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
137 type(vol7d_level
) :: almost_equal_levels(3)=(/&
138 vol7d_level( 1,imiss,imiss,imiss),&
139 vol7d_level(103,imiss,imiss,imiss),&
140 vol7d_level(106,imiss,imiss,imiss)/)
144 CHARACTER(len=10) :: btable
150 TYPE(level_var
),
PARAMETER :: level_var_converter(6) = (/ &
151 level_var(20,
'B12101'), &
152 level_var(100,
'B10004'), &
153 level_var(102,
'B10007'), &
154 level_var(103,
'B10007'), &
155 level_var(107,
'B12192'), &
156 level_var(108,
'B10004') /)
158 PRIVATE level_var, level_var_converter
167 FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
168 INTEGER,
INTENT(IN),
OPTIONAL :: level1
169 INTEGER,
INTENT(IN),
OPTIONAL :: l1
170 INTEGER,
INTENT(IN),
OPTIONAL :: level2
171 INTEGER,
INTENT(IN),
OPTIONAL :: l2
173 TYPE(vol7d_level
) :: this
175 CALL
init(this, level1, l1, level2, l2)
177 END FUNCTION vol7d_level_new
183 SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
184 TYPE(vol7d_level
),
INTENT(INOUT) :: this
185 INTEGER,
INTENT(IN),
OPTIONAL :: level1
186 INTEGER,
INTENT(IN),
OPTIONAL :: l1
187 INTEGER,
INTENT(IN),
OPTIONAL :: level2
188 INTEGER,
INTENT(IN),
OPTIONAL :: l2
195 IF (present(level1))
THEN
201 IF (present(l1)) this%l1 = l1
203 IF (present(level2))
THEN
209 IF (present(l2)) this%l2 = l2
211 END SUBROUTINE vol7d_level_init
215 SUBROUTINE vol7d_level_delete(this)
216 TYPE(vol7d_level
),
INTENT(INOUT) :: this
223 END SUBROUTINE vol7d_level_delete
226 SUBROUTINE display_level(this)
227 TYPE(vol7d_level
),
INTENT(in) :: this
231 END SUBROUTINE display_level
234 FUNCTION to_char_level(this)
236 #ifdef HAVE_DBALLEF_MOD
242 TYPE(vol7d_level
),
INTENT(in) :: this
243 CHARACTER(len=255) :: to_char_level
246 INTEGER :: handle, ier
249 ier = idba_messaggi(handle,
"/dev/null",
"w",
"BUFR")
250 ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
251 ier = idba_fatto(handle)
253 to_char_level=
"LEVEL: "//to_char_level
257 to_char_level=
"LEVEL: "//&
258 " typelev1:"//trim(
to_char(this%level1))//
" L1:"//trim(
to_char(this%l1))//&
259 " typelev2:"//trim(
to_char(this%level2))//
" L2:"//trim(
to_char(this%l2))
263 END FUNCTION to_char_level
266 ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
267 TYPE(vol7d_level
),
INTENT(IN) :: this, that
271 this%level1 == that%level1 .AND. &
272 this%level2 == that%level2 .AND. &
273 this%l1 == that%l1 .AND. this%l2 == that%l2
275 END FUNCTION vol7d_level_eq
278 ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
279 TYPE(vol7d_level
),
INTENT(IN) :: this, that
282 res = .NOT.(this == that)
284 END FUNCTION vol7d_level_ne
287 ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
288 TYPE(vol7d_level
),
INTENT(IN) :: this, that
291 IF ( .not.
c_e(this%level1) .or. .not.
c_e(that%level1) .or. this%level1 == that%level1 .AND. &
292 .not.
c_e(this%level2) .or. .not.
c_e(that%level2) .or. this%level2 == that%level2 .AND. &
293 .not.
c_e(this%l1) .or. .not.
c_e(that%l1) .or. this%l1 == that%l1 .AND. &
294 .not.
c_e(this%l2) .or. .not.
c_e(that%l2) .or. this%l2 == that%l2)
THEN
300 END FUNCTION vol7d_level_almost_eq
303 ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
304 TYPE(vol7d_level
),
INTENT(IN) :: this, that
308 this%level1 > that%level1 .OR. &
309 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
310 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
312 this%level2 > that%level2 .OR. &
313 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
320 END FUNCTION vol7d_level_gt
323 ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
324 TYPE(vol7d_level
),
INTENT(IN) :: this, that
328 this%level1 < that%level1 .OR. &
329 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
330 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
332 this%level2 < that%level2 .OR. &
333 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
340 END FUNCTION vol7d_level_lt
343 ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
344 TYPE(vol7d_level
),
INTENT(IN) :: this, that
347 IF (this == that)
THEN
349 ELSE IF (this > that)
THEN
355 END FUNCTION vol7d_level_ge
358 ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
359 TYPE(vol7d_level
),
INTENT(IN) :: this, that
362 IF (this == that)
THEN
364 ELSE IF (this < that)
THEN
370 END FUNCTION vol7d_level_le
373 ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
374 TYPE(vol7d_level
),
INTENT(IN) :: this
376 c_e = this /= vol7d_level_miss
377 END FUNCTION vol7d_level_c_e
380 #include "array_utilities_inc.F90"
383 FUNCTION vol7d_level_to_var(level) RESULT(btable)
384 TYPE(vol7d_level
),
INTENT(in) :: level
385 CHARACTER(len=10) :: btable
389 DO i = 1,
SIZE(level_var_converter)
390 IF (level_var_converter(i)%level == level%level1)
THEN
391 btable = level_var_converter(i)%btable
398 END FUNCTION vol7d_level_to_var
Costruttore per la classe vol7d_level.
Distruttore per la classe vol7d_level.
Definitions of constants and functions for working with missing values.
Represent level object in a pretty string.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Utilities for CHARACTER variables.
Definition of constants to be used for declaring variables of a desired type.