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