49 CHARACTER(len=65) :: description
50 CHARACTER(len=24) :: unit
56 TYPE(vol7d_var),
PARAMETER :: vol7d_var_horstag(2) = (/ &
57 vol7d_var(
'B11003',
'',
'', 0, 0, 0, 0, 0, 0), &
58 vol7d_var(
'B11004',
'',
'', 0, 0, 0, 0, 0, 0) &
61 TYPE(vol7d_var),
PARAMETER :: vol7d_var_horcomp(4) = (/ &
62 vol7d_var(
'B11003',
'',
'', 0, 0, 0, 0, 0, 0), &
63 vol7d_var(
'B11004',
'',
'', 0, 0, 0, 0, 0, 0), &
64 vol7d_var(
'B11200',
'',
'', 0, 0, 0, 0, 0, 0), &
65 vol7d_var(
'B11201',
'',
'', 0, 0, 0, 0, 0, 0) &
85 TYPE vg6d_v7d_var_conv
90 END TYPE vg6d_v7d_var_conv
92 TYPE(vg6d_v7d_var_conv
),
PARAMETER :: vg6d_v7d_var_conv_miss= &
93 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
95 TYPE(vg6d_v7d_var_conv
),
ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
111 MODULE PROCEDURE volgrid6d_var_init
117 MODULE PROCEDURE volgrid6d_var_delete
125 INTERFACE operator (==)
126 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
133 INTERFACE operator (/=)
134 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
137 #define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
138 #define VOL7D_POLY_TYPES _var6d
139 #include "array_utilities_pre.F90"
143 MODULE PROCEDURE display_volgrid6d_var
150 INTERFACE operator (*)
151 MODULE PROCEDURE conv_func_mult
152 END INTERFACE OPERATOR (*)
157 MODULE PROCEDURE conv_func_compute
163 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
169 volgrid6d_var_normalize, &
170 operator(==), operator(/=), operator(*), &
171 count_distinct, pack_distinct, count_and_pack_distinct, &
172 map_distinct, map_inv_distinct, &
174 vargrib2varbufr, varbufr2vargrib, &
176 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
182 ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
183 discipline, description, unit) result(this)
184 integer,
INTENT(in),
OPTIONAL :: centre
185 integer,
INTENT(in),
OPTIONAL :: category
186 integer,
INTENT(in),
OPTIONAL :: number
187 integer,
INTENT(in),
OPTIONAL :: discipline
188 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: description
189 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: unit
193 CALL
init(this, centre, category, number, discipline, description, unit)
195 END FUNCTION volgrid6d_var_new
199 ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
201 INTEGER,
INTENT(in),
OPTIONAL :: centre
202 INTEGER,
INTENT(in),
OPTIONAL :: category
203 INTEGER,
INTENT(in),
OPTIONAL :: number
204 INTEGER,
INTENT(in),
OPTIONAL :: discipline
205 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: description
206 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: unit
208 IF (present(centre))
THEN
212 this%category = imiss
214 this%discipline = imiss
218 IF (present(category))
THEN
219 this%category = category
221 this%category = imiss
223 this%discipline = imiss
228 IF (present(number))
THEN
232 this%discipline = imiss
239 IF (present(discipline))
THEN
240 this%discipline = discipline
242 this%discipline = 255
245 IF (present(description))
THEN
246 this%description = description
248 this%description = cmiss
251 IF (present(unit))
THEN
259 END SUBROUTINE volgrid6d_var_init
263 SUBROUTINE volgrid6d_var_delete(this)
267 this%category = imiss
269 this%discipline = imiss
270 this%description = cmiss
273 END SUBROUTINE volgrid6d_var_delete
276 ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
280 IF (this%discipline == that%discipline)
THEN
282 IF (this%discipline == 255)
THEN
283 res = this%category == that%category .AND. &
284 this%number == that%number
286 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
287 (this%number >= 128 .AND. this%number <= 254))
THEN
288 res = res .AND. this%centre == that%centre
292 res = this%category == that%category .AND. &
293 this%number == that%number
295 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
296 (this%category >= 192 .AND. this%category <= 254) .OR. &
297 (this%number >= 192 .AND. this%number <= 254))
THEN
298 res = res .AND. this%centre == that%centre
306 END FUNCTION volgrid6d_var_eq
309 ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
313 res = .NOT.(this == that)
315 END FUNCTION volgrid6d_var_ne
318 #include "array_utilities_inc.F90"
322 SUBROUTINE display_volgrid6d_var(this)
325 print*,
"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
327 END SUBROUTINE display_volgrid6d_var
342 SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
344 type(
vol7d_var),
INTENT(out) :: varbufr(:)
347 INTEGER :: i, n, stallo
349 n = min(
SIZE(varbufr),
SIZE(vargrib))
350 ALLOCATE(c_func(n),stat=stallo)
351 IF (stallo /= 0)
THEN
352 call l4f_log(l4f_fatal,
"allocating memory")
353 call raise_fatal_error()
357 varbufr(i) =
convert(vargrib(i), c_func(i))
360 END SUBROUTINE vargrib2varbufr
373 FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
375 type(
conv_func),
INTENT(out),
OPTIONAL :: c_func
380 IF (.NOT.
ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
382 DO i = 1,
SIZE(conv_fwd)
383 IF (vargrib == conv_fwd(i)%vg6d_var)
THEN
385 IF (present(c_func)) c_func = conv_fwd(i)%c_func
391 IF (present(c_func)) c_func = conv_func_miss
393 CALL l4f_log(l4f_warn,
'vargrib2varbufr: variable '// &
394 trim(
to_char(vargrib%centre))//
':'//trim(
to_char(vargrib%category))//
':'// &
395 trim(
to_char(vargrib%number))//
':'//trim(
to_char(vargrib%discipline))// &
396 ' not found in table')
398 END FUNCTION vargrib2varbufr_convert
416 SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
420 type(
grid_id),
INTENT(in),
OPTIONAL :: grid_id_template
422 INTEGER :: i, n, stallo
424 n = min(
SIZE(varbufr),
SIZE(vargrib))
425 ALLOCATE(c_func(n),stat=stallo)
426 IF (stallo /= 0)
THEN
427 CALL l4f_log(l4f_fatal,
"allocating memory")
428 CALL raise_fatal_error()
432 vargrib(i) =
convert(varbufr(i), c_func(i), grid_id_template)
435 END SUBROUTINE varbufr2vargrib
451 FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
453 type(
conv_func),
INTENT(out),
OPTIONAL :: c_func
454 type(
grid_id),
INTENT(in),
OPTIONAL :: grid_id_template
458 #ifdef HAVE_LIBGRIBAPI
459 INTEGER :: gaid, editionnumber, category, centre
462 IF (.NOT.
ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
464 #ifdef HAVE_LIBGRIBAPI
465 editionnumber=255; category=255; centre=255
467 IF (present(grid_id_template))
THEN
468 #ifdef HAVE_LIBGRIBAPI
469 gaid = grid_id_get_gaid(grid_id_template)
471 CALL grib_get(gaid,
'GRIBEditionNumber', editionnumber)
472 IF (editionnumber == 1)
THEN
473 CALL grib_get(gaid,
'gribTablesVersionNo',category)
475 CALL grib_get(gaid,
'centre',centre)
480 DO i = 1,
SIZE(conv_bwd)
481 IF (varbufr == conv_bwd(i)%v7d_var)
THEN
482 #ifdef HAVE_LIBGRIBAPI
483 IF (editionnumber /= 255)
THEN
484 IF (editionnumber == 1)
THEN
485 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle
486 ELSE IF (editionnumber == 2)
THEN
487 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle
489 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
490 conv_bwd(i)%vg6d_var%centre /= centre) cycle
494 IF (present(c_func)) c_func = conv_bwd(i)%c_func
500 IF (present(c_func)) c_func = conv_func_miss
502 CALL l4f_log(l4f_warn,
'varbufr2vargrib: variable '// &
503 trim(varbufr%btable)//
" : "//trim(varbufr%description)//
" : "//trim(varbufr%unit)// &
504 ' not found in table')
506 END FUNCTION varbufr2vargrib_convert
516 SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
519 type(
grid_id),
INTENT(in) :: grid_id_template
521 LOGICAL :: eqed, eqcentre
522 INTEGER :: gaid, editionnumber, centre
529 c_func = conv_func_miss
531 #ifdef HAVE_LIBGRIBAPI
532 gaid = grid_id_get_gaid(grid_id_template)
534 CALL grib_get(gaid,
'GRIBEditionNumber', editionnumber)
535 CALL grib_get(gaid,
'centre', centre)
536 eqed = editionnumber == 1 .EQV. this%discipline == 255
537 eqcentre = centre == this%centre
541 IF (eqed .AND. eqcentre)
RETURN
543 tmpbufr =
convert(this, tmpc_func1)
544 tmpgrib =
convert(tmpbufr, tmpc_func2, grid_id_template)
546 IF (tmpgrib /= volgrid6d_var_miss)
THEN
549 c_func = tmpc_func1 * tmpc_func2
551 IF (c_func == conv_func_identity) c_func = conv_func_miss
552 ELSE IF (.NOT.eqed)
THEN
557 END SUBROUTINE volgrid6d_var_normalize
562 SUBROUTINE vg6d_v7d_var_conv_setup()
563 INTEGER :: un, i, n, stallo
566 un = open_package_file(
'vargrib2bufr.csv', filetype_data)
576 ALLOCATE(conv_fwd(n),stat=stallo)
577 IF (stallo /= 0)
THEN
578 CALL l4f_log(l4f_fatal,
"allocating memory")
579 CALL raise_fatal_error()
582 conv_fwd(:) = vg6d_v7d_var_conv_miss
583 CALL import_var_conv(un, conv_fwd)
587 un = open_package_file(
'vargrib2bufr.csv', filetype_data)
599 ALLOCATE(conv_bwd(n),stat=stallo)
600 IF (stallo /= 0)
THEN
601 CALL l4f_log(l4f_fatal,
"allocating memory")
602 CALL raise_fatal_error()
605 conv_bwd(:) = vg6d_v7d_var_conv_miss
606 CALL import_var_conv(un, conv_bwd)
608 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
609 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
615 SUBROUTINE import_var_conv(un, conv_type)
616 INTEGER,
INTENT(in) :: un
617 TYPE(vg6d_v7d_var_conv
),
INTENT(out) :: conv_type(:)
621 CHARACTER(len=1024) :: line
622 CHARACTER(len=10) :: btable
623 INTEGER :: centre, category, number, discipline
625 DO i = 1,
SIZE(conv_type)
626 READ(un,
'(A)',end=200)line
631 CALL
init(conv_type(i)%v7d_var, btable=btable)
637 CALL
init(conv_type(i)%vg6d_var, centre=centre, category=category, &
638 number=number, discipline=discipline)
647 END SUBROUTINE import_var_conv
649 END SUBROUTINE vg6d_v7d_var_conv_setup
652 ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
656 res = this%a == that%a .AND. this%b == that%b
658 END FUNCTION conv_func_eq
661 ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
665 res = .NOT.(this == that)
667 END FUNCTION conv_func_ne
670 FUNCTION conv_func_mult(this, that) RESULT(mult)
676 IF (this == conv_func_miss .OR. that == conv_func_miss)
THEN
677 mult = conv_func_miss
679 mult%a = this%a*that%a
680 mult%b = this%a*that%b+this%b
683 END FUNCTION conv_func_mult
692 ELEMENTAL SUBROUTINE conv_func_compute(this, values)
694 REAL,
INTENT(inout) :: values
696 IF (this /= conv_func_miss)
THEN
697 IF (
c_e(values)) values = values*this%a + this%b
702 END SUBROUTINE conv_func_compute
712 ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
714 REAL,
INTENT(in) :: values
720 END FUNCTION conv_func_convert
736 SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
738 INTEGER,
POINTER :: xind(:), yind(:)
742 INTEGER :: i, nv, counts(size(vol7d_var_horcomp))
747 CALL vargrib2varbufr(this, varbufr, c_func)
749 DO i = 1,
SIZE(vol7d_var_horcomp)
750 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
753 IF (any(counts(1::2) > 1))
THEN
754 CALL l4f_log(l4f_warn,
'> 1 variable refer to x component of the same field, (un)rotation impossible')
758 IF (any(counts(2::2) > 1))
THEN
759 CALL l4f_log(l4f_warn,
'> 1 variable refer to y component of the same field, (un)rotation impossible')
766 DO i = 1,
SIZE(vol7d_var_horcomp), 2
767 IF (counts(i) == 0 .AND. counts(i+1) > 0)
THEN
768 CALL l4f_log(l4f_warn,
'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
769 ' present but the corresponding x-component '// &
770 trim(vol7d_var_horcomp(i)%btable)//
' is missing, (un)rotation impossible')
772 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0)
THEN
773 CALL l4f_log(l4f_warn,
'variable '//trim(vol7d_var_horcomp(i)%btable)// &
774 ' present but the corresponding y-component '// &
775 trim(vol7d_var_horcomp(i+1)%btable)//
' is missing, (un)rotation impossible')
778 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
782 ALLOCATE(xind(nv), yind(nv))
784 DO i = 1,
SIZE(vol7d_var_horcomp), 2
785 IF (counts(i) == 1 .AND. counts(i+1) == 1)
THEN
787 xind(nv) =
index(varbufr(:), vol7d_var_horcomp(i))
788 yind(nv) =
index(varbufr(:), vol7d_var_horcomp(i+1))
793 END SUBROUTINE volgrid6d_var_hor_comp_index
800 FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
802 LOGICAL :: is_hor_comp
807 is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
809 END FUNCTION volgrid6d_var_is_hor_comp
Definitions of constants and functions for working with missing values.
Derived type associated to a block/message/record/band of gridded data coming from a file-like object...
Definition of a physical variable in grib coding style.
This module defines an abstract interface to different drivers for access to files containing gridded...
Apply the conversion function this to values.
Display on the screen a brief content of object.
Methods for successively obtaining the fields of a csv_record object.
Initialize a volgrid6d_var object with the optional arguments provided.
Destructor for the corresponding object, it assigns it to a missing value.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Class for managing physical variables in a grib 1/2 fashion.
Class for interpreting the records of a csv file.
Definisce una variabile meteorologica osservata o un suo attributo.
Definition of constants to be used for declaring variables of a desired type.
Utilities for managing files.
Class defining a real conversion function between units.
Apply the conversion function this to values.