14 use modv_vars,
only: mxbtm, mxbtmse
23 integer,
intent(in) :: n, lun
24 integer node, nodtam, ii, jj, ibfms, lstjpb
30 if (
tag(node)(1:5) ==
'DPRI ' )
then
35 nodtam = lstjpb( node, lun,
'SUB' )
40 (
inodtco(ii,jj) < node ) )
then
41 if (
ctco(ii,jj) ==
'236000' )
then
43 else if ( (
ctco(ii,jj) ==
'235000' ) .or. (
ctco(ii,jj) ==
'237255' ) )
then
51 if ( .not. isbtme )
then
57 if (
nbtm >= mxbtm )
call bort(
'BUFRLIB: STRBTM - MXBTM OVERFLOW')
65 if ( ibfms(
val(n,lun)) == 0 )
then
67 if (
nbtmse(
nbtm) >= mxbtmse )
call bort(
'BUFRLIB: STRBTM - MXBTMSE OVERFLOW')
71 else if (
itp(node) > 1 )
then
102 recursive subroutine gettagre ( lunit, tagi, ntagi, tagre, ntagre, iret )
104 use modv_vars,
only: im8b
112 integer,
intent(in) :: lunit, ntagi
113 integer,
intent(out) :: iret, ntagre
114 integer my_lunit, my_ntagi, lun, il, im, ni, nre, ltre, ii
116 character*(*),
intent(in) :: tagi
117 character*(*),
intent(out) :: tagre
124 call x84(lunit,my_lunit,1)
125 call x84(ntagi,my_ntagi,1)
126 call gettagre(my_lunit,tagi,my_ntagi,tagre,ntagre,iret)
127 call x48(ntagre,ntagre,1)
128 call x48(iret,iret,1)
137 call status( lunit, lun, il, im )
138 if ( il == 0 )
return
139 if (
inode(lun) /=
inv(1,lun) )
return
143 call fstag( lun, tagi, ntagi, 1, ni, iret )
144 if ( iret /= 0 )
return
149 call strsuc( tagre, tagtmp, ltre )
152 if (
tag(
inv(ii,lun))(1:ltre) == tagre(1:ltre) )
then
175 integer function igetrfel ( n, lun )
result ( iret )
185 integer,
intent(in) :: n, lun
186 integer node, ii, jj, nn, idxta, idn, ntc, nodflw, nodl236, nodbmap, nodrfe, nodnn, nodtam, idxbtm, iemrk, iect, &
189 character*(*),
parameter :: bort_str_mrkopr = &
190 'BUFRLIB: IGETRFEL - UNABLE TO FIND PREVIOUS ELEMENT REFERENCED BY MARKER OPERATOR '
191 character*128 bort_str
192 character*6 cflwopr,
adn30, fxy
199 if (
itp(node) > 1 )
then
200 if ( node ==
lstnod )
then
208 if (
ntamc > 0 )
then
209 nodtam =
lstjpb( node, lun,
'SUB' )
217 if ( ( idxta > 0 ) .and. (
nbtm > 0 ) )
then
222 cflwopr =
tag(node)(1:3) //
'000'
224 call nemtab( lun,
tag(node), idn, tab, nn )
225 if ( tab ==
'B' )
then
227 if ( fxy(2:3) ==
'33' ) cflwopr =
'222000'
230 if ( cflwopr ==
'XXXXXX' )
return
235 if ( (
ctco(idxta,jj) == cflwopr ) .and. (
inodtco(idxta,jj) >=
inode(lun) ) .and. &
238 if ( nodflw == 0 )
then
240 write(bort_str,
'("BUFRLB: IGETRFEL - UNABLE TO FIND FOLLOW OPERATOR ",A," IN SUBSET")') cflwopr
250 do while ( ( jj <= ntc ) .and. (
inodtco(idxta,jj) >=
inode(lun) ) .and. &
252 if (
ctco(idxta,jj) ==
'236000' )
then
254 if (
inodtco(idxta,jj) == nodflw ) nodbmap = nodflw
255 else if ( (
ctco(idxta,jj) ==
'235000' ) .or. (
ctco(idxta,jj) ==
'237255' ) )
then
257 else if ( (
ctco(idxta,jj) ==
'237000' ) .and. (
inodtco(idxta,jj) == nodflw ) .and. ( nodl236 /= 0 ) )
then
262 if ( nodbmap == 0 )
then
269 do while ( ( idxbtm == 0 ) .and. ( nn <=
nval(lun) ) )
270 if (
inv( nn, lun ) > nodbmap )
then
272 do while ( ( idxbtm == 0 ) .and. ( ii <=
nbtm ) )
273 if ( nn ==
istbtm(ii) )
then
282 if ( idxbtm == 0 )
then
284 write(bort_str,
'("BUFRLB: IGETRFEL - UNABLE TO FIND BITMAP FOR MARKER OPERATOR ",A)')
tag(node)
297 do while ( ( nn >= 1 ) .and. ( iret == 0 ) )
298 nodnn =
inv( nn, lun )
299 if ( nodnn <= nodbmap )
then
301 if ( ( nodnn ==
inodtco(idxta,jj) ) .and. (
ctco(idxta,jj) ==
'235000' ) )
then
306 if (
itp(nodnn) > 1 )
then
308 if ( iect == iemrk ) iret = nn
313 if ( iret == 0 )
then
320 nodrfe =
inv( iret, lun )
322 if (
tag(node)(1:3) ==
'225' )
then
323 ibt(node) =
ibt(nodrfe) + 1
324 irf(node) = -1 * (2 **
ibt(nodrfe))
330 if ( ( nodrfe /=
inodnrv(ii) ) .and. (
tag(nodrfe)(1:8) ==
tagnrv(ii) ) .and. &
331 ( nodrfe >=
isnrv(ii) ) .and. ( nodrfe <=
ienrv(ii) ) )
then
357 character*(*),
intent(in) :: nemo
359 if (len(nemo)<6)
then
361 else if ( ( nemo(4:6)==
'255' ) .and. &
362 ( ( nemo(1:3)==
'223' ) .or. ( nemo(1:3)==
'224' ) .or. ( nemo(1:3)==
'225' ) .or. ( nemo(1:3)==
'232' ) ) )
then
integer function igetrfel(n, lun)
Check whether a subset element refers to a previous element within the same subset via an internal bi...
subroutine strbtm(n, lun)
Store internal information in module moda_bitmaps if the input element is part of a bitmap.
recursive subroutine gettagre(lunit, tagi, ntagi, tagre, ntagre, iret)
Check whether a specified Table B mnemonic references another Table B mnemonic within the same data s...
integer function imrkopr(nemo)
Check whether a specified mnemonic is a Table C marker operator.
subroutine bort(str)
Log an error message, then abort the application program.
subroutine nemtab(lun, nemo, idn, tab, iret)
Get information about a descriptor, based on a mnemonic.
character *(*) function adn30(idn, ldn)
Convert an FXY value from its WMO bit-wise representation to a character string of length 5 or 6.
subroutine fstag(lun, utag, nutag, nin, nout, iret)
Search for a specified occurrence of a specified mnemonic within a data subset definition,...
integer function lstjpb(node, lun, jbtyp)
Search backwards, beginning from a given node within the jump/link table, until finding the most rece...
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 iszbtm
Size of bitmap (total number of entries, whether "set" (set to a value of 0) or not).
integer lstnod
Most recent jump/link table entry that was processed by function igetrfel() and whose corresponding v...
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 istbtm
Ordinal position in data subset definition corresponding to the first entry of the bitmap.
integer nbtm
Number of stored bitmaps for the current data subset (up to a maximum of mxbtm).
integer, dimension(:), allocatable inodtamc
Entries within jump/link table which contain Table A mnemonics.
integer, dimension(:,:), allocatable ibtmse
Ordinal positions in bitmap of bits that were "set" (set to a value of 0); these ordinal positions ca...
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.
integer, dimension(:), allocatable nbtmse
Number of "set" entries (set to a value of 0) in the bitmap.
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 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 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, dimension(:), allocatable inodnrv
Entries within jump/link table which contain new reference values.
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 *10, dimension(:), allocatable tag
Mnemonics in the jump/link table.
integer, dimension(:), allocatable itp
Integer type values corresponding to typ:
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 status(lunit, lun, il, im)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
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.