11 CHARACTER*50 headr,obstr,qmstr,fcstr,erstr,qmsfc
13 CHARACTER*8 subset,date
14 dimension knt(300,7,0:17),hdr(5),obs(8,255),qms(8,255)
18 DATA headr /
'SID XOB YOB DHR TYP '/
19 DATA obstr /
'POB QOB TOB ZOB UOB PWO RHO VOB '/
20 DATA qmstr /
'PQM QQM TQM ZQM WQM PWQ RHQ '/
22 DATA vars /
'PRESSURE ',
42 read(5,
'(a)',end=100) file
43 open(lubfr,file=file,form=
'unformatted')
44 CALL
openbf(lubfr,
'IN',lubfr)
45 CALL
readmg(lubfr,subset,idate,iret)
46 IF(iret.NE.0) goto 900
47 WRITE(date,
'(I8)') idate
49 IF(date(i:i).EQ.
' ') date(i:i) =
'0'
51 print
'(''DATA VALID AT '',A8)',date
58 CALL
readmg(lubfr,subset,idate,iret)
59 IF(iret.NE.0) goto 100
60 CALL
ufbcnt(lubfr,irec,isub)
64 CALL
ufbint(lubfr,hdr,5,1,iret,headr)
65 CALL
ufbint(lubfr,obs,8,255,nlev,obstr)
66 CALL
ufbint(lubfr,qms,8,255,nlev,qmstr)
73 IF(k.EQ.5) obs(5,l) = max(obs(5,l),obs(8,l))
74 IF(obs(k,l).LT.vmax .AND. qms(k,l).LT.vmax)
THEN
76 ELSEIF(obs(k,l).LT.vmax .AND. qms(k,l).GE.vmax)
THEN
78 ELSEIF(obs(k,l).GE.vmax .AND. qms(k,l).LT.vmax)
THEN
81 IF(iq.GE.0) knt(kx,k,iq) = knt(kx,k,iq)+1
94 itot = 0; igood=0; ifail=0
96 itot = itot+knt(kx,k,iq)
98 igood=igood+knt(kx,k,iq)
100 ifail=ifail+knt(kx,k,iq)
103 IF(itot.GT.0) print101,kx,itot,igood,ifail,(knt(kx,k,iq),iq=8,17)
104 101
FORMAT(i3,i6,2(
'|', i6),
112 print*,
'******CMPBQM PROCESSED ',irec,
' BUFR RECORDS******'
114 900 CALL
bort(
'CMPBQM - ERROR READING BUFR FILE ')
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
subroutine ufbint(LUNIN, USR, I1, I2, IRET, STR)
This subroutine reads or writes one or more data values from or to the BUFR data subset that is curre...
subroutine ufbcnt(LUNIT, KMSG, KSUB)
THIS SUBROUTINE RETURNS A COUNT OF THE CURRENT MESSAGE NUMBER AND SUBSET NUMBER, WHERE THE MESSAGE NU...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
subroutine readmg(LUNXX, SUBSET, JDATE, IRET)
This subroutine reads the next BUFR message from logical unit ABS(LUNXX) into internal arrays...
subroutine readsb(LUNIT, IRET)
This subroutine reads the next data subset from a BUFR message into internal arrays.