libsim Versione 7.2.0
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
26USE kinds
29IMPLICIT NONE
30
35TYPE vol7d_level
36 INTEGER :: level1
37 INTEGER :: l1
38 INTEGER :: level2
39 INTEGER :: l2
40END TYPE vol7d_level
41
43TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
44
48INTERFACE init
49 MODULE PROCEDURE vol7d_level_init
50END INTERFACE
51
54INTERFACE delete
55 MODULE PROCEDURE vol7d_level_delete
56END INTERFACE
57
61INTERFACE OPERATOR (==)
62 MODULE PROCEDURE vol7d_level_eq
63END INTERFACE
64
68INTERFACE OPERATOR (/=)
69 MODULE PROCEDURE vol7d_level_ne
70END INTERFACE
71
77INTERFACE OPERATOR (>)
78 MODULE PROCEDURE vol7d_level_gt
79END INTERFACE
80
86INTERFACE OPERATOR (<)
87 MODULE PROCEDURE vol7d_level_lt
88END INTERFACE
89
95INTERFACE OPERATOR (>=)
96 MODULE PROCEDURE vol7d_level_ge
97END INTERFACE
98
104INTERFACE OPERATOR (<=)
105 MODULE PROCEDURE vol7d_level_le
106END INTERFACE
107
111INTERFACE OPERATOR (.almosteq.)
112 MODULE PROCEDURE vol7d_level_almost_eq
113END INTERFACE
114
115
116! da documentare in inglese assieme al resto
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
128INTERFACE display
129 MODULE PROCEDURE display_level
130END INTERFACE
131
133INTERFACE to_char
134 MODULE PROCEDURE to_char_level
135END INTERFACE
136
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
144 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
145END INTERFACE vol7d_level_to_var_factor
146
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
188FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
189INTEGER,INTENT(IN),OPTIONAL :: level1
190INTEGER,INTENT(IN),OPTIONAL :: l1
191INTEGER,INTENT(IN),OPTIONAL :: level2
192INTEGER,INTENT(IN),OPTIONAL :: l2
193
194TYPE(vol7d_level) :: this
195
196CALL init(this, level1, l1, level2, l2)
197
198END FUNCTION vol7d_level_new
199
200
204SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
205TYPE(vol7d_level),INTENT(INOUT) :: this
206INTEGER,INTENT(IN),OPTIONAL :: level1
207INTEGER,INTENT(IN),OPTIONAL :: l1
208INTEGER,INTENT(IN),OPTIONAL :: level2
209INTEGER,INTENT(IN),OPTIONAL :: l2
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
236SUBROUTINE vol7d_level_delete(this)
237TYPE(vol7d_level),INTENT(INOUT) :: this
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.