libsim Versione 7.2.6
volgrid6d_var_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
20!> Class for managing physical variables in a grib 1/2 fashion.
21!! This module defines a class which can represent Earth-science
22!! related physical variables, following the classification scheme
23!! adopted by WMO for grib1 and grib2 parameter definition. It also
24!! defines some methods for mapping \a volgrid6d_var variables and
25!! converting the corresponding fields to a matching \a vol7d_var
26!! object defined in \a vol7d_var_class module, which, unlike the
27!! variables defined here, defines univocally a physical quantity.
28!!
29!! \ingroup volgrid6d
31USE kinds
37
38IMPLICIT NONE
39
40!> Definition of a physical variable in grib coding style.
41!! \a volgrid6d_var members are public, thus they can be freely
42!! altered, but it is advisable to set them through the
43!! volgrid6d_var_class::init constructor.
45 integer :: centre !< centre
46 integer :: category !< grib2: category / grib1: grib table version number
47 integer :: number !< parameter number
48 integer :: discipline !< grib2: discipline / grib1: 255
49 CHARACTER(len=65) :: description !< optional textual description of the variable
50 CHARACTER(len=24) :: unit !< optional textual description of the variable's unit
51END TYPE volgrid6d_var
52
53TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
54 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss) !< missing value volgrid6d_var.
55
56TYPE(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) &
59 /)
60
61TYPE(vol7d_var),PARAMETER :: vol7d_var_horcomp(4) = (/ &! RESHAPE( (/ &
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) &
66/)
67!/), (/2,2/)) ! bug in gfortran
68
69!> Class defining a real conversion function between units. It is
70!! used to numerically convert a value expressed as a \a volgrid6d_var
71!! variable in a value expressed as a \a vol7d_var variable and
72!! vice-versa. At the moment only a linear conversion is
73!! supported. Objects of this class are returned only by the \a
74!! vargrib2varbufr \a varbufr2vargrib, and \a convert methods and are
75!! used in the \a convert and \a compute methods defined in this
76!! MODULE.
77TYPE conv_func
78 PRIVATE
79 REAL :: a, b
80END TYPE conv_func
81
82TYPE(conv_func), PARAMETER :: conv_func_miss=conv_func(rmiss,rmiss)
83TYPE(conv_func), PARAMETER :: conv_func_identity=conv_func(1.0,0.0)
84
85TYPE vg6d_v7d_var_conv
86 TYPE(volgrid6d_var) :: vg6d_var
87 TYPE(vol7d_var) :: v7d_var
88 TYPE(conv_func) :: c_func
89! aggiungere informazioni ad es. su rotazione del vento
90END TYPE vg6d_v7d_var_conv
91
92TYPE(vg6d_v7d_var_conv), PARAMETER :: vg6d_v7d_var_conv_miss= &
93 vg6d_v7d_var_conv(volgrid6d_var_miss, vol7d_var_miss, conv_func_miss)
94
95TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
96
97!> Initialize a \a volgrid6d_var object with the optional arguments provided.
98!! If an argument is not provided, the corresponding object member and
99!! those depending on it will be set to missing. For grib1-style
100!! variables, the \a discipline argument must be omitted, it will be
101!! set to 255 (grib missing value).
102!!
103!! \param this TYPE(volgrid6d_var),INTENT(INOUT) object to be initialized
104!! \param centre INTEGER,INTENT(in),OPTIONAL centre
105!! \param category INTEGER,INTENT(in),OPTIONAL grib2: category / grib1: grib table version number
106!! \param number INTEGER,INTENT(in),OPTIONAL parameter number
107!! \param discipline INTEGER,INTENT(in),OPTIONAL grib2: discipline / grib1: 255
108!! \param description CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable
109!! \param unit CHARACTER(len=*),INTENT(in),OPTIONAL optional textual description of the variable's unit
110INTERFACE init
111 MODULE PROCEDURE volgrid6d_var_init
112END INTERFACE
113
114!> Destructor for the corresponding object, it assigns it to a missing value.
115!! \param this TYPE(volgrid6d_var) object to be destroyed
116INTERFACE delete
117 MODULE PROCEDURE volgrid6d_var_delete
118END INTERFACE
119
120INTERFACE c_e
121 MODULE PROCEDURE volgrid6d_var_c_e
122END INTERFACE
123
124
125!> Logical equality operators for objects of the classes \a
126!! volgrid6d_var and \a conv_func.
127!! They are all defined as \c ELEMENTAL thus work also on arrays of
128!! any shape.
129INTERFACE OPERATOR (==)
130 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
131END INTERFACE
132
133!> Logical inequality operators for objects of the classes \a
134!! volgrid6d_var and \a conv_func.
135!! They are all defined as \c ELEMENTAL thus work also on arrays of
136!! any shape.
137INTERFACE OPERATOR (/=)
138 MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
139END INTERFACE
140
141#define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
142#define VOL7D_POLY_TYPES _var6d
143#include "array_utilities_pre.F90"
144
145!> Display on the screen a brief content of object
146INTERFACE display
147 MODULE PROCEDURE display_volgrid6d_var
148END INTERFACE
149
150!> Compose two conversions into a single one.
151!! Unlike scalar multiplication (and like matrix multiplication) here
152!! a*b /= b*a. By convention, the second factor is applied first in
153!! the result.
154INTERFACE OPERATOR (*)
155 MODULE PROCEDURE conv_func_mult
156END INTERFACE OPERATOR (*)
157
158!> Apply the conversion function \a this to \a values.
159!! function version
160INTERFACE compute
161 MODULE PROCEDURE conv_func_compute
162END INTERFACE
163
164!> Apply the conversion function \a this to \a values.
165!! subroutine version
166INTERFACE convert
167 MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
168 conv_func_convert
169END INTERFACE
170
171PRIVATE
172PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
173 c_e, volgrid6d_var_normalize, &
174 OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
175 count_distinct, pack_distinct, count_and_pack_distinct, &
176 map_distinct, map_inv_distinct, &
177 index, display, &
178 vargrib2varbufr, varbufr2vargrib, &
179 conv_func, conv_func_miss, compute, convert, &
180 volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
181
182
183CONTAINS
184
185
186ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
187 discipline, description, unit) RESULT(this)
188integer,INTENT(in),OPTIONAL :: centre !< centre
189integer,INTENT(in),OPTIONAL :: category !< grib2: category / grib1: grib table version number
190integer,INTENT(in),OPTIONAL :: number !< parameter number
191integer,INTENT(in),OPTIONAL :: discipline !< grib2: discipline
192CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< textual description of the variable
193CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< textual description of the variable's unit
194
195TYPE(volgrid6d_var) :: this !< object to be initialised
196
197CALL init(this, centre, category, number, discipline, description, unit)
198
199END FUNCTION volgrid6d_var_new
200
201
202! documented in the interface
203ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
204TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
205INTEGER,INTENT(in),OPTIONAL :: centre ! centre
206INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
207INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
208INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
209CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
210CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
211
212IF (PRESENT(centre)) THEN
213 this%centre = centre
214ELSE
215 this%centre = imiss
216 this%category = imiss
217 this%number = imiss
218 this%discipline = imiss
219 RETURN
220ENDIF
221
222IF (PRESENT(category)) THEN
223 this%category = category
224ELSE
225 this%category = imiss
226 this%number = imiss
227 this%discipline = imiss
228 RETURN
229ENDIF
230
231
232IF (PRESENT(number)) THEN
233 this%number = number
234ELSE
235 this%number = imiss
236 this%discipline = imiss
237 RETURN
238ENDIF
239
240! se sono arrivato fino a qui ho impostato centre, category e number
241!per il grib 1 manca discipline e imposto 255 (missing del grib2)
242
243IF (PRESENT(discipline)) THEN
244 this%discipline = discipline
245ELSE
246 this%discipline = 255
247ENDIF
248
249IF (PRESENT(description)) THEN
250 this%description = description
251ELSE
252 this%description = cmiss
253ENDIF
254
255IF (PRESENT(unit)) THEN
256 this%unit = unit
257ELSE
258 this%unit = cmiss
259ENDIF
260
261
262
263END SUBROUTINE volgrid6d_var_init
264
266! documented in the interface
267SUBROUTINE volgrid6d_var_delete(this)
268TYPE(volgrid6d_var),INTENT(INOUT) :: this
269
270this%centre = imiss
271this%category = imiss
272this%number = imiss
273this%discipline = imiss
274this%description = cmiss
275this%unit = cmiss
276
277END SUBROUTINE volgrid6d_var_delete
278
279
280ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
281TYPE(volgrid6d_var),INTENT(IN) :: this
282LOGICAL :: c_e
283c_e = this /= volgrid6d_var_miss
284END FUNCTION volgrid6d_var_c_e
285
286
287ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
288TYPE(volgrid6d_var),INTENT(IN) :: this, that
289LOGICAL :: res
290
291IF (this%discipline == that%discipline) THEN
292
293 IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
294 res = ((this%category == that%category) .OR. &
295 (this%category >= 1 .AND. this%category <=3 .AND. &
296 that%category >= 1 .AND. that%category <=3)) .AND. &
297 this%number == that%number
299 IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
300 (this%number >= 128 .AND. this%number <= 254)) THEN
301 res = res .AND. this%centre == that%centre ! local definition, centre matters
302 ENDIF
303
304 ELSE ! grib2
305 res = this%category == that%category .AND. &
306 this%number == that%number
307
308 IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
309 (this%category >= 192 .AND. this%category <= 254) .OR. &
310 (this%number >= 192 .AND. this%number <= 254)) THEN
311 res = res .AND. this%centre == that%centre ! local definition, centre matters
312 ENDIF
313 ENDIF
314
315ELSE ! different edition or different discipline
316 res = .false.
317ENDIF
318
319END FUNCTION volgrid6d_var_eq
320
321
322ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
323TYPE(volgrid6d_var),INTENT(IN) :: this, that
324LOGICAL :: res
326res = .NOT.(this == that)
327
328END FUNCTION volgrid6d_var_ne
329
330
331#include "array_utilities_inc.F90"
332
333
334!> Display on the screen a brief content of \a volgrid6d_var object.
335SUBROUTINE display_volgrid6d_var(this)
336TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object to display
337
338print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
339
340END SUBROUTINE display_volgrid6d_var
341
342
343!> Convert a \a volgrid6d_var array object into a physically equivalent
344!! \a vol7d_var array object. This method converts a grib-like array
345!! of physical variables \a vargrib, to an array of unique, physically
346!! based, bufr-like variables \a varbufr. The output array must have
347!! enough room for the converted variables. The method additionally
348!! allocates a \a conv_func array object of the same size, which can
349!! successively be used to convert the numerical values of the fields
350!! associated to \a vargrib to the corresponding fields in the \a
351!! bufr-like representation. \a c_func will have to be deallocated by
352!! the calling procedure. If a conversion is not successful, the
353!! corresponding output variable is set to \a vol7d_var_miss and the
354!! conversion function to \a conv_func_miss.
355SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
356TYPE(volgrid6d_var),INTENT(in) :: vargrib(:) !< array of input grib-like variables
357TYPE(vol7d_var),INTENT(out) :: varbufr(:) !< array of output bufr-like variables
358TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
359
360INTEGER :: i, n, stallo
361
362n = min(SIZE(varbufr), SIZE(vargrib))
363ALLOCATE(c_func(n),stat=stallo)
364IF (stallo /= 0) THEN
365 call l4f_log(l4f_fatal,"allocating memory")
366 call raise_fatal_error()
367ENDIF
368
369DO i = 1, n
370 varbufr(i) = convert(vargrib(i), c_func(i))
371ENDDO
372
373END SUBROUTINE vargrib2varbufr
374
375
376!> Convert a \a volgrid6d_var object into a physically equivalent
377!! \a vol7d_var object. This method returns a physically based,
378!! bufr-like representation of type \a vol7d_var of the grib-like
379!! input physical variable \a vargrib. The method optionally returns
380!! a \a conv_func object which can successively be used to convert the
381!! numerical values of the field associated to \a vargrib to the
382!! corresponding fields in the bufr-like representation. If the
383!! conversion is not successful, the output variable is
384!! set to \a vol7d_var_miss and the conversion function to \a
385!! conv_func_miss.
386FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
387TYPE(volgrid6d_var),INTENT(in) :: vargrib !< input grib-like variable
388TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
389TYPE(vol7d_var) :: convert
391INTEGER :: i
392
393IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
394
395DO i = 1, SIZE(conv_fwd)
396 IF (vargrib == conv_fwd(i)%vg6d_var) THEN
397 convert = conv_fwd(i)%v7d_var
398 IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
399 RETURN
400 ENDIF
401ENDDO
402! not found
403convert = vol7d_var_miss
404IF (PRESENT(c_func)) c_func = conv_func_miss
405
406! set hint for backwards conversion
407convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
408 vargrib%discipline/)
409
410CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
411 trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
412 trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
413 ' not found in table')
414
415END FUNCTION vargrib2varbufr_convert
417
418!> Convert a \a vol7d_var array object into a physically equivalent
419!! \a volgrid6d_var array object. This method converts a bufr-like
420!! array of physical variables \a vargrib, to an array of grib-like
421!! variables \a varbufr. Unlike the opposite method \a
422!! vargrib2varbufr, in this case the conversion is not uniqe and at
423!! the moment the first matching grib-like variable is chosen, without
424!! any control over the choice process. The output array must have
425!! enough room for the converted variables. The method additionally
426!! allocates a \a conv_func array object of the same size, which can
427!! successively be used to convert the numerical values of the fields
428!! associated to \a varbufr to the corresponding fields in the \a
429!! grib-like representation. \a c_func will have to be deallocated by
430!! the calling procedure. If a conversion is not successful, the
431!! corresponding output variable is set to \a volgrid6d_var_miss and
432!! the conversion function to \a conv_func_miss.
433SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
434TYPE(vol7d_var),INTENT(in) :: varbufr(:) !< array of input bufr-like variables
435TYPE(volgrid6d_var),INTENT(out) :: vargrib(:) !< array of output grib-like variables
436TYPE(conv_func),POINTER :: c_func(:) !< pointer to an array of the corresponding \a conv_func objects, allocated in the method
437TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
438
439INTEGER :: i, n, stallo
440
441n = min(SIZE(varbufr), SIZE(vargrib))
442ALLOCATE(c_func(n),stat=stallo)
443IF (stallo /= 0) THEN
444 CALL l4f_log(l4f_fatal,"allocating memory")
445 CALL raise_fatal_error()
446ENDIF
447
448DO i = 1, n
449 vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
450ENDDO
451
452END SUBROUTINE varbufr2vargrib
453
454
455!> Convert a \a vol7d_var object into a physically equivalent
456!! \a volgrid6d_var object. This method returns a grib-like
457!! representation of type \a volgrid6d_var of the bufr-like input
458!! physical variable \a varbufr. Unlike the opposite \a convert
459!! method, in this case the conversion is not uniqe and at the moment
460!! the first matching grib-like variable is chosen, without any
461!! control over the choice process. The method optionally returns a
462!! \a conv_func object which can successively be used to convert the
463!! numerical values of the field associated to \a varbufr to the
464!! corresponding fields in the grib-like representation. If the
465!! conversion is not successful, the output variable is set to \a
466!! volgrid6d_var_miss and the conversion function to \a
467!! conv_func_miss.
468FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
469TYPE(vol7d_var),INTENT(in) :: varbufr !< input bufr-like variable
470TYPE(conv_func),INTENT(out),OPTIONAL :: c_func !< corresponding \a conv_func object
471TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
472TYPE(volgrid6d_var) :: convert
473
474INTEGER :: i
475#ifdef HAVE_LIBGRIBAPI
476INTEGER :: gaid, editionnumber, category, centre
477#endif
478
479IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
480
481#ifdef HAVE_LIBGRIBAPI
482editionnumber=255; category=255; centre=255
483#endif
484IF (PRESENT(grid_id_template)) THEN
485#ifdef HAVE_LIBGRIBAPI
486 gaid = grid_id_get_gaid(grid_id_template)
487 IF (c_e(gaid)) THEN
488 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
489 IF (editionnumber == 1) THEN
490 CALL grib_get(gaid,'gribTablesVersionNo',category)
491 ENDIF
492 CALL grib_get(gaid,'centre',centre)
493 ENDIF
494#endif
495ENDIF
496
497DO i = 1, SIZE(conv_bwd)
498 IF (varbufr == conv_bwd(i)%v7d_var) THEN
499#ifdef HAVE_LIBGRIBAPI
500 IF (editionnumber /= 255) THEN ! further check required (gaid present)
501 IF (editionnumber == 1) THEN
502 IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
503 ELSE IF (editionnumber == 2) THEN
504 IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
505 ENDIF
506 IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
507 conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
508 ENDIF
509#endif
510 convert = conv_bwd(i)%vg6d_var
511 IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
512 RETURN
513 ENDIF
514ENDDO
515! not found
516convert = volgrid6d_var_miss
517IF (PRESENT(c_func)) c_func = conv_func_miss
518
519! if hint available use it as a fallback
520IF (any(varbufr%gribhint /= imiss)) THEN
521 convert%centre = varbufr%gribhint(1)
522 convert%category = varbufr%gribhint(2)
523 convert%number = varbufr%gribhint(3)
524 convert%discipline = varbufr%gribhint(4)
525ENDIF
526
527CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
528 trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
529 ' not found in table')
530
531END FUNCTION varbufr2vargrib_convert
532
533
534!> Normalize a variable definition converting it to the
535!! format (grib edition) specified in the (grib) template provided.
536!! This allows a basic grib1 <-> grib2 conversion provided that
537!! entries for both grib editions of the related variable are present
538!! in the static file \a vargrib2ufr.csv. If the \a c_func variable
539!! returned is not missing (i.e. /= conv_func_miss) the field value
540!! should be converted as well using the conv_func::compute method .
541SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
542TYPE(volgrid6d_var),INTENT(inout) :: this !< variable to normalize
543TYPE(conv_func),INTENT(out) :: c_func !< \a conv_func object to convert data
544TYPE(grid_id),INTENT(in) :: grid_id_template !< a template (typically grib_api) to which data will be finally exported, it helps in improving variable conversion
545
546LOGICAL :: eqed, eqcentre
547INTEGER :: gaid, editionnumber, centre
548TYPE(volgrid6d_var) :: tmpgrib
549TYPE(vol7d_var) :: tmpbufr
550TYPE(conv_func) tmpc_func1, tmpc_func2
551
552eqed = .true.
553eqcentre = .true.
554c_func = conv_func_miss
555
556#ifdef HAVE_LIBGRIBAPI
557gaid = grid_id_get_gaid(grid_id_template)
558IF (c_e(gaid)) THEN
559 CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
560 CALL grib_get(gaid, 'centre', centre)
561 eqed = editionnumber == 1 .EQV. this%discipline == 255
562 eqcentre = centre == this%centre
563ENDIF
564#endif
565
566IF (eqed .AND. eqcentre) RETURN ! nothing to do
567
568tmpbufr = convert(this, tmpc_func1)
569tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
570
571IF (tmpgrib /= volgrid6d_var_miss) THEN
572! conversion back and forth successful, set also conversion function
573 this = tmpgrib
574 c_func = tmpc_func1 * tmpc_func2
575! set to missing in common case to avoid useless computation
576 IF (c_func == conv_func_identity) c_func = conv_func_miss
577ELSE IF (.NOT.eqed) THEN
578! conversion back and forth unsuccessful and grib edition incompatible, set to miss
579 this = tmpgrib
580ENDIF
581
582END SUBROUTINE volgrid6d_var_normalize
583
584
585! Private subroutine for reading forward and backward conversion tables
586! todo: better error handling
587SUBROUTINE vg6d_v7d_var_conv_setup()
588INTEGER :: un, i, n, stallo
589
590! forward, grib to bufr
591un = open_package_file('vargrib2bufr.csv', filetype_data)
592n=0
593DO WHILE(.true.)
594 READ(un,*,END=100)
595 n = n + 1
596ENDDO
597
598100 CONTINUE
599
600rewind(un)
601ALLOCATE(conv_fwd(n),stat=stallo)
602IF (stallo /= 0) THEN
603 CALL l4f_log(l4f_fatal,"allocating memory")
604 CALL raise_fatal_error()
605ENDIF
606
607conv_fwd(:) = vg6d_v7d_var_conv_miss
608CALL import_var_conv(un, conv_fwd)
609CLOSE(un)
610
611! backward, bufr to grib
612un = open_package_file('vargrib2bufr.csv', filetype_data)
613! use the same file for now
614!un = open_package_file('varbufr2grib.csv', filetype_data)
615n=0
616DO WHILE(.true.)
617 READ(un,*,END=300)
618 n = n + 1
619ENDDO
620
621300 CONTINUE
622
623rewind(un)
624ALLOCATE(conv_bwd(n),stat=stallo)
625IF (stallo /= 0) THEN
626 CALL l4f_log(l4f_fatal,"allocating memory")
627 CALL raise_fatal_error()
628end if
629
630conv_bwd(:) = vg6d_v7d_var_conv_miss
631CALL import_var_conv(un, conv_bwd)
632DO i = 1, n
633 conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
634 conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
635ENDDO
636CLOSE(un)
637
638CONTAINS
639
640SUBROUTINE import_var_conv(un, conv_type)
641INTEGER, INTENT(in) :: un
642TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
643
644INTEGER :: i
645TYPE(csv_record) :: csv
646CHARACTER(len=1024) :: line
647CHARACTER(len=10) :: btable
648INTEGER :: centre, category, number, discipline
649
650DO i = 1, SIZE(conv_type)
651 READ(un,'(A)',END=200)line
652 CALL init(csv, line)
653 CALL csv_record_getfield(csv, btable)
654 CALL csv_record_getfield(csv) ! skip fields for description and unit,
655 CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
656 CALL init(conv_type(i)%v7d_var, btable=btable)
657
658 CALL csv_record_getfield(csv, centre)
659 CALL csv_record_getfield(csv, category)
660 CALL csv_record_getfield(csv, number)
661 CALL csv_record_getfield(csv, discipline)
662 CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
663 number=number, discipline=discipline) ! controllare l'ordine
664
665 CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
666 CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
667 CALL delete(csv)
668ENDDO
669
670200 CONTINUE
671
672END SUBROUTINE import_var_conv
673
674END SUBROUTINE vg6d_v7d_var_conv_setup
675
676
677ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
678TYPE(conv_func),INTENT(IN) :: this, that
679LOGICAL :: res
680
681res = this%a == that%a .AND. this%b == that%b
682
683END FUNCTION conv_func_eq
684
685
686ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
687TYPE(conv_func),INTENT(IN) :: this, that
688LOGICAL :: res
689
690res = .NOT.(this == that)
691
692END FUNCTION conv_func_ne
693
694
695FUNCTION conv_func_mult(this, that) RESULT(mult)
696TYPE(conv_func),INTENT(in) :: this
697TYPE(conv_func),INTENT(in) :: that
698
699TYPE(conv_func) :: mult
700
701IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
702 mult = conv_func_miss
703ELSE
704 mult%a = this%a*that%a
705 mult%b = this%a*that%b+this%b
706ENDIF
707
708END FUNCTION conv_func_mult
709
710!> Apply the conversion function \a this to \a values.
711!! The numerical conversion (only linear at the moment) defined by the
712!! \a conv_func object \a this is applied to the \a values argument;
713!! the converted result is stored in place; missing values remain
714!! missing; if the conversion function is undefined (\a
715!! conv_func_miss) the values are unchanged. The method is \c
716!! ELEMENTAL, thus \a values can be also an array of any shape.
717ELEMENTAL SUBROUTINE conv_func_compute(this, values)
718TYPE(conv_func),INTENT(in) :: this !< object defining the conversion function
719REAL,INTENT(inout) :: values !< value to be converted in place
720
721IF (this /= conv_func_miss) THEN
722 IF (c_e(values)) values = values*this%a + this%b
723ELSE
724 values=rmiss
725ENDIF
726
727END SUBROUTINE conv_func_compute
728
729
730!> Return a copy of \a values converted by applying the conversion
731!! function \a this. The numerical conversion (only linear at the
732!! moment) defined by the \a conv_func object \a this is applied to
733!! the \a values argument and the converted result is returned;
734!! missing values remain missing; if the conversion function is
735!! undefined (\a conv_func_miss) the values are unchanged. The method
736!! is \c ELEMENTAL, thus \a values can be also an array of any shape.
737ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
738TYPE(conv_func),intent(in) :: this !< object defining the conversion function
739REAL,INTENT(in) :: values !< input value to be converted
740REAL :: convert
741
742convert = values
743CALL compute(this, convert)
744
745END FUNCTION conv_func_convert
746
747
748!> Locate variables which are horizontal components of a vector field.
749!! This method scans the \a volgrid6d_var array provided and locates
750!! pairs of variables which are x and y component of the same vector
751!! field. On exit, the arrays \x xind(:) and \a yind(:) are allocated
752!! to a size equal to the number of vector fields detected and their
753!! corresponding elements will point to x and y components of the same
754!! vector field. If inconsistencies are found, e.g. only one component
755!! is detected for a field, or more than one input variable define
756!! the same component, then \a xind and \a xind are nullified, thus an
757!! error condition can be tested as \c .NOT.ASSOCIATED(xind). If no
758!! vector fields are found then \a xind and \a xind are allocated to
759!! zero size. If \a xind and \a yind are \c ASSOCIATED() after return,
760!! they should be \c DEALLOCATEd by the calling procedure.
761SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
762TYPE(volgrid6d_var),INTENT(in) :: this(:) !< array of volgrid6d_var objects (grib variable) to test
763INTEGER,POINTER :: xind(:), yind(:) !< output arrays of indices pointing to matching horizontal components, allocated by this method
764
765TYPE(vol7d_var) :: varbufr(size(this))
766TYPE(conv_func),POINTER :: c_func(:)
767INTEGER :: i, nv, counts(size(vol7d_var_horcomp))
768
769NULLIFY(xind, yind)
770counts(:) = 0
771
772CALL vargrib2varbufr(this, varbufr, c_func)
773
774DO i = 1, SIZE(vol7d_var_horcomp)
775 counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
776ENDDO
777
778IF (any(counts(1::2) > 1)) THEN
779 CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
780 DEALLOCATE(c_func)
781 RETURN
782ENDIF
783IF (any(counts(2::2) > 1)) THEN
784 CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
785 DEALLOCATE(c_func)
786 RETURN
787ENDIF
788
789! check that variables are paired and count pairs
790nv = 0
791DO i = 1, SIZE(vol7d_var_horcomp), 2
792 IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
793 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
794 ' present but the corresponding x-component '// &
795 trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
796 RETURN
797 ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
798 CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
799 ' present but the corresponding y-component '// &
800 trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
801 RETURN
802 ENDIF
803 IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
804ENDDO
805
806! repeat the loop storing indices
807ALLOCATE(xind(nv), yind(nv))
808nv = 0
809DO i = 1, SIZE(vol7d_var_horcomp), 2
810 IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
811 nv = nv + 1
812 xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
813 yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
814 ENDIF
815ENDDO
816DEALLOCATE(c_func)
817
818END SUBROUTINE volgrid6d_var_hor_comp_index
819
820
821!> Tests whether a variable is the horizontal component of a vector field.
822!! Returns \a .TRUE. if the corresponding variable is recognized as an
823!! horizontal component of a vector field; if it is the case the
824!! variable may need rotation in case of coordinate change.
825FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
826TYPE(volgrid6d_var),INTENT(in) :: this !< volgrid6d_var object (grib variable) to test
827LOGICAL :: is_hor_comp
828
829TYPE(vol7d_var) :: varbufr
830
831varbufr = convert(this)
832is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
833
834END FUNCTION volgrid6d_var_is_hor_comp
835
836! before unstaggering??
837
838!IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
839!
840!call init(varu,btable="B11003")
841!call init(varv,btable="B11004")
842!
843! test about presence of u and v in standard table
844!if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
845! call l4f_category_log(this%category,L4F_FATAL, &
846! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
847! CALL raise_error()
848! RETURN
849!end if
850!
851!if (associated(this%var))then
852! nvar=size(this%var)
853! allocate(varbufr(nvar),stat=stallo)
854! if (stallo /=0)then
855! call l4f_log(L4F_FATAL,"allocating memory")
856! call raise_fatal_error("allocating memory")
857! end if
858!
859! CALL vargrib2varbufr(this%var, varbufr)
860!ELSE
861! CALL l4f_category_log(this%category, L4F_ERROR, &
862! "trying to destagger an incomplete volgrid6d object")
863! CALL raise_error()
864! RETURN
865!end if
866!
867!nvaru=COUNT(varbufr==varu)
868!nvarv=COUNT(varbufr==varv)
869!
870!if (nvaru > 1 )then
871! call l4f_category_log(this%category,L4F_WARN, &
872! ">1 variables refer to u wind component, destaggering will not be done ")
873! DEALLOCATE(varbufr)
874! RETURN
875!endif
876!
877!if (nvarv > 1 )then
878! call l4f_category_log(this%category,L4F_WARN, &
879! ">1 variables refer to v wind component, destaggering will not be done ")
880! DEALLOCATE(varbufr)
881! RETURN
882!endif
883!
884!if (nvaru == 0 .and. nvarv == 0) then
885! call l4f_category_log(this%category,L4F_WARN, &
886! "no u or v wind component found in volume, nothing to do")
887! DEALLOCATE(varbufr)
888! RETURN
889!endif
890!
891!if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
892! call l4f_category_log(this%category,L4F_WARN, &
893! "there are variables different from u and v wind component in C grid")
894!endif
895
896
897END MODULE volgrid6d_var_class
Index method.
Apply the conversion function this to values.
Apply the conversion function this to values.
Destructor for the corresponding object, it assigns it to a missing value.
Display on the screen a brief content of object.
Initialize a volgrid6d_var object with the optional arguments provided.
Gestione degli errori.
Utilities for managing files.
This module defines an abstract interface to different drivers for access to files containing gridded...
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 delle variabili osservate da stazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Derived type associated to a block/message/record/band of gridded data coming from a file-like object...
Definisce una variabile meteorologica osservata o un suo attributo.
Class defining a real conversion function between units.
Definition of a physical variable in grib coding style.

Generated with Doxygen.