22 recursive subroutine copybf(lunin,lunot)
24 use modv_vars,
only: im8b
30 integer,
intent(in) :: lunin, lunot
31 integer my_lunin, my_lunot, lun, il, im, ier,
iupbs01
38 call x84(lunin,my_lunin,1)
39 call x84(lunot,my_lunot,1)
40 call copybf(my_lunin,my_lunot)
48 call status(lunin,lun,il,im)
49 if(il/=0)
call bort (
'BUFRLIB: COPYBF - INPUT BUFR FILE IS OPEN, IT MUST BE CLOSED')
50 call status(lunot,lun,il,im)
51 if(il/=0)
call bort (
'BUFRLIB: COPYBF - OUTPUT BUFR FILE IS OPEN, IT MUST BE CLOSED')
55 call openbf(lunin,
'INX',lunin)
56 call openbf(lunot,
'OUX',lunin)
109 use modv_vars,
only: im8b
117 integer,
intent(in) :: lunin, lunot
118 integer my_lunin, my_lunot, lin, lot, il, im, mtyp, msbt, inod, mbym,
iupbs01,
iok2cpy
127 call x84(lunin,my_lunin,1)
128 call x84(lunot,my_lunot,1)
129 call copymg(my_lunin,my_lunot)
137 call status(lunin,lin,il,im)
138 if(il==0)
call bort(
'BUFRLIB: COPYMG - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
139 if(il>0)
call bort(
'BUFRLIB: COPYMG - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
140 if(im==0)
call bort(
'BUFRLIB: COPYMG - A MESSAGE MUST BE OPEN IN INPUT BUFR FILE, NONE ARE')
142 call status(lunot,lot,il,im)
143 if(il==0)
call bort(
'BUFRLIB: COPYMG - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
144 if(il<0)
call bort(
'BUFRLIB: COPYMG - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
145 if(im/=0)
call bort(
'BUFRLIB: COPYMG - ALL MESSAGES MUST BE CLOSED IN OUTPUT BUFR FILE, A MESSAGE IS OPEN')
150 call nemtba(lot,subset,mtyp,msbt,inod)
152 call bort(
'BUFRLIB: COPYMG - INPUT AND OUTPUT BUFR FILES MUST HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
202 recursive subroutine copysb(lunin,lunot,iret)
204 use modv_vars,
only: im8b
212 integer,
intent(in) :: lunin, lunot
213 integer,
intent(out) :: iret
214 integer my_lunin, my_lunot, lin, lot, il, im, mest, icmp, nbyt, len0, len1, len2, len3, len4, l5,
iok2cpy
221 call x84(lunin,my_lunin,1)
222 call x84(lunot,my_lunot,1)
223 call copysb(my_lunin,my_lunot,iret)
224 call x48(iret,iret,1)
234 call status(lunin,lin,il,im)
235 if(il==0)
call bort(
'BUFRLIB: COPYSB - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
236 if(il>0)
call bort(
'BUFRLIB: COPYSB - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
237 if(im==0)
call bort(
'BUFRLIB: COPYSB - A MESSAGE MUST BE OPEN IN INPUT BUFR FILE, NONE ARE')
240 call status(lunot,lot,il,im)
241 if(il==0)
call bort(
'BUFRLIB: COPYSB - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
242 if(il<0)
call bort(
'BUFRLIB: COPYSB - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
243 if(im==0)
call bort(
'BUFRLIB: COPYSB - A MESSAGE MUST BE OPEN IN OUTPUT BUFR FILE, NONE ARE')
245 call bort(
'BUFRLIB: COPYSB - INPUT AND OUTPUT BUFR FILES MUST HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
257 call mesgbc(-lunin, mest, icmp)
278 if ( (
nsub(lin)==0) .and. (
msub(lin)==1) )
then
280 call getlens(
mbay(1,lin), 4, len0, len1, len2, len3, len4, l5)
288 if(lunot>0)
call cpyupd(lunot, lin, lot, nbyt)
311 recursive integer function icopysb(lunin,lunot)
result(iret)
313 use modv_vars,
only: im8b
317 integer,
intent(in) :: lunin, lunot
318 integer my_lunin, my_lunot
323 call x84(lunin,my_lunin,1)
324 call x84(lunot,my_lunot,1)
325 iret=
icopysb(my_lunin,my_lunot)
331 call copysb(lunin,lunot,iret)
354 integer function iok2cpy(lui,luo)
result(iret)
361 integer,
intent(in) :: lui, luo
362 integer icmpdx, mtyp, msbt, inod, ntei, nteo, i
370 if (
icmpdx(lui,luo) == 1 )
then
379 call nemtbax(luo,subset,mtyp,msbt,inod)
380 if ( inod == 0 )
return
385 nteo =
isc(inod)-inod
386 if ( ntei /= nteo )
return
435 use modv_vars,
only: im8b
444 integer,
intent(in) :: lunot
445 integer my_lunot, lin, lot, il, im, mtyp, msbt, inod, mbym,
iupbs01,
iok2cpy
454 call x84(lunot,my_lunot,1)
464 if(im==0)
call bort(
'BUFRLIB: CPYMEM - A MESSAGE MUST BE OPEN IN INPUT BUFR MESSAGES IN INTERNAL MEMORY, NONE ARE')
466 call status(lunot,lot,il,im)
467 if(il==0)
call bort(
'BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
468 if(il<0)
call bort(
'BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
469 if(im/=0)
call bort(
'BUFRLIB: CPYMEM - ALL MESSAGES MUST BE CLOSED IN OUTPUT BUFR FILE, A MESSAGE IS OPEN')
474 call nemtba(lot,subset,mtyp,msbt,inod)
476 call bort(
'BUFRLIB: CPYMEM - INPUT BUFR MESSAGES IN INTERNAL MEMORY AND OUTPUT BUFR FILE MUST HAVE SAME INTERNAL '// &
477 'TABLES (DIFFERENT HERE)')
519 integer,
intent(in) :: lunit, lin, lun, ibyt
520 integer nby0, nby1, nby2, nby3, nby4, nby5, iprt, lbit, lbyt, nbyt, iupb
522 common /msgptr/ nby0,nby1,nby2,nby3,nby4,nby5
526 character*128 bort_str, errstr
532 if(msgfull(
mbyt(lun),ibyt,
maxbyt) .or. ((ibyt>65530).and.(
nsub(lun)>0)))
then
544 write(bort_str,
'("BUFRLIB: CPYUPD - THE LENGTH OF THIS SUBSET EXCEEDS THE MAXIMUM MESSAGE LENGTH (",I6,")")')
maxbyt
561 lbit = (nby0+nby1+nby2+4)*8
564 lbyt = nby0+nby1+nby2+nby3
565 nbyt = iupb(
mbay(1,lun),lbyt+1,24)
567 call pkb(nbyt+ibyt,24,
mbay(1,lun),lbit)
575 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
576 write ( unit=errstr, fmt=
'(A,I7,A,A)')
'BUFRLIB: CPYUPD - SUBSET HAS BYTE COUNT = ',ibyt,
' > UPPER LIMIT OF 65535'
578 call errwrt(
'>>>>>>>WILL BE COPIED INTO ITS OWN MESSAGE<<<<<<<<')
579 call errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
613 use modv_vars,
only: im8b
622 integer,
intent(in) :: lubin, lubot
623 integer my_lubin, my_lubot, lui, luo, il, im, n,
iok2cpy
630 call x84(lubin,my_lubin,1)
631 call x84(lubot,my_lubot,1)
632 call ufbcpy(my_lubin,my_lubot)
640 call status(lubin,lui,il,im)
641 if(il==0)
call bort(
'BUFRLIB: UFBCPY - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
642 if(il>0)
call bort(
'BUFRLIB: UFBCPY - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
643 if(im==0)
call bort(
'BUFRLIB: UFBCPY - A MESSAGE MUST BE OPEN IN INPUT BUFR FILE, NONE ARE')
645 call bort(
'BUFRLIB: UFBCPY - LOCATION OF INTERNAL TABLE FOR INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION '// &
646 'IN INTERNAL SUBSET ARRAY')
648 call status(lubot,luo,il,im)
649 if(il==0)
call bort(
'BUFRLIB: UFBCPY - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
650 if(il<0)
call bort(
'BUFRLIB: UFBCPY - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
651 if(im==0)
call bort(
'BUFRLIB: UFBCPY - A MESSAGE MUST BE OPEN IN OUTPUT BUFR FILE, NONE ARE')
654 call bort(
'BUFRLIB: UFBCPY - INPUT AND OUTPUT BUFR FILES MUST HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
684 integer,
intent(in) :: lud, lun
730 subroutine mvb(ib1,nb1,ib2,nb2,nbm)
734 integer,
intent(in) :: ib1(*), nb1, nb2, nbm
735 integer,
intent(out) :: ib2(*)
736 integer jb1, jb2, n, nval
742 call upb(nval,8,ib1,jb1)
743 call pkb(nval,8,ib2,jb2)
769 use modv_vars,
only: im8b
778 integer,
intent(in) :: lubin, lubot
779 integer my_lubin, my_lubot, lui, luo, il, im, ntag, ni, no, nv, nin
787 call x84(lubin,my_lubin,1)
788 call x84(lubot,my_lubot,1)
789 call ufbcup(my_lubin,my_lubot)
796 call status(lubin,lui,il,im)
797 if(il==0)
call bort(
'BUFRLIB: UFBCUP - INPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR INPUT')
798 if(il>0)
call bort(
'BUFRLIB: UFBCUP - INPUT BUFR FILE IS OPEN FOR OUTPUT, IT MUST BE OPEN FOR INPUT')
799 if(im==0)
call bort(
'BUFRLIB: UFBCUP - A MESSAGE MUST BE OPEN IN INPUT BUFR FILE, NONE ARE')
800 if(
inode(lui)/=
inv(1,lui))
call bort(
'BUFRLIB: UFBCUP - LOCATION OF INTERNAL TABLE FOR '// &
801 'INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN INTERNAL SUBSET ARRAY')
803 call status(lubot,luo,il,im)
804 if(il==0)
call bort(
'BUFRLIB: UFBCUP - OUTPUT BUFR FILE IS CLOSED, IT MUST BE OPEN FOR OUTPUT')
805 if(il<0)
call bort(
'BUFRLIB: UFBCUP - OUTPUT BUFR FILE IS OPEN FOR INPUT, IT MUST BE OPEN FOR OUTPUT')
806 if(im==0)
call bort(
'BUFRLIB: UFBCUP - A MESSAGE MUST BE OPEN IN OUTPUT BUFR FILE, NONE ARE')
812 outer1:
do ni=1,
nval(lui)
816 if(
ttmp(nv)==
tag(nin)) cycle outer1
824 if(ntag==0)
call bort(
'BUFRLIB: UFBCUP - THERE ARE NO ELEMENTS (TAGS) IN INPUT SUBSET BUFFER')
832 if(
ttmp(nv)==tago)
then
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 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 cmpmsg(cf)
Specify whether BUFR messages output by future calls to message-writing subroutines and subset-writin...
integer function iok2cpy(lui, luo)
Check whether a BUFR message, or a data subset from within a BUFR message, can be copied from one For...
recursive integer function icopysb(lunin, lunot)
Copy a BUFR data subset from one Fortran logical unit to another.
subroutine cpbfdx(lud, lun)
Copy all of the DX BUFR table information from one unit to another within internal memory.
subroutine mvb(ib1, nb1, ib2, nb2, nbm)
Copy a specified number of bytes from one packed binary array to another.
recursive subroutine copybf(lunin, lunot)
Copy an entire BUFR file from one Fortran logical unit to another.
recursive subroutine ufbcup(lubin, lubot)
Copy unique elements of a data subset.
recursive subroutine copysb(lunin, lunot, iret)
Copy a BUFR data subset from one Fortran logical unit to another.
subroutine cpyupd(lunit, lin, lun, ibyt)
Copy a BUFR data subset from one unit to another within internal memory.
recursive subroutine cpymem(lunot)
Copy a BUFR message from internal arrays to a file.
recursive subroutine ufbcpy(lubin, lubot)
Copy a BUFR data subset from one Fortran logical unit to another.
recursive subroutine copymg(lunin, lunot)
Copy a BUFR message from one file to another.
subroutine nemtba(lun, nemo, mtyp, msbt, inod)
Get information about a Table A descriptor from the internal DX BUFR tables.
subroutine nemtbax(lun, nemo, mtyp, msbt, inod)
Get information about a Table A descriptor from the internal DX BUFR tables.
subroutine dxinit(lun, ioi)
Clear out the internal arrays (in module moda_tababd) holding the DX BUFR table, then optionally init...
subroutine errwrt(str)
Specify a custom location for the logging of error and diagnostic messages generated by the NCEPLIBS-...
integer function icmpdx(lud, lun)
Check whether the full set of associated DX BUFR Table information is identical between two Fortran l...
Declare arrays and variables used to store BUFR messages internally for multiple file IDs.
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 which provide working space in several subprograms (usrtpl() and ufbcup()) which manip...
character *10, dimension(:), allocatable ttmp
tag 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 an array used by various subroutines and functions to hold a temporary working copy of a BUFR...
integer, dimension(:), allocatable mgwa
Temporary working copy of BUFR message.
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 arrays and variables used to store the contents of one or more BUFR files within internal mem...
integer munit
Fortran logical unit number for use in accessing contents of BUFR files within internal memory.
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 irf
Reference values corresponding to tag and typ:
integer, dimension(:), allocatable isc
Scale factors corresponding to tag and typ:
integer, dimension(:), allocatable ibt
Bit widths corresponding to tag and typ:
character *3, dimension(:), allocatable typ
Type indicators corresponding to tag:
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 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...
recursive subroutine closbf(lunit)
Close the connection between logical unit lunit and the NCEPLIBS-bufr software.
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 status(lunit, lun, il, im)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
recursive subroutine getlens(mbay, ll, len0, len1, len2, len3, len4, len5)
Read the section lengths of a BUFR message, up to a specified point in the message.
subroutine rdmsgw(lunit, mesg, iret)
Read the next BUFR message from logical unit lunit as an array of integer words.
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 writsb(lunit)
Write a complete data subset into a BUFR message, for eventual output to logical unit lunit.
recursive subroutine readsb(lunit, iret)
Read the next data subset from a BUFR message.
recursive integer function iupbs01(mbay, s01mnem)
Read a specified value from within Section 0 or Section 1 of a BUFR message.
recursive subroutine mesgbc(lunin, mesgtyp, icomp)
Return the message type (from Section 1) and message compression indicator (from Section 3) of a BUFR...
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.