43 COMMON /reptab/ idnr(5,2),typs(5,2),reps(5,2),lens(5)
45 CHARACTER*128 bort_str1,bort_str2
46 CHARACTER*80 card,seqs
47 CHARACTER*12 atag,tags(250)
48 CHARACTER*8 nemo,nema,nemb
49 CHARACTER*6 adn30,clemon
75 CALL
nemtab(lun,nemo,idn,tab,iseq)
76 IF(tab.NE.
'D') goto 900
77 CALL
parstr(seqs,tags,maxtgs,ntag,
' ',.true.)
78 IF(ntag.EQ.0 ) goto 901
88 IF(atag(1:1).EQ.reps(i,1))
THEN
97 IF(atag(j:j).EQ.reps(i,2))
THEN
98 IF(j.EQ.maxtag) goto 902
109 CALL
strnum(atag(j+1:maxtag),numr)
110 IF(i.EQ.1 .AND. numr.LE.0 ) goto 903
111 IF(i.EQ.1 .AND. numr.GT.255) goto 904
112 IF(i.NE.1 .AND. numr.NE.0 ) goto 905
126 IF(iret.EQ.-1) goto 906
127 IF(iret.EQ.-2) goto 907
128 CALL
nemtab(lun,atag,idn,tab,iret)
137 IF(tab.EQ.
'B' .AND. irep.NE.0) goto 908
138 IF(atag(1:1).EQ.
'.')
THEN
148 CALL
numtab(lun,idn,nema,tab,itab)
149 CALL
nemtab(lun,nemb,jdn,tab,iret)
151 IF(nema.NE.atag) goto 909
154 IF(n.GT.ntag ) goto 910
155 IF(tab.NE.
'B') goto 911
164 IF(irep.GT.0) CALL
pktdd(iseq,lun,idnr(irep,1)+numr,iret)
165 IF(iret.LT.0) goto 913
166 CALL
pktdd(iseq,lun,idn,iret)
167 IF(iret.LT.0) goto 914
175 900
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
176 WRITE(bort_str2,
'(18X,"MNEMONIC ",A," IS NOT A TABLE D ENTRY '//
177 .
'(UNDEFINED, TAB=",A,")")') nemo,tab
178 CALL
bort2(bort_str1,bort_str2)
179 901
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
180 WRITE(bort_str2,
'(18X,"TABLE D SEQUENCE (PARENT) MNEMONIC ",A,'//
181 .
'" DOES NOT CONTAIN ANY CHILD MNEMONICS")') nemo
182 CALL
bort2(bort_str1,bort_str2)
183 902
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
184 WRITE(bort_str2,
'(18X,"TABLE D SEQUENCE (PARENT) MNEMONIC ",A,'//
185 .
'" CONTAINS A BADLY FORMED CHILD MNEMONIC",A)') nemo,tags(n)
186 CALL
bort2(bort_str1,bort_str2)
187 903
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
188 WRITE(bort_str2,
'(9X,"TBL D MNEM. ",A," CONTAINS REG. REPL. '//
189 .
'CHILD MNEM. ",A," W/ INVALID # OF REPLICATIONS (",I3,") AFTER'//
190 .
' 2ND QUOTE")') nemo,tags(n),numr
191 CALL
bort2(bort_str1,bort_str2)
192 904
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
193 WRITE(bort_str2,
'(18X,"TBL D MNEM. ",A," CONTAINS REG. REPL. '//
194 .
'CHILD MNEM. ",A," W/ # OF REPLICATIONS (",I3,") > LIMIT OF '//
195 .
'255")') nemo,tags(n),numr
196 CALL
bort2(bort_str1,bort_str2)
197 905
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
198 WRITE(bort_str2,
'(18X,"TBL D MNEM. ",A," CONTAINS DELAYED REPL.'//
199 .
' CHILD MNEM. ",A," W/ # OF REPL. (",I3,") SPECIFIED - A NO-'//
200 .
'NO")') nemo,tags(n),numr
201 CALL
bort2(bort_str1,bort_str2)
202 906
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
203 WRITE(bort_str2,
'(18X,"TABLE D (PARENT) MNEMONIC ",A," CONTAINS'//
204 .
' A CHILD MNEMONIC ",A," NOT BETWEEN 1 & 8 CHARACTERS")')
206 CALL
bort2(bort_str1,bort_str2)
207 907
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
208 WRITE(bort_str2,
'(18X,"TABLE D (PARENT) MNEMONIC ",A," CONTAINS'//
209 .
' A CHILD MNEMONIC ",A," WITH INVALID CHARACTERS")') nemo,tags(n)
210 CALL
bort2(bort_str1,bort_str2)
211 908
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
212 WRITE(bort_str2,
'(18X,"TABLE D (PARENT) MNEMONIC ",A," CONTAINS'//
213 .
' A REPLICATED CHILD TABLE B MNEMONIC ",A," - A NO-NO")')
215 CALL
bort2(bort_str1,bort_str2)
216 909
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
217 WRITE(bort_str2,
'(18X,"TBL D (PARENT) MNEM. ",A," CONTAINS AN '//
218 .
'INVALID ''FOLLOWING VALUE'' MNEMONIC ",A,"(SHOULD BE ",A,")")')
220 CALL
bort2(bort_str1,bort_str2)
221 910
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
222 WRITE(bort_str2,
'(18X,"TBL D (PARENT) MNEM. ",A," CONTAINS A '//
223 .
'''FOLLOWING VALUE'' MNEMONIC ",A," WHICH IS LAST IN THE '//
224 .
'STRING")') nemo,nema
225 CALL
bort2(bort_str1,bort_str2)
226 911
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
227 WRITE(bort_str2,
'(18X,"TBL D (PARENT) MNEM. ",A,", THE MNEM. ",'//
228 .
'A," FOLLOWING A ''FOLLOWING VALUE'' MNEM. IS NOT A TBL B '//
229 .
'ENTRY")') nemo,nemb
230 CALL
bort2(bort_str1,bort_str2)
231 912
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
232 WRITE(bort_str2,
'(18X,"TABLE D SEQUENCE (PARENT) MNEMONIC ",A,'//
233 .
'" CONTAINS A CHILD MNEMONIC ",A," NOT FOUND IN ANY TABLE")')
235 CALL
bort2(bort_str1,bort_str2)
236 913 clemon =
adn30(idnr(irep,1)+numr,6)
237 WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
238 WRITE(bort_str2,
'(9X,"TBL D (PARENT) MNEM. ",A," - BAD RETURN '//
239 .
'FROM PKTDD TRYING TO STORE REPL. DESC. ",A,", SEE PREV. '//
240 .
'WARNING MSG")') nemo,clemon
241 CALL
bort2(bort_str1,bort_str2)
242 914
WRITE(bort_str1,
'("BUFRLIB: SEQSDX - CARD READ IN IS: ",A)') card
243 WRITE(bort_str2,
'(9X,"TBL D (PARENT) MNEM. ",A," - BAD RETURN '//
244 .
'FROM PKTDD TRYING TO STORE CHILD MNEM. ",A,", SEE PREV. '//
245 .
'WARNING MSG")') nemo,tags(n)
246 CALL
bort2(bort_str1,bort_str2)
subroutine numtab(LUN, IDN, NEMO, TAB, IRET)
This subroutine returns information about a descriptor from the internal DX BUFR tables, based on the bit-wise representation of the FXY value associated with that descriptor.
subroutine seqsdx(CARD, LUN)
THIS SUBROUTINE DECODES THE TABLE D SEQUENCE INFORMATION FROM A MNEMONIC DEFINITION CARD THAT WAS PRE...
subroutine parstr(STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS...
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
function nemock(NEMO)
THIS FUNCTION CHECKS A MNEMONIC TO VERIFY THAT IT HAS A LENGTH OF BETWEEN ONE AND EIGHT CHARACTERS AN...
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
subroutine rsvfvm(NEM1, NEM2)
THIS SUBROUTINE STEPS THROUGH THE "FOLLOWING VALUE" MNEMONIC NEM1 AND, FOR EACH "." CHARACTER ENCOUNTERED (EXCEPT FOR THE INITIAL ONE), OVERWRITES IT WITH THE NEXT CORRESPONDING CHARACTER FROM NEM2 (SEE REMARKS).
character *(*) function adn30(IDN, L30)
This function converts an FXY value from its bit-wise (integer) representation to its 5 or 6 characte...
subroutine pktdd(ID, LUN, IDN, IRET)
THIS SUBROUTINE STORES INFORMATION ABOUT A "CHILD" MNEMONIC WITHIN THE INTERNAL BUFR TABLE D ENTRY (I...
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.