SUBROUTINE PRESET_GRIB_TEMPLATE(CDTYPE)

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE PARDIM   , ONLY : JPMXLE    ,JPMXGL
USE IOSTREAM_MIX, ONLY : NGRIB_HANDLE_SH, NGRIB_HANDLE_SH_ML, NGRIB_HANDLE_GG,&
 & NGRIB_HANDLE_GG_ML
USE GRIB_API_INTERFACE, ONLY : IGRIB_NEW_FROM_TEMPLATE,IGRIB_SET_VALUE
USE YOMCT0   , ONLY : CNMEXP, LFPOS, CFCLASS, NCYCLE, &
 & LOBSC1   ,CTYPE    ,NSTEPINI,NCONF
USE YOMDIM   , ONLY : NDGLG    ,NDLON , NFLEVG ,NSMAX
USE YOMCST   , ONLY : RPI
USE YOMGEM   , ONLY : NLOENG   ,VBH      ,VAH      ,NSTTYP   ,&
 & NHTYP    ,RMUCEN   ,RLOCEN   ,RSTRET  
USE YOMLUN   , ONLY : NULOUT
USE YOMLEG   , ONLY : RLATIG
USE YOMGRB   , ONLY : &
 & NLOCGRB  ,&
 & NTOTENS  ,NENSFNB  ,&
 & NJDIAG   ,NJDOMAI  ,NJITER   ,&
 & NSTREAM  ,&
 & NSYSTEM  ,NMETHOD  ,NREFERENCE, NCONSENSUS  ,NDWD  ,NMFR      ,&
 & NNCEP    ,NUKM     ,NLEG
USE YOMHOOK  , ONLY : LHOOK,   DR_HOOK
USE YOMFPD   , ONLY : NLAT     ,NLON
USE YOMFPG   , ONLY : NFPMAX   ,NFPRGRI  ,FPVALH   ,FPVBH    ,&
 & NFPLEV   ,RFPMU
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE YOMVAREPS, ONLY : NFCHO_TRUNC_INI, LVAREPS
USE YOMMCC, ONLY: LMCC04

IMPLICIT NONE

CHARACTER(LEN=*),INTENT(IN) :: CDTYPE

INTEGER(KIND=JPIM) :: IGRIB_HANDLE,IVAL
INTEGER(KIND=JPIM) :: ISMAX, ILATS, ILONS, IFLEV, IDGNH,ICLASS
INTEGER(KIND=JPIM) :: IDD,IMM,IYYYY,IHOUR,IHOUR1,ID1,IM1,IYYYY1,ILMO(12)
INTEGER(KIND=JPIM) :: IINDAT,ISSSSS,ITIME,ISHOUR,IHDAY
INTEGER(KIND=JPIM) :: ILOENG(JPMXGL)
INTEGER(KIND=JPIM) :: ICENTRE,imimi,ihhmm,ifcho_res,ifcda_ini
REAL(KIND=JPRB) :: ZNLAT,ZSLAT
REAL(KIND=JPRB) :: ZVERT(2*(JPMXLE+1))
REAL(KIND=JPRB) :: ZVAL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTEGER(KIND=JPIM) :: CLASS_GRIB

CHARACTER(LEN=96) :: CLWORD

#include "abor1.intfb.h"
#include "updcal.intfb.h"

#include "fcttim.h"

IF (LHOOK) CALL DR_HOOK('PRESET_GRIB_TEMPLATE',0,ZHOOK_HANDLE)
SELECT CASE(CDTYPE)
CASE('GG')
CALL IGRIB_NEW_FROM_TEMPLATE(NGRIB_HANDLE_GG,'gg_sfc')
IGRIB_HANDLE = NGRIB_HANDLE_GG
CASE('GG_ML')
CALL IGRIB_NEW_FROM_TEMPLATE(NGRIB_HANDLE_GG_ML,'gg_ml')
IGRIB_HANDLE = NGRIB_HANDLE_GG_ML
CASE('SH_ML')
CALL IGRIB_NEW_FROM_TEMPLATE(NGRIB_HANDLE_SH_ML,'sh_ml')
IGRIB_HANDLE = NGRIB_HANDLE_SH_ML
CASE('SH')
CALL IGRIB_NEW_FROM_TEMPLATE(NGRIB_HANDLE_SH,'sh_sfc')
IGRIB_HANDLE = NGRIB_HANDLE_SH
CASE DEFAULT
  CALL ABOR1('PRESET_GRIB_TEMPLATE:STORE_GRIB_TEMPLATE - UNKNOWN TYPE')
END SELECT

CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'type',CTYPE)
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'localDefinitionNumber',NLOCGRB)

IF(LFPOS) THEN
  ISMAX = NFPMAX(1)
  ILATS = NLAT(1)
  ILONS = NLON(1)
  ZNLAT = ASIN(RFPMU(1))
  ZSLAT = ASIN(RFPMU(NLAT(1)))
  ILOENG(1:ILATS) = NFPRGRI(1:ILATS)
  IFLEV = NFPLEV
  ZVERT(1:IFLEV+1) = FPVALH(0:IFLEV)
  ZVERT(IFLEV+2:2*(IFLEV+1)) = FPVBH(0:IFLEV)
ELSE
  ISMAX = NSMAX
  ILATS = NDGLG
  ILONS = NDLON
  ZNLAT = RLATIG(1)
  ZSLAT = RLATIG(NDGLG)
  ILOENG(1:ILATS) = NLOENG(1:ILATS)
  IFLEV = NFLEVG
  ZVERT(1:IFLEV+1) = VAH(0:IFLEV)
  ZVERT(IFLEV+2:2*(IFLEV+1)) = VBH(0:IFLEV)
ENDIF
IDGNH =(ILATS+1)/2


CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'generatingProcessIdentifier',NCYCLE)
IHDAY=24
IF(CTYPE == 'fc'.AND.LOBSC1) THEN
  IDD    = NDD(NINDAT)
  IMM    = NMM(NINDAT)
  IYYYY  = NCCAA(NINDAT)
  IHOUR  = NSSSSS/ISHOUR
  IHOUR1 = IHOUR-NSTEPINI
  IF(IHOUR1 < 0) THEN
    IHOUR1=IHOUR1+IHDAY
    CALL UPDCAL(IDD,IMM,IYYYY,-1,ID1,IM1,IYYYY1,ILMO,NULOUT)
  ELSE
    IYYYY1=IYYYY
    IM1=IMM
    ID1=IDD
  ENDIF
  WRITE(NULOUT,FMT='(''PRESET_GRIB_TEMPLATE DATE: '',I6,2I3)') IYYYY1,IM1,ID1
  WRITE(NULOUT,FMT='(''PRESET_GRIB_TEMPLATE HOUR: '',I3)') IHOUR1
  IINDAT=IYYYY1*10000+IM1*100+ID1
  ISSSSS=IHOUR1*ISHOUR
ELSE
  IINDAT=NINDAT
  ISSSSS=NSSSSS
ENDIF
!*       1.0.2  CHANGE GRIB HEADERS TO WRITE FC IF VAREPS

ISHOUR=3600

IF(LVAREPS.AND.(NLEG >= 2)) THEN

! Change initial date/time

  IDD    = NDD(NINDAT)
  IMM    = NMM(NINDAT)
  IYYYY  = NCCAA(NINDAT)
  IHOUR  = NSSSSS/ISHOUR

  IFCDA_INI=NFCHO_TRUNC_INI/IHDAY
  IFCHO_RES=NFCHO_TRUNC_INI-IFCDA_INI*IHDAY
  IF(IFCHO_RES == 0) THEN

!   VAREPS: if the shift is a full number of days, then:
!           - subtract IFCDA_INI days to date, and
!           - add NFCHO_TRUNC_INI to IHOUR

    CALL UPDCAL(IDD,IMM,IYYYY,-IFCDA_INI,ID1,IM1,IYYYY1,ILMO,NULOUT)
    IHOUR1=IHOUR
  ELSE

!   VAREPS: if the shift is NOT a full number of days, then:
!           - add IFCHO_RES to the initial time IHOUR
!           - if IHOUR+IFCHO_RES is more than 24, then:
!             - add 1 to IFCDA_INI
!             - redefine initial time as IHOUR-24
!           - subtract IFCDA_INI days to date, and

    IHOUR=IHOUR+IFCHO_RES
    IF(IHOUR >= IHDAY) THEN
      IFCDA_INI=IFCDA_INI+1
      CALL UPDCAL(IDD,IMM,IYYYY,-IFCDA_INI,ID1,IM1,IYYYY1,ILMO,NULOUT)
      IHOUR1=IHOUR-IHDAY
    ENDIF
  ENDIF
  WRITE(NULOUT,FMT='(''SUGRIB DATE:'',I6,2I3)') IYYYY1,IM1,ID1
  WRITE(NULOUT,FMT='(''SUGRIB HOUR:'',I3)') IHOUR1
  IINDAT=IYYYY1*10000+IM1*100+ID1
  ISSSSS=IHOUR1*ISHOUR
ELSE
  IINDAT=NINDAT
  ISSSSS=NSSSSS
ENDIF

! Date and time
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'date',IINDAT)
ITIME=100*NCTH(ISSSSS)+0
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'time',ITIME)

! Local definition 1
ICLASS=CLASS_GRIB(CFCLASS)
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'class',ICLASS)
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'stream',NSTREAM)
CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'expver',CNMEXP(1:4))
IF(CTYPE == 'cf' .OR. CTYPE == 'pf' .OR. CTYPE == 'cv' &
               & .OR. NSTREAM == 1030) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'eps',1)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'perturbationNumber',NENSFNB)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'numberOfForecastsInEnsemble',NTOTENS)
ELSE
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'eps',0)
ENDIF
! Sensitivity data
IF (NLOCGRB == 7) THEN
  IF (IABS(NCONF)/100 == 8) THEN
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'type','sg')
  ELSE
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'type','sf')
  ENDIF
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'table2Version',129) ! GRIB2 problem
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'iteration',NJITER) 
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'domain',NJDOMAI)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'diagnostic',NJDIAG)
! Singular vectors and ensemble perturbations
ELSEIF (NLOCGRB == 9) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'type','sv')
!NB The rest set in SULCZ or NALAN1

! Seasonal forecast data
ELSEIF (NLOCGRB == 15) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'perturbationNumber',NENSFNB)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'numberOfForecastsInEnsemble',NTOTENS)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'system',NSYSTEM)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'method',NMETHOD)
! Coupled atmospheric, wave and ocean means (with hindcast support)
ELSEIF (NLOCGRB == 23) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'system',NSYSTEM)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'method',NMETHOD)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'refdate',NREFERENCE)
! MARS labelling or ensemble forecast data (with hindcast support)
ELSEIF (NLOCGRB == 26) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'referenceDate',NREFERENCE)
ELSEIF ( NLOCGRB == 27 .OR. NLOCGRB == 30 ) THEN 
! Date and time of current leg for VAREPS
  IDD    = NDD(NINDAT)
  IMM    = NMM(NINDAT)
  IYYYY  = NCCAA(NINDAT)
  IHOUR  = NSSSSS/ISHOUR
  IMIMI  = (NSSSSS-(IHOUR*ISHOUR))/60
  IINDAT = IYYYY*10000+IMM*100+IDD
  IHHMM = IHOUR*100+IMIMI
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legBaseDate',IINDAT)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legBaseTime',IHHMM)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'legNumber',NLEG)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'referenceDate',NREFERENCE)
  IF (LMCC04) THEN
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'oceanAtmosphereCoupling',2)
  ENDIF
! Multi-analysis ensemble data
ELSEIF (NLOCGRB == 18) THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'modelIdentifier','ECMF')
  IF(NCONSENSUS == 0) THEN
      !   Data from one centre
    IF(NDWD == 1) THEN
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'origin',78)
    ELSEIF(NMFR == 1) THEN
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'origin',85)
    ELSEIF(NNCEP == 1) THEN
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'origin',7)
    ELSEIF(NUKM == 1) THEN
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'origin',74)
    ENDIF
  ELSE
! Consensus analysis (always includes EC)
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'origin',255)
      ICENTRE=1
      CLWORD='ECMF'
      IF(NDWD == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD=CLWORD//'EDZW'
      ENDIF
      IF(NMFR == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD=CLWORD//'LFPW'
       ENDIF
      IF(NNCEP == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD=CLWORD//'KWBC'
       ENDIF
      IF(NUKM == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD=CLWORD//'EGRR'
      ENDIF
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'consensusCount',ICENTRE)
      CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'ccccIdentifiers',CLWORD(1:4*ICENTRE))
    ENDIF
  ENDIF
!Geography
IF(CDTYPE == 'GG' .OR. CDTYPE == 'GG_ML') THEN
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'truncateDegrees',1)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'numberOfPointsAlongAMeridian',ILATS)
  ZVAL = 180._JPRB/RPI*ZNLAT
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'latitudeOfFirstGridPointInDegrees',ZVAL)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'longitudeOfFirstGridPointInDegrees',0)
  ZVAL = 180._JPRB/RPI*ZSLAT
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'latitudeOfLastGridPointInDegrees',ZVAL)
! This convoluted way of computing ZVAL is to get the same rounding as with GRIBEX
  IVAL=(360*1000*(ILONS-1))/ILONS
  ZVAL=REAL(IVAL,JPRB)/1000
!  ZVAL=(360.*(ILONS-1))/ILONS
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'longitudeOfLastGridPointInDegrees',ZVAL)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'numberOfParallelsBetweenAPoleAndTheEquator',IDGNH)
  IF(NHTYP > 0) THEN
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'gridType','reduced_gg')
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'pl',ILOENG(1:ILATS))
  ELSE
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'gridType','regular_gg')
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'numberOfPointsAlongAParallel',NDLON)
    ZVAL = 360.0/NDLON
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'iDirectionIncrementInDegrees',ZVAL)
  ENDIF
ENDIF
IF(CDTYPE == 'SH' .OR. CDTYPE == 'SH_ML') THEN
  IF(NSTTYP >= 2) THEN
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'gridType','stretched_rotated_sh')
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'latitudeOfStretchingPoleInDegrees',180._JPRB/RPI*ASIN(RMUCEN))
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'longitudeOfStretchingPoleInDegrees',180._JPRB/RPI*RLOCEN)
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'stretchingFactor',RSTRET)
  ELSEIF(ABS(RSTRET-1.0_JPRB) >= 1.E-14_JPRB) THEN
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'gridType','stretched_sh')
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'stretchingFactor',RSTRET)
  ELSE
    CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'gridType','sh')
  ENDIF
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'pentagonalResolutionParameterJ',ISMAX)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'pentagonalResolutionParameterK',ISMAX)
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'pentagonalResolutionParameterM',ISMAX)
ENDIF
IF(CDTYPE == 'SH_ML' .OR. CDTYPE == 'GG_ML') THEN
!  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'nvNumberOfVerticalCoordinateParameters',2*(IFLEV+1))
  CALL IGRIB_SET_VALUE(IGRIB_HANDLE,'pv',ZVERT(1:2*(IFLEV+1)))
ENDIF

IF (LHOOK) CALL DR_HOOK('PRESET_GRIB_TEMPLATE',1,ZHOOK_HANDLE)
END SUBROUTINE PRESET_GRIB_TEMPLATE
