libsim Versione 7.2.6
vol7d_level_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 dei livelli verticali in osservazioni meteo e affini.
21!! Questo modulo definisce una classe per rappresentare la localizzazione
22!! verticale di un'osservazione meteorologica, prendendo in prestito
23!! concetti dal formato grib.
24!! \ingroup vol7d
26USE kinds
29IMPLICIT NONE
30
31!> Definisce il livello verticale di un'osservazione.
32!! I membri di \a vol7d_level sono pubblici e quindi liberamente
33!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
34!! il costruttore ::init.
35TYPE vol7d_level
36 INTEGER :: level1 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
37 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
38 INTEGER :: level2 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
39 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
40END TYPE vol7d_level
41
42!> Valore mancante per vol7d_level.
43TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
44
45!> Costruttore per la classe vol7d_level.
46!! Deve essere richiamato
47!! per tutti gli oggetti di questo tipo definiti in un programma.
48INTERFACE init
49 MODULE PROCEDURE vol7d_level_init
50END INTERFACE
51
52!> Distruttore per la classe vol7d_level.
53!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
54INTERFACE delete
55 MODULE PROCEDURE vol7d_level_delete
56END INTERFACE
57
58!> Logical equality operator for objects of \a vol7d_level class.
59!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
60!! of any shape.
61INTERFACE OPERATOR (==)
62 MODULE PROCEDURE vol7d_level_eq
63END INTERFACE
64
65!> Logical inequality operator for objects of \a vol7d_level class.
66!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
67!! of any shape.
68INTERFACE OPERATOR (/=)
69 MODULE PROCEDURE vol7d_level_ne
70END INTERFACE
71
72!> Logical greater-than operator for objects of \a vol7d_level class.
73!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
74!! of any shape.
75!! Comparison is performed first on \a level, then, then on \l1, then
76!! on \l2 if defined.
77INTERFACE OPERATOR (>)
78 MODULE PROCEDURE vol7d_level_gt
79END INTERFACE
80
81!> Logical less-than operator for objects of \a vol7d_level class.
82!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
83!! of any shape.
84!! Comparison is performed first on \a level, then, then on \l1, then
85!! on \l2 if defined.
86INTERFACE OPERATOR (<)
87 MODULE PROCEDURE vol7d_level_lt
88END INTERFACE
89
90!> Logical greater-equal operator for objects of \a vol7d_level class.
91!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
92!! of any shape.
93!! Comparison is performed first on \a level, then, then on \l1, then
94!! on \l2 if defined.
95INTERFACE OPERATOR (>=)
96 MODULE PROCEDURE vol7d_level_ge
97END INTERFACE
98
99!> Logical less-equal operator for objects of \a vol7d_level class.
100!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
101!! of any shape.
102!! Comparison is performed first on \a level, then, then on \l1, then
103!! on \l2 if defined.
104INTERFACE OPERATOR (<=)
105 MODULE PROCEDURE vol7d_level_le
106END INTERFACE
107
108!> Logical almost equality operators for objects of the class \a
109!! vol7d_level
110!! If one component is missing it is not used in comparison
111INTERFACE OPERATOR (.almosteq.)
112 MODULE PROCEDURE vol7d_level_almost_eq
113END INTERFACE
114
115
116! da documentare in inglese assieme al resto
117!> to be documented
118INTERFACE c_e
119 MODULE PROCEDURE vol7d_level_c_e
120END INTERFACE
121
122#define VOL7D_POLY_TYPE TYPE(vol7d_level)
123#define VOL7D_POLY_TYPES _level
124#define ENABLE_SORT
125#include "array_utilities_pre.F90"
126
127!>Print object
128INTERFACE display
129 MODULE PROCEDURE display_level
130END INTERFACE
131
132!>Represent level object in a pretty string
133INTERFACE to_char
134 MODULE PROCEDURE to_char_level
135END INTERFACE
136
137!> Convert a level type to a physical variable
138INTERFACE vol7d_level_to_var
139 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
140END INTERFACE vol7d_level_to_var
141
142!> Return the conversion factor for multiplying the level value when converting to variable
144 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
145END INTERFACE vol7d_level_to_var_factor
146
147!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
149 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
150END INTERFACE vol7d_level_to_var_log10
151
152type(vol7d_level) :: almost_equal_levels(3)=(/&
153 vol7d_level( 1,imiss,imiss,imiss),&
154 vol7d_level(103,imiss,imiss,imiss),&
155 vol7d_level(106,imiss,imiss,imiss)/)
156
157! levels requiring conversion from internal to physical representation
158INTEGER, PARAMETER :: &
159 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
160 thermo_level(3) = (/20,107,235/), & ! 10**-1
161 sigma_level(2) = (/104,111/) ! 10**-4
162
163TYPE level_var
164 INTEGER :: level
165 CHARACTER(len=10) :: btable
166END TYPE level_var
167
168! Conversion table from GRIB2 vertical level codes to corresponding
169! BUFR B table variables
170TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
171 level_var(20, 'B12101'), & ! isothermal (K)
172 level_var(100, 'B10004'), & ! isobaric (Pa)
173 level_var(102, 'B10007'), & ! height over sea level (m)
174 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
175 level_var(107, 'B12192'), & ! isentropical (K)
176 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
177 level_var(161, 'B22195') /) ! depth below sea surface
178
179PRIVATE level_var, level_var_converter
180
181CONTAINS
182
183!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
184!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
185!! rispetto alla versione \c SUBROUTINE \c init.
186!! Se non viene passato nessun parametro opzionale l'oggetto è
187!! inizializzato a valore mancante.
188FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
189INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
190INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
191INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
192INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
193
194TYPE(vol7d_level) :: this !< object to initialize
195
196CALL init(this, level1, l1, level2, l2)
197
198END FUNCTION vol7d_level_new
199
200
201!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
202!! Se non viene passato nessun parametro opzionale l'oggetto è
203!! inizializzato a valore mancante.
204SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
205TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
206INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
207INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
208INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
209INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
210
211this%level1 = imiss
212this%l1 = imiss
213this%level2 = imiss
214this%l2 = imiss
215
216IF (PRESENT(level1)) THEN
217 this%level1 = level1
218ELSE
219 RETURN
220END IF
221
222IF (PRESENT(l1)) this%l1 = l1
224IF (PRESENT(level2)) THEN
225 this%level2 = level2
226ELSE
227 RETURN
228END IF
229
230IF (PRESENT(l2)) this%l2 = l2
232END SUBROUTINE vol7d_level_init
233
234
235!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
236SUBROUTINE vol7d_level_delete(this)
237TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
238
239this%level1 = imiss
240this%l1 = imiss
241this%level2 = imiss
242this%l2 = imiss
243
244END SUBROUTINE vol7d_level_delete
245
246
247SUBROUTINE display_level(this)
248TYPE(vol7d_level),INTENT(in) :: this
250print*,trim(to_char(this))
251
252END SUBROUTINE display_level
253
254
255FUNCTION to_char_level(this)
256#ifdef HAVE_DBALLE
257USE dballef
258#endif
259TYPE(vol7d_level),INTENT(in) :: this
260CHARACTER(len=255) :: to_char_level
261
262#ifdef HAVE_DBALLE
263INTEGER :: handle, ier
264
265handle = 0
266ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
267ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
268ier = idba_fatto(handle)
269
270to_char_level="LEVEL: "//to_char_level
271
272#else
273
274to_char_level="LEVEL: "//&
275 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
276 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
277
278#endif
279
280END FUNCTION to_char_level
281
282
283ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
284TYPE(vol7d_level),INTENT(IN) :: this, that
285LOGICAL :: res
286
287res = &
288 this%level1 == that%level1 .AND. &
289 this%level2 == that%level2 .AND. &
290 this%l1 == that%l1 .AND. this%l2 == that%l2
291
292END FUNCTION vol7d_level_eq
293
294
295ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
296TYPE(vol7d_level),INTENT(IN) :: this, that
297LOGICAL :: res
298
299res = .NOT.(this == that)
300
301END FUNCTION vol7d_level_ne
302
303
304ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
305TYPE(vol7d_level),INTENT(IN) :: this, that
306LOGICAL :: res
307
308IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
309 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
310 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
311 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
312 res = .true.
313ELSE
314 res = .false.
315ENDIF
316
317END FUNCTION vol7d_level_almost_eq
318
319
320ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
321TYPE(vol7d_level),INTENT(IN) :: this, that
322LOGICAL :: res
323
324IF (&
325 this%level1 > that%level1 .OR. &
326 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
327 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
328 (&
329 this%level2 > that%level2 .OR. &
330 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
331 ))) THEN
332 res = .true.
333ELSE
334 res = .false.
335ENDIF
336
337END FUNCTION vol7d_level_gt
338
339
340ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
341TYPE(vol7d_level),INTENT(IN) :: this, that
342LOGICAL :: res
343
344IF (&
345 this%level1 < that%level1 .OR. &
346 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
347 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
348 (&
349 this%level2 < that%level2 .OR. &
350 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
351 ))) THEN
352 res = .true.
353ELSE
354 res = .false.
355ENDIF
356
357END FUNCTION vol7d_level_lt
359
360ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
361TYPE(vol7d_level),INTENT(IN) :: this, that
362LOGICAL :: res
364IF (this == that) THEN
365 res = .true.
366ELSE IF (this > that) THEN
367 res = .true.
368ELSE
369 res = .false.
370ENDIF
372END FUNCTION vol7d_level_ge
373
374
375ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
376TYPE(vol7d_level),INTENT(IN) :: this, that
377LOGICAL :: res
378
379IF (this == that) THEN
380 res = .true.
381ELSE IF (this < that) THEN
382 res = .true.
383ELSE
384 res = .false.
385ENDIF
387END FUNCTION vol7d_level_le
388
389
390ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
391TYPE(vol7d_level),INTENT(IN) :: this
392LOGICAL :: c_e
393c_e = this /= vol7d_level_miss
394END FUNCTION vol7d_level_c_e
395
396
397#include "array_utilities_inc.F90"
398
399
400FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
401TYPE(vol7d_level),INTENT(in) :: level
402CHARACTER(len=10) :: btable
403
404btable = vol7d_level_to_var_int(level%level1)
405
406END FUNCTION vol7d_level_to_var_lev
407
408FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
409INTEGER,INTENT(in) :: level
410CHARACTER(len=10) :: btable
411
412INTEGER :: i
413
414DO i = 1, SIZE(level_var_converter)
415 IF (level_var_converter(i)%level == level) THEN
416 btable = level_var_converter(i)%btable
417 RETURN
418 ENDIF
419ENDDO
420
421btable = cmiss
422
423END FUNCTION vol7d_level_to_var_int
424
425
426FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
427TYPE(vol7d_level),INTENT(in) :: level
428REAL :: factor
429
430factor = vol7d_level_to_var_factor_int(level%level1)
432END FUNCTION vol7d_level_to_var_factor_lev
433
434FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
435INTEGER,INTENT(in) :: level
436REAL :: factor
437
438factor = 1.
439IF (any(level == height_level)) THEN
440 factor = 1.e-3
441ELSE IF (any(level == thermo_level)) THEN
442 factor = 1.e-1
443ELSE IF (any(level == sigma_level)) THEN
444 factor = 1.e-4
445ENDIF
446
447END FUNCTION vol7d_level_to_var_factor_int
448
449
450FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
451TYPE(vol7d_level),INTENT(in) :: level
452REAL :: log10
453
454log10 = vol7d_level_to_var_log10_int(level%level1)
455
456END FUNCTION vol7d_level_to_var_log10_lev
457
458FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
459INTEGER,INTENT(in) :: level
460REAL :: log10
461
462log10 = 0.
463IF (any(level == height_level)) THEN
464 log10 = -3.
465ELSE IF (any(level == thermo_level)) THEN
466 log10 = -1.
467ELSE IF (any(level == sigma_level)) THEN
468 log10 = -4.
469ENDIF
470
471END FUNCTION vol7d_level_to_var_log10_int
472
473END MODULE vol7d_level_class
Index method.
Distruttore per la classe vol7d_level.
Index method with sorted array.
Costruttore per la classe vol7d_level.
Represent level object in a pretty string.
Return the conversion factor for multiplying the level value when converting to variable.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Convert a level type to a physical variable.
Utilities for CHARACTER variables.
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 dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.

Generated with Doxygen.