libsim  Versione8.0.0
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 
31 USE kinds
33 USE err_handling
36 USE grid_id_class
37 
38 IMPLICIT NONE
39 
44 TYPE volgrid6d_var
45  integer :: centre
46  integer :: category
47  integer :: number
48  integer :: discipline
49  CHARACTER(len=65) :: description
50  CHARACTER(len=24) :: unit
51 END TYPE volgrid6d_var
52 
53 TYPE(volgrid6d_var),PARAMETER :: volgrid6d_var_miss= &
54  volgrid6d_var(imiss,imiss,imiss,imiss,cmiss,cmiss)
55 
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) &
59  /)
60 
61 TYPE(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 
77 TYPE conv_func
78  PRIVATE
79  REAL :: a, b
80 END TYPE conv_func
81 
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)
84 
85 TYPE 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
90 END TYPE vg6d_v7d_var_conv
91 
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)
94 
95 TYPE(vg6d_v7d_var_conv), ALLOCATABLE :: conv_fwd(:), conv_bwd(:)
96 
110 INTERFACE init
111  MODULE PROCEDURE volgrid6d_var_init
112 END INTERFACE
113 
116 INTERFACE delete
117  MODULE PROCEDURE volgrid6d_var_delete
118 END INTERFACE
119 
120 INTERFACE c_e
121  MODULE PROCEDURE volgrid6d_var_c_e
122 END INTERFACE
123 
124 
129 INTERFACE OPERATOR (==)
130  MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
131 END INTERFACE
132 
137 INTERFACE OPERATOR (/=)
138  MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
139 END INTERFACE
140 
141 #define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
142 #define VOL7D_POLY_TYPES _var6d
143 #include "array_utilities_pre.F90"
144 
146 INTERFACE display
147  MODULE PROCEDURE display_volgrid6d_var
148 END INTERFACE
149 
154 INTERFACE OPERATOR (*)
155  MODULE PROCEDURE conv_func_mult
156 END INTERFACE OPERATOR (*)
157 
160 INTERFACE compute
161  MODULE PROCEDURE conv_func_compute
162 END INTERFACE
163 
166 INTERFACE convert
167  MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert
168 END INTERFACE
169 
170 PRIVATE
171 PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
172  c_e, volgrid6d_var_normalize, &
173  OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
174  count_distinct, pack_distinct, count_and_pack_distinct, &
175  map_distinct, map_inv_distinct, &
176  index, display, &
177  vargrib2varbufr, varbufr2vargrib, &
178  conv_func, conv_func_miss, compute, convert, &
179  volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
180 
181 
182 CONTAINS
183 
184 
185 ELEMENTAL FUNCTION volgrid6d_var_new(centre, category, number, &
186  discipline, description, unit) RESULT(this)
187 integer,INTENT(in),OPTIONAL :: centre
188 integer,INTENT(in),OPTIONAL :: category
189 integer,INTENT(in),OPTIONAL :: number
190 integer,INTENT(in),OPTIONAL :: discipline
191 CHARACTER(len=*),INTENT(in),OPTIONAL :: description
192 CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
193 
194 TYPE(volgrid6d_var) :: this
195 
196 CALL init(this, centre, category, number, discipline, description, unit)
197 
198 END FUNCTION volgrid6d_var_new
199 
200 
201 ! documented in the interface
202 ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
203 TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
204 INTEGER,INTENT(in),OPTIONAL :: centre ! centre
205 INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
206 INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
207 INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
208 CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
209 CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
210 
211 IF (PRESENT(centre)) THEN
212  this%centre = centre
213 ELSE
214  this%centre = imiss
215  this%category = imiss
216  this%number = imiss
217  this%discipline = imiss
218  RETURN
219 ENDIF
220 
221 IF (PRESENT(category)) THEN
222  this%category = category
223 ELSE
224  this%category = imiss
225  this%number = imiss
226  this%discipline = imiss
227  RETURN
228 ENDIF
229 
230 
231 IF (PRESENT(number)) THEN
232  this%number = number
233 ELSE
234  this%number = imiss
235  this%discipline = imiss
236  RETURN
237 ENDIF
238 
239 ! se sono arrivato fino a qui ho impostato centre, category e number
240 !per il grib 1 manca discipline e imposto 255 (missing del grib2)
241 
242 IF (PRESENT(discipline)) THEN
243  this%discipline = discipline
244 ELSE
245  this%discipline = 255
246 ENDIF
248 IF (PRESENT(description)) THEN
249  this%description = description
250 ELSE
251  this%description = cmiss
252 ENDIF
253 
254 IF (PRESENT(unit)) THEN
255  this%unit = unit
256 ELSE
257  this%unit = cmiss
258 ENDIF
259 
260 
261 
262 END SUBROUTINE volgrid6d_var_init
263 
264 
265 ! documented in the interface
266 SUBROUTINE volgrid6d_var_delete(this)
267 TYPE(volgrid6d_var),INTENT(INOUT) :: this
268 
269 this%centre = imiss
270 this%category = imiss
271 this%number = imiss
272 this%discipline = imiss
273 this%description = cmiss
274 this%unit = cmiss
276 END SUBROUTINE volgrid6d_var_delete
277 
278 
279 ELEMENTAL FUNCTION volgrid6d_var_c_e(this) RESULT(c_e)
280 TYPE(volgrid6d_var),INTENT(IN) :: this
281 LOGICAL :: c_e
282 c_e = this /= volgrid6d_var_miss
283 END FUNCTION volgrid6d_var_c_e
284 
285 
286 ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
287 TYPE(volgrid6d_var),INTENT(IN) :: this, that
288 LOGICAL :: res
289 
290 IF (this%discipline == that%discipline) THEN
291 
292  IF (this%discipline == 255) THEN ! grib1, WMO tables are all equivalent
293  res = ((this%category == that%category) .OR. &
294  (this%category >= 1 .AND. this%category <=3 .AND. &
295  that%category >= 1 .AND. that%category <=3)) .AND. &
296  this%number == that%number
297 
298  IF ((this%category >= 128 .AND. this%category <= 254) .OR. &
299  (this%number >= 128 .AND. this%number <= 254)) THEN
300  res = res .AND. this%centre == that%centre ! local definition, centre matters
301  ENDIF
302 
303  ELSE ! grib2
304  res = this%category == that%category .AND. &
305  this%number == that%number
306 
307  IF ((this%discipline >= 192 .AND. this%discipline <= 254) .OR. &
308  (this%category >= 192 .AND. this%category <= 254) .OR. &
309  (this%number >= 192 .AND. this%number <= 254)) THEN
310  res = res .AND. this%centre == that%centre ! local definition, centre matters
311  ENDIF
312  ENDIF
313 
314 ELSE ! different edition or different discipline
315  res = .false.
316 ENDIF
317 
318 END FUNCTION volgrid6d_var_eq
319 
320 
321 ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
322 TYPE(volgrid6d_var),INTENT(IN) :: this, that
323 LOGICAL :: res
324 
325 res = .NOT.(this == that)
326 
327 END FUNCTION volgrid6d_var_ne
328 
329 
330 #include "array_utilities_inc.F90"
331 
332 
334 SUBROUTINE display_volgrid6d_var(this)
335 TYPE(volgrid6d_var),INTENT(in) :: this
336 
337 print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
338 
339 END SUBROUTINE display_volgrid6d_var
340 
341 
354 SUBROUTINE vargrib2varbufr(vargrib, varbufr, c_func)
355 TYPE(volgrid6d_var),INTENT(in) :: vargrib(:)
356 TYPE(vol7d_var),INTENT(out) :: varbufr(:)
357 TYPE(conv_func),POINTER :: c_func(:)
358 
359 INTEGER :: i, n, stallo
360 
361 n = min(SIZE(varbufr), SIZE(vargrib))
362 ALLOCATE(c_func(n),stat=stallo)
363 IF (stallo /= 0) THEN
364  call l4f_log(l4f_fatal,"allocating memory")
365  call raise_fatal_error()
366 ENDIF
367 
368 DO i = 1, n
369  varbufr(i) = convert(vargrib(i), c_func(i))
370 ENDDO
371 
372 END SUBROUTINE vargrib2varbufr
373 
374 
385 FUNCTION vargrib2varbufr_convert(vargrib, c_func) RESULT(convert)
386 TYPE(volgrid6d_var),INTENT(in) :: vargrib
387 TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
388 TYPE(vol7d_var) :: convert
389 
390 INTEGER :: i
391 
392 IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
393 
394 DO i = 1, SIZE(conv_fwd)
395  IF (vargrib == conv_fwd(i)%vg6d_var) THEN
396  convert = conv_fwd(i)%v7d_var
397  IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
398  RETURN
399  ENDIF
400 ENDDO
401 ! not found
402 convert = vol7d_var_miss
403 IF (PRESENT(c_func)) c_func = conv_func_miss
404 
405 ! set hint for backwards conversion
406 convert%gribhint(:) = (/vargrib%centre, vargrib%category, vargrib%number, &
407  vargrib%discipline/)
408 
409 CALL l4f_log(l4f_warn, 'vargrib2varbufr: variable '// &
410  trim(to_char(vargrib%centre))//':'//trim(to_char(vargrib%category))//':'// &
411  trim(to_char(vargrib%number))//':'//trim(to_char(vargrib%discipline))// &
412  ' not found in table')
413 
414 END FUNCTION vargrib2varbufr_convert
415 
416 
432 SUBROUTINE varbufr2vargrib(varbufr, vargrib, c_func, grid_id_template)
433 TYPE(vol7d_var),INTENT(in) :: varbufr(:)
434 TYPE(volgrid6d_var),INTENT(out) :: vargrib(:)
435 TYPE(conv_func),POINTER :: c_func(:)
436 TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
437 
438 INTEGER :: i, n, stallo
439 
440 n = min(SIZE(varbufr), SIZE(vargrib))
441 ALLOCATE(c_func(n),stat=stallo)
442 IF (stallo /= 0) THEN
443  CALL l4f_log(l4f_fatal,"allocating memory")
444  CALL raise_fatal_error()
445 ENDIF
446 
447 DO i = 1, n
448  vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
449 ENDDO
450 
451 END SUBROUTINE varbufr2vargrib
452 
453 
467 FUNCTION varbufr2vargrib_convert(varbufr, c_func, grid_id_template) RESULT(convert)
468 TYPE(vol7d_var),INTENT(in) :: varbufr
469 TYPE(conv_func),INTENT(out),OPTIONAL :: c_func
470 TYPE(grid_id),INTENT(in),OPTIONAL :: grid_id_template
471 TYPE(volgrid6d_var) :: convert
472 
473 INTEGER :: i
474 #ifdef HAVE_LIBGRIBAPI
475 INTEGER :: gaid, editionnumber, category, centre
476 #endif
477 
478 IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
479 
480 #ifdef HAVE_LIBGRIBAPI
481 editionnumber=255; category=255; centre=255
482 #endif
483 IF (PRESENT(grid_id_template)) THEN
484 #ifdef HAVE_LIBGRIBAPI
485  gaid = grid_id_get_gaid(grid_id_template)
486  IF (c_e(gaid)) THEN
487  CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
488  IF (editionnumber == 1) THEN
489  CALL grib_get(gaid,'gribTablesVersionNo',category)
490  ENDIF
491  CALL grib_get(gaid,'centre',centre)
492  ENDIF
493 #endif
494 ENDIF
495 
496 DO i = 1, SIZE(conv_bwd)
497  IF (varbufr == conv_bwd(i)%v7d_var) THEN
498 #ifdef HAVE_LIBGRIBAPI
499  IF (editionnumber /= 255) THEN ! further check required (gaid present)
500  IF (editionnumber == 1) THEN
501  IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
502  ELSE IF (editionnumber == 2) THEN
503  IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
504  ENDIF
505  IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
506  conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
507  ENDIF
508 #endif
509  convert = conv_bwd(i)%vg6d_var
510  IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
511  RETURN
512  ENDIF
513 ENDDO
514 ! not found
515 convert = volgrid6d_var_miss
516 IF (PRESENT(c_func)) c_func = conv_func_miss
517 
518 ! if hint available use it as a fallback
519 IF (any(varbufr%gribhint /= imiss)) THEN
520  convert%centre = varbufr%gribhint(1)
521  convert%category = varbufr%gribhint(2)
522  convert%number = varbufr%gribhint(3)
523  convert%discipline = varbufr%gribhint(4)
524 ENDIF
525 
526 CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
527  trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
528  ' not found in table')
529 
530 END FUNCTION varbufr2vargrib_convert
531 
532 
540 SUBROUTINE volgrid6d_var_normalize(this, c_func, grid_id_template)
541 TYPE(volgrid6d_var),INTENT(inout) :: this
542 TYPE(conv_func),INTENT(out) :: c_func
543 TYPE(grid_id),INTENT(in) :: grid_id_template
544 
545 LOGICAL :: eqed, eqcentre
546 INTEGER :: gaid, editionnumber, centre
547 TYPE(volgrid6d_var) :: tmpgrib
548 TYPE(vol7d_var) :: tmpbufr
549 TYPE(conv_func) tmpc_func1, tmpc_func2
550 
551 eqed = .true.
552 eqcentre = .true.
553 c_func = conv_func_miss
554 
555 #ifdef HAVE_LIBGRIBAPI
556 gaid = grid_id_get_gaid(grid_id_template)
557 IF (c_e(gaid)) THEN
558  CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
559  CALL grib_get(gaid, 'centre', centre)
560  eqed = editionnumber == 1 .EQV. this%discipline == 255
561  eqcentre = centre == this%centre
562 ENDIF
563 #endif
564 
565 IF (eqed .AND. eqcentre) RETURN ! nothing to do
566 
567 tmpbufr = convert(this, tmpc_func1)
568 tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
569 
570 IF (tmpgrib /= volgrid6d_var_miss) THEN
571 ! conversion back and forth successful, set also conversion function
572  this = tmpgrib
573  c_func = tmpc_func1 * tmpc_func2
574 ! set to missing in common case to avoid useless computation
575  IF (c_func == conv_func_identity) c_func = conv_func_miss
576 ELSE IF (.NOT.eqed) THEN
577 ! conversion back and forth unsuccessful and grib edition incompatible, set to miss
578  this = tmpgrib
579 ENDIF
580 
581 END SUBROUTINE volgrid6d_var_normalize
582 
583 
584 ! Private subroutine for reading forward and backward conversion tables
585 ! todo: better error handling
586 SUBROUTINE vg6d_v7d_var_conv_setup()
587 INTEGER :: un, i, n, stallo
588 
589 ! forward, grib to bufr
590 un = open_package_file('vargrib2bufr.csv', filetype_data)
591 n=0
592 DO WHILE(.true.)
593  READ(un,*,end=100)
594  n = n + 1
595 ENDDO
596 
597 100 CONTINUE
598 
599 rewind(un)
600 ALLOCATE(conv_fwd(n),stat=stallo)
601 IF (stallo /= 0) THEN
602  CALL l4f_log(l4f_fatal,"allocating memory")
603  CALL raise_fatal_error()
604 ENDIF
605 
606 conv_fwd(:) = vg6d_v7d_var_conv_miss
607 CALL import_var_conv(un, conv_fwd)
608 CLOSE(un)
609 
610 ! backward, bufr to grib
611 un = open_package_file('vargrib2bufr.csv', filetype_data)
612 ! use the same file for now
613 !un = open_package_file('varbufr2grib.csv', filetype_data)
614 n=0
615 DO WHILE(.true.)
616  READ(un,*,end=300)
617  n = n + 1
618 ENDDO
619 
620 300 CONTINUE
621 
622 rewind(un)
623 ALLOCATE(conv_bwd(n),stat=stallo)
624 IF (stallo /= 0) THEN
625  CALL l4f_log(l4f_fatal,"allocating memory")
626  CALL raise_fatal_error()
627 end if
628 
629 conv_bwd(:) = vg6d_v7d_var_conv_miss
630 CALL import_var_conv(un, conv_bwd)
631 DO i = 1, n
632  conv_bwd(i)%c_func%a = 1./conv_bwd(i)%c_func%a
633  conv_bwd(i)%c_func%b = - conv_bwd(i)%c_func%b
634 ENDDO
635 CLOSE(un)
636 
637 CONTAINS
638 
639 SUBROUTINE import_var_conv(un, conv_type)
640 INTEGER, INTENT(in) :: un
641 TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
642 
643 INTEGER :: i
644 TYPE(csv_record) :: csv
645 CHARACTER(len=1024) :: line
646 CHARACTER(len=10) :: btable
647 INTEGER :: centre, category, number, discipline
648 
649 DO i = 1, SIZE(conv_type)
650  READ(un,'(A)',end=200)line
651  CALL init(csv, line)
652  CALL csv_record_getfield(csv, btable)
653  CALL csv_record_getfield(csv) ! skip fields for description and unit,
654  CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
655  CALL init(conv_type(i)%v7d_var, btable=btable)
656 
657  CALL csv_record_getfield(csv, centre)
658  CALL csv_record_getfield(csv, category)
659  CALL csv_record_getfield(csv, number)
660  CALL csv_record_getfield(csv, discipline)
661  CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
662  number=number, discipline=discipline) ! controllare l'ordine
663 
664  CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
665  CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
666  CALL delete(csv)
667 ENDDO
668 
669 200 CONTINUE
670 
671 END SUBROUTINE import_var_conv
672 
673 END SUBROUTINE vg6d_v7d_var_conv_setup
674 
675 
676 ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
677 TYPE(conv_func),INTENT(IN) :: this, that
678 LOGICAL :: res
679 
680 res = this%a == that%a .AND. this%b == that%b
681 
682 END FUNCTION conv_func_eq
683 
684 
685 ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
686 TYPE(conv_func),INTENT(IN) :: this, that
687 LOGICAL :: res
688 
689 res = .NOT.(this == that)
690 
691 END FUNCTION conv_func_ne
692 
693 
694 FUNCTION conv_func_mult(this, that) RESULT(mult)
695 TYPE(conv_func),INTENT(in) :: this
696 TYPE(conv_func),INTENT(in) :: that
697 
698 TYPE(conv_func) :: mult
699 
700 IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
701  mult = conv_func_miss
702 ELSE
703  mult%a = this%a*that%a
704  mult%b = this%a*that%b+this%b
705 ENDIF
706 
707 END FUNCTION conv_func_mult
708 
716 ELEMENTAL SUBROUTINE conv_func_compute(this, values)
717 TYPE(conv_func),INTENT(in) :: this
718 REAL,INTENT(inout) :: values
719 
720 IF (this /= conv_func_miss) THEN
721  IF (c_e(values)) values = values*this%a + this%b
722 ELSE
723  values=rmiss
724 ENDIF
725 
726 END SUBROUTINE conv_func_compute
727 
728 
742 SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
743 TYPE(volgrid6d_var),INTENT(in) :: this(:)
744 INTEGER,POINTER :: xind(:), yind(:)
745 
746 TYPE(vol7d_var) :: varbufr(size(this))
747 TYPE(conv_func),POINTER :: c_func(:)
748 INTEGER :: i, nv, counts(size(vol7d_var_horcomp))
749 
750 NULLIFY(xind, yind)
751 counts(:) = 0
752 
753 CALL vargrib2varbufr(this, varbufr, c_func)
754 
755 DO i = 1, SIZE(vol7d_var_horcomp)
756  counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
757 ENDDO
758 
759 IF (any(counts(1::2) > 1)) THEN
760  CALL l4f_log(l4f_warn, '> 1 variable refer to x component of the same field, (un)rotation impossible')
761  DEALLOCATE(c_func)
762  RETURN
763 ENDIF
764 IF (any(counts(2::2) > 1)) THEN
765  CALL l4f_log(l4f_warn, '> 1 variable refer to y component of the same field, (un)rotation impossible')
766  DEALLOCATE(c_func)
767  RETURN
768 ENDIF
769 
770 ! check that variables are paired and count pairs
771 nv = 0
772 DO i = 1, SIZE(vol7d_var_horcomp), 2
773  IF (counts(i) == 0 .AND. counts(i+1) > 0) THEN
774  CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i+1)%btable)// &
775  ' present but the corresponding x-component '// &
776  trim(vol7d_var_horcomp(i)%btable)//' is missing, (un)rotation impossible')
777  RETURN
778  ELSE IF (counts(i+1) == 0 .AND. counts(i) > 0) THEN
779  CALL l4f_log(l4f_warn, 'variable '//trim(vol7d_var_horcomp(i)%btable)// &
780  ' present but the corresponding y-component '// &
781  trim(vol7d_var_horcomp(i+1)%btable)//' is missing, (un)rotation impossible')
782  RETURN
783  ENDIF
784  IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
785 ENDDO
786 
787 ! repeat the loop storing indices
788 ALLOCATE(xind(nv), yind(nv))
789 nv = 0
790 DO i = 1, SIZE(vol7d_var_horcomp), 2
791  IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
792  nv = nv + 1
793  xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
794  yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
795  ENDIF
796 ENDDO
797 DEALLOCATE(c_func)
798 
799 END SUBROUTINE volgrid6d_var_hor_comp_index
800 
801 
806 FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
807 TYPE(volgrid6d_var),INTENT(in) :: this
808 LOGICAL :: is_hor_comp
809 
810 TYPE(vol7d_var) :: varbufr
811 
812 varbufr = convert(this)
813 is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
814 
815 END FUNCTION volgrid6d_var_is_hor_comp
816 
817 ! before unstaggering??
818 
819 !IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
820 !
821 !call init(varu,btable="B11003")
822 !call init(varv,btable="B11004")
823 !
824 ! test about presence of u and v in standard table
825 !if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
826 ! call l4f_category_log(this%category,L4F_FATAL, &
827 ! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
828 ! CALL raise_error()
829 ! RETURN
830 !end if
831 !
832 !if (associated(this%var))then
833 ! nvar=size(this%var)
834 ! allocate(varbufr(nvar),stat=stallo)
835 ! if (stallo /=0)then
836 ! call l4f_log(L4F_FATAL,"allocating memory")
837 ! call raise_fatal_error("allocating memory")
838 ! end if
839 !
840 ! CALL vargrib2varbufr(this%var, varbufr)
841 !ELSE
842 ! CALL l4f_category_log(this%category, L4F_ERROR, &
843 ! "trying to destagger an incomplete volgrid6d object")
844 ! CALL raise_error()
845 ! RETURN
846 !end if
847 !
848 !nvaru=COUNT(varbufr==varu)
849 !nvarv=COUNT(varbufr==varv)
850 !
851 !if (nvaru > 1 )then
852 ! call l4f_category_log(this%category,L4F_WARN, &
853 ! ">1 variables refer to u wind component, destaggering will not be done ")
854 ! DEALLOCATE(varbufr)
855 ! RETURN
856 !endif
857 !
858 !if (nvarv > 1 )then
859 ! call l4f_category_log(this%category,L4F_WARN, &
860 ! ">1 variables refer to v wind component, destaggering will not be done ")
861 ! DEALLOCATE(varbufr)
862 ! RETURN
863 !endif
864 !
865 !if (nvaru == 0 .and. nvarv == 0) then
866 ! call l4f_category_log(this%category,L4F_WARN, &
867 ! "no u or v wind component found in volume, nothing to do")
868 ! DEALLOCATE(varbufr)
869 ! RETURN
870 !endif
871 !
872 !if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
873 ! call l4f_category_log(this%category,L4F_WARN, &
874 ! "there are variables different from u and v wind component in C grid")
875 !endif
876 
877 
878 END MODULE volgrid6d_var_class
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.
Index method.
Gestione degli errori.
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.
Definition: kinds.F90:255

Generated with Doxygen.