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)
639 IF (status == grib_success .AND. ttimeincr == 1)
THEN
641 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
642 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
643 CALL g2_interval_to_second(unit, p2g, p2)
644 this = this + timedelta_new(sec=p2)
645 ELSE IF (status == grib_success .AND. ttimeincr == 2 .AND. tprocdata == 0)
THEN
649 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
650 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
651 CALL g2_interval_to_second(unit, p2g, p2)
652 CALL grib_get(gaid,
'centre',centre)
653 IF (centre /= 78)
THEN
654 this = this + timedelta_new(sec=p2)
656 ELSE IF ((status == grib_success .AND. ttimeincr == 2) .OR. &
657 status /= grib_success)
THEN
660 CALL l4f_log(l4f_error,
'typeOfTimeIncrement '//
t2c(ttimeincr)// &
667 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
672END SUBROUTINE time_import_gribapi
675SUBROUTINE time_export_gribapi(this, gaid, timerange)
677INTEGER,
INTENT(in) :: gaid
680INTEGER :: EditionNumber, centre
681CHARACTER(len=8) :: env_var
682LOGICAL :: g2cosmo_behavior
684CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
686IF (editionnumber == 1)
THEN
688 CALL code_referencetime(this)
690ELSE IF (editionnumber == 2 )
THEN
692 IF (timerange%p1 >= timerange%p2)
THEN
693 CALL code_referencetime(this)
694 ELSE IF (timerange%p1 == 0)
THEN
696 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
697 g2cosmo_behavior = len_trim(env_var) > 0
698 CALL grib_get(gaid,
'centre',centre)
699 IF (g2cosmo_behavior .AND. centre == 78)
THEN
700 CALL code_referencetime(this)
702 CALL code_referencetime(this-timedelta_new(sec=timerange%p2))
705 CALL l4f_log( l4f_error,
'Timerange with 0>p1>p2 cannot be exported in grib2')
711 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
718SUBROUTINE code_referencetime(reftime)
722CHARACTER(len=17) :: date_time
725CALL getval(reftime, simpledate=date_time)
726READ(date_time(:8),
'(I8)')date
727READ(date_time(9:12),
'(I4)')time
728CALL grib_set(gaid,
'dataDate',date)
729CALL grib_set(gaid,
'dataTime',time)
731END SUBROUTINE code_referencetime
733END SUBROUTINE time_export_gribapi
736SUBROUTINE level_import_gribapi(this, gaid)
738INTEGER,
INTENT(in) :: gaid
740INTEGER :: EditionNumber,level1,l1,level2,l2
741INTEGER :: ltype,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
743call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
745if (editionnumber == 1)
then
747 call grib_get(gaid,
'indicatorOfTypeOfLevel',ltype)
748 call grib_get(gaid,
'topLevel',l1)
749 call grib_get(gaid,
'bottomLevel',l2)
751 call level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
753else if (editionnumber == 2)
then
755 call grib_get(gaid,
'typeOfFirstFixedSurface',ltype1)
756 call grib_get(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
757 call grib_get(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
758 IF (scalef1 == -1 .OR. scalev1 == -1)
THEN
759 scalef1 = imiss; scalev1 = imiss
762 call grib_get(gaid,
'typeOfSecondFixedSurface',ltype2)
763 call grib_get(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
764 call grib_get(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
765 IF (scalef2 == -1 .OR. scalev2 == -1)
THEN
766 scalef2 = imiss; scalev2 = imiss
771 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
777call level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, &
780call init (this,level1,l1,level2,l2)
782END SUBROUTINE level_import_gribapi
785SUBROUTINE level_export_gribapi(this, gaid)
787INTEGER,
INTENT(in) :: gaid
789INTEGER :: EditionNumber, ltype1, scalef1, scalev1, ltype2, scalef2, scalev2, &
792CALL level_dballe_to_g2(this%level1, this%l1, this%level2, this%l2, &
793 ltype1, scalef1, scalev1, ltype2, scalef2, scalev2)
795call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
797if (editionnumber == 1)
then
799 CALL level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
801 call grib_set(gaid,
'indicatorOfTypeOfLevel',ltype)
804 call grib_set(gaid,
'bottomLevel',l2)
805 call grib_set(gaid,
'topLevel',l1)
807else if (editionnumber == 2)
then
809 CALL grib_set(gaid,
'typeOfFirstFixedSurface',ltype1)
810 IF (.NOT.
c_e(scalef1) .OR. .NOT.
c_e(scalev1))
THEN
811 CALL grib_set_missing(gaid,
'scaleFactorOfFirstFixedSurface')
812 CALL grib_set_missing(gaid,
'scaledValueOfFirstFixedSurface')
814 CALL grib_set(gaid,
'scaleFactorOfFirstFixedSurface',scalef1)
815 CALL grib_set(gaid,
'scaledValueOfFirstFixedSurface',scalev1)
818 CALL grib_set(gaid,
'typeOfSecondFixedSurface',ltype2)
819 IF (ltype2 == 255 .OR. .NOT.
c_e(scalef2) .OR. .NOT.
c_e(scalev2))
THEN
820 CALL grib_set_missing(gaid,
'scaleFactorOfSecondFixedSurface')
821 CALL grib_set_missing(gaid,
'scaledValueOfSecondFixedSurface')
823 CALL grib_set(gaid,
'scaleFactorOfSecondFixedSurface',scalef2)
824 CALL grib_set(gaid,
'scaledValueOfSecondFixedSurface',scalev2)
829 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
834END SUBROUTINE level_export_gribapi
837SUBROUTINE timerange_import_gribapi(this, gaid)
839INTEGER,
INTENT(in) :: gaid
841INTEGER :: EditionNumber, tri, unit, p1g, p2g, p1, p2, statproc, &
842 ttimeincr, tprocdata, status
844call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
846IF (editionnumber == 1)
THEN
848 CALL grib_get(gaid,
'timeRangeIndicator',tri)
849 CALL grib_get(gaid,
'P1',p1g)
850 CALL grib_get(gaid,
'P2',p2g)
851 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
852 CALL timerange_g1_to_v7d(tri, p1g, p2g, unit, statproc, p1, p2)
854ELSE IF (editionnumber == 2)
THEN
856 CALL grib_get(gaid,
'forecastTime',p1g)
857 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',unit)
858 CALL g2_interval_to_second(unit, p1g, p1)
859 call grib_get(gaid,
'typeOfStatisticalProcessing',statproc,status)
861 IF (status == grib_success .AND. statproc >= 0 .AND. statproc < 254)
THEN
862 CALL grib_get(gaid,
'lengthOfTimeRange',p2g)
863 CALL grib_get(gaid,
'indicatorOfUnitForTimeRange',unit)
864 CALL g2_interval_to_second(unit, p2g, p2)
867 CALL grib_get(gaid,
'typeOfProcessedData',tprocdata,status)
868 CALL grib_get(gaid,
'typeOfTimeIncrement',ttimeincr)
869 IF (ttimeincr == 2 .AND. tprocdata /= 0)
THEN
873 CALL l4f_log(l4f_warn,
'Found p1>0 in grib2 analysis data, strange things may happen')
884 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
889CALL init(this, statproc, p1, p2)
891END SUBROUTINE timerange_import_gribapi
894SUBROUTINE timerange_export_gribapi(this, gaid, reftime)
896INTEGER,
INTENT(in) :: gaid
899INTEGER :: EditionNumber, centre, tri, currentunit, unit, p1_g1, p2_g1, p1, p2, pdtn
900CHARACTER(len=8) :: env_var
901LOGICAL :: g2cosmo_behavior
903CALL grib_get(gaid,
'GRIBEditionNumber',editionnumber)
905IF (editionnumber == 1 )
THEN
907 CALL grib_get(gaid,
'indicatorOfUnitOfTimeRange',currentunit)
908 CALL timerange_v7d_to_g1(this%timerange, this%p1, this%p2, &
909 tri, p1_g1, p2_g1, unit)
911 CALL grib_set(gaid,
'timeRangeIndicator',tri)
912 CALL grib_set(gaid,
'P1',p1_g1)
913 CALL grib_set(gaid,
'P2',p2_g1)
914 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
916ELSE IF (editionnumber == 2)
THEN
917 CALL grib_get(gaid,
'productDefinitionTemplateNumber', pdtn)
919 IF (this%timerange == 254)
THEN
920 IF (pdtn < 0 .OR. pdtn > 7) &
921 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 0)
923 CALL timerange_v7d_to_g2(this%p1,p1,unit)
925 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
926 CALL grib_set(gaid,
'forecastTime',p1)
928 ELSE IF (this%timerange >= 0 .AND. this%timerange < 254)
THEN
930 IF (pdtn < 8 .OR. pdtn > 14) &
931 CALL grib_set(gaid,
'productDefinitionTemplateNumber', 8)
933 IF (this%p1 >= this%p2)
THEN
935 CALL timerange_v7d_to_g2(this%p1-this%p2,p1,unit)
936 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
937 CALL grib_set(gaid,
'forecastTime',p1)
938 CALL code_endoftimeinterval(reftime+timedelta_new(sec=this%p1))
941 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
943 CALL grib_set(gaid,
'typeOfTimeIncrement',2)
944 CALL timerange_v7d_to_g2(this%p2,p2,unit)
945 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
946 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
948 ELSE IF (this%p1 == 0)
THEN
950 CALL timerange_v7d_to_g2(this%p2,p2,unit)
951 CALL grib_set(gaid,
'indicatorOfUnitOfTimeRange',unit)
952 CALL grib_set(gaid,
'forecastTime',0)
953 CALL code_endoftimeinterval(reftime)
956 CALL grib_set(gaid,
'typeOfStatisticalProcessing',this%timerange)
958 CALL getenv(
'LIBSIM_G2COSMO_BEHAVIOR', env_var)
959 g2cosmo_behavior = len_trim(env_var) > 0
960 IF (g2cosmo_behavior)
THEN
961 CALL grib_set(gaid,
'typeOfProcessedData',0)
963 CALL grib_set(gaid,
'typeOfTimeIncrement',1)
965 CALL grib_set(gaid,
'indicatorOfUnitForTimeRange',unit)
966 CALL grib_set(gaid,
'lengthOfTimeRange',p2)
969 IF (this%timerange >= 192)
THEN
970 CALL l4f_log(l4f_warn, &
971 'coding in grib2 a nonstandard typeOfStatisticalProcessing '// &
975 CALL l4f_log(l4f_error, &
976 'Timerange with 0>p1>p2 cannot be exported in grib2')
977 CALL raise_fatal_error()
980 CALL l4f_log(l4f_error, &
981 'typeOfStatisticalProcessing not supported: '//trim(
to_char(this%timerange)))
982 CALL raise_fatal_error()
986 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
987 CALL raise_fatal_error()
994SUBROUTINE code_endoftimeinterval(endtime)
997INTEGER :: year, month, day, hour, minute, msec
999CALL getval(endtime, year=year, month=month, day=day, &
1000 hour=hour, minute=minute, msec=msec)
1001 CALL grib_set(gaid,
'yearOfEndOfOverallTimeInterval',year)
1002 CALL grib_set(gaid,
'monthOfEndOfOverallTimeInterval',month)
1003 CALL grib_set(gaid,
'dayOfEndOfOverallTimeInterval',day)
1004 CALL grib_set(gaid,
'hourOfEndOfOverallTimeInterval',hour)
1005 CALL grib_set(gaid,
'minuteOfEndOfOverallTimeInterval',minute)
1006 CALL grib_set(gaid,
'secondOfEndOfOverallTimeInterval',msec/1000)
1008END SUBROUTINE code_endoftimeinterval
1010END SUBROUTINE timerange_export_gribapi
1013SUBROUTINE var_import_gribapi(this, gaid)
1015INTEGER,
INTENT(in) :: gaid
1017INTEGER :: EditionNumber, centre, discipline, category, number
1019call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1021if (editionnumber == 1)
then
1023 call grib_get(gaid,
'centre',centre)
1024 call grib_get(gaid,
'gribTablesVersionNo',category)
1025 call grib_get(gaid,
'indicatorOfParameter',number)
1027 call init(this, centre, category, number)
1029else if (editionnumber == 2)
then
1031 call grib_get(gaid,
'centre',centre)
1032 call grib_get(gaid,
'discipline',discipline)
1033 call grib_get(gaid,
'parameterCategory',category)
1034 call grib_get(gaid,
'parameterNumber',number)
1036 call init(this, centre, category, number, discipline)
1040 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1045END SUBROUTINE var_import_gribapi
1048SUBROUTINE var_export_gribapi(this, gaid)
1050INTEGER,
INTENT(in) :: gaid
1052INTEGER ::EditionNumber
1054call grib_get(gaid,
'GRIBEditionNumber',editionnumber)
1056if (editionnumber == 1)
then
1058 IF (this%centre /= 255) &
1059 CALL grib_set(gaid,
'centre',this%centre)
1060 CALL grib_set(gaid,
'gribTablesVersionNo',this%category)
1061 CALL grib_set(gaid,
'indicatorOfParameter',this%number)
1063else if (editionnumber == 2)
then
1066 IF (this%centre /= 255) &
1067 CALL grib_set(gaid,
'centre',this%centre)
1068 CALL grib_set(gaid,
'discipline',this%discipline)
1069 CALL grib_set(gaid,
'parameterCategory',this%category)
1070 CALL grib_set(gaid,
'parameterNumber',this%number)
1074 CALL l4f_log(l4f_error,
'GribEditionNumber '//
t2c(editionnumber)//
' not supported')
1079END SUBROUTINE var_export_gribapi
1082SUBROUTINE level_g2_to_dballe(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2, lt1,l1,lt2,l2)
1083integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1084integer,
intent(out) ::lt1,l1,lt2,l2
1087CALL g2_to_dballe(ltype1, scalef1, scalev1, lt1, l1)
1088CALL g2_to_dballe(ltype2, scalef2, scalev2, lt2, l2)
1092SUBROUTINE g2_to_dballe(ltype, scalef, scalev, lt, l)
1093integer,
intent(in) :: ltype,scalef,scalev
1094integer,
intent(out) :: lt,l
1096doubleprecision :: sl
1099IF (ltype == 255 .OR. ltype == -1)
THEN
1102ELSE IF (ltype <= 10 .OR. ltype == 101 .OR. (ltype >= 162 .AND. ltype <= 184))
THEN
1107 IF (
c_e(scalef) .AND.
c_e(scalev))
THEN
1108 sl = scalev*(10.d0**(-scalef))
1110 IF (any(ltype == height_level))
THEN
1111 l = nint(sl*1000.d0)
1112 ELSE IF (any(ltype == thermo_level))
THEN
1114 ELSE IF (any(ltype == sigma_level))
THEN
1115 l = nint(sl*10000.d0)
1124END SUBROUTINE g2_to_dballe
1126END SUBROUTINE level_g2_to_dballe
1129SUBROUTINE level_dballe_to_g2(lt1,l1,lt2,l2, ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1130integer,
intent(in) :: lt1,l1,lt2,l2
1131integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1133CALL dballe_to_g2(lt1, l1, ltype1, scalef1, scalev1)
1134CALL dballe_to_g2(lt2, l2, ltype2, scalef2, scalev2)
1138SUBROUTINE dballe_to_g2(lt, l, ltype, scalef, scalev)
1139INTEGER,
INTENT(in) :: lt,l
1140INTEGER,
INTENT(out) :: ltype,scalef,scalev
1143IF (lt == imiss)
THEN
1147ELSE IF (lt <= 10 .OR. lt == 101 .OR. (lt >= 162 .AND. lt <= 184))
THEN
1151ELSE IF (lt == 256 .AND. l == imiss)
THEN
1158 IF (any(ltype == height_level))
THEN
1160 ELSE IF (any(ltype == thermo_level))
THEN
1162 ELSE IF (any(ltype == sigma_level))
THEN
1187END SUBROUTINE dballe_to_g2
1189END SUBROUTINE level_dballe_to_g2
1192SUBROUTINE level_g1_to_g2(ltype,l1,l2,ltype1,scalef1,scalev1,ltype2,scalef2,scalev2)
1193integer,
intent(in) :: ltype,l1,l2
1194integer,
intent(out) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1203if (ltype > 0 .and. ltype <= 9)
then
1205else if (ltype == 20)
then
1209else if (ltype == 100)
then
1212else if (ltype == 101)
then
1217else if (ltype == 102)
then
1219else if (ltype == 103)
then
1222else if (ltype == 104)
then
1227else if (ltype == 105)
then
1230else if (ltype == 106)
then
1235else if (ltype == 107)
then
1239else if (ltype == 108)
then
1246else if (ltype == 109)
then
1249else if (ltype == 110)
then
1254else if (ltype == 111)
then
1258else if (ltype == 112)
then
1265else if (ltype == 113)
then
1268else if (ltype == 114)
then
1273else if (ltype == 115)
then
1276else if (ltype == 116)
then
1281else if (ltype == 117)
then
1285 if ( btest(l1,15) )
then
1286 scalev1=-1*
mod(l1,32768)
1288else if (ltype == 119)
then
1292else if (ltype == 120)
then
1299else if (ltype == 121)
then
1301 scalev1=(1100+l1)*100
1303 scalev2=(1100+l2)*100
1304else if (ltype == 125)
then
1308else if (ltype == 128)
then
1315else if (ltype == 141)
then
1319 scalev2=(1100+l2)*100
1320else if (ltype == 160)
then
1323else if (ltype == 200)
then
1326else if (ltype == 210)
then
1331 call l4f_log(l4f_error,
'level_g1_to_g2: GRIB1 level '//trim(
to_char(ltype)) &
1332 //
' cannot be converted to GRIB2.')
1336END SUBROUTINE level_g1_to_g2
1339SUBROUTINE level_g2_to_g1(ltype1,scalef1,scalev1,ltype2,scalef2,scalev2,ltype,l1,l2)
1340integer,
intent(in) :: ltype1,scalef1,scalev1,ltype2,scalef2,scalev2
1341integer,
intent(out) :: ltype,l1,l2
1343if (ltype1 > 0 .and. ltype1 <= 9 .and. ltype2 == 255)
then
1347else if (ltype1 == 20 .and. ltype2 == 255)
then
1349 l1 = rescale2(scalef1-2,scalev1)
1351else if (ltype1 == 100 .and. ltype2 == 255)
then
1353 l1 = rescale2(scalef1+2,scalev1)
1355else if (ltype1 == 100 .and. ltype2 == 100)
then
1357 l1 = rescale1(scalef1+3,scalev1)
1358 l2 = rescale1(scalef2+3,scalev2)
1359else if (ltype1 == 101 .and. ltype2 == 255)
then
1363else if (ltype1 == 102 .and. ltype2 == 255)
then
1365 l1 = rescale2(scalef1,scalev1)
1367else if (ltype1 == 102 .and. ltype2 == 102)
then
1369 l1 = rescale1(scalef1+2,scalev1)
1370 l2 = rescale1(scalef2+2,scalev2)
1371else if (ltype1 == 103 .and. ltype2 == 255)
then
1373 l1 = rescale2(scalef1,scalev1)
1375else if (ltype1 == 103 .and. ltype2 == 103)
then
1377 l1 = rescale1(scalef1+2,scalev1)
1378 l2 = rescale1(scalef2+2,scalev2)
1379else if (ltype1 == 104 .and. ltype2 == 255)
then
1381 l1 = rescale2(scalef1,scalev1-4)
1383else if (ltype1 == 104 .and. ltype2 == 104)
then
1385 l1 = rescale1(scalef1-2,scalev1)
1386 l2 = rescale1(scalef2-2,scalev2)
1387else if (ltype1 == 105 .and. ltype2 == 255)
then
1389 l1 = rescale2(scalef1,scalev1)
1391else if (ltype1 == 105 .and. ltype2 == 105)
then
1393 l1 = rescale1(scalef1,scalev1)
1394 l2 = rescale1(scalef2,scalev2)
1395else if (ltype1 == 106 .and. ltype2 == 255)
then
1397 l1 = rescale2(scalef1-2,scalev1)
1399else if (ltype1 == 106 .and. ltype2 == 106)
then
1401 l1 = rescale1(scalef1-2,scalev1)
1402 l2 = rescale1(scalef2-2,scalev2)
1403else if (ltype1 == 107 .and. ltype2 == 255)
then
1405 l1 = rescale2(scalef1,scalev1)
1407else if (ltype1 == 107 .and. ltype2 == 107)
then
1409 l1 = rescale1(scalef1,scalev1)
1410 l2 = rescale1(scalef2,scalev2)
1411else if (ltype1 == 108 .and. ltype2 == 255)
then
1413 l1 = rescale2(scalef1+2,scalev1)
1415else if (ltype1 == 108 .and. ltype2 == 108)
then
1417 l1 = rescale1(scalef1+2,scalev1)
1418 l2 = rescale1(scalef2+2,scalev2)
1419else if (ltype1 == 109 .and. ltype2 == 255)
then
1421 l1 = rescale2(scalef1+9,scalev1)
1423else if (ltype1 == 111 .and. ltype2 == 255)
then
1425 l1 = rescale2(scalef1-2,scalev1)
1427else if (ltype1 == 111 .and. ltype2 == 111)
then
1429 l1 = rescale1(scalef1-4,scalev1)
1430 l2 = rescale1(scalef2-4,scalev2)
1431else if (ltype1 == 160 .and. ltype2 == 255)
then
1433 l1 = rescale2(scalef1,scalev1)
1435else if (ltype1 == 1 .and. ltype2 == 8)
then
1437else if (ltype1 == 1 .and. ltype2 == 9)
then
1444 call l4f_log(l4f_error,
'level_g2_to_g1: GRIB2 levels '//trim(
to_char(ltype1))//
' ' &
1445 //trim(
to_char(ltype2))//
' cannot be converted to GRIB1.')
1451FUNCTION rescale1(scalef, scalev)
RESULT(rescale)
1452INTEGER,
INTENT(in) :: scalef, scalev
1455rescale = min(255, nint(scalev*10.0d0**(-scalef)))
1457END FUNCTION rescale1
1459FUNCTION rescale2(scalef, scalev)
RESULT(rescale)
1460INTEGER,
INTENT(in) :: scalef, scalev
1463rescale = min(65535, nint(scalev*10.0d0**(-scalef)))
1465END FUNCTION rescale2
1467END SUBROUTINE level_g2_to_g1
1478SUBROUTINE timerange_g1_to_v7d(tri, p1_g1, p2_g1, unit, statproc, p1, p2)
1479INTEGER,
INTENT(in) :: tri, p1_g1, p2_g1, unit
1480INTEGER,
INTENT(out) :: statproc, p1, p2
1482IF (tri == 0 .OR. tri == 1)
THEN
1484 CALL g1_interval_to_second(unit, p1_g1, p1)
1486ELSE IF (tri == 10)
THEN
1488 CALL g1_interval_to_second(unit, p1_g1*256+p2_g1, p1)
1490ELSE IF (tri == 2)
THEN
1492 CALL g1_interval_to_second(unit, p2_g1, p1)
1493 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1494ELSE IF (tri == 3)
THEN
1496 CALL g1_interval_to_second(unit, p2_g1, p1)
1497 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1498ELSE IF (tri == 4)
THEN
1500 CALL g1_interval_to_second(unit, p2_g1, p1)
1501 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1502ELSE IF (tri == 5)
THEN
1504 CALL g1_interval_to_second(unit, p2_g1, p1)
1505 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1506ELSE IF (tri == 13)
THEN
1509 CALL g1_interval_to_second(unit, p2_g1-p1_g1, p2)
1511 call l4f_log(l4f_error,
'timerange_g1_to_g2: GRIB1 timerange '//trim(
to_char(tri)) &
1512 //
' cannot be converted to GRIB2.')
1516if (statproc == 254 .and. p2 /= 0 )
then
1517 call l4f_log(l4f_warn,
"inconsistence in timerange:254,"//trim(
to_char(p1))//
","//trim(
to_char(p2)))
1520END SUBROUTINE timerange_g1_to_v7d
1541SUBROUTINE g1_interval_to_second(unit, valuein, valueout)
1542INTEGER,
INTENT(in) :: unit, valuein
1543INTEGER,
INTENT(out) :: valueout
1545INTEGER,
PARAMETER :: unitlist(0:14)=(/ 60,3600,86400,2592000, &
1546 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,900,1800/)
1549IF (unit >= lbound(unitlist,1) .AND. unit <= ubound(unitlist,1))
THEN
1550 IF (
c_e(unitlist(unit)))
THEN
1551 valueout = valuein*unitlist(unit)
1555END SUBROUTINE g1_interval_to_second
1558SUBROUTINE g2_interval_to_second(unit, valuein, valueout)
1559INTEGER,
INTENT(in) :: unit, valuein
1560INTEGER,
INTENT(out) :: valueout
1562INTEGER,
PARAMETER :: unitlist(0:13)=(/ 60,3600,86400,2592000, &
1563 31536000,315360000,946080000,imiss,imiss,imiss,10800,21600,43200,1/)
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 g2_interval_to_second
1586SUBROUTINE timerange_v7d_to_g1(statproc, p1, p2, tri, p1_g1, p2_g1, unit)
1587INTEGER,
INTENT(in) :: statproc, p1, p2
1588INTEGER,
INTENT(out) :: tri, p1_g1, p2_g1, unit
1593IF (statproc == 254) pdl = p1
1595CALL timerange_choose_unit_g1(p1, pdl, p2_g1, p1_g1, unit)
1596IF (statproc == 0)
THEN
1598ELSE IF (statproc == 1)
THEN
1600ELSE IF (statproc == 4)
THEN
1602ELSE IF (statproc == 205)
THEN
1604ELSE IF (statproc == 257)
THEN
1611ELSE IF (statproc == 254)
THEN
1615 CALL l4f_log(l4f_error,
'timerange_v7d_to_g1: GRIB2 statisticalprocessing ' &
1616 //trim(
to_char(statproc))//
' cannot be converted to GRIB1.')
1620IF (p1_g1 > 255 .OR. p2_g1 > 255)
THEN
1621 ptmp = max(p1_g1,p2_g1)
1622 p2_g1 =
mod(ptmp,256)
1625 CALL l4f_log(l4f_warn,
'timerange_v7d_to_g1: timerange too long for grib1 ' &
1626 //trim(
to_char(ptmp))//
', forcing time range indicator to 10.')
1636 p2_g1 = p2_g1 - ptmp
1640END SUBROUTINE timerange_v7d_to_g1
1643SUBROUTINE timerange_v7d_to_g2(valuein, valueout, unit)
1644INTEGER,
INTENT(in) :: valuein
1645INTEGER,
INTENT(out) :: valueout, unit
1647IF (valuein == imiss)
THEN
1650ELSE IF (
mod(valuein,3600) == 0)
THEN
1651 valueout = valuein/3600
1653ELSE IF (
mod(valuein,60) == 0)
THEN
1654 valueout = valuein/60
1661END SUBROUTINE timerange_v7d_to_g2
1671SUBROUTINE timerange_choose_unit_g1(valuein1, valuein2, valueout1, valueout2, unit)
1672INTEGER,
INTENT(in) :: valuein1, valuein2
1673INTEGER,
INTENT(out) :: valueout1, valueout2, unit
1678 INTEGER :: sectounit
1681TYPE(unitchecker),
PARAMETER :: hunit(5) = (/ &
1682 unitchecker(1, 3600), unitchecker(10, 10800), unitchecker(11, 21600), &
1683 unitchecker(12, 43200), unitchecker(2, 86400) /)
1684TYPE(unitchecker),
PARAMETER :: munit(3) = (/ &
1685 unitchecker(0, 60), unitchecker(13, 900), unitchecker(14, 1800) /)
1688IF (.NOT.
c_e(valuein1) .OR. .NOT.
c_e(valuein2))
THEN
1692ELSE IF (
mod(valuein1,3600) == 0 .AND.
mod(valuein2,3600) == 0)
THEN
1693 DO i = 1,
SIZE(hunit)
1694 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1695 .AND.
mod(valuein2, hunit(i)%sectounit) == 0 &
1696 .AND. valuein1/hunit(i)%sectounit < 255 &
1697 .AND. valuein2/hunit(i)%sectounit < 255)
THEN
1698 valueout1 = valuein1/hunit(i)%sectounit
1699 valueout2 = valuein2/hunit(i)%sectounit
1700 unit = hunit(i)%unit
1704 IF (.NOT.
c_e(unit))
THEN
1706 DO i =
SIZE(hunit), 1, -1
1707 IF (
mod(valuein1, hunit(i)%sectounit) == 0 &
1708 .AND.
mod(valuein2, hunit(i)%sectounit) == 0)
THEN
1709 valueout1 = valuein1/hunit(i)%sectounit
1710 valueout2 = valuein2/hunit(i)%sectounit
1711 unit = hunit(i)%unit
1716ELSE IF (
mod(valuein1,60) == 0. .AND.
mod(valuein2,60) == 0)
THEN
1717 DO i = 1,
SIZE(munit)
1718 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1719 .AND.
mod(valuein2, munit(i)%sectounit) == 0 &
1720 .AND. valuein1/munit(i)%sectounit < 255 &
1721 .AND. valuein2/munit(i)%sectounit < 255)
THEN
1722 valueout1 = valuein1/munit(i)%sectounit
1723 valueout2 = valuein2/munit(i)%sectounit
1724 unit = munit(i)%unit
1728 IF (.NOT.
c_e(unit))
THEN
1730 DO i =
SIZE(munit), 1, -1
1731 IF (
mod(valuein1, munit(i)%sectounit) == 0 &
1732 .AND.
mod(valuein2, munit(i)%sectounit) == 0)
THEN
1733 valueout1 = valuein1/munit(i)%sectounit
1734 valueout2 = valuein2/munit(i)%sectounit
1735 unit = munit(i)%unit
1742IF (.NOT.
c_e(unit))
THEN
1743 CALL l4f_log(l4f_error,
'timerange_second_to_g1: cannot find a grib1 timerange unit for coding ' &
1744 //
t2c(valuein1)//
','//
t2c(valuein2)//
's intervals' )
1748END SUBROUTINE timerange_choose_unit_g1
1764SUBROUTINE normalize_gridinfo(this)
1767IF (this%timerange%timerange == 254)
THEN
1770 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1776 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1781ELSE IF (this%timerange%timerange == 205)
THEN
1784 IF (this%var == volgrid6d_var_new(255,2,16,255))
THEN
1786 this%timerange%timerange=3
1791 IF (this%var == volgrid6d_var_new(255,2,15,255))
THEN
1793 this%timerange%timerange=2
1798 IF (this%var%discipline == 255 .AND. &
1799 any(this%var%centre == cosmo_centre))
THEN
1801 IF (this%var%category == 201)
THEN
1803 IF (this%var%number == 187)
THEN
1806 this%timerange%timerange=2
1811ELSE IF (this%timerange%timerange == 257)
THEN
1813 IF (this%timerange%p2 == 0)
THEN
1815 this%timerange%timerange=254
1819 IF (this%var%discipline == 255 .AND. &
1820 any(this%var%centre == cosmo_centre))
THEN
1822 IF (this%var%category >= 1 .AND. this%var%category <= 3)
THEN
1824 if (this%var%number == 11)
then
1825 this%timerange%timerange=0
1827 else if (this%var%number == 15)
then
1828 this%timerange%timerange=2
1831 else if (this%var%number == 16)
then
1832 this%timerange%timerange=3
1835 else if (this%var%number == 17)
then
1836 this%timerange%timerange=0
1838 else if (this%var%number == 33)
then
1839 this%timerange%timerange=0
1841 else if (this%var%number == 34)
then
1842 this%timerange%timerange=0
1844 else if (this%var%number == 57)
then
1845 this%timerange%timerange=1
1847 else if (this%var%number == 61)
then
1848 this%timerange%timerange=1
1850 else if (this%var%number == 78)
then
1851 this%timerange%timerange=1
1853 else if (this%var%number == 79)
then
1854 this%timerange%timerange=1
1856 else if (this%var%number == 90)
then
1857 this%timerange%timerange=1
1859 else if (this%var%number == 111)
then
1860 this%timerange%timerange=0
1861 else if (this%var%number == 112)
then
1862 this%timerange%timerange=0
1863 else if (this%var%number == 113)
then
1864 this%timerange%timerange=0
1865 else if (this%var%number == 114)
then
1866 this%timerange%timerange=0
1867 else if (this%var%number == 121)
then
1868 this%timerange%timerange=0
1869 else if (this%var%number == 122)
then
1870 this%timerange%timerange=0
1871 else if (this%var%number == 124)
then
1872 this%timerange%timerange=0
1873 else if (this%var%number == 125)
then
1874 this%timerange%timerange=0
1875 else if (this%var%number == 126)
then
1876 this%timerange%timerange=0
1877 else if (this%var%number == 127)
then
1878 this%timerange%timerange=0
1882 ELSE IF (this%var%category == 201)
THEN
1884 if (this%var%number == 5)
then
1885 this%timerange%timerange=0
1887 else if (this%var%number == 20)
then
1888 this%timerange%timerange=1
1890 else if (this%var%number == 22)
then
1891 this%timerange%timerange=0
1892 else if (this%var%number == 23)
then
1893 this%timerange%timerange=0
1894 else if (this%var%number == 24)
then
1895 this%timerange%timerange=0
1896 else if (this%var%number == 25)
then
1897 this%timerange%timerange=0
1898 else if (this%var%number == 26)
then
1899 this%timerange%timerange=0
1900 else if (this%var%number == 27)
then
1901 this%timerange%timerange=0
1903 else if (this%var%number == 42)
then
1904 this%timerange%timerange=1
1906 else if (this%var%number == 102)
then
1907 this%timerange%timerange=1
1909 else if (this%var%number == 113)
then
1910 this%timerange%timerange=1
1912 else if (this%var%number == 132)
then
1913 this%timerange%timerange=1
1915 else if (this%var%number == 135)
then
1916 this%timerange%timerange=1
1918 else if (this%var%number == 187)
then
1921 this%timerange%timerange=2
1923 else if (this%var%number == 218)
then
1924 this%timerange%timerange=2
1926 else if (this%var%number == 219)
then
1927 this%timerange%timerange=2
1931 ELSE IF (this%var%category == 202)
THEN
1933 if (this%var%number == 231)
then
1934 this%timerange%timerange=0
1935 else if (this%var%number == 232)
then
1936 this%timerange%timerange=0
1937 else if (this%var%number == 233)
then
1938 this%timerange%timerange=0
1944 'normalize_gridinfo: found COSMO non instantaneous analysis 13,0,'//&
1945 trim(
to_char(this%timerange%p2)))
1947 'associated to an apparently instantaneous parameter '//&
1948 trim(
to_char(this%var%centre))//
','//trim(
to_char(this%var%category))//
','//&
1949 trim(
to_char(this%var%number))//
','//trim(
to_char(this%var%discipline)))
1952 this%timerange%p2 = 0
1953 this%timerange%timerange = 254
1960IF (this%var%discipline == 255 .AND. &
1961 any(this%var%centre == ecmwf_centre))
THEN
1966 IF (this%var%category == 128)
THEN
1968 IF ((this%var%number == 142 .OR. &
1969 this%var%number == 143 .OR. &
1970 this%var%number == 144 .OR. &
1971 this%var%number == 228 .OR. &
1972 this%var%number == 145 .OR. &
1973 this%var%number == 146 .OR. &
1974 this%var%number == 147 .OR. &
1975 this%var%number == 169) .AND. &
1976 this%timerange%timerange == 254)
THEN
1977 this%timerange%timerange = 1
1978 this%timerange%p2 = this%timerange%p1
1980 ELSE IF ((this%var%number == 165 .OR. &
1981 this%var%number == 166) .AND. &
1982 this%level%level1 == 1)
THEN
1983 this%level%level1 = 103
1984 this%level%l1 = 10000
1986 ELSE IF ((this%var%number == 167 .OR. &
1987 this%var%number == 168) .AND. &
1988 this%level%level1 == 1)
THEN
1989 this%level%level1 = 103
1990 this%level%l1 = 2000
1992 ELSE IF (this%var%number == 39 .OR. this%var%number == 139 .OR. this%var%number == 140)
THEN
1993 this%level%level1 = 106
1997 ELSE IF (this%var%number == 40 .OR. this%var%number == 170)
THEN
1998 this%level%level1 = 106
2002 ELSE IF (this%var%number == 171)
THEN
2003 this%level%level1 = 106
2007 ELSE IF (this%var%number == 41 .OR. this%var%number == 183)
THEN
2008 this%level%level1 = 106
2010 this%level%l2 = 1000
2012 ELSE IF (this%var%number == 184)
THEN
2013 this%level%level1 = 106
2015 this%level%l2 = 1000
2017 ELSE IF (this%var%number == 42 .OR. this%var%number == 236 .OR. this%var%number == 237)
THEN
2018 this%level%level1 = 106
2019 this%level%l1 = 1000
2020 this%level%l2 = 2890
2022 ELSE IF (this%var%number == 121 .AND. &
2023 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2024 this%timerange%timerange = 2
2025 this%timerange%p2 = 21600
2027 this%level%level1 = 103
2028 this%level%l1 = 2000
2030 ELSE IF (this%var%number == 122 .AND. &
2031 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2032 this%timerange%timerange = 3
2033 this%timerange%p2 = 21600
2036 this%level%level1 = 103
2037 this%level%l1 = 2000
2039 ELSE IF (this%var%number == 123 .AND. &
2040 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2041 this%timerange%timerange = 2
2042 this%timerange%p2 = 21600
2043 this%level%level1 = 103
2044 this%level%l1 = 10000
2047 ELSE IF (this%var%number == 186)
THEN
2048 this%var%number = 248
2049 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2050 ELSE IF (this%var%number == 187)
THEN
2051 this%var%number = 248
2052 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2053 ELSE IF (this%var%number == 188)
THEN
2054 this%var%number = 248
2055 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2058 ELSE IF (this%var%category == 228)
THEN
2060 IF (this%var%number == 24)
THEN
2061 this%level%level1 = 4
2063 this%level%level2 = 255
2066 ELSE IF (this%var%number == 26 .AND. &
2067 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2068 this%timerange%timerange = 2
2069 this%timerange%p2 = 10800
2070 this%var%category = 128
2072 this%level%level1 = 103
2073 this%level%l1 = 2000
2075 ELSE IF (this%var%number == 27 .AND. &
2076 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2077 this%timerange%timerange = 3
2078 this%timerange%p2 = 10800
2079 this%var%category = 128
2081 this%level%level1 = 103
2082 this%level%l1 = 2000
2084 ELSE IF (this%var%number == 28 .AND. &
2085 (this%timerange%timerange == 254 .OR. this%timerange%timerange == 205))
THEN
2086 this%timerange%timerange = 2
2087 this%timerange%p2 = 10800
2088 this%level%level1 = 103
2089 this%level%l1 = 10000
2096IF (this%var%discipline == 255 .AND. &
2097 this%var%category >= 1 .AND. this%var%category <= 3)
THEN
2100 IF (this%var%number == 73)
THEN
2101 this%var%number = 71
2102 this%level = vol7d_level_new(level1=256, level2=258, l2=1)
2103 ELSE IF (this%var%number == 74)
THEN
2104 this%var%number = 71
2105 this%level = vol7d_level_new(level1=256, level2=258, l2=2)
2106 ELSE IF (this%var%number == 75)
THEN
2107 this%var%number = 71
2108 this%level = vol7d_level_new(level1=256, level2=258, l2=3)
2115END SUBROUTINE normalize_gridinfo
2126SUBROUTINE unnormalize_gridinfo(this)
2129IF (this%timerange%timerange == 3)
THEN
2131 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2133 this%timerange%timerange=205
2135 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2136 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2138 this%timerange%timerange=205
2142ELSE IF (this%timerange%timerange == 2)
THEN
2144 IF (this%var == volgrid6d_var_new(255,2,11,255))
THEN
2146 this%timerange%timerange=205
2148 ELSE IF (any(this%var%centre == ecmwf_centre))
THEN
2149 IF (this%var == volgrid6d_var_new(this%var%centre,128,167,255))
THEN
2151 this%timerange%timerange=205
2153 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,128,123,255))
THEN
2154 this%timerange%timerange=205
2156 ELSE IF(this%var == volgrid6d_var_new(this%var%centre,228,28,255))
THEN
2157 this%timerange%timerange=205
2160 ELSE IF (any(this%var%centre == cosmo_centre))
THEN
2169 IF (this%var == volgrid6d_var_new(this%var%centre,201,187,255))
THEN
2170 this%timerange%timerange=205
2176IF (this%var%discipline == 255 .AND. this%var%category == 2)
THEN
2177 IF (this%var%number == 71 .AND. &
2178 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2179 IF (this%level%l2 == 1)
THEN
2180 this%var%number = 73
2181 ELSE IF (this%level%l2 == 2)
THEN
2182 this%var%number = 74
2183 ELSE IF (this%level%l2 == 3)
THEN
2184 this%var%number = 75
2186 this%level = vol7d_level_new(level1=1)
2190IF (any(this%var%centre == ecmwf_centre))
THEN
2192 IF (this%var%discipline == 255 .AND. this%var%category == 128)
THEN
2193 IF ((this%var%number == 248 .OR. this%var%number == 164) .AND. &
2194 this%level%level1 == 256 .AND. this%level%level2 == 258)
THEN
2195 IF (this%level%l2 == 1)
THEN
2196 this%var%number = 186
2197 ELSE IF (this%level%l2 == 2)
THEN
2198 this%var%number = 187
2199 ELSE IF (this%level%l2 == 3)
THEN
2200 this%var%number = 188
2202 this%level = vol7d_level_new(level1=1)
2207END SUBROUTINE unnormalize_gridinfo
2216SUBROUTINE gridinfo_import_gdal(this, gdalid)
2218TYPE(gdalrasterbandh),
INTENT(in) :: gdalid
2220TYPE(gdaldataseth) :: hds
2224this%time = datetime_new(year=2010, month=1, day=1)
2227this%timerange = vol7d_timerange_new(254, 0, 0)
2230hds = gdalgetbanddataset(gdalid)
2231IF (gdalgetrastercount(hds) == 1)
THEN
2232 this%level = vol7d_level_new(1, 0)
2234 this%level = vol7d_level_new(105, gdalgetbandnumber(gdalid))
2238this%var = volgrid6d_var_new(centre=255, category=2, number=8)
2240END 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.