31 recursive subroutine readsb(lunit,iret)
33 use modv_vars,
only: im8b
43 integer,
intent(in) :: lunit
44 integer,
intent(out) :: iret
45 integer my_lunit, lun, il, im, ier, nbyt
52 call x84(lunit,my_lunit,1)
64 call status(lunit,lun,il,im)
65 if(il==0)
call bort(
'BUFRLIB: READSB - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
66 if(il>0)
call bort(
'BUFRLIB: READSB - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
88 elseif(
msgunp(lun)==1)
then
116 recursive integer function ireadsb(lunit)
result(iret)
118 use modv_vars,
only: im8b
122 integer,
intent(in) :: lunit
130 call x84(lunit,my_lunit,1)
167 recursive subroutine readns(lunit,subset,jdate,iret)
169 use modv_vars,
only: im8b
176 integer,
intent(in) :: lunit
177 integer,
intent(out) :: jdate, iret
178 integer my_lunit, lun, il, im
180 character*8,
intent(out) :: subset
187 call x84(lunit,my_lunit,1)
188 call readns(my_lunit,subset,jdate,iret)
189 call x48(jdate,jdate,1)
190 call x48(iret,iret,1)
198 call status(lunit,lun,il,im)
199 if(il==0)
call bort(
'BUFRLIB: READNS - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
200 if(il>0)
call bort(
'BUFRLIB: READNS - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
201 if(
inode(lun)==0)
then
213 call readmg(lunit,subset,jdate,iret)
238 recursive integer function ireadns(lunit,subset,idate)
result(iret)
240 use modv_vars,
only: im8b
244 integer,
intent(in) :: lunit
245 integer,
intent(out) :: idate
248 character*8,
intent(out) :: subset
255 call x84(lunit,my_lunit,1)
256 iret=
ireadns(my_lunit,subset,idate)
257 call x48(idate,idate,1)
263 call readns(lunit,subset,idate,iret)
304 use modv_vars,
only: im8b
310 integer,
intent(in) :: lunit
311 integer my_lunit, lun, il, im
318 call x84 ( lunit, my_lunit, 1 )
327 call status(lunit,lun,il,im)
328 if(il==0)
call bort(
'BUFRLIB: WRITSB - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
329 if(il<0)
call bort(
'BUFRLIB: WRITSB - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
330 if(im==0)
call bort(
'BUFRLIB: WRITSB - A MESSAGE MUST BE OPEN IN OUTPUT BUFR FILE, NONE ARE')
422 recursive subroutine writsa(lunxx,lmsgt,msgt,msgl)
424 use modv_vars,
only: im8b
431 integer,
intent(in) :: lunxx, lmsgt
432 integer,
intent(out) :: msgt(*), msgl
433 integer my_lunxx, my_lmsgt, lunit, lun, il, im, n
440 call x84 ( lunxx, my_lunxx, 1 )
441 call x84 ( lmsgt, my_lmsgt, 1 )
442 call writsa ( my_lunxx, my_lmsgt*2, msgt, msgl )
444 call x48 ( msgl, msgl, 1 )
454 call status(lunit,lun,il,im)
455 if(il==0)
call bort(
'BUFRLIB: WRITSA - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
456 if(il<0)
call bort(
'BUFRLIB: WRITSA - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
457 if(im==0)
call bort(
'BUFRLIB: WRITSA - A MESSAGE MUST BE OPEN IN OUTPUT BUFR FILE, NONE ARE')
461 if(lunxx<0)
call closmg(lunit)
466 if(
msglen(lun)>lmsgt)
call bort(
'BUFRLIB: WRITSA - OVERFLOW OF OUTPUT BUFR MESSAGE ARRAY; TRY A LARGER '// &
467 'DIMENSION FOR THIS ARRAY')
497 if( (
msglen(lun)>0) .and. (msgl+
msglen(lun)<=lmsgt) )
then
499 msgt(msgl+n) =
msgtxt(n,lun)
535 recursive subroutine rdmgsb(lunit,imsg,isub)
537 use modv_vars,
only: im8b
544 integer,
intent(in) :: lunit, imsg, isub
545 integer my_lunit, my_imsg, my_isub, lun, il, im, i, jdate, iret
547 character*128 bort_str
555 call x84(lunit,my_lunit,1)
556 call x84(imsg,my_imsg,1)
557 call x84(isub,my_isub,1)
558 call rdmgsb(my_lunit,my_imsg,my_isub)
566 call openbf(lunit,
'IN',lunit)
567 call status(lunit,lun,il,im)
573 call readmg(lunit,subset,jdate,iret)
575 write(bort_str,
'("BUFRLIB: RDMGSB - HIT END OF FILE BEFORE READING REQUESTED MESSAGE NO.",I5," IN '//&
576 'BUFR FILE CONNECTED TO UNIT",I4)') imsg,lunit
586 write(bort_str,
'("BUFRLIB: RDMGSB - ALL SUBSETS READ BEFORE READING REQ. SUBSET NO.",I3," IN '// &
587 'REQ. MSG NO.",I5," IN BUFR FILE CONNECTED TO UNIT",I4)') isub,imsg,lunit
620 integer,
intent(in) :: lunit, lun
621 integer nby0, nby1, nby2, nby3, nby4, nby5, iprt, ibyt, lbyt, lbit, nbyt, ii, iupb
627 common /msgptr/ nby0, nby1, nby2, nby3, nby4, nby5
636 if(msgfull(
mbyt(lun),ibyt,
maxbyt) .or. ((ibyt>65530).and.(
nsub(lun)>0)))
then
651 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
652 write ( unit=errstr, fmt=
'(A,A,I7,A)')
'BUFRLIB: MSGUPD - SUBSET LONGER THAN ANY POSSIBLE MESSAGE ', &
653 '{MAXIMUM MESSAGE LENGTH = ',
maxbyt,
'}'
655 call errwrt(
'>>>>>>>OVERLARGE SUBSET DISCARDED FROM FILE<<<<<<<<')
656 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
679 lbit = (nby0+nby1+nby2+4)*8
682 lbyt = nby0+nby1+nby2+nby3
683 nbyt = iupb(
mbay(1,lun),lbyt+1,24)
685 call pkb(nbyt+ibyt,24,
mbay(1,lun),lbit)
702 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
703 write ( unit=errstr, fmt=
'(A,I7,A,A)')
'BUFRLIB: MSGUPD - SUBSET HAS BYTE COUNT = ',ibyt,
' > UPPER LIMIT OF 65535'
705 call errwrt(
'>>>>>>>WILL BE WRITTEN INTO ITS OWN MESSAGE<<<<<<<<')
706 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
749 subroutine pad(ibay,ibit,ibyt,ipadb)
753 integer,
intent(inout) :: ibay(*), ibit
754 integer,
intent(in) :: ipadb
755 integer,
intent(out) :: ibyt
758 character*128 bort_str
762 ipad = ipadb - mod(ibit+8,ipadb)
764 call pkb(ipad,8,ibay,ibit)
766 call pkb(0,ipad,ibay,ibit)
769 if(mod(ibit,8)/=0)
then
770 write(bort_str,
'("BUFRLIB: PAD - THE NUMBER OF BITS IN A PACKED'// &
771 ' SUBSET AFTER PADDING (",I8,") IS NOT A MULTIPLE OF 8")') ibit
803 recursive integer function lcmgdf(lunit,subset)
result(iret)
805 use modv_vars,
only: im8b
811 integer,
intent(in) :: lunit
812 integer my_lunit, lun, il, im, mtyp, msbt, inod, nte, i
814 character*8,
intent(in) :: subset
821 call x84(lunit,my_lunit,1)
822 iret=
lcmgdf(my_lunit,subset)
832 call status(lunit,lun,il,im)
833 if (il==0)
call bort(
'BUFRLIB: LCMGDF - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN')
837 call nemtba(lun,subset,mtyp,msbt,inod)
844 if ( (
typ(inod+i)==
'CHR') .and. (
ibt(inod+i)>64) )
then
879 recursive subroutine ufbpos(lunit,irec,isub,subset,jdate)
883 use modv_vars,
only: im8b
890 integer,
intent(in) :: lunit, irec, isub
891 integer,
intent(out) :: jdate
892 integer my_lunit, my_irec, my_isub, lun, il, im, jrec, jsub, iret
894 character*128 bort_str
895 character*8,
intent(out) :: subset
901 call x84(lunit,my_lunit,1)
902 call x84(irec,my_irec,1)
903 call x84(isub,my_isub,1)
904 call ufbpos(my_lunit,my_irec,my_isub,subset,jdate)
905 call x48(jdate,jdate,1)
912 call status(lunit,lun,il,im)
913 if(il==0)
call bort(
'BUFRLIB: UFBPOS - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
914 if(il>0)
call bort(
'BUFRLIB: UFBPOS - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
917 write(bort_str,
'("BUFRLIB: UFBPOS - REQUESTED MESSAGE NUMBER TO READ IN (",I5,") IS NOT VALID")') irec
921 write(bort_str,
'("BUFRLIB: UFBPOS - REQUESTED SUBSET NUMBER TO READ IN (",I5,") IS NOT VALID")') isub
927 call ufbcnt(lunit,jrec,jsub)
931 if(irec<jrec .or. (irec==jrec.and.isub<jsub))
then
935 call ufbcnt(lunit,jrec,jsub)
941 call readmg(lunit,subset,jdate,iret)
943 write(bort_str,
'("BUFRLIB: UFBPOS - REQUESTED MESSAGE NUMBER '// &
944 'TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN THE FILE (",I5,")")') irec, jrec
947 call ufbcnt(lunit,jrec,jsub)
953 write(bort_str,
'("BUFRLIB: UFBPOS - REQ. SUBSET NUMBER TO READ'// &
954 ' IN (",I5,") EXCEEDS THE NUMBER OF SUBSETS (",I5,") IN THE REQ. MESSAGE (",I5,")")') isub, jsub, irec
957 call ufbcnt(lunit,jrec,jsub)
976 use modv_vars,
only: bmiss
986 integer,
intent(in) :: lun
987 integer,
intent(out) :: iret
988 integer ier, n, node, kbit, nbt, icbfms
994 equivalence(cval,rval)
1018 if(
itp(node)==1)
then
1023 elseif(
itp(node)==2)
then
1027 if (
ival(n)<2_8**
ibt(node)-1)
then
1032 elseif(
itp(node)==3)
then
1040 nbt = min(8,
nbit(n)/8)
1041 call upc(cval,nbt,
mbay(1,lun),kbit,.true.)
1042 if (
nbit(n)<=64 .and. icbfms(cval,nbt)/=0)
then
1073 integer,
intent(in) :: lun
1075 integer n, node, ncr, numchr, jj, ibfms
1082 equivalence(cval,rval)
1088 if(
itp(node)==1)
then
1090 elseif(
typ(node)==
'NUM')
then
1091 if( (ibfms(
val(n,lun))==1) .or. (
val(n,lun)/=
val(n,lun)) )
then
1095 ival(n) = ipks(
val(n,lun),node)
1106 if(
itp(node)<3)
then
1112 if ( ncr>8 .and.
luncpy(lun)/=0 )
then
1119 if(ibfms(rval)/=0)
then
1121 numchr = min(ncr,len(lstr))
1123 call ipkm(lstr(jj:jj),1,255)
1157 use modv_vars,
only: bmiss, maxjl, maxss, maxrcr
1168 character*128 bort_str
1170 integer,
intent(in) :: lun
1171 integer,
intent(out) :: iret
1172 integer nbmp(2,maxrcr), newn(2,maxrcr), knx(maxrcr), iprt, nodi, node, mbmp, knvn, nr, i, j, n, nn, n1, n2, new, &
1195 outer:
do while (.true.)
1201 write(bort_str,
'("BUFRLIB: RCSTPL - THE NUMBER OF RECURSION LEVELS EXCEEDS THE LIMIT (",I3,")")') maxrcr
1210 write(bort_str,
'("BUFRLIB: RCSTPL - UNSET EXPANSION SEGMENT ",A)')
tag(nodi)
1213 if(n2-n1+1>maxjl)
then
1215 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1216 call errwrt(
'BUFRLIB: RCSTPL - MAXJL OVERFLOW; SUBSET SKIPPED')
1217 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1223 newn(2,nr) = n2-n1+1
1235 do i=nbmp(1,nr),nbmp(2,nr)
1236 if(knx(nr)==0) knx(nr) = knvn
1237 if(i>nbmp(1,nr)) newn(1,nr) = 1
1238 do j=newn(1,nr),newn(2,nr)
1239 if(knvn+1>maxss)
then
1241 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1242 call errwrt(
'BUFRLIB: RCSTPL - MAXSS OVERFLOW; SUBSET SKIPPED')
1243 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1251 inv(knvn,lun) = node
1255 nrfelm(knvn,lun) = igetrfel(knvn,lun)
1257 if(
tag(node)(1:5)==
'DPRI ')
then
1263 val(knvn,lun) = bmiss
1269 if(
itp(node)==1)
then
1277 val(knx(nr)+1,lun) =
val(knx(nr)+1,lun) + new
1283 if(nr-1 == 0)
exit outer
1308 use modv_vars,
only: maxjl, maxss
1318 integer,
intent(in) :: lun, invn, nbmp
1319 integer iprt, i, j, ival, jval, n, n1, n2, nodi, node, newn, invr, knvn
1321 character*128 bort_str, errstr
1323 logical drp, drs, drb, drx
1328 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1329 write ( unit=errstr, fmt=
'(A,I3,A,I7,A,I5,A,A10)' ) &
1330 'BUFRLIB: USRTPL - LUN:INVN:NBMP:TAG(INODE(LUN)) = ', lun,
':', invn,
':', nbmp,
':',
tag(
inode(lun))
1332 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1338 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
1339 call errwrt(.LE.
'BUFRLIB: USRTPL - NBMP 0 - IMMEDIATE RETURN')
1340 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
1358 write(bort_str,
'("BUFRLIB: USRTPL - THIRD ARGUMENT (INPUT) = ",'// &
1359 'I4,", MUST BE 1 WHEN SECOND ARGUMENT (INPUT) IS 1 (SUBSET NODE) (",A,")")') nbmp,
tag(nodi)
1362 elseif(invn>0 .and. invn<=
nval(lun))
then
1364 nodi =
inv(invn,lun)
1365 drp =
typ(nodi) ==
'DRP'
1366 drs =
typ(nodi) ==
'DRS'
1367 drb =
typ(nodi) ==
'DRB'
1368 drx = drp .or. drs .or. drb
1369 ival = nint(
val(invn,lun))
1370 jval = 2**
ibt(nodi)-1
1371 val(invn,lun) = ival+nbmp
1372 if(drb.and.nbmp/=1)
then
1373 write(bort_str,
'("BUFRLIB: USRTPL - THIRD ARGUMENT (INPUT) = ",'// &
1374 'I4,", MUST BE 1 WHEN NODE IS DRB (1-BIT DELAYED REPL. FACTOR) (",A,")")') nbmp,
tag(nodi)
1378 write(bort_str,
'("BUFRLIB: USRTPL - NODE IS OF TYPE ",A," - IT '// &
1379 'MUST BE EITHER A SUBSET OR DELAYED REPL. FACTOR (",A,")")')
typ(nodi),
tag(nodi)
1383 write(bort_str,
'("BUFRLIB: USRTPL - REPLICATION FACTOR IS NEGATIVE (=",I5,") (",A,")")') ival,
tag(nodi)
1386 if(ival+nbmp>jval)
then
1387 write(bort_str,
'("BUFRLIB: USRTPL - REPLICATION FACTOR OVERFLOW (EXCEEDS MAXIMUM OF",I6," (",A,")")') jval,
tag(nodi)
1393 write(bort_str,
'("BUFRLIB: USRTPL - INVENTORY INDEX {FIRST '// &
1394 'ARGUMENT (INPUT)} OUT OF BOUNDS (=",I5,", RANGE IS 1 TO",I6,") ")') invn,
nval(lun)
1405 write(bort_str,
'("BUFRLIB: USRTPL - UNSET EXPANSION SEGMENT (",A,")")')
tag(nodi)
1408 if(n2-n1+1>maxjl)
then
1409 write(bort_str,
'("BUFRLIB: USRTPL - TEMPLATE ARRAY OVERFLOW, EXCEEDS THE LIMIT (",I6,") (",A,")")') maxjl,
tag(nodi)
1421 if(
nval(lun)+newn*nbmp>maxss)
then
1422 write(bort_str,
'("BUFRLIB: USRTPL - INVENTORY OVERFLOW (",I6,"), EXCEEDS THE LIMIT (",I6,") (",A,")")') &
1423 nval(lun)+newn*nbmp, maxss,
tag(nodi)
1427 do j=
nval(lun),invn+1,-1
1428 inv(j+newn*nbmp,lun) =
inv(j,lun)
1429 val(j+newn*nbmp,lun) =
val(j,lun)
1432 if(drp.or.drs)
vtmp(1) = newn
1448 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1449 write ( unit=errstr, fmt=
'(A,A,A10,2(A,I5),A,I7)' )
'BUFRLIB: USRTPL - TAG(INV(INVN,LUN)):NEWN:NBMP:', &
1450 'NVAL(LUN) = ',
tag(
inv(invn,lun)),
':', newn,
':', nbmp,
':',
nval(lun)
1453 write ( unit=errstr, fmt=
'(2(A,I5),A,A10)' )
'For I = ', i,
', ITMP(I) = ',
itmp(i),
', TAG(ITMP(I)) = ',
tag(
itmp(i))
1456 call errwrt(
'++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
1463 outer:
do while (.true.)
1466 if(
itp(node)==0)
then
1468 if(
inv(invr,lun)==node)
then
1469 val(invr,lun) =
val(invr,lun)+newn*nbmp
1473 write(bort_str,
'("BUFRLIB: USRTPL - BAD BACKUP STRATEGY (",A,")")')
tag(nodi)
1499 use modv_vars,
only: im8b
1506 integer,
intent(in) :: lubfi, lubfj
1507 integer nrpl, nmrg, namb, ntot, my_lubfi, my_lubfj, luni, il, im, lunj, jl, jm, is, js, node, nodj, ityp, iwrds, jwrds, &
1510 character*128 bort_str
1512 logical herei, herej, missi, missj, samei
1514 common /mrgcom/ nrpl, nmrg, namb, ntot
1520 call x84(lubfi,my_lubfi,1)
1521 call x84(lubfj,my_lubfj,1)
1522 call invmrg(my_lubfi,my_lubfj)
1532 call status(lubfi,luni,il,im)
1533 call status(lubfj,lunj,jl,jm)
1537 do while(is<=
nval(luni))
1542 write(bort_str,
'("BUFRLIB: INVMRG - NODE FROM INPUT BUFR FILE '// &
1543 '(",I7,") DOES NOT EQUAL NODE FROM OUTPUT BUFR FILE (",I7,"), TABULAR MISMATCH")') node, nodj
1550 if(
typ(node)==
'DRB')
then
1555 iwrds =
nwords(is,luni)+ioff
1556 jwrds =
nwords(js,lunj)+ioff
1557 if(iwrds>ioff .and. jwrds==ioff)
then
1558 do n=
nval(lunj),js+1,-1
1559 inv(n+iwrds-jwrds,lunj) =
inv(n,lunj)
1560 val(n+iwrds-jwrds,lunj) =
val(n,lunj)
1563 inv(js+n,lunj) =
inv(is+n,luni)
1564 val(js+n,lunj) =
val(is+n,luni)
1566 nval(lunj) =
nval(lunj)+iwrds-jwrds
1572 elseif((ityp==2).or.(ityp==3))
then
1576 missi = .not.(herei)
1577 missj = .not.(herej)
1578 samei =
val(is,luni)==
val(js,lunj)
1579 if(herei.and.missj)
then
1580 val(js,lunj) =
val(is,luni)
1582 elseif(herei.and.herej.and..not.samei)
then
1611 integer,
intent(in) :: n, lun
1616 do k=1,nint(
val(n,lun))
1617 iret = iret + nint(
val(iret+n+1,lun))
subroutine strbtm(n, lun)
Store internal information in module moda_bitmaps if the input element is part of a bitmap.
subroutine bort(str)
Log an error message, then abort the application program.
subroutine upb(nval, nbits, ibay, ibit)
Decode an integer value from within a specified number of bits of an integer array,...
subroutine upbb(nval, nbits, ibit, ibay)
Decode an integer value from within a specified number of bits of an integer array,...
subroutine upb8(nval, nbits, ibit, ibay)
Decode an 8-byte integer value from within a specified number of bits of an integer array,...
real *8 function ups(ival, node)
Unpack a real*8 value from an integer by applying the proper scale and reference values.
subroutine upc(chr, nchr, ibay, ibit, cnvnull)
Decode a character string from within a specified number of bytes of an integer array,...
subroutine pkc(chr, nchr, ibay, ibit)
Encode a character string within a specified number of bytes of an integer array, starting at the bit...
recursive subroutine ipkm(cbay, nbyt, n)
Encode an integer value within a specified number of bytes of a character string, up to a maximum of ...
subroutine pkb(nval, nbits, ibay, ibit)
Encode an integer value within a specified number of bits of an integer array, starting at the bit im...
subroutine pkb8(nval, nbits, ibay, ibit)
Encode an 8-byte integer value within a specified number of bits of an integer array,...
subroutine rdcmps(lun)
Read the next compressed BUFR data subset into internal arrays.
subroutine wrcmps(lunix)
Write a compressed BUFR data subset.
subroutine mvb(ib1, nb1, ib2, nb2, nbm)
Copy a specified number of bytes from one packed binary array to another.
subroutine nemtba(lun, nemo, mtyp, msbt, inod)
Get information about a Table A 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-...
integer function ibfms(r8val)
Check whether a real*8 data value returned from a previous call to any of the NCEPLIBS-bufr values-re...
Wrap C NCEPLIBS-bufr functions so they can be called from within the Fortran part of the library.
Declare arrays and variables used to store BUFR messages internally for multiple file IDs.
integer, dimension(:), allocatable ibay
Current data subset.
integer ibit
Bit pointer within ibay.
integer, dimension(:,:), allocatable mbay
Current BUFR message for each file ID.
integer, dimension(:), allocatable mbyt
Length (in bytes) of current BUFR message for each file ID.
integer maxbyt
Maximum length of an output BUFR message.
Declare arrays and variables used to store bitmaps internally within a data subset definition.
integer lstnod
Most recent jump/link table entry that was processed by function igetrfel() and whose corresponding v...
integer nbtm
Number of stored bitmaps for the current data subset (up to a maximum of mxbtm).
integer lstnodct
Current count of consecutive occurrences of lstnod.
logical linbtm
true if a bitmap is in the process of being read for the current data subset; false otherwise.
Declare arrays used to store, for each output file ID, a copy of the BUFR message that was most recen...
integer, dimension(:), allocatable msglen
Length (in integers) of BUFR message most recently written to each output file ID.
integer, dimension(:,:), allocatable msgtxt
BUFR message most recently written to each output file ID.
Declare arrays and variables needed to store long character strings (greater than 8 bytes) via subrou...
integer nh4wlc
Number of long character strings being stored.
character *14, dimension(:), allocatable sth4wlc
Table B mnemonics associated with long character strings.
integer, dimension(:), allocatable luh4wlc
File ID for associated output file.
character *120, dimension(:), allocatable chh4wlc
Long character strings.
Declare an array used to pack or unpack all of the values of a BUFR data subset.
integer *8, dimension(:), allocatable ival
BUFR data subset values.
Declare arrays which provide working space in several subprograms (usrtpl() and ufbcup()) which manip...
real *8, dimension(:), allocatable vtmp
val array elements for new sections of a growing subset buffer.
integer, dimension(:), allocatable itmp
inv array elements for new sections of a growing subset buffer.
Declare a variable used to indicate whether output BUFR messages should be compressed.
character ccmf
Flag indicating whether BUFR output messages are to be compressed; this variable is initialized to a ...
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.
integer, dimension(:), allocatable idate
Section 1 date-time of message.
integer, dimension(:), allocatable nmsg
Current message pointer within logical unit.
integer, dimension(:), allocatable msub
Total number of data subsets in message.
integer, dimension(:), allocatable nsub
Current subset pointer within message.
Declare an array used to store a status code for each file ID if an error or other abnormal result oc...
integer, dimension(:), allocatable iscodes
Abnormal status codes.
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 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:
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, dimension(:), allocatable itp
Integer type values corresponding to typ:
Declare an array used to store, for each file ID, the logical unit number corresponding to a separate...
integer, dimension(:), allocatable luncpy
Logical unit numbers used to copy long character strings between BUFR data subsets.
Declare an array used to store, for each file ID from which a BUFR message is currently being read as...
integer, dimension(:), allocatable msgunp
Flag indicating how to unpack data subsets from BUFR message:
Declare arrays for internal storage of pointers to BUFR data subset values.
integer, dimension(:), allocatable nbit
Length (in bits) of each packed data value in data subset.
integer, dimension(:), allocatable mbit
Pointer in data subset to first bit of each packed data value.
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...
integer, dimension(:,:), allocatable nrfelm
Referenced data value, for data values which refer to a previous data value in the BUFR data subset v...
Declare arrays used in subroutine rcstpl() to store subset segments that are being copied from a subs...
integer, dimension(:,:), allocatable iutmp
inv array elements for new sections of a growing subset buffer.
real *8, dimension(:,:), allocatable vutmp
val array elements for new sections of a growing subset buffer.
recursive subroutine openbf(lunit, io, lundx)
Connect a new file to the NCEPLIBS-bufr software for input or output operations, or initialize the li...
recursive subroutine ufbcnt(lunit, kmsg, ksub)
Get the current location of the file pointer within a BUFR file, in terms of a message number countin...
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...
recursive subroutine readmg(lunxx, subset, jdate, iret)
Read the next BUFR message from logical unit abs(lunxx) into internal arrays.
subroutine msgini(lun)
Initialize, within the internal arrays, a new uncompressed BUFR message for output.
subroutine msgwrt(lunit, mesg, mgbyt)
Perform final checks and updates on a BUFR message before writing it to a specified Fortran logical u...
recursive subroutine ufbpos(lunit, irec, isub, subset, jdate)
Jump forwards or backwards to a specified data subset within a BUFR file.
subroutine pad(ibay, ibit, ibyt, ipadb)
Pad a BUFR data subset with zeroed-out bits up to the next byte boundary.
subroutine rdtree(lun, iret)
Read the next uncompressed BUFR data subset into internal arrays.
subroutine wrtree(lun)
Pack a BUFR data subset.
subroutine msgupd(lunit, lun)
Write an uncompressed BUFR data subset.
subroutine usrtpl(lun, invn, nbmp)
Expand a subset template within internal arrays.
recursive subroutine writsa(lunxx, lmsgt, msgt, msgl)
Write a complete data subset into a BUFR message, and return each completed message within a memory a...
recursive integer function ireadns(lunit, subset, idate)
Call subroutine readns() and pass back its return code as the function value.
integer function nwords(n, lun)
Compute the length of a specified delayed replication sequence within a data subset.
recursive subroutine writsb(lunit)
Write a complete data subset into a BUFR message, for eventual output to logical unit lunit.
recursive subroutine invmrg(lubfi, lubfj)
Merge parts of data subsets which have duplicate space and time coordinates but different or unique o...
recursive integer function ireadsb(lunit)
Call subroutine readsb() and pass back its return code as the function value.
recursive subroutine readsb(lunit, iret)
Read the next data subset from a BUFR message.
subroutine rcstpl(lun, iret)
Initialize a subset template within internal arrays.
recursive integer function lcmgdf(lunit, subset)
Check whether the subset definition for a given message type contains any long character strings (gre...
recursive subroutine rdmgsb(lunit, imsg, isub)
Read a specified data subset from a BUFR file.
recursive subroutine readns(lunit, subset, jdate, iret)
Read the next data subset from a BUFR file.
recursive subroutine readlc(lunit, chr, str)
Read a long character string (greater than 8 bytes) from a data subset.
recursive subroutine writlc(lunit, chr, str)
Write a long character string (greater than 8 bytes) to a data subset.
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.