24 use modv_vars,
only: bmiss, maxjl, nfiles
37 integer iprt, lunit, lundx, lun, lum, k, n, itba, inc, newn, noda, node, inod, icmpdx, ishrdx
39 character*128 bort_str, errstr
68 if(
iolun(lun)==0)
then
71 else if(
mtab(1,lun)==0)
then
77 else if(
lus(lun)>0)
then
81 if(icmpdx(
lus(lun),lun)==1)
then
87 else if(icmpdx(abs(
lus(lun)),lun)==1)
then
96 else if(
lus(lun)>0)
then
101 else if(
xtab(
lus(lun)) .and. (icmpdx(
lus(lun),lun)==0) )
then
110 do while ((lum<lun).and.(
lus(lun)==0))
111 if(ishrdx(lum,lun)==1)
then
125 if(
iomsg(lun)/=0)
then
132 inv(n,lun) =
inv(n,lun)+inc
141 nemo =
taba(itba,lun)(4:11)
143 mtab(itba,lun) = inod
146 else if(
xtab(
lus(lun)) .and. (icmpdx(
lus(lun),lun)==0) )
then
151 lunit = abs(
iolun(lun))
163 if(
typ(node)==
'SUB')
then
167 elseif(
typ(node)==
'SEQ')
then
171 elseif(
typ(node)==
'RPC')
then
175 elseif(
typ(node)==
'RPS')
then
179 elseif(
typ(node)==
'REP')
then
183 elseif(
typ(node)==
'DRS')
then
187 elseif(
typ(node)==
'DRP')
then
191 elseif(
typ(node)==
'DRB')
then
195 elseif(
typ(node)==
'NUM')
then
213 expand =
typ(n)==
'SUB' .or.
typ(n)==
'DRP' .or.
typ(n)==
'DRS' .or.
typ(n)==
'REP' .or.
typ(n)==
'DRB'
221 if(
typ(noda)==
'REP')
then
227 outer:
do while (.true.)
230 write(bort_str,
'("BUFRLIB: MAKESTAB - NUMBER OF JSEQ ENTRIES IN JUMP/LINK TABLE EXCEEDS THE LIMIT (",I6,")")') maxjl
235 inner:
do while (.true.)
236 if(
jump(node)*
knt(node)>0)
then
239 else if(
link(node)>0)
then
244 if(node==noda)
exit outer
246 write(bort_str,
'("BUFRLIB: MAKESTAB - NODE IS ZERO, FAILED TO CIRCULATE (TAG IS ",A,")")')
tag(n)
249 knt(node) = max(
knt(node)-1,0)
260 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
262 write ( unit=errstr, fmt=
'(A,I5,2X,A10,A5,6I8)' ) &
266 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
286 integer,
intent(in) :: lun
287 integer itab, idn, iret, iscl, iref, ibit, nseq
289 character*128 bort_str
296 if(
ntba(lun)==0)
call bort (
'BUFRLIB: CHEKSTAB - EMPTY TABLE A IN INTERNAL BUFR TABLES')
297 if(
ntbb(lun)==0)
call bort (
'BUFRLIB: CHEKSTAB - EMPTY TABLE B IN INTERNAL BUFR TABLES')
298 if(
ntbd(lun)==0)
call bort (
'BUFRLIB: CHEKSTAB - EMPTY TABLE D IN INTERNAL BUFR TABLES')
303 nemo =
taba(itab,lun)(4:11)
304 call nemtab(lun,nemo,idn,tab,iret)
306 write(bort_str,
'("BUFRLIB: CHEKSTAB - TABLE A ENTRY: ",A," NOT DEFINED AS A SEQUENCE")') nemo
314 call nemtbb(lun,itab,unit,iscl,iref,ibit)
335 use modv_vars,
only: mxtamc, mxtco
344 integer,
intent(in) :: lun
345 integer jmp0(10), nodl(10), ntag(10,2), icdw, icsc, icrv, incw, maxlim, node, idn, itab, nseq, limb, n, jj, iyyy, &
346 irep, iknt, jum0, iokoper
348 character*128 bort_str
349 character*8,
intent(in) :: nemo
353 logical drop(10), ltamc
355 common /tabccc/ icdw, icsc, icrv, incw
364 call nemtab(lun,nemo,idn,tab,itab)
366 write(bort_str,
'("BUFRLIB: TABSUB - SUBSET NODE NOT IN TABLE D (TAB=",A,") FOR INPUT MNEMONIC ",A)') tab,nemo
372 call inctab(nemo,
'SUB',node)
395 if(
ntamc+1>mxtamc)
call bort(
'BUFRLIB: TABSUB - MXTAMC OVERFLOW')
402 11
do n=ntag(limb,1),ntag(limb,2)
405 drop(limb) = n==ntag(limb,2)
407 call nemtab(lun,
nem(n,limb),idn,tab,itab)
412 read(nems,
'(3X,I3)') iyyy
416 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '// &
417 'CHANGE DATA WIDTH OPERATIONS IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
427 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '// &
428 'CHANGE DATA SCALE OPERATIONS IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
439 write(bort_str,
'("BUFRLIB: TABSUB - A 2-03-000 OPERATOR WAS '// &
440 'ENCOUNTERED WITHOUT ANY PRIOR 2-03-YYY OPERATOR FOR INPUT MNEMONIC ",A)') nemo
447 elseif(iyyy==255)
then
453 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '// &
454 'CHANGE REF VALUE OPERATIONS IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
462 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '// &
463 'CHANGE DATA WIDTH OPERATIONS IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
467 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TWO SIMULTANEOUS '// &
468 'CHANGE DATA SCALE OPERATIONS IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
471 icdw = ((10*iyyy)+2)/3
481 elseif((itab>=21).and.(iokoper(nems)==1))
then
487 if(
ntco(
ntamc)+1>mxtco)
call bort(
'BUFRLIB: TABSUB - MXTCO OVERFLOW')
497 call tabent(lun,nems,tab,itab,irep,iknt,jum0)
505 write(bort_str,
'("BUFRLIB: TABSUB - THERE ARE TOO MANY NESTED '// &
506 'TABLE D SEQUENCES (TREES) WITHIN INPUT MNEMONIC ",A," - THE LIMIT IS",I4)') nemo,maxlim
514 elseif(drop(limb))
then
520 write(bort_str,
'("BUFRLIB: TABSUB - A 2-07-YYY OPERATOR WAS '// &
521 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
525 write(bort_str,
'("BUFRLIB: TABSUB - A 2-01-YYY OPERATOR WAS '// &
526 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
530 write(bort_str,
'("BUFRLIB: TABSUB - A 2-02-YYY OPERATOR WAS '// &
531 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
535 write(bort_str,
'("BUFRLIB: TABSUB - A 2-08-YYY OPERATOR WAS '// &
536 'NOT CANCELLED IN THE TREE BUILT FROM INPUT MNEMONIC ",A)') nemo
540 write(bort_str,
'("BUFRLIB: TABSUB - A 2-03-YYY OPERATOR WAS '// &
541 'APPLIED WITHOUT ANY SUBSEQUENT 2-03-255 OPERATOR FOR INPUT MNEMONIC ",A)') nemo
555 if(.not.drop(limb))
exit
559 elseif(tab/=
'C')
then
565 write(bort_str,
'("BUFRLIB: TABSUB - ENTITIES WERE NOT SUCCESSFULLY RESOLVED (BY EMULATING RESURSION) FOR SUBSET '// &
566 'DEFINED BY TBL A MNEM. ",A)') nemo
585 subroutine tabent(lun,nemo,tab,itab,irep,iknt,jum0)
587 use modv_vars,
only: mxnrv, typs, reps, lens
594 integer,
intent(in) :: lun, itab, irep, iknt, jum0
595 integer icdw, icsc, icrv, incw, i, jm0, node, iscl, iref, ibit
599 character*8,
intent(in) :: nemo
600 character,
intent(in) :: tab
603 common /tabccc/ icdw, icsc, icrv, incw
610 rtag = reps(irep)//nemo
612 if(rtag(i:i)==
' ')
then
613 rtag(i:i) = reps(irep+5)
614 call inctab(rtag,typs(irep),node)
618 ibt(node) = lens(irep)
621 if(irep==1)
irf(node) = iknt
631 call nemtbb(lun,itab,unit,iscl,iref,ibit)
632 if(unit(1:5)==
'CCITT')
then
637 call inctab(nemo,typt,node)
644 if(unit(1:4)==
'CODE')
then
646 elseif(unit(1:4)==
'FLAG')
then
649 if( (typt==
'NUM') .and. (
ibtnrv/=0) )
then
651 if(
nnrv+1>mxnrv)
call bort(
'BUFRLIB: TABENT - MXNRV OVERFLOW')
658 elseif( (typt==
'NUM') .and. (nemo(1:3)/=
'204') )
then
659 ibt(node) =
ibt(node) + icdw
660 isc(node) =
isc(node) + icsc
661 irf(node) =
irf(node) * icrv
662 elseif( (typt==
'CHR') .and. (incw>0) )
then
671 call inctab(nemo,typt,node)
697 use modv_vars,
only: maxjl
703 integer,
intent(out) :: node
705 character*(*),
intent(in) :: atag, atyp
706 character*128 bort_str
710 write(bort_str,
'("BUFRLIB: INCTAB - THE NUMBER OF JUMP/LINK TABLE ENTRIES EXCEEDS THE LIMIT, MAXJL (",I7,")")') maxjl
740 integer function lstjpb(node,lun,jbtyp)
result(iret)
747 integer,
intent(in) :: node, lun
750 character*(*),
intent(in) :: jbtyp
751 character*128 bort_str
753 if(node<
inode(lun))
then
754 write(bort_str,
'("BUFRLIB: LSTJPB - TABLE NODE (",I7,") IS OUT OF BOUNDS, < LOWER BOUNDS (",I7,")")') node,
inode(lun)
758 write(bort_str,
'("BUFRLIB: LSTJPB - TABLE NODE (",I7,") IS OUT OF BOUNDS, > UPPER BOUNDS (",I7,")")') node,
isc(
inode(lun))
767 if(
typ(nod)==jbtyp)
exit
786 integer function ishrdx(lud,lun)
result(iret)
792 integer,
intent(in) :: lud, lun
799 if ( (
ntba(lud) >= 1 ) .and. (
ntba(lud) ==
ntba(lun) ) )
then
802 do while ( ( ii <=
ntba(lud) ) .and. ( iret == 1 ) )
803 if ( (
mtab(ii,lud) /= 0 ) .and. (
mtab(ii,lud) ==
mtab(ii,lun) ) )
then
831 integer function icmpdx(lud,lun)
result(iret)
837 integer,
intent(in) :: lud, lun
844 if ( iret == 1 )
return
848 if ( (
ntba(lud) == 0 ) .or. (
ntba(lun) /=
ntba(lud) ) )
return
850 if (
idna(i,lun,1) /=
idna(i,lud,1) )
return
851 if (
idna(i,lun,2) /=
idna(i,lud,2) )
return
852 if (
taba(i,lun) /=
taba(i,lud) )
return
855 if ( (
ntbb(lud) == 0 ) .or. (
ntbb(lun) /=
ntbb(lud) ) )
return
857 if (
idnb(i,lun) /=
idnb(i,lud) )
return
858 if (
tabb(i,lun) /=
tabb(i,lud) )
return
861 if ( (
ntbd(lud) == 0 ) .or. (
ntbd(lun) /=
ntbd(lud) ) )
return
863 if (
idnd(i,lun) /=
idnd(i,lud) )
return
864 if (
tabd(i,lun) /=
tabd(i,lud) )
return
897 subroutine drstpl(inod,lun,inv1,inv2,invn)
903 integer,
intent(in) :: inod, lun, inv1
904 integer,
intent(inout) :: inv2
905 integer,
intent(out) :: invn
913 if(
typ(node)==
'DRS' .or.
typ(node)==
'DRB')
then
914 invn = invwin(node,lun,inv1,inv2)
917 call newwin(lun,inv1,inv2)
918 invn = invwin(inod,lun,invn,inv2)
961 recursive subroutine nemspecs ( lunit, nemo, nnemo, nscl, nref, nbts, iret )
963 use modv_vars,
only: im8b
972 integer,
intent(in) :: lunit, nnemo
973 integer,
intent(out) :: nscl, nref, nbts, iret
974 integer my_lunit, my_nnemo, lun, il, im, nidx, ierfst, node, ltn, jj
976 character*(*),
intent(in) :: nemo
984 call x84(lunit,my_lunit,1)
985 call x84(nnemo,my_nnemo,1)
986 call nemspecs(my_lunit,nemo,my_nnemo,nscl,nref,nbts,iret)
987 call x48(nscl,nscl,1)
988 call x48(nref,nref,1)
989 call x48(nbts,nbts,1)
990 call x48(iret,iret,1)
1000 call status( lunit, lun, il, im )
1001 if ( il == 0 )
return
1002 if (
inode(lun) /=
inv(1,lun) )
return
1006 call fstag( lun, nemo, nnemo, 1, nidx, ierfst )
1007 if ( ierfst /= 0 )
return
1011 node =
inv(nidx,lun)
1012 if ( (
typ(node) /=
'NUM' ) .and. (
typ(node) /=
'CHR' ) )
return
1023 if (
nnrv > 0 )
then
1029 call strsuc( nemo, tagn, ltn )
1030 if ( ( ltn <= 0 ) .or. ( ltn > 8 ) )
return
1033 if ( ( node /=
inodnrv(jj) ) .and. ( tagn(1:8) ==
tagnrv(jj) ) .and. &
1034 ( node >=
isnrv(jj) ) .and. ( node <=
ienrv(jj) ) )
then
1064 subroutine fstag ( lun, utag, nutag, nin, nout, iret )
1071 integer,
intent(in) :: lun, nutag, nin
1072 integer,
intent(out) :: nout, iret
1073 integer,
parameter :: maxtg = 15
1074 integer ntg, istep, itagct
1076 character*(*),
intent(in) :: utag
1077 character*10 tgs(maxtg)
1083 call parstr( utag, tgs, maxtg, ntg,
' ', .true. )
1084 if ( ntg /= 1 )
return
1088 if ( nutag == 0 )
return
1089 istep = isign( 1, nutag )
1092 do while ( ( nout >= 1 ) .and. ( nout <=
nval(lun) ) )
1093 if ( tgs(1) ==
tag(
inv(nout,lun)) )
then
1095 if ( itagct == iabs(nutag) )
then
1104 end subroutine fstag
1125 recursive subroutine gettagpr ( lunit, tagch, ntagch, tagpr, iret )
1127 use modv_vars,
only: im8b
1135 integer,
intent(in) :: lunit, ntagch
1136 integer,
intent(out) :: iret
1137 integer my_lunit, my_ntagch, lun, il, im, nch
1139 character*(*),
intent(in) :: tagch
1140 character*(*),
intent(out) :: tagpr
1147 call x84 ( lunit, my_lunit, 1 )
1148 call x84 ( ntagch, my_ntagch, 1 )
1149 call gettagpr ( my_lunit, tagch, my_ntagch, tagpr, iret )
1150 call x48 ( iret, iret, 1 )
1160 call status( lunit, lun, il, im )
1161 if ( il == 0 )
return
1162 if (
inode(lun) /=
inv(1,lun) )
return
1166 call fstag( lun, tagch, ntagch, 1, nch, iret )
1167 if ( iret /= 0 )
return
1190 integer function invtag(node,lun,inv1,inv2)
result(iret)
1197 integer,
intent(in) :: node, lun, inv1, inv2
1208 if(
tag(
inv(iret,lun))==tagn)
return
1215 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1216 call errwrt(
'BUFRLIB: INVTAG - RETURNING WITH A VALUE OF 0')
1217 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1238 integer function invwin(node,lun,inv1,inv2)
result(iret)
1244 integer,
intent(in) :: node, lun, inv1, inv2
1255 if(
inv(idx,lun)==node)
then
1263 write(errstr,
'(a,3i8)')
'invwin i1,i2,in ', inv1, inv2, iret
1319 integer,
intent(in) :: node, lun
1320 integer,
intent(out) :: iwin, jwin
1321 integer irpc, lstjpb, invwin
1323 character*128 bort_str
1325 irpc = lstjpb(node,lun,
'RPC')
1328 iwin = invwin(node,lun,jwin,
nval(lun))
1329 if(iwin==0 .and. jwin>1)
return
1334 iwin = invwin(irpc,lun,jwin,
nval(lun))
1336 if(
val(iwin,lun)==0.)
then
1342 jwin = invwin(irpc,lun,iwin+1,
nval(lun))
1344 write(bort_str,
'("BUFRLIB: GETWIN - SEARCHED BETWEEN",I5," AND",I5,", MISSING BRACKET")') iwin+1,
nval(lun)
1388 integer,
intent(in) :: lun
1389 integer,
intent(out) :: inc1, inc2
1390 integer nnod, ncon, nods, nodc, ivls, kons, nc, invcon
1392 common /usrstr/ nnod, ncon, nods(20), nodc(10), ivls(10), kons(10)
1401 outer:
do while (.true.)
1402 call getwin(nodc(1),lun,inc1,inc2)
1405 if(invcon(nc,lun,inc1,inc2)==0) cycle outer
1440 integer function invcon(nc,lun,inv1,inv2)
result(iret)
1446 integer,
intent(in) :: nc, lun, inv1, inv2
1447 integer nnod, ncon, nods, nodc, ivls, kons, iprt
1449 common /usrstr/ nnod, ncon, nods(20), nodc(10), ivls(10), kons(10)
1452 if(inv1>0 .and. inv1<=
nval(lun) .and. inv2>0 .and. inv2<=
nval(lun))
then
1454 if(
inv(iret,lun)==nodc(nc))
then
1455 if(kons(nc)==1 .and.
val(iret,lun)==ivls(nc))
return
1456 if(kons(nc)==2 .and.
val(iret,lun)/=ivls(nc))
return
1457 if(kons(nc)==3 .and.
val(iret,lun)<ivls(nc))
return
1458 if(kons(nc)==4 .and.
val(iret,lun)>ivls(nc))
return
1465 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1466 call errwrt(
'BUFRLIB: INVCON - RETURNING WITH A VALUE OF 0')
1467 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1496 integer,
intent(in) :: lun, iwin
1497 integer,
intent(out) :: jwin
1498 integer node, lstjpb
1500 character*128 bort_str
1509 node =
inv(iwin,lun)
1510 if(lstjpb(node,lun,
'RPC')/=node)
then
1511 write(bort_str,
'("BUFRLIB: NEWWIN - LSTJPB FOR NODE",I6,'// &
1512 '" (LSTJPB=",I5,") DOES NOT EQUAL VALUE OF NODE, NOT RPC (IWIN =",I8,")")') node, lstjpb(node,lun,
'RPC'), iwin
1515 jwin = iwin+nint(
val(iwin,lun))
1544 integer,
intent(in) :: lun
1545 integer,
intent(inout) :: iwin, jwin
1546 integer node, lstjpb
1548 character*128 bort_str
1550 if(jwin==
nval(lun))
then
1555 node =
inv(iwin,lun)
1556 if(lstjpb(node,lun,
'RPC')/=node)
then
1557 write(bort_str,
'("BUFRLIB: NXTWIN - LSTJPB FOR NODE",I6," '// &
1558 '(LSTJPB=",I5,") DOES NOT EQUAL VALUE OF NODE, NOT RPC (IWIN =",I8,")")') node, lstjpb(node,lun,
'RPC'), iwin
1561 if(
val(jwin,lun)==0)
then
1565 jwin = iwin+nint(
val(iwin,lun))
1588 integer function nvnwin(node,lun,inv1,inv2,invn,nmax)
result(iret)
1594 integer,
intent(in) :: node, lun, inv1, inv2, nmax
1595 integer,
intent(out) :: invn(*)
1598 character*128 bort_str
1606 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
1607 call errwrt(
'BUFRLIB: NVNWIN - NODE=0, IMMEDIATE RETURN')
1608 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
1621 if(
inv(n,lun)==node)
then
1622 if(iret+1>nmax)
then
1623 write(bort_str,
'("BUFRLIB: NVNWIN - THE NUMBER OF EVENTS EXCEEDS THE LIMIT NMAX (",I5,")")') nmax
subroutine bort(str)
Log an error message, then abort the application program.
subroutine cpbfdx(lud, lun)
Copy all of the DX BUFR table information from one unit to another within internal memory.
subroutine nemtbb(lun, itab, unit, iscl, iref, ibit)
Get information about a Table B descriptor from the internal DX BUFR tables.
recursive subroutine wrdxtb(lundx, lunot)
Generate one or more BUFR messages from the DX BUFR tables information associated with a given BUFR f...
subroutine nemtbd(lun, itab, nseq, nems, irps, knts)
Get information about a Table D descriptor from the internal DX BUFR tables.
subroutine errwrt(str)
Specify a custom location for the logging of error and diagnostic messages generated by the NCEPLIBS-...
subroutine nemtab(lun, nemo, idn, tab, iret)
Get information about a descriptor, based on a mnemonic.
subroutine fstag(lun, utag, nutag, nin, nout, iret)
Search for a specified occurrence of a specified mnemonic within a data subset definition,...
subroutine drstpl(inod, lun, inv1, inv2, invn)
Search for a specified mnemonic within unexpanded sequences of the internal jump/link table.
integer function nvnwin(node, lun, inv1, inv2, invn, nmax)
Search for all occurrences of a specified node within a specified portion of the current data subset.
integer function invcon(nc, lun, inv1, inv2)
Search a specified window for a conditional node.
integer function lstjpb(node, lun, jbtyp)
Search backwards, beginning from a given node within the jump/link table, until finding the most rece...
subroutine inctab(atag, atyp, node)
Get the next available positional index for writing into the internal jump/link table in module moda_...
subroutine tabent(lun, nemo, tab, itab, irep, iknt, jum0)
Build and store an entry for a Table B or Table D mnemonic within the internal jump/link table.
recursive subroutine nemspecs(lunit, nemo, nnemo, nscl, nref, nbts, iret)
Get the scale factor, reference value and bit width associated with a specified occurrence of a Table...
integer function invtag(node, lun, inv1, inv2)
Search for a specified mnemonic within a specified portion of the current data subset.
subroutine nxtwin(lun, iwin, jwin)
Compute the start and end indices of the next window.
integer function icmpdx(lud, lun)
Check whether the full set of associated DX BUFR Table information is identical between two Fortran l...
subroutine newwin(lun, iwin, jwin)
Compute the ending index of the window.
integer function invwin(node, lun, inv1, inv2)
Search for a specified node within a specified portion of the current data subset.
subroutine conwin(lun, inc1, inc2)
Search consecutive subset buffer segments for a conditional node.
subroutine chekstab(lun)
Check that an internal BUFR table representation is self-consistent and fully defined.
subroutine makestab
Build the entire internal jump/link table within module moda_tables, using all of the internal BUFR t...
subroutine getwin(node, lun, iwin, jwin)
Look for a window containing a specified node within the internal jump/link table.
integer function ishrdx(lud, lun)
Check whether the same DX BUFR Table is being shared between two Fortran logical units.
subroutine tabsub(lun, nemo)
Build and store the entire jump/link tree (including recursively resolving all "child" mnemonics) for...
recursive subroutine gettagpr(lunit, tagch, ntagch, tagpr, iret)
Get the parent for a specified occurrence of a Table B or Table D mnemonic within a data subset defin...
subroutine strsuc(str1, str2, lens)
Remove leading and trailing blanks from a character string.
Declare arrays and variables used to store bitmaps internally within a data subset definition.
integer, dimension(:,:), allocatable inodtco
Entries within jump/link table which contain Table C operators.
integer ntamc
Number of Table A mnemonics in jump/link table (up to a maximum of mxtamc) which contain at least one...
integer, dimension(:), allocatable inodtamc
Entries within jump/link table which contain Table A mnemonics.
character *6, dimension(:,:), allocatable ctco
Table C operators corresponding to inodtco.
integer, dimension(:), allocatable ntco
Number of Table C operators (with an XX value of 21 or greater) within the data subset definition of ...
Declare an array used by subroutine makestab() to keep track of which logical units share DX BUFR tab...
integer, dimension(:), allocatable lus
Tracking index for each file ID.
Declare arrays used to store information about the current BUFR message that is in the process of bei...
integer, dimension(:), allocatable inode
Table A mnemonic for type of BUFR message.
Declare arrays used by various subroutines to hold information about Table D sequences.
integer, dimension(:,:), allocatable krp
Replication counts corresponding to nem:
integer, dimension(:,:), allocatable irp
Replication indicators corresponding to nem:
character *8, dimension(:,:), allocatable nem
Child mnemonics within Table D sequences.
Declare arrays and variables for use with any 2-03-YYY (change reference value) operators present wit...
integer, dimension(:), allocatable ienrv
End of entry range in jump/link table, within which the corresponding new reference value in nrv will...
character *8, dimension(:), allocatable tagnrv
Table B mnemonic to which the corresponding new reference value in nrv applies.
integer, dimension(:), allocatable isnrv
Start of entry range in jump/link table, within which the corresponding new reference value in nrv wi...
integer nnrv
Number of entries in the jump/link table which contain new reference values (up to a maximum of mxnrv...
integer *8, dimension(:), allocatable nrv
New reference values corresponding to inodnrv.
integer ipfnrv
A number between 1 and nnrv, denoting the first entry within the module arrays which applies to the c...
integer, dimension(:), allocatable inodnrv
Entries within jump/link table which contain new reference values.
integer ibtnrv
Number of bits in Section 4 occupied by each new reference value for the current 2-03-YYY operator in...
Declare arrays used to store file and message status indicators for all logical units that have been ...
integer, dimension(:), allocatable iolun
File status indicators.
integer, dimension(:), allocatable iomsg
Message status indicator corresponding to iolun, denoting whether a BUFR message is currently open wi...
Declare arrays and variables used to store DX BUFR tables internally for multiple file IDs.
integer, dimension(:), allocatable ntba
Number of Table A entries for each file ID (up to a maximum of maxtba, whose value is stored in array...
character *600, dimension(:,:), allocatable tabd
Table D entries for each file ID.
character *128, dimension(:,:), allocatable taba
Table A entries for each file ID.
integer, dimension(:,:), allocatable mtab
Entries within jump/link table corresponding to taba.
integer, dimension(:,:,:), allocatable idna
Message types (in array element 1) and subtypes (in array element 2) corresponding to taba.
integer, dimension(:), allocatable ntbd
Number of Table D entries for each file ID (up to a maximum of maxtbd, whose value is stored in array...
integer, dimension(:), allocatable ntbb
Number of Table B entries for each file ID (up to a maximum of maxtbb, whose value is stored in array...
integer, dimension(:,:), allocatable idnd
WMO bit-wise representations of the FXY values corresponding to tabd.
integer, dimension(:,:), allocatable idnb
WMO bit-wise representations of the FXY values corresponding to tabb.
character *128, dimension(:,:), allocatable tabb
Table B entries for each file ID.
Declare arrays and variables used to store the internal jump/link table.
integer, dimension(:), allocatable jseq
Temporary storage used in expanding sequences.
integer, dimension(:), allocatable irf
Reference values corresponding to tag and typ:
integer, dimension(:,:), allocatable iseq
Temporary storage used in expanding sequences.
integer, dimension(:), allocatable isc
Scale factors corresponding to tag and typ:
integer, dimension(:), allocatable ibt
Bit widths corresponding to tag and typ:
integer, dimension(:), allocatable knt
Temporary storage used in calculating delayed replication counts.
real *8, dimension(:), allocatable vali
Initialized data values corresponding to typ:
character *3, dimension(:), allocatable typ
Type indicators corresponding to tag:
integer, dimension(:), allocatable jmpb
Jump backward indices corresponding to tag and typ:
character *10, dimension(:), allocatable tag
Mnemonics in the jump/link table.
integer ntab
Number of entries in the jump/link table.
integer, dimension(:), allocatable jump
Jump forward indices corresponding to tag and typ:
integer, dimension(:), allocatable itp
Integer type values corresponding to typ:
integer, dimension(:), allocatable link
Link indices corresponding to tag, typ and jmpb:
integer, dimension(:), allocatable knti
Initialized replication counts corresponding to typ and jump:
Declare arrays used to store data values and associated metadata for the current BUFR data subset in ...
integer, dimension(:), allocatable nval
Number of data values in BUFR data subset.
real *8, dimension(:,:), allocatable, target val
Data values.
integer, dimension(:,:), allocatable, target inv
Inventory pointer which links each data value to its corresponding node in the internal jump/link tab...
Declare an array used to track, for each file ID, whether the DX BUFR table associated with the corre...
logical, dimension(:), allocatable xtab
Tracking index for each file ID.
recursive subroutine status(lunit, lun, il, im)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
recursive subroutine closmg(lunin)
Close the BUFR message that is currently open for writing within internal arrays associated with logi...
subroutine usrtpl(lun, invn, nbmp)
Expand a subset template within internal arrays.
subroutine strcln
Reset the internal mnemonic string cache.
subroutine parstr(str, tags, mtag, ntag, sep, limit80)
Parse a string containing one or more substrings into an array of substrings.
subroutine x48(iin4, iout8, nval)
Encode one or more 4-byte integer values as 8-byte integer values.
subroutine x84(iin8, iout4, nval)
Encode one or more 8-byte integer values as 4-byte integer values.