replace common block /padesc/ and parameterize some FXY constants

NOAA-EMC · Dec 18, 2024 · ac43bac · ac43bac
1 parent f9d2073
commit ac43bac
Show file tree

Hide file tree

Showing 11 changed files with 111 additions and 73 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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