48 void stseq( f77int *lun, f77int *irepct, f77int *idn,
char nemo[8],
49 char cseq[55], f77int cdesc[], f77int *ncdesc )
51 f77int i, j, nb, nd, ipt, ix, iy, iret, nbits;
52 f77int i0 = 0, imxcd, rpidn, pkint, ilen;
54 char tab, adn[7], adn2[7], nemo2[9], units[10], errstr[129];
55 char rpseq[56], card[80], cblk =
' ';
69 static f77int naf, iafpk[MXNAF];
75 numtbd( lun, idn, nemo2, &tab, &iret,
sizeof( nemo2 ),
sizeof( tab ) );
76 if ( ( iret > 0 ) && ( tab ==
'D' ) )
return;
82 nd =
igetntbi( lun, &tab,
sizeof ( tab ) );
83 cadn30( idn, adn,
sizeof( adn ) );
84 stntbi( &nd, lun, adn, nemo, cseq,
sizeof( adn ), 8, 55 );
91 for ( i = 0; i < *ncdesc; i++ ) {
92 cadn30( &cdesc[i], adn,
sizeof( adn ) );
93 if ( adn[0] ==
'3' ) {
99 nummtb( &cdesc[i], &tab, &ipt );
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 );
114 stseq( lun, irepct, &rpidn, nemo2, rpseq,
115 &MSTABS_BASE(idefxy)[
icvidx(&ipt,&i0,&imxcd)],
116 &MSTABS_BASE(ndelem)[ipt] );
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] );
131 else if ( adn[0] ==
'2' ) {
135 strnum( &adn[1], &ix, 2 );
136 strnum( &adn[3], &iy, 3 );
138 if ( ( ( ix >= 4 ) && ( ix <= 6 ) ) || (
imrkopr( adn, 6 ) ) ) {
144 strncpy( nemo2, adn, 6 );
145 memset( &nemo2[6], (
int) cblk, 2 );
147 if ( ( ix == 4 ) && ( iy == 0 ) ) {
152 sprintf( errstr,
"BUFRLIB: STSEQ - TOO MANY ASSOCIATED"
153 " FIELD CANCELLATION OPERATORS" );
154 bort( errstr, ( f77int ) strlen( errstr ) );
162 nemtab( lun, nemo2, &pkint, &tab, &iret, 8,
sizeof( tab ) );
163 if ( ( iret == 0 ) || ( tab !=
'B' ) ) {
168 nb =
igetntbi( lun, &tab,
sizeof( tab ) );
171 sprintf( rpseq,
"Associated field of %3lu bits",
172 (
unsigned long ) iy );
174 strcpy( units,
"NUMERIC" );
176 else if ( ix == 5 ) {
177 sprintf( rpseq,
"Text string of %3lu bytes",
178 (
unsigned long ) iy );
180 strcpy( units,
"CCITT IA5" );
182 else if ( ix == 6 ) {
183 sprintf( rpseq,
"Local descriptor of %3lu bits",
184 (
unsigned long ) iy );
187 strcpy( units,
"CCITT IA5" );
190 strcpy( units,
"NUMERIC" );
196 sprintf( rpseq,
"Substituted value" );
198 else if ( ix == 24 ) {
199 sprintf( rpseq,
"First-order statistical value" );
201 else if ( ix == 25 ) {
202 sprintf( rpseq,
"Difference statistical value" );
204 else if ( ix == 32 ) {
205 sprintf( rpseq,
"Replaced/retained value" );
209 strcpy( units,
"NUMERIC" );
211 ilen = ( f77int ) strlen( rpseq );
212 memset( &rpseq[ilen], (
int) cblk, 55 - ilen );
218 pkint = (
igettdi( lun ) - 49152 );
219 cadn30( &pkint, adn2,
sizeof( adn2 ) );
221 stntbi( &nb, lun, adn2, nemo2, rpseq,
222 sizeof( adn2 ), 8, 55 );
225 memset( card, (
int) cblk,
sizeof( card ) );
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;
233 elemdx( card, lun,
sizeof( card ) );
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 ) );
244 iafpk[naf++] = pkint;
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 ) );
262 else if ( adn[0] ==
'1' ) {
271 strnum( &adn[3], &iy, 3 );
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 ) );
283 else if ( cdesc[i+1] ==
ifxy(
"031002", 6 ) ) {
284 pkint =
ifxy(
"360001", 6 );
286 else if ( cdesc[i+1] ==
ifxy(
"031001", 6 ) ) {
287 pkint =
ifxy(
"360002", 6 );
289 else if ( cdesc[i+1] ==
ifxy(
"031000", 6 ) ) {
290 pkint =
ifxy(
"360004", 6 );
293 sprintf( errstr,
"BUFRLIB: STSEQ - UNKNOWN DELAYED "
294 "DESCRIPTOR REPLICATION FACTOR FOR %s", adn );
295 bort( errstr, ( f77int ) strlen( errstr ) );
300 pkint =
ifxy(
"101000", 6 ) + iy;
307 pktdd( &nd, lun, &pkint, &iret );
309 strncpy( nemo2, nemo, 8 );
311 sprintf( errstr,
"BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
312 "STORING REPLICATOR FOR PARENT MNEMONIC %s", nemo2 );
313 bort( errstr, ( f77int ) strlen( errstr ) );
316 strnum( &adn[1], &ix, 2 );
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 ) );
326 else if ( ( ix == 1 ) && ( cdesc[i] >=
ifxy (
"300000", 6 ) ) ) {
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] );
346 if ( ( rpdesc = malloc( imxcd *
sizeof(f77int) ) ) == NULL ) {
347 sprintf( errstr,
"BUFRLIB: STSEQ - UNABLE TO ALLOCATE SPACE"
349 bort( errstr, ( f77int ) strlen( errstr ) );
352 for ( j = 0; j < ix; j++ ) {
353 rpdesc[j] = cdesc[i+j];
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 );
363 stseq( lun, irepct, &rpidn, nemo2, rpseq, rpdesc, &ix );
377 numtbd( lun, &cdesc[i], nemo2, &tab, &iret,
sizeof( nemo2 ),
379 if ( ( iret == 0 ) || ( tab !=
'B' ) ) {
383 nummtb( &cdesc[i], &tab, &ipt );
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 );
393 memset( card, (
int) cblk,
sizeof( card ) );
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 ) );
404 if ( strncmp( adn,
"204", 3 ) != 0 ) {
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 );
419 sprintf( errstr,
"BUFRLIB: STSEQ - BAD RETURN FROM PKTDD "
420 "WHEN STORING ASSOCIATED FIELDS" );
421 bort( errstr, ( f77int ) strlen( errstr ) );
428 pktdd( &nd, lun, &pkint, &iret );
430 strncpy( nemo2, nemo, 8 );
432 sprintf( errstr,
"BUFRLIB: STSEQ - BAD RETURN FROM PKTDD WHEN "
433 "STORING CHILD FOR PARENT MNEMONIC %s", nemo2 );
434 bort( errstr, ( f77int ) strlen( errstr ) );
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...
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 ...
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
INTEGER function igetprm(CPRMNM)
This function returns the current value of a parameter used for allocating one or more internal array...
function igettdi(IFLAG)
DEPENDING ON THE VALUE OF THE INPUT FLAG, THIS FUNCTION EITHER RETURNS THE NEXT USABLE SCRATCH TABLE ...
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...
function ifxy(ADSC)
This function converts an FXY value from its 6 character representation to its bit-wise (integer) rep...
subroutine cadn30(IDN, ADN)
This subroutine converts an FXY value from its bit-wise (integer) representation to its 6 character r...
function igetntbi(LUN, CTB)
This function returns the next available index for storing an entry within a specified internal DX BU...
subroutine pktdd(ID, LUN, IDN, IRET)
THIS SUBROUTINE STORES INFORMATION ABOUT A "CHILD" MNEMONIC WITHIN THE INTERNAL BUFR TABLE D ENTRY (I...
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...
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.
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
subroutine elemdx(CARD, LUN)
THIS SUBROUTINE DECODES THE SCALE FACTOR, REFERENCE VALUE, BIT WIDTH AND UNITS (I.E., THE "ELEMENTS") 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.
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.
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 ...