libsim Versione 7.1.11
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
31USE kinds
37
38IMPLICIT NONE
39
45 integer :: centre
46 integer :: category
47 integer :: number
48 integer :: discipline
49 CHARACTER(len=65) :: description
50 CHARACTER(len=24) :: unit
51END TYPE volgrid6d_var
52
53TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
54 volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
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
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
110INTERFACE init
111 MODULE PROCEDURE volgrid6d_var_init
112END INTERFACE
113
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
129INTERFACE OPERATOR (==)
130 MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
131END INTERFACE
132
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
146INTERFACE display
147 MODULE PROCEDURE display_volgrid6d_var
148END INTERFACE
149
154INTERFACE OPERATOR (*)
155 MODULE PROCEDURE conv_func_mult
156END INTERFACE OPERATOR (*)
157
160INTERFACE compute
161 MODULE PROCEDURE conv_func_compute
162END INTERFACE
163
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
189integer,INTENT(in),OPTIONAL :: category
190integer,INTENT(in),OPTIONAL :: number
191integer,INTENT(in),OPTIONAL :: discipline
192CHARACTER(len=*),INTENT(in),OPTIONAL :: description
193CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
194
195TYPE(volgrid6d_var) :: this
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
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)
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
265
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
298
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
325
326res = .NOT.(this == that)
327
328END FUNCTION volgrid6d_var_ne
329
330
331#include "array_utilities_inc.F90"
332
333
335SUBROUTINE display_volgrid6d_var(this)
336TYPE(volgrid6d_var),INTENT(in) :: this
337
338print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
339
340END SUBROUTINE display_volgrid6d_var
341
342
355SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
356TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
357TYPE(vol7d_var),INTENT(out) :: varbufr(:)
358TYPE(conv_func),POINTER :: c_func(:)
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
386FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
387TYPE(volgrid6d_var),INTENT(in) :: vargrib
388TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
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
416
417
433SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
434TYPE(vol7d_var),INTENT(in) :: varbufr(:)
435TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
436TYPE(conv_func),POINTER :: c_func(:)
437TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
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
468FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
469TYPE(vol7d_var),INTENT(in) :: varbufr
470TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
471TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
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
541SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
542TYPE(volgrid6d_var),INTENT(inout) :: this
543TYPE(conv_func),INTENT(out) :: c_func
544TYPE(grid_id),INTENT(in) :: grid_id_template
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
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
717ELEMENTAL SUBROUTINE conv_func_compute(this, values)
718TYPE(conv_func),INTENT(in) :: this
719REAL,INTENT(inout) :: values
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
737ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
738TYPE(conv_func),intent(in) :: this
739REAL,INTENT(in) :: values
740REAL :: convert
741
742convert = values
743CALL compute(this, convert)
744
745END FUNCTION conv_func_convert
746
747
761SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
762TYPE(volgrid6d_var),INTENT(in) :: this(:)
763INTEGER,POINTER :: xind(:), yind(:)
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
825FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
826TYPE(volgrid6d_var),INTENT(in) :: this
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:251
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.