88 CHARACTER*128 bort_str,errstr
128 IF(iolun(lun).EQ.0)
THEN
133 ELSE IF(mtab(1,lun).EQ.0)
THEN
139 IF(lus(lun).NE.0)
THEN
140 IF(iolun(abs(lus(lun))).EQ.0)
THEN
142 ELSE IF(lus(lun).GT.0)
THEN
151 IF(
icmpdx(lus(lun),lun).EQ.1)
THEN
155 lus(lun) = (-1)*lus(lun)
157 ELSE IF(
icmpdx(abs(lus(lun)),lun).EQ.1)
THEN
167 lus(lun) = abs(lus(lun))
171 ELSE IF(lus(lun).GT.0)
THEN
177 IF(iolun(lus(lun)).EQ.0)
THEN
179 ELSE IF( xtab(lus(lun)) .AND.
180 + (
icmpdx(lus(lun),lun).EQ.0) )
THEN
189 IF(iolun(lun).LT.0) lus(lun) = (-1)*lus(lun)
197 DO WHILE ((lum.LT.lun).AND.(lus(lun).EQ.0))
198 IF(
ishrdx(lum,lun).EQ.1)
THEN
212 IF(iolun(lun).NE.0 .AND. ntba(lun).GT.0)
THEN
216 IF(iomsg(lun).NE.0)
THEN
217 IF(lus(lun).EQ.0)
THEN
218 inc = (ntab+1)-mtab(1,lun)
220 inc = mtab(1,lus(lun))-mtab(1,lun)
223 inv(n,lun) = inv(n,lun)+inc
227 IF(lus(lun).LE.0)
THEN
236 nemo = taba(itba,lun)(4:11)
238 mtab(itba,lun) = inod
241 ELSE IF( xtab(lus(lun)) .AND.
242 + (
icmpdx(lus(lun),lun).EQ.0) )
THEN
252 lunit = abs(iolun(lun))
253 IF(iomsg(lun).NE.0) CALL
closmg(lunit)
255 lundx = abs(iolun(lus(lun)))
267 IF(typ(node).EQ.
'SUB')
THEN
271 ELSEIF(typ(node).EQ.
'SEQ')
THEN
275 ELSEIF(typ(node).EQ.
'RPC')
THEN
279 ELSEIF(typ(node).EQ.
'RPS')
THEN
283 ELSEIF(typ(node).EQ.
'REP')
THEN
285 knti(node) = irf(node)
287 ELSEIF(typ(node).EQ.
'DRS')
THEN
291 ELSEIF(typ(node).EQ.
'DRP')
THEN
295 ELSEIF(typ(node).EQ.
'DRB')
THEN
299 ELSEIF(typ(node).EQ.
'NUM')
THEN
303 ELSEIF(typ(node).EQ.
'CHR')
THEN
320 expand = typ(n).EQ.
'SUB' .OR. typ(n).EQ.
'DRP' .OR. typ(n).EQ.
'DRS'
321 . .OR. typ(n).EQ.
'REP' .OR. typ(n).EQ.
'DRB'
329 IF(typ(noda).EQ.
'REP') knt(node) = knti(noda)
330 IF(typ(noda).NE.
'REP') knt(node) = 1
333 IF(newn.GT.maxjl) goto 902
335 knt(node) = max(knti(node),knt(node))
336 2
IF(jump(node)*knt(node).GT.0)
THEN
339 ELSE IF(link(node).GT.0)
THEN
344 IF(node.EQ.noda) goto 3
345 IF(node.EQ.0 ) goto 903
346 knt(node) = max(knt(node)-1,0)
357 CALL
errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
359 WRITE ( unit=errstr, fmt=
'(A,I5,2X,A10,A5,6I8)' )
360 .
'BUFRLIB: MAKESTAB ', i, tag(i), typ(i), jmpb(i), jump(i),
361 . link(i), ibt(i), irf(i), isc(i)
364 CALL
errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
372 900
WRITE(bort_str,
'("BUFRLIB: MAKESTAB - MNEMONIC ",A," IS '//
373 .
'DUPLICATED IN SUBSET: ",A)') nemo,tag(n1)
375 901
WRITE(bort_str,
'("BUFRLIB: MAKESTAB - UNKNOWN TYPE ",A)')typ(node)
377 902
WRITE(bort_str,
'("BUFRLIB: MAKESTAB - NUMBER OF JSEQ ENTRIES IN'//
378 .
' JUMP/LINK TABLE EXCEEDS THE LIMIT (",I6,")")') maxjl
380 903
WRITE(bort_str,
'("BUFRLIB: MAKESTAB - NODE IS ZERO, FAILED TO '//
381 .
'CIRCULATE (TAG IS ",A,")")') tag(n)
subroutine cpbfdx(LUD, LUN)
THIS SUBROUTINE COPIES BUFR TABLE (DICTIONARY) MESSAGES FROM ONE LOCATION TO ANOTHER WITHIN INTERNAL ...
This module contains array and variable declarations for use with any 2-03-YYY (change reference valu...
This module contains array and variable declarations used to store bitmaps internally within a data s...
subroutine strcln
THIS SUBROUTINE RESETS THE MNEMONIC STRING CACHE IN THE BUFR INTERFACE (ARRAYS IN COMMON BLOCK /STCAC...
This module declares and initializes the BMISS variable.
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
This module contains array and variable declarations used to store the internal jump/link table...
INTEGER function ishrdx(LUD, LUN)
This function determines whether the same DX BUFR Table is being shared between two Fortran logical u...
subroutine chekstab(LUN)
THIS SUBROUTINE CHECKS THAT AN INTERNAL BUFR TABLE REPRESENTATION IS SELF-CONSISTENT AND FULLY DEFINE...
subroutine makestab
THIS SUBROUTINE CONSTRUCTS AN INTERNAL JUMP/LINK TABLE WITHIN MODULE TABLES, USING THE INFORMATION WI...
subroutine wrdxtb(LUNDX, LUNOT)
THIS SUBROUTINE WRITES BUFR TABLE (DICTIONARY) MESSAGES ASSOCIATED WITH THE BUFR FILE IN LUNDX TO THE...
subroutine closmg(LUNIN)
This subroutine closes the BUFR message that is currently open for writing within internal arrays ass...
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
subroutine tabsub(LUN, NEMO)
THIS SUBROUTINE BUILDS THE ENTIRE JUMP/LINK TREE (I.E., INCLUDING RECURSIVELY RESOLVING ALL "CHILD" M...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
INTEGER function icmpdx(LUD, LUN)
This function determines whether the full set of associated DX BUFR Table information is identical be...