Sample program for module qcspa.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20#include "config.h"
21
22program v7d_qcspa
23
32
37
38#ifdef HAVE_LIBNCARG
39USE ncar_plot_class
40#endif
41
42implicit none
43
44integer :: category,io,ier,i,iun,n,ind
45character(len=512):: a_name,output_format, output_template
46
47
48TYPE(optionparser) :: opt
49TYPE(geo_coord) :: coordmin, coordmax
50TYPE(datetime) :: time,ti, tf, timei, timef, timeiqc, timefqc
51type(qcspatype) :: v7dqcspa
52type(vol7d_dballe) :: v7ddballe
53#ifdef HAVE_LIBNCARG
54type(ncar_plot) :: plot
55#endif
56
57integer, parameter :: maxvar=10
58character(len=6) :: var(maxvar)=cmiss
59#ifdef HAVE_DBALLE
60character(len=512) :: dsn='test1',user='test',password=''
61character(len=512) :: dsne='test',usere='test',passworde=''
62character(len=512) :: dsnspa='test',userspa='test',passwordspa=''
63#endif
64integer :: years=imiss,months=imiss,days=imiss,hours=imiss,yeare=imiss,monthe=imiss,daye=imiss,houre=imiss,nvar=0
65doubleprecision :: lons=dmiss,lats=dmiss,lone=dmiss,late=dmiss
66integer :: year, month, day, hour
67logical :: height2level=.false.,doplot=.false.,version
68CHARACTER(len=512) :: input_file, output_file
69INTEGER :: optind, optstatus, ninput
70CHARACTER(len=20) :: operation
71TYPE(ARRAYOF_REAL):: grad
72real :: val
73integer :: iostat
74REAL, DIMENSION(11) :: perc_vals=(/(10.*i,i=0,10)/)
75REAL, DIMENSION(size(perc_vals)-1) :: ndi
76REAL, DIMENSION(size(perc_vals)) :: nlimbins
77double precision, dimension(2) :: percentile
78TYPE(cyclicdatetime) :: cyclicdt
79type(vol7d_level) :: level,levelo
80type(vol7d_timerange) :: timerange,timerangeo
81type(vol7d_var) :: varia,variao
82CHARACTER(len=vol7d_ana_lenident) :: ident
83integer :: indcana,indctime,indclevel,indctimerange,indcdativarr,indcnetwork,indcattr
84INTEGER,POINTER :: w_s(:), w_e(:)
85TYPE(vol7d_dballe) :: v7d_dba_out
86logical :: file
87integer :: status,grunit
88
89#ifdef HAVE_DBALLE
90namelist /odbc/ dsn,user,password,dsne,usere,passworde
91namelist /odbcspa/ dsnspa,userspa,passwordspa
92#endif
93namelist /switchspa/ height2level,doplot
94namelist /minmax/ years,months,days,hours,lons,lats,yeare,monthe,daye,houre,lone,late
95namelist /varlist/ var
96
97
99
100
101call l4f_launcher(a_name,a_name_force="v7d_qcspa")
102
103
104category=l4f_category_get(a_name//".main")
105
106
107
108opt = optionparser_new(description_msg= &
109 'Spatial quality control: compute gradient; compute NDI from gradient; apply quality control', &
110 usage_msg='Usage: v7d_qcspa [options] [inputfile1] [inputfile2...] [outputfile] \n&
111 &If input-format is of file type, inputfile ''-'' indicates stdin,'&
112#ifdef HAVE_DBALLE
113 //'if output-format is of database type, outputfile specifies &
114 &database access info in URI form,' &
115#endif
116 //'if empty or ''-'', a suitable default is used. &
117&')
118
119
121 'operation to execute: ''gradient'' compute gradient and write on files; '&
122 //'''ndi'' compute NDI from gradient;' &
123 //'''run'' apply quality control ')
124
125
126
127output_template = ''
128CALL optionparser_add(opt,
' ',
'output-format', output_format,
'native', help= &
129 'format of output file for "ndi" operation only, in the form ''name[:template]''; ''native'' for vol7d &
130 &native binary format (no template to be specified)'&
131#ifdef HAVE_DBALLE
132 //'; ''BUFR'' and ''CREX'' for corresponding formats, with template as an alias like ''synop'', ''metar'', &
133 &''temp'', ''generic'', empty for ''generic'''&
134#endif
135)
136
137
138CALL optionparser_add_help(opt, 'h', 'help', help='show an help message and exit')
139CALL optionparser_add(opt,
' ',
'version', version, help=
'show version and exit')
140
141
142CALL optionparser_parse(opt, optind, optstatus)
143
144IF (optstatus == optionparser_help) THEN
145 CALL exit(0)
146ELSE IF (optstatus == optionparser_err) THEN
148 CALL raise_fatal_error()
149ENDIF
150IF (version) THEN
151 WRITE(*,'(A,1X,A)')'v7d_qcspa',version
152 CALL exit(0)
153ENDIF
154
155
156if (operation /= "gradient" .and. operation /= "ndi" .and. operation /= "run") then
157 CALL optionparser_printhelp(opt)
159 'argument to --operation is wrong')
160 CALL raise_fatal_error()
161end if
162
163
164
165n = word_split(output_format, w_s, w_e, ':')
166IF (n >= 2) THEN
167 output_template = output_format(w_s(2):w_e(2))
168 output_format(w_e(1)+1:) = ' '
169ENDIF
170DEALLOCATE(w_s, w_e)
171
172if (operation == "ndi") then
173
174
175 i = iargc() - optind
176 IF (i < 0) THEN
177 CALL optionparser_printhelp(opt)
179 CALL raise_fatal_error()
180 ELSE IF (i < 1) THEN
181 CALL optionparser_printhelp(opt)
183 CALL raise_fatal_error()
184 ENDIF
185 CALL getarg(iargc(), output_file)
186
187
188
190 call init(timerangeo)
192
193 do ninput = optind, iargc()-1
194 call getarg(ninput, input_file)
195
197 grunit=getunit()
198 open (grunit,file=input_file,status="old")
199 read (grunit,*,iostat=status) level,timerange,varia
200 if (status /= 0) then
202 close(grunit)
203 cycle
204 endif
205
206 if (
c_e(levelo))
then
207
208
209 if ( level /= levelo .or. timerange /= timerangeo .or. varia /= variao ) then
210 call l4f_category_log(category,l4f_error,
"Error reading grad files: file are incoerent")
211 call raise_error("")
212 end if
213 else
214 levelo = level
215 timerangeo = timerange
216 variao = varia
217 end if
218
219 do while (.true.)
220 read (grunit,*,iostat=iostat) val
221 if (iostat /= 0) exit
222 if (val /= 0.)
call insert(grad,val)
223 end do
224
225 close(grunit)
226 end do
227
228 CALL l4f_category_log(category,l4f_info,
"compute percentile to remove the tails")
230
231
233 call normalizeddensityindex(pack(grad%array(:grad%arraysize),&
234 mask=(grad%array(:grad%arraysize) < percentile(2) )), perc_vals, ndi, nlimbins)
235
237 call delete(v7dqcspa%clima)
238 CALL init(v7dqcspa%clima, time_definition=0)
239 call vol7d_alloc(v7dqcspa%clima,nana=size(perc_vals)-1, &
240 nlevel=1, ntimerange=1, &
241 ndativarr=1, nnetwork=1,ntime=1,ndativarattrr=1,ndatiattrr=1)
242
243 call vol7d_alloc_vol(v7dqcspa%clima,inivol=.true.)
244
245 call init(v7dqcspa%clima%network(1),name=
"qcspa-ndi")
246 v7dqcspa%clima%level=level
247 v7dqcspa%clima%timerange=timerange
248 v7dqcspa%clima%dativar%r(1)=varia
249 v7dqcspa%clima%dativarattr%r(1)=varia
250 call init(v7dqcspa%clima%datiattr%r(1), btable=
"*B33209")
251 cyclicdt = cyclicdatetime_new(chardate="/////////")
252 v7dqcspa%clima%time(1)=cyclicdatetime_to_conventional(cyclicdt)
253
254 indctime=1
255 indclevel=1
256 indcnetwork=1
257 indcattr=1
258 indcdativarr=1
259 indctimerange=1
260
261 do indcana=1,size(perc_vals)-1
262 write(ident,'("#",i2.2,2i3.3)')0,0,nint(perc_vals(indcana))
263 call init(v7dqcspa%clima%ana(indcana),ident=ident,lat=0d0,lon=0d0)
264 if (
c_e(nlimbins(indcana)).and.
c_e(ndi(indcana)))
then
265 ind=index_c(spa_btable,varia%btable)
266 v7dqcspa%clima%voldatir(indcana, indctime, indclevel, indctimerange, indcdativarr, indcnetwork)=&
267 nlimbins(indcana)*spa_a(ind) + spa_b(ind)
268 v7dqcspa%clima%voldatiattrr(indcana, indctime, indclevel, indctimerange, indcdativarr, indcnetwork,indcattr)=&
269 ndi(indcana)*100.
270 end if
271 end do
272
273 print *,">>>>>> NDI Volume <<<<<<"
275
276 IF (output_format == 'native') THEN
277 IF (output_file == '-') THEN
278 CALL l4f_category_log(category, l4f_info,
'trying /dev/stdout as stdout unit.')
279 output_file='/dev/stdout'
280 ENDIF
281 iun = getunit()
282 OPEN(iun, file=output_file, form='UNFORMATTED', access='STREAM')
283 CALL export(v7dqcspa%clima, unit=iun)
284 CLOSE(iun)
285 CALL delete(v7dqcspa%clima)
286
287#ifdef HAVE_DBALLE
288 ELSE IF (output_format == 'BUFR' .OR. output_format == 'CREX' .OR. output_format == 'dba') THEN
289 IF (output_format == 'BUFR' .OR. output_format == 'CREX') THEN
290 IF (output_file == '-') THEN
291 CALL l4f_category_log(category, l4f_info,
'trying /dev/stdout as stdout unit.')
292 output_file='/dev/stdout'
293 ENDIF
294 file=.true.
295
296 ELSE IF (output_format == 'dba') THEN
297 file=.false.
298 ENDIF
299
300 IF (output_template == '') output_template = 'generic'
301
302 CALL init(v7d_dba_out, filename=output_file, format=output_format, &
303 dsn=output_file, file=file, write=.true., wipe=file)
304
305 v7d_dba_out%vol7d = v7dqcspa%clima
306 CALL init(v7dqcspa%clima)
307 CALL export(v7d_dba_out, template=output_template)
309#endif
310
311 end if
312
313 stop
314
315end if
316
317
318
319
320
321open(10,file='qc.nml',status='old')
322read(10,nml=odbc,iostat=io)
323if ( io == 0 ) read(10,nml=odbcspa,iostat=io)
324if ( io == 0 ) read(10,nml=switchspa,iostat=io)
325if ( io == 0 ) read(10,nml=minmax,iostat=io)
326if ( io == 0 ) read(10,nml=varlist,iostat=io)
327
328if (io /= 0 )then
330 call raise_error("Error reading namelist qc.nml")
331end if
332close(10)
333
334
335
336
337
338
340
341if (nvar == 0) then
343 call raise_error()
344end if
345
346CALL init(ti, year=years, month=months, day=days, hour=hours)
347CALL init(tf, year=yeare, month=monthe, day=daye, hour=houre)
348print *,"time extreme"
351
352
353CALL init(coordmin,lat=lats,lon=lons)
354CALL init(coordmax,lat=late,lon=lone)
355
356
357print*,
"lon lat minimum -> ",
to_char(coordmin)
358
359print*,
"lon lat maximum -> ",
to_char(coordmax)
360
361
363do i=1,nvar
365enddo
372
373
374time=ti
375
376
377
378
379
380
381
382
383
384
385#ifdef HAVE_LIBNCARG
386if (doplot) then
388 call init(plot,pstype=
'PS', orient=
'LANDSCAPE',color=
'COLOR',file=
"v7d_qcspa.ps")
389end if
390#endif
391DO WHILE (time <= tf)
392 timei = time - timedelta_new(minute=30)
393 timef = time + timedelta_new(minute=30)
394 timeiqc = time - timedelta_new(minute=15)
395 timefqc = time + timedelta_new(minute=15)
397
398
399 CALL init(v7ddballe,dsn=dsn,write=.true.,wipe=.false.,categoryappend=
"data-"//
t2c(time))
401
402 CALL import(v7ddballe,var=var(:nvar),varkind=(/(
"r",i=1,nvar)/),&
403 anavar=(/"B07030"/),anavarkind=(/"r"/),&
404 attr=(/qcattrvarsbtables(1),qcattrvarsbtables(2),qcattrvarsbtables(4)/),attrkind=(/"b","b","b"/)&
405 ,timei=timei,timef=timef,coordmin=coordmin,coordmax=coordmax)
406
407
410
412
413
414
415
416 qcpar%att=bmiss
417
418 call vol7d_peeling(v7ddballe%vol7d,keep_attr=(/qcattrvarsbtables(4)/),purgeana=.true.)
419
420
421 call l4f_category_log(category,l4f_info,
"filtered N staz="//
t2c(
size(v7ddballe%vol7d%ana)))
422
424
425
426
427
428 call init(v7dqcspa,v7ddballe%vol7d,var(:nvar),timei=timeiqc,timef=timefqc, coordmin=coordmin, coordmax=coordmax,&
429
430 dsne=dsne, usere=usere, passworde=passworde,&
431 dsnspa=dsnspa, userspa=userspa, passwordspa=passwordspa,&
432 height2level=height2level, operation=operation,&
433 categoryappend=
"space"//
t2c(time))
434
435
436
437
438
439
440
442
443
444
446
447 call quaconspa(v7dqcspa,timetollerance=timedelta_new(minute=15),noborder=.true.,&
448 timemask= ( v7dqcspa%v7d%time >= timeiqc .and. v7dqcspa%v7d%time <= timefqc ))
450
451#ifdef HAVE_LIBNCARG
452 if (doplot) then
454 call plot_triangles(plot,v7dqcspa%co,v7dqcspa%tri,logo=
"Time: "//
t2c(timeiqc)//
" to "//
t2c(timefqc))
455 call frame()
456 end if
457#endif
458
459
460
461
462
463
464 if (v7dqcspa%operation == "run") then
466
467
468
469
470
471
474 attr_only=.true.)
475
477 end if
478
480
481
483
484 time = time + timedelta_new(minute=30)
485end do
486
487#ifdef HAVE_LIBNCARG
488 if (doplot) then
490 end if
491#endif
492
493
494call l4f_category_delete(category)
496
497end program v7d_qcspa
Destructor for finalizing an array object.
Method for inserting elements of the array at a desired position.
Costruttori per le classi datetime e timedelta.
Functions that return a trimmed CHARACTER representation of the input variable.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Export one or more geo_coordvect objects to a plain text file or to a file in ESRI/Shapefile format.
Import one or more geo_coordvect objects from a plain text file or for a file in ESRI/Shapefile forma...
Emit log message for a category with specific priority.
Global log4fortran constructor.
Add a new option of a specific type.
Compute a set of percentiles for a random variable.
This module defines usefull general purpose function and subroutine.
Classi per la gestione delle coordinate temporali.
class for import and export data from e to DB-All.e.
Classes for handling georeferenced sparse points in geographical corodinates.
classe per la gestione del logging
Definitions of constants and functions for working with missing values.
Utilities and defines for quality control.
Controllo di qualità spaziale.
Module for parsing command-line optons.
Module for basic statistical computations taking into account missing data.
Classe per la gestione di un volume completo di dati osservati.
classe per import ed export di volumi da e in DB-All.e
filter to apply before ingest data