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')
389 input_grid = grid_id_new(input_file)
390 IF (.NOT.
c_e(input_grid))
EXIT 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)))
402 CALL insert(this, gridinfol)
409 "gridinfo_import, "//
t2c(ngrid)//
" messages/bands imported from file "// &
415 CALL l4f_category_delete(category)
417 END SUBROUTINE gridinfo_import_from_file
426 SUBROUTINE gridinfo_export(this)
427 TYPE(gridinfo_def),
INTENT(inout) :: this
429 #ifdef HAVE_LIBGRIBAPI 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 452 CALL l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
456 END SUBROUTINE gridinfo_export
464 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
466 CHARACTER(len=*),
INTENT(in) :: filename
467 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
469 INTEGER :: i, category
470 CHARACTER(len=512) :: a_name
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)
484 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
487 valid_grid_id = grid_id_new()
488 DO i = 1, this%arraysize
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 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))
501 CALL export(this%array(i)%gaid, output_file)
511 "gridinfo object of size "//
t2c(this%arraysize))
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
531 FUNCTION gridinfo_decode_data(this)
RESULT(field)
533 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
535 CALL grid_id_decode_data(this%gaid, field)
537 END FUNCTION gridinfo_decode_data
547 SUBROUTINE gridinfo_encode_data(this, field)
549 REAL,
intent(in) :: field(:,:)
551 IF (
SIZE(field,1) /= this%griddim%dim%nx &
552 .OR.
SIZE(field,2) /= this%griddim%dim%ny)
THEN 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
570 #ifdef HAVE_LIBGRIBAPI 571 SUBROUTINE gridinfo_import_gribapi(this, gaid)
573 INTEGER,
INTENT(in) :: gaid
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)
588 INTEGER,
INTENT(in) :: gaid
591 REAL,
ALLOCATABLE :: tmparr(:,:)
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 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)
618 INTEGER,
INTENT(in) :: gaid
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 IF (editionnumber == 1 .OR. 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
640 IF (status == grib_success .AND. ttimeincr == 1)
THEN 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 ELSE IF (status == grib_success .AND. ttimeincr == 2 .AND. tprocdata == 0)
THEN 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 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
658 status /= grib_success)
THEN 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)
678 INTEGER,
INTENT(in) :: gaid
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 694 CALL code_referencetime(this)
695 ELSE IF (timerange%p1 == 0)
THEN 697 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
698 g2cosmo_behavior = len_trim(env_var) > 0
699 CALL grib_get(gaid,
'centre',centre)
700 IF (g2cosmo_behavior .AND. centre == 78)
THEN 701 CALL code_referencetime(this)
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
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
739 INTEGER,
INTENT(in) :: gaid
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 IF (scalef1 == -1 .OR. 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 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN 767 scalef2 = imiss; scalev2 = imiss
772 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
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
788 INTEGER,
INTENT(in) :: gaid
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)
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 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN 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 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN 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
840 INTEGER,
INTENT(in) :: gaid
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 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN 863 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
864 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
865 CALL g2_interval_to_second(unit, p2g, p2)
868 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
869 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
870 IF (ttimeincr == 2 .AND. 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
897 INTEGER,
INTENT(in) :: gaid
898 TYPE(datetime) :: reftime
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 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)
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 921 IF (pdtn < 0 .OR. pdtn > 7) &
922 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
924 CALL timerange_v7d_to_g2(this%p1,p1,unit)
926 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
927 CALL grib_set(gaid,
'forecastTime',p1)
929 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN 931 IF (pdtn < 8 .OR. pdtn > 14) &
932 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
934 IF (this%p1 >= this%p2)
THEN 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))
942 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
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 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)
957 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
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)
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()
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
1016 INTEGER,
INTENT(in) :: gaid
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
1051 INTEGER,
INTENT(in) :: gaid
1053 INTEGER ::EditionNumber
1055 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1057 if (editionnumber == 1)
then 1059 IF (this%centre /= 255) &
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 1067 IF (this%centre /= 255) &
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 IF (ltype == 255 .OR. ltype == -1)
THEN 1103 ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN 1108 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN 1109 sl = scalev*(10.d0**(-scalef))
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 ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN 1152 ELSE IF (lt == 256 .AND. l == imiss)
THEN 1159 IF (any(ltype == height_level))
THEN 1161 ELSE IF (any(ltype == thermo_level))
THEN 1163 ELSE IF (any(ltype == sigma_level))
THEN 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 if (ltype > 0 .and. 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 1327 else if (ltype == 210)
then 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 if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then 1348 else if (ltype1 == 20 .and. ltype2 == 255)
then 1350 l1 = rescale2(scalef1-2,scalev1)
1352 else if (ltype1 == 100 .and. ltype2 == 255)
then 1354 l1 = rescale2(scalef1+2,scalev1)
1356 else if (ltype1 == 100 .and. ltype2 == 100)
then 1358 l1 = rescale1(scalef1+3,scalev1)
1359 l2 = rescale1(scalef2+3,scalev2)
1360 else if (ltype1 == 101 .and. ltype2 == 255)
then 1364 else if (ltype1 == 102 .and. ltype2 == 255)
then 1366 l1 = rescale2(scalef1,scalev1)
1368 else if (ltype1 == 102 .and. ltype2 == 102)
then 1370 l1 = rescale1(scalef1+2,scalev1)
1371 l2 = rescale1(scalef2+2,scalev2)
1372 else if (ltype1 == 103 .and. ltype2 == 255)
then 1374 l1 = rescale2(scalef1,scalev1)
1376 else if (ltype1 == 103 .and. ltype2 == 103)
then 1378 l1 = rescale1(scalef1+2,scalev1)
1379 l2 = rescale1(scalef2+2,scalev2)
1380 else if (ltype1 == 104 .and. ltype2 == 255)
then 1382 l1 = rescale2(scalef1,scalev1-4)
1384 else if (ltype1 == 104 .and. ltype2 == 104)
then 1386 l1 = rescale1(scalef1-2,scalev1)
1387 l2 = rescale1(scalef2-2,scalev2)
1388 else if (ltype1 == 105 .and. ltype2 == 255)
then 1390 l1 = rescale2(scalef1,scalev1)
1392 else if (ltype1 == 105 .and. ltype2 == 105)
then 1394 l1 = rescale1(scalef1,scalev1)
1395 l2 = rescale1(scalef2,scalev2)
1396 else if (ltype1 == 106 .and. ltype2 == 255)
then 1398 l1 = rescale2(scalef1-2,scalev1)
1400 else if (ltype1 == 106 .and. ltype2 == 106)
then 1402 l1 = rescale1(scalef1-2,scalev1)
1403 l2 = rescale1(scalef2-2,scalev2)
1404 else if (ltype1 == 107 .and. ltype2 == 255)
then 1406 l1 = rescale2(scalef1,scalev1)
1408 else if (ltype1 == 107 .and. ltype2 == 107)
then 1410 l1 = rescale1(scalef1,scalev1)
1411 l2 = rescale1(scalef2,scalev2)
1412 else if (ltype1 == 108 .and. ltype2 == 255)
then 1414 l1 = rescale2(scalef1+2,scalev1)
1416 else if (ltype1 == 108 .and. ltype2 == 108)
then 1418 l1 = rescale1(scalef1+2,scalev1)
1419 l2 = rescale1(scalef2+2,scalev2)
1420 else if (ltype1 == 109 .and. ltype2 == 255)
then 1422 l1 = rescale2(scalef1+9,scalev1)
1424 else if (ltype1 == 111 .and. ltype2 == 255)
then 1426 l1 = rescale2(scalef1-2,scalev1)
1428 else if (ltype1 == 111 .and. ltype2 == 111)
then 1430 l1 = rescale1(scalef1-4,scalev1)
1431 l2 = rescale1(scalef2-4,scalev2)
1432 else if (ltype1 == 160 .and. ltype2 == 255)
then 1434 l1 = rescale2(scalef1,scalev1)
1436 else if (ltype1 == 1 .and. ltype2 == 8)
then 1438 else if (ltype1 == 1 .and. ltype2 == 9)
then 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
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 IF (tri == 0 .OR. tri == 1)
THEN 1485 CALL g1_interval_to_second(unit, p1_g1, p1)
1487 ELSE IF (tri == 10)
THEN 1489 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1491 ELSE IF (tri == 2)
THEN 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 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 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 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 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 if (statproc == 254 .and. 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
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 IF (unit >= lbound(unitlist,1) .AND. 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 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1568 IF (
c_e(unitlist(unit)))
THEN 1569 valueout = valuein*unitlist(unit)
1573 END SUBROUTINE g2_interval_to_second
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
1596 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1597 IF (statproc == 0)
THEN 1599 ELSE IF (statproc == 1)
THEN 1601 ELSE IF (statproc == 4)
THEN 1603 ELSE IF (statproc == 205)
THEN 1605 ELSE IF (statproc == 257)
THEN 1612 ELSE IF (statproc == 254)
THEN 1616 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1617 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1621 IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN 1622 ptmp = max(p1_g1,p2_g1)
1623 p2_g1 =
mod(ptmp,256)
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.')
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 1652 valueout = valuein/3600
1654 ELSE IF (
mod(valuein,60) == 0)
THEN 1655 valueout = valuein/60
1662 END SUBROUTINE timerange_v7d_to_g2
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) = (/ &
1686 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1689 IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN 1693 ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN 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 IF (.NOT.
c_e(unit))
THEN 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 ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN 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 IF (.NOT.
c_e(unit))
THEN 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 IF (.NOT.
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
1765 SUBROUTINE normalize_gridinfo(this)
1766 TYPE(gridinfo_def),
intent(inout) :: this
1768 IF (this%timerange%timerange == 254)
THEN 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 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
1799 IF (this%var%discipline == 255 .AND. &
1800 any(this%var%centre == cosmo_centre))
THEN 1802 IF (this%var%category == 201)
THEN 1804 IF (this%var%number == 187)
THEN 1807 this%timerange%timerange=2
1812 ELSE IF (this%timerange%timerange == 257)
THEN 1814 IF (this%timerange%p2 == 0)
THEN 1816 this%timerange%timerange=254
1820 IF (this%var%discipline == 255 .AND. &
1821 any(this%var%centre == cosmo_centre))
THEN 1823 IF (this%var%category >= 1 .AND. this%var%category <= 3)
THEN 1825 if (this%var%number == 11)
then 1826 this%timerange%timerange=0
1828 else if (this%var%number == 15)
then 1829 this%timerange%timerange=2
1832 else if (this%var%number == 16)
then 1833 this%timerange%timerange=3
1836 else if (this%var%number == 17)
then 1837 this%timerange%timerange=0
1839 else if (this%var%number == 33)
then 1840 this%timerange%timerange=0
1842 else if (this%var%number == 34)
then 1843 this%timerange%timerange=0
1845 else if (this%var%number == 57)
then 1846 this%timerange%timerange=1
1848 else if (this%var%number == 61)
then 1849 this%timerange%timerange=1
1851 else if (this%var%number == 78)
then 1852 this%timerange%timerange=1
1854 else if (this%var%number == 79)
then 1855 this%timerange%timerange=1
1857 else if (this%var%number == 90)
then 1858 this%timerange%timerange=1
1860 else if (this%var%number == 111)
then 1861 this%timerange%timerange=0
1862 else if (this%var%number == 112)
then 1863 this%timerange%timerange=0
1864 else if (this%var%number == 113)
then 1865 this%timerange%timerange=0
1866 else if (this%var%number == 114)
then 1867 this%timerange%timerange=0
1868 else if (this%var%number == 121)
then 1869 this%timerange%timerange=0
1870 else if (this%var%number == 122)
then 1871 this%timerange%timerange=0
1872 else if (this%var%number == 124)
then 1873 this%timerange%timerange=0
1874 else if (this%var%number == 125)
then 1875 this%timerange%timerange=0
1876 else if (this%var%number == 126)
then 1877 this%timerange%timerange=0
1878 else if (this%var%number == 127)
then 1879 this%timerange%timerange=0
1883 ELSE IF (this%var%category == 201)
THEN 1885 if (this%var%number == 5)
then 1886 this%timerange%timerange=0
1888 else if (this%var%number == 20)
then 1889 this%timerange%timerange=1
1891 else if (this%var%number == 22)
then 1892 this%timerange%timerange=0
1893 else if (this%var%number == 23)
then 1894 this%timerange%timerange=0
1895 else if (this%var%number == 24)
then 1896 this%timerange%timerange=0
1897 else if (this%var%number == 25)
then 1898 this%timerange%timerange=0
1899 else if (this%var%number == 26)
then 1900 this%timerange%timerange=0
1901 else if (this%var%number == 27)
then 1902 this%timerange%timerange=0
1904 else if (this%var%number == 42)
then 1905 this%timerange%timerange=1
1907 else if (this%var%number == 102)
then 1908 this%timerange%timerange=1
1910 else if (this%var%number == 113)
then 1911 this%timerange%timerange=1
1913 else if (this%var%number == 132)
then 1914 this%timerange%timerange=1
1916 else if (this%var%number == 135)
then 1917 this%timerange%timerange=1
1919 else if (this%var%number == 187)
then 1922 this%timerange%timerange=2
1924 else if (this%var%number == 218)
then 1925 this%timerange%timerange=2
1927 else if (this%var%number == 219)
then 1928 this%timerange%timerange=2
1932 ELSE IF (this%var%category == 202)
THEN 1934 if (this%var%number == 231)
then 1935 this%timerange%timerange=0
1936 else if (this%var%number == 232)
then 1937 this%timerange%timerange=0
1938 else if (this%var%number == 233)
then 1939 this%timerange%timerange=0
1945 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1946 trim(
to_char(this%timerange%p2)))
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)))
1953 this%timerange%p2 = 0
1954 this%timerange%timerange = 254
1961 IF (this%var%discipline == 255 .AND. &
1962 any(this%var%centre == ecmwf_centre))
THEN 1967 IF (this%var%category == 128)
THEN 1969 IF ((this%var%number == 142 .OR. &
1970 this%var%number == 143 .OR. &
1971 this%var%number == 144 .OR. &
1972 this%var%number == 228 .OR. &
1973 this%var%number == 145 .OR. &
1974 this%var%number == 146 .OR. &
1975 this%var%number == 147 .OR. &
1976 this%var%number == 169) .AND. &
1977 this%timerange%timerange == 254)
THEN 1978 this%timerange%timerange = 1
1979 this%timerange%p2 = this%timerange%p1
1981 ELSE IF ((this%var%number == 165 .OR. &
1982 this%var%number == 166) .AND. &
1983 this%level%level1 == 1)
THEN 1984 this%level%level1 = 103
1985 this%level%l1 = 10000
1987 ELSE IF ((this%var%number == 167 .OR. &
1988 this%var%number == 168) .AND. &
1989 this%level%level1 == 1)
THEN 1990 this%level%level1 = 103
1991 this%level%l1 = 2000
1993 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN 1994 this%level%level1 = 106
1998 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN 1999 this%level%level1 = 106
2003 ELSE IF (this%var%number == 171)
THEN 2004 this%level%level1 = 106
2008 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN 2009 this%level%level1 = 106
2011 this%level%l2 = 1000
2013 ELSE IF (this%var%number == 184)
THEN 2014 this%level%level1 = 106
2016 this%level%l2 = 1000
2018 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN 2019 this%level%level1 = 106
2020 this%level%l1 = 1000
2021 this%level%l2 = 2890
2023 ELSE IF (this%var%number == 121 .AND. &
2024 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2025 this%timerange%timerange = 2
2026 this%timerange%p2 = 21600
2028 this%level%level1 = 103
2029 this%level%l1 = 2000
2031 ELSE IF (this%var%number == 122 .AND. &
2032 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2033 this%timerange%timerange = 3
2034 this%timerange%p2 = 21600
2037 this%level%level1 = 103
2038 this%level%l1 = 2000
2040 ELSE IF (this%var%number == 123 .AND. &
2041 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2042 this%timerange%timerange = 2
2043 this%timerange%p2 = 21600
2044 this%level%level1 = 103
2045 this%level%l1 = 10000
2048 ELSE IF (this%var%number == 186)
THEN 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 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 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 2061 IF (this%var%number == 24)
THEN 2062 this%level%level1 = 4
2064 this%level%level2 = 255
2067 ELSE IF (this%var%number == 26 .AND. &
2068 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2069 this%timerange%timerange = 2
2070 this%timerange%p2 = 10800
2071 this%var%category = 128
2073 this%level%level1 = 103
2074 this%level%l1 = 2000
2076 ELSE IF (this%var%number == 27 .AND. &
2077 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2078 this%timerange%timerange = 3
2079 this%timerange%p2 = 10800
2080 this%var%category = 128
2082 this%level%level1 = 103
2083 this%level%l1 = 2000
2085 ELSE IF (this%var%number == 28 .AND. &
2086 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2087 this%timerange%timerange = 2
2088 this%timerange%p2 = 10800
2089 this%level%level1 = 103
2090 this%level%l1 = 10000
2097 IF (this%var%discipline == 255 .AND. &
2098 this%var%category >= 1 .AND. this%var%category <= 3)
THEN 2101 IF (this%var%number == 73)
THEN 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 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 2108 this%var%number = 71
2109 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2116 END SUBROUTINE normalize_gridinfo
2127 SUBROUTINE unnormalize_gridinfo(this)
2128 TYPE(gridinfo_def),
intent(inout) :: this
2130 IF (this%timerange%timerange == 3)
THEN 2132 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2134 this%timerange%timerange=205
2136 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2137 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2139 this%timerange%timerange=205
2143 ELSE IF (this%timerange%timerange == 2)
THEN 2145 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2147 this%timerange%timerange=205
2149 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2150 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2152 this%timerange%timerange=205
2154 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN 2155 this%timerange%timerange=205
2157 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN 2158 this%timerange%timerange=205
2161 ELSE IF (any(this%var%centre == cosmo_centre))
THEN 2170 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN 2171 this%timerange%timerange=205
2177 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN 2178 IF (this%var%number == 71 .AND. &
2179 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2180 IF (this%level%l2 == 1)
THEN 2181 this%var%number = 73
2182 ELSE IF (this%level%l2 == 2)
THEN 2183 this%var%number = 74
2184 ELSE IF (this%level%l2 == 3)
THEN 2185 this%var%number = 75
2187 this%level = vol7d_level_new(level1=1)
2191 IF (any(this%var%centre == ecmwf_centre))
THEN 2193 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN 2194 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2195 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2196 IF (this%level%l2 == 1)
THEN 2197 this%var%number = 186
2198 ELSE IF (this%level%l2 == 2)
THEN 2199 this%var%number = 187
2200 ELSE IF (this%level%l2 == 3)
THEN 2201 this%var%number = 188
2203 this%level = vol7d_level_new(level1=1)
2208 END SUBROUTINE unnormalize_gridinfo
2217 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2218 TYPE(gridinfo_def),
INTENT(inout) :: this
2219 TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2221 TYPE(gdaldataseth) :: hds
2225 this%time = datetime_new(year=2010, month=1, day=1)
2228 this%timerange = vol7d_timerange_new(254, 0, 0)
2231 hds = gdalgetbanddataset(gdalid)
2232 IF (gdalgetrastercount(hds) == 1)
THEN 2233 this%level = vol7d_level_new(1, 0)
2235 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2239 this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2241 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.