61 #ifdef HAVE_LIBGRIBAPI
74 character (len=255),
parameter:: subcategory=
"gridinfo_class"
80 type(datetime) :: time
81 type(vol7d_timerange) :: timerange
82 type(vol7d_level) :: level
85 INTEGER :: category = 0
88 INTEGER,
PARAMETER :: &
89 cosmo_centre(3) = (/78,80,200/), &
90 ecmwf_centre(1) = (/98/)
94 MODULE PROCEDURE gridinfo_init
99 MODULE PROCEDURE gridinfo_delete
105 MODULE PROCEDURE gridinfo_clone
111 MODULE PROCEDURE gridinfo_import, gridinfo_import_from_file
118 MODULE PROCEDURE gridinfo_export, gridinfo_export_to_file
126 MODULE PROCEDURE gridinfo_display, gridinfov_display
132 MODULE PROCEDURE gridinfo_decode_data
137 MODULE PROCEDURE gridinfo_encode_data
140 #define ARRAYOF_ORIGTYPE TYPE(gridinfo_def)
141 #define ARRAYOF_TYPE arrayof_gridinfo
142 #define ARRAYOF_ORIGDESTRUCTOR(x) CALL delete(x)
143 #include "arrayof_pre.F90"
153 #include "arrayof_post.F90"
158 SUBROUTINE gridinfo_init(this, gaid, griddim, time, timerange, level, var, &
159 clone, categoryappend)
161 type(
grid_id),
intent(in),
optional :: gaid
163 type(datetime),
intent(in),
optional :: time
164 type(vol7d_timerange),
intent(in),
optional :: timerange
165 type(vol7d_level),
intent(in),
optional :: level
167 logical ,
intent(in),
optional ::
clone
168 character(len=*),
INTENT(in),
OPTIONAL :: categoryappend
170 character(len=512) :: a_name
172 if (present(categoryappend))
then
173 call l4f_launcher(a_name,a_name_append=trim(subcategory)//
"."//trim(categoryappend))
175 call l4f_launcher(a_name,a_name_append=trim(subcategory))
177 this%category=l4f_category_get(a_name)
183 if (present(gaid))
then
184 if (optio_log(
clone))
then
185 CALL
copy(gaid,this%gaid)
190 this%gaid = grid_id_new()
198 if (present(griddim))
then
199 call
copy(griddim,this%griddim)
201 call
init(this%griddim,categoryappend=categoryappend)
204 if (present(time))
then
210 if (present(timerange))
then
211 this%timerange=timerange
213 call
init(this%timerange)
216 if (present(level))
then
219 call
init(this%level)
222 if (present(var))
then
228 END SUBROUTINE gridinfo_init
233 SUBROUTINE gridinfo_delete(this)
242 call
delete(this%timerange)
252 call l4f_category_delete(this%category)
254 END SUBROUTINE gridinfo_delete
263 SUBROUTINE gridinfo_display(this, namespace)
265 CHARACTER (len=*),
OPTIONAL :: namespace
271 print*,
"----------------------- gridinfo display ---------------------"
277 call
display(this%gaid, namespace=namespace)
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)
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)
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)
364 CHARACTER(len=*),
INTENT(in) :: filename
365 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
368 INTEGER :: ngrid, category
369 CHARACTER(len=512) :: a_name
373 IF (present(categoryappend))
THEN
374 CALL l4f_launcher(a_name,a_name_append= &
375 trim(subcategory)//
"."//trim(categoryappend))
377 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
379 category=l4f_category_get(a_name)
385 input_file = grid_file_id_new(filename,
'r')
389 input_grid = grid_id_new(input_file)
390 IF (.NOT.
c_e(input_grid))
EXIT
394 IF (present(categoryappend))
THEN
395 CALL
init(gridinfol, gaid=input_grid, &
396 categoryappend=trim(categoryappend)//
"-msg"//trim(
to_char(ngrid)))
398 CALL
init(gridinfol, gaid=input_grid, &
399 categoryappend=
"msg"//trim(
to_char(ngrid)))
402 CALL
insert(this, gridinfol)
409 "gridinfo_import, "//
t2c(ngrid)//
" messages/bands imported from file "// &
415 CALL l4f_category_delete(category)
417 END SUBROUTINE gridinfo_import_from_file
426 SUBROUTINE gridinfo_export(this)
429 #ifdef HAVE_LIBGRIBAPI
441 CALL
export(this%griddim, this%gaid)
443 #ifdef HAVE_LIBGRIBAPI
444 IF (grid_id_get_driver(this%gaid) ==
'grib_api')
THEN
445 gaid = grid_id_get_gaid(this%gaid)
446 IF (
c_e(gaid)) CALL gridinfo_export_gribapi(this, gaid)
450 IF (grid_id_get_driver(this%gaid) ==
'gdal')
THEN
452 CALL
l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
456 END SUBROUTINE gridinfo_export
464 SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
466 CHARACTER(len=*),
INTENT(in) :: filename
467 CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
469 INTEGER :: i, category
470 CHARACTER(len=512) :: a_name
474 IF (present(categoryappend))
THEN
475 CALL l4f_launcher(a_name,a_name_append= &
476 trim(subcategory)//
"."//trim(categoryappend))
478 CALL l4f_launcher(a_name,a_name_append=trim(subcategory))
480 category=l4f_category_get(a_name)
484 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
487 valid_grid_id = grid_id_new()
488 DO i = 1, this%arraysize
489 IF (
c_e(this%array(i)%gaid))
THEN
490 valid_grid_id = this%array(i)%gaid
495 IF (
c_e(valid_grid_id))
THEN
497 output_file = grid_file_id_new(filename,
'w', from_grid_id=valid_grid_id)
498 IF (
c_e(output_file))
THEN
499 DO i = 1, this%arraysize
500 CALL
export(this%array(i))
501 CALL
export(this%array(i)%gaid, output_file)
511 "gridinfo object of size "//
t2c(this%arraysize))
513 "no valid grid id found when exporting to file "//trim(filename))
518 CALL l4f_category_delete(category)
520 END SUBROUTINE gridinfo_export_to_file
531 FUNCTION gridinfo_decode_data(this) RESULT(field)
533 REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
535 CALL grid_id_decode_data(this%gaid, field)
537 END FUNCTION gridinfo_decode_data
547 SUBROUTINE gridinfo_encode_data(this, field)
549 REAL,
intent(in) :: field(:,:)
551 IF (
SIZE(field,1) /= this%griddim%dim%nx &
552 .OR.
SIZE(field,2) /= this%griddim%dim%ny)
THEN
554 'gridinfo_encode: field and gridinfo object non conformal, field: ' &
555 //trim(
to_char(
SIZE(field,1)))//
'X'//trim(
to_char(
SIZE(field,2)))//
', nx,ny:' &
556 //trim(
to_char(this%griddim%dim%nx))//
'X'//trim(
to_char(this%griddim%dim%ny)))
561 CALL grid_id_encode_data(this%gaid, field)
563 END SUBROUTINE gridinfo_encode_data
570 #ifdef HAVE_LIBGRIBAPI
571 SUBROUTINE gridinfo_import_gribapi(this, gaid)
573 INTEGER,
INTENT(in) :: gaid
575 call time_import_gribapi(this%time, gaid)
576 call timerange_import_gribapi(this%timerange,gaid)
577 call level_import_gribapi(this%level, gaid)
578 call var_import_gribapi(this%var, gaid)
580 call normalize_gridinfo(this)
582 END SUBROUTINE gridinfo_import_gribapi
586 SUBROUTINE gridinfo_export_gribapi(this, gaid)
588 INTEGER,
INTENT(in) :: gaid
591 REAL,
ALLOCATABLE :: tmparr(:,:)
594 CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
595 IF (this%var == volgrid6d_var_miss)
THEN
596 CALL l4f_log(l4f_error, &
597 'A suitable variable has not been found in table when converting template')
600 IF (c_func /= conv_func_miss)
THEN
606 CALL unnormalize_gridinfo(this)
608 CALL time_export_gribapi(this%time, gaid, this%timerange)
609 CALL timerange_export_gribapi(this%timerange, gaid, this%time)
610 CALL level_export_gribapi(this%level, gaid)
611 CALL var_export_gribapi(this%var, gaid)
613 END SUBROUTINE gridinfo_export_gribapi
616 SUBROUTINE time_import_gribapi(this,gaid)
617 TYPE(datetime
),
INTENT(out) :: this
618 INTEGER,
INTENT(in) :: gaid
620 INTEGER :: editionnumber, ttimeincr, tprocdata, centre, p2g, p2, unit, status
621 CHARACTER(len=9) :: date
622 CHARACTER(len=10) :: time
624 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
626 IF (editionnumber == 1 .OR. editionnumber == 2)
THEN
628 CALL grib_get(gaid,
'dataDate',date )
629 CALL grib_get(gaid,
'dataTime',time(:5) )
631 CALL
init(this,simpledate=date(:8)//time(:4))
633 IF (editionnumber == 2)
THEN
635 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
636 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr,status)
639 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 .AND. tprocdata == 0)
THEN
649 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
650 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
651 CALL g2_interval_to_second(unit, p2g, p2)
652 CALL grib_get(gaid,
'centre',centre)
653 IF (centre /= 78)
THEN
654 this = this + timedelta_new(sec=p2)
656 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
657 status /= grib_success)
THEN
660 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
667 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
672 END SUBROUTINE time_import_gribapi
675 SUBROUTINE time_export_gribapi(this, gaid, timerange)
676 TYPE(datetime
),
INTENT(in) :: this
677 INTEGER,
INTENT(in) :: gaid
678 TYPE(vol7d_timerange
) :: timerange
680 INTEGER :: editionnumber, centre
681 CHARACTER(len=8) :: env_var
682 LOGICAL :: g2cosmo_behavior
684 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
686 IF (editionnumber == 1)
THEN
688 CALL code_referencetime(this)
690 ELSE IF (editionnumber == 2 )
THEN
692 IF (timerange%p1 >= timerange%p2)
THEN
693 CALL code_referencetime(this)
694 ELSE IF (timerange%p1 == 0)
THEN
696 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
697 g2cosmo_behavior = len_trim(env_var) > 0
698 CALL grib_get(gaid,
'centre',centre)
699 IF (g2cosmo_behavior .AND. centre == 78)
THEN
700 CALL code_referencetime(this)
702 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
705 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
711 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
718 SUBROUTINE code_referencetime(reftime)
719 TYPE(datetime
),
INTENT(in) :: reftime
722 CHARACTER(len=17) :: date_time
725 CALL
getval(reftime, simpledate=date_time)
726 READ(date_time(:8),
'(I8)')date
727 READ(date_time(9:12),
'(I4)')time
728 CALL grib_set(gaid,
'dataDate',date)
729 CALL grib_set(gaid,
'dataTime',time)
731 END SUBROUTINE code_referencetime
733 END SUBROUTINE time_export_gribapi
736 SUBROUTINE level_import_gribapi(this, gaid)
737 TYPE(vol7d_level
),
INTENT(out) :: this
738 INTEGER,
INTENT(in) :: gaid
740 INTEGER :: editionnumber,level1,l1,level2,l2
741 INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
743 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
745 if (editionnumber == 1)
then
747 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
748 call grib_get(gaid,
'topLevel',l1)
749 call grib_get(gaid,
'bottomLevel',l2)
751 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
753 else if (editionnumber == 2)
then
755 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
756 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
757 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
758 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN
759 scalef1 = imiss; scalev1 = imiss
762 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
763 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
764 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
765 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN
766 scalef2 = imiss; scalev2 = imiss
771 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
777 call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
780 call
init(this,level1,l1,level2,l2)
782 END SUBROUTINE level_import_gribapi
785 SUBROUTINE level_export_gribapi(this, gaid)
786 TYPE(vol7d_level
),
INTENT(in) :: this
787 INTEGER,
INTENT(in) :: gaid
789 INTEGER :: editionnumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
792 CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
793 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
795 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
797 if (editionnumber == 1)
then
799 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
801 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
804 call grib_set(gaid,
'bottomLevel',l2)
805 call grib_set(gaid,
'topLevel',l1)
807 else if (editionnumber == 2)
then
809 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
810 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN
811 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
812 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
814 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
815 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
818 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
819 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN
820 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
821 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
823 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
824 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
829 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
834 END SUBROUTINE level_export_gribapi
837 SUBROUTINE timerange_import_gribapi(this, gaid)
838 TYPE(vol7d_timerange
),
INTENT(out) :: this
839 INTEGER,
INTENT(in) :: gaid
841 INTEGER :: editionnumber, tri, unit, p1g, p2g, p1, p2, statproc, &
842 ttimeincr, tprocdata, status
844 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
846 IF (editionnumber == 1)
THEN
848 CALL grib_get(gaid,
'timeRangeIndicator',tri)
849 CALL grib_get(gaid,
'P1',p1g)
850 CALL grib_get(gaid,
'P2',p2g)
851 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
852 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
854 ELSE IF (editionnumber == 2)
THEN
856 CALL grib_get(gaid,
'forecastTime',p1g)
857 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
858 CALL g2_interval_to_second(unit, p1g, p1)
859 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
861 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN
862 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
863 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
864 CALL g2_interval_to_second(unit, p2g, p2)
867 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
868 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
869 IF (ttimeincr == 2 .AND. tprocdata /= 0)
THEN
873 CALL l4f_log(l4f_warn,
'Found p1>0 in grib2 analysis data, strange things may happen')
884 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
889 CALL
init(this, statproc, p1, p2)
891 END SUBROUTINE timerange_import_gribapi
894 SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
895 TYPE(vol7d_timerange
),
INTENT(in) :: this
896 INTEGER,
INTENT(in) :: gaid
897 TYPE(datetime
) :: reftime
899 INTEGER :: editionnumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
900 CHARACTER(len=8) :: env_var
901 LOGICAL :: g2cosmo_behavior
903 CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
905 IF (editionnumber == 1 )
THEN
907 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
908 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
909 tri, p1_g1, p2_g1, unit)
911 CALL grib_set(gaid,
'timeRangeIndicator',tri)
912 CALL grib_set(gaid,
'P1',p1_g1)
913 CALL grib_set(gaid,
'P2',p2_g1)
914 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
916 ELSE IF (editionnumber == 2)
THEN
917 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
919 IF (this%timerange == 254)
THEN
920 IF (pdtn < 0 .OR. pdtn > 7) &
921 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
923 CALL timerange_v7d_to_g2(this%p1,p1,unit)
925 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
926 CALL grib_set(gaid,
'forecastTime',p1)
928 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN
930 IF (pdtn < 8 .OR. pdtn > 14) &
931 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
933 IF (this%p1 >= this%p2)
THEN
935 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
936 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
937 CALL grib_set(gaid,
'forecastTime',p1)
938 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
941 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
943 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
944 CALL timerange_v7d_to_g2(this%p2,p2,unit)
945 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
946 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
948 ELSE IF (this%p1 == 0)
THEN
950 CALL timerange_v7d_to_g2(this%p2,p2,unit)
951 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
952 CALL grib_set(gaid,
'forecastTime',0)
953 CALL code_endoftimeinterval(reftime)
956 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
958 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
959 g2cosmo_behavior = len_trim(env_var) > 0
960 IF (g2cosmo_behavior)
THEN
961 CALL grib_set(gaid,
'typeOfProcessedData',0)
963 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
965 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
966 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
969 IF (this%timerange >= 192)
THEN
970 CALL l4f_log(l4f_warn, &
971 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
975 CALL l4f_log(l4f_error, &
976 'Timerange with 0>p1>p2 cannot be exported in grib2')
977 CALL raise_fatal_error()
980 CALL l4f_log(l4f_error, &
981 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
982 CALL raise_fatal_error()
986 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
987 CALL raise_fatal_error()
994 SUBROUTINE code_endoftimeinterval(endtime)
995 TYPE(datetime
),
INTENT(in) :: endtime
997 INTEGER :: year, month, day, hour, minute, msec
999 CALL
getval(endtime, year=year, month=month, day=day, &
1000 hour=hour, minute=minute, msec=msec)
1001 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
1002 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
1003 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
1004 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
1005 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
1006 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
1008 END SUBROUTINE code_endoftimeinterval
1010 END SUBROUTINE timerange_export_gribapi
1013 SUBROUTINE var_import_gribapi(this, gaid)
1015 INTEGER,
INTENT(in) :: gaid
1017 INTEGER :: editionnumber, centre, discipline, category, number
1019 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1021 if (editionnumber == 1)
then
1023 call grib_get(gaid,
'centre',centre)
1024 call grib_get(gaid,
'gribTablesVersionNo',category)
1025 call grib_get(gaid,
'indicatorOfParameter',number)
1027 call
init(this, centre, category, number)
1029 else if (editionnumber == 2)
then
1031 call grib_get(gaid,
'centre',centre)
1032 call grib_get(gaid,
'discipline',discipline)
1033 call grib_get(gaid,
'parameterCategory',category)
1034 call grib_get(gaid,
'parameterNumber',number)
1036 call
init(this, centre, category, number, discipline)
1040 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1045 END SUBROUTINE var_import_gribapi
1048 SUBROUTINE var_export_gribapi(this, gaid)
1050 INTEGER,
INTENT(in) :: gaid
1052 INTEGER ::editionnumber
1054 call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1056 if (editionnumber == 1)
then
1058 IF (this%centre /= 255) &
1059 CALL grib_set(gaid,
'centre',this%centre)
1060 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1061 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1063 else if (editionnumber == 2)
then
1066 IF (this%centre /= 255) &
1067 CALL grib_set(gaid,
'centre',this%centre)
1068 CALL grib_set(gaid,
'discipline',this%discipline)
1069 CALL grib_set(gaid,
'parameterCategory',this%category)
1070 CALL grib_set(gaid,
'parameterNumber',this%number)
1074 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1079 END SUBROUTINE var_export_gribapi
1082 SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1083 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1084 integer,
intent(out) ::lt1,l1,lt2,l2
1087 CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1088 CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1092 SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1093 integer,
intent(in) :: ltype,scalef,scalev
1094 integer,
intent(out) :: lt,l
1096 doubleprecision :: sl
1099 IF (ltype == 255 .OR. ltype == -1)
THEN
1102 ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN
1107 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN
1108 sl = scalev*(10.d0**(-scalef))
1110 IF (any(ltype == height_level))
THEN
1111 l = nint(sl*1000.d0)
1112 ELSE IF (any(ltype == thermo_level))
THEN
1114 ELSE IF (any(ltype == sigma_level))
THEN
1115 l = nint(sl*10000.d0)
1124 END SUBROUTINE g2_to_dballe
1126 END SUBROUTINE level_g2_to_dballe
1129 SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1130 integer,
intent(in) :: lt1,l1,lt2,l2
1131 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1133 CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1134 CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1138 SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1139 INTEGER,
INTENT(in) :: lt,l
1140 INTEGER,
INTENT(out) :: ltype,scalef,scalev
1143 IF (lt == imiss)
THEN
1147 ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN
1151 ELSE IF (lt == 256 .AND. l == imiss)
THEN
1158 IF (any(ltype == height_level))
THEN
1160 ELSE IF (any(ltype == thermo_level))
THEN
1162 ELSE IF (any(ltype == sigma_level))
THEN
1187 END SUBROUTINE dballe_to_g2
1189 END SUBROUTINE level_dballe_to_g2
1192 SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1193 integer,
intent(in) :: ltype,l1,l2
1194 integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1203 if (ltype > 0 .and. ltype <= 9)
then
1205 else if (ltype == 20)
then
1209 else if (ltype == 100)
then
1212 else if (ltype == 101)
then
1217 else if (ltype == 102)
then
1219 else if (ltype == 103)
then
1222 else if (ltype == 104)
then
1227 else if (ltype == 105)
then
1230 else if (ltype == 106)
then
1235 else if (ltype == 107)
then
1239 else if (ltype == 108)
then
1246 else if (ltype == 109)
then
1249 else if (ltype == 110)
then
1254 else if (ltype == 111)
then
1258 else if (ltype == 112)
then
1265 else if (ltype == 113)
then
1268 else if (ltype == 114)
then
1273 else if (ltype == 115)
then
1276 else if (ltype == 116)
then
1281 else if (ltype == 117)
then
1285 if ( btest(l1,15) )
then
1286 scalev1=-1*
mod(l1,32768)
1288 else if (ltype == 119)
then
1292 else if (ltype == 120)
then
1299 else if (ltype == 121)
then
1301 scalev1=(1100+l1)*100
1303 scalev2=(1100+l2)*100
1304 else if (ltype == 125)
then
1308 else if (ltype == 128)
then
1315 else if (ltype == 141)
then
1319 scalev2=(1100+l2)*100
1320 else if (ltype == 160)
then
1323 else if (ltype == 200)
then
1326 else if (ltype == 210)
then
1331 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1332 //
' cannot be converted to GRIB2.')
1336 END SUBROUTINE level_g1_to_g2
1339 SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1340 integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1341 integer,
intent(out) :: ltype,l1,l2
1343 if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then
1347 else if (ltype1 == 20 .and. ltype2 == 255)
then
1349 l1 = rescale2(scalef1-2,scalev1)
1351 else if (ltype1 == 100 .and. ltype2 == 255)
then
1353 l1 = rescale2(scalef1+2,scalev1)
1355 else if (ltype1 == 100 .and. ltype2 == 100)
then
1357 l1 = rescale1(scalef1+3,scalev1)
1358 l2 = rescale1(scalef2+3,scalev2)
1359 else if (ltype1 == 101 .and. ltype2 == 255)
then
1363 else if (ltype1 == 102 .and. ltype2 == 255)
then
1365 l1 = rescale2(scalef1,scalev1)
1367 else if (ltype1 == 102 .and. ltype2 == 102)
then
1369 l1 = rescale1(scalef1+2,scalev1)
1370 l2 = rescale1(scalef2+2,scalev2)
1371 else if (ltype1 == 103 .and. ltype2 == 255)
then
1373 l1 = rescale2(scalef1,scalev1)
1375 else if (ltype1 == 103 .and. ltype2 == 103)
then
1377 l1 = rescale1(scalef1+2,scalev1)
1378 l2 = rescale1(scalef2+2,scalev2)
1379 else if (ltype1 == 104 .and. ltype2 == 255)
then
1381 l1 = rescale2(scalef1,scalev1-4)
1383 else if (ltype1 == 104 .and. ltype2 == 104)
then
1385 l1 = rescale1(scalef1-2,scalev1)
1386 l2 = rescale1(scalef2-2,scalev2)
1387 else if (ltype1 == 105 .and. ltype2 == 255)
then
1389 l1 = rescale2(scalef1,scalev1)
1391 else if (ltype1 == 105 .and. ltype2 == 105)
then
1393 l1 = rescale1(scalef1,scalev1)
1394 l2 = rescale1(scalef2,scalev2)
1395 else if (ltype1 == 106 .and. ltype2 == 255)
then
1397 l1 = rescale2(scalef1-2,scalev1)
1399 else if (ltype1 == 106 .and. ltype2 == 106)
then
1401 l1 = rescale1(scalef1-2,scalev1)
1402 l2 = rescale1(scalef2-2,scalev2)
1403 else if (ltype1 == 107 .and. ltype2 == 255)
then
1405 l1 = rescale2(scalef1,scalev1)
1407 else if (ltype1 == 107 .and. ltype2 == 107)
then
1409 l1 = rescale1(scalef1,scalev1)
1410 l2 = rescale1(scalef2,scalev2)
1411 else if (ltype1 == 108 .and. ltype2 == 255)
then
1413 l1 = rescale2(scalef1+2,scalev1)
1415 else if (ltype1 == 108 .and. ltype2 == 108)
then
1417 l1 = rescale1(scalef1+2,scalev1)
1418 l2 = rescale1(scalef2+2,scalev2)
1419 else if (ltype1 == 109 .and. ltype2 == 255)
then
1421 l1 = rescale2(scalef1+9,scalev1)
1423 else if (ltype1 == 111 .and. ltype2 == 255)
then
1425 l1 = rescale2(scalef1-2,scalev1)
1427 else if (ltype1 == 111 .and. ltype2 == 111)
then
1429 l1 = rescale1(scalef1-4,scalev1)
1430 l2 = rescale1(scalef2-4,scalev2)
1431 else if (ltype1 == 160 .and. ltype2 == 255)
then
1433 l1 = rescale2(scalef1,scalev1)
1435 else if (ltype1 == 1 .and. ltype2 == 8)
then
1437 else if (ltype1 == 1 .and. ltype2 == 9)
then
1444 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1445 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1451 FUNCTION rescale1(scalef, scalev) RESULT(rescale)
1452 INTEGER,
INTENT(in) :: scalef, scalev
1455 rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1457 END FUNCTION rescale1
1459 FUNCTION rescale2(scalef, scalev) RESULT(rescale)
1460 INTEGER,
INTENT(in) :: scalef, scalev
1463 rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1465 END FUNCTION rescale2
1467 END SUBROUTINE level_g2_to_g1
1478 SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1479 INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1480 INTEGER,
INTENT(out) :: statproc, p1, p2
1482 IF (tri == 0 .OR. tri == 1)
THEN
1484 CALL g1_interval_to_second(unit, p1_g1, p1)
1486 ELSE IF (tri == 10)
THEN
1488 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1490 ELSE IF (tri == 2)
THEN
1492 CALL g1_interval_to_second(unit, p2_g1, p1)
1493 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1494 ELSE IF (tri == 3)
THEN
1496 CALL g1_interval_to_second(unit, p2_g1, p1)
1497 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1498 ELSE IF (tri == 4)
THEN
1500 CALL g1_interval_to_second(unit, p2_g1, p1)
1501 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1502 ELSE IF (tri == 5)
THEN
1504 CALL g1_interval_to_second(unit, p2_g1, p1)
1505 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1506 ELSE IF (tri == 13)
THEN
1509 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1511 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1512 //
' cannot be converted to GRIB2.')
1516 if (statproc == 254 .and. p2 /= 0 )
then
1517 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1520 END SUBROUTINE timerange_g1_to_v7d
1541 SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1542 INTEGER,
INTENT(in) :: unit, valuein
1543 INTEGER,
INTENT(out) :: valueout
1545 INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1546 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1549 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN
1550 IF (
c_e(unitlist(unit)))
THEN
1551 valueout = valuein*unitlist(unit)
1555 END SUBROUTINE g1_interval_to_second
1558 SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1559 INTEGER,
INTENT(in) :: unit, valuein
1560 INTEGER,
INTENT(out) :: valueout
1562 INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1563 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1566 IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN
1567 IF (
c_e(unitlist(unit)))
THEN
1568 valueout = valuein*unitlist(unit)
1572 END SUBROUTINE g2_interval_to_second
1586 SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1587 INTEGER,
INTENT(in) :: statproc, p1, p2
1588 INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1590 INTEGER :: ptmp, pdl
1593 IF (statproc == 254) pdl = p1
1595 CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1596 IF (statproc == 0)
THEN
1598 ELSE IF (statproc == 1)
THEN
1600 ELSE IF (statproc == 4)
THEN
1602 ELSE IF (statproc == 205)
THEN
1604 ELSE IF (statproc == 257)
THEN
1611 ELSE IF (statproc == 254)
THEN
1615 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1616 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1620 IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN
1621 ptmp = max(p1_g1,p2_g1)
1622 p2_g1 =
mod(ptmp,256)
1625 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1626 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1636 p2_g1 = p2_g1 - ptmp
1640 END SUBROUTINE timerange_v7d_to_g1
1643 SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1644 INTEGER,
INTENT(in) :: valuein
1645 INTEGER,
INTENT(out) :: valueout, unit
1647 IF (valuein == imiss)
THEN
1650 ELSE IF (
mod(valuein,3600) == 0)
THEN
1651 valueout = valuein/3600
1653 ELSE IF (
mod(valuein,60) == 0)
THEN
1654 valueout = valuein/60
1661 END SUBROUTINE timerange_v7d_to_g2
1671 SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1672 INTEGER,
INTENT(in) :: valuein1, valuein2
1673 INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1678 INTEGER :: sectounit
1679 END TYPE unitchecker
1681 TYPE(unitchecker
),
PARAMETER :: hunit(5) = (/ &
1682 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1683 unitchecker(12, 43200), unitchecker(2, 86400) /)
1684 TYPE(unitchecker
),
PARAMETER :: munit(3) = (/ &
1685 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1688 IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN
1692 ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN
1693 DO i = 1,
SIZE(hunit)
1694 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1695 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1696 .AND. valuein1/hunit(i)%sectounit < 255 &
1697 .AND. valuein2/hunit(i)%sectounit < 255)
THEN
1698 valueout1 = valuein1/hunit(i)%sectounit
1699 valueout2 = valuein2/hunit(i)%sectounit
1700 unit = hunit(i)%unit
1704 IF (.NOT.
c_e(unit))
THEN
1706 DO i =
SIZE(hunit), 1, -1
1707 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1708 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN
1709 valueout1 = valuein1/hunit(i)%sectounit
1710 valueout2 = valuein2/hunit(i)%sectounit
1711 unit = hunit(i)%unit
1716 ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN
1717 DO i = 1,
SIZE(munit)
1718 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1719 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1720 .AND. valuein1/munit(i)%sectounit < 255 &
1721 .AND. valuein2/munit(i)%sectounit < 255)
THEN
1722 valueout1 = valuein1/munit(i)%sectounit
1723 valueout2 = valuein2/munit(i)%sectounit
1724 unit = munit(i)%unit
1728 IF (.NOT.
c_e(unit))
THEN
1730 DO i =
SIZE(munit), 1, -1
1731 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1732 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN
1733 valueout1 = valuein1/munit(i)%sectounit
1734 valueout2 = valuein2/munit(i)%sectounit
1735 unit = munit(i)%unit
1742 IF (.NOT.
c_e(unit))
THEN
1743 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1744 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1748 END SUBROUTINE timerange_choose_unit_g1
1764 SUBROUTINE normalize_gridinfo(this)
1767 IF (this%timerange%timerange == 254)
THEN
1770 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1776 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1781 ELSE IF (this%timerange%timerange == 205)
THEN
1784 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1786 this%timerange%timerange=3
1791 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1793 this%timerange%timerange=2
1798 IF (this%var%discipline == 255 .AND. &
1799 any(this%var%centre == cosmo_centre))
THEN
1801 IF (this%var%category == 201)
THEN
1803 IF (this%var%number == 187)
THEN
1806 this%timerange%timerange=2
1811 ELSE IF (this%timerange%timerange == 257)
THEN
1813 IF (this%timerange%p2 == 0)
THEN
1815 this%timerange%timerange=254
1819 IF (this%var%discipline == 255 .AND. &
1820 any(this%var%centre == cosmo_centre))
THEN
1822 IF (this%var%category == 2)
THEN
1824 if (this%var%number == 11)
then
1825 this%timerange%timerange=0
1827 else if (this%var%number == 15)
then
1828 this%timerange%timerange=2
1831 else if (this%var%number == 16)
then
1832 this%timerange%timerange=3
1835 else if (this%var%number == 17)
then
1836 this%timerange%timerange=0
1838 else if (this%var%number == 33)
then
1839 this%timerange%timerange=0
1841 else if (this%var%number == 34)
then
1842 this%timerange%timerange=0
1844 else if (this%var%number == 57)
then
1845 this%timerange%timerange=1
1847 else if (this%var%number == 61)
then
1848 this%timerange%timerange=1
1850 else if (this%var%number == 78)
then
1851 this%timerange%timerange=1
1853 else if (this%var%number == 79)
then
1854 this%timerange%timerange=1
1856 else if (this%var%number == 90)
then
1857 this%timerange%timerange=1
1859 else if (this%var%number == 111)
then
1860 this%timerange%timerange=0
1861 else if (this%var%number == 112)
then
1862 this%timerange%timerange=0
1863 else if (this%var%number == 113)
then
1864 this%timerange%timerange=0
1865 else if (this%var%number == 114)
then
1866 this%timerange%timerange=0
1867 else if (this%var%number == 121)
then
1868 this%timerange%timerange=0
1869 else if (this%var%number == 122)
then
1870 this%timerange%timerange=0
1871 else if (this%var%number == 124)
then
1872 this%timerange%timerange=0
1873 else if (this%var%number == 125)
then
1874 this%timerange%timerange=0
1875 else if (this%var%number == 126)
then
1876 this%timerange%timerange=0
1877 else if (this%var%number == 127)
then
1878 this%timerange%timerange=0
1882 ELSE IF (this%var%category == 201)
THEN
1884 if (this%var%number == 5)
then
1885 this%timerange%timerange=0
1887 else if (this%var%number == 20)
then
1888 this%timerange%timerange=1
1890 else if (this%var%number == 22)
then
1891 this%timerange%timerange=0
1892 else if (this%var%number == 23)
then
1893 this%timerange%timerange=0
1894 else if (this%var%number == 24)
then
1895 this%timerange%timerange=0
1896 else if (this%var%number == 25)
then
1897 this%timerange%timerange=0
1898 else if (this%var%number == 26)
then
1899 this%timerange%timerange=0
1900 else if (this%var%number == 27)
then
1901 this%timerange%timerange=0
1903 else if (this%var%number == 42)
then
1904 this%timerange%timerange=1
1906 else if (this%var%number == 102)
then
1907 this%timerange%timerange=1
1909 else if (this%var%number == 113)
then
1910 this%timerange%timerange=1
1912 else if (this%var%number == 132)
then
1913 this%timerange%timerange=1
1915 else if (this%var%number == 135)
then
1916 this%timerange%timerange=1
1918 else if (this%var%number == 187)
then
1921 this%timerange%timerange=2
1923 else if (this%var%number == 218)
then
1924 this%timerange%timerange=2
1926 else if (this%var%number == 219)
then
1927 this%timerange%timerange=2
1931 ELSE IF (this%var%category == 202)
THEN
1933 if (this%var%number == 231)
then
1934 this%timerange%timerange=0
1935 else if (this%var%number == 232)
then
1936 this%timerange%timerange=0
1937 else if (this%var%number == 233)
then
1938 this%timerange%timerange=0
1944 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1945 trim(
to_char(this%timerange%p2)))
1947 'associated to an apparently instantaneous parameter '//&
1948 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1949 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1952 this%timerange%p2 = 0
1953 this%timerange%timerange = 254
1960 IF (this%var%discipline == 255 .AND. &
1961 any(this%var%centre == ecmwf_centre))
THEN
1966 IF (this%var%category == 128)
THEN
1968 IF ((this%var%number == 142 .OR. &
1969 this%var%number == 143 .OR. &
1970 this%var%number == 144 .OR. &
1971 this%var%number == 228 .OR. &
1972 this%var%number == 145 .OR. &
1973 this%var%number == 146 .OR. &
1974 this%var%number == 147 .OR. &
1975 this%var%number == 169) .AND. &
1976 this%timerange%timerange == 254)
THEN
1977 this%timerange%timerange = 1
1978 this%timerange%p2 = this%timerange%p1
1980 ELSE IF ((this%var%number == 165 .OR. &
1981 this%var%number == 166) .AND. &
1982 this%level%level1 == 1)
THEN
1983 this%level%level1 = 103
1984 this%level%l1 = 10000
1986 ELSE IF ((this%var%number == 167 .OR. &
1987 this%var%number == 168) .AND. &
1988 this%level%level1 == 1)
THEN
1989 this%level%level1 = 103
1990 this%level%l1 = 2000
1992 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN
1993 this%level%level1 = 106
1997 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN
1998 this%level%level1 = 106
2002 ELSE IF (this%var%number == 171)
THEN
2003 this%level%level1 = 106
2007 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN
2008 this%level%level1 = 106
2010 this%level%l2 = 1000
2012 ELSE IF (this%var%number == 184)
THEN
2013 this%level%level1 = 106
2015 this%level%l2 = 1000
2017 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN
2018 this%level%level1 = 106
2019 this%level%l1 = 1000
2020 this%level%l2 = 2890
2022 ELSE IF (this%var%number == 121 .AND. &
2023 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2024 this%timerange%timerange = 2
2025 this%timerange%p2 = 21600
2027 this%level%level1 = 103
2028 this%level%l1 = 2000
2030 ELSE IF (this%var%number == 122 .AND. &
2031 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2032 this%timerange%timerange = 3
2033 this%timerange%p2 = 21600
2036 this%level%level1 = 103
2037 this%level%l1 = 2000
2039 ELSE IF (this%var%number == 123 .AND. &
2040 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2041 this%timerange%timerange = 2
2042 this%timerange%p2 = 21600
2043 this%level%level1 = 103
2044 this%level%l1 = 10000
2047 ELSE IF (this%var%number == 186)
THEN
2048 this%var%number = 248
2049 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2050 ELSE IF (this%var%number == 187)
THEN
2051 this%var%number = 248
2052 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2053 ELSE IF (this%var%number == 188)
THEN
2054 this%var%number = 248
2055 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2058 ELSE IF (this%var%category == 228)
THEN
2060 IF (this%var%number == 24)
THEN
2061 this%level%level1 = 4
2063 this%level%level2 = 255
2066 ELSE IF (this%var%number == 26 .AND. &
2067 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2068 this%timerange%timerange = 2
2069 this%timerange%p2 = 10800
2070 this%var%category = 128
2072 this%level%level1 = 103
2073 this%level%l1 = 2000
2075 ELSE IF (this%var%number == 27 .AND. &
2076 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2077 this%timerange%timerange = 3
2078 this%timerange%p2 = 10800
2079 this%var%category = 128
2081 this%level%level1 = 103
2082 this%level%l1 = 2000
2084 ELSE IF (this%var%number == 28 .AND. &
2085 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2086 this%timerange%timerange = 2
2087 this%timerange%p2 = 10800
2088 this%level%level1 = 103
2089 this%level%l1 = 10000
2096 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN
2099 IF (this%var%number == 73)
THEN
2100 this%var%number = 71
2101 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2102 ELSE IF (this%var%number == 74)
THEN
2103 this%var%number = 71
2104 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2105 ELSE IF (this%var%number == 75)
THEN
2106 this%var%number = 71
2107 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2114 END SUBROUTINE normalize_gridinfo
2125 SUBROUTINE unnormalize_gridinfo(this)
2128 IF (this%timerange%timerange == 3)
THEN
2130 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2132 this%timerange%timerange=205
2134 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2135 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2137 this%timerange%timerange=205
2141 ELSE IF (this%timerange%timerange == 2)
THEN
2143 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2145 this%timerange%timerange=205
2147 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2148 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2150 this%timerange%timerange=205
2152 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN
2153 this%timerange%timerange=205
2155 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN
2156 this%timerange%timerange=205
2159 ELSE IF (any(this%var%centre == cosmo_centre))
THEN
2168 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN
2169 this%timerange%timerange=205
2175 IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN
2176 IF (this%var%number == 71 .AND. &
2177 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2178 IF (this%level%l2 == 1)
THEN
2179 this%var%number = 73
2180 ELSE IF (this%level%l2 == 2)
THEN
2181 this%var%number = 74
2182 ELSE IF (this%level%l2 == 3)
THEN
2183 this%var%number = 75
2185 this%level = vol7d_level_new(level1=1)
2189 IF (any(this%var%centre == ecmwf_centre))
THEN
2191 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN
2192 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2193 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2194 IF (this%level%l2 == 1)
THEN
2195 this%var%number = 186
2196 ELSE IF (this%level%l2 == 2)
THEN
2197 this%var%number = 187
2198 ELSE IF (this%level%l2 == 3)
THEN
2199 this%var%number = 188
2201 this%level = vol7d_level_new(level1=1)
2206 END SUBROUTINE unnormalize_gridinfo
2215 SUBROUTINE gridinfo_import_gdal(this, gdalid)
2217 TYPE(gdalrasterbandh
),
INTENT(in) :: gdalid
2219 TYPE(gdaldataseth
) :: hds
2223 this%time = datetime_new(year=2010, month=1, day=1)
2226 this%timerange = vol7d_timerange_new(254, 0, 0)
2229 hds = gdalgetbanddataset(gdalid)
2230 IF (gdalgetrastercount(hds) == 1)
THEN
2231 this%level = vol7d_level_new(1, 0)
2233 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2237 this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2239 END SUBROUTINE gridinfo_import_gdal
Classi per la gestione delle coordinate temporali.
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.
Method for removing elements of the array at a desired position.
Derived type associated to a block/message/record/band of gridded data coming from a file-like object...
Definition of a physical variable in grib coding style.
This module defines an abstract interface to different drivers for access to files containing gridded...
Derived type associated to a file-like object containing many blocks/messages/records/bands of gridde...
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.
Destructor, it releases every information associated with the object.
This object completely describes a grid on a geographic projection.
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.
Classe per la gestione degli intervalli temporali di osservazioni meteo e affini. ...
Copy an object, creating a fully new instance.
Method for packing the array object reducing at a minimum the memory occupation, without destroying i...
Object describing a single gridded message/band.
Class for managing physical variables in a grib 1/2 fashion.
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
Module for quickly interpreting the OPTIONAL parameters passed to a subprogram.
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.
Class for managing information about a single gridded georeferenced field, typically imported from an...
Emit log message for a category with specific priority.