19 use modv_vars,
only: nbitw
23 integer,
intent(in) :: idn, ldn
25 integer i, idf, idx, idy
28 character*128 bort_str
30 if(len(
adn30)<ldn)
call bort(
'BUFRLIB: ADN30 - FUNCTION RETURN STRING TOO SHORT')
31 if(idn<0 .or. idn>65535)
call bort(
'BUFRLIB: ADN30 - INTEGER REPRESENTATION OF DESCRIPTOR OUT OF 16-BIT RANGE')
34 write(
adn30,
'(i5)') idn
37 idx = ishft(ishft(idn,nbitw-14),-(nbitw-6))
38 idy = ishft(ishft(idn,nbitw- 8),-(nbitw-8))
39 write(
adn30,
'(i1,i2,i3)') idf,idx,idy
41 write(bort_str,
'("BUFRLIB: ADN30 - CHARACTER LENGTH (",I4,") MUST BE EITHER 5 OR 6")') ldn
68 integer,
intent(in) :: idn
70 character*(*),
intent(out) :: adn
90 integer function idn30(adn,ldn)
result(iret)
94 integer,
intent(in) :: ldn
96 character*(*),
intent(in) :: adn
98 character*128 bort_str
102 if(len(adn)<ldn)
then
103 write(bort_str,
'("BUFRLIB: IDN30 - FUNCTION INPUT STRING ",A," CHARACTER LENGTH (",I4,") IS TOO SHORT (< LDN,",I5)') &
109 read(adn,
'(i5)') iret
110 if(iret<0 .or. iret>65535)
then
112 '("BUFRLIB: IDN30 - DESCRIPTOR INTEGER REPRESENTATION, IDN30 (",I8,"), IS OUTSIDE 16-BIT RANGE (0-65535)")') iret
118 write(bort_str,
'("BUFRLIB: IDN30 - FUNCTION INPUT STRING ",A," CHARACTER LENGTH (",I4,") MUST BE EITHER 5 OR 6")') &
151 integer function ifxy(adsc)
result(iret)
157 character*6,
intent(in) :: adsc
159 read(adsc,
'(i1,i2,i3)')
if,ix,iy
160 iret = if*2**14 + ix*2**8 + iy
178 integer function igetfxy ( str, cfxy )
result ( iret )
182 character*(*),
intent(in) :: str
183 character*6,
intent(out) :: cfxy
185 integer,
parameter :: lstr2 = 120
186 character*(lstr2) str2
193 if ( lstr < 6 )
return
197 if ( lstr > lstr2 )
then
198 str2(1:lstr2) = str(1:lstr2)
202 str2 = adjustl( str2 )
203 if ( str2 ==
' ' )
return
207 if ( index( str2,
'-' ) /= 0 )
then
209 cfxy(1:1) = str2(1:1)
210 cfxy(2:3) = str2(3:4)
211 cfxy(4:6) = str2(6:8)
219 if (
numbck( cfxy ) == 0 ) iret = 0
236 integer function numbck(numb)
result(iret)
240 character*6,
intent(in) :: numb
246 if( llt(numb(1:1),
'0') .or. lgt(numb(1:1),
'3') )
then
253 if( verify(numb(2:6),
'1234567890') == 0 )
then
254 read(numb,
'(1x,i2,i3)') ix,iy
260 if(ix<0 .or. ix> 63)
then
263 else if(iy<0 .or. iy>255)
then
295 integer,
intent(in) :: lun, idn
296 integer,
intent(out) :: iret
299 character*(*),
intent(out) :: nemo
300 character,
intent(out) :: tab
306 if(idn>=ifxy(
'300000'))
then
309 if(idn==
idnd(i,lun))
then
310 nemo =
tabd(i,lun)(7:14)
319 if(idn==
idnb(i,lun))
then
320 nemo =
tabb(i,lun)(7:14)
358 use modv_vars,
only: idnr
362 integer,
intent(in) :: lun, idn
363 integer,
intent(out) :: iret
366 character*(*),
intent(out) :: nemo
367 character,
intent(out) :: tab
368 character*6 adn30, cid
376 if(idn>=idnr(1) .and. idn<=idnr(6))
then
386 if(idn==idnr(i))
then
390 elseif(idn==idnr(i+5))
then
399 call numtbd(lun,idn,nemo,tab,iret)
405 if (iokoper(cid)==1)
then
407 read(nemo,
'(1X,I2)') iret
437 integer,
intent(in) :: lun
438 integer,
intent(out) :: idn, iret
439 integer i, j, ifxy, iokoper
441 character*(*),
intent(in) :: nemo
442 character,
intent(out) :: tab
447 folval = nemo(1:1)==
'.'
453 outer:
do i=1,
ntbb(lun)
454 nemt =
tabb(i,lun)(7:14)
460 elseif(folval.and.nemt(1:1)==
'.')
then
462 if(nemt(j:j)/=
'.' .and. nemt(j:j)/=nemo(j:j)) cycle outer
478 nemt =
tabd(i,lun)(7:14)
489 if (iokoper(nemo)==1)
then
490 read(nemo,
'(1X,I2)') iret
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.
integer function numbck(numb)
Check an FXY number for validity.
subroutine cadn30(idn, adn)
Convert an FXY value from its WMO bit-wise representation to its 6 character representation.
subroutine numtab(lun, idn, nemo, tab, iret)
Get information about a descriptor, based on the WMO bit-wise representation of an FXY value.
integer function idn30(adn, ldn)
Convert an FXY value from a character string to the WMO bit-wise representation.
subroutine numtbd(lun, idn, nemo, tab, iret)
Get information about a Table B or Table D descriptor, based on the WMO bit-wise representation of an...
integer function igetfxy(str, cfxy)
Search for and return a valid FXY number from within a character string.
integer function ifxy(adsc)
Convert an FXY value from its 6 character representation to its WMO bit-wise representation.
character *(*) function adn30(idn, ldn)
Convert an FXY value from its WMO bit-wise representation to a character string of length 5 or 6.
Declare arrays and variables used to store DX BUFR tables internally for multiple file IDs.
character *600, dimension(:,:), allocatable tabd
Table D entries for each file ID.
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.