NCEPLIBS-bufr 11.7.1
stseq.c
Go to the documentation of this file.
1
6#include "bufrlib.h"
7#include "mstabs.h"
8
48void 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}
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23
Define signatures to enable a number of BUFRLIB subprograms to be called directly from C application ...
subroutine cadn30(IDN, ADN)
This subroutine converts an FXY value from its bit-wise (integer) representation to its 6 character r...
Definition: cadn30.f:24
subroutine elemdx(CARD, LUN)
THIS SUBROUTINE DECODES THE SCALE FACTOR, REFERENCE VALUE, BIT WIDTH AND UNITS (I....
Definition: elemdx.f:48
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
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
Definition: ifxy.f:43
function igetntbi(LUN, CTB)
This function returns the next available index for storing an entry within a specified internal DX BU...
Definition: igetntbi.f:28
integer function igetprm(CPRMNM)
This function returns the current value of a parameter used for allocating one or more internal array...
Definition: igetprm.f:84
function igettdi(IFLAG)
DEPENDING ON THE VALUE OF THE INPUT FLAG, THIS FUNCTION EITHER RETURNS THE NEXT USABLE SCRATCH TABLE ...
Definition: igettdi.f:31
integer function imrkopr(NEMO)
This function determines whether a specified mnemonic is a Table C marker operator.
Definition: imrkopr.f:22
Define signatures and declare variables for internal storage of master Table B and Table D entries.
integer, dimension(:), allocatable ndelem
Numbers of child descriptors corresponding to idfxyn.
Definition: moda_mstabs.F:72
character, dimension(:,:), allocatable cdseq
Sequence names corresponding to idfxyn.
Definition: moda_mstabs.F:70
integer, dimension(:), allocatable idefxy
Bit-wise representations of child descriptors corresponding to idfxyn.
Definition: moda_mstabs.F:73
character, dimension(:,:), allocatable cbscl
Scale factors corresponding to ibfxyn.
Definition: moda_mstabs.F:63
character, dimension(:,:), allocatable cbmnem
Mnemonics corresponding to ibfxyn.
Definition: moda_mstabs.F:67
character, dimension(:,:), allocatable cbsref
Reference values corresponding to ibfxyn.
Definition: moda_mstabs.F:64
character, dimension(:,:), allocatable cbelem
Element names corresponding to ibfxyn.
Definition: moda_mstabs.F:68
character, dimension(:,:), allocatable cbunit
Units corresponding to ibfxyn.
Definition: moda_mstabs.F:66
character, dimension(:,:), allocatable cdmnem
Mnemonics corresponding to idfxyn.
Definition: moda_mstabs.F:71
character, dimension(:,:), allocatable cbbw
Bit widths corresponding to ibfxyn.
Definition: moda_mstabs.F:65
subroutine nemtab(LUN, NEMO, IDN, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables,...
Definition: nemtab.f:45
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 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:36
subroutine pktdd(ID, LUN, IDN, IRET)
THIS SUBROUTINE STORES INFORMATION ABOUT A "CHILD" MNEMONIC WITHIN THE INTERNAL BUFR TABLE D ENTRY (I...
Definition: pktdd.f:55
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:28
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
Definition: strnum.f:24
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