libsim Versione 7.2.6
vol7d_var_class.F90
1! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
2! authors:
3! Davide Cesari <dcesari@arpa.emr.it>
4! Paolo Patruno <ppatruno@arpa.emr.it>
5
6! This program is free software; you can redistribute it and/or
7! modify it under the terms of the GNU General Public License as
8! published by the Free Software Foundation; either version 2 of
9! the License, or (at your option) any later version.
10
11! This program is distributed in the hope that it will be useful,
12! but WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14! GNU General Public License for more details.
15
16! You should have received a copy of the GNU General Public License
17! along with this program. If not, see <http://www.gnu.org/licenses/>.
18#include "config.h"
19
20!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
21!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
22!! osservate, o attributi, aventi diversi tipi numerici o carattere.
23!! \ingroup vol7d
24MODULE vol7d_var_class
25USE kinds
28IMPLICIT NONE
29
30!> Definisce una variabile meteorologica osservata o un suo attributo.
31!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
32!! per associare le variabili agli attributi, e indicano
33!! a quale variabile, nel descrittore delle variabili, coincide
34!! la variabile corrente nel descrittore delle "variabili aventi attributo".
35!! I membri di \a vol7d_var sono pubblici e quindi liberamente
36!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
37!! il costruttore ::init.
38TYPE vol7d_var
39 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
40 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
41 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
42 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
43
44 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
45 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
46 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
47 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
48 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
49 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
50END TYPE vol7d_var
51
52!> Valore mancante per vol7d_var.
53TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
54 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
55 (/imiss,imiss,imiss,imiss/))
56
57!> Costruttore per la classe vol7d_var.
58!! Deve essere richiamato
59!! per tutti gli oggetti di questo tipo definiti in un programma.
60INTERFACE init
61 MODULE PROCEDURE vol7d_var_init
62END INTERFACE
63
64!> Distruttore per la classe vol7d_var.
65!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
66INTERFACE delete
67 MODULE PROCEDURE vol7d_var_delete
68END INTERFACE
69
70!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
71!! Funziona anche per
72!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
73!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
74!! di 1 dimensione e scalari).
75INTERFACE OPERATOR (==)
76 MODULE PROCEDURE vol7d_var_eq
77END INTERFACE
78
79!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
80!! Funziona anche per
81!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
82!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
83!! di 1 dimensione e scalari).
84INTERFACE OPERATOR (/=)
85 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
86END INTERFACE
87
88!> to be documented
89INTERFACE c_e
90 MODULE PROCEDURE vol7d_var_c_e
91END INTERFACE
92
93#define VOL7D_POLY_TYPE TYPE(vol7d_var)
94#define VOL7D_POLY_TYPES _var
95#include "array_utilities_pre.F90"
96
97!> \brief display on the screen a brief content of object
98INTERFACE display
99 MODULE PROCEDURE display_var, display_var_vect
100END INTERFACE
101
102
103TYPE vol7d_var_features
104 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
105 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
106 INTEGER :: vartype !< type of variable, one of the var_* constants
107END TYPE vol7d_var_features
108
109TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
110
111! constants for vol7d_vartype
112INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
113INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
114INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
115INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
116INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
117INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
118
119
120CONTAINS
121
122!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
123!! Se non viene passato nessun parametro opzionale l'oggetto è
124!! inizializzato a valore mancante.
125!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
126!! tramite costruttore, ma solo direttamente.
127elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
128TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
129CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
130CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
131CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
132INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
133
134IF (PRESENT(btable)) THEN
135 this%btable = btable
136ELSE
137 this%btable = cmiss
138 this%description = cmiss
139 this%unit = cmiss
140 this%scalefactor = imiss
141 RETURN
142ENDIF
143IF (PRESENT(description)) THEN
144 this%description = description
145ELSE
146 this%description = cmiss
147ENDIF
148IF (PRESENT(unit)) THEN
149 this%unit = unit
150ELSE
151 this%unit = cmiss
152ENDIF
153if (present(scalefactor)) then
154 this%scalefactor = scalefactor
155else
156 this%scalefactor = imiss
157endif
158
159this%r = -1
160this%d = -1
161this%i = -1
162this%b = -1
163this%c = -1
164
165END SUBROUTINE vol7d_var_init
166
167
168ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
169CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
170CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
171CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
172INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
173
174TYPE(vol7d_var) :: this
175
176CALL init(this, btable, description, unit, scalefactor)
177
178END FUNCTION vol7d_var_new
179
180
181!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
182elemental SUBROUTINE vol7d_var_delete(this)
183TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
184
185this%btable = cmiss
186this%description = cmiss
187this%unit = cmiss
188this%scalefactor = imiss
189
190END SUBROUTINE vol7d_var_delete
191
192
193ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
194TYPE(vol7d_var),INTENT(IN) :: this, that
195LOGICAL :: res
196
197res = this%btable == that%btable
198
199END FUNCTION vol7d_var_eq
200
201
202ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
203TYPE(vol7d_var),INTENT(IN) :: this, that
204LOGICAL :: res
205
206res = .NOT.(this == that)
207
208END FUNCTION vol7d_var_ne
209
210
211FUNCTION vol7d_var_nesv(this, that) RESULT(res)
212TYPE(vol7d_var),INTENT(IN) :: this, that(:)
213LOGICAL :: res(SIZE(that))
214
215INTEGER :: i
216
217DO i = 1, SIZE(that)
218 res(i) = .NOT.(this == that(i))
219ENDDO
220
221END FUNCTION vol7d_var_nesv
222
223
224
225!> \brief display on the screen a brief content of vol7d_var object
226subroutine display_var(this)
228TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
230print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
231 " scale factor",this%scalefactor
233end subroutine display_var
236!> \brief display on the screen a brief content of vector of vol7d_var object
237subroutine display_var_vect(this)
238
239TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
240integer :: i
242do i=1,size(this)
243 call display_var(this(i))
244end do
245
246end subroutine display_var_vect
247
248FUNCTION vol7d_var_c_e(this) RESULT(c_e)
249TYPE(vol7d_var),INTENT(IN) :: this
250LOGICAL :: c_e
251c_e = this /= vol7d_var_miss
252END FUNCTION vol7d_var_c_e
253
255!> Initialise the global table of variable features.
256!! This subroutine reads the table of variable features from an
257!! external file and stores it in a global array. It has to be called
258!! once at the beginning of the program. At the moment it gives access
259!! to the information about type of variable and positive
260!! definitness. The table is based on the unique bufr-like variable
261!! table. The table is contained in the csv file `vargrib.csv`.
262!! It is not harmful to call this subroutine multiple times.
263SUBROUTINE vol7d_var_features_init()
264INTEGER :: un, i, n
265TYPE(csv_record) :: csv
266CHARACTER(len=1024) :: line
267
268IF (ALLOCATED(var_features)) RETURN
269
270un = open_package_file('varbufr.csv', filetype_data)
271n=0
272DO WHILE(.true.)
273 READ(un,*,END=100)
274 n = n + 1
275ENDDO
276
277100 CONTINUE
278
279rewind(un)
280ALLOCATE(var_features(n))
281
282DO i = 1, n
283 READ(un,'(A)',END=200)line
284 CALL init(csv, line)
285 CALL csv_record_getfield(csv, var_features(i)%var%btable)
286 CALL csv_record_getfield(csv)
287 CALL csv_record_getfield(csv)
288 CALL csv_record_getfield(csv, var_features(i)%posdef)
289 CALL csv_record_getfield(csv, var_features(i)%vartype)
290 CALL delete(csv)
291ENDDO
292
293200 CONTINUE
294CLOSE(un)
295
296END SUBROUTINE vol7d_var_features_init
297
298
299!> Deallocate the global table of variable features.
300!! This subroutine deallocates the table of variable features
301!! allocated in the `vol7d_var_features_init` subroutine.
302SUBROUTINE vol7d_var_features_delete()
303IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
304END SUBROUTINE vol7d_var_features_delete
305
306
307!> Return the physical type of the variable.
308!! Returns a rough classification of the variable depending on the
309!! physical parameter it represents. The result is one of the
310!! constants vartype_* defined in the module. To be extended.
311!! In order for this to work, the subroutine \a
312!! vol7d_var_features_init has to be preliminary called.
313ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
314TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
315INTEGER :: vartype
316
317INTEGER :: i
318
319vartype = imiss
320
321IF (ALLOCATED(var_features)) THEN
322 DO i = 1, SIZE(var_features)
323 IF (this == var_features(i)%var) THEN
324 vartype = var_features(i)%vartype
325 RETURN
326 ENDIF
327 ENDDO
328ENDIF
329
330END FUNCTION vol7d_var_features_vartype
331
332
333!> Apply a positive definite flag to a variable.
334!! This subroutine resets the value of a variable depending on its
335!! positive definite flag defined in the associated \a c_func object.
336!! The \a c_func object can be obtained for example by the \a convert
337!! (interfaced to vargrib2varbufr_convert) function. The value is
338!! reset to the maximum between the value itsel and and 0 (or the
339!! value set in \a c_func%posdef. These values are set from the
340!! vargrib2bufr.csv file.
341!! In order for this to work, the subroutine \a
342!! vol7d_var_features_init has to be preliminary called.
343ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
344TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
345REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
347INTEGER :: i
348
349IF (ALLOCATED(var_features)) THEN
350 DO i = 1, SIZE(var_features)
351 IF (this == var_features(i)%var) THEN
352 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
353 RETURN
354 ENDIF
355 ENDDO
356ENDIF
358END SUBROUTINE vol7d_var_features_posdef_apply
359
360
361!> Return the physical type of the variable.
362!! Returns a rough classification of the variable depending on the
363!! physical parameter it represents. The result is one of the
364!! constants vartype_* defined in the module. To be extended.
365ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
366TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
367
368INTEGER :: vartype
369
370vartype = var_ord
371SELECT CASE(this%btable)
372CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
373 vartype = var_dir360
374CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
375 vartype = var_press
376CASE('B11003', 'B11200') ! u-component
377 vartype = var_ucomp
378CASE('B11004', 'B11201') ! v-component
379 vartype = var_vcomp
380CASE('B11005', 'B11006') ! w-component
381 vartype = var_wcomp
382END SELECT
383
384END FUNCTION vol7d_vartype
385
386
387#include "array_utilities_inc.F90"
388
389
390END MODULE vol7d_var_class
Index method.
Distruttore per la classe vol7d_var.
display on the screen a brief content of object
Costruttore per la classe vol7d_var.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Class for interpreting the records of a csv file.
Definisce una variabile meteorologica osservata o un suo attributo.

Generated with Doxygen.