14 CHARACTER*50 headr,obstr,qmstr
16 CHARACTER*8 subset,date
17 dimension knt(300,7,0:17),hdr(5),obs(8,255),qms(8,255)
21 DATA headr /
'SID XOB YOB DHR TYP '/
22 DATA obstr /
'POB QOB TOB ZOB UOB PWO RHO VOB '/
23 DATA qmstr /
'PQM QQM TQM ZQM WQM PWQ RHQ '/
25 DATA vars /
'PRESSURE ',&
45 call get_command_argument(1,file); file=trim(adjustl(file))
47 print *,
'Usage: Usage: cmpbqm <prepbufrfile> will print prep inventory by variable, report type, and qc mark'
50 inquire(file=file,exist=exist)
52 print *, trim(file)//
' does not exist'
56 open(lubfr,file=file,form=
'unformatted')
57 CALL openbf(lubfr,
'IN',lubfr)
58 CALL readmg(lubfr,subset,idate,iret)
60 WRITE(date,
'(I8)') idate
62 IF(date(i:i)==
' ') date(i:i) =
'0'
64 print
'(''DATA VALID AT '',A8)',date
71 CALL readmg(lubfr,subset,idate,iret)
73 CALL ufbcnt(lubfr,irec,isub)
77 CALL ufbint(lubfr,hdr,5,1,iret,headr)
78 CALL ufbint(lubfr,obs,8,255,nlev,obstr)
79 CALL ufbint(lubfr,qms,8,255,nlev,qmstr)
86 IF(k==5) obs(5,l) = max(obs(5,l),obs(8,l))
87 IF(obs(k,l)<vmax .AND. qms(k,l)<vmax)
THEN
89 ELSEIF(obs(k,l)<vmax .AND. qms(k,l)>=vmax)
THEN
91 ELSEIF(obs(k,l)>=vmax .AND. qms(k,l)<vmax)
THEN
94 IF(iq>=0) knt(kx,k,iq) = knt(kx,k,iq)+1
107 itot = 0; igood=0; ifail=0
109 itot = itot+knt(kx,k,iq)
111 igood=igood+knt(kx,k,iq)
113 ifail=ifail+knt(kx,k,iq)
116 IF(itot>0) print 101,kx,itot,igood,ifail,(knt(kx,k,iq),iq=8,17)
117 101
FORMAT(i3,i6,2(
'|', i6),&
125 print*,
'******CMPBQM PROCESSED ',irec,
' BUFR RECORDS******'
127 900
CALL bort(
'CMPBQM - ERROR READING BUFR FILE ')
subroutine bort(str)
Log an error message, then abort the application program.
program cmpbqm
Usage: cmpbqm <prepbufrfile> will print prep inventory by variable, report type, and qc mark.
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 ufbcnt(lunit, kmsg, ksub)
Get the current location of the file pointer within a BUFR file, in terms of a message number countin...
recursive subroutine readmg(lunxx, subset, jdate, iret)
Read the next BUFR message from logical unit abs(lunxx) into internal arrays.
recursive subroutine readsb(lunit, iret)
Read the next data subset from a BUFR message.
recursive subroutine ufbint(lunin, usr, i1, i2, iret, str)
Read or write one or more data values from or to a data subset.