diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0a1e62a9..47e23aa1 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -21,7 +21,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/misc.F90.in ${CMAKE_CURRENT_BINARY_DI list(APPEND fortran_src ${CMAKE_CURRENT_BINARY_DIR}/misc.F90) # Create the bufrlib.h file -foreach(_var IN ITEMS bmostr bmcstr) +foreach(_var IN ITEMS bmostr bmcstr fxy_fbit fxy_mintd fxy_minr fxy_drp16 fxy_drp8 fxy_drp1 fxy_drf16 fxy_drf8 fxy_drf1) file(STRINGS modules_vars.F90 _${_var}_tempstr REGEX "character.*${_var}") if(_${_var}_tempstr MATCHES "= '([A-Z0-9]+)") set(${_var} ${CMAKE_MATCH_1}) diff --git a/src/bufrlib.h.in b/src/bufrlib.h.in index 1a18ba8c..45d9472d 100644 --- a/src/bufrlib.h.in +++ b/src/bufrlib.h.in @@ -1,6 +1,5 @@ /** @file - * @brief Enable a number of NCEPLIBS-bufr subprograms to be called from within - * the C part of the library. + * @brief Enable a number of NCEPLIBS-bufr subprograms to be called from within the C part of the library. * * This header file defines signatures which wrap a number of native Fortran subprograms * in the library. It also contains prototypes for native C functions in the library as @@ -35,13 +34,31 @@ void stseq(int lun, int *irepct, int idn, char *nemo, char *cseq, int *cdesc, in #define FXY_STR_LEN 6 /** Character string containing minimum FXY value for a replication descriptor. */ -#define MIN_FXY_REPL "101000" +#define FXY_MINR "@fxy_minr@" /** Character string containing minimum FXY value for a Table D descriptor. */ -#define MIN_FXY_TABLED "300000" +#define FXY_MINTD "@fxy_mintd@" /** Character string containing maximum FXY value for a Table B descriptor. */ -#define MAX_FXY_TABLEB "063255" +#define FXY_MAXTB "@fxy_fbit@" + +/** Character string containing FXY value for NCEP Table D local descriptor denoting 16-bit delayed replication of a sequence using ( ) notation. */ +#define FXY_DRP16 "@fxy_drp16@" + +/** Character string containing FXY value for NCEP Table D local descriptor denoting 8-bit delayed replication of a sequence using { } notation. */ +#define FXY_DRP8 "@fxy_drp8@" + +/** Character string containing FXY value for NCEP Table D local descriptor denoting 1-bit delayed replication of a sequence using < > notation. */ +#define FXY_DRP1 "@fxy_drp1@" + +/** Character string containing FXY value for long (16-bit) delayed replication factor. */ +#define FXY_DRF16 "@fxy_drf16@" + +/** Character string containing FXY value for medium (8-bit) delayed replication factor. */ +#define FXY_DRF8 "@fxy_drf8@" + +/** Character string containing FXY value for short (1-bit) delayed replication factor. */ +#define FXY_DRF1 "@fxy_drf1@" /** Size of a character string needed to store a mnemonic. */ #define NEMO_STR_LEN 8 diff --git a/src/dumpdata.F90 b/src/dumpdata.F90 index fbac874f..f32b83b8 100644 --- a/src/dumpdata.F90 +++ b/src/dumpdata.F90 @@ -583,7 +583,8 @@ end subroutine ufdump !> @author J. Ator @date 2004-08-18 recursive subroutine dxdump(lunit,ldxot) - use modv_vars, only: im8b, reps + use modv_vars, only: im8b, reps, fxy_fbit, fxy_sbyct, fxy_drp16, fxy_drp8, fxy_drp8s, fxy_drp1, & + fxy_drf16, fxy_drf8, fxy_drf1 use moda_tababd use moda_nmikrp @@ -603,8 +604,8 @@ recursive subroutine dxdump(lunit,ldxot) data cardi4 /'|------------------------------------------------------------------------------|'/ ! Statement functions - tbskip(adn) = ((adn=='063000').or.(adn=='063255').or.(adn=='031000').or.(adn=='031001').or.(adn=='031002')) - tdskip(adn) = ((adn=='360001').or.(adn=='360002').or.(adn=='360003').or.(adn=='360004')) + tbskip(adn) = ((adn==fxy_sbyct).or.(adn==fxy_fbit).or.(adn==fxy_drf16).or.(adn==fxy_drf8).or.(adn==fxy_drf1)) + tdskip(adn) = ((adn==fxy_drp16).or.(adn==fxy_drp8).or.(adn==fxy_drp8s).or.(adn==fxy_drp1)) ! Check for I8 integers. diff --git a/src/dxtable.F90 b/src/dxtable.F90 index ade6d256..0c314d0c 100644 --- a/src/dxtable.F90 +++ b/src/dxtable.F90 @@ -604,25 +604,23 @@ end subroutine elemdx !> @author Woollen @date 1994-01-06 subroutine dxinit(lun,ioi) - use modv_vars, only: idnr + use modv_vars, only: idnr, fxy_fbit, fxy_sbyct, fxy_drf16, fxy_drf8, fxy_drf1 use moda_tababd implicit none integer, intent(in) :: lun, ioi - integer ibct, ipd1, ipd2, ipd3, ipd4, ninib, ninid, n, i, iret, ifxy + integer ninib, ninid, n, i, iret, ifxy character*8 inib(6,5),inid(5) character*6 adn30 - common /padesc/ ibct, ipd1, ipd2, ipd3, ipd4 - - data inib /'------','BYTCNT ','BYTES ','+0','+0','16', & - '------','BITPAD ','NONE ','+0','+0','1 ', & - '031000','DRF1BIT ','NUMERIC','+0','+0','1 ', & - '031001','DRF8BIT ','NUMERIC','+0','+0','8 ', & - '031002','DRF16BIT','NUMERIC','+0','+0','16'/ + data inib / '------','BYTCNT ','BYTES ','+0','+0','16', & + '------','BITPAD ','NONE ','+0','+0','1 ', & + fxy_drf1,'DRF1BIT ','NUMERIC','+0','+0','1 ', & + fxy_drf8,'DRF8BIT ','NUMERIC','+0','+0','8 ', & + fxy_drf16,'DRF16BIT','NUMERIC','+0','+0','16'/ data ninib /5/ data inid /' ', & @@ -653,8 +651,8 @@ subroutine dxinit(lun,ioi) ! Initialize table with apriori Table B and D entries - inib(1,1) = adn30(ibct,6) - inib(1,2) = adn30(ipd4,6) + inib(1,1) = fxy_sbyct + inib(1,2) = fxy_fbit do i=1,ninib ntbb(lun) = ntbb(lun)+1 diff --git a/src/fxy.F90 b/src/fxy.F90 index 6fa01fab..3aaca2e7 100644 --- a/src/fxy.F90 +++ b/src/fxy.F90 @@ -288,6 +288,8 @@ end function numbck !> @author J. Woollen @date 2002-05-14 subroutine numtbd(lun,idn,nemo,tab,iret) + use modv_vars, only: fxy_mintd + use moda_tababd implicit none @@ -303,7 +305,7 @@ subroutine numtbd(lun,idn,nemo,tab,iret) iret = 0 tab = ' ' - if(idn>=ifxy('300000')) then + if(idn>=ifxy(fxy_mintd)) then ! Look for idn in Table D do i=1,ntbd(lun) if(idn==idnd(i,lun)) then diff --git a/src/misc.F90.in b/src/misc.F90.in index a90b96fb..7d5b1e27 100644 --- a/src/misc.F90.in +++ b/src/misc.F90.in @@ -28,14 +28,13 @@ subroutine bfrini implicit none - integer ndndx(10), nldxa(10), nldxb(10), nldxd(10), nld30(10), ibct, ipd1, ipd2, ipd3, ipd4, nrpl, nmrg, namb, ntot, & + integer ndndx(10), nldxa(10), nldxb(10), nldxd(10), nld30(10), nrpl, nmrg, namb, ntot, & maxdx, idxv, nxstr, ldxa, ldxb, ldxd, ld30, i, j, i1, ifxy character*240 cmtdir character*56 dxstr character*6 dndx(25,10) - common /padesc/ ibct, ipd1, ipd2, ipd3, ipd4 common /dxtab/ maxdx, idxv, nxstr(10), ldxa(10), ldxb(10), ldxd(10), ld30(10), dxstr(10) common /mrgcom/ nrpl,nmrg,namb,ntot @@ -59,14 +58,6 @@ subroutine bfrini maxbyt = min(10000,mxmsgl) - ! Initialize common /padesc/ - - ibct = ifxy('063000') - ipd1 = ifxy('102000') - ipd2 = ifxy('031001') - ipd3 = ifxy('206001') - ipd4 = ifxy('063255') - ! Initialize module @ref moda_stbfr do i=1,nfiles diff --git a/src/modules_vars.F90 b/src/modules_vars.F90 index df3b1d8c..e2e8a072 100644 --- a/src/modules_vars.F90 +++ b/src/modules_vars.F90 @@ -86,23 +86,63 @@ module modv_vars !> in YYYYMMDDHH (4-digit year) format. integer :: lendat = 8 + !> Opening string of a BUFR message. + character*4, parameter :: bmostr = 'BUFR' + + !> Closing string of a BUFR message. + character*4, parameter :: bmcstr = '7777' + + !> Minimum FXY value for a Table D descriptor. + character*6, parameter :: fxy_mintd = '300000' + + !> Minimum FXY value for a replication descriptor. + character*6, parameter :: fxy_minr = '101000' + + !> FXY value for NCEP Table B local descriptor containing a subset byte count. + character*6, parameter :: fxy_sbyct = '063000' + + !> FXY value for NCEP Table B local descriptor containing a fill bit. + !> This is also the maximum FXY value for a Table B descriptor. + character*6, parameter :: fxy_fbit = '063255' + + !> FXY value for short (1-bit) delayed replication factor. + character*6, parameter :: fxy_drf1 = '031000' + + !> FXY value for medium (8-bit) delayed replication factor. + character*6, parameter :: fxy_drf8 = '031001' + + !> FXY value for long (16-bit) delayed replication factor. + character*6, parameter :: fxy_drf16 = '031002' + + !> FXY value for NCEP Table D local descriptor denoting 1-bit delayed replication of a sequence using < > notation. + character*6, parameter :: fxy_drp1 = '360004' + + !> FXY value for NCEP Table D local descriptor denoting 8-bit delayed replication of a sequence using { } notation. + character*6, parameter :: fxy_drp8 = '360002' + + !> FXY value for NCEP Table D local descriptor denoting 8-bit delayed replication of a sequence using [ ] notation. + character*6, parameter :: fxy_drp8s = '360003' + + !> FXY value for NCEP Table D local descriptor denoting 16-bit delayed replication of a sequence using ( ) notation. + character*6, parameter :: fxy_drp16 = '360001' + !> Replication indicators used in DX BUFR tables. - character, parameter :: reps(10) = (/ '"', '(', '{', '[', '<', & - '"', ')', '}', ']', '>'/) + character, parameter :: reps(10) = (/ '"', '(', '{', '[', '<', & + '"', ')', '}', ']', '>'/) !> Replication tags corresponding to reps. - character*3, parameter :: typs(10) = (/ 'REP', 'DRP', 'DRP', 'DRS', 'DRB', & - 'SEQ', 'RPC', 'RPC', 'RPS', 'SEQ'/) + character*3, parameter :: typs(10) = (/ 'REP', 'DRP', 'DRP', 'DRS', 'DRB', & + 'SEQ', 'RPC', 'RPC', 'RPS', 'SEQ'/) !> FXY values corresponding to reps. - character*6, parameter :: adsn(10) = (/'101000','360001','360002','360003','360004', & - '101255','031002','031001','031001','031000'/) + character*6, parameter :: adsn(10) = (/ fxy_minr, fxy_drp16, fxy_drp8, fxy_drp8s, fxy_drp1, & + '101255', fxy_drf16, fxy_drf8, fxy_drf8 , fxy_drf1/) !> WMO bit-wise representations of FXY values corresponding to reps. integer :: idnr(10) !> Lengths of delayed replication factors corresponding to each type of replication in reps. - integer, parameter :: lens(5) = (/ 0, 16, 8, 8, 1/) + integer, parameter :: lens(5) = (/ 0, 16, 8, 8, 1/) !> Maximum number of child descriptors that can be included within !> the sequence definition of a Table D descriptor, not counting the @@ -330,12 +370,6 @@ module modv_vars !> Number of bytes in Section 5 of a BUFR message. integer, parameter :: nby5 = 4 - !> Opening string of a BUFR message. - character*4, parameter :: bmostr = 'BUFR' - - !> Closing string of a BUFR message. - character*4, parameter :: bmcstr = '7777' - !> Master table for the last BUFR message that was read from a logical unit where !> Section 3 decoding is being used. !> This value is initialized to an artificially low number, in order to ensure that new diff --git a/src/readwritemg.F90 b/src/readwritemg.F90 index eeca94e6..1660b796 100644 --- a/src/readwritemg.F90 +++ b/src/readwritemg.F90 @@ -766,7 +766,7 @@ end subroutine msgwrt !> @author Woollen @date 1994-01-06 subroutine msgini(lun) - use modv_vars, only: mtv, nby0, nby1, nby2, nby3, nby5, bmostr, bmcstr + use modv_vars, only: mtv, nby0, nby1, nby2, nby3, nby5, bmostr, bmcstr, fxy_fbit, fxy_sbyct, fxy_drf8 use moda_msgcwd use moda_ufbcpl @@ -776,15 +776,12 @@ subroutine msgini(lun) implicit none integer, intent(in) :: lun - integer ibct, ipd1, ipd2, ipd3, ipd4, nby4, nbyt, mtyp, msbt, inod, isub, iret, & - mcen, mear, mmon, mday, mour, mmin, mbit + integer nby4, nbyt, mtyp, msbt, inod, isub, iret, mcen, mear, mmon, mday, mour, mmin, mbit, ifxy character*128 bort_str character*8 subtag character tab - common /padesc/ ibct,ipd1,ipd2,ipd3,ipd4 - ! Get the message tag and type, and break up the date subtag = tag(inode(lun))(1:8) @@ -851,12 +848,12 @@ subroutine msgini(lun) call pkb( 0 , 8 , mbay(1,lun),mbit) call pkb( 0 , 16 , mbay(1,lun),mbit) call pkb(2**7 , 8 , mbay(1,lun),mbit) - call pkb(ibct , 16 , mbay(1,lun),mbit) + call pkb(ifxy(fxy_sbyct), 16, mbay(1,lun),mbit) call pkb(isub , 16 , mbay(1,lun),mbit) - call pkb(ipd1 , 16 , mbay(1,lun),mbit) - call pkb(ipd2 , 16 , mbay(1,lun),mbit) - call pkb(ipd3 , 16 , mbay(1,lun),mbit) - call pkb(ipd4 , 16 , mbay(1,lun),mbit) + call pkb(ifxy('102000') , 16, mbay(1,lun),mbit) + call pkb(ifxy(fxy_drf8) , 16, mbay(1,lun),mbit) + call pkb(ifxy('206001') , 16, mbay(1,lun),mbit) + call pkb(ifxy(fxy_fbit), 16, mbay(1,lun),mbit) call pkb( 0 , 8 , mbay(1,lun),mbit) ! Section 4 diff --git a/src/restd.c b/src/restd.c index 6116858e..cbfbbbad 100644 --- a/src/restd.c +++ b/src/restd.c @@ -114,7 +114,7 @@ restd(int lun, int tddesc, int *nctddesc, int *ctddesc) restd(lun, desc, &ncdesc, cdesc); if ( ( *nctddesc > 0 ) && - ( ctddesc[(*nctddesc)-1] > ifxy_f(MIN_FXY_REPL) ) && + ( ctddesc[(*nctddesc)-1] > ifxy_f(FXY_MINR) ) && ( ctddesc[(*nctddesc)-1] <= ifxy_f("101255") ) ) { /* ** desc is replicated using fixed replication, so write @@ -128,7 +128,7 @@ restd(int lun, int tddesc, int *nctddesc, int *ctddesc) ctddesc[(*nctddesc)-1] = ifxy_f(adn); } else if ( ( *nctddesc > 1 ) && - ( ctddesc[(*nctddesc)-2] == ifxy_f(MIN_FXY_REPL) ) ) { + ( ctddesc[(*nctddesc)-2] == ifxy_f(FXY_MINR) ) ) { /* ** desc is replicated using delayed replication, so write ** the number of child descriptors into the X value of diff --git a/src/s013vals.F90 b/src/s013vals.F90 index e6cc7ed5..4dea0121 100644 --- a/src/s013vals.F90 +++ b/src/s013vals.F90 @@ -1263,7 +1263,7 @@ end subroutine minimg !> @author Woollen @date 2000-09-19 subroutine cktaba(lun,subset,jdate,iret) - use modv_vars, only: iprt + use modv_vars, only: iprt, fxy_sbyct use moda_msgcwd use moda_sc3bfr @@ -1275,8 +1275,8 @@ subroutine cktaba(lun,subset,jdate,iret) integer, intent(in) :: lun integer, intent(out) :: jdate, iret integer, parameter :: ncpfx = 3 - integer ibct, ipd1, ipd2, ipd3, ipd4, mtyp, msbt, mty1, msb1, isub, ksub, len0, len1, len2, len3, l4, l5, lundx, ii, & - itab, inod, iad3, iad4, iyr, imo, idy, ihr, iupb, iupbs01, iupbs3, i4dy, igetdate + integer mtyp, msbt, mty1, msb1, isub, ksub, len0, len1, len2, len3, l4, l5, lundx, ii, & + itab, inod, iad3, iad4, iyr, imo, idy, ihr, iupb, ifxy, iupbs01, iupbs3, i4dy, igetdate character*128 bort_str, errstr character*8, intent(out) :: subset @@ -1285,8 +1285,6 @@ subroutine cktaba(lun,subset,jdate,iret) logical trybt - common /padesc/ ibct, ipd1, ipd2, ipd3, ipd4 - iret = 0 trybt = .true. @@ -1361,7 +1359,7 @@ subroutine cktaba(lun,subset,jdate,iret) write(subset,'(A2,2I3.3)') cpfx(ii),mtyp,msbt call nemtbax(lun,subset,mty1,msb1,inod) if(inod>0) then - if(ksub==ibct) then + if(ksub==ifxy(fxy_sbyct)) then mbyt(lun) = (iad4+4) msgunp(lun) = 0 else diff --git a/src/stseq.c b/src/stseq.c index 9a397be2..c2dc252c 100644 --- a/src/stseq.c +++ b/src/stseq.c @@ -57,7 +57,7 @@ nummtb(int *idn, char *tab, int *ipt) char adn[FXY_STR_LEN+1], errstr[129]; - if ( *idn >= ifxy_f(MIN_FXY_TABLED) ) { + if ( *idn >= ifxy_f(FXY_MINTD) ) { *tab = 'D'; pifxyn = &idfxyn_c[0]; nmt = nmtd_c; @@ -425,14 +425,14 @@ stseq(int lun, int *irepct, int idn, char *nemo, char *cseq, int *cdesc, int ncd "DESCRIPTOR REPLICATION FACTOR FOR %s", adn); bort_f(errstr); } - else if ( cdesc[i+1] == ifxy_f("031002") ) { - pkint = ifxy_f("360001"); + else if ( cdesc[i+1] == ifxy_f(FXY_DRF16) ) { + pkint = ifxy_f(FXY_DRP16); } - else if ( cdesc[i+1] == ifxy_f("031001") ) { - pkint = ifxy_f("360002"); + else if ( cdesc[i+1] == ifxy_f(FXY_DRF8) ) { + pkint = ifxy_f(FXY_DRP8); } - else if ( cdesc[i+1] == ifxy_f("031000") ) { - pkint = ifxy_f("360004"); + else if ( cdesc[i+1] == ifxy_f(FXY_DRF1) ) { + pkint = ifxy_f(FXY_DRP1); } else { sprintf(errstr, "BUFRLIB: STSEQ - UNKNOWN DELAYED " @@ -442,7 +442,7 @@ stseq(int lun, int *irepct, int idn, char *nemo, char *cseq, int *cdesc, int ncd i += 2; } else { /* regular replication */ - pkint = ifxy_f(MIN_FXY_REPL) + iy; + pkint = ifxy_f(FXY_MINR) + iy; i++; } /* @@ -466,7 +466,7 @@ stseq(int lun, int *irepct, int idn, char *nemo, char *cseq, int *cdesc, int ncd "DESCRIPTORS TO COMPLETE REPLICATION FOR %s", adn); bort_f(errstr); } - else if ( ( ix == 1 ) && ( cdesc[i] >= ifxy_f(MIN_FXY_TABLED) ) ) { + else if ( ( ix == 1 ) && ( cdesc[i] >= ifxy_f(FXY_MINTD) ) ) { /* ** The only thing being replicated is a single Table D descriptor, ** so there's no need to invent a new sequence for this replication @@ -556,8 +556,8 @@ stseq(int lun, int *irepct, int idn, char *nemo, char *cseq, int *cdesc, int ncd ** Note that associated fields are only applied to Table B descriptors, ** except for those in Class 31. */ - if ( ( naf > 0 ) && ( pkint <= ifxy_f(MAX_FXY_TABLEB) ) && - ( ( pkint < ifxy_f("031000") ) || + if ( ( naf > 0 ) && ( pkint <= ifxy_f(FXY_MAXTB) ) && + ( ( pkint < ifxy_f(FXY_DRF1) ) || ( pkint > ifxy_f("031255") ) ) ) { for ( j = 0; j < naf; j++ ) { pktdd_f(nd, lun, iafpk[j], &iret);