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')
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 "// &
415CALL l4f_category_delete(category)
417END SUBROUTINE gridinfo_import_from_file
426SUBROUTINE gridinfo_export(this)
427TYPE(gridinfo_def),
INTENT(inout) :: this
429#ifdef HAVE_LIBGRIBAPI
441CALL export(this%griddim, this%gaid)
443#ifdef HAVE_LIBGRIBAPI
444IF (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)
450IF (grid_id_get_driver(this%gaid) ==
'gdal')
THEN
452 CALL l4f_category_log(this%category,l4f_warn,
"export to gdal not implemented" )
456END SUBROUTINE gridinfo_export
464SUBROUTINE gridinfo_export_to_file(this, filename, categoryappend)
466CHARACTER(len=*),
INTENT(in) :: filename
467CHARACTER(len=*),
INTENT(in),
OPTIONAL :: categoryappend
469INTEGER :: i, category
470CHARACTER(len=512) :: a_name
474IF (
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))
480category=l4f_category_get(a_name)
484 "exporting to file "//trim(filename)//
" "//
t2c(this%arraysize)//
" fields")
487valid_grid_id = grid_id_new()
488DO i = 1, this%arraysize
489 IF (
c_e(this%array(i)%gaid))
THEN
490 valid_grid_id = this%array(i)%gaid
495IF (
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))
518CALL l4f_category_delete(category)
520END SUBROUTINE gridinfo_export_to_file
531FUNCTION gridinfo_decode_data(this)
RESULT(field)
533REAL :: field(this%griddim%dim%nx, this%griddim%dim%ny)
535CALL grid_id_decode_data(this%gaid, field)
537END FUNCTION gridinfo_decode_data
547SUBROUTINE gridinfo_encode_data(this, field)
549REAL,
intent(in) :: field(:,:)
551IF (
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)))
561CALL grid_id_encode_data(this%gaid, field)
563END SUBROUTINE gridinfo_encode_data
570#ifdef HAVE_LIBGRIBAPI
571SUBROUTINE gridinfo_import_gribapi(this, gaid)
573INTEGER,
INTENT(in) :: gaid
575call time_import_gribapi(this%time, gaid)
576call timerange_import_gribapi(this%timerange,gaid)
577call level_import_gribapi(this%level, gaid)
578call var_import_gribapi(this%var, gaid)
580call normalize_gridinfo(this)
582END SUBROUTINE gridinfo_import_gribapi
586SUBROUTINE gridinfo_export_gribapi(this, gaid)
588INTEGER,
INTENT(in) :: gaid
591REAL,
ALLOCATABLE :: tmparr(:,:)
594CALL volgrid6d_var_normalize(this%var, c_func, grid_id_new(grib_api_id=gaid))
595IF (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')
600IF (c_func /= conv_func_miss)
THEN
606CALL unnormalize_gridinfo(this)
608CALL time_export_gribapi(this%time, gaid, this%timerange)
609CALL timerange_export_gribapi(this%timerange, gaid, this%time)
610CALL level_export_gribapi(this%level, gaid)
611CALL var_export_gribapi(this%var, gaid)
613END SUBROUTINE gridinfo_export_gribapi
616SUBROUTINE time_import_gribapi(this,gaid)
618INTEGER,
INTENT(in) :: gaid
620INTEGER :: EditionNumber, ttimeincr, tprocdata, centre, p2g, p2, unit, status
621CHARACTER(len=9) :: date
622CHARACTER(len=10) :: time
624CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
626IF (editionnumber == 1 .OR. editionnumber == 2)
THEN
628 CALL grib_get(gaid,
'dataDate',date )
629 CALL grib_get(gaid,
'dataTime',time(:5) )
631 CALL init(this,simpledate=date(:8)//time(:4))
633 IF (editionnumber == 2)
THEN
635 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
636 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr,status)
637 IF (ttimeincr == 255) ttimeincr = 2
640 IF (status == grib_success .AND. ttimeincr == 1)
THEN
642 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
643 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
644 CALL g2_interval_to_second(unit, p2g, p2)
645 this = this + timedelta_new(sec=p2)
646 ELSE IF (status == grib_success .AND. ttimeincr == 2 .AND. tprocdata == 0)
THEN
650 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
651 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
652 CALL g2_interval_to_second(unit, p2g, p2)
653 CALL grib_get(gaid,
'centre',centre)
654 IF (centre /= 78)
THEN
655 this = this + timedelta_new(sec=p2)
657 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
658 status /= grib_success)
THEN
661 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
668 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
673END SUBROUTINE time_import_gribapi
676SUBROUTINE time_export_gribapi(this, gaid, timerange)
678INTEGER,
INTENT(in) :: gaid
681INTEGER :: EditionNumber, centre
682CHARACTER(len=8) :: env_var
683LOGICAL :: g2cosmo_behavior
685CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
687IF (editionnumber == 1)
THEN
689 CALL code_referencetime(this)
691ELSE IF (editionnumber == 2 )
THEN
693 IF (timerange%p1 >= timerange%p2)
THEN
694 CALL code_referencetime(this)
695 ELSE IF (timerange%p1 == 0)
THEN
697 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
698 g2cosmo_behavior = len_trim(env_var) > 0
699 CALL grib_get(gaid,
'centre',centre)
700 IF (g2cosmo_behavior .AND. centre == 78)
THEN
701 CALL code_referencetime(this)
703 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
706 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
712 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
719SUBROUTINE code_referencetime(reftime)
723CHARACTER(len=17) :: date_time
726CALL getval(reftime, simpledate=date_time)
727READ(date_time(:8),
'(I8)')date
728READ(date_time(9:12),
'(I4)')time
729CALL grib_set(gaid,
'dataDate',date)
730CALL grib_set(gaid,
'dataTime',time)
732END SUBROUTINE code_referencetime
734END SUBROUTINE time_export_gribapi
737SUBROUTINE level_import_gribapi(this, gaid)
739INTEGER,
INTENT(in) :: gaid
741INTEGER :: EditionNumber,level1,l1,level2,l2
742INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
744call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
746if (editionnumber == 1)
then
748 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
749 call grib_get(gaid,
'topLevel',l1)
750 call grib_get(gaid,
'bottomLevel',l2)
752 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
754else if (editionnumber == 2)
then
756 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
757 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
758 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
759 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN
760 scalef1 = imiss; scalev1 = imiss
763 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
764 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
765 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
766 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN
767 scalef2 = imiss; scalev2 = imiss
772 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
778call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
781call init (this,level1,l1,level2,l2)
783END SUBROUTINE level_import_gribapi
786SUBROUTINE level_export_gribapi(this, gaid)
788INTEGER,
INTENT(in) :: gaid
790INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
793CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
794 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
796call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
798if (editionnumber == 1)
then
800 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
802 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
805 call grib_set(gaid,
'bottomLevel',l2)
806 call grib_set(gaid,
'topLevel',l1)
808else if (editionnumber == 2)
then
810 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
811 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN
812 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
813 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
815 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
816 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
819 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
820 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN
821 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
822 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
824 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
825 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
830 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
835END SUBROUTINE level_export_gribapi
838SUBROUTINE timerange_import_gribapi(this, gaid)
840INTEGER,
INTENT(in) :: gaid
842INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
843 ttimeincr, tprocdata, status
845call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
847IF (editionnumber == 1)
THEN
849 CALL grib_get(gaid,
'timeRangeIndicator',tri)
850 CALL grib_get(gaid,
'P1',p1g)
851 CALL grib_get(gaid,
'P2',p2g)
852 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
853 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
855ELSE IF (editionnumber == 2)
THEN
857 CALL grib_get(gaid,
'forecastTime',p1g)
858 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
859 CALL g2_interval_to_second(unit, p1g, p1)
860 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
862 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN
863 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
864 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
865 CALL g2_interval_to_second(unit, p2g, p2)
868 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
869 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
870 IF (ttimeincr == 2 .AND. tprocdata /= 0)
THEN
874 CALL l4f_log(l4f_warn,
'Found p1>0 in grib2 analysis data, strange things may happen')
885 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
890CALL init(this, statproc, p1, p2)
892END SUBROUTINE timerange_import_gribapi
895SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
897INTEGER,
INTENT(in) :: gaid
900INTEGER :: EditionNumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
901CHARACTER(len=8) :: env_var
902LOGICAL :: g2cosmo_behavior
904CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
906IF (editionnumber == 1 )
THEN
908 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
909 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
910 tri, p1_g1, p2_g1, unit)
912 CALL grib_set(gaid,
'timeRangeIndicator',tri)
913 CALL grib_set(gaid,
'P1',p1_g1)
914 CALL grib_set(gaid,
'P2',p2_g1)
915 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
917ELSE IF (editionnumber == 2)
THEN
918 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
920 IF (this%timerange == 254)
THEN
921 IF (pdtn < 0 .OR. pdtn > 7) &
922 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
924 CALL timerange_v7d_to_g2(this%p1,p1,unit)
926 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
927 CALL grib_set(gaid,
'forecastTime',p1)
929 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN
931 IF (pdtn < 8 .OR. pdtn > 14) &
932 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
934 IF (this%p1 >= this%p2)
THEN
936 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
937 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
938 CALL grib_set(gaid,
'forecastTime',p1)
939 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
942 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
944 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
945 CALL timerange_v7d_to_g2(this%p2,p2,unit)
946 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
947 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
949 ELSE IF (this%p1 == 0)
THEN
951 CALL timerange_v7d_to_g2(this%p2,p2,unit)
952 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
953 CALL grib_set(gaid,
'forecastTime',0)
954 CALL code_endoftimeinterval(reftime)
957 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
959 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
960 g2cosmo_behavior = len_trim(env_var) > 0
961 IF (g2cosmo_behavior)
THEN
962 CALL grib_set(gaid,
'typeOfProcessedData',0)
964 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
966 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
967 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
970 IF (this%timerange >= 192)
THEN
971 CALL l4f_log(l4f_warn, &
972 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
976 CALL l4f_log(l4f_error, &
977 'Timerange with 0>p1>p2 cannot be exported in grib2')
978 CALL raise_fatal_error()
981 CALL l4f_log(l4f_error, &
982 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
983 CALL raise_fatal_error()
987 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
988 CALL raise_fatal_error()
995SUBROUTINE code_endoftimeinterval(endtime)
998INTEGER :: year, month, day, hour, minute, msec
1000CALL getval(endtime, year=year, month=month, day=day, &
1001 hour=hour, minute=minute, msec=msec)
1002 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
1003 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
1004 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
1005 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
1006 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
1007 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
1009END SUBROUTINE code_endoftimeinterval
1011END SUBROUTINE timerange_export_gribapi
1014SUBROUTINE var_import_gribapi(this, gaid)
1016INTEGER,
INTENT(in) :: gaid
1018INTEGER :: EditionNumber, centre, discipline, category, number
1020call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1022if (editionnumber == 1)
then
1024 call grib_get(gaid,
'centre',centre)
1025 call grib_get(gaid,
'gribTablesVersionNo',category)
1026 call grib_get(gaid,
'indicatorOfParameter',number)
1028 call init(this, centre, category, number)
1030else if (editionnumber == 2)
then
1032 call grib_get(gaid,
'centre',centre)
1033 call grib_get(gaid,
'discipline',discipline)
1034 call grib_get(gaid,
'parameterCategory',category)
1035 call grib_get(gaid,
'parameterNumber',number)
1037 call init(this, centre, category, number, discipline)
1041 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1046END SUBROUTINE var_import_gribapi
1049SUBROUTINE var_export_gribapi(this, gaid)
1051INTEGER,
INTENT(in) :: gaid
1053INTEGER ::EditionNumber
1055call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1057if (editionnumber == 1)
then
1059 IF (this%centre /= 255) &
1060 CALL grib_set(gaid,
'centre',this%centre)
1061 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1062 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1064else if (editionnumber == 2)
then
1067 IF (this%centre /= 255) &
1068 CALL grib_set(gaid,
'centre',this%centre)
1069 CALL grib_set(gaid,
'discipline',this%discipline)
1070 CALL grib_set(gaid,
'parameterCategory',this%category)
1071 CALL grib_set(gaid,
'parameterNumber',this%number)
1075 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1080END SUBROUTINE var_export_gribapi
1083SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1084integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1085integer,
intent(out) ::lt1,l1,lt2,l2
1088CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1089CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1093SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1094integer,
intent(in) :: ltype,scalef,scalev
1095integer,
intent(out) :: lt,l
1097doubleprecision :: sl
1100IF (ltype == 255 .OR. ltype == -1)
THEN
1103ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN
1108 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN
1109 sl = scalev*(10.d0**(-scalef))
1111 IF (any(ltype == height_level))
THEN
1112 l = nint(sl*1000.d0)
1113 ELSE IF (any(ltype == thermo_level))
THEN
1115 ELSE IF (any(ltype == sigma_level))
THEN
1116 l = nint(sl*10000.d0)
1125END SUBROUTINE g2_to_dballe
1127END SUBROUTINE level_g2_to_dballe
1130SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1131integer,
intent(in) :: lt1,l1,lt2,l2
1132integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1134CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1135CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1139SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1140INTEGER,
INTENT(in) :: lt,l
1141INTEGER,
INTENT(out) :: ltype,scalef,scalev
1144IF (lt == imiss)
THEN
1148ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN
1152ELSE IF (lt == 256 .AND. l == imiss)
THEN
1159 IF (any(ltype == height_level))
THEN
1161 ELSE IF (any(ltype == thermo_level))
THEN
1163 ELSE IF (any(ltype == sigma_level))
THEN
1188END SUBROUTINE dballe_to_g2
1190END SUBROUTINE level_dballe_to_g2
1193SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1194integer,
intent(in) :: ltype,l1,l2
1195integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1204if (ltype > 0 .and. ltype <= 9)
then
1206else if (ltype == 20)
then
1210else if (ltype == 100)
then
1213else if (ltype == 101)
then
1218else if (ltype == 102)
then
1220else if (ltype == 103)
then
1223else if (ltype == 104)
then
1228else if (ltype == 105)
then
1231else if (ltype == 106)
then
1236else if (ltype == 107)
then
1240else if (ltype == 108)
then
1247else if (ltype == 109)
then
1250else if (ltype == 110)
then
1255else if (ltype == 111)
then
1259else if (ltype == 112)
then
1266else if (ltype == 113)
then
1269else if (ltype == 114)
then
1274else if (ltype == 115)
then
1277else if (ltype == 116)
then
1282else if (ltype == 117)
then
1286 if ( btest(l1,15) )
then
1287 scalev1=-1*
mod(l1,32768)
1289else if (ltype == 119)
then
1293else if (ltype == 120)
then
1300else if (ltype == 121)
then
1302 scalev1=(1100+l1)*100
1304 scalev2=(1100+l2)*100
1305else if (ltype == 125)
then
1309else if (ltype == 128)
then
1316else if (ltype == 141)
then
1320 scalev2=(1100+l2)*100
1321else if (ltype == 160)
then
1324else if (ltype == 200)
then
1327else if (ltype == 210)
then
1332 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1333 //
' cannot be converted to GRIB2.')
1337END SUBROUTINE level_g1_to_g2
1340SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1341integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1342integer,
intent(out) :: ltype,l1,l2
1344if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then
1348else if (ltype1 == 20 .and. ltype2 == 255)
then
1350 l1 = rescale2(scalef1-2,scalev1)
1352else if (ltype1 == 100 .and. ltype2 == 255)
then
1354 l1 = rescale2(scalef1+2,scalev1)
1356else if (ltype1 == 100 .and. ltype2 == 100)
then
1358 l1 = rescale1(scalef1+3,scalev1)
1359 l2 = rescale1(scalef2+3,scalev2)
1360else if (ltype1 == 101 .and. ltype2 == 255)
then
1364else if (ltype1 == 102 .and. ltype2 == 255)
then
1366 l1 = rescale2(scalef1,scalev1)
1368else if (ltype1 == 102 .and. ltype2 == 102)
then
1370 l1 = rescale1(scalef1+2,scalev1)
1371 l2 = rescale1(scalef2+2,scalev2)
1372else if (ltype1 == 103 .and. ltype2 == 255)
then
1374 l1 = rescale2(scalef1,scalev1)
1376else if (ltype1 == 103 .and. ltype2 == 103)
then
1378 l1 = rescale1(scalef1+2,scalev1)
1379 l2 = rescale1(scalef2+2,scalev2)
1380else if (ltype1 == 104 .and. ltype2 == 255)
then
1382 l1 = rescale2(scalef1,scalev1-4)
1384else if (ltype1 == 104 .and. ltype2 == 104)
then
1386 l1 = rescale1(scalef1-2,scalev1)
1387 l2 = rescale1(scalef2-2,scalev2)
1388else if (ltype1 == 105 .and. ltype2 == 255)
then
1390 l1 = rescale2(scalef1,scalev1)
1392else if (ltype1 == 105 .and. ltype2 == 105)
then
1394 l1 = rescale1(scalef1,scalev1)
1395 l2 = rescale1(scalef2,scalev2)
1396else if (ltype1 == 106 .and. ltype2 == 255)
then
1398 l1 = rescale2(scalef1-2,scalev1)
1400else if (ltype1 == 106 .and. ltype2 == 106)
then
1402 l1 = rescale1(scalef1-2,scalev1)
1403 l2 = rescale1(scalef2-2,scalev2)
1404else if (ltype1 == 107 .and. ltype2 == 255)
then
1406 l1 = rescale2(scalef1,scalev1)
1408else if (ltype1 == 107 .and. ltype2 == 107)
then
1410 l1 = rescale1(scalef1,scalev1)
1411 l2 = rescale1(scalef2,scalev2)
1412else if (ltype1 == 108 .and. ltype2 == 255)
then
1414 l1 = rescale2(scalef1+2,scalev1)
1416else if (ltype1 == 108 .and. ltype2 == 108)
then
1418 l1 = rescale1(scalef1+2,scalev1)
1419 l2 = rescale1(scalef2+2,scalev2)
1420else if (ltype1 == 109 .and. ltype2 == 255)
then
1422 l1 = rescale2(scalef1+9,scalev1)
1424else if (ltype1 == 111 .and. ltype2 == 255)
then
1426 l1 = rescale2(scalef1-2,scalev1)
1428else if (ltype1 == 111 .and. ltype2 == 111)
then
1430 l1 = rescale1(scalef1-4,scalev1)
1431 l2 = rescale1(scalef2-4,scalev2)
1432else if (ltype1 == 160 .and. ltype2 == 255)
then
1434 l1 = rescale2(scalef1,scalev1)
1436else if (ltype1 == 1 .and. ltype2 == 8)
then
1438else if (ltype1 == 1 .and. ltype2 == 9)
then
1445 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1446 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1452FUNCTION rescale1(scalef, scalev)
RESULT(rescale)
1453INTEGER,
INTENT(in) :: scalef, scalev
1456rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1458END FUNCTION rescale1
1460FUNCTION rescale2(scalef, scalev)
RESULT(rescale)
1461INTEGER,
INTENT(in) :: scalef, scalev
1464rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1466END FUNCTION rescale2
1468END SUBROUTINE level_g2_to_g1
1479SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1480INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1481INTEGER,
INTENT(out) :: statproc, p1, p2
1483IF (tri == 0 .OR. tri == 1)
THEN
1485 CALL g1_interval_to_second(unit, p1_g1, p1)
1487ELSE IF (tri == 10)
THEN
1489 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1491ELSE IF (tri == 2)
THEN
1493 CALL g1_interval_to_second(unit, p2_g1, p1)
1494 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1495ELSE IF (tri == 3)
THEN
1497 CALL g1_interval_to_second(unit, p2_g1, p1)
1498 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1499ELSE IF (tri == 4)
THEN
1501 CALL g1_interval_to_second(unit, p2_g1, p1)
1502 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1503ELSE IF (tri == 5)
THEN
1505 CALL g1_interval_to_second(unit, p2_g1, p1)
1506 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1507ELSE IF (tri == 13)
THEN
1510 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1512 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1513 //
' cannot be converted to GRIB2.')
1517if (statproc == 254 .and. p2 /= 0 )
then
1518 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1521END SUBROUTINE timerange_g1_to_v7d
1542SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1543INTEGER,
INTENT(in) :: unit, valuein
1544INTEGER,
INTENT(out) :: valueout
1546INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1547 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1550IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN
1551 IF (
c_e(unitlist(unit)))
THEN
1552 valueout = valuein*unitlist(unit)
1556END SUBROUTINE g1_interval_to_second
1559SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1560INTEGER,
INTENT(in) :: unit, valuein
1561INTEGER,
INTENT(out) :: valueout
1563INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1564 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
1567IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN
1568 IF (
c_e(unitlist(unit)))
THEN
1569 valueout = valuein*unitlist(unit)
1573END SUBROUTINE g2_interval_to_second
1587SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1588INTEGER,
INTENT(in) :: statproc, p1, p2
1589INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1594IF (statproc == 254) pdl = p1
1596CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1597IF (statproc == 0)
THEN
1599ELSE IF (statproc == 1)
THEN
1601ELSE IF (statproc == 4)
THEN
1603ELSE IF (statproc == 205)
THEN
1605ELSE IF (statproc == 257)
THEN
1612ELSE IF (statproc == 254)
THEN
1616 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1617 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1621IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN
1622 ptmp = max(p1_g1,p2_g1)
1623 p2_g1 =
mod(ptmp,256)
1626 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1627 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1637 p2_g1 = p2_g1 - ptmp
1641END SUBROUTINE timerange_v7d_to_g1
1644SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1645INTEGER,
INTENT(in) :: valuein
1646INTEGER,
INTENT(out) :: valueout, unit
1648IF (valuein == imiss)
THEN
1651ELSE IF (
mod(valuein,3600) == 0)
THEN
1652 valueout = valuein/3600
1654ELSE IF (
mod(valuein,60) == 0)
THEN
1655 valueout = valuein/60
1662END SUBROUTINE timerange_v7d_to_g2
1672SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1673INTEGER,
INTENT(in) :: valuein1, valuein2
1674INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1679 INTEGER :: sectounit
1682TYPE(unitchecker),
PARAMETER :: hunit(5) = (/ &
1683 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1684 unitchecker(12, 43200), unitchecker(2, 86400) /)
1685TYPE(unitchecker),
PARAMETER :: munit(3) = (/ &
1686 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1689IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN
1693ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN
1694 DO i = 1,
SIZE(hunit)
1695 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1696 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1697 .AND. valuein1/hunit(i)%sectounit < 255 &
1698 .AND. valuein2/hunit(i)%sectounit < 255)
THEN
1699 valueout1 = valuein1/hunit(i)%sectounit
1700 valueout2 = valuein2/hunit(i)%sectounit
1701 unit = hunit(i)%unit
1705 IF (.NOT.
c_e(unit))
THEN
1707 DO i =
SIZE(hunit), 1, -1
1708 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1709 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN
1710 valueout1 = valuein1/hunit(i)%sectounit
1711 valueout2 = valuein2/hunit(i)%sectounit
1712 unit = hunit(i)%unit
1717ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN
1718 DO i = 1,
SIZE(munit)
1719 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1720 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1721 .AND. valuein1/munit(i)%sectounit < 255 &
1722 .AND. valuein2/munit(i)%sectounit < 255)
THEN
1723 valueout1 = valuein1/munit(i)%sectounit
1724 valueout2 = valuein2/munit(i)%sectounit
1725 unit = munit(i)%unit
1729 IF (.NOT.
c_e(unit))
THEN
1731 DO i =
SIZE(munit), 1, -1
1732 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1733 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN
1734 valueout1 = valuein1/munit(i)%sectounit
1735 valueout2 = valuein2/munit(i)%sectounit
1736 unit = munit(i)%unit
1743IF (.NOT.
c_e(unit))
THEN
1744 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1745 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1749END SUBROUTINE timerange_choose_unit_g1
1765SUBROUTINE normalize_gridinfo(this)
1768IF (this%timerange%timerange == 254)
THEN
1771 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1777 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1782ELSE IF (this%timerange%timerange == 205)
THEN
1785 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1787 this%timerange%timerange=3
1792 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1794 this%timerange%timerange=2
1799 IF (this%var%discipline == 255 .AND. &
1800 any(this%var%centre == cosmo_centre))
THEN
1802 IF (this%var%category == 201)
THEN
1804 IF (this%var%number == 187)
THEN
1807 this%timerange%timerange=2
1812ELSE IF (this%timerange%timerange == 257)
THEN
1814 IF (this%timerange%p2 == 0)
THEN
1816 this%timerange%timerange=254
1820 IF (this%var%discipline == 255 .AND. &
1821 any(this%var%centre == cosmo_centre))
THEN
1823 IF (this%var%category >= 1 .AND. this%var%category <= 3)
THEN
1825 if (this%var%number == 11)
then
1826 this%timerange%timerange=0
1828 else if (this%var%number == 15)
then
1829 this%timerange%timerange=2
1832 else if (this%var%number == 16)
then
1833 this%timerange%timerange=3
1836 else if (this%var%number == 17)
then
1837 this%timerange%timerange=0
1839 else if (this%var%number == 33)
then
1840 this%timerange%timerange=0
1842 else if (this%var%number == 34)
then
1843 this%timerange%timerange=0
1845 else if (this%var%number == 57)
then
1846 this%timerange%timerange=1
1848 else if (this%var%number == 61)
then
1849 this%timerange%timerange=1
1851 else if (this%var%number == 78)
then
1852 this%timerange%timerange=1
1854 else if (this%var%number == 79)
then
1855 this%timerange%timerange=1
1857 else if (this%var%number == 90)
then
1858 this%timerange%timerange=1
1860 else if (this%var%number == 111)
then
1861 this%timerange%timerange=0
1862 else if (this%var%number == 112)
then
1863 this%timerange%timerange=0
1864 else if (this%var%number == 113)
then
1865 this%timerange%timerange=0
1866 else if (this%var%number == 114)
then
1867 this%timerange%timerange=0
1868 else if (this%var%number == 121)
then
1869 this%timerange%timerange=0
1870 else if (this%var%number == 122)
then
1871 this%timerange%timerange=0
1872 else if (this%var%number == 124)
then
1873 this%timerange%timerange=0
1874 else if (this%var%number == 125)
then
1875 this%timerange%timerange=0
1876 else if (this%var%number == 126)
then
1877 this%timerange%timerange=0
1878 else if (this%var%number == 127)
then
1879 this%timerange%timerange=0
1883 ELSE IF (this%var%category == 201)
THEN
1885 if (this%var%number == 5)
then
1886 this%timerange%timerange=0
1888 else if (this%var%number == 20)
then
1889 this%timerange%timerange=1
1891 else if (this%var%number == 22)
then
1892 this%timerange%timerange=0
1893 else if (this%var%number == 23)
then
1894 this%timerange%timerange=0
1895 else if (this%var%number == 24)
then
1896 this%timerange%timerange=0
1897 else if (this%var%number == 25)
then
1898 this%timerange%timerange=0
1899 else if (this%var%number == 26)
then
1900 this%timerange%timerange=0
1901 else if (this%var%number == 27)
then
1902 this%timerange%timerange=0
1904 else if (this%var%number == 42)
then
1905 this%timerange%timerange=1
1907 else if (this%var%number == 102)
then
1908 this%timerange%timerange=1
1910 else if (this%var%number == 113)
then
1911 this%timerange%timerange=1
1913 else if (this%var%number == 132)
then
1914 this%timerange%timerange=1
1916 else if (this%var%number == 135)
then
1917 this%timerange%timerange=1
1919 else if (this%var%number == 187)
then
1922 this%timerange%timerange=2
1924 else if (this%var%number == 218)
then
1925 this%timerange%timerange=2
1927 else if (this%var%number == 219)
then
1928 this%timerange%timerange=2
1932 ELSE IF (this%var%category == 202)
THEN
1934 if (this%var%number == 231)
then
1935 this%timerange%timerange=0
1936 else if (this%var%number == 232)
then
1937 this%timerange%timerange=0
1938 else if (this%var%number == 233)
then
1939 this%timerange%timerange=0
1945 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1946 trim(
to_char(this%timerange%p2)))
1948 'associated to an apparently instantaneous parameter '//&
1949 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1950 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1953 this%timerange%p2 = 0
1954 this%timerange%timerange = 254
1961IF (this%var%discipline == 255 .AND. &
1962 any(this%var%centre == ecmwf_centre))
THEN
1967 IF (this%var%category == 128)
THEN
1969 IF ((this%var%number == 142 .OR. &
1970 this%var%number == 143 .OR. &
1971 this%var%number == 144 .OR. &
1972 this%var%number == 228 .OR. &
1973 this%var%number == 145 .OR. &
1974 this%var%number == 146 .OR. &
1975 this%var%number == 147 .OR. &
1976 this%var%number == 169) .AND. &
1977 this%timerange%timerange == 254)
THEN
1978 this%timerange%timerange = 1
1979 this%timerange%p2 = this%timerange%p1
1981 ELSE IF ((this%var%number == 165 .OR. &
1982 this%var%number == 166) .AND. &
1983 this%level%level1 == 1)
THEN
1984 this%level%level1 = 103
1985 this%level%l1 = 10000
1987 ELSE IF ((this%var%number == 167 .OR. &
1988 this%var%number == 168) .AND. &
1989 this%level%level1 == 1)
THEN
1990 this%level%level1 = 103
1991 this%level%l1 = 2000
1993 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN
1994 this%level%level1 = 106
1998 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN
1999 this%level%level1 = 106
2003 ELSE IF (this%var%number == 171)
THEN
2004 this%level%level1 = 106
2008 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN
2009 this%level%level1 = 106
2011 this%level%l2 = 1000
2013 ELSE IF (this%var%number == 184)
THEN
2014 this%level%level1 = 106
2016 this%level%l2 = 1000
2018 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN
2019 this%level%level1 = 106
2020 this%level%l1 = 1000
2021 this%level%l2 = 2890
2023 ELSE IF (this%var%number == 121 .AND. &
2024 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2025 this%timerange%timerange = 2
2026 this%timerange%p2 = 21600
2028 this%level%level1 = 103
2029 this%level%l1 = 2000
2031 ELSE IF (this%var%number == 122 .AND. &
2032 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2033 this%timerange%timerange = 3
2034 this%timerange%p2 = 21600
2037 this%level%level1 = 103
2038 this%level%l1 = 2000
2040 ELSE IF (this%var%number == 123 .AND. &
2041 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2042 this%timerange%timerange = 2
2043 this%timerange%p2 = 21600
2044 this%level%level1 = 103
2045 this%level%l1 = 10000
2048 ELSE IF (this%var%number == 186)
THEN
2049 this%var%number = 248
2050 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2051 ELSE IF (this%var%number == 187)
THEN
2052 this%var%number = 248
2053 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2054 ELSE IF (this%var%number == 188)
THEN
2055 this%var%number = 248
2056 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2059 ELSE IF (this%var%category == 228)
THEN
2061 IF (this%var%number == 24)
THEN
2062 this%level%level1 = 4
2064 this%level%level2 = 255
2067 ELSE IF (this%var%number == 26 .AND. &
2068 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2069 this%timerange%timerange = 2
2070 this%timerange%p2 = 10800
2071 this%var%category = 128
2073 this%level%level1 = 103
2074 this%level%l1 = 2000
2076 ELSE IF (this%var%number == 27 .AND. &
2077 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2078 this%timerange%timerange = 3
2079 this%timerange%p2 = 10800
2080 this%var%category = 128
2082 this%level%level1 = 103
2083 this%level%l1 = 2000
2085 ELSE IF (this%var%number == 28 .AND. &
2086 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2087 this%timerange%timerange = 2
2088 this%timerange%p2 = 10800
2089 this%level%level1 = 103
2090 this%level%l1 = 10000
2097IF (this%var%discipline == 255 .AND. &
2098 this%var%category >= 1 .AND. this%var%category <= 3)
THEN
2101 IF (this%var%number == 73)
THEN
2102 this%var%number = 71
2103 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2104 ELSE IF (this%var%number == 74)
THEN
2105 this%var%number = 71
2106 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2107 ELSE IF (this%var%number == 75)
THEN
2108 this%var%number = 71
2109 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2116END SUBROUTINE normalize_gridinfo
2127SUBROUTINE unnormalize_gridinfo(this)
2130IF (this%timerange%timerange == 3)
THEN
2132 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2134 this%timerange%timerange=205
2136 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2137 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2139 this%timerange%timerange=205
2143ELSE IF (this%timerange%timerange == 2)
THEN
2145 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2147 this%timerange%timerange=205
2149 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2150 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2152 this%timerange%timerange=205
2154 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN
2155 this%timerange%timerange=205
2157 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN
2158 this%timerange%timerange=205
2161 ELSE IF (any(this%var%centre == cosmo_centre))
THEN
2170 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN
2171 this%timerange%timerange=205
2177IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN
2178 IF (this%var%number == 71 .AND. &
2179 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2180 IF (this%level%l2 == 1)
THEN
2181 this%var%number = 73
2182 ELSE IF (this%level%l2 == 2)
THEN
2183 this%var%number = 74
2184 ELSE IF (this%level%l2 == 3)
THEN
2185 this%var%number = 75
2187 this%level = vol7d_level_new(level1=1)
2191IF (any(this%var%centre == ecmwf_centre))
THEN
2193 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN
2194 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2195 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2196 IF (this%level%l2 == 1)
THEN
2197 this%var%number = 186
2198 ELSE IF (this%level%l2 == 2)
THEN
2199 this%var%number = 187
2200 ELSE IF (this%level%l2 == 3)
THEN
2201 this%var%number = 188
2203 this%level = vol7d_level_new(level1=1)
2208END SUBROUTINE unnormalize_gridinfo
2217SUBROUTINE gridinfo_import_gdal(this, gdalid)
2219TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2221TYPE(gdaldataseth) :: hds
2225this%time = datetime_new(year=2010, month=1, day=1)
2228this%timerange = vol7d_timerange_new(254, 0, 0)
2231hds = gdalgetbanddataset(gdalid)
2232IF (gdalgetrastercount(hds) == 1)
THEN
2233 this%level = vol7d_level_new(1, 0)
2235 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2239this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2241END 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.