var/external/bufr/stseq.c

   1 /*$$$  SUBPROGRAM DOCUMENTATION BLOCK
   2 C
   3 C SUBPROGRAM:   STSEQ
   4 C   PRGMMR: ATOR             ORG: NP12       DATE: 2009-03-23
   5 C
   6 C ABSTRACT:  USING THE BUFR MASTER TABLES, THIS ROUTINE STORES ALL
   7 C   OF THE INFORMATION FOR SEQUENCE IDN WITHIN THE INTERNAL BUFR
   8 C   TABLES B AND D.  ANY DESCRIPTORS IN IDN WHICH ARE THEMSELVES
   9 C   SEQUENCES ARE IMMEDIATELY RESOLVED VIA A RECURSIVE CALL TO THIS
  10 C   SAME ROUTINE.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 2009-03-23  J. ATOR    -- ORIGINAL AUTHOR
  14 C 2010-03-19  J. ATOR    -- ADDED PROCESSING FOR 2-04 ASSOCIATED FIELDS
  15 C 2010-04-05  J. ATOR    -- ADDED PROCESSING FOR 2-2X, 2-3X AND 2-4X
  16 C                           NON-MARKER OPERATORS
  17 C
  18 C USAGE:    CALL STSEQ( LUN, IREPCT, IDN, NEMO, CSEQ, CDESC, NCDESC )
  19 C   INPUT ARGUMENT LIST:
  20 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  21 C     IREPCT   - INTEGER: REPLICATION SEQUENCE COUNTER FOR THE CURRENT
  22 C                MASTER TABLE; USED INTERNALLY TO KEEP TRACK OF WHICH
  23 C                SEQUENCE NAMES HAVE ALREADY BEEN DEFINED AND THEREBY
  24 C                AVOID CONTENTION WITHIN THE INTERNAL BUFR TABLE D
  25 C     IDN      - INTEGER: BIT-WISE REPRESENTATION OF FXY VALUE FOR
  26 C                SEQUENCE TO BE STORED
  27 C     NEMO     - CHARACTER*8: MNEMONIC CORRESPONDING TO IDN
  28 C     CSEQ     - CHARACTER*55: DESCRIPTION CORRESPONDING TO IDN
  29 C     CDESC    - INTEGER: ARRAY OF BIT-WISE REPRESENTATIONS OF FXY
  30 C                VALUES CORRESPONDING TO DESCRIPTORS WHICH CONSTITUTE
  31 C                THE IDN SEQUENCE
  32 C     NCDESC   - INTEGER: NUMBER OF VALUES IN CDESC
  33 C
  34 C   OUTPUT ARGUMENT LIST:
  35 C     IREPCT   - INTEGER: REPLICATION SEQUENCE COUNTER FOR THE CURRENT
  36 C                MASTER TABLE; USED INTERNALLY TO KEEP TRACK OF WHICH
  37 C                SEQUENCE NAMES HAVE ALREADY BEEN DEFINED AND THEREBY
  38 C                AVOID CONTENTION WITHIN THE INTERNAL BUFR TABLE D
  39 C
  40 C REMARKS:
  41 C    THIS ROUTINE CALLS:        BORT     CADN30   ELEMDX   ICVIDX
  42 C                               IFXY     IGETNTBI IGETTDI  NEMTAB
  43 C                               NUMMTB   NUMTBD   PKTDD    STNTBI
  44 C                               STRNUM   STSEQ
  45 C    THIS ROUTINE IS CALLED BY: READS3   STSEQ
  46 C                               Normally not called by any application
  47 C                               programs.
  48 C
  49 C ATTRIBUTES:
  50 C   LANGUAGE: C
  51 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  52 C
  53 C$$$*/
  54
  55 #define COMMON_MSTABS
  56 #include "bufrlib.h"
  57
  58 void stseq( f77int *lun, f77int *irepct, f77int *idn, char nemo[8],
  59             char cseq[55], f77int cdesc[], f77int *ncdesc )
  60 {
  61     f77int i, j, nb, nd, ipt, ix, iy, iret, nbits;
  62     f77int i0 = 0, imxcd = MAXCD;
  63     f77int rpdesc[MAXCD], rpidn, pkint;
  64
  65     char tab, adn[7], adn2[7], nemo2[9], units[10], errstr[129];
  66     char rpseq[56], card[80], cblk = ' ';
  67
  68 /*
  69 **  The following variables are declared as static so that they
  70 **  automatically initialize to zero and remain unchanged between
  71 **  recursive calls to this subroutine.
  72 */
  73     static f77int naf, iafpk[MXNAF];
  74
  75 /*
  76 **  Is *idn already listed as an entry in the internal Table D?
  77 **  If so, then there's no need to proceed any further.
  78 */
  79     numtbd( lun, idn, nemo2, &tab, &iret, sizeof( nemo2 ), sizeof( tab ) );
  80     if ( ( iret > 0 ) && ( tab == 'D' ) ) return;
  81
  82 /*
  83 **  Start a new Table D entry for *idn.
  84 */
  85     tab = 'D';
  86     nd = igetntbi( lun, &tab, sizeof ( tab ) );
  87     cadn30( idn, adn, sizeof( adn ) );
  88     stntbi( &nd, lun, adn, nemo, cseq, sizeof( adn ), 8, 55 );
  89
  90 /*
  91 **  Now, go through the list of child descriptors corresponding to *idn.
  92 */
  93     for ( i = 0; i < *ncdesc; i++ ) {
  94         cadn30( &cdesc[i], adn, sizeof( adn ) );
  95         if ( adn[0] == '3' ) {
  96 /*
  97 **          cdesc[i] is itself a Table D descriptor, so search for it within the
  98 **          master table D and then, if found, immediately store it within the
  99 **          internal Table D via a recursive call to this same routine.
 100 */
 101             nummtb( &cdesc[i], &tab, &ipt );
 102             stseq( lun, irepct, &cdesc[i], &mstabs.cdmnem[ipt][0],
 103                    &mstabs.cdseq[ipt][0],
 104                    &mstabs.idefxy[icvidx(&ipt,&i0,&imxcd)],
 105                    &mstabs.ndelem[ipt] );
 106             pkint = cdesc[i];
 107         }
 108         else if ( adn[0] == '2' ) {
 109 /*
 110 **          cdesc[i] is an operator descriptor.
 111 */
 112             strnum( &adn[3], &iy, 3 );
 113
 114             if ( ( adn[1] == '0' ) &&
 115                    ( ( adn[2] >= '4' ) && ( adn[2] <= '6' ) ) ) {
 116 /*
 117 **              This is a 204YYY, 205YYY or 206YYY operator.  Using the YYY
 118 **              value, generate a Table B mnemonic to hold the corresponding
 119 **              data.
 120 */
 121                 strncpy( nemo2, "20", 2 );
 122                 strncpy( &nemo2[2], &adn[2], 1 );
 123                 strncpy( &nemo2[3], &adn[3], 3 );
 124                 memset( &nemo2[6], (int) cblk, 2 );
 125
 126                 if ( ( adn[2] == '4' ) && ( iy == 0 ) ) {
 127 /*
 128 **                  Cancel the most-recently added associated field.
 129 */
 130                     if ( naf-- <= 0 ) {
 131                         sprintf( errstr, "BUFRLIB: STSEQ - TOO MANY ASSOCIATED"
 132                             " FIELD CANCELLATION OPERATORS" );
 133                         bort( errstr, ( f77int ) strlen( errstr ) );
 134                     }
 135                 }
 136                 else {
 137 /*
 138 **                Is nemo2 already listed as an entry within the internal
 139 **                Table B?
 140 */
 141                   nemtab( lun, nemo2, &pkint, &tab, &iret, 8, sizeof( tab ) );
 142                   if ( ( iret == 0 ) || ( tab != 'B' ) ) {
 143 /*
 144 **                  No, so create and store a new Table B entry for nemo2.
 145 */
 146                     tab = 'B';
 147                     nb = igetntbi( lun, &tab, sizeof( tab ) );
 148
 149                     if ( adn[2] == '4' ) {
 150                         sprintf( rpseq, "ASSOCIATED FIELD OF %3lu BITS",
 151                              ( unsigned long ) iy );
 152                         memset( &rpseq[28], (int) cblk, 27 );
 153                         nbits = iy;
 154                         strcpy( units, "NUMERIC" );
 155                     }
 156                     else if ( adn[2] == '5' ) {
 157                         sprintf( rpseq, "TEXT STRING OF %3lu BYTES",
 158                              ( unsigned long ) iy );
 159                         memset( &rpseq[24], (int) cblk, 31 );
 160                         nbits = iy*8;
 161                         strcpy( units, "CCITT IA5" );
 162                     }
 163                     else {
 164                         sprintf( rpseq, "LOCAL DESCRIPTOR OF %3lu BITS",
 165                              ( unsigned long ) iy );
 166                         memset( &rpseq[28], (int) cblk, 27 );
 167                         nbits = iy;
 168                         if ( nbits > 32 ) {
 169                             strcpy( units, "CCITT IA5" );
 170                         }
 171                         else {
 172                             strcpy( units, "NUMERIC" );
 173                         }
 174                     }
 175 /*
 176 **                  Note that 49152 = 3*(2**14), so subtracting 49152 in the
 177 **                  following statement changes a Table D bitwise FXY value into
 178 **                  a Table B bitwise FXY value.
 179 */
 180                     pkint = ( igettdi( lun ) - 49152 );
 181                     cadn30( &pkint, adn2, sizeof( adn2 ) );
 182
 183                     stntbi( &nb, lun, adn2, nemo2, rpseq,
 184                             sizeof( adn2 ), 8, 55 );
 185
 186                     /* Initialize card to all blanks. */
 187                     memset( card, (int) cblk, sizeof( card ) );
 188
 189                     strncpy( &card[2], nemo2, 8 );
 190                     strncpy( &card[16], "0", 1 );
 191                     strncpy( &card[30], "0", 1 );
 192                     sprintf( &card[33], "%4lu", ( unsigned long ) nbits );
 193                     strncpy( &card[40], units, strlen( units ) );
 194                     elemdx( card, lun, sizeof( card ) );
 195                   }
 196                   if ( adn[2] == '4' )  {
 197 /*
 198 **                  Add an associated field.
 199 */
 200                     if ( naf >= MXNAF ) {
 201                         sprintf( errstr, "BUFRLIB: STSEQ - TOO MANY ASSOCIATED"
 202                             " FIELDS ARE IN EFFECT AT THE SAME TIME" );
 203                         bort( errstr, ( f77int ) strlen( errstr ) );
 204                     }
 205                     iafpk[naf++] = pkint;
 206                   }
 207                 }
 208                 if ( adn[2] == '6' ) {
 209 /*
 210 **                  Skip over the local descriptor placeholder.
 211 */
 212                     if ( ++i >= *ncdesc ) {
 213                         sprintf( errstr, "BUFRLIB: STSEQ - COULD NOT FIND LOCAL"
 214                             " DESCRIPTOR PLACEHOLDER FOR %s", adn );
 215                         bort( errstr, ( f77int ) strlen( errstr ) );
 216                     }
 217                 }
 218             }
 219             else if ( ( adn[1] >= '2' ) && ( adn[1] <= '4' ) ) {
 220 /*
 221 **              This is a 22XYYY, 23XYYY or 24XYYY operator.
 222 */
 223                 strnum( &adn[1], &ix, 2 );
 224                 if ( ( iy == 255 ) &&
 225                         ( ( ix == 23 ) || ( ix == 24 ) ||
 226                           ( ix == 25 ) || ( ix == 32 ) ) ) {
 227                     sprintf( errstr, "BUFRLIB: STSEQ - UNKNOWN OPERATOR"
 228                         " DESCRIPTOR %s", adn );
 229                     bort( errstr, ( f77int ) strlen( errstr ) );
 230                 }
 231                 else {
 232                     continue; /* skip to next child descriptor for *idn */
 233                 }
 234             }
 235             else { /* for any operator descriptor other than 204YYY, 205YYY,
 236                       206YYY, 22XYYY, 23XYYY or 24XYYY */
 237                 pkint = cdesc[i];
 238             }
 239         }
 240         else if ( adn[0] == '1' ) {
 241 /*
 242 **          cdesc[i] is a replication descriptor, so create a sequence
 243 **          consisting of the set of replicated descriptors and then immediately
 244 **          store that sequence within the internal Table D via a recursive call
 245 **          to this same routine.
 246 */
 247             adn[6] = '\0';
 248
 249             strnum( &adn[3], &iy, 3 );
 250 /*
 251 **          See subroutine BFRINI and COMMON /REPTAB/ for the source of the FXY
 252 **          values referenced in the following block.  Note we are guaranteed
 253 **          that 0 <= iy <= 255 since adn was generated using subroutine CADN30.
 254 */
 255             if ( iy == 0 ) {        /* delayed replication */
 256                 if ( ( i+1 ) >= *ncdesc ) {
 257                     sprintf( errstr, "BUFRLIB: STSEQ - COULD NOT FIND DELAYED "
 258                              "DESCRIPTOR REPLICATION FACTOR FOR %s", adn );
 259                     bort( errstr, ( f77int ) strlen( errstr ) );
 260                 }
 261                 else if ( cdesc[i+1] == ifxy( "031002", 6 ) ) {
 262                     pkint = ifxy( "360001", 6 );
 263                 }
 264                 else if ( cdesc[i+1] == ifxy( "031001", 6 ) ) {
 265                     pkint = ifxy( "360002", 6 );
 266                 }
 267                 else if ( cdesc[i+1] == ifxy( "031000", 6 ) ) {
 268                     pkint = ifxy( "360004", 6 );
 269                 }
 270                 else {
 271                     sprintf( errstr, "BUFRLIB: STSEQ - UNKNOWN DELAYED "
 272                              "DESCRIPTOR REPLICATION FACTOR FOR %s", adn );
 273                     bort( errstr, ( f77int ) strlen( errstr ) );
 274                 }
 275                 i += 2;
 276             }
 277             else {        /* regular replication */
 278                 pkint = ifxy( "101000", 6 ) + iy;
 279                 i++;
 280             }
 281 /*
 282 **          Store this replication descriptor within the table D entry for
 283 **          this parent.
 284 */
 285             pktdd( &nd, lun, &pkint, &iret );
 286             if ( iret < 0 ) {
 287                 strncpy( nemo2, nemo, 8 );
 288                 nemo2[8] = '\0';
 289                 sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
 290                          "STORING REPLICATOR FOR PARENT MNEMONIC %s", nemo2 );
 291                 bort( errstr, ( f77int ) strlen( errstr ) );
 292             }
 293
 294             strnum( &adn[1], &ix, 2 );
 295 /*
 296 **          Note we are guaranteed that 0 < ix <= 63 since adn was generated
 297 **          using subroutine CADN30.
 298 */
 299             if ( ix > ( *ncdesc - i ) ) {
 300                 sprintf( errstr, "BUFRLIB: STSEQ - NOT ENOUGH REMAINING CHILD "
 301                          "DESCRIPTORS TO COMPLETE REPLICATION FOR %s", adn );
 302                 bort( errstr, ( f77int ) strlen( errstr ) );
 303             }
 304             else if ( ( ix == 1 ) && ( cdesc[i] >= ifxy ( "300000", 6 ) ) ) {
 305 /*
 306 **              The only thing being replicated is a single Table D descriptor,
 307 **              so there's no need to invent a new sequence for this replication
 308 **              (this is a special case!)
 309 */
 310                 nummtb( &cdesc[i], &tab, &ipt );
 311                 stseq( lun, irepct, &cdesc[i], &mstabs.cdmnem[ipt][0],
 312                        &mstabs.cdseq[ipt][0],
 313                        &mstabs.idefxy[icvidx(&ipt,&i0,&imxcd)],
 314                        &mstabs.ndelem[ipt] );
 315                 pkint = cdesc[i];
 316             }
 317             else {
 318 /*
 319 **              Store the ix descriptors to be replicated in a local list, then
 320 **              get an FXY value to use with this list and generate a unique
 321 **              mnemonic and description as well.
 322 */
 323                 for ( j = 0; j < ix; j++ ) {
 324                     rpdesc[j] = cdesc[i+j];
 325                 }
 326
 327                 rpidn = igettdi( lun );
 328
 329                 sprintf( rpseq, "REPLICATION SEQUENCE %.3lu",
 330                          ( unsigned long ) ++(*irepct) );
 331                 memset( &rpseq[24], (int) cblk, 31 );
 332                 sprintf( nemo2, "RPSEQ%.3lu", ( unsigned long ) *irepct );
 333
 334                 stseq( lun, irepct, &rpidn, nemo2, rpseq, rpdesc, &ix );
 335
 336                 pkint = rpidn;
 337                 i += ix - 1;
 338             }
 339         }
 340         else {
 341 /*
 342 **          cdesc[i] is a Table B descriptor.
 343 **
 344 **          Is cdesc[i] already listed as an entry in the internal Table B?
 345 */
 346             numtbd( lun, &cdesc[i], nemo2, &tab, &iret, sizeof( nemo2 ),
 347                     sizeof( tab ) );
 348             if ( ( iret == 0 ) || ( tab != 'B' ) ) {
 349 /*
 350 **              No, so search for it within the master table B.
 351 */
 352                 nummtb( &cdesc[i], &tab, &ipt );
 353 /*
 354 **              Start a new Table B entry for cdesc[i].
 355 */
 356                 nb = igetntbi( lun, &tab, sizeof( tab ) );
 357                 cadn30( &cdesc[i], adn2, sizeof( adn2 ) );
 358                 stntbi( &nb, lun, adn2, &mstabs.cbmnem[ipt][0],
 359                         &mstabs.cbelem[ipt][0], sizeof( adn2 ), 8, 55 );
 360
 361                 /* Initialize card to all blanks. */
 362                 memset( card, (int) cblk, sizeof( card ) );
 363
 364                 strncpy( &card[2], &mstabs.cbmnem[ipt][0], 8 );
 365                 strncpy( &card[13], &mstabs.cbscl[ipt][0], 4 );
 366                 strncpy( &card[19], &mstabs.cbsref[ipt][0], 12 );
 367                 strncpy( &card[33], &mstabs.cbbw[ipt][0], 4 );
 368                 strncpy( &card[40], &mstabs.cbunit[ipt][0], 14 );
 369                 elemdx( card, lun, sizeof( card ) );
 370             }
 371             pkint = cdesc[i];
 372         }
 373         if ( strncmp( adn, "204", 3 ) != 0 ) {
 374 /*
 375 **          Store this child descriptor within the table D entry for this
 376 **          parent, preceding it with any associated fields that are currently
 377 **          in effect.
 378 **
 379 **          Note that associated fields are only applied to Table B descriptors,
 380 **          except for those in Class 31.
 381 */
 382             if ( ( naf > 0 ) && ( pkint < ifxy( "100000", 6 ) ) &&
 383                     ( ( pkint < ifxy( "031000", 6 ) ) ||
 384                       ( pkint > ifxy( "031255", 6 ) ) )  ) {
 385                 for ( j = 0; j < naf; j++ ) {
 386                     pktdd( &nd, lun, &iafpk[j], &iret );
 387                     if ( iret < 0 ) {
 388                       sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD "
 389                              "WHEN STORING ASSOCIATED FIELDS" );
 390                       bort( errstr, ( f77int ) strlen( errstr ) );
 391                     }
 392                 }
 393             }
 394 /*
 395 **          Store the child descriptor.
 396 */
 397             pktdd( &nd, lun, &pkint, &iret );
 398             if ( iret < 0 ) {
 399                 strncpy( nemo2, nemo, 8 );
 400                 nemo2[8] = '\0';
 401                 sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
 402                      "STORING CHILD FOR PARENT MNEMONIC %s", nemo2 );
 403                 bort( errstr, ( f77int ) strlen( errstr ) );
 404             }
 405         }
 406     }
 407 }