NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
cmpbqm.f90
Go to the documentation of this file.
1 
4 
5 !-----------------------------------------------------------------------
6 ! MAIN PROGRAM CMPBQM
7 !-----------------------------------------------------------------------
8  PROGRAM cmpbqm
9 
10  CHARACTER*255 file
11  CHARACTER*50 headr,obstr,qmstr,fcstr,erstr,qmsfc
12  CHARACTER*20 vars(7)
13  CHARACTER*8 subset,date
14  dimension knt(300,7,0:17),hdr(5),obs(8,255),qms(8,255)
15  LOGICAL skip,exist
16  REAL*8 hdr,obs,qms
17 
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 '/
21 
22  DATA vars /'PRESSURE ',&
23  'SPECIFIC HUMIDTY',&
24  'TEMPERATURE ',&
25  'HEIGHT ',&
26  'WIND COMPONENTS ',&
27  'PRECIPITABLE H2O',&
28  'RELATIVE HUMIDTY'/
29 
30  DATA lubfr /8 /
31  DATA vmax /10e10/
32 
33 !-----------------------------------------------------------------------
34 !-----------------------------------------------------------------------
35 
36  irec = 0
37  knt = 0
38 
39 ! OPEN A FILE - GET A DATE
40 ! ------------------------
41 
42  call getarg(1,file); file=trim(adjustl(file))
43  if (file == '') call bort('Usage: "cmpbqm prepbufrfile" will print prep inventory by variable, report type, and qc mark')
44  inquire(file=file,exist=exist)
45  if (.not.exist) call bort(trim(file)//' does not exist')
46 
47  open(lubfr,file=file,form='unformatted')
48  CALL openbf(lubfr,'IN',lubfr)
49  CALL readmg(lubfr,subset,idate,iret)
50  IF(iret.NE.0) goto 900
51  WRITE(date,'(I8)') idate
52  DO i=1,8
53  IF(date(i:i).EQ.' ') date(i:i) = '0'
54  ENDDO
55  print'(''DATA VALID AT '',A8)',date
56 
57 ! READ THRU THE PREPDA RECORDS
58 ! ----------------------------
59 
60 10 CALL readsb(lubfr,iret)
61  IF(iret.NE.0) THEN
62  CALL readmg(lubfr,subset,idate,iret)
63  IF(iret.NE.0) goto 100
64  CALL ufbcnt(lubfr,irec,isub)
65  goto 10
66  ENDIF
67  qms = 10e10
68  CALL ufbint(lubfr,hdr,5,1,iret,headr)
69  CALL ufbint(lubfr,obs,8,255,nlev,obstr)
70  CALL ufbint(lubfr,qms,8,255,nlev,qmstr)
71 
72  kx = hdr(5)
73 
74  DO l=1,nlev
75  DO k=1,7
76  iq = -1
77  IF(k.EQ.5) obs(5,l) = max(obs(5,l),obs(8,l))
78  IF(obs(k,l).LT.vmax .AND. qms(k,l).LT.vmax) THEN
79  iq = qms(k,l)
80  ELSEIF(obs(k,l).LT.vmax .AND. qms(k,l).GE.vmax) THEN
81  iq = 16
82  ELSEIF(obs(k,l).GE.vmax .AND. qms(k,l).LT.vmax) THEN
83  iq = 17
84  ENDIF
85  IF(iq.GE.0) knt(kx,k,iq) = knt(kx,k,iq)+1
86  ENDDO
87  ENDDO
88 
89  goto 10
90 
91 ! FINISH UP
92 ! ---------
93 
94 100 DO k=1,7
95  print*,vars(k)
96  print*
97  DO kx=1,300
98  itot = 0; igood=0; ifail=0
99  DO iq=0,17
100  itot = itot+knt(kx,k,iq)
101  if(iq.le.3) then
102  igood=igood+knt(kx,k,iq)
103  elseif(iq.le.7) then
104  ifail=ifail+knt(kx,k,iq)
105  endif
106  ENDDO
107  IF(itot.GT.0) print 101,kx,itot,igood,ifail,(knt(kx,k,iq),iq=8,17)
108 101 FORMAT(i3,i6,2('|', i6),&
109  2('|', i6),&
110  1('|',6i6),&
111  2('|', i6))
112  ENDDO
113  print*
114  ENDDO
115 
116  print*,'******CMPBQM PROCESSED ',irec,' BUFR RECORDS******'
117  stop
118 900 CALL bort('CMPBQM - ERROR READING BUFR FILE ')
119  END
subroutine openbf(LUNIT, IO, LUNDX)
This subroutine connects a new file to the BUFRLIB software for input or output operations.
Definition: openbf.f:138
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...
Definition: ufbint.f:152
subroutine ufbcnt(LUNIT, KMSG, KSUB)
This subroutine returns the current location of the file pointer within a BUFR file, in terms of a message number counting from the beginning of the file, and a data subset number counting from the beginning of that message.
Definition: ufbcnt.f:45
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
subroutine readmg(LUNXX, SUBSET, JDATE, IRET)
This subroutine reads the next BUFR message from logical unit ABS(LUNXX) into internal arrays...
Definition: readmg.f:73
subroutine readsb(LUNIT, IRET)
This subroutine reads the next data subset from a BUFR message into internal arrays.
Definition: readsb.f:47