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 TYPE(l4f_handle) :: category
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_handle(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
369 TYPE(l4f_handle) :: category
370 CHARACTER(len=512) :: a_name
371 TYPE(grid_file_id) :: input_file
374 IF (
PRESENT(categoryappend))
THEN 375 CALL l4f_launcher(a_name,a_name_append= &
376 trim(subcategory)//
"."//trim(categoryappend))
378 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
380 category=l4f_category_get_handle(a_name)
386 input_file = grid_file_id_new(filename,
'r')
392 input_grid = grid_id_new(input_file)
393 IF (.NOT.
c_e(input_grid))
EXIT 398 IF (
PRESENT(categoryappend))
THEN 399 CALL init(gridinfol, gaid=input_grid, &
400 categoryappend=trim(categoryappend)//
"-msg"//trim(
to_char(ngrid)))
402 CALL init(gridinfol, gaid=input_grid, &
403 categoryappend=
"msg"//trim(
to_char(ngrid)))
407 CALL insert(this, gridinfol)
418 "gridinfo_import, "//
t2c(ngrid)//
" messages/bands imported from file "// &
424 CALL l4f_category_delete(category)
426 END SUBROUTINE gridinfo_import_from_file
435 SUBROUTINE gridinfo_export(this)
436 TYPE(gridinfo_def),
INTENT(inout) :: this
438 #ifdef HAVE_LIBGRIBAPI 450 CALL export(this%griddim, this%gaid)
452 #ifdef HAVE_LIBGRIBAPI 453 IF (grid_id_get_driver(this%gaid) ==
'grib_api')
THEN 454 gaid = grid_id_get_gaid(this%gaid)
455 IF (
c_e(gaid))
CALL gridinfo_export_gribapi(this, gaid)
459 IF (grid_id_get_driver(this%gaid) ==
'gdal')
THEN 461 CALL l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
465 END SUBROUTINE gridinfo_export
473 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
475 CHARACTER(len=*),
INTENT(in) :: filename
476 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
480 CHARACTER(len=512) :: a_name
484 IF (
PRESENT(categoryappend))
THEN 485 CALL l4f_launcher(a_name,a_name_append= &
486 trim(subcategory)//
"."//trim(categoryappend))
488 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
490 category=l4f_category_get_handle(a_name)
494 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
497 valid_grid_id = grid_id_new()
498 DO i = 1, this%arraysize
499 IF (
c_e(this%array(i)%gaid))
THEN 500 valid_grid_id = this%array(i)%gaid
505 IF (
c_e(valid_grid_id))
THEN 507 output_file = grid_file_id_new(filename,
'w', from_grid_id=valid_grid_id)
508 IF (
c_e(output_file))
THEN 511 DO i = 1, this%arraysize
513 CALL export(this%array(i))
515 CALL export(this%array(i)%gaid, output_file)
529 "gridinfo object of size "//
t2c(this%arraysize))
531 "no valid grid id found when exporting to file "//trim(filename))
536 CALL l4f_category_delete(category)
538 END SUBROUTINE gridinfo_export_to_file
549 FUNCTION gridinfo_decode_data(this)
RESULT(field)
551 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
553 CALL grid_id_decode_data(this%gaid, field)
555 END FUNCTION gridinfo_decode_data
565 SUBROUTINE gridinfo_encode_data(this, field)
567 REAL,
intent(in) :: field(:,:)
569 IF (
SIZE(field,1) /= this%griddim%dim%nx &
570 .OR.
SIZE(field,2) /= this%griddim%dim%ny)
THEN 572 'gridinfo_encode: field and gridinfo object non conformal, field: ' &
573 //trim(
to_char(
SIZE(field,1)))//
'X'//trim(
to_char(
SIZE(field,2)))//
', nx,ny:' &
574 //trim(
to_char(this%griddim%dim%nx))//
'X'//trim(
to_char(this%griddim%dim%ny)))
579 CALL grid_id_encode_data(this%gaid, field)
581 END SUBROUTINE gridinfo_encode_data
588 #ifdef HAVE_LIBGRIBAPI 589 SUBROUTINE gridinfo_import_gribapi(this, gaid)
591 INTEGER,
INTENT(in) :: gaid
593 call time_import_gribapi(this%time, gaid)
594 call timerange_import_gribapi(this%timerange,gaid)
595 call level_import_gribapi(this%level, gaid)
596 call var_import_gribapi(this%var, gaid)
598 call normalize_gridinfo(this)
600 END SUBROUTINE gridinfo_import_gribapi
604 SUBROUTINE gridinfo_export_gribapi(this, gaid)
606 INTEGER,
INTENT(in) :: gaid
609 REAL,
ALLOCATABLE :: tmparr(:,:)
612 CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
613 IF (this%var == volgrid6d_var_miss)
THEN 614 CALL l4f_log(l4f_error, &
615 'A suitable variable has not been found in table when converting template')
618 IF (c_func /= conv_func_miss)
THEN 624 CALL unnormalize_gridinfo(this)
626 CALL time_export_gribapi(this%time, gaid, this%timerange)
627 CALL timerange_export_gribapi(this%timerange, gaid, this%time)
628 CALL level_export_gribapi(this%level, gaid)
629 CALL var_export_gribapi(this%var, gaid)
631 END SUBROUTINE gridinfo_export_gribapi
634 SUBROUTINE time_import_gribapi(this,gaid)
636 INTEGER,
INTENT(in) :: gaid
638 INTEGER :: editionnumber, ttimeincr, tprocdata, centre, p2g, p2, unit, status
639 CHARACTER(len=9) :: date
640 CHARACTER(len=10) :: time
642 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
644 IF (editionnumber == 1 .OR. editionnumber == 2)
THEN 646 CALL grib_get(gaid,
'dataDate',date )
647 CALL grib_get(gaid,
'dataTime',time(:5) )
649 CALL init(this,simpledate=date(:8)//time(:4))
651 IF (editionnumber == 2)
THEN 653 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
654 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr,status)
655 IF (ttimeincr == 255) ttimeincr = 2
658 IF (status == grib_success .AND. ttimeincr == 1)
THEN 660 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
661 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
662 CALL g2_interval_to_second(unit, p2g, p2)
663 this = this + timedelta_new(sec=p2)
664 ELSE IF (status == grib_success .AND. ttimeincr == 2 .AND. tprocdata == 0)
THEN 668 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
669 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
670 CALL g2_interval_to_second(unit, p2g, p2)
671 CALL grib_get(gaid,
'centre',centre)
672 IF (centre /= 78)
THEN 673 this = this + timedelta_new(sec=p2)
675 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
676 status /= grib_success)
THEN 679 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
686 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
691 END SUBROUTINE time_import_gribapi
694 SUBROUTINE time_export_gribapi(this, gaid, timerange)
696 INTEGER,
INTENT(in) :: gaid
699 INTEGER :: editionnumber, centre
700 CHARACTER(len=8) :: env_var
701 LOGICAL :: g2cosmo_behavior
703 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
705 IF (editionnumber == 1)
THEN 707 CALL code_referencetime(this)
709 ELSE IF (editionnumber == 2 )
THEN 711 IF (timerange%p1 >= timerange%p2)
THEN 712 CALL code_referencetime(this)
713 ELSE IF (timerange%p1 == 0)
THEN 715 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
716 g2cosmo_behavior = len_trim(env_var) > 0
717 CALL grib_get(gaid,
'centre',centre)
718 IF (g2cosmo_behavior .AND. centre == 78)
THEN 719 CALL code_referencetime(this)
721 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
724 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
730 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
737 SUBROUTINE code_referencetime(reftime)
738 TYPE(datetime),
INTENT(in) :: reftime
741 CHARACTER(len=17) :: date_time
744 CALL getval(reftime, simpledate=date_time)
745 READ(date_time(:8),
'(I8)')date
746 READ(date_time(9:12),
'(I4)')time
747 CALL grib_set(gaid,
'dataDate',date)
748 CALL grib_set(gaid,
'dataTime',time)
750 END SUBROUTINE code_referencetime
752 END SUBROUTINE time_export_gribapi
755 SUBROUTINE level_import_gribapi(this, gaid)
756 TYPE(vol7d_level),
INTENT(out) :: this
757 INTEGER,
INTENT(in) :: gaid
759 INTEGER :: EditionNumber,level1,l1,level2,l2
760 INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
762 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
764 if (editionnumber == 1)
then 766 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
767 call grib_get(gaid,
'topLevel',l1)
768 call grib_get(gaid,
'bottomLevel',l2)
770 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
772 else if (editionnumber == 2)
then 774 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
775 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
776 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
777 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN 778 scalef1 = imiss; scalev1 = imiss
781 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
782 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
783 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
784 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN 785 scalef2 = imiss; scalev2 = imiss
790 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
796 call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
799 call init (this,level1,l1,level2,l2)
801 END SUBROUTINE level_import_gribapi
804 SUBROUTINE level_export_gribapi(this, gaid)
805 TYPE(vol7d_level),
INTENT(in) :: this
806 INTEGER,
INTENT(in) :: gaid
808 INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
811 CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
812 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
814 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
816 if (editionnumber == 1)
then 818 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
820 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
823 call grib_set(gaid,
'bottomLevel',l2)
824 call grib_set(gaid,
'topLevel',l1)
826 else if (editionnumber == 2)
then 828 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
829 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN 830 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
831 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
833 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
834 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
837 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
838 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN 839 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
840 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
842 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
843 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
848 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
853 END SUBROUTINE level_export_gribapi
856 SUBROUTINE timerange_import_gribapi(this, gaid)
857 TYPE(vol7d_timerange),
INTENT(out) :: this
858 INTEGER,
INTENT(in) :: gaid
860 INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
861 ttimeincr, tprocdata, status
863 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
865 IF (editionnumber == 1)
THEN 867 CALL grib_get(gaid,
'timeRangeIndicator',tri)
868 CALL grib_get(gaid,
'P1',p1g)
869 CALL grib_get(gaid,
'P2',p2g)
870 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
871 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
873 ELSE IF (editionnumber == 2)
THEN 875 CALL grib_get(gaid,
'forecastTime',p1g)
876 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
877 CALL g2_interval_to_second(unit, p1g, p1)
878 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
880 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN 881 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
882 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
883 CALL g2_interval_to_second(unit, p2g, p2)
886 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
887 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
888 IF (ttimeincr == 2 .AND. tprocdata /= 0)
THEN 892 CALL l4f_log(l4f_warn,
'Found p1>0 in grib2 analysis data, strange things may happen')
903 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
908 CALL init(this, statproc, p1, p2)
910 END SUBROUTINE timerange_import_gribapi
913 SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
914 TYPE(vol7d_timerange),
INTENT(in) :: this
915 INTEGER,
INTENT(in) :: gaid
916 TYPE(datetime) :: reftime
918 INTEGER :: EditionNumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
919 CHARACTER(len=8) :: env_var
920 LOGICAL :: g2cosmo_behavior
922 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
924 IF (editionnumber == 1 )
THEN 926 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
927 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
928 tri, p1_g1, p2_g1, unit)
930 CALL grib_set(gaid,
'timeRangeIndicator',tri)
931 CALL grib_set(gaid,
'P1',p1_g1)
932 CALL grib_set(gaid,
'P2',p2_g1)
933 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
935 ELSE IF (editionnumber == 2)
THEN 936 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
938 IF (this%timerange == 254)
THEN 939 IF (pdtn < 0 .OR. pdtn > 7) &
940 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
942 CALL timerange_v7d_to_g2(this%p1,p1,unit)
944 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
945 CALL grib_set(gaid,
'forecastTime',p1)
947 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN 949 IF (pdtn < 8 .OR. pdtn > 14) &
950 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
952 IF (this%p1 >= this%p2)
THEN 954 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
955 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
956 CALL grib_set(gaid,
'forecastTime',p1)
957 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
960 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
962 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
963 CALL timerange_v7d_to_g2(this%p2,p2,unit)
964 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
965 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
967 ELSE IF (this%p1 == 0)
THEN 969 CALL timerange_v7d_to_g2(this%p2,p2,unit)
970 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
971 CALL grib_set(gaid,
'forecastTime',0)
972 CALL code_endoftimeinterval(reftime)
975 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
977 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
978 g2cosmo_behavior = len_trim(env_var) > 0
979 IF (g2cosmo_behavior)
THEN 980 CALL grib_set(gaid,
'typeOfProcessedData',0)
982 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
984 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
985 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
988 IF (this%timerange >= 192)
THEN 989 CALL l4f_log(l4f_warn, &
990 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
994 CALL l4f_log(l4f_error, &
995 'Timerange with 0>p1>p2 cannot be exported in grib2')
996 CALL raise_fatal_error()
999 CALL l4f_log(l4f_error, &
1000 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
1001 CALL raise_fatal_error()
1005 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1006 CALL raise_fatal_error()
1013 SUBROUTINE code_endoftimeinterval(endtime)
1014 TYPE(datetime),
INTENT(in) :: endtime
1016 INTEGER :: year, month, day, hour, minute, msec
1018 CALL getval(endtime, year=year, month=month, day=day, &
1019 hour=hour, minute=minute, msec=msec)
1020 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
1021 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
1022 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
1023 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
1024 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
1025 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
1027 END SUBROUTINE code_endoftimeinterval
1029 END SUBROUTINE timerange_export_gribapi
1032 SUBROUTINE var_import_gribapi(this, gaid)
1033 TYPE(volgrid6d_var),
INTENT(out) :: this
1034 INTEGER,
INTENT(in) :: gaid
1036 INTEGER :: EditionNumber, centre, discipline, category, number
1038 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1040 if (editionnumber == 1)
then 1042 call grib_get(gaid,
'centre',centre)
1043 call grib_get(gaid,
'gribTablesVersionNo',category)
1044 call grib_get(gaid,
'indicatorOfParameter',number)
1046 call init(this, centre, category, number)
1048 else if (editionnumber == 2)
then 1050 call grib_get(gaid,
'centre',centre)
1051 call grib_get(gaid,
'discipline',discipline)
1052 call grib_get(gaid,
'parameterCategory',category)
1053 call grib_get(gaid,
'parameterNumber',number)
1055 call init(this, centre, category, number, discipline)
1059 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1064 END SUBROUTINE var_import_gribapi
1067 SUBROUTINE var_export_gribapi(this, gaid)
1068 TYPE(volgrid6d_var),
INTENT(in) :: this
1069 INTEGER,
INTENT(in) :: gaid
1071 INTEGER ::EditionNumber
1073 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1075 if (editionnumber == 1)
then 1077 IF (this%centre /= 255) &
1078 CALL grib_set(gaid,
'centre',this%centre)
1079 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1080 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1082 else if (editionnumber == 2)
then 1085 IF (this%centre /= 255) &
1086 CALL grib_set(gaid,
'centre',this%centre)
1087 CALL grib_set(gaid,
'discipline',this%discipline)
1088 CALL grib_set(gaid,
'parameterCategory',this%category)
1089 CALL grib_set(gaid,
'parameterNumber',this%number)
1093 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1098 END SUBROUTINE var_export_gribapi
1101 SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1102 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1103 integer,
intent(out) ::lt1,l1,lt2,l2
1106 CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1107 CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1111 SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1112 integer,
intent(in) :: ltype,scalef,scalev
1113 integer,
intent(out) :: lt,l
1115 doubleprecision :: sl
1118 IF (ltype == 255 .OR. ltype == -1)
THEN 1121 ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN 1126 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN 1127 sl = scalev*(10.d0**(-scalef))
1129 IF (any(ltype == height_level))
THEN 1130 l = nint(sl*1000.d0)
1131 ELSE IF (any(ltype == thermo_level))
THEN 1133 ELSE IF (any(ltype == sigma_level))
THEN 1134 l = nint(sl*10000.d0)
1143 END SUBROUTINE g2_to_dballe
1145 END SUBROUTINE level_g2_to_dballe
1148 SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1149 integer,
intent(in) :: lt1,l1,lt2,l2
1150 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1152 CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1153 CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1157 SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1158 INTEGER,
INTENT(in) :: lt,l
1159 INTEGER,
INTENT(out) :: ltype,scalef,scalev
1162 IF (lt == imiss)
THEN 1166 ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN 1170 ELSE IF (lt == 256 .AND. l == imiss)
THEN 1177 IF (any(ltype == height_level))
THEN 1179 ELSE IF (any(ltype == thermo_level))
THEN 1181 ELSE IF (any(ltype == sigma_level))
THEN 1206 END SUBROUTINE dballe_to_g2
1208 END SUBROUTINE level_dballe_to_g2
1211 SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1212 integer,
intent(in) :: ltype,l1,l2
1213 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1222 if (ltype > 0 .and. ltype <= 9)
then 1224 else if (ltype == 20)
then 1228 else if (ltype == 100)
then 1231 else if (ltype == 101)
then 1236 else if (ltype == 102)
then 1238 else if (ltype == 103)
then 1241 else if (ltype == 104)
then 1246 else if (ltype == 105)
then 1249 else if (ltype == 106)
then 1254 else if (ltype == 107)
then 1258 else if (ltype == 108)
then 1265 else if (ltype == 109)
then 1268 else if (ltype == 110)
then 1273 else if (ltype == 111)
then 1277 else if (ltype == 112)
then 1284 else if (ltype == 113)
then 1287 else if (ltype == 114)
then 1292 else if (ltype == 115)
then 1295 else if (ltype == 116)
then 1300 else if (ltype == 117)
then 1304 if ( btest(l1,15) )
then 1305 scalev1=-1*
mod(l1,32768)
1307 else if (ltype == 119)
then 1311 else if (ltype == 120)
then 1318 else if (ltype == 121)
then 1320 scalev1=(1100+l1)*100
1322 scalev2=(1100+l2)*100
1323 else if (ltype == 125)
then 1327 else if (ltype == 128)
then 1334 else if (ltype == 141)
then 1338 scalev2=(1100+l2)*100
1339 else if (ltype == 160)
then 1342 else if (ltype == 200)
then 1345 else if (ltype == 210)
then 1350 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1351 //
' cannot be converted to GRIB2.')
1355 END SUBROUTINE level_g1_to_g2
1358 SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1359 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1360 integer,
intent(out) :: ltype,l1,l2
1362 if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then 1366 else if (ltype1 == 20 .and. ltype2 == 255)
then 1368 l1 = rescale2(scalef1-2,scalev1)
1370 else if (ltype1 == 100 .and. ltype2 == 255)
then 1372 l1 = rescale2(scalef1+2,scalev1)
1374 else if (ltype1 == 100 .and. ltype2 == 100)
then 1376 l1 = rescale1(scalef1+3,scalev1)
1377 l2 = rescale1(scalef2+3,scalev2)
1378 else if (ltype1 == 101 .and. ltype2 == 255)
then 1382 else if (ltype1 == 102 .and. ltype2 == 255)
then 1384 l1 = rescale2(scalef1,scalev1)
1386 else if (ltype1 == 102 .and. ltype2 == 102)
then 1388 l1 = rescale1(scalef1+2,scalev1)
1389 l2 = rescale1(scalef2+2,scalev2)
1390 else if (ltype1 == 103 .and. ltype2 == 255)
then 1392 l1 = rescale2(scalef1,scalev1)
1394 else if (ltype1 == 103 .and. ltype2 == 103)
then 1396 l1 = rescale1(scalef1+2,scalev1)
1397 l2 = rescale1(scalef2+2,scalev2)
1398 else if (ltype1 == 104 .and. ltype2 == 255)
then 1400 l1 = rescale2(scalef1,scalev1-4)
1402 else if (ltype1 == 104 .and. ltype2 == 104)
then 1404 l1 = rescale1(scalef1-2,scalev1)
1405 l2 = rescale1(scalef2-2,scalev2)
1406 else if (ltype1 == 105 .and. ltype2 == 255)
then 1408 l1 = rescale2(scalef1,scalev1)
1410 else if (ltype1 == 105 .and. ltype2 == 105)
then 1412 l1 = rescale1(scalef1,scalev1)
1413 l2 = rescale1(scalef2,scalev2)
1414 else if (ltype1 == 106 .and. ltype2 == 255)
then 1416 l1 = rescale2(scalef1-2,scalev1)
1418 else if (ltype1 == 106 .and. ltype2 == 106)
then 1420 l1 = rescale1(scalef1-2,scalev1)
1421 l2 = rescale1(scalef2-2,scalev2)
1422 else if (ltype1 == 107 .and. ltype2 == 255)
then 1424 l1 = rescale2(scalef1,scalev1)
1426 else if (ltype1 == 107 .and. ltype2 == 107)
then 1428 l1 = rescale1(scalef1,scalev1)
1429 l2 = rescale1(scalef2,scalev2)
1430 else if (ltype1 == 108 .and. ltype2 == 255)
then 1432 l1 = rescale2(scalef1+2,scalev1)
1434 else if (ltype1 == 108 .and. ltype2 == 108)
then 1436 l1 = rescale1(scalef1+2,scalev1)
1437 l2 = rescale1(scalef2+2,scalev2)
1438 else if (ltype1 == 109 .and. ltype2 == 255)
then 1440 l1 = rescale2(scalef1+9,scalev1)
1442 else if (ltype1 == 111 .and. ltype2 == 255)
then 1444 l1 = rescale2(scalef1-2,scalev1)
1446 else if (ltype1 == 111 .and. ltype2 == 111)
then 1448 l1 = rescale1(scalef1-4,scalev1)
1449 l2 = rescale1(scalef2-4,scalev2)
1450 else if (ltype1 == 160 .and. ltype2 == 255)
then 1452 l1 = rescale2(scalef1,scalev1)
1454 else if (ltype1 == 1 .and. ltype2 == 8)
then 1456 else if (ltype1 == 1 .and. ltype2 == 9)
then 1463 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1464 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1470 FUNCTION rescale1(scalef, scalev)
RESULT(rescale)
1471 INTEGER,
INTENT(in) :: scalef, scalev
1474 rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1476 END FUNCTION rescale1
1478 FUNCTION rescale2(scalef, scalev)
RESULT(rescale)
1479 INTEGER,
INTENT(in) :: scalef, scalev
1482 rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1484 END FUNCTION rescale2
1486 END SUBROUTINE level_g2_to_g1
1497 SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1498 INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1499 INTEGER,
INTENT(out) :: statproc, p1, p2
1501 IF (tri == 0 .OR. tri == 1)
THEN 1503 CALL g1_interval_to_second(unit, p1_g1, p1)
1505 ELSE IF (tri == 10)
THEN 1507 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1509 ELSE IF (tri == 2)
THEN 1511 CALL g1_interval_to_second(unit, p2_g1, p1)
1512 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1513 ELSE IF (tri == 3)
THEN 1515 CALL g1_interval_to_second(unit, p2_g1, p1)
1516 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1517 ELSE IF (tri == 4)
THEN 1519 CALL g1_interval_to_second(unit, p2_g1, p1)
1520 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1521 ELSE IF (tri == 5)
THEN 1523 CALL g1_interval_to_second(unit, p2_g1, p1)
1524 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1525 ELSE IF (tri == 13)
THEN 1528 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1530 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1531 //
' cannot be converted to GRIB2.')
1535 if (statproc == 254 .and. p2 /= 0 )
then 1536 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1539 END SUBROUTINE timerange_g1_to_v7d
1560 SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1561 INTEGER,
INTENT(in) :: unit, valuein
1562 INTEGER,
INTENT(out) :: valueout
1564 INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1565 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1568 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1569 IF (
c_e(unitlist(unit)))
THEN 1570 valueout = valuein*unitlist(unit)
1574 END SUBROUTINE g1_interval_to_second
1577 SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1578 INTEGER,
INTENT(in) :: unit, valuein
1579 INTEGER,
INTENT(out) :: valueout
1581 INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1582 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1585 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1586 IF (
c_e(unitlist(unit)))
THEN 1587 valueout = valuein*unitlist(unit)
1591 END SUBROUTINE g2_interval_to_second
1605 SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1606 INTEGER,
INTENT(in) :: statproc, p1, p2
1607 INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1609 INTEGER :: ptmp, pdl
1612 IF (statproc == 254) pdl = p1
1614 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1615 IF (statproc == 0)
THEN 1617 ELSE IF (statproc == 1)
THEN 1619 ELSE IF (statproc == 4)
THEN 1621 ELSE IF (statproc == 205)
THEN 1623 ELSE IF (statproc == 257)
THEN 1630 ELSE IF (statproc == 254)
THEN 1634 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1635 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1639 IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN 1640 ptmp = max(p1_g1,p2_g1)
1641 p2_g1 =
mod(ptmp,256)
1644 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1645 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1655 p2_g1 = p2_g1 - ptmp
1659 END SUBROUTINE timerange_v7d_to_g1
1662 SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1663 INTEGER,
INTENT(in) :: valuein
1664 INTEGER,
INTENT(out) :: valueout, unit
1666 IF (valuein == imiss)
THEN 1669 ELSE IF (
mod(valuein,3600) == 0)
THEN 1670 valueout = valuein/3600
1672 ELSE IF (
mod(valuein,60) == 0)
THEN 1673 valueout = valuein/60
1680 END SUBROUTINE timerange_v7d_to_g2
1690 SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1691 INTEGER,
INTENT(in) :: valuein1, valuein2
1692 INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1697 INTEGER :: sectounit
1698 END TYPE unitchecker
1700 TYPE(unitchecker),
PARAMETER :: hunit(5) = (/ &
1701 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1702 unitchecker(12, 43200), unitchecker(2, 86400) /)
1703 TYPE(unitchecker),
PARAMETER :: munit(3) = (/ &
1704 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1707 IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN 1711 ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN 1712 DO i = 1,
SIZE(hunit)
1713 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1714 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1715 .AND. valuein1/hunit(i)%sectounit < 255 &
1716 .AND. valuein2/hunit(i)%sectounit < 255)
THEN 1717 valueout1 = valuein1/hunit(i)%sectounit
1718 valueout2 = valuein2/hunit(i)%sectounit
1719 unit = hunit(i)%unit
1723 IF (.NOT.
c_e(unit))
THEN 1725 DO i =
SIZE(hunit), 1, -1
1726 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1727 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN 1728 valueout1 = valuein1/hunit(i)%sectounit
1729 valueout2 = valuein2/hunit(i)%sectounit
1730 unit = hunit(i)%unit
1735 ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN 1736 DO i = 1,
SIZE(munit)
1737 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1738 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1739 .AND. valuein1/munit(i)%sectounit < 255 &
1740 .AND. valuein2/munit(i)%sectounit < 255)
THEN 1741 valueout1 = valuein1/munit(i)%sectounit
1742 valueout2 = valuein2/munit(i)%sectounit
1743 unit = munit(i)%unit
1747 IF (.NOT.
c_e(unit))
THEN 1749 DO i =
SIZE(munit), 1, -1
1750 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1751 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN 1752 valueout1 = valuein1/munit(i)%sectounit
1753 valueout2 = valuein2/munit(i)%sectounit
1754 unit = munit(i)%unit
1761 IF (.NOT.
c_e(unit))
THEN 1762 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1763 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1767 END SUBROUTINE timerange_choose_unit_g1
1783 SUBROUTINE normalize_gridinfo(this)
1784 TYPE(gridinfo_def),
intent(inout) :: this
1786 IF (this%timerange%timerange == 254)
THEN 1789 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1795 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1800 ELSE IF (this%timerange%timerange == 205)
THEN 1803 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1805 this%timerange%timerange=3
1810 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1812 this%timerange%timerange=2
1817 IF (this%var%discipline == 255 .AND. &
1818 any(this%var%centre == cosmo_centre))
THEN 1820 IF (this%var%category == 201)
THEN 1822 IF (this%var%number == 187)
THEN 1825 this%timerange%timerange=2
1830 ELSE IF (this%timerange%timerange == 257)
THEN 1832 IF (this%timerange%p2 == 0)
THEN 1834 this%timerange%timerange=254
1838 IF (this%var%discipline == 255 .AND. &
1839 any(this%var%centre == cosmo_centre))
THEN 1841 IF (this%var%category >= 1 .AND. this%var%category <= 3)
THEN 1843 if (this%var%number == 11)
then 1844 this%timerange%timerange=0
1846 else if (this%var%number == 15)
then 1847 this%timerange%timerange=2
1850 else if (this%var%number == 16)
then 1851 this%timerange%timerange=3
1854 else if (this%var%number == 17)
then 1855 this%timerange%timerange=0
1857 else if (this%var%number == 33)
then 1858 this%timerange%timerange=0
1860 else if (this%var%number == 34)
then 1861 this%timerange%timerange=0
1863 else if (this%var%number == 57)
then 1864 this%timerange%timerange=1
1866 else if (this%var%number == 61)
then 1867 this%timerange%timerange=1
1869 else if (this%var%number == 78)
then 1870 this%timerange%timerange=1
1872 else if (this%var%number == 79)
then 1873 this%timerange%timerange=1
1875 else if (this%var%number == 90)
then 1876 this%timerange%timerange=1
1878 else if (this%var%number == 111)
then 1879 this%timerange%timerange=0
1880 else if (this%var%number == 112)
then 1881 this%timerange%timerange=0
1882 else if (this%var%number == 113)
then 1883 this%timerange%timerange=0
1884 else if (this%var%number == 114)
then 1885 this%timerange%timerange=0
1886 else if (this%var%number == 121)
then 1887 this%timerange%timerange=0
1888 else if (this%var%number == 122)
then 1889 this%timerange%timerange=0
1890 else if (this%var%number == 124)
then 1891 this%timerange%timerange=0
1892 else if (this%var%number == 125)
then 1893 this%timerange%timerange=0
1894 else if (this%var%number == 126)
then 1895 this%timerange%timerange=0
1896 else if (this%var%number == 127)
then 1897 this%timerange%timerange=0
1901 ELSE IF (this%var%category == 201)
THEN 1903 if (this%var%number == 5)
then 1904 this%timerange%timerange=0
1906 else if (this%var%number == 20)
then 1907 this%timerange%timerange=1
1909 else if (this%var%number == 22)
then 1910 this%timerange%timerange=0
1911 else if (this%var%number == 23)
then 1912 this%timerange%timerange=0
1913 else if (this%var%number == 24)
then 1914 this%timerange%timerange=0
1915 else if (this%var%number == 25)
then 1916 this%timerange%timerange=0
1917 else if (this%var%number == 26)
then 1918 this%timerange%timerange=0
1919 else if (this%var%number == 27)
then 1920 this%timerange%timerange=0
1922 else if (this%var%number == 42)
then 1923 this%timerange%timerange=1
1925 else if (this%var%number == 102)
then 1926 this%timerange%timerange=1
1928 else if (this%var%number == 113)
then 1929 this%timerange%timerange=1
1931 else if (this%var%number == 132)
then 1932 this%timerange%timerange=1
1934 else if (this%var%number == 135)
then 1935 this%timerange%timerange=1
1937 else if (this%var%number == 187)
then 1940 this%timerange%timerange=2
1942 else if (this%var%number == 218)
then 1943 this%timerange%timerange=2
1945 else if (this%var%number == 219)
then 1946 this%timerange%timerange=2
1950 ELSE IF (this%var%category == 202)
THEN 1952 if (this%var%number == 231)
then 1953 this%timerange%timerange=0
1954 else if (this%var%number == 232)
then 1955 this%timerange%timerange=0
1956 else if (this%var%number == 233)
then 1957 this%timerange%timerange=0
1963 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1964 trim(
to_char(this%timerange%p2)))
1966 'associated to an apparently instantaneous parameter '//&
1967 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1968 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1971 this%timerange%p2 = 0
1972 this%timerange%timerange = 254
1979 IF (this%var%discipline == 255 .AND. &
1980 any(this%var%centre == ecmwf_centre))
THEN 1985 IF (this%var%category == 128)
THEN 1987 IF ((this%var%number == 142 .OR. &
1988 this%var%number == 143 .OR. &
1989 this%var%number == 144 .OR. &
1990 this%var%number == 228 .OR. &
1991 this%var%number == 145 .OR. &
1992 this%var%number == 146 .OR. &
1993 this%var%number == 147 .OR. &
1994 this%var%number == 169) .AND. &
1995 this%timerange%timerange == 254)
THEN 1996 this%timerange%timerange = 1
1997 this%timerange%p2 = this%timerange%p1
1999 ELSE IF ((this%var%number == 165 .OR. &
2000 this%var%number == 166) .AND. &
2001 this%level%level1 == 1)
THEN 2002 this%level%level1 = 103
2003 this%level%l1 = 10000
2005 ELSE IF ((this%var%number == 167 .OR. &
2006 this%var%number == 168) .AND. &
2007 this%level%level1 == 1)
THEN 2008 this%level%level1 = 103
2009 this%level%l1 = 2000
2011 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN 2012 this%level%level1 = 106
2016 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN 2017 this%level%level1 = 106
2021 ELSE IF (this%var%number == 171)
THEN 2022 this%level%level1 = 106
2026 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN 2027 this%level%level1 = 106
2029 this%level%l2 = 1000
2031 ELSE IF (this%var%number == 184)
THEN 2032 this%level%level1 = 106
2034 this%level%l2 = 1000
2036 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN 2037 this%level%level1 = 106
2038 this%level%l1 = 1000
2039 this%level%l2 = 2890
2041 ELSE IF (this%var%number == 121 .AND. &
2042 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2043 this%timerange%timerange = 2
2044 this%timerange%p2 = 21600
2046 this%level%level1 = 103
2047 this%level%l1 = 2000
2049 ELSE IF (this%var%number == 122 .AND. &
2050 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2051 this%timerange%timerange = 3
2052 this%timerange%p2 = 21600
2055 this%level%level1 = 103
2056 this%level%l1 = 2000
2058 ELSE IF (this%var%number == 123 .AND. &
2059 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2060 this%timerange%timerange = 2
2061 this%timerange%p2 = 21600
2062 this%level%level1 = 103
2063 this%level%l1 = 10000
2066 ELSE IF (this%var%number == 186)
THEN 2067 this%var%number = 248
2068 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2069 ELSE IF (this%var%number == 187)
THEN 2070 this%var%number = 248
2071 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2072 ELSE IF (this%var%number == 188)
THEN 2073 this%var%number = 248
2074 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2077 ELSE IF (this%var%category == 228)
THEN 2079 IF (this%var%number == 24)
THEN 2080 this%level%level1 = 4
2082 this%level%level2 = 255
2085 ELSE IF (this%var%number == 26 .AND. &
2086 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2087 this%timerange%timerange = 2
2088 this%timerange%p2 = 10800
2089 this%var%category = 128
2091 this%level%level1 = 103
2092 this%level%l1 = 2000
2094 ELSE IF (this%var%number == 27 .AND. &
2095 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2096 this%timerange%timerange = 3
2097 this%timerange%p2 = 10800
2098 this%var%category = 128
2100 this%level%level1 = 103
2101 this%level%l1 = 2000
2103 ELSE IF (this%var%number == 28 .AND. &
2104 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2105 this%timerange%timerange = 2
2106 this%timerange%p2 = 10800
2107 this%level%level1 = 103
2108 this%level%l1 = 10000
2115 IF (this%var%discipline == 255 .AND. &
2116 this%var%category >= 1 .AND. this%var%category <= 3)
THEN 2119 IF (this%var%number == 73)
THEN 2120 this%var%number = 71
2121 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2122 ELSE IF (this%var%number == 74)
THEN 2123 this%var%number = 71
2124 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2125 ELSE IF (this%var%number == 75)
THEN 2126 this%var%number = 71
2127 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2134 END SUBROUTINE normalize_gridinfo
2145 SUBROUTINE unnormalize_gridinfo(this)
2146 TYPE(gridinfo_def),
intent(inout) :: this
2148 IF (this%timerange%timerange == 3)
THEN 2150 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2152 this%timerange%timerange=205
2154 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2155 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2157 this%timerange%timerange=205
2161 ELSE IF (this%timerange%timerange == 2)
THEN 2163 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2165 this%timerange%timerange=205
2167 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2168 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2170 this%timerange%timerange=205
2172 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN 2173 this%timerange%timerange=205
2175 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN 2176 this%timerange%timerange=205
2179 ELSE IF (any(this%var%centre == cosmo_centre))
THEN 2188 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN 2189 this%timerange%timerange=205
2195 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN 2196 IF (this%var%number == 71 .AND. &
2197 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2198 IF (this%level%l2 == 1)
THEN 2199 this%var%number = 73
2200 ELSE IF (this%level%l2 == 2)
THEN 2201 this%var%number = 74
2202 ELSE IF (this%level%l2 == 3)
THEN 2203 this%var%number = 75
2205 this%level = vol7d_level_new(level1=1)
2209 IF (any(this%var%centre == ecmwf_centre))
THEN 2211 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN 2212 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2213 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2214 IF (this%level%l2 == 1)
THEN 2215 this%var%number = 186
2216 ELSE IF (this%level%l2 == 2)
THEN 2217 this%var%number = 187
2218 ELSE IF (this%level%l2 == 3)
THEN 2219 this%var%number = 188
2221 this%level = vol7d_level_new(level1=1)
2226 END SUBROUTINE unnormalize_gridinfo
2235 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2236 TYPE(gridinfo_def),
INTENT(inout) :: this
2237 TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2239 TYPE(gdaldataseth) :: hds
2243 this%time = datetime_new(year=2010, month=1, day=1)
2246 this%timerange = vol7d_timerange_new(254, 0, 0)
2249 hds = gdalgetbanddataset(gdalid)
2250 IF (gdalgetrastercount(hds) == 1)
THEN 2251 this%level = vol7d_level_new(1, 0)
2253 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2257 this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2259 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.