diff --git a/.github/workflows/MacOS.yml b/.github/workflows/MacOS.yml
index 9d69b311..dbc9da94 100644
--- a/.github/workflows/MacOS.yml
+++ b/.github/workflows/MacOS.yml
@@ -16,8 +16,8 @@ jobs:
MacOS:
runs-on: macos-latest
env:
- FC: gfortran-11
- F90: gfortran-11
+ FC: gfortran-12
+ F90: gfortran-12
steps:
@@ -33,7 +33,7 @@ jobs:
pip3 install ninja
pip3 install netCDF4
pip3 install protobuf
- sudo ln -sf /usr/local/bin/gfortran-11 /usr/local/bin/gfortran
+ sudo ln -sf /usr/local/bin/gfortran-12 /usr/local/bin/gfortran
- name: checkout-bufr
uses: actions/checkout@v4
diff --git a/VERSION b/VERSION
index 77903b35..68533262 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-12.1.0
+12.2.0
diff --git a/docs/dx_tables.md b/docs/dx_tables.md
index 1de9e5b9..2159944e 100644
--- a/docs/dx_tables.md
+++ b/docs/dx_tables.md
@@ -6,7 +6,7 @@
Every BUFR file must have DX BUFR tables associated with it, unless
the 'SEC3' decoding option is specified during the call to
openbf(). For all other cases, DX table information must be
-pre-defined and made available to the software via call argument LUNDX
+pre-defined and made available to the software via call argument lundx
during the call to openbf(). The DX tables information may be embedded
within the first few BUFR messages of the file itself. Otherwise, a
separate ASCII text file containing the necessary DX tables
@@ -18,6 +18,10 @@ that all necessary mnemonics must exist and be fully-defined.
A mnemonic is a
descriptive, alphanumeric name for a data value.
+A mnemonic may contain any
+combination of uppercase letters and numbers (or, in certain special
+cases, a "." character), up to a maximum of 8 characters in length.
+There are 3 basic types of mnemonics:
* "Table A mnemonics", refer to particular data subset (i.e. report ) types,
* "Table B mnemonics", refer directly to basic data values,
* "Table D mnemonics" are
@@ -40,6 +44,10 @@ software by providing descriptive names to represent individual data
values. They are more intuitive than FXY numbers (described below),
which are the prescribed method within actual BUFR messages.
+Of note, there is one special 4-letter mnemonic "DPRI" which is reserved
+for exclusive use with FXY number 031031, and which must always be used
+when reading or writing bitmaps within the software.
+
## DX BUFR Tables File
A DX BUFR tables file consists of three distinct sections. Each
@@ -64,9 +72,7 @@ bit width, and units.
The first section of a BUFR tables file is where all Table A, B and D
mnemonics are initially declared, assigned a unique FXY number, and
-given a short free-form text description. Mnemonics may contain any
-combination of uppercase letters and numbers (or, in certain special
-cases, a "." character), up to a maximum of 8 characters in length. A
+given a short free-form text description. Each
mnemonic may be declared only once, and each one must correspond to a
unique FXY number, which itself consists of 6 characters, and where
the first character (i.e. the "F" component) is an "A" if the mnemonic
diff --git a/src/bitmaps.F90 b/src/bitmaps.F90
index 1018c8af..2ddd4e4c 100644
--- a/src/bitmaps.F90
+++ b/src/bitmaps.F90
@@ -5,11 +5,18 @@
!> Store internal information in module @ref moda_bitmaps if the input element is part of a bitmap.
!>
+!> This subroutine first determines whether the input element is part of a bitmap. If so, then information about the
+!> element is stored internally for later use.
+!>
!> @param n - Subset element
!> @param lun - File ID
+!> @param ival - Value associated with n:
+!> - If n is determined to be part of a bitmap, then a value of 0 means that n is a "set" entry in the bitmap, and
+!> any other (i.e. non-zero) value means that n is not a "set" entry in the bitmap
+!> - If n is determined to not be part of a bitmap, then this value is ignored
!>
!> @author J. Ator @date 2016-05-27
-subroutine strbtm ( n, lun )
+subroutine strbtm ( n, lun, ival )
use modv_vars, only: mxbtm, mxbtmse
@@ -20,8 +27,8 @@ subroutine strbtm ( n, lun )
implicit none
- integer, intent(in) :: n, lun
- integer node, nodtam, ii, jj, ibfms, lstjpb
+ integer, intent(in) :: n, lun, ival
+ integer node, nodtam, ii, jj, lstjpb
logical isbtme
@@ -62,7 +69,7 @@ subroutine strbtm ( n, lun )
linbtm = .true.
end if
iszbtm(nbtm) = iszbtm(nbtm) + 1
- if ( ibfms(val(n,lun)) == 0 ) then
+ if ( ival == 0 ) then
! This is a "set" (value=0) entry in the bitmap.
if ( nbtmse(nbtm) >= mxbtmse ) call bort('BUFRLIB: STRBTM - MXBTMSE OVERFLOW')
nbtmse(nbtm) = nbtmse(nbtm) + 1
diff --git a/src/cidecode.F90 b/src/cidecode.F90
index 02e8a3ab..da5275ea 100644
--- a/src/cidecode.F90
+++ b/src/cidecode.F90
@@ -99,7 +99,7 @@ subroutine upb8(nval,nbits,ibit,ibay)
elseif(nbits<=64) then
jbit=ibit; nvals=0
call upb(nvals(2),max(nbits-nbitw,0),ibay,jbit)
- call upb(nvals(1),min(nbitw,nbits ),ibay,jbit)
+ call upb(nvals(1),min(nbitw,nbits),ibay,jbit)
nval=nval8
else
nval=0
diff --git a/src/ciencode.F90 b/src/ciencode.F90
index 5fec6b20..32192a6b 100644
--- a/src/ciencode.F90
+++ b/src/ciencode.F90
@@ -116,7 +116,7 @@ subroutine pkb8(nval,nbits,ibay,ibit)
nval4=nvals(2)
call pkb(nval4,max(nbits-nbitw,0),ibay,ibit)
nval4=nvals(1)
- call pkb(nval4,min(nbits,nbitw ),ibay,ibit)
+ call pkb(nval4,min(nbits,nbitw),ibay,ibit)
return
end subroutine pkb8
diff --git a/src/compress.F90 b/src/compress.F90
index fbbdf363..2feaf8e9 100644
--- a/src/compress.F90
+++ b/src/compress.F90
@@ -121,7 +121,7 @@ subroutine rdcmps(lun)
integer, intent(in) :: lun
integer*8 :: ival, lref, ninc, lps
- integer nsbs, jbit, lbit, nbit, n, node, ityp, linc, lre4, nin4, nbmp, nchr, lelm, ibsv, igetrfel, icbfms
+ integer nsbs, jbit, lbit, nbit, n, node, ityp, linc, lre4, nin4, nbmp, nchr, lelm, ibsv, igetrfel, ibfms, icbfms
real*8 rval, ups
@@ -191,7 +191,7 @@ subroutine rdcmps(lun)
goto 11
endif
if(ival0) then
- write(fmt(15:20),'(A,I2)') 'F20.', isc(node)
+ if(imrkopr(nemo)==1) then
+ iscl = isc(inv(nrfe,lun))
+ else
+ iscl = isc(node)
+ endif
+ if(iscl>0) then
+ write(fmt(15:20),'(A,I2)') 'F20.', iscl
else
write(fmt(18:20),'(A)') 'I20'
endif
@@ -447,7 +452,7 @@ recursive subroutine ufdump(lunit,luprt)
unit(ipt-1:ipt-1) = ')'
endif
endif
- if(isc(node)>0) then
+ if(iscl>0) then
write(luout,fmt) numb,nemo,rval,unit,desc
else
ival = nint(rval,8)
diff --git a/src/readwritesb.F90 b/src/readwritesb.F90
index 9c984f09..3715438c 100644
--- a/src/readwritesb.F90
+++ b/src/readwritesb.F90
@@ -985,7 +985,7 @@ subroutine rdtree(lun,iret)
integer, intent(in) :: lun
integer, intent(out) :: iret
- integer ier, n, node, kbit, nbt, icbfms
+ integer ier, n, node, kbit, nbt, icbfms, igetrfel
character*8 cval
@@ -1005,36 +1005,26 @@ subroutine rdtree(lun,iret)
return
endif
- ! Unpack a subset into the user array ival
+ ! Loop through each element of the subset, unpacking each value and then converting it to the proper type
do n=1,nval(lun)
call upb8(ival(n),nbit(n),mbit(n),mbay(1,lun))
- enddo
-
- ! Loop through each element of the subset, converting the unpacked values to the proper types
-
- do n=1,nval(lun)
node = inv(n,lun)
if(itp(node)==1) then
-
! The unpacked value is a delayed descriptor replication factor.
-
val(n,lun) = ival(n)
elseif(itp(node)==2) then
-
! The unpacked value is a real.
-
+ nrfelm(n,lun) = igetrfel(n,lun)
if (ival(n)<2_8**ibt(node)-1) then
val(n,lun) = ups(ival(n),node)
else
val(n,lun) = bmiss
endif
elseif(itp(node)==3) then
-
! The value is a character string, so unpack it using an equivalenced real*8 value. Note that a maximum of 8 characters
! will be unpacked here, so a separate subsequent call to subroutine readlc() will be needed to fully unpack any string
! longer than 8 characters.
-
cval = ' '
kbit = mbit(n)
nbt = min(8,nbit(n)/8)
@@ -1072,7 +1062,7 @@ subroutine wrtree(lun)
integer, intent(in) :: lun
integer*8 ipks
- integer n, node, ncr, numchr, jj, ibfms
+ integer n, node, nbit, ncr, numchr, jj, ibfms, igetrfel, imrkopr
character*120 lstr
character*8 cval
@@ -1085,6 +1075,7 @@ subroutine wrtree(lun)
do n=1,nval(lun)
node = inv(n,lun)
+ nrfelm(n,lun) = igetrfel(n,lun)
if(itp(node)==1) then
ival(n) = nint(val(n,lun))
elseif(typ(node)=='NUM') then
@@ -1094,6 +1085,7 @@ subroutine wrtree(lun)
else
ival(n) = ipks(val(n,lun),node)
endif
+ call strbtm(n,lun,int(ival(n)))
endif
enddo
@@ -1105,7 +1097,12 @@ subroutine wrtree(lun)
node = inv(n,lun)
if(itp(node)<3) then
! The value to be packed is numeric.
- call pkb8(ival(n),ibt(node),ibay,ibit)
+ if ( imrkopr(tag(node)) == 1 ) then
+ nbit = ibt(inv(nrfelm(n,lun),lun))
+ else
+ nbit = ibt(node)
+ endif
+ call pkb8(ival(n),nbit,ibay,ibit)
else
! The value to be packed is a character string.
ncr=ibt(node)/8
@@ -1154,7 +1151,7 @@ end subroutine wrtree
!> @author Woollen @date 1994-01-06
subroutine rcstpl(lun,iret)
- use modv_vars, only: bmiss, maxjl, maxss, maxrcr
+ use modv_vars, only: maxjl, maxss, maxrcr
use moda_usrint
use moda_usrbit
@@ -1169,8 +1166,7 @@ subroutine rcstpl(lun,iret)
integer, intent(in) :: lun
integer, intent(out) :: iret
- integer nbmp(2,maxrcr), newn(2,maxrcr), knx(maxrcr), iprt, nodi, node, mbmp, knvn, nr, i, j, n, nn, n1, n2, new, &
- idpri, igetrfel
+ integer nbmp(2,maxrcr), newn(2,maxrcr), knx(maxrcr), iprt, nodi, node, mbmp, nr, i, j, n, nn, n1, n2, new, ivob, igetrfel
common /quiet/ iprt
@@ -1185,7 +1181,7 @@ subroutine rcstpl(lun,iret)
nodi = inode(lun)
node = inode(lun)
mbmp = 1
- knvn = 1
+ nval(lun) = 1
nr = 0
do i=1,maxrcr
@@ -1233,10 +1229,10 @@ subroutine rcstpl(lun,iret)
! Store nodes at some recursion level
do i=nbmp(1,nr),nbmp(2,nr)
- if(knx(nr)==0) knx(nr) = knvn
+ if(knx(nr)==0) knx(nr) = nval(lun)
if(i>nbmp(1,nr)) newn(1,nr) = 1
do j=newn(1,nr),newn(2,nr)
- if(knvn+1>maxss) then
+ if(nval(lun)+1>maxss) then
if(iprt>=0) then
call errwrt('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
call errwrt('BUFRLIB: RCSTPL - MAXSS OVERFLOW; SUBSET SKIPPED')
@@ -1245,35 +1241,30 @@ subroutine rcstpl(lun,iret)
iret = -1
return
endif
- knvn = knvn+1
+ nval(lun) = nval(lun)+1
node = iutmp(j,nr)
- ! inv is positional index in internal jump/link table for packed subset element knvn in mbay
- inv(knvn,lun) = node
- ! mbit is the bit in mbay pointing to where the packed subset element knvn begins
- mbit(knvn) = mbit(knvn-1)+nbit(knvn-1)
- ! nbit is the number of bits in mbay occupied by packed subset element knvn
- nrfelm(knvn,lun) = igetrfel(knvn,lun)
- nbit(knvn) = ibt(node)
- if(tag(node)(1:5)=='DPRI ') then
- ! This is a bitmap entry, so get and store the corresponding value
- call upbb(idpri,nbit(knvn),mbit(knvn),mbay(1,lun))
- if(idpri==0) then
- val(knvn,lun) = 0.0
- else
- val(knvn,lun) = bmiss
- endif
- call strbtm(knvn,lun)
+ ! inv is positional index in internal jump/link table for packed subset element nval(lun) in mbay
+ inv(nval(lun),lun) = node
+ ! mbit is the bit in mbay pointing to where the packed subset element nval(lun) begins
+ mbit(nval(lun)) = mbit(nval(lun)-1)+nbit(nval(lun)-1)
+ ! nbit is the number of bits in mbay occupied by packed subset element nval(lun)
+ nrfelm(nval(lun),lun) = igetrfel(nval(lun),lun)
+ nbit(nval(lun)) = ibt(node)
+ if(nbit(nval(lun))==1) then
+ ! Check whether this is a bitmap entry
+ call upbb(ivob,nbit(nval(lun)),mbit(nval(lun)),mbay(1,lun))
+ call strbtm(nval(lun),lun,ivob)
endif
! Actual unpacked subset values are initialized here
- val(knvn,lun) = vutmp(j,nr)
+ val(nval(lun),lun) = vutmp(j,nr)
if(itp(node)==1) then
- call upbb(mbmp,nbit(knvn),mbit(knvn),mbay(1,lun))
+ call upbb(mbmp,nbit(nval(lun)),mbit(nval(lun)),mbay(1,lun))
newn(1,nr) = j+1
nbmp(1,nr) = i
cycle outer
endif
enddo
- new = knvn-knx(nr)
+ new = nval(lun)-knx(nr)
val(knx(nr)+1,lun) = val(knx(nr)+1,lun) + new
knx(nr) = 0
enddo
@@ -1286,10 +1277,6 @@ subroutine rcstpl(lun,iret)
enddo outer
- ! Finally store the length of (i.e. the number of elements in) the subset template
-
- nval(lun) = knvn
-
return
end subroutine rcstpl
diff --git a/src/restd.c b/src/restd.c
index 2d8e97a3..1ff42ace 100644
--- a/src/restd.c
+++ b/src/restd.c
@@ -141,6 +141,13 @@ restd(int lun, int tddesc, int *nctddesc, int *ctddesc)
free(cdesc);
}
+ else if ( imrkopr_f(nemo) ) {
+/*
+** desc is a Table C marker operator, so append it "as is" to the
+** output list.
+*/
+ wrdesc(ifxy_f(nemo), ctddesc, nctddesc, maxnc);
+ }
else {
/*
** desc is a local Table B descriptor, so precede it with
diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt
index 8157c0f7..c7813a74 100644
--- a/test/CMakeLists.txt
+++ b/test/CMakeLists.txt
@@ -8,7 +8,9 @@ list(APPEND test_kinds 4 8 d)
# Fetch test data from: https://ftp.emc.ncep.noaa.gov/static_files/public
set(BUFR_URL "https://ftp.emc.ncep.noaa.gov/static_files/public")
-if(${PROJECT_VERSION} VERSION_GREATER_EQUAL 12.1.0)
+if(${PROJECT_VERSION} VERSION_GREATER_EQUAL 12.2.0)
+ set(BUFR_TAR "bufr-12.2.0.tgz")
+elseif(${PROJECT_VERSION} VERSION_GREATER_EQUAL 12.1.0)
set(BUFR_TAR "bufr-12.1.0.tgz")
elseif(${PROJECT_VERSION} VERSION_GREATER_EQUAL 11.6.0)
set(BUFR_TAR "bufr-11.6.0.tgz")
@@ -158,7 +160,7 @@ foreach(kind ${test_kinds})
foreach(innum RANGE 1 12)
create_test(intest ${kind} ${innum})
endforeach()
- foreach(outnum RANGE 1 11)
+ foreach(outnum RANGE 1 12)
create_test(outtest ${kind} ${outnum})
endforeach()
endforeach()
diff --git a/test/outtest12.F90 b/test/outtest12.F90
new file mode 100644
index 00000000..ba4130a1
--- /dev/null
+++ b/test/outtest12.F90
@@ -0,0 +1,90 @@
+! This is a test for NCEPLIBS-bufr.
+!
+! Writes test file 'testfiles/OUT_12' using a bitmap and Table C marker operators.
+!
+! J. Ator, 8/20/2024
+program outtest12
+ implicit none
+
+ real*8 r8bitmap(16), r8data(10,1), r8pccf(3), r8mrkr(3)
+
+ integer nlv, ii, jj, iostat1, iostat2
+
+ character ptidc*16
+
+ print *, 'Testing writing OUT_12 using a bitmap and Table C marker operators'
+
+#ifdef KIND_8
+ call setim8b ( .true. )
+#endif
+
+ ! Open the BUFR table and output file.
+ open ( unit = 11, file = 'out12.bufr', form ='unformatted', iostat = iostat1 )
+ open ( unit = 12, file = 'testfiles/OUT_12_bufrtab', iostat = iostat2 )
+ if ( ( iostat1 /= 0 ) .or. ( iostat2 /= 0 ) ) stop 1
+ call openbf ( 11, 'NODX', 12 )
+ call stdmsg ( 'Y' )
+ call pkvs01 ( 'BEN', 4 )
+
+ do jj = 1, 4
+ ! The first 2 data subsets will be uncompressed, and the second 2 data subsets will be compressed.
+ if ( jj == 3 ) call cmpmsg ( 'Y' )
+
+ ! Open a new message for output.
+ call openmb ( 11, 'FN004017', 2024072412 )
+
+ ! Store the subset data.
+ r8data ( 1, 1 ) = 2024.
+ r8data ( 2, 1 ) = 7.
+ r8data ( 3, 1 ) = 24.
+ r8data ( 4, 1 ) = 12.
+ r8data ( 5, 1 ) = 55. + jj
+ r8data ( 6, 1 ) = 10.
+ r8data ( 7, 1 ) = -24.55750 + (jj * 0.001)
+ r8data ( 8, 1 ) = 86.23435 + (jj * 0.001)
+ r8data ( 9, 1 ) = 10500.
+ call ufbint ( 11, r8data, 10, 1, nlv, 'YEAR MNTH DAYS HOUR MINU SECO CLATH CLONH HMSL' )
+ r8data ( 1, 1 ) = 283.5 - jj
+ r8data ( 2, 1 ) = 170.
+ r8data ( 3, 1 ) = 290. - (jj * 5)
+ r8data ( 4, 1 ) = 6.5 + (jj * 0.1)
+ r8data ( 5, 1 ) = 3.
+ r8data ( 6, 1 ) = 0.
+ r8data ( 7, 1 ) = 10.
+ call ufbint ( 11, r8data, 10, 1, nlv, 'TMDBST SMMO WDIR WSPD POAF ROLQ FOST' )
+
+ ! Store the bitmap.
+ do ii = 1, 16
+ r8bitmap(ii) = 1.
+ end do
+ r8bitmap(11) = 0.
+ r8bitmap(13) = 0.
+ r8bitmap(14) = 0.
+ call ufbrep ( 11, r8bitmap, 1, 16, nlv, 'DPRI' )
+
+ ! Store the percent confidences.
+ r8pccf(1) = 93. - jj
+ r8pccf(2) = 94. - jj
+ r8pccf(3) = 87. - jj
+ call ufbrep ( 11, r8pccf, 1, 3, nlv, 'PCCF' )
+
+ ! Store the marker operators containing standard deviations.
+ r8mrkr(1) = 0.3 + (jj * 0.1)
+ r8mrkr(2) = 1.0 * jj ! WDIR has scale 0, so the corresponding marker operator will also be scale 0
+ r8mrkr(3) = 0.1 + (jj * 0.3)
+ call ufbrep ( 11, r8mrkr, 1, 3, nlv, '224255' )
+
+ call writsb ( 11 )
+
+ ! Write a long character string to the message.
+ ptidc = 'HC888V3497074363'
+ call writlc ( 11, ptidc, 'PTIDC' )
+
+ if ( jj == 2 ) call closmg ( 11 )
+
+ end do
+
+ ! Close the output file.
+ call closbf ( 11 )
+
+end program outtest12
diff --git a/test/test_scripts/test_debufr.sh b/test/test_scripts/test_debufr.sh
index 74a2619e..acf561c9 100755
--- a/test/test_scripts/test_debufr.sh
+++ b/test/test_scripts/test_debufr.sh
@@ -55,16 +55,16 @@ args_7="-t ../tables -o ${outfile_7}"
../utils/debufr ${args_7} testfiles/data/debufr_7 && cmp -s ${outfile_7} testfiles/testoutput/debufr_7.out
[[ ${?} -ne 0 ]] && exit 7
+# Test #8, reading debufr_8 file using master tables.
+outfile_8=testrun/debufr_8.out
+args_8="-t ../tables -o ${outfile_8}"
+../utils/debufr ${args_8} testfiles/data/debufr_8 && cmp -s ${outfile_8} testfiles/testoutput/debufr_8.out
+[[ ${?} -ne 0 ]] && exit 8
+
# We expect some of the following tests may return a non-zero exit code, but we don't want
# to immediately exit the script when that happens.
set +e
-# Test #8, which should call NCEPLIBS-bufr subroutine bort from within subroutine nummtb.
-outfile_8=testrun/debufr_8.out
-args_8="-t ../tables"
-../utils/debufr ${args_8} testfiles/data/debufr_8 > ${outfile_8}
-[[ ${?} -eq 0 || `grep -c "NUMMTB - COULD NOT FIND DESCRIPTOR" ${outfile_8}` -ne 1 ]] && exit 8
-
# Test #9, for wrong number of arguments.
outfile_9=testrun/debufr_9.out
../utils/debufr > ${outfile_9}
@@ -96,5 +96,11 @@ outfile_14=testrun/debufr_14.out
../utils/debufr -o /BUFRLIB_DUMMY_DIRECTORY/BUFRLIB_DUMMY testfiles/data/debufr_1 > ${outfile_14}
[[ ${?} -eq 0 || `grep -c "ERROR: Cannot write output file" ${outfile_14}` -ne 1 ]] && exit 14
+# Test #15, which should call NCEPLIBS-bufr subroutine bort from within subroutine nummtb.
+outfile_15=testrun/debufr_15.out
+args_15="-t ../tables"
+../utils/debufr ${args_15} testfiles/data/debufr_15 > ${outfile_15}
+[[ ${?} -eq 0 || `grep -c "NUMMTB - COULD NOT FIND DESCRIPTOR" ${outfile_15}` -ne 1 ]] && exit 15
+
# Success!
exit 0