23 recursive subroutine atrcpt(msgin,lmsgot,msgot)
25 use modv_vars,
only: im8b, nbytw
31 integer,
intent(in) :: msgin(*), lmsgot
32 integer,
intent(out) :: msgot(*)
33 integer my_lmsgot, len0, len1, l2, l3, l4, l5, iad1, iad2, lenm, lenmot, len1ot, ibit,
iupbs01
40 call x84 ( lmsgot, my_lmsgot, 1 )
41 call atrcpt ( msgin, my_lmsgot*2, msgot )
49 call getlens(msgin,1,len0,len1,l2,l3,l4,l5)
59 if(lenmot>(lmsgot*nbytw)) &
60 call bort(
'BUFRLIB: ATRCPT - OVERFLOW OF OUTPUT MESSAGE ARRAY; TRY A LARGER DIMENSION FOR THIS ARRAY')
66 call mvb ( msgin, 1, msgot, 1, 4 )
68 call pkb ( lenmot, 24, msgot, ibit )
69 call mvb ( msgin, 8, msgot, 8, 1 )
74 call pkb ( len1ot, 24, msgot, ibit )
78 call mvb ( msgin, iad1+4, msgot, (ibit/8)+1, len1-3 )
91 call mvb ( msgin, iad2+1, msgot, (ibit/8)+1, lenm-iad2 )
113 recursive subroutine rtrcptb(mbay,iyr,imo,idy,ihr,imi,iret)
115 use modv_vars,
only: im8b
119 integer,
intent(in) :: mbay(*)
120 integer,
intent(out) :: iyr, imo, idy, ihr, imi, iret
128 call rtrcptb(mbay,iyr,imo,idy,ihr,imi,iret)
134 call x48(iret,iret,1)
144 if(
iupbs01(mbay,
'BEN')==4)
then
149 if( (is1byt+5) >
iupbs01(mbay,
'LEN1') )
return
156 imgbyt = is1byt +
iupbs01(mbay,
'LEN0')
158 iyr =
iupb(mbay,imgbyt,16)
159 imo =
iupb(mbay,imgbyt+2,8)
160 idy =
iupb(mbay,imgbyt+3,8)
161 ihr =
iupb(mbay,imgbyt+4,8)
162 imi =
iupb(mbay,imgbyt+5,8)
186 recursive subroutine rtrcpt(lunit,iyr,imo,idy,ihr,imi,iret)
188 use modv_vars,
only: im8b
194 integer,
intent(in) :: lunit
195 integer,
intent(out) :: iyr, imo, idy, ihr, imi, iret
196 integer my_lunit, lun, il, im
203 call x84(lunit,my_lunit,1)
204 call rtrcpt(my_lunit,iyr,imo,idy,ihr,imi,iret)
210 call x48(iret,iret,1)
218 call status(lunit,lun,il,im)
219 if(il==0)
call bort(
'BUFRLIB: RTRCPT - INPUT BUFR FILE IS CLOSED; IT MUST BE OPEN FOR INPUT')
220 if(il>0)
call bort(
'BUFRLIB: RTRCPT - INPUT BUFR FILE IS OPEN FOR OUTPUT; IT MUST BE OPEN FOR INPUT')
221 if(im==0)
call bort(
'BUFRLIB: RTRCPT - A MESSAGE MUST BE OPEN IN INPUT BUFR FILE; NONE ARE')
257 recursive subroutine strcpt(cf,iyr,imo,idy,ihr,imi)
259 use modv_vars,
only: im8b
265 character*1,
intent(in) :: cf
266 character*128 bort_str
268 integer,
intent(in) :: iyr, imo, idy, ihr, imi
269 integer my_iyr, my_imo, my_idy, my_ihr, my_imi
276 call x84(iyr,my_iyr,1)
277 call x84(imo,my_imo,1)
278 call x84(idy,my_idy,1)
279 call x84(ihr,my_ihr,1)
280 call x84(imi,my_imi,1)
281 call strcpt(cf,my_iyr,my_imo,my_idy,my_ihr,my_imi)
288 if(cf/=
'Y' .and. cf/=
'N')
then
289 write(bort_str,
'("BUFRLIB: STRCPT - INPUT ARGUMENT IS ",A1,", IT MUST BE EITHER Y OR N")') cf
subroutine bort(str)
Log an error message, then abort the application program.
recursive integer function iupb(mbay, nbyt, nbit)
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 mvb(ib1, nb1, ib2, nb2, nbm)
Copy a specified number of bytes from one packed binary array to another.
subroutine capit(str)
Capitalize all of the alphabetic characters in a string.
Declare arrays and variables used to store BUFR messages internally for multiple file IDs.
integer, dimension(:,:), allocatable mbay
Current BUFR message for each file ID.
Declare variables used to store tank receipt time information within Section 1 of BUFR messages.
integer itrhr
Tank receipt hour.
integer itryr
Tank receipt year.
integer itrdy
Tank receipt day.
character *1 ctrt
Flag indicating whether tank receipt times are to be included within output BUFR messages; this varia...
integer itrmi
Tank receipt minute.
integer itrmo
Tank receipt month.
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.
recursive integer function iupbs01(mbay, s01mnem)
Read a specified value from within Section 0 or Section 1 of a BUFR message.
recursive subroutine strcpt(cf, iyr, imo, idy, ihr, imi)
Specify a tank receipt time to be included within Section 1 of all BUFR messages output by future cal...
recursive subroutine rtrcpt(lunit, iyr, imo, idy, ihr, imi, iret)
Read the tank receipt time (if one exists) from Section 1 of a BUFR message.
recursive subroutine rtrcptb(mbay, iyr, imo, idy, ihr, imi, iret)
Read the tank receipt time (if one exists) from Section 1 of a BUFR message.
recursive subroutine atrcpt(msgin, lmsgot, msgot)
Read an input message and output an equivalent BUFR message with a tank receipt time added to Section...
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.