43 TYPE(vol7d_level),
PARAMETER :: vol7d_level_miss=
vol7d_level(imiss,imiss,imiss,imiss)
49 MODULE PROCEDURE vol7d_level_init
55 MODULE PROCEDURE vol7d_level_delete
61 INTERFACE OPERATOR (==)
62 MODULE PROCEDURE vol7d_level_eq
68 INTERFACE OPERATOR (/=)
69 MODULE PROCEDURE vol7d_level_ne
77 INTERFACE OPERATOR (>)
78 MODULE PROCEDURE vol7d_level_gt
86 INTERFACE OPERATOR (<)
87 MODULE PROCEDURE vol7d_level_lt
95 INTERFACE OPERATOR (>=)
96 MODULE PROCEDURE vol7d_level_ge
104 INTERFACE OPERATOR (<=)
105 MODULE PROCEDURE vol7d_level_le
111 INTERFACE OPERATOR (.almosteq.)
112 MODULE PROCEDURE vol7d_level_almost_eq
119 MODULE PROCEDURE vol7d_level_c_e
122 #define VOL7D_POLY_TYPE TYPE(vol7d_level) 123 #define VOL7D_POLY_TYPES _level 125 #include "array_utilities_pre.F90" 129 MODULE PROCEDURE display_level
134 MODULE PROCEDURE to_char_level
139 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
144 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
149 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
152 type(vol7d_level) :: almost_equal_levels(3)=(/&
158 INTEGER,
PARAMETER :: &
159 height_level(6) = (/102,103,106,117,160,161/), &
160 thermo_level(3) = (/20,107,235/), &
161 sigma_level(2) = (/104,111/)
165 CHARACTER(len=10) :: btable
170 TYPE(level_var),
PARAMETER :: level_var_converter(7) = (/ &
171 level_var(20,
'B12101'), &
172 level_var(100,
'B10004'), &
173 level_var(102,
'B10007'), &
174 level_var(103,
'B10007'), &
175 level_var(107,
'B12192'), &
176 level_var(108,
'B10004'), &
177 level_var(161,
'B22195') /)
179 PRIVATE level_var, level_var_converter
188 FUNCTION vol7d_level_new(level1, l1, level2, l2)
RESULT(this)
189 INTEGER,
INTENT(IN),
OPTIONAL :: level1
190 INTEGER,
INTENT(IN),
OPTIONAL :: l1
191 INTEGER,
INTENT(IN),
OPTIONAL :: level2
192 INTEGER,
INTENT(IN),
OPTIONAL :: l2
194 TYPE(vol7d_level) :: this
196 CALL init(this, level1, l1, level2, l2)
198 END FUNCTION vol7d_level_new
204 SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
205 TYPE(vol7d_level),
INTENT(INOUT) :: this
206 INTEGER,
INTENT(IN),
OPTIONAL :: level1
207 INTEGER,
INTENT(IN),
OPTIONAL :: l1
208 INTEGER,
INTENT(IN),
OPTIONAL :: level2
209 INTEGER,
INTENT(IN),
OPTIONAL :: l2
216 IF (
PRESENT(level1))
THEN 222 IF (
PRESENT(l1)) this%l1 = l1
224 IF (
PRESENT(level2))
THEN 230 IF (
PRESENT(l2)) this%l2 = l2
232 END SUBROUTINE vol7d_level_init
236 SUBROUTINE vol7d_level_delete(this)
244 END SUBROUTINE vol7d_level_delete
247 SUBROUTINE display_level(this)
248 TYPE(vol7d_level),
INTENT(in) :: this
252 END SUBROUTINE display_level
255 FUNCTION to_char_level(this)
259 TYPE(vol7d_level),
INTENT(in) :: this
260 CHARACTER(len=255) :: to_char_level
263 INTEGER :: handle, ier
266 ier = idba_messaggi(handle,
"/dev/null",
"w",
"BUFR")
267 ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
268 ier = idba_fatto(handle)
270 to_char_level=
"LEVEL: "//to_char_level
274 to_char_level=
"LEVEL: "//&
276 " typelev2:"//trim(
to_char(this%level2))//
" L2:"//trim(
to_char(this%l2))
280 END FUNCTION to_char_level
283 ELEMENTAL FUNCTION vol7d_level_eq(this, that)
RESULT(res)
284 TYPE(vol7d_level),
INTENT(IN) :: this, that
288 this%level1 == that%level1 .AND. &
289 this%level2 == that%level2 .AND. &
290 this%l1 == that%l1 .AND. this%l2 == that%l2
292 END FUNCTION vol7d_level_eq
295 ELEMENTAL FUNCTION vol7d_level_ne(this, that)
RESULT(res)
296 TYPE(vol7d_level),
INTENT(IN) :: this, that
299 res = .NOT.(this == that)
301 END FUNCTION vol7d_level_ne
304 ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that)
RESULT(res)
305 TYPE(vol7d_level),
INTENT(IN) :: this, that
308 IF ( .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 317 END FUNCTION vol7d_level_almost_eq
320 ELEMENTAL FUNCTION vol7d_level_gt(this, that)
RESULT(res)
321 TYPE(vol7d_level),
INTENT(IN) :: this, that
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. &
329 this%level2 > that%level2 .OR. &
330 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
337 END FUNCTION vol7d_level_gt
340 ELEMENTAL FUNCTION vol7d_level_lt(this, that)
RESULT(res)
341 TYPE(vol7d_level),
INTENT(IN) :: this, that
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. &
349 this%level2 < that%level2 .OR. &
350 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
357 END FUNCTION vol7d_level_lt
360 ELEMENTAL FUNCTION vol7d_level_ge(this, that)
RESULT(res)
361 TYPE(vol7d_level),
INTENT(IN) :: this, that
364 IF (this == that)
THEN 366 ELSE IF (this > that)
THEN 372 END FUNCTION vol7d_level_ge
375 ELEMENTAL FUNCTION vol7d_level_le(this, that)
RESULT(res)
376 TYPE(vol7d_level),
INTENT(IN) :: this, that
379 IF (this == that)
THEN 381 ELSE IF (this < that)
THEN 387 END FUNCTION vol7d_level_le
390 ELEMENTAL FUNCTION vol7d_level_c_e(this)
RESULT(c_e)
391 TYPE(vol7d_level),
INTENT(IN) :: this
393 c_e = this /= vol7d_level_miss
394 END FUNCTION vol7d_level_c_e
397 #include "array_utilities_inc.F90" 400 FUNCTION vol7d_level_to_var_lev(level)
RESULT(btable)
401 TYPE(vol7d_level),
INTENT(in) :: level
402 CHARACTER(len=10) :: btable
404 btable = vol7d_level_to_var_int(level%level1)
406 END FUNCTION vol7d_level_to_var_lev
408 FUNCTION vol7d_level_to_var_int(level)
RESULT(btable)
409 INTEGER,
INTENT(in) :: level
410 CHARACTER(len=10) :: btable
414 DO i = 1,
SIZE(level_var_converter)
415 IF (level_var_converter(i)%level == level)
THEN 416 btable = level_var_converter(i)%btable
423 END FUNCTION vol7d_level_to_var_int
426 FUNCTION vol7d_level_to_var_factor_lev(level)
RESULT(factor)
427 TYPE(vol7d_level),
INTENT(in) :: level
430 factor = vol7d_level_to_var_factor_int(level%level1)
432 END FUNCTION vol7d_level_to_var_factor_lev
434 FUNCTION vol7d_level_to_var_factor_int(level)
RESULT(factor)
435 INTEGER,
INTENT(in) :: level
439 IF (any(level == height_level))
THEN 441 ELSE IF (any(level == thermo_level))
THEN 443 ELSE IF (any(level == sigma_level))
THEN 447 END FUNCTION vol7d_level_to_var_factor_int
450 FUNCTION vol7d_level_to_var_log10_lev(level)
RESULT(log10)
454 log10 = vol7d_level_to_var_log10_int(level%level1)
456 END FUNCTION vol7d_level_to_var_log10_lev
458 FUNCTION vol7d_level_to_var_log10_int(level)
RESULT(log10)
459 INTEGER,
INTENT(in) :: level
463 IF (any(level == height_level))
THEN 465 ELSE IF (any(level == thermo_level))
THEN 467 ELSE IF (any(level == sigma_level))
THEN 471 END FUNCTION vol7d_level_to_var_log10_int
Costruttore per la classe vol7d_level.
Distruttore 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.
Convert a level type to a physical variable.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.
Definitions of constants and functions for working with missing values.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.