49 CHARACTER(len=65) :: description
50 CHARACTER(len=24) :: unit
53 TYPE(volgrid6d_var),
PARAMETER :: volgrid6d_var_miss= &
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) &
82 TYPE(conv_func),
PARAMETER :: conv_func_miss=
conv_func(rmiss,rmiss)
83 TYPE(conv_func),
PARAMETER :: conv_func_identity=
conv_func(1.0,0.0)
85 TYPE vg6d_v7d_var_conv
86 TYPE(volgrid6d_var) :: vg6d_var
87 TYPE(vol7d_var) :: v7d_var
88 TYPE(conv_func) :: c_func
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
191 TYPE(volgrid6d_var) :: this
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)
200 TYPE(volgrid6d_var),
INTENT(INOUT) :: this
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)
310 TYPE(volgrid6d_var),
INTENT(IN) :: this, that
313 res = .NOT.(this == that)
315 END FUNCTION volgrid6d_var_ne
318 #include "array_utilities_inc.F90" 322 SUBROUTINE display_volgrid6d_var(this)
323 TYPE(volgrid6d_var),
INTENT(in) :: 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)
343 TYPE(volgrid6d_var),
INTENT(in) :: vargrib(:)
344 TYPE(vol7d_var),
INTENT(out) :: varbufr(:)
345 TYPE(conv_func),
POINTER :: c_func(:)
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)
374 TYPE(volgrid6d_var),
INTENT(in) :: vargrib
375 TYPE(conv_func),
INTENT(out),
OPTIONAL :: c_func
376 TYPE(vol7d_var) :: convert
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)
417 TYPE(vol7d_var),
INTENT(in) :: varbufr(:)
418 TYPE(volgrid6d_var),
INTENT(out) :: vargrib(:)
419 TYPE(conv_func),
POINTER :: c_func(:)
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)
452 TYPE(vol7d_var),
INTENT(in) :: varbufr
453 TYPE(conv_func),
INTENT(out),
OPTIONAL :: c_func
454 TYPE(grid_id),
INTENT(in),
OPTIONAL :: grid_id_template
455 TYPE(volgrid6d_var) :: convert
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)
517 TYPE(volgrid6d_var),
INTENT(inout) :: this
518 TYPE(conv_func),
INTENT(out) :: c_func
519 TYPE(grid_id),
INTENT(in) :: grid_id_template
521 LOGICAL :: eqed, eqcentre
522 INTEGER :: gaid, editionnumber, centre
523 TYPE(volgrid6d_var) :: tmpgrib
524 TYPE(vol7d_var) :: tmpbufr
525 TYPE(conv_func) tmpc_func1, tmpc_func2
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
Represent level object in a pretty string.
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.
Utilities for managing files.
Methods for successively obtaining the fields of a csv_record object.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Initialize a volgrid6d_var object with the optional arguments provided.
Destructor for the corresponding object, it assigns it to a missing value.
Definitions of constants and functions for working with missing values.
Class for interpreting the records of a csv file.
Class for managing physical variables in a grib 1/2 fashion.
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Apply the conversion function this to values.
Definition of constants to be used for declaring variables of a desired type.