NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
stseq.c
Go to the documentation of this file.
1 
6 #include "bufrlib.h"
7 #include "mstabs.h"
8 
48 void stseq( f77int *lun, f77int *irepct, f77int *idn, char nemo[8],
49  char cseq[55], f77int cdesc[], f77int *ncdesc )
50 {
51  f77int i, j, nb, nd, ipt, ix, iy, iret, nbits;
52  f77int i0 = 0, imxcd, rpidn, pkint, ilen;
53 
54  char tab, adn[7], adn2[7], nemo2[9], units[10], errstr[129];
55  char rpseq[56], card[80], cblk = ' ';
56 
57 /*
58 ** The following variable is declared as automatic so that a local
59 ** private copy is created and dynamically allocated during each
60 ** recursive call to this subroutine.
61 */
62  f77int *rpdesc;
63 
64 /*
65 ** The following variables are declared as static so that they
66 ** automatically initialize to zero and remain unchanged between
67 ** recursive calls to this subroutine.
68 */
69  static f77int naf, iafpk[MXNAF];
70 
71 /*
72 ** Is *idn already listed as an entry in the internal Table D?
73 ** If so, then there's no need to proceed any further.
74 */
75  numtbd( lun, idn, nemo2, &tab, &iret, sizeof( nemo2 ), sizeof( tab ) );
76  if ( ( iret > 0 ) && ( tab == 'D' ) ) return;
77 
78 /*
79 ** Start a new Table D entry for *idn.
80 */
81  tab = 'D';
82  nd = igetntbi( lun, &tab, sizeof ( tab ) );
83  cadn30( idn, adn, sizeof( adn ) );
84  stntbi( &nd, lun, adn, nemo, cseq, sizeof( adn ), 8, 55 );
85 
86 /*
87 ** Now, go through the list of child descriptors corresponding to *idn.
88 */
89  imxcd = igetprm( "MAXCD", 5 );
90 
91  for ( i = 0; i < *ncdesc; i++ ) {
92  cadn30( &cdesc[i], adn, sizeof( adn ) );
93  if ( adn[0] == '3' ) {
94 /*
95 ** cdesc[i] is itself a Table D descriptor, so locate it within the
96 ** master table D and then store the contents within the internal
97 ** Table D via a recursive call to this same routine.
98 */
99  nummtb( &cdesc[i], &tab, &ipt );
100  if ( naf > 0 ) {
101 /*
102 ** There are associated fields in effect which will modify this
103 ** descriptor when storing it within the internal Table D. So
104 ** create a new sequence to store the contents of this descriptor
105 ** along with its associated fields.
106 */
107  rpidn = igettdi( lun );
108 
109  sprintf( rpseq, "REPLICATION SEQUENCE %.3lu",
110  ( unsigned long ) ++(*irepct) );
111  memset( &rpseq[24], (int) cblk, 31 );
112  sprintf( nemo2, "RPSEQ%.3lu", ( unsigned long ) *irepct );
113 
114  stseq( lun, irepct, &rpidn, nemo2, rpseq,
115  &MSTABS_BASE(idefxy)[icvidx(&ipt,&i0,&imxcd)],
116  &MSTABS_BASE(ndelem)[ipt] );
117  pkint = rpidn;
118 
119  }
120  else {
121 /*
122 ** Store cdesc[i] as is directly within the internal Table D.
123 */
124  stseq( lun, irepct, &cdesc[i], &MSTABS_BASE(cdmnem)[ipt][0],
125  &MSTABS_BASE(cdseq)[ipt][0],
126  &MSTABS_BASE(idefxy)[icvidx(&ipt,&i0,&imxcd)],
127  &MSTABS_BASE(ndelem)[ipt] );
128  pkint = cdesc[i];
129  }
130  }
131  else if ( adn[0] == '2' ) {
132 /*
133 ** cdesc[i] is an operator descriptor.
134 */
135  strnum( &adn[1], &ix, 2 );
136  strnum( &adn[3], &iy, 3 );
137 
138  if ( ( ( ix >= 4 ) && ( ix <= 6 ) ) || ( imrkopr( adn, 6 ) ) ) {
139 /*
140 ** This is a 204YYY, 205YYY, 206YYY operator, or else a 223255,
141 ** 224255, 225255 or 232255 marker operator. In any case,
142 ** generate a Table B mnemonic to hold the corresponding data.
143 */
144  strncpy( nemo2, adn, 6 );
145  memset( &nemo2[6], (int) cblk, 2 );
146 
147  if ( ( ix == 4 ) && ( iy == 0 ) ) {
148 /*
149 ** Cancel the most-recently added associated field.
150 */
151  if ( naf-- <= 0 ) {
152  sprintf( errstr, "BUFRLIB: STSEQ - TOO MANY ASSOCIATED"
153  " FIELD CANCELLATION OPERATORS" );
154  bort( errstr, ( f77int ) strlen( errstr ) );
155  }
156  }
157  else {
158 /*
159 ** Is nemo2 already listed as an entry within the internal
160 ** Table B?
161 */
162  nemtab( lun, nemo2, &pkint, &tab, &iret, 8, sizeof( tab ) );
163  if ( ( iret == 0 ) || ( tab != 'B' ) ) {
164 /*
165 ** No, so create and store a new Table B entry for nemo2.
166 */
167  tab = 'B';
168  nb = igetntbi( lun, &tab, sizeof( tab ) );
169 
170  if ( ix == 4 ) {
171  sprintf( rpseq, "Associated field of %3lu bits",
172  ( unsigned long ) iy );
173  nbits = iy;
174  strcpy( units, "NUMERIC" );
175  }
176  else if ( ix == 5 ) {
177  sprintf( rpseq, "Text string of %3lu bytes",
178  ( unsigned long ) iy );
179  nbits = iy*8;
180  strcpy( units, "CCITT IA5" );
181  }
182  else if ( ix == 6 ) {
183  sprintf( rpseq, "Local descriptor of %3lu bits",
184  ( unsigned long ) iy );
185  nbits = iy;
186  if ( nbits > 32 ) {
187  strcpy( units, "CCITT IA5" );
188  }
189  else {
190  strcpy( units, "NUMERIC" );
191  }
192  }
193  else { // 2-XX-255 marker operator
194  adn[6] = '\0';
195  if ( ix == 23 ) {
196  sprintf( rpseq, "Substituted value" );
197  }
198  else if ( ix == 24 ) {
199  sprintf( rpseq, "First-order statistical value" );
200  }
201  else if ( ix == 25 ) {
202  sprintf( rpseq, "Difference statistical value" );
203  }
204  else if ( ix == 32 ) {
205  sprintf( rpseq, "Replaced/retained value" );
206  }
207  /* For now, set a default bit width and units. */
208  nbits = 8;
209  strcpy( units, "NUMERIC" );
210  }
211  ilen = ( f77int ) strlen( rpseq );
212  memset( &rpseq[ilen], (int) cblk, 55 - ilen );
213 /*
214 ** Note that 49152 = 3*(2**14), so subtracting 49152 in the
215 ** following statement changes a Table D bit-wise FXY value into
216 ** a Table B bit-wise FXY value.
217 */
218  pkint = ( igettdi( lun ) - 49152 );
219  cadn30( &pkint, adn2, sizeof( adn2 ) );
220 
221  stntbi( &nb, lun, adn2, nemo2, rpseq,
222  sizeof( adn2 ), 8, 55 );
223 
224  /* Initialize card to all blanks. */
225  memset( card, (int) cblk, sizeof( card ) );
226 
227  strncpy( &card[2], nemo2, 8 );
228  strncpy( &card[16], "0", 1 );
229  strncpy( &card[30], "0", 1 );
230  sprintf( &card[33], "%4lu", ( unsigned long ) nbits );
231  strcpy( &card[40], units );
232  card[40+strlen(units)] = cblk; /* overwrite trailing null */
233  elemdx( card, lun, sizeof( card ) );
234  }
235  if ( ix == 4 ) {
236 /*
237 ** Add an associated field.
238 */
239  if ( naf >= MXNAF ) {
240  sprintf( errstr, "BUFRLIB: STSEQ - TOO MANY ASSOCIATED"
241  " FIELDS ARE IN EFFECT AT THE SAME TIME" );
242  bort( errstr, ( f77int ) strlen( errstr ) );
243  }
244  iafpk[naf++] = pkint;
245  }
246  }
247  if ( ix == 6 ) {
248 /*
249 ** Skip over the local descriptor placeholder.
250 */
251  if ( ++i >= *ncdesc ) {
252  sprintf( errstr, "BUFRLIB: STSEQ - COULD NOT FIND LOCAL"
253  " DESCRIPTOR PLACEHOLDER FOR %s", adn );
254  bort( errstr, ( f77int ) strlen( errstr ) );
255  }
256  }
257  }
258  else {
259  pkint = cdesc[i];
260  }
261  }
262  else if ( adn[0] == '1' ) {
263 /*
264 ** cdesc[i] is a replication descriptor, so create a sequence
265 ** consisting of the set of replicated descriptors and then immediately
266 ** store that sequence within the internal Table D via a recursive call
267 ** to this same routine.
268 */
269  adn[6] = '\0';
270 
271  strnum( &adn[3], &iy, 3 );
272 /*
273 ** See subroutine BFRINI and COMMON /REPTAB/ for the source of the FXY
274 ** values referenced in the following block. Note we are guaranteed
275 ** that 0 <= iy <= 255 since adn was generated using subroutine CADN30.
276 */
277  if ( iy == 0 ) { /* delayed replication */
278  if ( ( i+1 ) >= *ncdesc ) {
279  sprintf( errstr, "BUFRLIB: STSEQ - COULD NOT FIND DELAYED "
280  "DESCRIPTOR REPLICATION FACTOR FOR %s", adn );
281  bort( errstr, ( f77int ) strlen( errstr ) );
282  }
283  else if ( cdesc[i+1] == ifxy( "031002", 6 ) ) {
284  pkint = ifxy( "360001", 6 );
285  }
286  else if ( cdesc[i+1] == ifxy( "031001", 6 ) ) {
287  pkint = ifxy( "360002", 6 );
288  }
289  else if ( cdesc[i+1] == ifxy( "031000", 6 ) ) {
290  pkint = ifxy( "360004", 6 );
291  }
292  else {
293  sprintf( errstr, "BUFRLIB: STSEQ - UNKNOWN DELAYED "
294  "DESCRIPTOR REPLICATION FACTOR FOR %s", adn );
295  bort( errstr, ( f77int ) strlen( errstr ) );
296  }
297  i += 2;
298  }
299  else { /* regular replication */
300  pkint = ifxy( "101000", 6 ) + iy;
301  i++;
302  }
303 /*
304 ** Store this replication descriptor within the table D entry for
305 ** this parent.
306 */
307  pktdd( &nd, lun, &pkint, &iret );
308  if ( iret < 0 ) {
309  strncpy( nemo2, nemo, 8 );
310  nemo2[8] = '\0';
311  sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
312  "STORING REPLICATOR FOR PARENT MNEMONIC %s", nemo2 );
313  bort( errstr, ( f77int ) strlen( errstr ) );
314  }
315 
316  strnum( &adn[1], &ix, 2 );
317 /*
318 ** Note we are guaranteed that 0 < ix <= 63 since adn was generated
319 ** using subroutine CADN30.
320 */
321  if ( ix > ( *ncdesc - i ) ) {
322  sprintf( errstr, "BUFRLIB: STSEQ - NOT ENOUGH REMAINING CHILD "
323  "DESCRIPTORS TO COMPLETE REPLICATION FOR %s", adn );
324  bort( errstr, ( f77int ) strlen( errstr ) );
325  }
326  else if ( ( ix == 1 ) && ( cdesc[i] >= ifxy ( "300000", 6 ) ) ) {
327 /*
328 ** The only thing being replicated is a single Table D descriptor,
329 ** so there's no need to invent a new sequence for this replication
330 ** (this is a special case!)
331 */
332  nummtb( &cdesc[i], &tab, &ipt );
333  stseq( lun, irepct, &cdesc[i], &MSTABS_BASE(cdmnem)[ipt][0],
334  &MSTABS_BASE(cdseq)[ipt][0],
335  &MSTABS_BASE(idefxy)[icvidx(&ipt,&i0,&imxcd)],
336  &MSTABS_BASE(ndelem)[ipt] );
337  pkint = cdesc[i];
338  }
339  else {
340 /*
341 ** Store the ix descriptors to be replicated in a local list, then
342 ** get an FXY value to use with this list and generate a unique
343 ** mnemonic and description as well.
344 */
345 
346  if ( ( rpdesc = malloc( imxcd * sizeof(f77int) ) ) == NULL ) {
347  sprintf( errstr, "BUFRLIB: STSEQ - UNABLE TO ALLOCATE SPACE"
348  " FOR RPDESC" );
349  bort( errstr, ( f77int ) strlen( errstr ) );
350  }
351 
352  for ( j = 0; j < ix; j++ ) {
353  rpdesc[j] = cdesc[i+j];
354  }
355 
356  rpidn = igettdi( lun );
357 
358  sprintf( rpseq, "REPLICATION SEQUENCE %.3lu",
359  ( unsigned long ) ++(*irepct) );
360  memset( &rpseq[24], (int) cblk, 31 );
361  sprintf( nemo2, "RPSEQ%.3lu", ( unsigned long ) *irepct );
362 
363  stseq( lun, irepct, &rpidn, nemo2, rpseq, rpdesc, &ix );
364 
365  free( rpdesc );
366 
367  pkint = rpidn;
368  i += ix - 1;
369  }
370  }
371  else {
372 /*
373 ** cdesc[i] is a Table B descriptor.
374 **
375 ** Is cdesc[i] already listed as an entry in the internal Table B?
376 */
377  numtbd( lun, &cdesc[i], nemo2, &tab, &iret, sizeof( nemo2 ),
378  sizeof( tab ) );
379  if ( ( iret == 0 ) || ( tab != 'B' ) ) {
380 /*
381 ** No, so search for it within the master table B.
382 */
383  nummtb( &cdesc[i], &tab, &ipt );
384 /*
385 ** Start a new Table B entry for cdesc[i].
386 */
387  nb = igetntbi( lun, &tab, sizeof( tab ) );
388  cadn30( &cdesc[i], adn2, sizeof( adn2 ) );
389  stntbi( &nb, lun, adn2, &MSTABS_BASE(cbmnem)[ipt][0],
390  &MSTABS_BASE(cbelem)[ipt][0], sizeof( adn2 ), 8, 55 );
391 
392  /* Initialize card to all blanks. */
393  memset( card, (int) cblk, sizeof( card ) );
394 
395  strncpy( &card[2], &MSTABS_BASE(cbmnem)[ipt][0], 8 );
396  strncpy( &card[13], &MSTABS_BASE(cbscl)[ipt][0], 4 );
397  strncpy( &card[19], &MSTABS_BASE(cbsref)[ipt][0], 12 );
398  strncpy( &card[33], &MSTABS_BASE(cbbw)[ipt][0], 4 );
399  strncpy( &card[40], &MSTABS_BASE(cbunit)[ipt][0], 24 );
400  elemdx( card, lun, sizeof( card ) );
401  }
402  pkint = cdesc[i];
403  }
404  if ( strncmp( adn, "204", 3 ) != 0 ) {
405 /*
406 ** Store this child descriptor within the table D entry for this
407 ** parent, preceding it with any associated fields that are currently
408 ** in effect.
409 **
410 ** Note that associated fields are only applied to Table B descriptors,
411 ** except for those in Class 31.
412 */
413  if ( ( naf > 0 ) && ( pkint < ifxy( "100000", 6 ) ) &&
414  ( ( pkint < ifxy( "031000", 6 ) ) ||
415  ( pkint > ifxy( "031255", 6 ) ) ) ) {
416  for ( j = 0; j < naf; j++ ) {
417  pktdd( &nd, lun, &iafpk[j], &iret );
418  if ( iret < 0 ) {
419  sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD "
420  "WHEN STORING ASSOCIATED FIELDS" );
421  bort( errstr, ( f77int ) strlen( errstr ) );
422  }
423  }
424  }
425 /*
426 ** Store the child descriptor.
427 */
428  pktdd( &nd, lun, &pkint, &iret );
429  if ( iret < 0 ) {
430  strncpy( nemo2, nemo, 8 );
431  nemo2[8] = '\0';
432  sprintf( errstr, "BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
433  "STORING CHILD FOR PARENT MNEMONIC %s", nemo2 );
434  bort( errstr, ( f77int ) strlen( errstr ) );
435  }
436  }
437  }
438 }
Define signatures to enable a number of BUFRLIB subprograms to be called directly from C application ...
void stseq(f77int *lun, f77int *irepct, f77int *idn, char nemo[8], char cseq[55], f77int cdesc[], f77int *ncdesc)
Given the bit-wise (integer) representation of a WMO-standard Table D descriptor, this subroutine use...
Definition: stseq.c:48
void nummtb(f77int *idn, char *tab, f77int *ipt)
C C SUBPROGRAM: NUMMTB C PRGMMR: ATOR ORG: NP12 DATE: 2009-03-23 C C ABSTRACT: THIS ROUTINE SEARCHES ...
Definition: nummtb.c:43
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
Definition: strnum.f:23
INTEGER function igetprm(CPRMNM)
This function returns the current value of a parameter used for allocating one or more internal array...
Definition: igetprm.f:83
function igettdi(IFLAG)
DEPENDING ON THE VALUE OF THE INPUT FLAG, THIS FUNCTION EITHER RETURNS THE NEXT USABLE SCRATCH TABLE ...
Definition: igettdi.f:30
subroutine numtbd(LUN, IDN, NEMO, TAB, IRET)
This subroutine searches for a descriptor within Table B and Table D of the internal DX BUFR tables...
Definition: numtbd.f:35
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
Definition: ifxy.f:42
subroutine cadn30(IDN, ADN)
This subroutine converts an FXY value from its bit-wise (integer) representation to its 6 character r...
Definition: cadn30.f:23
function igetntbi(LUN, CTB)
This function returns the next available index for storing an entry within a specified internal DX BU...
Definition: igetntbi.f:27
subroutine pktdd(ID, LUN, IDN, IRET)
THIS SUBROUTINE STORES INFORMATION ABOUT A &quot;CHILD&quot; MNEMONIC WITHIN THE INTERNAL BUFR TABLE D ENTRY (I...
Definition: pktdd.f:54
subroutine stntbi(N, LUN, NUMB, NEMO, CELSQ)
THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR TABLE B OR D, DEPENDING ON THE VALUE OF NUMB...
Definition: stntbi.f:27
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables, based on the mnemonic associated with that descriptor.
Definition: nemtab.f:44
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
subroutine elemdx(CARD, LUN)
THIS SUBROUTINE DECODES THE SCALE FACTOR, REFERENCE VALUE, BIT WIDTH AND UNITS (I.E., THE &quot;ELEMENTS&quot;) FROM A TABLE B MNEMONIC DEFINITION CARD THAT WAS PREVIOUSLY READ FROM A USER-SUPPLIED BUFR DICTIONARY TABLE FILE IN CHARACTER FORMAT BY BUFR ARCHIVE LIBRARY SUBROUTINE RDUSDX.
Definition: elemdx.f:47
Define signatures and declare variables for internal storage of master Table B and Table D entries...
INTEGER function imrkopr(NEMO)
This function determines whether a specified mnemonic is a Table C marker operator.
Definition: imrkopr.f:21
f77int icvidx(f77int *ii, f77int *jj, f77int *numjj)
C C SUBPROGRAM: ICVIDX C PRGMMR: ATOR ORG: NP12 DATE: 2009-03-23 C C ABSTRACT: THIS ROUTINE COMPUTES ...
Definition: icvidx.c:41