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/), &
91 height_level(5) = (/102,103,106,117,160/)
95 MODULE PROCEDURE gridinfo_init
100 MODULE PROCEDURE gridinfo_delete
106 MODULE PROCEDURE gridinfo_clone
112 MODULE PROCEDURE gridinfo_import, gridinfo_import_from_file
119 MODULE PROCEDURE gridinfo_export, gridinfo_export_to_file
127 MODULE PROCEDURE gridinfo_display, gridinfov_display
133 MODULE PROCEDURE gridinfo_decode_data
138 MODULE PROCEDURE gridinfo_encode_data
141 #define ARRAYOF_ORIGTYPE TYPE(gridinfo_def) 142 #define ARRAYOF_TYPE arrayof_gridinfo 143 #define ARRAYOF_ORIGDESTRUCTOR(x) CALL delete(x) 144 #include "arrayof_pre.F90" 154 #include "arrayof_post.F90" 159 SUBROUTINE gridinfo_init(this, gaid, griddim, time, timerange, level, var, &
160 clone, categoryappend)
161 TYPE(gridinfo_def),
intent(out) :: this
162 TYPE(grid_id),
intent(in),
optional :: gaid
163 type(griddim_def),
intent(in),
optional :: griddim
164 TYPE(datetime),
intent(in),
optional :: time
165 TYPE(vol7d_timerange),
intent(in),
optional :: timerange
166 TYPE(vol7d_level),
intent(in),
optional :: level
167 TYPE(volgrid6d_var),
intent(in),
optional :: var
168 logical ,
intent(in),
optional :: clone
169 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
171 character(len=512) :: a_name
173 if (
present(categoryappend))
then 174 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
176 call l4f_launcher(a_name,a_name_append=trim(subcategory))
178 this%category=l4f_category_get(a_name)
184 if (
present(gaid))
then 185 if (optio_log(
clone))
then 186 CALL copy(gaid,this%gaid)
191 this%gaid = grid_id_new()
199 if (
present(griddim))
then 200 call copy(griddim,this%griddim)
202 call init(this%griddim,categoryappend=categoryappend)
205 if (
present(time))
then 211 if (
present(timerange))
then 212 this%timerange=timerange
214 call init(this%timerange)
217 if (
present(level))
then 220 call init(this%level)
223 if (
present(var))
then 229 END SUBROUTINE gridinfo_init
234 SUBROUTINE gridinfo_delete(this)
235 TYPE(gridinfo_def),
intent(inout) :: this
243 call delete(this%timerange)
253 call l4f_category_delete(this%category)
255 END SUBROUTINE gridinfo_delete
264 SUBROUTINE gridinfo_display(this, namespace)
265 TYPE(gridinfo_def),
intent(in) :: this
266 CHARACTER (len=*),
OPTIONAL :: namespace
272 print*,
"----------------------- gridinfo display ---------------------" 278 call display(this%gaid, namespace=namespace)
279 print*,
"--------------------------------------------------------------" 281 END SUBROUTINE gridinfo_display
285 SUBROUTINE gridinfov_display(this, namespace)
286 TYPE(arrayof_gridinfo),
INTENT(in) :: this
287 CHARACTER (len=*),
OPTIONAL :: namespace
291 print*,
"----------------------- gridinfo array -----------------------" 293 DO i = 1, this%arraysize
297 "displaying gridinfo array, element "//
t2c(i))
299 CALL display(this%array(i), namespace)
302 print*,
"--------------------------------------------------------------" 304 END SUBROUTINE gridinfov_display
309 SUBROUTINE gridinfo_clone(this, that, categoryappend)
312 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
314 CALL init(that, gaid=this%gaid, griddim=this%griddim, time=this%time, &
315 timerange=this%timerange, level=this%level, var=this%var,
clone=.true., &
316 categoryappend=categoryappend)
318 END SUBROUTINE gridinfo_clone
328 SUBROUTINE gridinfo_import(this)
329 TYPE(gridinfo_def),
INTENT(inout) :: this
331 #ifdef HAVE_LIBGRIBAPI 335 TYPE(gdalrasterbandh) :: gdalid
343 CALL import(this%griddim, this%gaid)
345 #ifdef HAVE_LIBGRIBAPI 346 gaid = grid_id_get_gaid(this%gaid)
347 IF (
c_e(gaid))
CALL gridinfo_import_gribapi(this, gaid)
350 gdalid = grid_id_get_gdalid(this%gaid)
351 IF (gdalassociated(gdalid))
CALL gridinfo_import_gdal(this, gdalid)
354 END SUBROUTINE gridinfo_import
363 SUBROUTINE gridinfo_import_from_file(this, filename, categoryappend)
364 TYPE(arrayof_gridinfo) :: this
365 CHARACTER(len=*),
INTENT(in) :: filename
366 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
368 type(gridinfo_def) :: gridinfol
369 INTEGER :: ngrid, category
370 CHARACTER(len=512) :: a_name
371 TYPE(grid_file_id) :: input_file
372 TYPE(grid_id) :: input_grid
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(a_name)
386 input_file = grid_file_id_new(filename,
'r')
390 input_grid = grid_id_new(input_file)
391 IF (.NOT.
c_e(input_grid))
EXIT 395 IF (
PRESENT(categoryappend))
THEN 396 CALL init(gridinfol, gaid=input_grid, &
397 categoryappend=trim(categoryappend)//
"-msg"//trim(
to_char(ngrid)))
399 CALL init(gridinfol, gaid=input_grid, &
400 categoryappend=
"msg"//trim(
to_char(ngrid)))
403 CALL insert(this, gridinfol)
410 "gridinfo_import, "//
t2c(ngrid)//
" messages/bands imported from file "// &
416 CALL l4f_category_delete(category)
418 END SUBROUTINE gridinfo_import_from_file
427 SUBROUTINE gridinfo_export(this)
428 TYPE(gridinfo_def),
INTENT(inout) :: this
430 #ifdef HAVE_LIBGRIBAPI 443 CALL export(this%griddim, this%gaid)
445 #ifdef HAVE_LIBGRIBAPI 446 IF (grid_id_get_driver(this%gaid) ==
'grib_api')
THEN 447 gaid = grid_id_get_gaid(this%gaid)
448 IF (
c_e(gaid))
CALL gridinfo_export_gribapi(this, gaid)
452 IF (grid_id_get_driver(this%gaid) ==
'gdal')
THEN 454 CALL l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
458 END SUBROUTINE gridinfo_export
466 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
468 CHARACTER(len=*),
INTENT(in) :: filename
469 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
471 INTEGER :: i, category
472 CHARACTER(len=512) :: a_name
476 IF (
PRESENT(categoryappend))
THEN 477 CALL l4f_launcher(a_name,a_name_append= &
478 trim(subcategory)//
"."//trim(categoryappend))
480 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
482 category=l4f_category_get(a_name)
486 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
489 valid_grid_id = grid_id_new()
490 DO i = 1, this%arraysize
491 IF (
c_e(this%array(i)%gaid))
THEN 492 valid_grid_id = this%array(i)%gaid
497 IF (
c_e(valid_grid_id))
THEN 499 output_file = grid_file_id_new(filename,
'w', from_grid_id=valid_grid_id)
500 IF (
c_e(output_file))
THEN 501 DO i = 1, this%arraysize
502 CALL export(this%array(i))
503 CALL export(this%array(i)%gaid, output_file)
513 "gridinfo object of size "//
t2c(this%arraysize))
515 "no valid grid id found when exporting to file "//trim(filename))
520 CALL l4f_category_delete(category)
522 END SUBROUTINE gridinfo_export_to_file
533 FUNCTION gridinfo_decode_data(this)
RESULT(field)
535 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
537 CALL grid_id_decode_data(this%gaid, field)
539 END FUNCTION gridinfo_decode_data
549 SUBROUTINE gridinfo_encode_data(this, field)
551 REAL,
intent(in) :: field(:,:)
553 IF (
SIZE(field,1) /= this%griddim%dim%nx &
554 .OR.
SIZE(field,2) /= this%griddim%dim%ny)
THEN 556 'gridinfo_encode: field and gridinfo object non conformal, field: ' &
557 //trim(
to_char(
SIZE(field,1)))//
'X'//trim(
to_char(
SIZE(field,2)))//
', nx,ny:' &
558 //trim(
to_char(this%griddim%dim%nx))//
'X'//trim(
to_char(this%griddim%dim%ny)))
563 CALL grid_id_encode_data(this%gaid, field)
565 END SUBROUTINE gridinfo_encode_data
572 #ifdef HAVE_LIBGRIBAPI 573 SUBROUTINE gridinfo_import_gribapi(this, gaid)
575 INTEGER,
INTENT(in) :: gaid
577 call time_import_gribapi(this%time, gaid)
578 call timerange_import_gribapi(this%timerange,gaid)
579 call level_import_gribapi(this%level, gaid)
580 call var_import_gribapi(this%var, gaid)
582 call normalize_gridinfo(this)
584 END SUBROUTINE gridinfo_import_gribapi
588 SUBROUTINE gridinfo_export_gribapi(this, gaid)
590 INTEGER,
INTENT(in) :: gaid
593 REAL,
ALLOCATABLE :: tmparr(:,:)
596 CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
597 IF (this%var == volgrid6d_var_miss)
THEN 598 CALL l4f_log(l4f_error, &
599 'A suitable variable has not been found in table when converting template')
602 IF (c_func /= conv_func_miss)
THEN 608 CALL unnormalize_gridinfo(this)
610 CALL time_export_gribapi(this%time, gaid, this%timerange)
611 CALL timerange_export_gribapi(this%timerange, gaid, this%time)
612 CALL level_export_gribapi(this%level, gaid)
613 CALL var_export_gribapi(this%var, gaid)
615 END SUBROUTINE gridinfo_export_gribapi
618 SUBROUTINE time_import_gribapi(this,gaid)
620 INTEGER,
INTENT(in) :: gaid
622 INTEGER :: editionnumber, ttimeincr, p2g, p2, unit, status
623 CHARACTER(len=9) :: date
624 CHARACTER(len=10) :: time
626 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
628 IF (editionnumber == 1 .OR. editionnumber == 2)
THEN 630 call grib_get(gaid,
'dataDate',date )
631 call grib_get(gaid,
'dataTime',time(:5) )
633 call init(this,simpledate=date(:8)//time(:4))
635 IF (editionnumber == 2)
THEN 637 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr,status)
640 IF (status == grib_success .AND. ttimeincr == 1)
THEN 641 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
642 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
643 CALL g2_interval_to_second(unit, p2g, p2)
644 this = this + timedelta_new(sec=p2)
645 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
646 status /= grib_success)
THEN 649 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
656 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
661 END SUBROUTINE time_import_gribapi
664 SUBROUTINE time_export_gribapi(this, gaid, timerange)
666 INTEGER,
INTENT(in) :: gaid
669 INTEGER :: editionnumber
671 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
673 IF (editionnumber == 1)
THEN 675 CALL code_referencetime(this)
677 ELSE IF (editionnumber == 2 )
THEN 679 IF (timerange%p1 >= timerange%p2)
THEN 680 CALL code_referencetime(this)
681 ELSE IF (timerange%p1 == 0)
THEN 682 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
684 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
690 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
697 SUBROUTINE code_referencetime(reftime)
698 TYPE(
datetime),
INTENT(in) :: reftime
701 CHARACTER(len=17) :: date_time
704 CALL getval(reftime, simpledate=date_time)
705 READ(date_time(:8),
'(I8)')date
706 READ(date_time(9:12),
'(I4)')time
707 CALL grib_set(gaid,
'dataDate',date)
708 CALL grib_set(gaid,
'dataTime',time)
710 END SUBROUTINE code_referencetime
712 END SUBROUTINE time_export_gribapi
715 SUBROUTINE level_import_gribapi(this, gaid)
717 INTEGER,
INTENT(in) :: gaid
719 INTEGER :: EditionNumber,level1,l1,level2,l2
720 INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
722 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
724 if (editionnumber == 1)
then 726 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
727 call grib_get(gaid,
'topLevel',l1)
728 call grib_get(gaid,
'bottomLevel',l2)
730 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
732 else if (editionnumber == 2)
then 734 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
735 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
736 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
737 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN 738 scalef1 = imiss; scalev1 = imiss
741 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
742 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
743 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
744 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN 745 scalef2 = imiss; scalev2 = imiss
750 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
756 call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
759 call init (this,level1,l1,level2,l2)
761 END SUBROUTINE level_import_gribapi
764 SUBROUTINE level_export_gribapi(this, gaid)
765 TYPE(vol7d_level),
INTENT(in) :: this
766 INTEGER,
INTENT(in) :: gaid
768 INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
771 CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
772 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
774 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
776 if (editionnumber == 1)
then 778 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
780 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
783 call grib_set(gaid,
'bottomLevel',l2)
784 call grib_set(gaid,
'topLevel',l1)
786 else if (editionnumber == 2)
then 788 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
789 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN 790 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
791 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
793 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
794 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
797 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
798 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN 799 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
800 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
802 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
803 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
808 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
813 END SUBROUTINE level_export_gribapi
816 SUBROUTINE timerange_import_gribapi(this, gaid)
817 TYPE(vol7d_timerange),
INTENT(out) :: this
818 INTEGER,
INTENT(in) :: gaid
820 INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
823 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
825 IF (editionnumber == 1)
THEN 827 CALL grib_get(gaid,
'timeRangeIndicator',tri)
828 CALL grib_get(gaid,
'P1',p1g)
829 CALL grib_get(gaid,
'P2',p2g)
830 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
831 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
833 ELSE IF (editionnumber == 2)
THEN 835 CALL grib_get(gaid,
'forecastTime',p1g)
836 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
837 CALL g2_interval_to_second(unit, p1g, p1)
838 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
840 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN 841 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
842 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
843 CALL g2_interval_to_second(unit, p2g, p2)
846 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
847 IF (ttimeincr == 2) p1 = p1 + p2
857 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
862 CALL init(this, statproc, p1, p2)
864 END SUBROUTINE timerange_import_gribapi
867 SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
868 TYPE(vol7d_timerange),
INTENT(in) :: this
869 INTEGER,
INTENT(in) :: gaid
870 TYPE(datetime) :: reftime
872 INTEGER :: EditionNumber, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
874 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
876 IF (editionnumber == 1 )
THEN 878 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
879 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
880 tri, p1_g1, p2_g1, unit)
882 CALL grib_set(gaid,
'timeRangeIndicator',tri)
883 CALL grib_set(gaid,
'P1',p1_g1)
884 CALL grib_set(gaid,
'P2',p2_g1)
885 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
887 ELSE IF (editionnumber == 2)
THEN 888 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
890 IF (this%timerange == 254)
THEN 891 IF (pdtn < 0 .OR. pdtn > 7) &
892 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
894 CALL timerange_v7d_to_g2(this%p1,p1,unit)
896 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
897 CALL grib_set(gaid,
'forecastTime',p1)
899 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN 901 IF (pdtn < 8 .OR. pdtn > 14) &
902 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
904 IF (this%p1 >= this%p2)
THEN 906 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
907 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
908 CALL grib_set(gaid,
'forecastTime',p1)
909 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
912 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
913 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
914 CALL timerange_v7d_to_g2(this%p2,p2,unit)
915 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
916 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
918 ELSE IF (this%p1 == 0)
THEN 920 CALL timerange_v7d_to_g2(this%p2,p2,unit)
921 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
922 CALL grib_set(gaid,
'forecastTime',0)
923 CALL code_endoftimeinterval(reftime)
926 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
927 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
928 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
929 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
932 IF (this%timerange >= 192)
THEN 933 CALL l4f_log(l4f_warn, &
934 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
938 CALL l4f_log(l4f_error, &
939 'Timerange with 0>p1>p2 cannot be exported in grib2')
940 CALL raise_fatal_error()
943 CALL l4f_log(l4f_error, &
944 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
945 CALL raise_fatal_error()
949 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
950 CALL raise_fatal_error()
957 SUBROUTINE code_endoftimeinterval(endtime)
958 TYPE(datetime),
INTENT(in) :: endtime
960 INTEGER :: year, month, day, hour, minute, msec
962 CALL getval(endtime, year=year, month=month, day=day, &
963 hour=hour, minute=minute, msec=msec)
964 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
965 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
966 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
967 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
968 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
969 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
971 END SUBROUTINE code_endoftimeinterval
973 END SUBROUTINE timerange_export_gribapi
976 SUBROUTINE var_import_gribapi(this, gaid)
977 TYPE(volgrid6d_var),
INTENT(out) :: this
978 INTEGER,
INTENT(in) :: gaid
980 INTEGER :: EditionNumber, centre, discipline, category, number
982 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
984 if (editionnumber == 1)
then 986 call grib_get(gaid,
'centre',centre)
987 call grib_get(gaid,
'gribTablesVersionNo',category)
988 call grib_get(gaid,
'indicatorOfParameter',number)
990 call init(this, centre, category, number)
992 else if (editionnumber == 2)
then 994 call grib_get(gaid,
'centre',centre)
995 call grib_get(gaid,
'discipline',discipline)
996 call grib_get(gaid,
'parameterCategory',category)
997 call grib_get(gaid,
'parameterNumber',number)
999 call init(this, centre, category, number, discipline)
1003 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1008 END SUBROUTINE var_import_gribapi
1011 SUBROUTINE var_export_gribapi(this, gaid)
1012 TYPE(volgrid6d_var),
INTENT(in) :: this
1013 INTEGER,
INTENT(in) :: gaid
1015 INTEGER ::EditionNumber
1017 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1019 if (editionnumber == 1)
then 1021 IF (this%centre /= 255) &
1022 CALL grib_set(gaid,
'centre',this%centre)
1023 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1024 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1026 else if (editionnumber == 2)
then 1029 IF (this%centre /= 255) &
1030 CALL grib_set(gaid,
'centre',this%centre)
1031 CALL grib_set(gaid,
'discipline',this%discipline)
1032 CALL grib_set(gaid,
'parameterCategory',this%category)
1033 CALL grib_set(gaid,
'parameterNumber',this%number)
1037 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1042 END SUBROUTINE var_export_gribapi
1045 SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1046 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1047 integer,
intent(out) ::lt1,l1,lt2,l2
1050 CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1051 CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1055 SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1056 integer,
intent(in) :: ltype,scalef,scalev
1057 integer,
intent(out) :: lt,l
1059 doubleprecision :: sl
1062 IF (ltype == 255 .OR. ltype == -1)
THEN 1065 ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN 1070 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN 1071 sl = scalev*(10.d0**(-scalef))
1073 IF (any(ltype == height_level))
THEN 1074 l = nint(sl*1000.d0)
1083 END SUBROUTINE g2_to_dballe
1085 END SUBROUTINE level_g2_to_dballe
1088 SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1089 integer,
intent(in) :: lt1,l1,lt2,l2
1090 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1092 CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1093 CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1097 SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1098 INTEGER,
INTENT(in) :: lt,l
1099 INTEGER,
INTENT(out) :: ltype,scalef,scalev
1102 IF (lt == imiss)
THEN 1106 ELSE IF (lt <= 10 .OR. (lt >= 162 .AND. lt <= 166))
THEN 1110 ELSE IF (lt == 256 .AND. l == imiss)
THEN 1117 IF (any(ltype == height_level))
THEN 1142 END SUBROUTINE dballe_to_g2
1144 END SUBROUTINE level_dballe_to_g2
1147 SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1148 integer,
intent(in) :: ltype,l1,l2
1149 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1158 if (ltype > 0 .and. ltype <= 9)
then 1160 else if (ltype == 20)
then 1164 else if (ltype == 100)
then 1167 else if (ltype == 101)
then 1172 else if (ltype == 102)
then 1174 else if (ltype == 103)
then 1177 else if (ltype == 104)
then 1182 else if (ltype == 105)
then 1185 else if (ltype == 106)
then 1190 else if (ltype == 107)
then 1194 else if (ltype == 108)
then 1201 else if (ltype == 109)
then 1204 else if (ltype == 110)
then 1209 else if (ltype == 111)
then 1213 else if (ltype == 112)
then 1220 else if (ltype == 113)
then 1223 else if (ltype == 114)
then 1228 else if (ltype == 115)
then 1231 else if (ltype == 116)
then 1236 else if (ltype == 117)
then 1240 if ( btest(l1,15) )
then 1241 scalev1=-1*
mod(l1,32768)
1243 else if (ltype == 119)
then 1247 else if (ltype == 120)
then 1254 else if (ltype == 121)
then 1256 scalev1=(1100+l1)*100
1258 scalev2=(1100+l2)*100
1259 else if (ltype == 125)
then 1263 else if (ltype == 128)
then 1270 else if (ltype == 141)
then 1274 scalev2=(1100+l2)*100
1275 else if (ltype == 160)
then 1278 else if (ltype == 200)
then 1281 else if (ltype == 210)
then 1286 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1287 //
' cannot be converted to GRIB2.')
1291 END SUBROUTINE level_g1_to_g2
1294 SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1295 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1296 integer,
intent(out) :: ltype,l1,l2
1298 if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then 1302 else if (ltype1 == 20 .and. ltype2 == 255)
then 1304 l1 = rescale2(scalef1-2,scalev1)
1306 else if (ltype1 == 100 .and. ltype2 == 255)
then 1308 l1 = rescale2(scalef1+2,scalev1)
1310 else if (ltype1 == 100 .and. ltype2 == 100)
then 1312 l1 = rescale1(scalef1+3,scalev1)
1313 l2 = rescale1(scalef2+3,scalev2)
1314 else if (ltype1 == 101 .and. ltype2 == 255)
then 1318 else if (ltype1 == 102 .and. ltype2 == 255)
then 1320 l1 = rescale2(scalef1,scalev1)
1322 else if (ltype1 == 102 .and. ltype2 == 102)
then 1324 l1 = rescale1(scalef1+2,scalev1)
1325 l2 = rescale1(scalef2+2,scalev2)
1326 else if (ltype1 == 103 .and. ltype2 == 255)
then 1328 l1 = rescale2(scalef1,scalev1)
1330 else if (ltype1 == 103 .and. ltype2 == 103)
then 1332 l1 = rescale1(scalef1+2,scalev1)
1333 l2 = rescale1(scalef2+2,scalev2)
1334 else if (ltype1 == 104 .and. ltype2 == 255)
then 1336 l1 = rescale2(scalef1,scalev1-4)
1338 else if (ltype1 == 104 .and. ltype2 == 104)
then 1340 l1 = rescale1(scalef1-2,scalev1)
1341 l2 = rescale1(scalef2-2,scalev2)
1342 else if (ltype1 == 105 .and. ltype2 == 255)
then 1344 l1 = rescale2(scalef1,scalev1)
1346 else if (ltype1 == 105 .and. ltype2 == 105)
then 1348 l1 = rescale1(scalef1,scalev1)
1349 l2 = rescale1(scalef2,scalev2)
1350 else if (ltype1 == 106 .and. ltype2 == 255)
then 1352 l1 = rescale2(scalef1-2,scalev1)
1354 else if (ltype1 == 106 .and. ltype2 == 106)
then 1356 l1 = rescale1(scalef1-2,scalev1)
1357 l2 = rescale1(scalef2-2,scalev2)
1358 else if (ltype1 == 107 .and. ltype2 == 255)
then 1360 l1 = rescale2(scalef1,scalev1)
1362 else if (ltype1 == 107 .and. ltype2 == 107)
then 1364 l1 = rescale1(scalef1,scalev1)
1365 l2 = rescale1(scalef2,scalev2)
1366 else if (ltype1 == 108 .and. ltype2 == 255)
then 1368 l1 = rescale2(scalef1+2,scalev1)
1370 else if (ltype1 == 108 .and. ltype2 == 108)
then 1372 l1 = rescale1(scalef1+2,scalev1)
1373 l2 = rescale1(scalef2+2,scalev2)
1374 else if (ltype1 == 109 .and. ltype2 == 255)
then 1376 l1 = rescale2(scalef1+9,scalev1)
1378 else if (ltype1 == 111 .and. ltype2 == 255)
then 1380 l1 = rescale2(scalef1-2,scalev1)
1382 else if (ltype1 == 111 .and. ltype2 == 111)
then 1384 l1 = rescale1(scalef1-4,scalev1)
1385 l2 = rescale1(scalef2-4,scalev2)
1386 else if (ltype1 == 160 .and. ltype2 == 255)
then 1388 l1 = rescale2(scalef1,scalev1)
1390 else if (ltype1 == 1 .and. ltype2 == 8)
then 1392 else if (ltype1 == 1 .and. ltype2 == 9)
then 1399 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1400 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1406 FUNCTION rescale1(scalef, scalev)
RESULT(rescale)
1407 INTEGER,
INTENT(in) :: scalef, scalev
1410 rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1412 END FUNCTION rescale1
1414 FUNCTION rescale2(scalef, scalev)
RESULT(rescale)
1415 INTEGER,
INTENT(in) :: scalef, scalev
1418 rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1420 END FUNCTION rescale2
1422 END SUBROUTINE level_g2_to_g1
1433 SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1434 INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1435 INTEGER,
INTENT(out) :: statproc, p1, p2
1437 IF (tri == 0 .OR. tri == 1)
THEN 1439 CALL g1_interval_to_second(unit, p1_g1, p1)
1441 ELSE IF (tri == 10)
THEN 1443 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1445 ELSE IF (tri == 2)
THEN 1447 CALL g1_interval_to_second(unit, p2_g1, p1)
1448 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1449 ELSE IF (tri == 3)
THEN 1451 CALL g1_interval_to_second(unit, p2_g1, p1)
1452 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1453 ELSE IF (tri == 4)
THEN 1455 CALL g1_interval_to_second(unit, p2_g1, p1)
1456 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1457 ELSE IF (tri == 5)
THEN 1459 CALL g1_interval_to_second(unit, p2_g1, p1)
1460 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1461 ELSE IF (tri == 13)
THEN 1464 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1466 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1467 //
' cannot be converted to GRIB2.')
1471 if (statproc == 254 .and. p2 /= 0 )
then 1472 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1475 END SUBROUTINE timerange_g1_to_v7d
1496 SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1497 INTEGER,
INTENT(in) :: unit, valuein
1498 INTEGER,
INTENT(out) :: valueout
1500 INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1501 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1504 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1505 IF (
c_e(unitlist(unit)))
THEN 1506 valueout = valuein*unitlist(unit)
1510 END SUBROUTINE g1_interval_to_second
1513 SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1514 INTEGER,
INTENT(in) :: unit, valuein
1515 INTEGER,
INTENT(out) :: valueout
1517 INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1518 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1521 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN 1522 IF (
c_e(unitlist(unit)))
THEN 1523 valueout = valuein*unitlist(unit)
1527 END SUBROUTINE g2_interval_to_second
1541 SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1542 INTEGER,
INTENT(in) :: statproc, p1, p2
1543 INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1545 INTEGER :: ptmp, pdl
1548 IF (statproc == 254) pdl = p1
1550 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1551 IF (statproc == 0)
THEN 1553 ELSE IF (statproc == 1)
THEN 1555 ELSE IF (statproc == 4)
THEN 1557 ELSE IF (statproc == 205)
THEN 1559 ELSE IF (statproc == 257)
THEN 1566 ELSE IF (statproc == 254)
THEN 1570 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1571 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1575 IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN 1576 ptmp = max(p1_g1,p2_g1)
1577 p2_g1 =
mod(ptmp,256)
1580 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1581 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1591 p2_g1 = p2_g1 - ptmp
1595 END SUBROUTINE timerange_v7d_to_g1
1598 SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1599 INTEGER,
INTENT(in) :: valuein
1600 INTEGER,
INTENT(out) :: valueout, unit
1602 IF (valuein == imiss)
THEN 1605 ELSE IF (
mod(valuein,3600) == 0)
THEN 1606 valueout = valuein/3600
1608 ELSE IF (
mod(valuein,60) == 0)
THEN 1609 valueout = valuein/60
1616 END SUBROUTINE timerange_v7d_to_g2
1626 SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1627 INTEGER,
INTENT(in) :: valuein1, valuein2
1628 INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1633 INTEGER :: sectounit
1634 END TYPE unitchecker
1636 TYPE(unitchecker),
PARAMETER :: hunit(5) = (/ &
1637 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1638 unitchecker(12, 43200), unitchecker(2, 86400) /)
1639 TYPE(unitchecker),
PARAMETER :: munit(3) = (/ &
1640 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1643 IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN 1647 ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN 1648 DO i = 1,
SIZE(hunit)
1649 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1650 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1651 .AND. valuein1/hunit(i)%sectounit < 255 &
1652 .AND. valuein2/hunit(i)%sectounit < 255)
THEN 1653 valueout1 = valuein1/hunit(i)%sectounit
1654 valueout2 = valuein2/hunit(i)%sectounit
1655 unit = hunit(i)%unit
1659 IF (.NOT.
c_e(unit))
THEN 1661 DO i =
SIZE(hunit), 1, -1
1662 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1663 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN 1664 valueout1 = valuein1/hunit(i)%sectounit
1665 valueout2 = valuein2/hunit(i)%sectounit
1666 unit = hunit(i)%unit
1671 ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN 1672 DO i = 1,
SIZE(munit)
1673 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1674 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1675 .AND. valuein1/munit(i)%sectounit < 255 &
1676 .AND. valuein2/munit(i)%sectounit < 255)
THEN 1677 valueout1 = valuein1/munit(i)%sectounit
1678 valueout2 = valuein2/munit(i)%sectounit
1679 unit = munit(i)%unit
1683 IF (.NOT.
c_e(unit))
THEN 1685 DO i =
SIZE(munit), 1, -1
1686 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1687 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN 1688 valueout1 = valuein1/munit(i)%sectounit
1689 valueout2 = valuein2/munit(i)%sectounit
1690 unit = munit(i)%unit
1697 IF (.NOT.
c_e(unit))
THEN 1698 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1699 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1703 END SUBROUTINE timerange_choose_unit_g1
1719 SUBROUTINE normalize_gridinfo(this)
1720 TYPE(gridinfo_def),
intent(inout) :: this
1722 IF (this%timerange%timerange == 254)
THEN 1725 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1731 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1736 ELSE IF (this%timerange%timerange == 205)
THEN 1739 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN 1741 this%timerange%timerange=3
1746 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN 1748 this%timerange%timerange=2
1753 IF (this%var%discipline == 255 .AND. &
1754 any(this%var%centre == cosmo_centre))
THEN 1756 IF (this%var%category == 201)
THEN 1758 IF (this%var%number == 187)
THEN 1761 this%timerange%timerange=2
1766 ELSE IF (this%timerange%timerange == 257)
THEN 1768 IF (this%timerange%p2 == 0)
THEN 1770 this%timerange%timerange=254
1774 IF (this%var%discipline == 255 .AND. &
1775 any(this%var%centre == cosmo_centre))
THEN 1777 IF (this%var%category == 2)
THEN 1779 if (this%var%number == 11)
then 1780 this%timerange%timerange=0
1782 else if (this%var%number == 15)
then 1783 this%timerange%timerange=2
1786 else if (this%var%number == 16)
then 1787 this%timerange%timerange=3
1790 else if (this%var%number == 17)
then 1791 this%timerange%timerange=0
1793 else if (this%var%number == 33)
then 1794 this%timerange%timerange=0
1796 else if (this%var%number == 34)
then 1797 this%timerange%timerange=0
1799 else if (this%var%number == 57)
then 1800 this%timerange%timerange=1
1802 else if (this%var%number == 61)
then 1803 this%timerange%timerange=1
1805 else if (this%var%number == 78)
then 1806 this%timerange%timerange=1
1808 else if (this%var%number == 79)
then 1809 this%timerange%timerange=1
1811 else if (this%var%number == 90)
then 1812 this%timerange%timerange=1
1814 else if (this%var%number == 111)
then 1815 this%timerange%timerange=0
1816 else if (this%var%number == 112)
then 1817 this%timerange%timerange=0
1818 else if (this%var%number == 113)
then 1819 this%timerange%timerange=0
1820 else if (this%var%number == 114)
then 1821 this%timerange%timerange=0
1822 else if (this%var%number == 121)
then 1823 this%timerange%timerange=0
1824 else if (this%var%number == 122)
then 1825 this%timerange%timerange=0
1826 else if (this%var%number == 124)
then 1827 this%timerange%timerange=0
1828 else if (this%var%number == 125)
then 1829 this%timerange%timerange=0
1830 else if (this%var%number == 126)
then 1831 this%timerange%timerange=0
1832 else if (this%var%number == 127)
then 1833 this%timerange%timerange=0
1837 ELSE IF (this%var%category == 201)
THEN 1839 if (this%var%number == 5)
then 1840 this%timerange%timerange=0
1842 else if (this%var%number == 20)
then 1843 this%timerange%timerange=1
1845 else if (this%var%number == 22)
then 1846 this%timerange%timerange=0
1847 else if (this%var%number == 23)
then 1848 this%timerange%timerange=0
1849 else if (this%var%number == 24)
then 1850 this%timerange%timerange=0
1851 else if (this%var%number == 25)
then 1852 this%timerange%timerange=0
1853 else if (this%var%number == 26)
then 1854 this%timerange%timerange=0
1855 else if (this%var%number == 27)
then 1856 this%timerange%timerange=0
1858 else if (this%var%number == 42)
then 1859 this%timerange%timerange=1
1861 else if (this%var%number == 102)
then 1862 this%timerange%timerange=1
1864 else if (this%var%number == 113)
then 1865 this%timerange%timerange=1
1867 else if (this%var%number == 132)
then 1868 this%timerange%timerange=1
1870 else if (this%var%number == 135)
then 1871 this%timerange%timerange=1
1873 else if (this%var%number == 187)
then 1876 this%timerange%timerange=2
1878 else if (this%var%number == 218)
then 1879 this%timerange%timerange=2
1881 else if (this%var%number == 219)
then 1882 this%timerange%timerange=2
1886 ELSE IF (this%var%category == 202)
THEN 1888 if (this%var%number == 231)
then 1889 this%timerange%timerange=0
1890 else if (this%var%number == 232)
then 1891 this%timerange%timerange=0
1892 else if (this%var%number == 233)
then 1893 this%timerange%timerange=0
1899 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1900 trim(
to_char(this%timerange%p2)))
1902 'associated to an apparently instantaneous parameter '//&
1903 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1904 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1907 this%timerange%p2 = 0
1908 this%timerange%timerange = 254
1915 IF (this%var%discipline == 255 .AND. &
1916 any(this%var%centre == ecmwf_centre))
THEN 1921 IF (this%var%category == 128)
THEN 1923 IF ((this%var%number == 142 .OR. &
1924 this%var%number == 143 .OR. &
1925 this%var%number == 144 .OR. &
1926 this%var%number == 228 .OR. &
1927 this%var%number == 145 .OR. &
1928 this%var%number == 146 .OR. &
1929 this%var%number == 147 .OR. &
1930 this%var%number == 169) .AND. &
1931 this%timerange%timerange == 254)
THEN 1932 this%timerange%timerange = 1
1933 this%timerange%p2 = this%timerange%p1
1935 ELSE IF ((this%var%number == 165 .OR. &
1936 this%var%number == 166) .AND. &
1937 this%level%level1 == 1)
THEN 1938 this%level%level1 = 103
1939 this%level%l1 = 10000
1941 ELSE IF ((this%var%number == 167 .OR. &
1942 this%var%number == 168) .AND. &
1943 this%level%level1 == 1)
THEN 1944 this%level%level1 = 103
1945 this%level%l1 = 2000
1947 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN 1948 this%level%level1 = 106
1952 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN 1953 this%level%level1 = 106
1957 ELSE IF (this%var%number == 171)
THEN 1958 this%level%level1 = 106
1962 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN 1963 this%level%level1 = 106
1965 this%level%l2 = 1000
1967 ELSE IF (this%var%number == 184)
THEN 1968 this%level%level1 = 106
1970 this%level%l2 = 1000
1972 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN 1973 this%level%level1 = 106
1974 this%level%l1 = 1000
1975 this%level%l2 = 2890
1977 ELSE IF (this%var%number == 121 .AND. &
1978 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 1979 this%timerange%timerange = 2
1980 this%timerange%p2 = 21600
1982 this%level%level1 = 103
1983 this%level%l1 = 2000
1985 ELSE IF (this%var%number == 122 .AND. &
1986 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 1987 this%timerange%timerange = 3
1988 this%timerange%p2 = 21600
1991 this%level%level1 = 103
1992 this%level%l1 = 2000
1994 ELSE IF (this%var%number == 123 .AND. &
1995 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 1996 this%timerange%timerange = 2
1997 this%timerange%p2 = 21600
1998 this%level%level1 = 103
1999 this%level%l1 = 10000
2002 ELSE IF (this%var%number == 186)
THEN 2003 this%var%number = 248
2004 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2005 ELSE IF (this%var%number == 187)
THEN 2006 this%var%number = 248
2007 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2008 ELSE IF (this%var%number == 188)
THEN 2009 this%var%number = 248
2010 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2013 ELSE IF (this%var%category == 228)
THEN 2015 IF (this%var%number == 24)
THEN 2016 this%level%level1 = 4
2018 this%level%level2 = 255
2021 ELSE IF (this%var%number == 28 .AND. &
2022 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN 2023 this%timerange%timerange = 2
2024 this%timerange%p2 = 10800
2025 this%level%level1 = 103
2026 this%level%l1 = 10000
2033 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN 2036 IF (this%var%number == 73)
THEN 2037 this%var%number = 71
2038 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2039 ELSE IF (this%var%number == 74)
THEN 2040 this%var%number = 71
2041 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2042 ELSE IF (this%var%number == 75)
THEN 2043 this%var%number = 71
2044 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2051 END SUBROUTINE normalize_gridinfo
2062 SUBROUTINE unnormalize_gridinfo(this)
2063 TYPE(gridinfo_def),
intent(inout) :: this
2065 IF (this%timerange%timerange == 3)
THEN 2067 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2069 this%timerange%timerange=205
2071 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2072 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2074 this%timerange%timerange=205
2078 ELSE IF (this%timerange%timerange == 2)
THEN 2080 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN 2082 this%timerange%timerange=205
2084 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN 2085 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN 2087 this%timerange%timerange=205
2089 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN 2090 this%timerange%timerange=205
2092 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN 2093 this%timerange%timerange=205
2096 ELSE IF (any(this%var%centre == cosmo_centre))
THEN 2105 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN 2106 this%timerange%timerange=205
2112 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN 2113 IF (this%var%number == 71 .AND. &
2114 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2115 IF (this%level%l2 == 1)
THEN 2116 this%var%number = 73
2117 ELSE IF (this%level%l2 == 2)
THEN 2118 this%var%number = 74
2119 ELSE IF (this%level%l2 == 3)
THEN 2120 this%var%number = 75
2122 this%level = vol7d_level_new(level1=1)
2126 IF (any(this%var%centre == ecmwf_centre))
THEN 2128 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN 2129 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2130 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN 2131 IF (this%level%l2 == 1)
THEN 2132 this%var%number = 186
2133 ELSE IF (this%level%l2 == 2)
THEN 2134 this%var%number = 187
2135 ELSE IF (this%level%l2 == 3)
THEN 2136 this%var%number = 188
2138 this%level = vol7d_level_new(level1=1)
2143 END SUBROUTINE unnormalize_gridinfo
2152 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2153 TYPE(gridinfo_def),
INTENT(inout) :: this
2154 TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2156 TYPE(gdaldataseth) :: hds
2160 this%time = datetime_new(year=2010, month=1, day=1)
2163 this%timerange = vol7d_timerange_new(254, 0, 0)
2166 hds = gdalgetbanddataset(gdalid)
2167 IF (gdalgetrastercount(hds) == 1)
THEN 2168 this%level = vol7d_level_new(1, 0)
2170 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2174 this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2176 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...
Definisce il livello verticale di un'osservazione.
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.