NCEPLIBS-bufr  12.2.0
•All Data Structures Namespaces Files Functions Variables Macros Pages
readbp.F90
Go to the documentation of this file.
1 
6 
14 
15 !-----------------------------------------------------------------------
16 ! Read and display an on29bufr file one report at a time
17 !-----------------------------------------------------------------------
18 program readbp
19 
20  character(120) :: file
21  character(50) :: optarg
22  character(40) :: hstr,ostr,qstr
23  character(10) :: val
24  character(8) :: sid,sta,subset,msg,cmc(17)
25  character(3) :: vars(8)
26  integer :: iostat
27  real(8) :: hdr(10),obs(10,255),qms(10,255),qmc(17),xob,yob
28  logical :: window,steam,level,dump,hedr,exist
29 
30  equivalence(hdr(1),sid)
31  equivalence(qmc,cmc)
32 
33  data hstr/'SID XOB YOB DHR ELV T29 ITP TYP SRC PRG '/
34  data ostr/'CAT POB QOB TOB ZOB UOB VOB PSL '/
35  data qstr/'PQM QQM TQM ZQM WQM PSQ '/
36 
37  data vars/'LVL','CAT','POB','SPH','TOB','ZOB','UOB','VOB'/
38  data cmc /'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','*'/
39 
40  data lubfr /8 /
41  data sta /' '/
42  data msg /' '/
43  data pob /0/
44  data irt /0/
45  data itp /0/
46  data ikx /0/
47  data window /.false./
48  data steam /.false./
49  data level /.false./
50  data dump /.false./
51  data hedr /.false./
52 
53 !-----------------------------------------------------------------------
54 !-----------------------------------------------------------------------
55 
56 ! check for filename argument
57 
58  narg=command_argument_count()
59 1 if(narg<1) then
60  call printx(' ')
61  call printx('Usage: readbp <-s> <-w> <m> <-k> <-r> <-d> <-n> <-h> prep bufrfile ')
62  call printx(' ')
63  call printx('Search filter and/or print prepbufr reports in various ways ')
64  call printx(' ')
65  call printx('-s "station_id " print reports where "station_id" matches the report id up to the len of "station_id" ')
66  call printx('-w "x1 x2 y1 y2" print reports within a lon/lat box ')
67  call printx('-m "subset " print reports with this subset name ')
68  call printx('-k "gsi rtype " print reports with this gsi report type ')
69  call printx('-r "on29 rtype " print reports with this on29 report type ')
70  call printx('-d print reports using ufdump - note: this works with any NCEP BUFR file ')
71  call printx('-n no pause between reports output ')
72  call printx('-h print only report headers ')
73  call printx(' ')
74  call printx('Only a filename is required in which case step through the reports one at a time using "enter" ')
75  call printx(' ')
76  call printx('Optional arguments can also be applied in the pause between reports output without using a dash ')
77  call printx(' ')
78  call printx('Optional arguments will be applied in concert in most cases ')
79  call printx(' ')
80  stop 2
81  endif
82 
83  iarg=1
84  do while(iarg<=narg)
85  call get_command_argument(iarg,file)
86  if(file(1:1)=='-') then
87  if(file(2:2)=='s') then
88  iarg=iarg+1; call get_command_argument(iarg,sta); nsta=len(trim(sta))
89  elseif(file(2:2)=='w') then
90  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)x1
91  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)x2
92  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)y1
93  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)y2
94  window=.true.
95  elseif(file(2:2)=='k') then
96  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)ikx
97  elseif(file(2:2)=='r') then
98  iarg=iarg+1; call get_command_argument(iarg,val); read(val,*)irt
99  elseif(file(2:2)=='m') then
100  iarg=iarg+1; call get_command_argument(iarg,val); msg=val(1:8)
101  elseif(file(2:2)=='d') then
102  iarg=iarg+1; dump=.true.
103  elseif(file(2:2)=='h') then
104  iarg=iarg+1; hedr=.true.
105  elseif(file(2:2)=='n') then
106  iarg=iarg+1; steam=.true.
107  else
108  iarg=iarg+1
109  endif
110  file='nofile'
111  cycle
112  endif
113  iarg=iarg+1
114  enddo
115 
116 ! if file exists then open it, else stop
117 
118  narg=0
119  if(file=='nofile') goto 1
120  file = trim(adjustl(file))
121  inquire(file=file,exist=exist)
122  if (.not.exist) then
123  print *, trim(file)//' does not exist'
124  stop 3
125  endif
126 
127 ! open the bufr input file
128 ! ------------------------
129 
130  open(lubfr,file=file,form='unformatted')
131  call openbf(lubfr,'IN',lubfr)
132  call datelen(10)
133 
134 ! Read a subset - read another message when no more subsets
135 ! ---------------------------------------------------------
136 
137  do while(ireadmg(lubfr,subset,idate)==0)
138  do while(ireadsb(lubfr)==0)
139  call ufbcnt(lubfr,irec,isub)
140 
141  IF(msg/=' ' .and. msg/=subset) stop
142 
143  if(dump) then
144  call ufdump(lubfr,6)
145  goto 99
146  endif
147 
148 ! Move subset contents into this program
149 ! --------------------------------------
150 
151  call ufbint(lubfr,hdr,10, 1,iret,hstr)
152  xob = hdr(2)
153  yob = hdr(3)
154  jrt = nint(hdr(6))
155  jtp = nint(hdr(7))
156  jkx = nint(hdr(8))
157  if(sta/=' ' .and. sta/=sid(1:nsta)) cycle
158  if(irt/=0 .and. irt/=jrt) cycle
159  if(itp/=0 .and. itp/=jtp) cycle
160  if(ikx/=0 .and. ikx/=jkx) cycle
161  if(window) then
162  if(.not.(xob>=x1 .and. xob<=x2))cycle
163  if(.not.(yob>=y1 .and. yob<=y2))cycle
164  endif
165 
166  call ufbint(lubfr,obs,10,255,nlev,ostr)
167  call ufbint(lubfr,qms,10,255,nleq,qstr)
168  if(nlev/=nleq) stop 'NLEV<>NLEQ'
169 
170 ! Move cat 8 data to print range
171 ! ------------------------------
172  do l=1,nlev
173  if(obs(1,l)==8) then
174  obs(2,l) = obs(9,l)
175  obs(3,l) = obs(10,l)
176  endif
177  enddo
178 
179 ! Print a report 20 lines at a time
180 ! ---------------------------------
181 
182  if(hedr) then
183  print'(a8,1x,a8,7(f8.2,1x))',subset,(hdr(i),i=1,8)
184  if(steam) cycle
185  goto 99
186  else
187  print'(80(''-''))'
188  print'(''MESSAGE: '',a8,2(2x,i4),i12 )' , subset,irec,isub,idate
189  print'(''STATION: '',a8,1x,2(f8.2,1X))' , (hdr(i),i= 1,3)
190  print'(''TIME: '',i10,2x,f8.2 )' , idate,hdr(4)
191  print'(''ELV: '',f8.2 )' , (hdr(5) )
192  print'(''TYPE: '',3(f8.0,1x) )' , (hdr(i),i= 6,8)
193  print'(''DATA: '' )'
194  endif
195 
196  do l=1,nlev
197  do i=1,7
198  iqm = nint(qms(i,l))
199  if(iqm<0)iqm=10e8
200  iqm = min(iqm,16)
201  qms(i,l) = qmc(iqm+1)
202  enddo
203  enddo
204 
205  nlne = 7
206  print'(2(1x,a3),6(8x,a3))',vars
207  do l=1,nlev
208  nlne = nlne+1
209  print 11, l,nint(obs(1,l)),(obs(i,l),qms(min(i-1,5),l),i=2,7)
210 11 format(2i4,6(1x,f7.1,'(',a1,')'))
211  enddo
212  print'(80(''-''))'
213  if(steam) cycle
214 
215 ! Go to read the next subset if no 'Q'
216 ! ------------------------------------
217 
218 99 read(5,'(a)',iostat=iostat) optarg
219  if(optarg(1:1)=='q') then
220  stop
221  elseif(optarg(1:1)=='s') then
222  read(optarg(2:50),*) sta
223  nsta=len(trim(sta))
224  elseif(optarg(1:1)=='w') then
225  read(optarg(2:50),*) x1,x2,y1,y2
226  window=.true.
227  elseif(optarg(1:1)=='k') then
228  read(optarg(2:50),*) ikx
229  elseif(optarg(1:1)=='r') then
230  read(optarg(2:50),*) irt
231  elseif(optarg(1:1)=='m') then
232  read(optarg(2:50),*) msg
233  elseif(optarg(1:1)=='d') then
234  call ufdump(lubfr,6)
235  elseif(optarg(1:1)=='h') then
236  hedr=.true.
237  endif
238 
239  enddo ! end of subset loop
240  enddo ! end of message loop
241 
242 ! Here when all messages have been read
243 ! -------------------------------------
244 
245  stop
246 end program readbp
247 
253 subroutine printx(str)
254  character(*) :: str
255  lens=len(str)
256  do i=1,lens-1
257  write(*,'(a1)',advance="no")str(i:i)
258  enddo
259  write(*,'(a1)')str(lens:lens)
260 end subroutine
ufdump
recursive subroutine ufdump(lunit, luprt)
Print a verbose listing of the contents of a data subset, including all data values and replicated se...
Definition: dumpdata.F90:228
openbf
recursive subroutine openbf(lunit, io, lundx)
Connect a new file to the NCEPLIBS-bufr software for input or output operations, or initialize the li...
Definition: openclosebf.F90:168
ufbcnt
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...
Definition: openclosebf.F90:579
printx
subroutine printx(str)
Print long lines to stdout using advance=no format clause.
Definition: readbp.F90:254
readbp
program readbp
Read PREPBUFR file containing embedded DX BUFR tables, and print each report one at a time.
Definition: readbp.F90:18
ireadmg
recursive integer function ireadmg(lunit, subset, idate)
Call subroutine readmg() and pass back its return code as the function value.
Definition: readwritemg.F90:142
ireadsb
recursive integer function ireadsb(lunit)
Call subroutine readsb() and pass back its return code as the function value.
Definition: readwritesb.F90:117
ufbint
recursive subroutine ufbint(lunin, usr, i1, i2, iret, str)
Read or write one or more data values from or to a data subset.
Definition: readwriteval.F90:642
datelen
recursive subroutine datelen(len)
Specify the format of Section 1 date-time values that will be output by future calls to any of the NC...
Definition: s013vals.F90:886