Merge pull request #617 from NOAA-EMC/jba_issue612

eliminate duplication of replication sequences within stseq function

.github/workflows/Intel.yml

@@ -54,7 +54,7 @@ jobs:
       uses: actions/cache@v4
       with:
         path: ~/data
-        key: data-15
+        key: data-16
 
     - name: build
       run: |

.github/workflows/Linux.yml

@@ -40,7 +40,7 @@ jobs:
       uses: actions/cache@v4
       with:
         path: ~/data
-        key: data-15
+        key: data-16
 
     - name: build
       run: |

.github/workflows/MacOS.yml

@@ -45,7 +45,7 @@ jobs:
       uses: actions/cache@v4
       with:
         path: ~/data
-        key: data-15
+        key: data-16
 
     - name: build-bufr
       run: |

.github/workflows/Spack.yml

@@ -42,7 +42,7 @@ jobs:
       uses: actions/cache@v4
       with:
         path: ~/data
-        key: data-15
+        key: data-16
 
     - name: spack-build-and-test
       run: |

.github/workflows/developer.yml

@@ -38,7 +38,7 @@ jobs:
       uses: actions/cache@v4
       with:
         path: ~/data
-        key: data-15
+        key: data-16
 
     - name: build-docs
       run: |

src/CMakeLists.txt

@@ -14,7 +14,7 @@ list(APPEND c_src
   arallocc.c cpmstabs.c cread.c crwbmg.c cfe.c icvidx.c restd.c stseq.c)
 
 list(APPEND c_hdr
-  cread.h mstabs.h bufr_interface.h bufrlib.h)
+  cread.h mstabs.h rpseqs.h bufr_interface.h bufrlib.h)
 
 # Create the misc.F90 file
 configure_file(${CMAKE_CURRENT_SOURCE_DIR}/misc.F90.in ${CMAKE_CURRENT_BINARY_DIR}/misc.F90 @ONLY)

src/arallocc.c

@@ -10,6 +10,7 @@
 
 #include "cread.h"
 #include "mstabs.h"
+#include "rpseqs.h"
 
 /**
  * Dynamically allocate C language arrays.
@@ -42,7 +43,6 @@ arallocc(void)
     nfiles = igetprm_f("NFILES");
 
     if (!(pb = malloc((nfiles+1) * sizeof(FILE *)))) bort_f(brtstr);
-
     if (!(lstpos = malloc((nfiles+1) * sizeof(fpos_t)))) bort_f(brtstr);
 
     /* mstabs arrays */
@@ -53,30 +53,23 @@ arallocc(void)
     mxnaf = igetprm_f("MXNAF");
 
     if (!(ibfxyn_c = malloc(mxmtbb * sizeof(int)))) bort_f(brtstr);
-
     if (!(cbscl_c = malloc(mxmtbb * 4 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cbsref_c = malloc(mxmtbb * 12 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cbbw_c = malloc(mxmtbb * 4 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cbunit_c = malloc(mxmtbb * 24 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cbmnem_c = malloc(mxmtbb * 8 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cbelem_c = malloc(mxmtbb * 120 * sizeof(char)))) bort_f(brtstr);
-
     if (!(idfxyn_c = malloc(mxmtbd * sizeof(int)))) bort_f(brtstr);
-
     if (!(cdseq_c = malloc(mxmtbd * 120 * sizeof(char)))) bort_f(brtstr);
-
     if (!(cdmnem_c = malloc(mxmtbd * 8 * sizeof(char)))) bort_f(brtstr);
-
     if (!(ndelem_c = malloc(mxmtbd * sizeof(int)))) bort_f(brtstr);
-
     if (!(idefxy_c = malloc(mxmtbd * maxcd * sizeof(int)))) bort_f(brtstr);
-
     if (!(iafpk = malloc(mxnaf * sizeof(int)))) bort_f(brtstr);
+
+    /* rpseqs arrays */
+
+    if (!(cdescs = malloc(MAX_RPSQ * maxcd * sizeof(int)))) bort_f(brtstr);
+    if (!(iafpks = malloc(MAX_RPSQ * mxnaf * sizeof(int)))) bort_f(brtstr);
 }
 
 /**
@@ -109,4 +102,13 @@ ardllocc(void)
     free( ndelem_c );
     free( idefxy_c );
     free( iafpk );
+
+    /* rpseqs arrays */
+
+    free( cdescs );
+    free( iafpks );
+
+    /* master Code/Flag table entries */
+
+    dlloctbf();
 }

src/arallocf.F90

@@ -905,7 +905,6 @@ subroutine exitbufr
 
   use moda_stbfr
   use moda_s01cm
-  use moda_tablef
 
   ! Close any logical units that are open to the library.
 
@@ -917,8 +916,6 @@ subroutine exitbufr
 
   call ardllocf
 
-  if ( cdmf == 'Y' ) call dlloctbf_c
-
   ! Reset the library.
 
   ns01v = 0

src/bufr_interface.F90

@@ -75,16 +75,6 @@ subroutine ccbfl_c() bind(C, name='ccbfl')
       use iso_c_binding
     end subroutine ccbfl_c
 
-    !> @fn bufr_interface::dlloctbf_c::dlloctbf_c()
-    !> Free all memory allocated via inittbf_c().
-    !>
-    !> Wraps dlloctbf() function.
-    !>
-    !> @author J. Ator @date 2017-11-03
-    subroutine dlloctbf_c() bind(C, name='dlloctbf')
-      use iso_c_binding
-    end subroutine dlloctbf_c
-
   end interface
 
 end module bufr_interface

src/bufrlib.h

@@ -18,6 +18,7 @@
 
 void arallocc(void);
 void ardllocc(void);
+void dlloctbf(void);
 void openrb(int nfile, char *ufile);
 void openwb(int nfile, char *ufile);
 void openab(int nfile, char *ufile);

src/crwbmg.c

@@ -9,8 +9,7 @@
  * other local filesystem notation. */
 #define MXFNLEN 200
 
-/** File pointers; each element will automatically initialize to
- * NULL */
+/** File pointers; each element will automatically initialize to NULL */
 FILE *pbf[2];
 
 /**
@@ -60,7 +59,7 @@ rbytes(char *bmg, int mxmb, int isloc, int newbytes)
  * program written in either C or Fortran. It is functionally
  * equivalent to subroutine openbf(); however, there are some
  * important differences:
-
+ *
  *  - When using openbf(), the underlying file must already be
  *    associated with a Fortran logical unit number on the local
  *    system, typicially via a prior Fortran "OPEN" statement. This is

src/restd.c

@@ -28,9 +28,9 @@ wrdesc(int desc, int *descary, int *ndescary, int mxdescary)
 {
     char errstr[129];
 
-/*
-**  Is there room in descary for desc?
-*/
+    /*
+    **  Is there room in descary for desc?
+    */
     if ( ( *ndescary + 1 ) < mxdescary ) {
         descary[(*ndescary)++] = desc;
     }
@@ -47,12 +47,12 @@ wrdesc(int desc, int *descary, int *ndescary, int mxdescary)
  * Standardize a local Table D descriptor.
  *
  * Given the bit-wise (integer) representation of a local (not
- * WMO-standard) Table D descriptor, this subroutine returns an
+ * WMO-standard) Table D descriptor, this function returns an
  * equivalent array of WMO-standard child descriptors.
  *
  * Any child descriptors which are themselves local Table D
  * descriptors are automatically resolved via a recursive call to this
- * same subroutine.  This recursive process continues until all child
+ * same function.  This recursive process continues until all child
  * descriptors are either WMO-standard descriptors (from Table B,
  * Table C, Table D, or replication descriptors) or else are local
  * Table B descriptors, in which case they are preceded with an
@@ -77,42 +77,50 @@ restd(int lun, int tddesc, int *nctddesc, int *ctddesc)
     int iscl, iref, ibit;
 
     char tab, nemo[NEMO_STR_LEN+1], adn[FXY_STR_LEN+1], cunit[UNIT_STR_LEN+1], cwork[31];
-/*
-**  How many child descriptors does tddesc have?
-*/
+
+    /*
+    **  How many child descriptors does tddesc have?
+    */
     numtbd_f(lun, tddesc, nemo, NEMO_STR_LEN+1, &tab, &itbd);
     uptdd_f(itbd, lun, 0, &inum);
 
     maxnc = igetprm_f("MAXNC");
 
     *nctddesc = 0;
-/*
-**  Examine each child descriptor one at a time.
-*/
+    /*
+    **  Examine each child descriptor one at a time.
+    */
     for ( i = 1; i <= inum; i++ ) {
         uptdd_f(itbd, lun, i, &desc);
-        if (! istdesc_f(desc)) {
-/*
-**          desc is a local descriptor.
-*/
+        if ( istdesc_f(desc) ) {
+            /*
+            **  desc is a standard Table B, Table D, operator or replicator
+            **  descriptor, so append it "as is" to the output list.
+            */
+            wrdesc(desc, ctddesc, nctddesc, maxnc);
+        }
+        else {
+            /*
+            **  desc is a local descriptor.
+            */
             numtbd_f(lun, desc, nemo, NEMO_STR_LEN+1, &tab, &ictbd);
             if ( tab == 'D' ) {
-/*
-**              desc is itself a local Table D descriptor, so resolve
-**              it now via a recursive call to this same routine.
-*/
+                /*
+                **  desc is itself a local Table D descriptor, so resolve
+                **  it now via a recursive call to this same routine.
+                */
                 if (!(cdesc = malloc(maxnc * sizeof(int)))) bort_f("RESTD FAILED ALLOCATING");
 
                 restd(lun, desc, &ncdesc, cdesc);
 
                 if ( ( *nctddesc > 0 ) &&
                      ( ctddesc[(*nctddesc)-1] >  ifxy_f(MIN_FXY_REPL) ) &&
                      ( ctddesc[(*nctddesc)-1] <= ifxy_f("101255") ) ) {
-/*
-**                  desc is replicated using fixed replication, so write
-**                  the number of child descriptors into the X value of
-**                  the replication descriptor ctddesc[(*nctddesc)-1]
-*/
+                    /*
+                    **  desc is replicated using fixed replication, so write
+                    **  the number of child descriptors into the X value of
+                    **  the replication descriptor ctddesc[(*nctddesc)-1]
+                    */
                     cadn30_f(ctddesc[(*nctddesc)-1], adn, FXY_STR_LEN+1);
                     sprintf(cwork, "%c%02d%c%c%c",
                              adn[0], ncdesc, adn[3], adn[4], adn[5]);
@@ -121,52 +129,45 @@ restd(int lun, int tddesc, int *nctddesc, int *ctddesc)
                 }
                 else if ( ( *nctddesc > 1 ) &&
                           ( ctddesc[(*nctddesc)-2] == ifxy_f(MIN_FXY_REPL) ) ) {
-/*
-**                  desc is replicated using delayed replication, so write
-**                  the number of child descriptors into the X value of
-**                  the replication descriptor ctddesc[(*nctddesc)-2]
-*/
+                    /*
+                    **  desc is replicated using delayed replication, so write
+                    **  the number of child descriptors into the X value of
+                    **  the replication descriptor ctddesc[(*nctddesc)-2]
+                    */
                     cadn30_f(ctddesc[(*nctddesc)-2], adn, FXY_STR_LEN+1);
                     sprintf(cwork, "%c%02d%c%c%c",
                              adn[0], ncdesc, adn[3], adn[4], adn[5]);
                     strncpy(adn, cwork, 6); adn[6] = '\0';
                     ctddesc[(*nctddesc)-2] = ifxy_f(adn);
                 }
-/*
-**              Add the child descriptors to the output list.
-*/
+                /*
+                **  Add the child descriptors to the output list.
+                */
                 for ( j = 0; j < ncdesc; j++ ) {
                     wrdesc(cdesc[j], ctddesc, nctddesc, maxnc);
                 }
 
                 free(cdesc);
             }
             else if ( imrkopr_f(nemo) ) {
-/*
-**              desc is a Table C marker operator, so append it "as is" to the
-**              output list.
-*/
+                /*
+                **  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
-**              a 206YYY operator in the output list.
-*/
+                /*
+                **  desc is a local Table B descriptor, so precede it with
+                **  a 206YYY operator in the output list.
+                */
                 nemtbb_f(lun, ictbd, cunit, UNIT_STR_LEN+1, &iscl, &iref, &ibit);
                 sprintf(cwork, "%c%c%c%03d", '2', '0', '6', ibit);
                 strncpy(adn, cwork, 6); adn[6] = '\0';
                 wrdesc(ifxy_f(adn), ctddesc, nctddesc, maxnc);
                 wrdesc(desc, ctddesc, nctddesc, maxnc);
             }
         }
-        else {
-/*
-**          desc is a standard Table B, Table D, operator or replicator
-**          descriptor, so append it "as is" to the output list.
-*/
-            wrdesc(desc, ctddesc, nctddesc, maxnc);
-        }
     }
 
     return;

src/rpseqs.h

@@ -0,0 +1,49 @@
+/** @file
+ *  @brief Declare variables for internal storage of replication sequences.
+ *
+ *  These variables are used within functions strrpsq() and srchrpsq() to
+ *  maintain an internal cache of replication sequences generated by function stseq().
+ *
+ *  @author J. Ator @date 2024-08-26
+ */
+
+/** Maximum number of entries in internal replication sequences cache.
+ *
+ *  Note that this value is constrained by the fact that any new rpidns value would
+ *  have been generated by a previous call to function igettdi().
+*/
+#define MAX_RPSQ 256
+
+/** @var nrpsq
+ *  Number of entries in internal replication sequences cache
+ *
+ *  @var rpidns
+ *  WMO bit-wise representation of FXY number for each entry
+ *
+ *  @var nafs
+ *  Number of associated fields in effect for each entry
+ *
+ *  @var iafpks
+ *  Associated fields in effect for each entry
+ *
+ *  @var ncdescs
+ *  Number of child descriptors for each entry
+ *
+ *  @var cdescs
+ *  Child descriptors for each entry
+ */
+#ifdef IN_ARALLOCC
+    int nrpsq;
+    int rpidns[MAX_RPSQ];
+    int nafs[MAX_RPSQ];
+    int *iafpks;
+    int ncdescs[MAX_RPSQ];
+    int *cdescs;
+#else
+    extern int nrpsq;
+    extern int rpidns[MAX_RPSQ];
+    extern int nafs[MAX_RPSQ];
+    extern int *iafpks;
+    extern int ncdescs[MAX_RPSQ];
+    extern int *cdescs;
+#endif