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