68 CHARACTER*128 bort_str1
69 CHARACTER*156 bort_str2
87 1
READ(lundx,
'(A80)',end=200,err=200) card
93 IF(card(1: 1).EQ.
'*') goto 1
95 IF(card(3:10).EQ.
'--------') goto 1
97 IF(card(3:10).EQ.
' ') goto 1
99 IF(card(3:10).EQ.
'MNEMONIC') goto 1
101 IF(card(3:10).EQ.
'TABLE D') goto 1
103 IF(card(3:10).EQ.
'TABLE B') goto 1
108 IF(card(12:12).EQ.
'|' .AND. card(21:21).EQ.
'|')
THEN
113 IF(iret.EQ.-1) goto 900
114 IF(iret.EQ.-2) goto 901
119 IF(nmb2(1:1).EQ.
'A') nmb2(1:1) =
'3'
121 IF(iret.EQ.-1) goto 902
122 IF(iret.EQ.-2) goto 903
123 IF(iret.EQ.-3) goto 904
124 IF(iret.EQ.-4) goto 905
129 IF(numb(1:1).EQ.
'A')
THEN
131 CALL
stntbia( n, lun, numb, nemo, card(23:) )
132 IF ( idna(n,lun,1) .EQ. 11 ) goto 906
141 IF(numb(1:1).EQ.
'0')
THEN
149 IF(numb(1:1).EQ.
'3')
THEN
162 IF(card(12:12).EQ.
'|' .AND. card(19:19).NE.
'|')
THEN
170 IF(card(12:12).EQ.
'|' .AND. card(19:19).EQ.
'|')
THEN
189 900
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
190 WRITE(bort_str2,
'(18X,"MNEMONIC ",A," IN USER DICTIONARY IS NOT'//
191 .
' BETWEEN 1 AND 8 CHARACTERS")') nemo
192 CALL
bort2(bort_str1,bort_str2)
193 901
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
194 WRITE(bort_str2,
'(18X,"MNEMONIC ",A," IN USER DICTIONARY HAS '//
195 .
'INVALID CHARACTERS")') nemo
196 CALL
bort2(bort_str1,bort_str2)
197 902
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
198 WRITE(bort_str2,
'(18X,"DESCRIPTOR NUMBER ",A," IN USER '//
199 .
'DICTIONARY HAS AN INVALID FIRST CHARACTER (F VALUE) - MUST BE'//
200 .
' A, 0 OR 3")') numb
201 CALL
bort2(bort_str1,bort_str2)
202 903
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
203 WRITE(bort_str2,
'(18X,"DESCRIPTOR NUMBER ",A," IN USER '//
204 .
'DICTIONARY HAS NON-NUMERIC VALUES IN CHARACTERS 2-6 (X AND Y '//
206 CALL
bort2(bort_str1,bort_str2)
207 904
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
208 WRITE(bort_str2,
'(18X,"DESCRIPTOR NUMBER ",A," IN USER '//
209 .
'DICTIONARY HAS INVALID NUMBER IN CHARACTERS 2-3 (X VALUE) - '//
210 .
'MUST BE BETWEEN 00 AND 63")') numb
211 CALL
bort2(bort_str1,bort_str2)
212 905
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
213 WRITE(bort_str2,
'(18X,"DESCRIPTOR NUMBER ",A," IN USER '//
214 .
'DICTIONARY HAS INVALID NUMBER IN CHARACTERS 4-6 (Y VALUE) - '//
215 .
'MUST BE BETWEEN 000 AND 255")') numb
216 CALL
bort2(bort_str1,bort_str2)
217 906
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
218 WRITE(bort_str2,
'(18X,"USER-DEFINED MESSAGE TYPE ""011"" IS '//
219 .
'RESERVED FOR DICTIONARY MESSAGES")')
220 CALL
bort2(bort_str1,bort_str2)
221 907
WRITE(bort_str1,
'("BUFRLIB: RDUSDX - CARD READ IN IS: ",A)') card
222 WRITE(bort_str2,
'(18X,"THIS CARD HAS A BAD FORMAT - IT IS NOT '//
223 .
'RECOGNIZED BY THIS SUBROUTINE")')
224 CALL
bort2(bort_str1,bort_str2)
subroutine seqsdx(CARD, LUN)
THIS SUBROUTINE DECODES THE TABLE D SEQUENCE INFORMATION FROM A MNEMONIC DEFINITION CARD THAT WAS PRE...
function numbck(NUMB)
THIS FUNCTION CHECKS THE INPUT CHARACTER STRING TO DETERMINE WHETHER IT CONTAINS A VALID FXY (DESCRIP...
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...
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
subroutine dxinit(LUN, IOI)
THIS SUBROUTINE INITIALIZES THE INTERNAL ARRAYS (IN MODULE TABABD) HOLDING THE DICTIONARY TABLE...
subroutine makestab
THIS SUBROUTINE CONSTRUCTS AN INTERNAL JUMP/LINK TABLE WITHIN MODULE TABLES, USING THE INFORMATION WI...
function igetntbi(LUN, CTB)
This function returns the next available index for storing an entry within a specified internal DX BU...
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 rdusdx(LUNDX, LUN)
THIS SUBROUTINE READS AND PARSES A FILE CONTAINING A USER- SUPPLIED BUFR DICTIONARY TABLE IN CHARACTE...
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.
subroutine stntbia(N, LUN, NUMB, NEMO, CELSQ)
THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR TABLE A.