libsim  Versione6.3.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 
125 INTERFACE OPERATOR (==)
126  MODULE PROCEDURE volgrid6d_var_eq, conv_func_eq
127 END INTERFACE
128 
133 INTERFACE OPERATOR (/=)
134  MODULE PROCEDURE volgrid6d_var_ne, conv_func_ne
135 END INTERFACE
136 
137 #define VOL7D_POLY_TYPE TYPE(volgrid6d_var)
138 #define VOL7D_POLY_TYPES _var6d
139 #include "array_utilities_pre.F90"
140 
142 INTERFACE display
143  MODULE PROCEDURE display_volgrid6d_var
144 END INTERFACE
145 
150 INTERFACE OPERATOR (*)
151  MODULE PROCEDURE conv_func_mult
152 END INTERFACE OPERATOR (*)
153 
156 INTERFACE compute
157  MODULE PROCEDURE conv_func_compute
158 END INTERFACE
159 
162 INTERFACE convert
163  MODULE PROCEDURE varbufr2vargrib_convert, vargrib2varbufr_convert, &
164  conv_func_convert
165 END INTERFACE
166 
167 PRIVATE
168 PUBLIC volgrid6d_var, volgrid6d_var_miss, volgrid6d_var_new, init, delete, &
169  volgrid6d_var_normalize, &
170  OPERATOR(==), OPERATOR(/=), OPERATOR(*), &
171  count_distinct, pack_distinct, count_and_pack_distinct, &
172  map_distinct, map_inv_distinct, &
173  index, display, &
174  vargrib2varbufr, varbufr2vargrib, &
175  conv_func, conv_func_miss, compute, convert, &
176  volgrid6d_var_hor_comp_index, volgrid6d_var_is_hor_comp
177 
178 
179 CONTAINS
180 
181 
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
190 
191 TYPE(volgrid6d_var) :: this
192 
193 CALL init(this, centre, category, number, discipline, description, unit)
194 
195 END FUNCTION volgrid6d_var_new
196 
197 
198 ! documented in the interface
199 ELEMENTAL SUBROUTINE volgrid6d_var_init(this, centre, category, number, discipline,description,unit)
200 TYPE(volgrid6d_var),INTENT(INOUT) :: this ! object to be initialized
201 INTEGER,INTENT(in),OPTIONAL :: centre ! centre
202 INTEGER,INTENT(in),OPTIONAL :: category ! grib2: category / grib1: grib table version number
203 INTEGER,INTENT(in),OPTIONAL :: number ! parameter number
204 INTEGER,INTENT(in),OPTIONAL :: discipline ! grib2: discipline / grib1: 255
205 CHARACTER(len=*),INTENT(in),OPTIONAL :: description ! optional textual description of the variable
206 CHARACTER(len=*),INTENT(in),OPTIONAL :: unit ! optional textual description of the variable's unit
207 
208 IF (PRESENT(centre)) THEN
209  this%centre = centre
210 ELSE
211  this%centre = imiss
212  this%category = imiss
213  this%number = imiss
214  this%discipline = imiss
215  RETURN
216 ENDIF
217 
218 IF (PRESENT(category)) THEN
219  this%category = category
220 ELSE
221  this%category = imiss
222  this%number = imiss
223  this%discipline = imiss
224  RETURN
225 ENDIF
226 
227 
228 IF (PRESENT(number)) THEN
229  this%number = number
230 ELSE
231  this%number = imiss
232  this%discipline = imiss
233  RETURN
234 ENDIF
235 
236 ! se sono arrivato fino a qui ho impostato centre, category e number
237 !per il grib 1 manca discipline e imposto 255 (missing del grib2)
238 
239 IF (PRESENT(discipline)) THEN
240  this%discipline = discipline
241 ELSE
242  this%discipline = 255
243 ENDIF
244 
245 IF (PRESENT(description)) THEN
246  this%description = description
247 ELSE
248  this%description = cmiss
249 ENDIF
250 
251 IF (PRESENT(unit)) THEN
252  this%unit = unit
253 ELSE
254  this%unit = cmiss
255 ENDIF
256 
259 END SUBROUTINE volgrid6d_var_init
262 ! documented in the interface
263 SUBROUTINE volgrid6d_var_delete(this)
264 TYPE(volgrid6d_var),INTENT(INOUT) :: this
265 
266 this%centre = imiss
267 this%category = imiss
268 this%number = imiss
269 this%discipline = imiss
270 this%description = cmiss
271 this%unit = cmiss
272 
273 END SUBROUTINE volgrid6d_var_delete
274 
275 
276 ELEMENTAL FUNCTION volgrid6d_var_eq(this, that) RESULT(res)
277 TYPE(volgrid6d_var),INTENT(IN) :: this, that
278 LOGICAL :: res
279 
280 IF (this%discipline == that%discipline) THEN
281 
282  IF (this%discipline == 255) THEN ! grib1
283  res = this%category == that%category .AND. &
284  this%number == that%number
285 
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 ! local definition, centre matters
289  ENDIF
291  ELSE ! grib2
292  res = this%category == that%category .AND. &
293  this%number == that%number
294 
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 ! local definition, centre matters
299  ENDIF
300  ENDIF
301 
302 ELSE ! different edition or different discipline
303  res = .false.
304 ENDIF
305 
306 END FUNCTION volgrid6d_var_eq
307 
308 
309 ELEMENTAL FUNCTION volgrid6d_var_ne(this, that) RESULT(res)
310 TYPE(volgrid6d_var),INTENT(IN) :: this, that
311 LOGICAL :: res
312 
313 res = .NOT.(this == that)
314 
315 END FUNCTION volgrid6d_var_ne
316 
317 
318 #include "array_utilities_inc.F90"
319 
320 
322 SUBROUTINE display_volgrid6d_var(this)
323 TYPE(volgrid6d_var),INTENT(in) :: this
324 
325 print*,"GRIDVAR: ",this%centre,this%discipline,this%category,this%number
326 
327 END SUBROUTINE display_volgrid6d_var
328 
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
348 
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()
354 ENDIF
355 
356 DO i = 1, n
357  varbufr(i) = convert(vargrib(i), c_func(i))
358 ENDDO
359 
360 END SUBROUTINE vargrib2varbufr
361 
362 
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
377 
378 INTEGER :: i
379 
380 IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
381 
382 DO i = 1, SIZE(conv_fwd)
383  IF (vargrib == conv_fwd(i)%vg6d_var) THEN
384  convert = conv_fwd(i)%v7d_var
385  IF (PRESENT(c_func)) c_func = conv_fwd(i)%c_func
386  RETURN
387  ENDIF
388 ENDDO
389 ! not found
390 convert = vol7d_var_miss
391 IF (PRESENT(c_func)) c_func = conv_func_miss
392 
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
399 
400 
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
421 
422 INTEGER :: i, n, stallo
423 
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()
429 ENDIF
430 
431 DO i = 1, n
432  vargrib(i) = convert(varbufr(i), c_func(i), grid_id_template)
433 ENDDO
434 
435 END SUBROUTINE varbufr2vargrib
436 
437 
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
456 
457 INTEGER :: i
458 #ifdef HAVE_LIBGRIBAPI
459 INTEGER :: gaid, editionnumber, category, centre
460 #endif
461 
462 IF (.NOT. ALLOCATED(conv_bwd)) CALL vg6d_v7d_var_conv_setup()
463 
464 #ifdef HAVE_LIBGRIBAPI
465 editionnumber=255; category=255; centre=255
466 #endif
467 IF (PRESENT(grid_id_template)) THEN
468 #ifdef HAVE_LIBGRIBAPI
469  gaid = grid_id_get_gaid(grid_id_template)
470  IF (c_e(gaid)) THEN
471  CALL grib_get(gaid, 'GRIBEditionNumber', editionnumber)
472  IF (editionnumber == 1) THEN
473  CALL grib_get(gaid,'gribTablesVersionNo',category)
474  ENDIF
475  CALL grib_get(gaid,'centre',centre)
476  ENDIF
477 #endif
478 ENDIF
479 
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 ! further check required (gaid present)
484  IF (editionnumber == 1) THEN
485  IF (conv_bwd(i)%vg6d_var%discipline /= 255) cycle ! wrong edition
486  ELSE IF (editionnumber == 2) THEN
487  IF (conv_bwd(i)%vg6d_var%discipline == 255) cycle ! wrong edition
488  ENDIF
489  IF (conv_bwd(i)%vg6d_var%centre /= 255 .AND. &
490  conv_bwd(i)%vg6d_var%centre /= centre) cycle ! wrong centre
491  ENDIF
492 #endif
493  convert = conv_bwd(i)%vg6d_var
494  IF (PRESENT(c_func)) c_func = conv_bwd(i)%c_func
495  RETURN
496  ENDIF
497 ENDDO
498 ! not found
499 convert = volgrid6d_var_miss
500 IF (PRESENT(c_func)) c_func = conv_func_miss
501 
502 CALL l4f_log(l4f_warn, 'varbufr2vargrib: variable '// &
503  trim(varbufr%btable)//" : "//trim(varbufr%description)//" : "//trim(varbufr%unit)// &
504  ' not found in table')
505 
506 END FUNCTION varbufr2vargrib_convert
507 
508 
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
520 
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
526 
527 eqed = .true.
528 eqcentre = .true.
529 c_func = conv_func_miss
530 
531 #ifdef HAVE_LIBGRIBAPI
532 gaid = grid_id_get_gaid(grid_id_template)
533 IF (c_e(gaid)) THEN
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
538 ENDIF
539 #endif
540 
541 IF (eqed .AND. eqcentre) RETURN ! nothing to do
542 
543 tmpbufr = convert(this, tmpc_func1)
544 tmpgrib = convert(tmpbufr, tmpc_func2, grid_id_template)
545 
546 IF (tmpgrib /= volgrid6d_var_miss) THEN
547 ! conversion back and forth successful, set also conversion function
548  this = tmpgrib
549  c_func = tmpc_func1 * tmpc_func2
550 ! set to missing in common case to avoid useless computation
551  IF (c_func == conv_func_identity) c_func = conv_func_miss
552 ELSE IF (.NOT.eqed) THEN
553 ! conversion back and forth unsuccessful and grib edition incompatible, set to miss
554  this = tmpgrib
555 ENDIF
556 
557 END SUBROUTINE volgrid6d_var_normalize
558 
559 
560 ! Private subroutine for reading forward and backward conversion tables
561 ! todo: better error handling
562 SUBROUTINE vg6d_v7d_var_conv_setup()
563 INTEGER :: un, i, n, stallo
564 
565 ! forward, grib to bufr
566 un = open_package_file('vargrib2bufr.csv', filetype_data)
567 n=0
568 DO WHILE(.true.)
569  READ(un,*,end=100)
570  n = n + 1
571 ENDDO
572 
573 100 CONTINUE
574 
575 rewind(un)
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()
580 ENDIF
581 
582 conv_fwd(:) = vg6d_v7d_var_conv_miss
583 CALL import_var_conv(un, conv_fwd)
584 CLOSE(un)
585 
586 ! backward, bufr to grib
587 un = open_package_file('vargrib2bufr.csv', filetype_data)
588 ! use the same file for now
589 !un = open_package_file('varbufr2grib.csv', filetype_data)
590 n=0
591 DO WHILE(.true.)
592  READ(un,*,end=300)
593  n = n + 1
594 ENDDO
595 
596 300 CONTINUE
597 
598 rewind(un)
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()
603 end if
604 
605 conv_bwd(:) = vg6d_v7d_var_conv_miss
606 CALL import_var_conv(un, conv_bwd)
607 DO i = 1, n
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
610 ENDDO
611 CLOSE(un)
612 
613 CONTAINS
614 
615 SUBROUTINE import_var_conv(un, conv_type)
616 INTEGER, INTENT(in) :: un
617 TYPE(vg6d_v7d_var_conv), INTENT(out) :: conv_type(:)
618 
619 INTEGER :: i
620 TYPE(csv_record) :: csv
621 CHARACTER(len=1024) :: line
622 CHARACTER(len=10) :: btable
623 INTEGER :: centre, category, number, discipline
624 
625 DO i = 1, SIZE(conv_type)
626  READ(un,'(A)',end=200)line
627  CALL init(csv, line)
628  CALL csv_record_getfield(csv, btable)
629  CALL csv_record_getfield(csv) ! skip fields for description and unit,
630  CALL csv_record_getfield(csv) ! they correspond to grib information, not bufr Btable
631  CALL init(conv_type(i)%v7d_var, btable=btable)
632 
633  CALL csv_record_getfield(csv, centre)
634  CALL csv_record_getfield(csv, category)
635  CALL csv_record_getfield(csv, number)
636  CALL csv_record_getfield(csv, discipline)
637  CALL init(conv_type(i)%vg6d_var, centre=centre, category=category, &
638  number=number, discipline=discipline) ! controllare l'ordine
639 
640  CALL csv_record_getfield(csv, conv_type(i)%c_func%a)
641  CALL csv_record_getfield(csv, conv_type(i)%c_func%b)
642  CALL delete(csv)
643 ENDDO
644 
645 200 CONTINUE
646 
647 END SUBROUTINE import_var_conv
648 
649 END SUBROUTINE vg6d_v7d_var_conv_setup
650 
651 
652 ELEMENTAL FUNCTION conv_func_eq(this, that) RESULT(res)
653 TYPE(conv_func),INTENT(IN) :: this, that
654 LOGICAL :: res
655 
656 res = this%a == that%a .AND. this%b == that%b
657 
658 END FUNCTION conv_func_eq
659 
660 
661 ELEMENTAL FUNCTION conv_func_ne(this, that) RESULT(res)
662 TYPE(conv_func),INTENT(IN) :: this, that
663 LOGICAL :: res
664 
665 res = .NOT.(this == that)
666 
667 END FUNCTION conv_func_ne
668 
669 
670 FUNCTION conv_func_mult(this, that) RESULT(mult)
671 TYPE(conv_func),INTENT(in) :: this
672 TYPE(conv_func),INTENT(in) :: that
673 
674 TYPE(conv_func) :: mult
675 
676 IF (this == conv_func_miss .OR. that == conv_func_miss) THEN
677  mult = conv_func_miss
678 ELSE
679  mult%a = this%a*that%a
680  mult%b = this%a*that%b+this%b
681 ENDIF
682 
683 END FUNCTION conv_func_mult
684 
692 ELEMENTAL SUBROUTINE conv_func_compute(this, values)
693 TYPE(conv_func),INTENT(in) :: this
694 REAL,INTENT(inout) :: values
695 
696 IF (this /= conv_func_miss) THEN
697  IF (c_e(values)) values = values*this%a + this%b
698 ELSE
699  values=rmiss
700 ENDIF
701 
702 END SUBROUTINE conv_func_compute
703 
704 
712 ELEMENTAL FUNCTION conv_func_convert(this, values) RESULT(convert)
713 TYPE(conv_func),intent(in) :: this
714 REAL,INTENT(in) :: values
715 REAL :: convert
716 
717 convert = values
718 CALL compute(this, convert)
719 
720 END FUNCTION conv_func_convert
721 
722 
736 SUBROUTINE volgrid6d_var_hor_comp_index(this, xind, yind)
737 TYPE(volgrid6d_var),INTENT(in) :: this(:)
738 INTEGER,POINTER :: xind(:), yind(:)
739 
740 TYPE(vol7d_var) :: varbufr(size(this))
741 TYPE(conv_func),POINTER :: c_func(:)
742 INTEGER :: i, nv, counts(size(vol7d_var_horcomp))
743 
744 NULLIFY(xind, yind)
745 counts(:) = 0
746 
747 CALL vargrib2varbufr(this, varbufr, c_func)
748 
749 DO i = 1, SIZE(vol7d_var_horcomp)
750  counts(i) = count(varbufr(:) == vol7d_var_horcomp(i))
751 ENDDO
752 
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')
755  DEALLOCATE(c_func)
756  RETURN
757 ENDIF
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')
760  DEALLOCATE(c_func)
761  RETURN
762 ENDIF
763 
764 ! check that variables are paired and count pairs
765 nv = 0
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')
771  RETURN
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')
776  RETURN
777  ENDIF
778  IF (counts(i) == 1 .AND. counts(i+1) == 1) nv = nv + 1
779 ENDDO
780 
781 ! repeat the loop storing indices
782 ALLOCATE(xind(nv), yind(nv))
783 nv = 0
784 DO i = 1, SIZE(vol7d_var_horcomp), 2
785  IF (counts(i) == 1 .AND. counts(i+1) == 1) THEN
786  nv = nv + 1
787  xind(nv) = index(varbufr(:), vol7d_var_horcomp(i))
788  yind(nv) = index(varbufr(:), vol7d_var_horcomp(i+1))
789  ENDIF
790 ENDDO
791 DEALLOCATE(c_func)
792 
793 END SUBROUTINE volgrid6d_var_hor_comp_index
794 
795 
800 FUNCTION volgrid6d_var_is_hor_comp(this) RESULT(is_hor_comp)
801 TYPE(volgrid6d_var),INTENT(in) :: this
802 LOGICAL :: is_hor_comp
803 
804 TYPE(vol7d_var) :: varbufr
805 
806 varbufr = convert(this)
807 is_hor_comp = any(varbufr == vol7d_var_horcomp(:))
808 
809 END FUNCTION volgrid6d_var_is_hor_comp
810 
811 ! before unstaggering??
812 
813 !IF (.NOT. ALLOCATED(conv_fwd)) CALL vg6d_v7d_var_conv_setup()
814 !
815 !call init(varu,btable="B11003")
816 !call init(varv,btable="B11004")
817 !
818 ! test about presence of u and v in standard table
819 !if ( index(conv_fwd(:)%v7d_var,varu) == 0 .or. index(conv_fwd(:)%v7d_var,varv) == 0 )then
820 ! call l4f_category_log(this%category,L4F_FATAL, &
821 ! "variables B11003 and/or B11004 (wind components) not defined by vg6d_v7d_var_conv_setup")
822 ! CALL raise_error()
823 ! RETURN
824 !end if
825 !
826 !if (associated(this%var))then
827 ! nvar=size(this%var)
828 ! allocate(varbufr(nvar),stat=stallo)
829 ! if (stallo /=0)then
830 ! call l4f_log(L4F_FATAL,"allocating memory")
831 ! call raise_fatal_error("allocating memory")
832 ! end if
833 !
834 ! CALL vargrib2varbufr(this%var, varbufr)
835 !ELSE
836 ! CALL l4f_category_log(this%category, L4F_ERROR, &
837 ! "trying to destagger an incomplete volgrid6d object")
838 ! CALL raise_error()
839 ! RETURN
840 !end if
841 !
842 !nvaru=COUNT(varbufr==varu)
843 !nvarv=COUNT(varbufr==varv)
844 !
845 !if (nvaru > 1 )then
846 ! call l4f_category_log(this%category,L4F_WARN, &
847 ! ">1 variables refer to u wind component, destaggering will not be done ")
848 ! DEALLOCATE(varbufr)
849 ! RETURN
850 !endif
851 !
852 !if (nvarv > 1 )then
853 ! call l4f_category_log(this%category,L4F_WARN, &
854 ! ">1 variables refer to v wind component, destaggering will not be done ")
855 ! DEALLOCATE(varbufr)
856 ! RETURN
857 !endif
858 !
859 !if (nvaru == 0 .and. nvarv == 0) then
860 ! call l4f_category_log(this%category,L4F_WARN, &
861 ! "no u or v wind component found in volume, nothing to do")
862 ! DEALLOCATE(varbufr)
863 ! RETURN
864 !endif
865 !
866 !if (COUNT(varbufr/=varu .and. varbufr/=varv) > 0) then
867 ! call l4f_category_log(this%category,L4F_WARN, &
868 ! "there are variables different from u and v wind component in C grid")
869 !endif
870 
871 
872 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:270

Generated with Doxygen.