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
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 END SUBROUTINE gridinfo_import
362 SUBROUTINE gridinfo_import_from_file(this, filename, categoryappend)
363 TYPE(arrayof_gridinfo) :: this
364 CHARACTER(len=*),
INTENT(in) :: filename
365 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
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)
385 input_file = grid_file_id_new(filename,
'r')
391 input_grid = grid_id_new(input_file)
392 IF (.NOT.
c_e(input_grid))
EXIT 397 IF (
PRESENT(categoryappend))
THEN 398 CALL init(gridinfol, gaid=input_grid, &
399 categoryappend=trim(categoryappend)//
"-msg"//trim(
to_char(ngrid)))
401 CALL init(gridinfol, gaid=input_grid, &
402 categoryappend=
"msg"//trim(
to_char(ngrid)))
406 CALL insert(this, gridinfol)
417 "gridinfo_import, "//
t2c(ngrid)//
" messages/bands imported from file "// &
423 CALL l4f_category_delete(category)
425 END SUBROUTINE gridinfo_import_from_file
434 SUBROUTINE gridinfo_export(this)
435 TYPE(gridinfo_def),
INTENT(inout) :: this
437 #ifdef HAVE_LIBGRIBAPI 449 CALL export(this%griddim, this%gaid)
451 #ifdef HAVE_LIBGRIBAPI 452 IF (grid_id_get_driver(this%gaid) ==
'grib_api')
THEN 453 gaid = grid_id_get_gaid(this%gaid)
454 IF (
c_e(gaid))
CALL gridinfo_export_gribapi(this, gaid)
458 IF (grid_id_get_driver(this%gaid) ==
'gdal')
THEN 460 CALL l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
464 END SUBROUTINE gridinfo_export
472 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
474 CHARACTER(len=*),
INTENT(in) :: filename
475 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
477 INTEGER :: i, category
478 CHARACTER(len=512) :: a_name
482 IF (
PRESENT(categoryappend))
THEN 483 CALL l4f_launcher(a_name,a_name_append= &
484 trim(subcategory)//
"."//trim(categoryappend))
486 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
488 category=l4f_category_get(a_name)
492 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
495 valid_grid_id = grid_id_new()
496 DO i = 1, this%arraysize
497 IF (
c_e(this%array(i)%gaid))
THEN 498 valid_grid_id = this%array(i)%gaid
503 IF (
c_e(valid_grid_id))
THEN 505 output_file = grid_file_id_new(filename,
'w', from_grid_id=valid_grid_id)
506 IF (
c_e(output_file))
THEN 509 DO i = 1, this%arraysize
511 CALL export(this%array(i))
513 CALL export(this%array(i)%gaid, output_file)
527 "gridinfo object of size "//
t2c(this%arraysize))
529 "no valid grid id found when exporting to file "//trim(filename))
534 CALL l4f_category_delete(category)
536 END SUBROUTINE gridinfo_export_to_file
547 FUNCTION gridinfo_decode_data(this)
RESULT(field)
549 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
551 CALL grid_id_decode_data(this%gaid, field)
553 END FUNCTION gridinfo_decode_data
563 SUBROUTINE gridinfo_encode_data(this, field)
565 REAL,
intent(in) :: field(:,:)
567 IF (
SIZE(field,1) /= this%griddim%dim%nx &
568 .OR.
SIZE(field,2) /= this%griddim%dim%ny)
THEN 570 'gridinfo_encode: field and gridinfo object non conformal, field: ' &
571 //trim(
to_char(
SIZE(field,1)))//
'X'//trim(
to_char(
SIZE(field,2)))//
', nx,ny:' &
572 //trim(
to_char(this%griddim%dim%nx))//
'X'//trim(
to_char(this%griddim%dim%ny)))
577 CALL grid_id_encode_data(this%gaid, field)
579 END SUBROUTINE gridinfo_encode_data
586 #ifdef HAVE_LIBGRIBAPI 587 SUBROUTINE gridinfo_import_gribapi(this, gaid)
589 INTEGER,
INTENT(in) :: gaid
591 call time_import_gribapi(this%time, gaid)
592 call timerange_import_gribapi(this%timerange,gaid)
593 call level_import_gribapi(this%level, gaid)
594 call var_import_gribapi(this%var, gaid)
596 call normalize_gridinfo(this)
598 END SUBROUTINE gridinfo_import_gribapi
602 SUBROUTINE gridinfo_export_gribapi(this, gaid)
604 INTEGER,
INTENT(in) :: gaid
607 REAL,
ALLOCATABLE :: tmparr(:,:)
610 CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
611 IF (this%var == volgrid6d_var_miss)
THEN 612 CALL l4f_log(l4f_error, &
613 'A suitable variable has not been found in table when converting template')
616 IF (c_func /= conv_func_miss)
THEN 622 CALL unnormalize_gridinfo(this)
624 CALL time_export_gribapi(this%time, gaid, this%timerange)
625 CALL timerange_export_gribapi(this%timerange, gaid, this%time)
626 CALL level_export_gribapi(this%level, gaid)
627 CALL var_export_gribapi(this%var, gaid)
629 END SUBROUTINE gridinfo_export_gribapi
632 SUBROUTINE time_import_gribapi(this,gaid)
634 INTEGER,
INTENT(in) :: gaid
636 INTEGER :: editionnumber, ttimeincr, tprocdata, centre, p2g, p2, unit, status
637 CHARACTER(len=9) :: date
638 CHARACTER(len=10) :: time
640 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
642 IF (editionnumber == 1 .OR. editionnumber == 2)
THEN 644 CALL grib_get(gaid,
'dataDate',date )
645 CALL grib_get(gaid,
'dataTime',time(:5) )
647 CALL init(this,simpledate=date(:8)//time(:4))
649 IF (editionnumber == 2)
THEN 651 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
652 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr,status)
653 IF (ttimeincr == 255) ttimeincr = 2
656 IF (status == grib_success .AND. ttimeincr == 1)
THEN 658 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
659 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
660 CALL g2_interval_to_second(unit, p2g, p2)
661 this = this + timedelta_new(sec=p2)
662 ELSE IF (status == grib_success .AND. ttimeincr == 2 .AND. tprocdata == 0)
THEN 666 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
667 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
668 CALL g2_interval_to_second(unit, p2g, p2)
669 CALL grib_get(gaid,
'centre',centre)
670 IF (centre /= 78)
THEN 671 this = this + timedelta_new(sec=p2)
673 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
674 status /= grib_success)
THEN 677 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
684 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
689 END SUBROUTINE time_import_gribapi
692 SUBROUTINE time_export_gribapi(this, gaid, timerange)
694 INTEGER,
INTENT(in) :: gaid
697 INTEGER :: editionnumber, centre
698 CHARACTER(len=8) :: env_var
699 LOGICAL :: g2cosmo_behavior
701 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
703 IF (editionnumber == 1)
THEN 705 CALL code_referencetime(this)
707 ELSE IF (editionnumber == 2 )
THEN 709 IF (timerange%p1 >= timerange%p2)
THEN 710 CALL code_referencetime(this)
711 ELSE IF (timerange%p1 == 0)
THEN 713 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
714 g2cosmo_behavior = len_trim(env_var) > 0
715 CALL grib_get(gaid,
'centre',centre)
716 IF (g2cosmo_behavior .AND. centre == 78)
THEN 717 CALL code_referencetime(this)
719 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
722 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
728 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
735 SUBROUTINE code_referencetime(reftime)
736 TYPE(datetime),
INTENT(in) :: reftime
739 CHARACTER(len=17) :: date_time
742 CALL getval(reftime, simpledate=date_time)
743 READ(date_time(:8),
'(I8)')date
744 READ(date_time(9:12),
'(I4)')time
745 CALL grib_set(gaid,
'dataDate',date)
746 CALL grib_set(gaid,
'dataTime',time)
748 END SUBROUTINE code_referencetime
750 END SUBROUTINE time_export_gribapi
753 SUBROUTINE level_import_gribapi(this, gaid)
754 TYPE(vol7d_level),
INTENT(out) :: this
755 INTEGER,
INTENT(in) :: gaid
757 INTEGER :: EditionNumber,level1,l1,level2,l2
758 INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
760 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
762 if (editionnumber == 1)
then 764 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
765 call grib_get(gaid,
'topLevel',l1)
766 call grib_get(gaid,
'bottomLevel',l2)
768 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
770 else if (editionnumber == 2)
then 772 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
773 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
774 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
775 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN 776 scalef1 = imiss; scalev1 = imiss
779 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
780 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
781 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
782 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN 783 scalef2 = imiss; scalev2 = imiss
788 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
794 call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
797 call init (this,level1,l1,level2,l2)
799 END SUBROUTINE level_import_gribapi
802 SUBROUTINE level_export_gribapi(this, gaid)
803 TYPE(vol7d_level),
INTENT(in) :: this
804 INTEGER,
INTENT(in) :: gaid
806 INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
809 CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
810 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
812 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
814 if (editionnumber == 1)
then 816 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
818 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
821 call grib_set(gaid,
'bottomLevel',l2)
822 call grib_set(gaid,
'topLevel',l1)
824 else if (editionnumber == 2)
then 826 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
827 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN 828 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
829 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
831 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
832 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
835 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
836 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN 837 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
838 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
840 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
841 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
846 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
851 END SUBROUTINE level_export_gribapi
854 SUBROUTINE timerange_import_gribapi(this, gaid)
855 TYPE(vol7d_timerange),
INTENT(out) :: this
856 INTEGER,
INTENT(in) :: gaid
858 INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
859 ttimeincr, tprocdata, status
861 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
863 IF (editionnumber == 1)
THEN 865 CALL grib_get(gaid,
'timeRangeIndicator',tri)
866 CALL grib_get(gaid,
'P1',p1g)
867 CALL grib_get(gaid,
'P2',p2g)
868 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
869 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
871 ELSE IF (editionnumber == 2)
THEN 873 CALL grib_get(gaid,
'forecastTime',p1g)
874 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
875 CALL g2_interval_to_second(unit, p1g, p1)
876 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
878 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN 879 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
880 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
881 CALL g2_interval_to_second(unit, p2g, p2)
884 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
885 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
886 IF (ttimeincr == 2 .AND. tprocdata /= 0)
THEN 890 CALL l4f_log(l4f_warn,
'Found p1>0 in grib2 analysis data, strange things may happen')
901 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
906 CALL init(this, statproc, p1, p2)
908 END SUBROUTINE timerange_import_gribapi
911 SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
912 TYPE(vol7d_timerange),
INTENT(in) :: this
913 INTEGER,
INTENT(in) :: gaid
914 TYPE(datetime) :: reftime
916 INTEGER :: EditionNumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
917 CHARACTER(len=8) :: env_var
918 LOGICAL :: g2cosmo_behavior
920 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
922 IF (editionnumber == 1 )
THEN 924 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
925 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
926 tri, p1_g1, p2_g1, unit)
928 CALL grib_set(gaid,
'timeRangeIndicator',tri)
929 CALL grib_set(gaid,
'P1',p1_g1)
930 CALL grib_set(gaid,
'P2',p2_g1)
931 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
933 ELSE IF (editionnumber == 2)
THEN 934 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
936 IF (this%timerange == 254)
THEN 937 IF (pdtn < 0 .OR. pdtn > 7) &
938 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
940 CALL timerange_v7d_to_g2(this%p1,p1,unit)
942 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
943 CALL grib_set(gaid,
'forecastTime',p1)
945 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN 947 IF (pdtn < 8 .OR. pdtn > 14) &
948 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
950 IF (this%p1 >= this%p2)
THEN 952 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
953 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
954 CALL grib_set(gaid,
'forecastTime',p1)
955 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
958 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
960 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
961 CALL timerange_v7d_to_g2(this%p2,p2,unit)
962 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
963 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
965 ELSE IF (this%p1 == 0)
THEN 967 CALL timerange_v7d_to_g2(this%p2,p2,unit)
968 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
969 CALL grib_set(gaid,
'forecastTime',0)
970 CALL code_endoftimeinterval(reftime)
973 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
975 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
976 g2cosmo_behavior = len_trim(env_var) > 0
977 IF (g2cosmo_behavior)
THEN 978 CALL grib_set(gaid,
'typeOfProcessedData',0)
980 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
982 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
983 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
986 IF (this%timerange >= 192)
THEN 987 CALL l4f_log(l4f_warn, &
988 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
992 CALL l4f_log(l4f_error, &
993 'Timerange with 0>p1>p2 cannot be exported in grib2')
994 CALL raise_fatal_error()
997 CALL l4f_log(l4f_error, &
998 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
999 CALL raise_fatal_error()
1003 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1004 CALL raise_fatal_error()
1011 SUBROUTINE code_endoftimeinterval(endtime)
1012 TYPE(datetime),
INTENT(in) :: endtime
1014 INTEGER :: year, month, day, hour, minute, msec
1016 CALL getval(endtime, year=year, month=month, day=day, &
1017 hour=hour, minute=minute, msec=msec)
1018 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
1019 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
1020 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
1021 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
1022 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
1023 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
1025 END SUBROUTINE code_endoftimeinterval
1027 END SUBROUTINE timerange_export_gribapi
1030 SUBROUTINE var_import_gribapi(this, gaid)
1031 TYPE(volgrid6d_var),
INTENT(out) :: this
1032 INTEGER,
INTENT(in) :: gaid
1034 INTEGER :: EditionNumber, centre, discipline, category, number
1036 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1038 if (editionnumber == 1)
then 1040 call grib_get(gaid,
'centre',centre)
1041 call grib_get(gaid,
'gribTablesVersionNo',category)
1042 call grib_get(gaid,
'indicatorOfParameter',number)
1044 call init(this, centre, category, number)
1046 else if (editionnumber == 2)
then 1048 call grib_get(gaid,
'centre',centre)
1049 call grib_get(gaid,
'discipline',discipline)
1050 call grib_get(gaid,
'parameterCategory',category)
1051 call grib_get(gaid,
'parameterNumber',number)
1053 call init(this, centre, category, number, discipline)
1057 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1062 END SUBROUTINE var_import_gribapi
1065 SUBROUTINE var_export_gribapi(this, gaid)
1066 TYPE(volgrid6d_var),
INTENT(in) :: this
1067 INTEGER,
INTENT(in) :: gaid
1069 INTEGER ::EditionNumber
1071 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1073 if (editionnumber == 1)
then 1075 IF (this%centre /= 255) &
1076 CALL grib_set(gaid,
'centre',this%centre)
1077 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1078 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1080 else if (editionnumber == 2)
then 1083 IF (this%centre /= 255) &
1084 CALL grib_set(gaid,
'centre',this%centre)
1085 CALL grib_set(gaid,
'discipline',this%discipline)
1086 CALL grib_set(gaid,
'parameterCategory',this%category)
1087 CALL grib_set(gaid,
'parameterNumber',this%number)
1091 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1096 END SUBROUTINE var_export_gribapi
1099 SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1100 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1101 integer,
intent(out) ::lt1,l1,lt2,l2
1104 CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1105 CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1109 SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1110 integer,
intent(in) :: ltype,scalef,scalev
1111 integer,
intent(out) :: lt,l
1113 doubleprecision :: sl
1116 IF (ltype == 255 .OR. ltype == -1)
THEN 1119 ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN 1124 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN 1125 sl = scalev*(10.d0**(-scalef))
1127 IF (any(ltype == height_level))
THEN 1128 l = nint(sl*1000.d0)
1129 ELSE IF (any(ltype == thermo_level))
THEN 1131 ELSE IF (any(ltype == sigma_level))
THEN 1132 l = nint(sl*10000.d0)
1141 END SUBROUTINE g2_to_dballe
1143 END SUBROUTINE level_g2_to_dballe
1146 SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1147 integer,
intent(in) :: lt1,l1,lt2,l2
1148 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1150 CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1151 CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1155 SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1156 INTEGER,
INTENT(in) :: lt,l
1157 INTEGER,
INTENT(out) :: ltype,scalef,scalev
1160 IF (lt == imiss)
THEN 1164 ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN 1168 ELSE IF (lt == 256 .AND. l == imiss)
THEN 1175 IF (any(ltype == height_level))
THEN 1177 ELSE IF (any(ltype == thermo_level))
THEN 1179 ELSE IF (any(ltype == sigma_level))
THEN 1204 END SUBROUTINE dballe_to_g2
1206 END SUBROUTINE level_dballe_to_g2
1209 SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1210 integer,
intent(in) :: ltype,l1,l2
1211 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1220 if (ltype > 0 .and. ltype <= 9)
then 1222 else if (ltype == 20)
then 1226 else if (ltype == 100)
then 1229 else if (ltype == 101)
then 1234 else if (ltype == 102)
then 1236 else if (ltype == 103)
then 1239 else if (ltype == 104)
then 1244 else if (ltype == 105)
then 1247 else if (ltype == 106)
then 1252 else if (ltype == 107)
then 1256 else if (ltype == 108)
then 1263 else if (ltype == 109)
then 1266 else if (ltype == 110)
then 1271 else if (ltype == 111)
then 1275 else if (ltype == 112)
then 1282 else if (ltype == 113)
then 1285 else if (ltype == 114)
then 1290 else if (ltype == 115)
then 1293 else if (ltype == 116)
then 1298 else if (ltype == 117)
then 1302 if ( btest(l1,15) )
then 1303 scalev1=-1*
mod(l1,32768)
1305 else if (ltype == 119)
then 1309 else if (ltype == 120)
then 1316 else if (ltype == 121)
then 1318 scalev1=(1100+l1)*100
1320 scalev2=(1100+l2)*100
1321 else if (ltype == 125)
then 1325 else if (ltype == 128)
then 1332 else if (ltype == 141)
then 1336 scalev2=(1100+l2)*100
1337 else if (ltype == 160)
then 1340 else if (ltype == 200)
then 1343 else if (ltype == 210)
then 1348 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1349 //
' cannot be converted to GRIB2.')
1353 END SUBROUTINE level_g1_to_g2
1356 SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1357 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1358 integer,
intent(out) :: ltype,l1,l2
1360 if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then 1364 else if (ltype1 == 20 .and. ltype2 == 255)
then 1366 l1 = rescale2(scalef1-2,scalev1)
1368 else if (ltype1 == 100 .and. ltype2 == 255)
then 1370 l1 = rescale2(scalef1+2,scalev1)
1372 else if (ltype1 == 100 .and. ltype2 == 100)
then 1374 l1 = rescale1(scalef1+3,scalev1)
1375 l2 = rescale1(scalef2+3,scalev2)
1376 else if (ltype1 == 101 .and. ltype2 == 255)
then 1380 else if (ltype1 == 102 .and. ltype2 == 255)
then 1382 l1 = rescale2(scalef1,scalev1)
1384 else if (ltype1 == 102 .and. ltype2 == 102)
then 1386 l1 = rescale1(scalef1+2,scalev1)
1387 l2 = rescale1(scalef2+2,scalev2)
1388 else if (ltype1 == 103 .and. ltype2 == 255)
then 1390 l1 = rescale2(scalef1,scalev1)
1392 else if (ltype1 == 103 .and. ltype2 == 103)
then 1394 l1 = rescale1(scalef1+2,scalev1)
1395 l2 = rescale1(scalef2+2,scalev2)
1396 else if (ltype1 == 104 .and. ltype2 == 255)
then 1398 l1 = rescale2(scalef1,scalev1-4)
1400 else if (ltype1 == 104 .and. ltype2 == 104)
then 1402 l1 = rescale1(scalef1-2,scalev1)
1403 l2 = rescale1(scalef2-2,scalev2)
1404 else if (ltype1 == 105 .and. ltype2 == 255)
then 1406 l1 = rescale2(scalef1,scalev1)
1408 else if (ltype1 == 105 .and. ltype2 == 105)
then 1410 l1 = rescale1(scalef1,scalev1)
1411 l2 = rescale1(scalef2,scalev2)
1412 else if (ltype1 == 106 .and. ltype2 == 255)
then 1414 l1 = rescale2(scalef1-2,scalev1)
1416 else if (ltype1 == 106 .and. ltype2 == 106)
then 1418 l1 = rescale1(scalef1-2,scalev1)
1419 l2 = rescale1(scalef2-2,scalev2)
1420 else if (ltype1 == 107 .and. ltype2 == 255)
then 1422 l1 = rescale2(scalef1,scalev1)
1424 else if (ltype1 == 107 .and. ltype2 == 107)
then 1426 l1 = rescale1(scalef1,scalev1)
1427 l2 = rescale1(scalef2,scalev2)
1428 else if (ltype1 == 108 .and. ltype2 == 255)
then 1430 l1 = rescale2(scalef1+2,scalev1)
1432 else if (ltype1 == 108 .and. ltype2 == 108)
then 1434 l1 = rescale1(scalef1+2,scalev1)
1435 l2 = rescale1(scalef2+2,scalev2)
1436 else if (ltype1 == 109 .and. ltype2 == 255)
then 1438 l1 = rescale2(scalef1+9,scalev1)
1440 else if (ltype1 == 111 .and. ltype2 == 255)
then 1442 l1 = rescale2(scalef1-2,scalev1)
1444 else if (ltype1 == 111 .and. ltype2 == 111)
then 1446 l1 = rescale1(scalef1-4,scalev1)
1447 l2 = rescale1(scalef2-4,scalev2)
1448 else if (ltype1 == 160 .and. ltype2 == 255)
then 1450 l1 = rescale2(scalef1,scalev1)
1452 else if (ltype1 == 1 .and. ltype2 == 8)
then 1454 else if (ltype1 == 1 .and. ltype2 == 9)
then 1461 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1462 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1468 FUNCTION rescale1(scalef, scalev)
RESULT(rescale)
1469 INTEGER,
INTENT(in) :: scalef, scalev
1472 rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1474 END FUNCTION rescale1
1476 FUNCTION rescale2(scalef, scalev)
RESULT(rescale)
1477 INTEGER,
INTENT(in) :: scalef, scalev
1480 rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1482 END FUNCTION rescale2
1484 END SUBROUTINE level_g2_to_g1
1495 SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1496 INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1497 INTEGER,
INTENT(out) :: statproc, p1, p2
1499 IF (tri == 0 .OR. tri == 1)
THEN 1501 CALL g1_interval_to_second(unit, p1_g1, p1)
1503 ELSE IF (tri == 10)
THEN 1505 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1507 ELSE IF (tri == 2)
THEN 1509 CALL g1_interval_to_second(unit, p2_g1, p1)
1510 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1511 ELSE IF (tri == 3)
THEN 1513 CALL g1_interval_to_second(unit, p2_g1, p1)
1514 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1515 ELSE IF (tri == 4)
THEN 1517 CALL g1_interval_to_second(unit, p2_g1, p1)
1518 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1519 ELSE IF (tri == 5)
THEN 1521 CALL g1_interval_to_second(unit, p2_g1, p1)
1522 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1523 ELSE IF (tri == 13)
THEN 1526 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1528 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1529 //
' cannot be converted to GRIB2.')
1533 if (statproc == 254 .and. p2 /= 0 )
then 1534 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1537 END SUBROUTINE timerange_g1_to_v7d
1558 SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1559 INTEGER,
INTENT(in) :: unit, valuein
1560 INTEGER,
INTENT(out) :: valueout
1562 INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1563 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1566 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1567 IF (
c_e(unitlist(unit)))
THEN 1568 valueout = valuein*unitlist(unit)
1572 END SUBROUTINE g1_interval_to_second
1575 SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1576 INTEGER,
INTENT(in) :: unit, valuein
1577 INTEGER,
INTENT(out) :: valueout
1579 INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1580 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1583 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1584 IF (
c_e(unitlist(unit)))
THEN 1585 valueout = valuein*unitlist(unit)
1589 END SUBROUTINE g2_interval_to_second
1603 SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1604 INTEGER,
INTENT(in) :: statproc, p1, p2
1605 INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1607 INTEGER :: ptmp, pdl
1610 IF (statproc == 254) pdl = p1
1612 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1613 IF (statproc == 0)
THEN 1615 ELSE IF (statproc == 1)
THEN 1617 ELSE IF (statproc == 4)
THEN 1619 ELSE IF (statproc == 205)
THEN 1621 ELSE IF (statproc == 257)
THEN 1628 ELSE IF (statproc == 254)
THEN 1632 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1633 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1637 IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN 1638 ptmp = max(p1_g1,p2_g1)
1639 p2_g1 =
mod(ptmp,256)
1642 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1643 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1653 p2_g1 = p2_g1 - ptmp
1657 END SUBROUTINE timerange_v7d_to_g1
1660 SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1661 INTEGER,
INTENT(in) :: valuein
1662 INTEGER,
INTENT(out) :: valueout, unit
1664 IF (valuein == imiss)
THEN 1667 ELSE IF (
mod(valuein,3600) == 0)
THEN 1668 valueout = valuein/3600
1670 ELSE IF (
mod(valuein,60) == 0)
THEN 1671 valueout = valuein/60
1678 END SUBROUTINE timerange_v7d_to_g2
1688 SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1689 INTEGER,
INTENT(in) :: valuein1, valuein2
1690 INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1695 INTEGER :: sectounit
1696 END TYPE unitchecker
1698 TYPE(unitchecker),
PARAMETER :: hunit(5) = (/ &
1699 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1700 unitchecker(12, 43200), unitchecker(2, 86400) /)
1701 TYPE(unitchecker),
PARAMETER :: munit(3) = (/ &
1702 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1705 IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN 1709 ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN 1710 DO i = 1,
SIZE(hunit)
1711 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1712 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1713 .AND. valuein1/hunit(i)%sectounit < 255 &
1714 .AND. valuein2/hunit(i)%sectounit < 255)
THEN 1715 valueout1 = valuein1/hunit(i)%sectounit
1716 valueout2 = valuein2/hunit(i)%sectounit
1717 unit = hunit(i)%unit
1721 IF (.NOT.
c_e(unit))
THEN 1723 DO i =
SIZE(hunit), 1, -1
1724 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1725 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN 1726 valueout1 = valuein1/hunit(i)%sectounit
1727 valueout2 = valuein2/hunit(i)%sectounit
1728 unit = hunit(i)%unit
1733 ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN 1734 DO i = 1,
SIZE(munit)
1735 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1736 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1737 .AND. valuein1/munit(i)%sectounit < 255 &
1738 .AND. valuein2/munit(i)%sectounit < 255)
THEN 1739 valueout1 = valuein1/munit(i)%sectounit
1740 valueout2 = valuein2/munit(i)%sectounit
1741 unit = munit(i)%unit
1745 IF (.NOT.
c_e(unit))
THEN 1747 DO i =
SIZE(munit), 1, -1
1748 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1749 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN 1750 valueout1 = valuein1/munit(i)%sectounit
1751 valueout2 = valuein2/munit(i)%sectounit
1752 unit = munit(i)%unit
1759 IF (.NOT.
c_e(unit))
THEN 1760 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1761 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1765 END SUBROUTINE timerange_choose_unit_g1
1781 SUBROUTINE normalize_gridinfo(this)
1782 TYPE(gridinfo_def),
intent(inout) :: this
1784 IF (this%timerange%timerange == 254)
THEN 1787 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1793 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1798 ELSE IF (this%timerange%timerange == 205)
THEN 1801 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1803 this%timerange%timerange=3
1808 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1810 this%timerange%timerange=2
1815 IF (this%var%discipline == 255 .AND. &
1816 any(this%var%centre == cosmo_centre))
THEN 1818 IF (this%var%category == 201)
THEN 1820 IF (this%var%number == 187)
THEN 1823 this%timerange%timerange=2
1828 ELSE IF (this%timerange%timerange == 257)
THEN 1830 IF (this%timerange%p2 == 0)
THEN 1832 this%timerange%timerange=254
1836 IF (this%var%discipline == 255 .AND. &
1837 any(this%var%centre == cosmo_centre))
THEN 1839 IF (this%var%category >= 1 .AND. this%var%category <= 3)
THEN 1841 if (this%var%number == 11)
then 1842 this%timerange%timerange=0
1844 else if (this%var%number == 15)
then 1845 this%timerange%timerange=2
1848 else if (this%var%number == 16)
then 1849 this%timerange%timerange=3
1852 else if (this%var%number == 17)
then 1853 this%timerange%timerange=0
1855 else if (this%var%number == 33)
then 1856 this%timerange%timerange=0
1858 else if (this%var%number == 34)
then 1859 this%timerange%timerange=0
1861 else if (this%var%number == 57)
then 1862 this%timerange%timerange=1
1864 else if (this%var%number == 61)
then 1865 this%timerange%timerange=1
1867 else if (this%var%number == 78)
then 1868 this%timerange%timerange=1
1870 else if (this%var%number == 79)
then 1871 this%timerange%timerange=1
1873 else if (this%var%number == 90)
then 1874 this%timerange%timerange=1
1876 else if (this%var%number == 111)
then 1877 this%timerange%timerange=0
1878 else if (this%var%number == 112)
then 1879 this%timerange%timerange=0
1880 else if (this%var%number == 113)
then 1881 this%timerange%timerange=0
1882 else if (this%var%number == 114)
then 1883 this%timerange%timerange=0
1884 else if (this%var%number == 121)
then 1885 this%timerange%timerange=0
1886 else if (this%var%number == 122)
then 1887 this%timerange%timerange=0
1888 else if (this%var%number == 124)
then 1889 this%timerange%timerange=0
1890 else if (this%var%number == 125)
then 1891 this%timerange%timerange=0
1892 else if (this%var%number == 126)
then 1893 this%timerange%timerange=0
1894 else if (this%var%number == 127)
then 1895 this%timerange%timerange=0
1899 ELSE IF (this%var%category == 201)
THEN 1901 if (this%var%number == 5)
then 1902 this%timerange%timerange=0
1904 else if (this%var%number == 20)
then 1905 this%timerange%timerange=1
1907 else if (this%var%number == 22)
then 1908 this%timerange%timerange=0
1909 else if (this%var%number == 23)
then 1910 this%timerange%timerange=0
1911 else if (this%var%number == 24)
then 1912 this%timerange%timerange=0
1913 else if (this%var%number == 25)
then 1914 this%timerange%timerange=0
1915 else if (this%var%number == 26)
then 1916 this%timerange%timerange=0
1917 else if (this%var%number == 27)
then 1918 this%timerange%timerange=0
1920 else if (this%var%number == 42)
then 1921 this%timerange%timerange=1
1923 else if (this%var%number == 102)
then 1924 this%timerange%timerange=1
1926 else if (this%var%number == 113)
then 1927 this%timerange%timerange=1
1929 else if (this%var%number == 132)
then 1930 this%timerange%timerange=1
1932 else if (this%var%number == 135)
then 1933 this%timerange%timerange=1
1935 else if (this%var%number == 187)
then 1938 this%timerange%timerange=2
1940 else if (this%var%number == 218)
then 1941 this%timerange%timerange=2
1943 else if (this%var%number == 219)
then 1944 this%timerange%timerange=2
1948 ELSE IF (this%var%category == 202)
THEN 1950 if (this%var%number == 231)
then 1951 this%timerange%timerange=0
1952 else if (this%var%number == 232)
then 1953 this%timerange%timerange=0
1954 else if (this%var%number == 233)
then 1955 this%timerange%timerange=0
1961 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1962 trim(
to_char(this%timerange%p2)))
1964 'associated to an apparently instantaneous parameter '//&
1965 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1966 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1969 this%timerange%p2 = 0
1970 this%timerange%timerange = 254
1977 IF (this%var%discipline == 255 .AND. &
1978 any(this%var%centre == ecmwf_centre))
THEN 1983 IF (this%var%category == 128)
THEN 1985 IF ((this%var%number == 142 .OR. &
1986 this%var%number == 143 .OR. &
1987 this%var%number == 144 .OR. &
1988 this%var%number == 228 .OR. &
1989 this%var%number == 145 .OR. &
1990 this%var%number == 146 .OR. &
1991 this%var%number == 147 .OR. &
1992 this%var%number == 169) .AND. &
1993 this%timerange%timerange == 254)
THEN 1994 this%timerange%timerange = 1
1995 this%timerange%p2 = this%timerange%p1
1997 ELSE IF ((this%var%number == 165 .OR. &
1998 this%var%number == 166) .AND. &
1999 this%level%level1 == 1)
THEN 2000 this%level%level1 = 103
2001 this%level%l1 = 10000
2003 ELSE IF ((this%var%number == 167 .OR. &
2004 this%var%number == 168) .AND. &
2005 this%level%level1 == 1)
THEN 2006 this%level%level1 = 103
2007 this%level%l1 = 2000
2009 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN 2010 this%level%level1 = 106
2014 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN 2015 this%level%level1 = 106
2019 ELSE IF (this%var%number == 171)
THEN 2020 this%level%level1 = 106
2024 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN 2025 this%level%level1 = 106
2027 this%level%l2 = 1000
2029 ELSE IF (this%var%number == 184)
THEN 2030 this%level%level1 = 106
2032 this%level%l2 = 1000
2034 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN 2035 this%level%level1 = 106
2036 this%level%l1 = 1000
2037 this%level%l2 = 2890
2039 ELSE IF (this%var%number == 121 .AND. &
2040 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2041 this%timerange%timerange = 2
2042 this%timerange%p2 = 21600
2044 this%level%level1 = 103
2045 this%level%l1 = 2000
2047 ELSE IF (this%var%number == 122 .AND. &
2048 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2049 this%timerange%timerange = 3
2050 this%timerange%p2 = 21600
2053 this%level%level1 = 103
2054 this%level%l1 = 2000
2056 ELSE IF (this%var%number == 123 .AND. &
2057 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2058 this%timerange%timerange = 2
2059 this%timerange%p2 = 21600
2060 this%level%level1 = 103
2061 this%level%l1 = 10000
2064 ELSE IF (this%var%number == 186)
THEN 2065 this%var%number = 248
2066 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2067 ELSE IF (this%var%number == 187)
THEN 2068 this%var%number = 248
2069 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2070 ELSE IF (this%var%number == 188)
THEN 2071 this%var%number = 248
2072 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2075 ELSE IF (this%var%category == 228)
THEN 2077 IF (this%var%number == 24)
THEN 2078 this%level%level1 = 4
2080 this%level%level2 = 255
2083 ELSE IF (this%var%number == 26 .AND. &
2084 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2085 this%timerange%timerange = 2
2086 this%timerange%p2 = 10800
2087 this%var%category = 128
2089 this%level%level1 = 103
2090 this%level%l1 = 2000
2092 ELSE IF (this%var%number == 27 .AND. &
2093 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2094 this%timerange%timerange = 3
2095 this%timerange%p2 = 10800
2096 this%var%category = 128
2098 this%level%level1 = 103
2099 this%level%l1 = 2000
2101 ELSE IF (this%var%number == 28 .AND. &
2102 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2103 this%timerange%timerange = 2
2104 this%timerange%p2 = 10800
2105 this%level%level1 = 103
2106 this%level%l1 = 10000
2113 IF (this%var%discipline == 255 .AND. &
2114 this%var%category >= 1 .AND. this%var%category <= 3)
THEN 2117 IF (this%var%number == 73)
THEN 2118 this%var%number = 71
2119 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2120 ELSE IF (this%var%number == 74)
THEN 2121 this%var%number = 71
2122 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2123 ELSE IF (this%var%number == 75)
THEN 2124 this%var%number = 71
2125 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2132 END SUBROUTINE normalize_gridinfo
2143 SUBROUTINE unnormalize_gridinfo(this)
2144 TYPE(gridinfo_def),
intent(inout) :: this
2146 IF (this%timerange%timerange == 3)
THEN 2148 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2150 this%timerange%timerange=205
2152 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2153 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2155 this%timerange%timerange=205
2159 ELSE IF (this%timerange%timerange == 2)
THEN 2161 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2163 this%timerange%timerange=205
2165 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2166 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2168 this%timerange%timerange=205
2170 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN 2171 this%timerange%timerange=205
2173 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN 2174 this%timerange%timerange=205
2177 ELSE IF (any(this%var%centre == cosmo_centre))
THEN 2186 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN 2187 this%timerange%timerange=205
2193 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN 2194 IF (this%var%number == 71 .AND. &
2195 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2196 IF (this%level%l2 == 1)
THEN 2197 this%var%number = 73
2198 ELSE IF (this%level%l2 == 2)
THEN 2199 this%var%number = 74
2200 ELSE IF (this%level%l2 == 3)
THEN 2201 this%var%number = 75
2203 this%level = vol7d_level_new(level1=1)
2207 IF (any(this%var%centre == ecmwf_centre))
THEN 2209 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN 2210 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2211 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2212 IF (this%level%l2 == 1)
THEN 2213 this%var%number = 186
2214 ELSE IF (this%level%l2 == 2)
THEN 2215 this%var%number = 187
2216 ELSE IF (this%level%l2 == 3)
THEN 2217 this%var%number = 188
2219 this%level = vol7d_level_new(level1=1)
2224 END SUBROUTINE unnormalize_gridinfo
2233 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2234 TYPE(gridinfo_def),
INTENT(inout) :: this
2235 TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2237 TYPE(gdaldataseth) :: hds
2241 this%time = datetime_new(year=2010, month=1, day=1)
2244 this%timerange = vol7d_timerange_new(254, 0, 0)
2247 hds = gdalgetbanddataset(gdalid)
2248 IF (gdalgetrastercount(hds) == 1)
THEN 2249 this%level = vol7d_level_new(1, 0)
2251 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2255 this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2257 END SUBROUTINE gridinfo_import_gdal
Export gridinfo descriptors information into a grid_id object.
Derived type defining a dynamically extensible array of TYPE(gridinfo_def) elements.
Functions that return a trimmed CHARACTER representation of the input variable.
Derived type associated to a block/message/record/band of gridded data coming from a file-like object...
Method for removing elements of the array at a desired position.
Class for expressing an absolute time value.
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
Derived type associated to a file-like object containing many blocks/messages/records/bands of gridde...
This module defines an abstract interface to different drivers for access to files containing gridded...
Module for describing geographically referenced regular grids.
Decode and return the data array from a grid_id object associated to a gridinfo object.
Encode a data array into a grid_id object associated to a gridinfo object.
Import information from a file or grid_id object into the gridinfo descriptors.
Classi per la gestione delle coordinate temporali.
Destructor, it releases every information associated with the object.
Definisce l'intervallo temporale di un'osservazione meteo.
Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
Quick method to append an element to the array.
Restituiscono il valore dell'oggetto in forma di stringa stampabile.
Restituiscono il valore dell'oggetto nella forma desiderata.
Operatore di resto della divisione.
Class for managing information about a single gridded georeferenced field, typically imported from an...
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. ...
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Object describing a single gridded message/band.
Display on standard output a description of the gridinfo object provided.
Clone the object, creating a new independent instance of the object exactly equal to the starting one...
Constructor, it creates a new instance of the object.
classe per la gestione del logging
Class for managing physical variables in a grib 1/2 fashion.
Copy an object, creating a fully new instance.
Method for inserting elements of the array at a desired position.
Class defining a real conversion function between units.
Apply the conversion function this to values.
Emit log message for a category with specific priority.