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