61 #ifdef HAVE_LIBGRIBAPI
74 character (len=255),
parameter:: subcategory=
"gridinfo_class"
79 TYPE(griddim_def) :: griddim
80 TYPE(datetime) :: time
81 TYPE(vol7d_timerange) :: timerange
82 TYPE(vol7d_level) :: level
83 TYPE(volgrid6d_var) :: var
85 INTEGER :: category = 0
88 INTEGER,
PARAMETER :: &
89 cosmo_centre(3) = (/78,80,200/), &
90 ecmwf_centre(1) = (/98/)
94 MODULE PROCEDURE gridinfo_init
99 MODULE PROCEDURE gridinfo_delete
105 MODULE PROCEDURE gridinfo_clone
111 MODULE PROCEDURE gridinfo_import, gridinfo_import_from_file
118 MODULE PROCEDURE gridinfo_export, gridinfo_export_to_file
126 MODULE PROCEDURE gridinfo_display, gridinfov_display
132 MODULE PROCEDURE gridinfo_decode_data
137 MODULE PROCEDURE gridinfo_encode_data
140 #define ARRAYOF_ORIGTYPE TYPE(gridinfo_def)
141 #define ARRAYOF_TYPE arrayof_gridinfo
142 #define ARRAYOF_ORIGDESTRUCTOR(x) CALL delete(x)
143 #include "arrayof_pre.F90"
153 #include "arrayof_post.F90"
158 SUBROUTINE gridinfo_init(this, gaid, griddim, time, timerange, level, var, &
159 clone, categoryappend)
160 TYPE(gridinfo_def),
intent(out) :: this
161 TYPE(grid_id),
intent(in),
optional :: gaid
162 type(griddim_def),
intent(in),
optional :: griddim
163 TYPE(datetime),
intent(in),
optional :: time
164 TYPE(vol7d_timerange),
intent(in),
optional :: timerange
165 TYPE(vol7d_level),
intent(in),
optional :: level
166 TYPE(volgrid6d_var),
intent(in),
optional :: var
167 logical ,
intent(in),
optional :: clone
168 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
170 character(len=512) :: a_name
172 if (
present(categoryappend))
then
173 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
175 call l4f_launcher(a_name,a_name_append=trim(subcategory))
177 this%category=l4f_category_get(a_name)
183 if (
present(gaid))
then
184 if (optio_log(
clone))
then
185 CALL copy(gaid,this%gaid)
190 this%gaid = grid_id_new()
198 if (
present(griddim))
then
199 call copy(griddim,this%griddim)
201 call init(this%griddim,categoryappend=categoryappend)
204 if (
present(time))
then
210 if (
present(timerange))
then
211 this%timerange=timerange
213 call init(this%timerange)
216 if (
present(level))
then
219 call init(this%level)
222 if (
present(var))
then
228 END SUBROUTINE gridinfo_init
233 SUBROUTINE gridinfo_delete(this)
234 TYPE(gridinfo_def),
intent(inout) :: this
242 call delete(this%timerange)
252 call l4f_category_delete(this%category)
254 END SUBROUTINE gridinfo_delete
263 SUBROUTINE gridinfo_display(this, namespace)
264 TYPE(gridinfo_def),
intent(in) :: this
265 CHARACTER (len=*),
OPTIONAL :: namespace
271 print*,
"----------------------- gridinfo display ---------------------"
278 print*,
"--------------------------------------------------------------"
280 END SUBROUTINE gridinfo_display
284 SUBROUTINE gridinfov_display(this, namespace)
286 CHARACTER (len=*),
OPTIONAL :: namespace
290 print*,
"----------------------- gridinfo array -----------------------"
292 DO i = 1, this%arraysize
296 "displaying gridinfo array, element "//
t2c(i))
298 CALL display(this%array(i), namespace)
301 print*,
"--------------------------------------------------------------"
303 END SUBROUTINE gridinfov_display
308 SUBROUTINE gridinfo_clone(this, that, categoryappend)
309 TYPE(gridinfo_def),
INTENT(in) :: this
310 TYPE(gridinfo_def),
INTENT(out) :: that
311 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
313 CALL init(that, gaid=this%gaid, griddim=this%griddim, time=this%time, &
314 timerange=this%timerange, level=this%level, var=this%var,
clone=.true., &
315 categoryappend=categoryappend)
317 END SUBROUTINE gridinfo_clone
327 SUBROUTINE gridinfo_import(this)
328 TYPE(gridinfo_def),
INTENT(inout) :: this
330 #ifdef HAVE_LIBGRIBAPI
334 TYPE(gdalrasterbandh) :: gdalid
341 ! griddim is imported separately in grid_class
342 CALL import(this%griddim, this%gaid)
344 #ifdef HAVE_LIBGRIBAPI
345 gaid = grid_id_get_gaid(this%gaid)
346 IF (c_e(gaid)) CALL gridinfo_import_gribapi(this, gaid)
349 gdalid = grid_id_get_gdalid(this%gaid)
350 IF (gdalassociated(gdalid)) CALL gridinfo_import_gdal(this, gdalid)
353 importEND SUBROUTINE gridinfo_
356 Import an array of gridinfo from a file. it receives a (possibly unallocated)
!>
357 !! array of gridinfo objects which will be extended by a number of
358 !! elements equal to the number of gridded messages/bands found in the
359 !! file provided and it will be filled with all the data found. In
360 !! case of error, the gridinfo object will not be allocated, so the
361 !! success can be tested by checking \a this%arraysize.
362 SUBROUTINE gridinfo_import_from_file(this, filename, categoryappend)
363 TYPE(arrayof_gridinfo) :: this !< array of gridinfo objects which will be allocated/extended and into which data will be imported
364 CHARACTER(len=*),INTENT(in) :: filename !< name of file to open and import, in the form [driver:]pathname
365 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
367 type(gridinfo_def) :: gridinfol
368 INTEGER :: ngrid, category
369 CHARACTER(len=512) :: a_name
370 TYPE(grid_file_id) :: input_file
371 TYPE(grid_id) :: input_grid
373 IF (PRESENT(categoryappend)) THEN
374 CALL l4f_launcher(a_name,a_name_append= &
375 TRIM(subcategory)//".
"//TRIM(categoryappend))
377 CALL l4f_launcher(a_name,a_name_append=TRIM(subcategory))
379 category=l4f_category_get(a_name)
382 CALL l4f_category_log(category,L4F_DEBUG,"import from file
")
385 input_file = grid_file_id_new(filename, 'r')
389 input_grid = grid_id_new(input_file)
390 .NOT.
IF ( c_e(input_grid)) EXIT
392 CALL l4f_category_log(category,L4F_INFO,"import gridinfo
")
394 IF (PRESENT(categoryappend)) THEN
395 CALL init(gridinfol, gaid=input_grid, &
396 categoryappend=TRIM(categoryappend)//"-msg
"//TRIM(to_char(ngrid)))
398 CALL init(gridinfol, gaid=input_grid, &
399 categoryappend="msg
"//TRIM(to_char(ngrid)))
401 CALL import(gridinfol)
402 CALL insert(this, gridinfol)
403 ! gridinfol is intentionally not destroyed, since now it lives into this
408 CALL l4f_category_log(category,L4F_INFO, &
409 "gridinfo_import,
"//t2c(ngrid)//" messages/bands imported from file
"// &
413 CALL delete(input_file)
415 CALL l4f_category_delete(category)
417 END SUBROUTINE gridinfo_import_from_file
420 !> Export gridinfo descriptors information into a message/band on file.
421 !! This method exports the contents of the descriptors of the gridinfo
422 !! object \a this in the grid_id object \a this%gaid, previously set,
423 !! for the successive write to a file. The information stored in the
424 !! descriptors of gridinfo object \a this is inserted, when possible,
425 !! in the grid_id object.
426 SUBROUTINE gridinfo_export(this)
427 TYPE(gridinfo_def),INTENT(inout) :: this !< gridinfo object
429 #ifdef HAVE_LIBGRIBAPI
433 !TYPE(gdalrasterbandh) :: gdalid
437 call l4f_category_log(this%category,L4F_DEBUG,"export to gaid
" )
440 ! griddim is exported separately in grid_class
441 CALL export(this%griddim, this%gaid)
443 #ifdef HAVE_LIBGRIBAPI
444 IF (grid_id_get_driver(this%gaid) == 'grib_api') THEN
445 gaid = grid_id_get_gaid(this%gaid)
446 IF (c_e(gaid)) CALL gridinfo_export_gribapi(this, gaid)
450 IF (grid_id_get_driver(this%gaid) == 'gdal') THEN
451 !gdalid = grid_id_get_gdalid(this%gaid)
452 CALL l4f_category_log(this%category,L4F_WARN,"export to gdal not implemented
" )
456 END SUBROUTINE gridinfo_export
459 !> Export an arrayof_gridinfo object to a file.
460 !! It receives an \a arrayof_gridinfo object which will be exported to
461 !! the given file. The driver for writing to file is chosen according
462 !! to the gaid associated to the first gridinfo element, and it must
463 !! be the same for all the elements.
464 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
465 TYPE(arrayof_gridinfo) :: this !< array of gridinfo objects which will be written to file
466 CHARACTER(len=*),INTENT(in) :: filename !< name of file to open and import, in the form [driver:]pathname
467 CHARACTER(len=*),INTENT(in),OPTIONAL :: categoryappend !< append this suffix to log4fortran namespace category
469 INTEGER :: i, category
470 CHARACTER(len=512) :: a_name
471 TYPE(grid_file_id) :: output_file
472 TYPE(grid_id) :: valid_grid_id
474 IF (PRESENT(categoryappend)) THEN
475 CALL l4f_launcher(a_name,a_name_append= &
476 TRIM(subcategory)//".
"//TRIM(categoryappend))
478 CALL l4f_launcher(a_name,a_name_append=TRIM(subcategory))
480 category=l4f_category_get(a_name)
483 CALL l4f_category_log(category,L4F_DEBUG, &
484 "exporting to file
"//TRIM(filename)//" "//t2c(this%arraysize)//" fields
")
487 valid_grid_id = grid_id_new()
488 DO i = 1, this%arraysize ! find a valid grid_id in this
489 IF (c_e(this%array(i)%gaid)) THEN
490 valid_grid_id = this%array(i)%gaid
495 IF (c_e(valid_grid_id)) THEN ! a valid grid_id has been found
497 output_file = grid_file_id_new(filename, 'w', from_grid_id=valid_grid_id)
498 IF (c_e(output_file)) THEN
499 DO i = 1, this%arraysize
500 CALL export(this%array(i)) ! export information to gaid
501 CALL export(this%array(i)%gaid, output_file) ! export gaid to file
504 CALL delete(output_file)
506 CALL l4f_category_log(category,L4F_ERROR,"opening file
"//TRIM(filename))
509 ELSE ! no valid grid_id has been found
510 CALL l4f_category_log(category,L4F_ERROR, &
511 "gridinfo object of size
"//t2c(this%arraysize))
512 CALL l4f_category_log(category,L4F_ERROR, &
513 "no valid grid id found when exporting to file
"//TRIM(filename))
518 CALL l4f_category_delete(category)
520 END SUBROUTINE gridinfo_export_to_file
523 !> Decode and return the data array from a grid_id object associated
524 !! to a gridinfo object. This method returns a 2-d array of proper
525 !! size extracted from the grid_id object associated to a gridinfo
526 !! object. This can work if the gridinfo object has been correctly
527 !! initialised and associated to a grid from an on-disk dataset
528 !! (e.g. grib_api or gdal file). The result is an array of size \a
529 !! this%griddim%dim%nx X \a this%griddim%dim%ny so it must have been
530 !! properly allocated by the caller.
531 FUNCTION gridinfo_decode_data(this) RESULT(field)
532 TYPE(gridinfo_def),INTENT(in) :: this !< gridinfo object
533 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny) ! array of decoded values
535 CALL grid_id_decode_data(this%gaid, field)
537 END FUNCTION gridinfo_decode_data
540 !> Encode a data array into a grid_id object associated to a gridinfo object.
541 !! This method encodes a 2-d array of proper size into the grid_id
542 !! object associated to a gridinfo object. This can work if the
543 !! gridinfo object has been correctly initialised and associated to a
544 !! grid_id from an on-disk (template) dataset (grib_api or gdal
545 !! file). The shape of the array must be conformal to the size of the
546 !! grid previously set in the gridinfo object descriptors.
547 SUBROUTINE gridinfo_encode_data(this, field)
548 TYPE(gridinfo_def),INTENT(inout) :: this !< gridinfo object
549 REAL,intent(in) :: field(:,:) !< data array to be encoded
551 IF (SIZE(field,1) /= this%griddim%dim%nx &
552 .OR.
SIZE(field,2) /= this%griddim%dim%ny) THEN
553 CALL l4f_category_log(this%category,L4F_ERROR, &
554 'gridinfo_encode: field and gridinfo object non conformal, field: ' &
555 //TRIM(to_char(SIZE(field,1)))//'X'//TRIM(to_char(SIZE(field,2)))//', nx,ny:' &
556 //TRIM(to_char(this%griddim%dim%nx))//'X'//TRIM(to_char(this%griddim%dim%ny)))
561 CALL grid_id_encode_data(this%gaid, field)
563 END SUBROUTINE gridinfo_encode_data
566 ! =========================================
567 ! grib_api driver specific code
568 ! could this be moved to a separate module?
569 ! =========================================
570 #ifdef HAVE_LIBGRIBAPI
571 SUBROUTINE gridinfo_import_gribapi(this, gaid)
572 TYPE(gridinfo_def),INTENT(inout) :: this ! gridinfo object
573 importINTEGER, INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to
575 call time_import_gribapi(this%time, gaid)
576 call timerange_import_gribapi(this%timerange,gaid)
577 call level_import_gribapi(this%level, gaid)
578 call var_import_gribapi(this%var, gaid)
580 call normalize_gridinfo(this)
582 END SUBROUTINE gridinfo_import_gribapi
586 SUBROUTINE gridinfo_export_gribapi(this, gaid)
587 TYPE(gridinfo_def),INTENT(inout) :: this ! gridinfo object
588 INTEGER, INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to export
590 TYPE(conv_func) :: c_func
591 REAL,ALLOCATABLE :: tmparr(:,:)
593 ! convert variable and values to the correct edition if required
594 CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
595 IF (this%var == volgrid6d_var_miss) THEN
596 CALL l4f_log(L4F_ERROR, &
597 'A suitable variable has not been found in table when converting template')
600 IF (c_func /= conv_func_miss) THEN ! convert values as well
601 tmparr = decode_gridinfo(this) ! f2003 implicit allocation
602 CALL compute(c_func, tmparr)
603 CALL encode_gridinfo(this, tmparr)
606 CALL unnormalize_gridinfo(this)
608 CALL time_export_gribapi(this%time, gaid, this%timerange)
609 CALL timerange_export_gribapi(this%timerange, gaid, this%time)
610 CALL level_export_gribapi(this%level, gaid)
611 CALL var_export_gribapi(this%var, gaid)
613 END SUBROUTINE gridinfo_export_gribapi
616 SUBROUTINE time_import_gribapi(this,gaid)
617 TYPE(datetime),INTENT(out) :: this ! datetime object
618 import INTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to
620 INTEGER :: EditionNumber, ttimeincr, tprocdata, centre, p2g, p2, unit, status
621 CHARACTER(len=9) :: date
622 CHARACTER(len=10) :: time
624 CALL grib_get(gaid,'GRIBEditionNumber',EditionNumber)
626 .OR.
IF (EditionNumber == 1 EditionNumber == 2) THEN
628 CALL grib_get(gaid,'dataDate',date )
629 CALL grib_get(gaid,'dataTime',time(:5) )
631 CALL init(this,simpledate=date(:8)//time(:4))
633 IF (EditionNumber == 2) THEN
635 CALL grib_get(gaid,'typeOfProcessedData',tprocdata,status)
636 CALL grib_get(gaid,'typeOfTimeIncrement',ttimeincr,status)
637 IF (ttimeincr == 255) ttimeincr = 2 ! fix some MeteosWiss data
638 ! if analysis-like statistically processed data is encountered, the
639 ! reference time must be shifted to the end of the processing period
640 .AND.
IF (status == GRIB_SUCCESS ttimeincr == 1) THEN
641 ! old libsim convention, to be removed sometime in the future
642 CALL grib_get(gaid,'lengthOfTimeRange',p2g)
643 CALL grib_get(gaid,'indicatorOfUnitForTimeRange',unit)
644 CALL g2_interval_to_second(unit, p2g, p2)
645 this = this + timedelta_new(sec=p2)
646 .AND..AND.
ELSE IF (status == GRIB_SUCCESS ttimeincr == 2 tprocdata == 0) THEN
647 ! generally accepted grib2 convention, DWD exception for cosmo
648 ! "accumulated
" analysis is such that reftime points to the end of the
649 ! interval, so no time shift in that case
650 CALL grib_get(gaid,'lengthOfTimeRange',p2g)
651 CALL grib_get(gaid,'indicatorOfUnitForTimeRange',unit)
652 CALL g2_interval_to_second(unit, p2g, p2)
653 CALL grib_get(gaid,'centre',centre)
654 IF (centre /= 78) THEN
655 this = this + timedelta_new(sec=p2)
657 .AND..OR.
ELSE IF ((status == GRIB_SUCCESS ttimeincr == 2) &
658 status /= GRIB_SUCCESS) THEN ! usual case
660 ELSE ! valid but unsupported typeOfTimeIncrement
661 CALL l4f_log(L4F_ERROR,'typeOfTimeIncrement '//t2c(ttimeincr)// &
668 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
673 END SUBROUTINE time_import_gribapi
676 SUBROUTINE time_export_gribapi(this, gaid, timerange)
677 TYPE(datetime),INTENT(in) :: this ! datetime object
678 INTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to export
679 TYPE(vol7d_timerange) :: timerange ! timerange, used for grib2 coding of statistically processed analysed data
681 INTEGER :: EditionNumber, centre
682 CHARACTER(len=8) :: env_var
683 LOGICAL :: g2cosmo_behavior
685 CALL grib_get(gaid,'GRIBEditionNumber',EditionNumber)
687 IF (EditionNumber == 1) THEN
689 CALL code_referencetime(this)
691 ELSE IF (EditionNumber == 2 )THEN
693 IF (timerange%p1 >= timerange%p2) THEN ! forecast-like
694 CALL code_referencetime(this)
695 ELSE IF (timerange%p1 == 0) THEN ! analysis-like
696 ! ready for coding with general convention
697 CALL getenv('LIBSIM_G2COSMO_BEHAVIOR', env_var)
698 g2cosmo_behavior = LEN_TRIM(env_var) > 0
699 CALL grib_get(gaid,'centre',centre)
700 .AND.
IF (g2cosmo_behavior centre == 78) THEN ! DWD analysis exception
701 CALL code_referencetime(this)
702 ELSE ! cosmo or old simc convention
703 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
706 CALL l4f_log( L4F_ERROR, 'Timerange with 0>p1>p2 cannot be exported in grib2')
712 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
719 SUBROUTINE code_referencetime(reftime)
720 TYPE(datetime),INTENT(in) :: reftime
723 CHARACTER(len=17) :: date_time
725 ! datetime is AAAAMMGGhhmmssmsc
726 CALL getval(reftime, simpledate=date_time)
727 READ(date_time(:8),'(I8)')date
728 READ(date_time(9:12),'(I4)')time
729 CALL grib_set(gaid,'dataDate',date)
730 CALL grib_set(gaid,'dataTime',time)
732 END SUBROUTINE code_referencetime
734 END SUBROUTINE time_export_gribapi
737 SUBROUTINE level_import_gribapi(this, gaid)
738 TYPE(vol7d_level),INTENT(out) :: this ! vol7d_level object
739 importINTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to
741 INTEGER :: EditionNumber,level1,l1,level2,l2
742 INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
744 call grib_get(gaid,'GRIBEditionNumber',EditionNumber)
746 if (EditionNumber == 1)then
748 call grib_get(gaid,'indicatorOfTypeOfLevel',ltype)
749 call grib_get(gaid,'topLevel',l1)
750 call grib_get(gaid,'bottomLevel',l2)
752 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
754 else if (EditionNumber == 2)then
756 call grib_get(gaid,'typeOfFirstFixedSurface',ltype1)
757 call grib_get(gaid,'scaleFactorOfFirstFixedSurface',scalef1)
758 call grib_get(gaid,'scaledValueOfFirstFixedSurface',scalev1)
759 .OR.
IF (scalef1 == -1 scalev1 == -1) THEN
760 scalef1 = imiss; scalev1 = imiss
763 call grib_get(gaid,'typeOfSecondFixedSurface',ltype2)
764 call grib_get(gaid,'scaleFactorOfSecondFixedSurface',scalef2)
765 call grib_get(gaid,'scaledValueOfSecondFixedSurface',scalev2)
766 .OR.
IF (scalef2 == -1 scalev2 == -1) THEN
767 scalef2 = imiss; scalev2 = imiss
772 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
777 ! Convert missing levels and units m -> mm
778 call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
781 call init (this,level1,l1,level2,l2)
783 END SUBROUTINE level_import_gribapi
786 SUBROUTINE level_export_gribapi(this, gaid)
787 TYPE(vol7d_level),INTENT(in) :: this ! vol7d_level object
788 INTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to export
790 INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
793 CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
794 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
796 call grib_get(gaid,'GRIBEditionNumber',EditionNumber)
798 if (EditionNumber == 1)then
800 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
802 call grib_set(gaid,'indicatorOfTypeOfLevel',ltype)
803 ! it is important to set topLevel after, otherwise, in case of single levels
804 ! bottomLevel=0 overwrites topLevel (aliases in grib_api)
805 call grib_set(gaid,'bottomLevel',l2)
806 call grib_set(gaid,'topLevel',l1)
808 else if (EditionNumber == 2)then
810 CALL grib_set(gaid,'typeOfFirstFixedSurface',ltype1)
811 .NOT..OR..NOT.
IF (c_e(scalef1) c_e(scalev1)) THEN ! code missing values correctly
812 CALL grib_set_missing(gaid,'scaleFactorOfFirstFixedSurface')
813 CALL grib_set_missing(gaid,'scaledValueOfFirstFixedSurface')
815 CALL grib_set(gaid,'scaleFactorOfFirstFixedSurface',scalef1)
816 CALL grib_set(gaid,'scaledValueOfFirstFixedSurface',scalev1)
819 CALL grib_set(gaid,'typeOfSecondFixedSurface',ltype2)
820 .OR..NOT..OR..NOT.
IF (ltype2 == 255 c_e(scalef2) c_e(scalev2)) THEN ! code missing values correctly
821 CALL grib_set_missing(gaid,'scaleFactorOfSecondFixedSurface')
822 CALL grib_set_missing(gaid,'scaledValueOfSecondFixedSurface')
824 CALL grib_set(gaid,'scaleFactorOfSecondFixedSurface',scalef2)
825 CALL grib_set(gaid,'scaledValueOfSecondFixedSurface',scalev2)
830 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
835 END SUBROUTINE level_export_gribapi
838 SUBROUTINE timerange_import_gribapi(this, gaid)
839 TYPE(vol7d_timerange),INTENT(out) :: this ! vol7d_timerange object
840 importINTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to
842 INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
843 ttimeincr, tprocdata, status
845 call grib_get(gaid,'GRIBEditionNumber',EditionNumber)
847 IF (EditionNumber == 1) THEN
849 CALL grib_get(gaid,'timeRangeIndicator',tri)
850 CALL grib_get(gaid,'P1',p1g)
851 CALL grib_get(gaid,'P2',p2g)
852 CALL grib_get(gaid,'indicatorOfUnitOfTimeRange',unit)
853 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
855 ELSE IF (EditionNumber == 2) THEN
857 CALL grib_get(gaid,'forecastTime',p1g)
858 CALL grib_get(gaid,'indicatorOfUnitOfTimeRange',unit)
859 CALL g2_interval_to_second(unit, p1g, p1)
860 call grib_get(gaid,'typeOfStatisticalProcessing',statproc,status)
862 .AND..AND.
IF (status == GRIB_SUCCESS statproc >= 0 statproc < 254) THEN ! statistically processed
863 CALL grib_get(gaid,'lengthOfTimeRange',p2g)
864 CALL grib_get(gaid,'indicatorOfUnitForTimeRange',unit)
865 CALL g2_interval_to_second(unit, p2g, p2)
867 ! for forecast-like timeranges p1 has to be shifted to the end of interval
868 CALL grib_get(gaid,'typeOfProcessedData',tprocdata,status)
869 CALL grib_get(gaid,'typeOfTimeIncrement',ttimeincr)
870 .AND.
IF (ttimeincr == 2 tprocdata /= 0) THEN
874 CALL l4f_log(L4F_WARN,'Found p1>0 in grib2 analysis data, strange things may happen')
885 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
890 CALL init(this, statproc, p1, p2)
892 END SUBROUTINE timerange_import_gribapi
895 SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
896 TYPE(vol7d_timerange),INTENT(in) :: this ! vol7d_timerange object
897 INTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to export
898 TYPE(datetime) :: reftime ! reference time of data, used for coding correct end of statistical processing period in grib2
900 INTEGER :: EditionNumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
901 CHARACTER(len=8) :: env_var
902 LOGICAL :: g2cosmo_behavior
904 CALL grib_get(gaid,'GRIBEditionNumber',EditionNumber)
906 IF (EditionNumber == 1 ) THEN
907 ! Convert vol7d_timerange members to grib1 with reasonable time unit
908 CALL grib_get(gaid,'indicatorOfUnitOfTimeRange',currentunit)
909 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
910 tri, p1_g1, p2_g1, unit)
911 ! Set the native keys
912 CALL grib_set(gaid,'timeRangeIndicator',tri)
913 CALL grib_set(gaid,'P1',p1_g1)
914 CALL grib_set(gaid,'P2',p2_g1)
915 CALL grib_set(gaid,'indicatorOfUnitOfTimeRange',unit)
917 ELSE IF (EditionNumber == 2) THEN
918 CALL grib_get(gaid,'productDefinitionTemplateNumber', pdtn)
920 IF (this%timerange == 254) THEN ! point in time -> template 4.0
921 .OR.
IF (pdtn < 0 pdtn > 7) &
922 CALL grib_set(gaid,'productDefinitionTemplateNumber', 0)
923 ! Set reasonable time unit
924 CALL timerange_v7d_to_g2(this%p1,p1,unit)
925 ! Set the native keys
926 CALL grib_set(gaid,'indicatorOfUnitOfTimeRange',unit)
927 CALL grib_set(gaid,'forecastTime',p1)
929 .AND.
ELSE IF (this%timerange >= 0 this%timerange < 254) THEN
930 ! statistically processed -> template 4.8
931 .OR.
IF (pdtn < 8 pdtn > 14) &
932 CALL grib_set(gaid,'productDefinitionTemplateNumber', 8)
934 IF (this%p1 >= this%p2) THEN ! forecast-like
935 ! Set reasonable time unit
936 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
937 CALL grib_set(gaid,'indicatorOfUnitOfTimeRange',unit)
938 CALL grib_set(gaid,'forecastTime',p1)
939 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
940 ! Successive times processed have same start time of forecast,
941 ! forecast time is incremented
942 CALL grib_set(gaid,'typeOfStatisticalProcessing',this%timerange)
943 ! typeOfTimeIncrement to be replaced with a check that typeOfProcessedData /= 0
944 CALL grib_set(gaid,'typeOfTimeIncrement',2)
945 CALL timerange_v7d_to_g2(this%p2,p2,unit)
946 CALL grib_set(gaid,'indicatorOfUnitForTimeRange',unit)
947 CALL grib_set(gaid,'lengthOfTimeRange',p2)
949 ELSE IF (this%p1 == 0) THEN ! analysis-like
950 ! Set reasonable time unit
951 CALL timerange_v7d_to_g2(this%p2,p2,unit)
952 CALL grib_set(gaid,'indicatorOfUnitOfTimeRange',unit)
953 CALL grib_set(gaid,'forecastTime',0)
954 CALL code_endoftimeinterval(reftime)
955 ! Successive times processed have same forecast time, start time of
956 ! forecast is incremented
957 CALL grib_set(gaid,'typeOfStatisticalProcessing',this%timerange)
958 ! typeOfTimeIncrement to be replaced with typeOfProcessedData
959 CALL getenv('LIBSIM_G2COSMO_BEHAVIOR', env_var)
960 g2cosmo_behavior = LEN_TRIM(env_var) > 0
961 IF (g2cosmo_behavior) THEN
962 CALL grib_set(gaid,'typeOfProcessedData',0)
964 CALL grib_set(gaid,'typeOfTimeIncrement',1)
966 CALL grib_set(gaid,'indicatorOfUnitForTimeRange',unit)
967 CALL grib_set(gaid,'lengthOfTimeRange',p2)
969 ! warn about local use
970 IF (this%timerange >= 192) THEN
971 CALL l4f_log(L4F_WARN, &
972 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
976 CALL l4f_log(L4F_ERROR, &
977 'Timerange with 0>p1>p2 cannot be exported in grib2')
978 CALL raise_fatal_error()
981 CALL l4f_log(L4F_ERROR, &
982 'typeOfStatisticalProcessing not supported: '//TRIM(to_char(this%timerange)))
983 CALL raise_fatal_error()
987 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
988 CALL raise_fatal_error()
993 ! Explicitely compute and code in grib2 template 4.8 the end of
994 ! overalltimeinterval which is not done automatically by grib_api
995 SUBROUTINE code_endoftimeinterval(endtime)
996 TYPE(datetime),INTENT(in) :: endtime
998 INTEGER :: year, month, day, hour, minute, msec
1000 CALL getval(endtime, year=year, month=month, day=day, &
1001 hour=hour, minute=minute, msec=msec)
1002 CALL grib_set(gaid,'yearOfEndOfOverallTimeInterval',year)
1003 CALL grib_set(gaid,'monthOfEndOfOverallTimeInterval',month)
1004 CALL grib_set(gaid,'dayOfEndOfOverallTimeInterval',day)
1005 CALL grib_set(gaid,'hourOfEndOfOverallTimeInterval',hour)
1006 CALL grib_set(gaid,'minuteOfEndOfOverallTimeInterval',minute)
1007 CALL grib_set(gaid,'secondOfEndOfOverallTimeInterval',msec/1000)
1009 END SUBROUTINE code_endoftimeinterval
1011 END SUBROUTINE timerange_export_gribapi
1014 SUBROUTINE var_import_gribapi(this, gaid)
1015 TYPE(volgrid6d_var),INTENT(out) :: this ! volgrid6d_var object
1016 importINTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to
1018 INTEGER :: EditionNumber, centre, discipline, category, number
1020 call grib_get(gaid,'GRIBEditionNumber',EditionNumber)
1022 if (EditionNumber == 1) then
1024 call grib_get(gaid,'centre',centre)
1025 call grib_get(gaid,'gribTablesVersionNo',category)
1026 call grib_get(gaid,'indicatorOfParameter',number)
1028 call init(this, centre, category, number)
1030 else if (EditionNumber == 2) then
1032 call grib_get(gaid,'centre',centre)
1033 call grib_get(gaid,'discipline',discipline)
1034 call grib_get(gaid,'parameterCategory',category)
1035 call grib_get(gaid,'parameterNumber',number)
1037 call init(this, centre, category, number, discipline)
1041 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
1046 END SUBROUTINE var_import_gribapi
1049 SUBROUTINE var_export_gribapi(this, gaid)
1050 TYPE(volgrid6d_var),INTENT(in) :: this ! volgrid6d_var object
1051 INTEGER,INTENT(in) :: gaid ! grib_api id of the grib loaded in memory to export
1053 INTEGER ::EditionNumber
1055 call grib_get(gaid,'GRIBEditionNumber',EditionNumber)
1057 if (EditionNumber == 1) then
1059 IF (this%centre /= 255) & ! if centre missing (coming from bufr), keep template
1060 CALL grib_set(gaid,'centre',this%centre)
1061 CALL grib_set(gaid,'gribTablesVersionNo',this%category)
1062 CALL grib_set(gaid,'indicatorOfParameter',this%number)
1064 else if (EditionNumber == 2) then
1066 ! this must be changed to 65535!!!!
1067 IF (this%centre /= 255) & ! if centre missing (coming from bufr), keep template
1068 CALL grib_set(gaid,'centre',this%centre)
1069 CALL grib_set(gaid,'discipline',this%discipline)
1070 CALL grib_set(gaid,'parameterCategory',this%category)
1071 CALL grib_set(gaid,'parameterNumber',this%number)
1075 CALL l4f_log(L4F_ERROR,'GribEditionNumber '//t2c(EditionNumber)//' not supported')
1080 END SUBROUTINE var_export_gribapi
1083 SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1084 integer,intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1085 integer,intent(out) ::lt1,l1,lt2,l2
1088 CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1089 CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1093 SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1094 integer,intent(in) :: ltype,scalef,scalev
1095 integer,intent(out) :: lt,l
1097 doubleprecision :: sl
1100 .OR.
IF (ltype == 255 ltype == -1) THEN
1103 .OR..OR..AND.
ELSE IF (ltype <= 10 ltype == 101 (ltype >= 162 ltype <= 184)) THEN
1108 .AND.
IF (c_e(scalef) c_e(scalev)) THEN
1109 sl = scalev*(10.D0**(-scalef))
1110 ! apply unit conversions
1111 IF (ANY(ltype == height_level)) THEN
1112 l = NINT(sl*1000.D0)
1113 ELSE IF (ANY(ltype == thermo_level)) THEN
1115 ELSE IF (ANY(ltype == sigma_level)) THEN
1116 l = NINT(sl*10000.D0)
1125 END SUBROUTINE g2_to_dballe
1127 END SUBROUTINE level_g2_to_dballe
1130 SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1131 integer,intent(in) :: lt1,l1,lt2,l2
1132 integer,intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1134 CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1135 CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1139 SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1140 INTEGER,INTENT(in) :: lt,l
1141 INTEGER,INTENT(out) :: ltype,scalef,scalev
1144 IF (lt == imiss) THEN
1148 .OR..OR..AND.
ELSE IF (lt <= 10 lt == 101 (lt >= 162 lt <= 184)) THEN
1152 .AND.
ELSE IF (lt == 256 l == imiss) THEN ! special case for cloud level -> surface
1159 IF (ANY(ltype == height_level)) THEN
1161 ELSE IF (ANY(ltype == thermo_level)) THEN
1163 ELSE IF (ANY(ltype == sigma_level)) THEN
1170 !Caso generale reale
1171 !IF (ANY(ltype == height_level)) THEN
1176 !IF (ABS(sl) < PRECISION) THEN
1180 ! magn = LOG10(ABS(sl))
1181 ! DO scalef = magn, MAX(magn, 20)
1182 ! IF (ABS((sl*10.D0**(scalef) - ANINT(sl*10.D0**(scalef))) / &
1183 ! sl*10.D0**(scalef)) < PRECISION) EXIT
1185 ! sl = scalev*(10.D0**(-scalef))
1188 END SUBROUTINE dballe_to_g2
1190 END SUBROUTINE level_dballe_to_g2
1193 SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1194 integer,intent(in) :: ltype,l1,l2
1195 integer,intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1204 .and.
if (ltype > 0 ltype <= 9)then
1206 else if (ltype == 20) then
1210 else if (ltype == 100) then
1213 else if (ltype == 101) then
1218 else if (ltype == 102) then
1220 else if (ltype == 103) then
1223 else if (ltype == 104) then
1228 else if (ltype == 105) then
1231 else if (ltype == 106) then
1236 else if (ltype == 107) then
1240 else if (ltype == 108) then
1247 else if (ltype == 109) then
1250 else if (ltype == 110) then
1255 else if (ltype == 111) then
1259 else if (ltype == 112) then
1266 else if (ltype == 113) then
1269 else if (ltype == 114) then
1274 else if (ltype == 115) then
1277 else if (ltype == 116) then
1282 else if (ltype == 117) then
1286 if ( btest(l1,15) ) then
1287 scalev1=-1*mod(l1,32768)
1289 else if (ltype == 119) then
1293 else if (ltype == 120) then
1300 else if (ltype == 121) then
1302 scalev1=(1100+l1)*100
1304 scalev2=(1100+l2)*100
1305 else if (ltype == 125) then
1309 else if (ltype == 128) then
1316 else if (ltype == 141) then
1320 scalev2=(1100+l2)*100
1321 else if (ltype == 160) then
1324 else if (ltype == 200) then ! entire atmosphere
1327 else if (ltype == 210) then ! entire ocean
1332 call l4f_log(L4F_ERROR,'level_g1_to_g2: GRIB1 level '//TRIM(to_char(ltype)) &
1333 //' cannot be converted to GRIB2.')
1337 END SUBROUTINE level_g1_to_g2
1340 SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1341 integer,intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1342 integer,intent(out) :: ltype,l1,l2
1344 .and..and.
if (ltype1 > 0 ltype1 <= 9 ltype2 == 255) then ! simple
1348 .and.
else if (ltype1 == 20 ltype2 == 255) then ! isothermal
1350 l1 = rescale2(scalef1-2,scalev1)!*100
1352 .and.
else if (ltype1 == 100 ltype2 == 255) then ! isobaric
1354 l1 = rescale2(scalef1+2,scalev1)!/100
1356 .and.
else if (ltype1 == 100 ltype2 == 100) then
1358 l1 = rescale1(scalef1+3,scalev1)!/1000
1359 l2 = rescale1(scalef2+3,scalev2)!/1000
1360 .and.
else if (ltype1 == 101 ltype2 == 255) then
1364 .and.
else if (ltype1 == 102 ltype2 == 255) then ! altitude over sea level
1366 l1 = rescale2(scalef1,scalev1)
1368 .and.
else if (ltype1 == 102 ltype2 == 102) then
1370 l1 = rescale1(scalef1+2,scalev1)!/100
1371 l2 = rescale1(scalef2+2,scalev2)!/100
1372 .and.
else if (ltype1 == 103 ltype2 == 255) then ! height over ground
1374 l1 = rescale2(scalef1,scalev1)
1376 .and.
else if (ltype1 == 103 ltype2 == 103) then
1378 l1 = rescale1(scalef1+2,scalev1)!/100
1379 l2 = rescale1(scalef2+2,scalev2)!/100
1380 .and.
else if (ltype1 == 104 ltype2 == 255) then ! sigma
1382 l1 = rescale2(scalef1,scalev1-4)!*10000
1384 .and.
else if (ltype1 == 104 ltype2 == 104) then
1386 l1 = rescale1(scalef1-2,scalev1)!*100
1387 l2 = rescale1(scalef2-2,scalev2)!*100
1388 .and.
else if (ltype1 == 105 ltype2 == 255) then ! hybrid
1390 l1 = rescale2(scalef1,scalev1)
1392 .and.
else if (ltype1 == 105 ltype2 == 105) then
1394 l1 = rescale1(scalef1,scalev1)
1395 l2 = rescale1(scalef2,scalev2)
1396 .and.
else if (ltype1 == 106 ltype2 == 255) then ! depth
1398 l1 = rescale2(scalef1-2,scalev1)!*100
1400 .and.
else if (ltype1 == 106 ltype2 == 106) then
1402 l1 = rescale1(scalef1-2,scalev1)!*100
1403 l2 = rescale1(scalef2-2,scalev2)!*100
1404 .and.
else if (ltype1 == 107 ltype2 == 255) then ! isentropic
1406 l1 = rescale2(scalef1,scalev1)
1408 .and.
else if (ltype1 == 107 ltype2 == 107) then
1410 l1 = rescale1(scalef1,scalev1)
1411 l2 = rescale1(scalef2,scalev2)
1412 .and.
else if (ltype1 == 108 ltype2 == 255) then ! pressure diff to ground
1414 l1 = rescale2(scalef1+2,scalev1)!/100
1416 .and.
else if (ltype1 == 108 ltype2 == 108) then
1418 l1 = rescale1(scalef1+2,scalev1)!/100
1419 l2 = rescale1(scalef2+2,scalev2)!/100
1420 .and.
else if (ltype1 == 109 ltype2 == 255) then ! potential vorticity surf
1422 l1 = rescale2(scalef1+9,scalev1)!/10**9
1424 .and.
else if (ltype1 == 111 ltype2 == 255) then ! eta level
1426 l1 = rescale2(scalef1-2,scalev1)!*100
1428 .and.
else if (ltype1 == 111 ltype2 == 111) then
1430 l1 = rescale1(scalef1-4,scalev1)!*10000
1431 l2 = rescale1(scalef2-4,scalev2)!*10000
1432 .and.
else if (ltype1 == 160 ltype2 == 255) then ! depth below sea
1434 l1 = rescale2(scalef1,scalev1)
1436 .and.
else if (ltype1 == 1 ltype2 == 8) then ! entire atmosphere
1438 .and.
else if (ltype1 == 1 ltype2 == 9) then ! entire ocean
1440 else ! mi sono rotto per ora
1445 call l4f_log(L4F_ERROR,'level_g2_to_g1: GRIB2 levels '//TRIM(to_char(ltype1))//' ' &
1446 //TRIM(to_char(ltype2))//' cannot be converted to GRIB1.')
1452 FUNCTION rescale1(scalef, scalev) RESULT(rescale)
1453 INTEGER,INTENT(in) :: scalef, scalev
1456 rescale = MIN(255, NINT(scalev*10.0D0**(-scalef)))
1458 END FUNCTION rescale1
1460 FUNCTION rescale2(scalef, scalev) RESULT(rescale)
1461 INTEGER,INTENT(in) :: scalef, scalev
1464 rescale = MIN(65535, NINT(scalev*10.0D0**(-scalef)))
1466 END FUNCTION rescale2
1468 END SUBROUTINE level_g2_to_g1
1470 ! Convert timerange from grib1 to grib2-like way:
1472 ! Tri 2 (point in time) gives (hopefully temporarily) statproc 205.
1474 ! Tri 13 (COSMO-nudging) gives p1 (forecast time) 0 and a temporary
1477 ! Further processing and correction of the values returned is
1478 ! performed in normalize_gridinfo.
1479 SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1480 INTEGER,INTENT(in) :: tri, p1_g1, p2_g1, unit
1481 INTEGER,INTENT(out) :: statproc, p1, p2
1483 .OR.
IF (tri == 0 tri == 1) THEN ! point in time
1485 CALL g1_interval_to_second(unit, p1_g1, p1)
1487 ELSE IF (tri == 10) THEN ! point in time
1489 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1491 ELSE IF (tri == 2) THEN ! somewhere between p1 and p2, not good for grib2 standard
1493 CALL g1_interval_to_second(unit, p2_g1, p1)
1494 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1495 ELSE IF (tri == 3) THEN ! average
1497 CALL g1_interval_to_second(unit, p2_g1, p1)
1498 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1499 ELSE IF (tri == 4) THEN ! accumulation
1501 CALL g1_interval_to_second(unit, p2_g1, p1)
1502 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1503 ELSE IF (tri == 5) THEN ! difference
1505 CALL g1_interval_to_second(unit, p2_g1, p1)
1506 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1507 ELSE IF (tri == 13) THEN ! COSMO-nudging, use a temporary value then normalize
1508 statproc = 257 ! check if 257 is legal!
1509 p1 = 0 ! analysis regardless of p2_g1
1510 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1512 call l4f_log(L4F_ERROR,'timerange_g1_to_g2: GRIB1 timerange '//TRIM(to_char(tri)) &
1513 //' cannot be converted to GRIB2.')
1517 .and.
if (statproc == 254 p2 /= 0 ) then
1518 call l4f_log(L4F_WARN,"inconsistence in timerange:254,
"//trim(to_char(p1))//",
"//trim(to_char(p2)))
1521 END SUBROUTINE timerange_g1_to_v7d
1529 !5 Decade (10 years)
1530 !6 Normal (30 years)
1531 !7 Century(100 years)
1542 SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1543 INTEGER,INTENT(in) :: unit, valuein
1544 INTEGER,INTENT(out) :: valueout
1546 INTEGER,PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1547 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1550 .AND.
IF (unit >= LBOUND(unitlist,1) unit <= UBOUND(unitlist,1)) THEN
1551 IF (c_e(unitlist(unit))) THEN
1552 valueout = valuein*unitlist(unit)
1556 END SUBROUTINE g1_interval_to_second
1559 SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1560 INTEGER,INTENT(in) :: unit, valuein
1561 INTEGER,INTENT(out) :: valueout
1563 INTEGER,PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1564 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1567 .AND.
IF (unit >= LBOUND(unitlist,1) unit <= UBOUND(unitlist,1)) THEN
1568 IF (c_e(unitlist(unit))) THEN
1569 valueout = valuein*unitlist(unit)
1573 END SUBROUTINE g2_interval_to_second
1576 ! Convert timerange from grib2-like to grib1 way:
1578 ! Statproc 205 (point in time, non standard, not good in grib2) is
1579 ! correctly converted to tri 2.
1581 ! Statproc 257 (COSMO nudging-like, non standard, not good in grib2)
1582 ! should not appear here, but is anyway converted to tri 13 (real
1585 ! In case p1_g1<0 (i.e. statistically processed analysis data, with
1586 ! p1=0 and p2>0), COSMO-nudging tri 13 is (mis-)used.
1587 SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1588 INTEGER,INTENT(in) :: statproc, p1, p2
1589 INTEGER,INTENT(out) :: tri, p1_g1, p2_g1, unit
1591 INTEGER :: ptmp, pdl
1594 IF (statproc == 254) pdl = p1 ! avoid unexpected situations (necessary?)
1596 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1597 IF (statproc == 0) THEN ! average
1599 ELSE IF (statproc == 1) THEN ! accumulation
1601 ELSE IF (statproc == 4) THEN ! difference
1603 ELSE IF (statproc == 205) THEN ! point in time interval, not good for grib2 standard
1605 ELSE IF (statproc == 257) THEN ! COSMO-nudging (statistical processing in the past)
1606 ! this should never happen (at least from COSMO grib1), since 257 is
1607 ! converted to something else in normalize_gridinfo; now a negative
1608 ! p1_g1 is set, it will be corrected in the next section
1610 ! CALL second_to_gribtr(p1, p2_g1, unit, 1)
1611 ! CALL second_to_gribtr(p1-p2, p1_g1, unit, 1)
1612 ELSE IF (statproc == 254) THEN ! point in time
1616 CALL l4f_log(L4F_ERROR,'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1617 //TRIM(to_char(statproc))//' cannot be converted to GRIB1.')
1621 .OR.
IF (p1_g1 > 255 p2_g1 > 255) THEN
1622 ptmp = MAX(p1_g1,p2_g1)
1623 p2_g1 = MOD(ptmp,256)
1625 IF (tri /= 0) THEN ! if not instantaneous give warning
1626 CALL l4f_log(L4F_WARN,'timerange_v7d_to_g1: timerange too long for grib1 ' &
1627 //TRIM(to_char(ptmp))//', forcing time range indicator to 10.')
1633 ! p1 < 0 is not allowed, use COSMO trick
1637 p2_g1 = p2_g1 - ptmp
1641 END SUBROUTINE timerange_v7d_to_g1
1644 SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1645 INTEGER,INTENT(in) :: valuein
1646 INTEGER,INTENT(out) :: valueout, unit
1648 IF (valuein == imiss) THEN
1651 ELSE IF (MOD(valuein,3600) == 0) THEN ! prefer hours
1652 valueout = valuein/3600
1654 ELSE IF (MOD(valuein,60) == 0) THEN ! then minutes
1655 valueout = valuein/60
1662 END SUBROUTINE timerange_v7d_to_g2
1665 ! These units are tested for applicability:
1672 SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1673 INTEGER,INTENT(in) :: valuein1, valuein2
1674 INTEGER,INTENT(out) :: valueout1, valueout2, unit
1679 INTEGER :: sectounit
1680 END TYPE unitchecker
1682 TYPE(unitchecker),PARAMETER :: hunit(5) = (/ &
1683 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1684 unitchecker(12, 43200), unitchecker(2, 86400) /)
1685 TYPE(unitchecker),PARAMETER :: munit(3) = (/ & ! 13 14 COSMO extensions
1686 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1689 .NOT..OR..NOT.
IF (c_e(valuein1) c_e(valuein2)) THEN
1693 .AND.
ELSE IF (MOD(valuein1,3600) == 0 MOD(valuein2,3600) == 0) THEN ! prefer hours
1694 DO i = 1, SIZE(hunit)
1695 IF (MOD(valuein1, hunit(i)%sectounit) == 0 &
1696 .AND.
MOD(valuein2, hunit(i)%sectounit) == 0 &
1697 .AND.
valuein1/hunit(i)%sectounit < 255 &
1698 .AND.
valuein2/hunit(i)%sectounit < 255) THEN
1699 valueout1 = valuein1/hunit(i)%sectounit
1700 valueout2 = valuein2/hunit(i)%sectounit
1701 unit = hunit(i)%unit
1705 .NOT.
IF (c_e(unit)) THEN
1706 ! last chance, disable overflow check and start from longest unit,
1707 DO i = SIZE(hunit), 1, -1
1708 IF (MOD(valuein1, hunit(i)%sectounit) == 0 &
1709 .AND.
MOD(valuein2, hunit(i)%sectounit) == 0) THEN
1710 valueout1 = valuein1/hunit(i)%sectounit
1711 valueout2 = valuein2/hunit(i)%sectounit
1712 unit = hunit(i)%unit
1717 .AND.
ELSE IF (MOD(valuein1,60) == 0. MOD(valuein2,60) == 0) THEN ! then minutes
1718 DO i = 1, SIZE(munit)
1719 IF (MOD(valuein1, munit(i)%sectounit) == 0 &
1720 .AND.
MOD(valuein2, munit(i)%sectounit) == 0 &
1721 .AND.
valuein1/munit(i)%sectounit < 255 &
1722 .AND.
valuein2/munit(i)%sectounit < 255) THEN
1723 valueout1 = valuein1/munit(i)%sectounit
1724 valueout2 = valuein2/munit(i)%sectounit
1725 unit = munit(i)%unit
1729 .NOT.
IF (c_e(unit)) THEN
1730 ! last chance, disable overflow check and start from longest unit,
1731 DO i = SIZE(munit), 1, -1
1732 IF (MOD(valuein1, munit(i)%sectounit) == 0 &
1733 .AND.
MOD(valuein2, munit(i)%sectounit) == 0) THEN
1734 valueout1 = valuein1/munit(i)%sectounit
1735 valueout2 = valuein2/munit(i)%sectounit
1736 unit = munit(i)%unit
1743 .NOT.
IF (c_e(unit)) THEN
1744 CALL l4f_log(L4F_ERROR,'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1745 //t2c(valuein1)//','//t2c(valuein2)//'s intervals' )
1749 END SUBROUTINE timerange_choose_unit_g1
1752 ! Standardize variables and timerange in DB-all.e thinking:
1754 ! Timerange 205 (point in time interval) is converted to maximum or
1755 ! minimum if parameter is recognized as such and parameter is
1756 ! corrected as well, otherwise 205 is kept (with possible error
1757 ! conditions later).
1759 ! Timerange 257 (COSMO nudging) is converted to point in time if
1760 ! interval length is 0, or to a proper timerange if parameter is
1761 ! recognized as a COSMO statistically processed parameter (and in case
1762 ! of maximum or minimum the parameter is corrected as well); if
1763 ! parameter is not recognized, it is converted to instantaneous with a
1765 SUBROUTINE normalize_gridinfo(this)
1766 TYPE(gridinfo_def),intent(inout) :: this
1768 IF (this%timerange%timerange == 254) THEN ! instantaneous
1771 IF (this%var == volgrid6d_var_new(255,2,16,255)) THEN
1777 IF (this%var == volgrid6d_var_new(255,2,15,255)) THEN
1782 ELSE IF (this%timerange%timerange == 205) THEN ! point in time interval
1785 IF (this%var == volgrid6d_var_new(255,2,16,255)) THEN
1787 this%timerange%timerange=3
1792 IF (this%var == volgrid6d_var_new(255,2,15,255)) THEN
1794 this%timerange%timerange=2
1798 ! it is accepted to keep 187 since it is wind gust, not max wind
1799 .AND.
IF (this%var%discipline == 255 &
1800 ANY(this%var%centre == cosmo_centre)) THEN ! grib1 & COSMO
1802 IF (this%var%category == 201) THEN ! table 201
1804 IF (this%var%number == 187) THEN ! wind gust
1805 ! this%var%category=2
1806 ! this%var%number=32
1807 this%timerange%timerange=2
1812 ELSE IF (this%timerange%timerange == 257) THEN ! COSMO-nudging
1814 IF (this%timerange%p2 == 0) THEN ! point in time
1816 this%timerange%timerange=254
1818 ELSE ! guess timerange according to parameter
1820 .AND.
IF (this%var%discipline == 255 &
1821 ANY(this%var%centre == cosmo_centre)) THEN ! grib1 & COSMO
1823 .AND.
IF (this%var%category >= 1 this%var%category <= 3) THEN ! WMO table 2
1825 if (this%var%number == 11) then ! T
1826 this%timerange%timerange=0 ! average
1828 else if (this%var%number == 15) then ! T
1829 this%timerange%timerange=2 ! maximum
1830 this%var%number=11 ! reset also parameter
1832 else if (this%var%number == 16) then ! T
1833 this%timerange%timerange=3 ! minimum
1834 this%var%number=11 ! reset also parameter
1836 else if (this%var%number == 17) then ! TD
1837 this%timerange%timerange=0 ! average
1839 else if (this%var%number == 33) then ! U
1840 this%timerange%timerange=0 ! average
1842 else if (this%var%number == 34) then ! V
1843 this%timerange%timerange=0 ! average
1845 else if (this%var%number == 57) then ! evaporation
1846 this%timerange%timerange=1 ! accumulated
1848 else if (this%var%number == 61) then ! TOT_PREC
1849 this%timerange%timerange=1 ! accumulated
1851 else if (this%var%number == 78) then ! SNOW_CON
1852 this%timerange%timerange=1 ! accumulated
1854 else if (this%var%number == 79) then ! SNOW_GSP
1855 this%timerange%timerange=1 ! accumulated
1857 else if (this%var%number == 90) then ! RUNOFF
1858 this%timerange%timerange=1 ! accumulated
1860 else if (this%var%number == 111) then ! fluxes
1861 this%timerange%timerange=0 ! average
1862 else if (this%var%number == 112) then
1863 this%timerange%timerange=0 ! average
1864 else if (this%var%number == 113) then
1865 this%timerange%timerange=0 ! average
1866 else if (this%var%number == 114) then
1867 this%timerange%timerange=0 ! average
1868 else if (this%var%number == 121) then
1869 this%timerange%timerange=0 ! average
1870 else if (this%var%number == 122) then
1871 this%timerange%timerange=0 ! average
1872 else if (this%var%number == 124) then
1873 this%timerange%timerange=0 ! average
1874 else if (this%var%number == 125) then
1875 this%timerange%timerange=0 ! average
1876 else if (this%var%number == 126) then
1877 this%timerange%timerange=0 ! average
1878 else if (this%var%number == 127) then
1879 this%timerange%timerange=0 ! average
1883 ELSE IF (this%var%category == 201) THEN ! table 201
1885 if (this%var%number == 5) then ! photosynthetic flux
1886 this%timerange%timerange=0 ! average
1888 else if (this%var%number == 20) then ! SUN_DUR
1889 this%timerange%timerange=1 ! accumulated
1891 else if (this%var%number == 22) then ! radiation fluxes
1892 this%timerange%timerange=0 ! average
1893 else if (this%var%number == 23) then
1894 this%timerange%timerange=0 ! average
1895 else if (this%var%number == 24) then
1896 this%timerange%timerange=0 ! average
1897 else if (this%var%number == 25) then
1898 this%timerange%timerange=0 ! average
1899 else if (this%var%number == 26) then
1900 this%timerange%timerange=0 ! average
1901 else if (this%var%number == 27) then
1902 this%timerange%timerange=0 ! average
1904 else if (this%var%number == 42) then ! water divergence
1905 this%timerange%timerange=1 ! accumulated
1907 else if (this%var%number == 102) then ! RAIN_GSP
1908 this%timerange%timerange=1 ! accumulated
1910 else if (this%var%number == 113) then ! RAIN_CON
1911 this%timerange%timerange=1 ! accumulated
1913 else if (this%var%number == 132) then ! GRAU_GSP
1914 this%timerange%timerange=1 ! accumulated
1916 else if (this%var%number == 135) then ! HAIL_GSP
1917 this%timerange%timerange=1 ! accumulated
1919 else if (this%var%number == 187) then ! UVMAX
1920 ! this%var%category=2 ! reset also parameter
1921 ! this%var%number=32
1922 this%timerange%timerange=2 ! maximum
1924 else if (this%var%number == 218) then ! maximum 10m dynamical gust
1925 this%timerange%timerange=2 ! maximum
1927 else if (this%var%number == 219) then ! maximum 10m convective gust
1928 this%timerange%timerange=2 ! maximum
1932 ELSE IF (this%var%category == 202) THEN ! table 202
1934 if (this%var%number == 231) then ! sso parameters
1935 this%timerange%timerange=0 ! average
1936 else if (this%var%number == 232) then
1937 this%timerange%timerange=0 ! average
1938 else if (this%var%number == 233) then
1939 this%timerange%timerange=0 ! average
1942 ELSE ! parameter not recognized, set instantaneous?
1944 call l4f_category_log(this%category,L4F_WARN, &
1945 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1946 TRIM(to_char(this%timerange%p2)))
1947 call l4f_category_log(this%category,L4F_WARN, &
1948 'associated to an apparently instantaneous parameter '//&
1949 TRIM(to_char(this%var%centre))//','//TRIM(to_char(this%var%category))//','//&
1950 TRIM(to_char(this%var%number))//','//TRIM(to_char(this%var%discipline)))
1951 call l4f_category_log(this%category,L4F_WARN, 'forcing to instantaneous')
1953 this%timerange%p2 = 0
1954 this%timerange%timerange = 254
1957 ENDIF ! grib1 & COSMO
1961 .AND.
IF (this%var%discipline == 255 &
1962 ANY(this%var%centre == ecmwf_centre)) THEN ! grib1 & ECMWF
1963 ! useful references:
1964 ! http://www.ecmwf.int/publications/manuals/libraries/tables/tables_index.html
1965 ! http://www.ecmwf.int/products/data/technical/soil/discret_soil_lay.html
1967 IF (this%var%category == 128) THEN ! table 128
1969 .OR.
IF ((this%var%number == 142 & ! large scale precipitation
1970 .OR.
this%var%number == 143 & ! convective precipitation
1971 .OR.
this%var%number == 144 & ! total snow
1972 .OR.
this%var%number == 228 & ! total precipitation
1973 .OR.
this%var%number == 145 & ! boundary layer dissipation
1974 .OR.
this%var%number == 146 & ! surface sensible heat flux
1975 .OR.
this%var%number == 147 & ! surface latent heat flux
1976 .AND.
this%var%number == 169) & ! surface solar radiation downwards
1977 this%timerange%timerange == 254) THEN
1978 this%timerange%timerange = 1 ! accumulated
1979 this%timerange%p2 = this%timerange%p1 ! length of period = forecast time
1981 .OR.
ELSE IF ((this%var%number == 165 & ! 10m U
1982 .AND.
this%var%number == 166) & ! 10m V
1983 this%level%level1 == 1) THEN
1984 this%level%level1 = 103
1985 this%level%l1 = 10000 ! 10m
1987 .OR.
ELSE IF ((this%var%number == 167 & ! 2m T
1988 .AND.
this%var%number == 168) & ! 2m Td
1989 this%level%level1 == 1) THEN
1990 this%level%level1 = 103
1991 this%level%l1 = 2000 ! 2m
1993 .OR..OR.
ELSE IF (this%var%number == 39 this%var%number == 139 this%var%number == 140) THEN ! SWVL1,STL1,SWL1
1994 this%level%level1 = 106 ! below surface
1996 this%level%l2 = 70 ! 7cm
1998 .OR.
ELSE IF (this%var%number == 40 this%var%number == 170) THEN ! SWVL2,STL2 (STL2 wrong before 2000)
1999 this%level%level1 = 106 ! below surface
2003 ELSE IF (this%var%number == 171) THEN ! SWL2
2004 this%level%level1 = 106 ! below surface
2008 .OR.
ELSE IF (this%var%number == 41 this%var%number == 183) THEN ! SWVL3,STL3 (STL3 wrong before 2000)
2009 this%level%level1 = 106 ! below surface
2011 this%level%l2 = 1000
2013 ELSE IF (this%var%number == 184) THEN ! SWL3
2014 this%level%level1 = 106 ! below surface
2016 this%level%l2 = 1000
2018 .OR..OR.
ELSE IF (this%var%number == 42 this%var%number == 236 this%var%number == 237) THEN ! SWVL4,STL4,SWL4
2019 this%level%level1 = 106 ! below surface
2020 this%level%l1 = 1000
2021 this%level%l2 = 2890
2023 .AND.
ELSE IF (this%var%number == 121 &
2024 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! MX2T6
2025 this%timerange%timerange = 2 ! max
2026 this%timerange%p2 = 21600 ! length of period = 6 hours
2027 this%var%number=167 ! set to T2m, it could be 130 T as well
2028 this%level%level1 = 103
2029 this%level%l1 = 2000 ! 2m
2031 .AND.
ELSE IF (this%var%number == 122 &
2032 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! MN2T6
2033 this%timerange%timerange = 3 ! min
2034 this%timerange%p2 = 21600 ! length of period = 6 hours
2036 this%var%number=167 ! set to T2m, it could be 130 T as well
2037 this%level%level1 = 103
2038 this%level%l1 = 2000 ! 2m
2040 .AND.
ELSE IF (this%var%number == 123 &
2041 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! 10FG6
2042 this%timerange%timerange = 2 ! max
2043 this%timerange%p2 = 21600 ! length of period = 6 hours
2044 this%level%level1 = 103
2045 this%level%l1 = 10000 ! 10m
2047 ! set cloud cover to bufr style
2048 ELSE IF (this%var%number == 186) THEN ! low cloud cover
2049 this%var%number = 248
2050 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2051 ELSE IF (this%var%number == 187) THEN ! medium cloud cover
2052 this%var%number = 248
2053 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2054 ELSE IF (this%var%number == 188) THEN ! high cloud cover
2055 this%var%number = 248
2056 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2059 ELSE IF (this%var%category == 228) THEN ! table 228
2061 IF (this%var%number == 24) THEN
2062 this%level%level1 = 4 ! Level of 0C Isotherm
2064 this%level%level2 = 255
2067 .AND.
ELSE IF (this%var%number == 26 &
2068 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! MX2T3
2069 this%timerange%timerange = 2 ! max
2070 this%timerange%p2 = 10800 ! length of period = 3 hours
2071 this%var%category = 128 ! reset to table version 128
2072 this%var%number=167 ! set to T2m, it could be 130 T as well
2073 this%level%level1 = 103
2074 this%level%l1 = 2000 ! 2m
2076 .AND.
ELSE IF (this%var%number == 27 &
2077 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! MN2T3
2078 this%timerange%timerange = 3 ! min
2079 this%timerange%p2 = 10800 ! length of period = 3 hours
2080 this%var%category = 128 ! reset to table version 128
2081 this%var%number=167 ! set to T2m, it could be 130 T as well
2082 this%level%level1 = 103
2083 this%level%l1 = 2000 ! 2m
2085 .AND.
ELSE IF (this%var%number == 28 &
2086 .OR.
(this%timerange%timerange == 254 this%timerange%timerange == 205)) THEN ! 10FG3
2087 this%timerange%timerange = 2 ! max
2088 this%timerange%p2 = 10800 ! length of period = 3 hours
2089 this%level%level1 = 103
2090 this%level%l1 = 10000 ! 10m
2095 ENDIF ! grib1 & ECMWF
2097 .AND.
IF (this%var%discipline == 255 &
2098 .AND.
this%var%category >= 1 this%var%category <= 3) THEN ! grib1 WMO table 2
2100 ! set cloud cover to bufr style
2101 IF (this%var%number == 73) THEN ! low cloud cover
2102 this%var%number = 71
2103 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2104 ELSE IF (this%var%number == 74) THEN ! medium cloud cover
2105 this%var%number = 71
2106 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2107 ELSE IF (this%var%number == 75) THEN ! high cloud cover
2108 this%var%number = 71
2109 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2116 END SUBROUTINE normalize_gridinfo
2119 ! Destandardize variables and timerange from DB-all.e thinking:
2121 ! Parameters having maximum or minimum statistical processing and
2122 ! having a corresponding extreme parameter in grib table, are
2123 ! temporarily converted to timerange 205 and to the corresponding
2124 ! extreme parameter; if parameter is not recognized, the max or min
2125 ! statistical processing is kept (with possible error conditions
2127 SUBROUTINE unnormalize_gridinfo(this)
2128 TYPE(gridinfo_def),intent(inout) :: this
2130 IF (this%timerange%timerange == 3) THEN ! min
2132 IF (this%var == volgrid6d_var_new(255,2,11,255)) THEN ! tmin
2134 this%timerange%timerange=205
2136 ELSE IF (ANY(this%var%centre == ecmwf_centre)) THEN ! ECMWF
2137 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255)) THEN ! tmin
2139 this%timerange%timerange=205
2143 ELSE IF (this%timerange%timerange == 2) THEN ! max
2145 IF (this%var == volgrid6d_var_new(255,2,11,255)) THEN ! tmax
2147 this%timerange%timerange=205
2149 ELSE IF (ANY(this%var%centre == ecmwf_centre)) THEN ! ECMWF
2150 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255)) THEN ! tmax
2152 this%timerange%timerange=205
2154 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255)) THEN ! uvmax
2155 this%timerange%timerange=205
2157 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255)) THEN ! uvmax
2158 this%timerange%timerange=205
2161 ELSE IF (ANY(this%var%centre == cosmo_centre)) THEN ! grib1 & COSMO
2164 ! it is accepted to keep 187 since it is wind gust, not max wind
2165 ! IF (this%var == volgrid6d_var_new(255,2,32,255)) THEN
2166 ! this%var%category=201
2167 ! this%var%number=187
2168 ! this%timerange%timerange=205
2170 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255)) THEN
2171 this%timerange%timerange=205
2176 ! reset cloud cover to grib1 style
2177 .AND.
IF (this%var%discipline == 255 this%var%category == 2) THEN ! grib1 table 2
2178 .AND.
IF (this%var%number == 71 &
2179 .AND.
this%level%level1 == 256 this%level%level2 == 258) THEN ! l/m/h cloud cover
2180 IF (this%level%l2 == 1) THEN ! l
2181 this%var%number = 73
2182 ELSE IF (this%level%l2 == 2) THEN ! m
2183 this%var%number = 74
2184 ELSE IF (this%level%l2 == 3) THEN ! h
2185 this%var%number = 75
2187 this%level = vol7d_level_new(level1=1) ! reset to surface
2191 IF (ANY(this%var%centre == ecmwf_centre)) THEN ! ECMWF
2192 ! reset cloud cover to grib1 style
2193 .AND.
IF (this%var%discipline == 255 this%var%category == 128) THEN ! grib1 table 128
2194 .OR..AND.
IF ((this%var%number == 248 this%var%number == 164) &
2195 .AND.
this%level%level1 == 256 this%level%level2 == 258) THEN ! l/m/h cloud cover
2196 IF (this%level%l2 == 1) THEN ! l
2197 this%var%number = 186
2198 ELSE IF (this%level%l2 == 2) THEN ! m
2199 this%var%number = 187
2200 ELSE IF (this%level%l2 == 3) THEN ! h
2201 this%var%number = 188
2203 this%level = vol7d_level_new(level1=1) ! reset to surface
2208 END SUBROUTINE unnormalize_gridinfo
2212 ! =========================================
2213 ! gdal driver specific code
2214 ! could this be moved to a separate module?
2215 ! =========================================
2217 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2218 TYPE(gridinfo_def),INTENT(inout) :: this ! gridinfo object
2219 TYPE(gdalrasterbandh),INTENT(in) :: gdalid ! gdal rasterband pointer
2221 TYPE(gdaldataseth) :: hds
2224 !call time_import_gdal(this%time, gaid)
2225 this%time = datetime_new(year=2010, month=1, day=1) ! conventional year
2227 !call timerange_import_gdal(this%timerange,gaid)
2228 this%timerange = vol7d_timerange_new(254, 0, 0) ! instantaneous data
2230 !call level_import_gdal(this%level, gaid)
2231 hds = gdalgetbanddataset(gdalid) ! go back to dataset
2232 IF (gdalgetrastercount(hds) == 1) THEN ! single level dataset
2233 this%level = vol7d_level_new(1, 0) ! surface
2235 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid)) ! hybrid level
2238 !call var_import_gdal(this%var, gaid)
2239 this%var = volgrid6d_var_new(centre=255, category=2, number=8) ! topography height
2241 END SUBROUTINE gridinfo_import_gdal
2245 END MODULE gridinfo_class
2248 !>\example example_vg6d_2.f90
2249 !!\brief Programma esempio semplice per la lettura di file grib.
2251 !! Programma che legge i grib contenuti in un file e li organizza in un vettore di oggetti gridinfo
2254 !>\example example_vg6d_4.f90
2255 !!\brief Programma esempio semplice per la elaborazione di file grib.
2257 !! Programma che legge uno ad uno i grid contenuti in un file e li
2258 !! elabora producendo un file di output contenente ancora grib
Functions that return a trimmed CHARACTER representation of the input variable.
Copy an object, creating a fully new instance.
Quick method to append an element to the array.
Clone the object, creating a new independent instance of the object exactly equal to the starting one...
Decode and return the data array from a grid_id object associated to a gridinfo object.
Destructor, it releases every information associated with the object.
Display on standard output a description of the gridinfo object provided.
Encode a data array into a grid_id object associated to a gridinfo object.
Export gridinfo descriptors information into a grid_id object.
Import information from a file or grid_id object into the gridinfo descriptors.
Constructor, it creates a new instance of the object.
Method for inserting elements of the array at a desired position.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Method for removing elements of the array at a desired position.
Emit log message for a category with specific priority.
Classi per la gestione delle coordinate temporali.
Module for describing geographically referenced regular grids.
This module defines an abstract interface to different drivers for access to files containing gridded...
Class for managing information about a single gridded georeferenced field, typically imported from an...
classe per la gestione del logging
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini.
Class for managing physical variables in a grib 1/2 fashion.
Derived type defining a dynamically extensible array of TYPE(gridinfo_def) elements.
Object describing a single gridded message/band.