SUBROUTINE SUGRIB

!**** *SUGRIB* - Routine to intitialize parameters for GRIB coding

!     Purpose.
!     --------
!         Set up parameters for GRIB coding including GRIB codes
!     for all parameters.

!**   Interface.
!     ----------
!        *CALL* *SUGRIB*

!        Explicit arguments :  None.
!        --------------------

!        Implicit arguments :  COMMON YOMGRB.
!        --------------------

!     Method.  
!     -------  

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 88-03-01
!        Modified : 93-04-15 L.Labbe - NCONF=821 : 2D model
!        Modified : 93-12-02 M.Hamrud - ECMWF extended GRIB
!        Modified : 94-04-26 M.Hamrud - NSTEPLPP
!        Modified : 95-06-04 R.Buizza - define sectors for SVs (NCONF=601)
!        Modified : 98-01-14 F.Rabier - mods to write fc in first 4V traj
!        Modified : 00-01-13 T.Stockdale - optional explicit stream
!        Modified : 00-02-16 T.Stockdale - ECMWF local use 15
!        Modified : 01-05-31 D.Richardson - ECMWF local use 18
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Modified : 09-03-2005 R. Buizza - Change GRIB header for VAREPS
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM   , ONLY : NDGLG    ,NDGNH    ,NDLON    ,NFLEVG   ,NSMAX
USE YOMLUN   , ONLY : NULNAM   ,NULOUT
USE YOMCT0   , ONLY : CNMEXP   ,CFCLASS  ,NCONF    ,NCYCLE   ,&
 & LOBSC1   ,CTYPE    ,NSTEPINI  
USE YOMGRB   , ONLY : JPN3SP   ,JPN2SP   ,NSEC1    ,NSEC2SPP ,&
 & NSEC2SPM ,NSEC3    ,NSEC4    ,NGRBS3   ,NGRBS2   ,&
 & NSTEPLPP ,RSEC3    ,NSEC2GG  ,RSEC2    ,NLOCGRB  ,&
 & NTOTENS  ,NENSFNB  ,NSMAXNP  ,NBITSSH  ,NBITSGG  ,&
 & NJDIAG   ,NJDOMAI  ,NJITER   ,NGRBZ    ,NGRBT    ,&
 & NGRBQ    ,NGRBVO   ,NGRBLNSP ,NGRBD    ,NSTREAM  ,&
 & NSYSTEM  ,NMETHOD  ,NREFERENCE, NCONSENSUS  ,NDWD  ,NMFR      ,&
 & NNCEP    ,NUKM     ,NLEG
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS
USE YOMGEM   , ONLY : NLOENG   ,VBH      ,VAH      ,NSTTYP   ,&
 & NHTYP    ,RMUCEN   ,RLOCEN   ,RSTRET  
USE YOMLEG   , ONLY : RLATIG
USE YOMCST   , ONLY : RPI
USE YOMVAREPS, ONLY : NFCHO_TRUNC_INI, LVAREPS
USE YOMMCC, ONLY: LMCC04

IMPLICIT NONE

INTEGER(KIND=JPIM) :: CLASS_GRIB

#include "namgrib.h"
CHARACTER (LEN = 8) ::  CLWORD
INTEGER(KIND=JPIM) :: ILMO(12)

INTEGER(KIND=JPIM) :: ICLASS, ID1, IDD, IHOUR, IHOUR1, IINDAT,&
 & IM1, IMM, IMIMI, IHHMM, ISHOUR, IHDAY, ISSSSS, IYYYY, IYYYY1, &
 & J, ICENTRE, IFCDA_INI, IFCHO_RES
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "posnam.intfb.h"
#include "updcal.intfb.h"

#include "fcttim.h"

!     ------------------------------------------------------------------

!*       0.    READ NAMELIST
!              -------------


IF (LHOOK) CALL DR_HOOK('SUGRIB',0,ZHOOK_HANDLE)
NLOCGRB=1
NENSFNB=0
NTOTENS=0
NSTREAM=0
NSYSTEM=0
NMETHOD=1
NREFERENCE=20000101
NCONSENSUS=0
NDWD=0
NMFR=0
NNCEP=0
NUKM=0
NBITSSH=16
NBITSGG=16
NJDIAG =99
NJDOMAI=99
NJITER=0
NLEG=1

IF(NSMAX >= 213) THEN
  NSMAXNP=20
ELSE
  NSMAXNP=MIN(10,NSMAX)
ENDIF
CALL POSNAM(NULNAM,'NAMGRIB')
READ(NULNAM,NAMGRIB)
NSMAXNP=MIN(NSMAXNP,NSMAX)

!*       0.1  CHECK STREAM IS RECOGNIZED
!             --------------------------

WRITE(NULOUT,'(''SUGRIB: NLOCGRB ='',2I6)') NLOCGRB,NSTREAM

IF(NSTREAM == 0) THEN
  IF(NLOCGRB == 7) THEN !Sensitivity data
    NSTREAM = 1036 ! Sensitivity forecast
  ELSEIF(NLOCGRB == 9) THEN !Singular vectors and ensemble perturbations
    NSTREAM = 1035 ! Ensemble prediction system
  ELSEIF ( NLOCGRB == 15) THEN ! Seasonal forecast data
    NSTREAM = 1090 ! Seasonal forecast
  ELSEIF ( NLOCGRB == 23) THEN !Coupled atmospheric, wave and ocean means (HC)
    NSTREAM = 1200 ! Real-time Monthly forecast
  ELSEIF ( NLOCGRB == 26) THEN !MARS labelling or ensemble forecast data (HC)
    IF(NTOTENS == 0) THEN
      NSTREAM=1024 ! Daily archive hindcast
    ELSE
      NSTREAM=1039 ! Ensemble forecast hindcasts
    ENDIF
  ELSEIF ( NLOCGRB == 27 .OR. NLOCGRB == 30 ) THEN !VarEPS
    IF(NREFERENCE > 0 ) THEN
       NSTREAM=1033 ! Ensemble prediction system hindcast
    ELSE
       NSTREAM=1035 ! Ensemble prediction system
    ENDIF
  ELSEIF ( NLOCGRB == 18) THEN ! Multi-analysis ensemble data
    NSTREAM = 1037 ! Multianalysis ensemble data
  ELSE
    IF(NTOTENS == 0) THEN
      NSTREAM=1025 ! Atmospheric model
    ELSE
      NSTREAM=1035 ! Ensemble prediction system
    ENDIF
  ENDIF
ENDIF
WRITE(NULOUT,'(''SUGRIB: OUTPUT STREAM SET TO '',I6)') NSTREAM

!     ------------------------------------------------------------------

!*       1.    SET DEFAULTS FOR INPUT TO GRIBEX.
!              ---------------------------------

!*       1.0  CHANGE GRIB HEADERS TO WRITE FC IF FIRST 4D-VAR TRAJECTORY

ISHOUR=3600
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='(''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

!*       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

!*       1.1   INTEGER BLOCK 1.

! Basic defaults for Sec1
NSEC1(:) = 0

NSEC1(1)=128
NSEC1(2)= 98
NSEC1(3)=NCYCLE
NSEC1(4)=255
NSEC1(5)=128
NSEC1(10)=NYEARC(IINDAT)
NSEC1(11)=NMM(IINDAT)
NSEC1(12)=NDD(IINDAT)
NSEC1(13)=NCTH(ISSSSS)
NSEC1(14)=0
NSEC1(21)=NCENT(IINDAT)

ICLASS=CLASS_GRIB(CFCLASS)

IF(NLOCGRB > 0) THEN

! Invariants for all local GRIB defs
  NSEC1(37)=NLOCGRB
  NSEC1(40)=NSTREAM
  CLWORD='    '//CNMEXP(1:4)
  NSEC1(41)=TRANSFER(CLWORD(5:8),NSEC1(41))

  !Defaults for local GRIB 1 - MARS labelling or ensemble forecast data

  NSEC1(24)=1
  NSEC1(38)=ICLASS
  IF(CTYPE == 'an') THEN
    NSEC1(39) = 2
  ELSEIF(CTYPE == '3v') THEN
    NSEC1(39) = 5
  ELSEIF(CTYPE == '4v') THEN
    NSEC1(39) = 6
  ELSEIF(CTYPE == 'cf') THEN
    NSEC1(39) = 10
  ELSEIF(CTYPE == 'pf') THEN
    NSEC1(39) = 11
  ELSEIF(CTYPE == 'cv') THEN
    NSEC1(39) = 65
  ELSEIF(CTYPE == 'sg') THEN
    NSEC1(39) = 50
  ELSEIF(CTYPE == 'sf') THEN
    NSEC1(39) = 52
  ELSE
    NSEC1(39) = 9
  ENDIF
  NSEC1(42)=NENSFNB
  NSEC1(43)=NTOTENS

! Modifications for other local GRIB extensions

  
! Sensitivity data
  IF (NLOCGRB == 7) THEN
    IF (IABS(NCONF)/100 == 8) THEN
      NSEC1(39)=50
    ELSE
      NSEC1(39)=52
    ENDIF
    NSEC1(1) = 129
    NSEC1(42)=NJITER
    NSEC1(43)=0
    NSEC1(44)=NJDOMAI
    NSEC1(45)=NJDIAG

! Singular vectors and ensemble perturbations
  ELSEIF (NLOCGRB == 9) THEN
    NSEC1(39)=62

!        Sectors 42:54 will be set in SULCZ or NALAN1:
!        NSEC1(42) = singular vector number (set in NALAN1)
!        NSEC1(43) = number of iterations (NITERL from NAMLCZ,
!                    set in SULCZ)
!        NSEC1(44) = number of SVs computed (set in NALAN1)
!        NSEC1(45) = norm used at initial time (NEWNORMT0 from YOMLCZ,
!                    set in SULCZ)
!        NSEC1(46) = norm used at final time (NLANNORM from YOMLCZ,
!                    set in SULCZ)
!        NSEC1(47) = mutiplication factor to convert lat-lon and xkapa
!                    from real to integer (set in SULCZ)  
!        NSEC1(48) = lat in deg of NW corner of LPO area multiplied by NSEC1(47)
!                    (NSEC1(47)*ALAT1 from YOMLCZ, set in SULCZ)
!        NSEC1(49) = lon in deg of NW corner of LPO area multiplied by NSEC1(47)
!                    (NSEC1(47)*ALAT1 from YOMLCZ, set in SULCZ)
!        NSEC1(50) = lat in deg of SE corner of LPO area multiplied by NSEC1(47)
!                    (NSEC1(47)*ALAT1 from YOMLCZ, set in SULCZ)
!        NSEC1(51) = lon in deg of SE corner of LPO area multiplied by NSEC1(47)
!                    (NSEC1(47)*ALAT1 from YOMLCZ, set in SULCZ)
!        NSEC1(52) = accuracy  multiplied by NSEC1(47)
!                    (NSEC1(47)*XKAPA from YOMLCZ, set in SULCZ)
!        NSEC1(53) = number of SVs evolved (NEIGEVO from YOMLCZ,
!                    set in SULCZ)
!        NSEC1(54-55) = they are used to store the ritz numbers (set in
!                       NALAN1). Given RITZ, then:
!                       NSEC1(54)=NINT( LOG10(RITZ)-5 )
!                       NSEC1(55)=NINT( RITZ/( EXP(LOG(10.)*NSEC1(54) )
!                       Thus: RITZ=NSEC1(55)*EXP( LOG(10.)*NSEC1(54) )

! Seasonal forecast data
  ELSEIF (NLOCGRB == 15) THEN
    NSEC1(43)=0
    NSEC1(44)=NSYSTEM
    NSEC1(45)=NMETHOD
! Coupled atmospheric, wave and ocean means (with hindcast support)
  ELSEIF (NLOCGRB == 23) THEN
    NSEC1(43)=NTOTENS
    NSEC1(44)=NSYSTEM
    NSEC1(45)=NMETHOD
    NSEC1(49)=NREFERENCE
! MARS labelling or ensemble forecast data (with hindcast support)
  ELSEIF (NLOCGRB == 26) THEN
    NSEC1(44)=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
    NSEC1(46)=IINDAT
    NSEC1(47)=IHHMM
    NSEC1(48)=NLEG
    NSEC1(49)=NREFERENCE
    IF (LMCC04) THEN
       NSEC1(44)=2
    ENDIF


! Multi-analysis ensemble data
  ELSEIF (NLOCGRB == 18) THEN
    CLWORD='    ECMF'
    NSEC1(45)=TRANSFER(CLWORD(5:8),NSEC1(45))
    IF(NCONSENSUS == 0) THEN
      !   Data from one centre
      NSEC1(46)=0
      IF(NDWD == 1) THEN
        NSEC1(44)=78
      ELSEIF(NMFR == 1) THEN
        NSEC1(44)=85
      ELSEIF(NNCEP == 1) THEN
        NSEC1(44)=7
      ELSEIF(NUKM == 1) THEN
        NSEC1(44)=74
      ENDIF
    ELSE
! Consensus analysis (always includes EC)
      NSEC1(44)=255
      ICENTRE=1
      CLWORD='    ECMF'
      NSEC1(46+ICENTRE)=TRANSFER(CLWORD(5:8),NSEC1(46+ICENTRE))
      IF(NDWD == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD='    EDZW'
        NSEC1(46+ICENTRE)=TRANSFER(CLWORD(5:8),NSEC1(46+ICENTRE))
      ENDIF
      IF(NMFR == 1) THEN  
        ICENTRE=ICENTRE+1
        CLWORD='    LFPW'
        NSEC1(46+ICENTRE)=TRANSFER(CLWORD(5:8),NSEC1(46+ICENTRE))
      ENDIF
      IF(NNCEP == 1) THEN 
        ICENTRE=ICENTRE+1
        CLWORD='    KWBC'
        NSEC1(46+ICENTRE)=TRANSFER(CLWORD(5:8),NSEC1(46+ICENTRE))
      ENDIF
      IF(NUKM == 1) THEN
        ICENTRE=ICENTRE+1
        CLWORD='    EGRR'
        NSEC1(46+ICENTRE)=TRANSFER(CLWORD(5:8),NSEC1(46+ICENTRE))
      ENDIF
      NSEC1(46)=ICENTRE
    ENDIF
  ENDIF
ENDIF

!*       1.2   INTEGER BLOCK 2, SPECTRAL REPRESENTATION,PRESSURE LEVELS

IF(NSTTYP >= 2) THEN
  NSEC2SPP(1)=80
ELSEIF(ABS(RSTRET-1.0_JPRB) >= 1.E-14_JPRB) THEN
  NSEC2SPP(1)=70
ELSE
  NSEC2SPP(1)=50
ENDIF
NSEC2SPP(2)=NSMAX
NSEC2SPP(3)=NSMAX
NSEC2SPP(4)=NSMAX
NSEC2SPP(5)=1
NSEC2SPP(6)=2
DO J=7,11
  NSEC2SPP(J)=0
ENDDO
NSEC2SPP(12)=0
NSEC2SPP(13)=0
NSEC2SPP(14)=0
IF(NSTTYP >= 2) THEN
  NSEC2SPP(15)=180._JPRB/RPI*1000._JPRB*ASIN(RMUCEN)
  NSEC2SPP(16)=180._JPRB/RPI*1000._JPRB*RLOCEN
ELSE
  NSEC2SPP(15)=0
  NSEC2SPP(16)=0
ENDIF
DO J=17,22
  NSEC2SPP(J)=0
ENDDO

!*       1.3   INTEGER BLOCK 2, SPECTRAL REPRESENTATION,MODEL LEVELS.

IF(NSTTYP >= 2) THEN
  NSEC2SPM(1)=80
ELSEIF(ABS(RSTRET-1.0_JPRB) >= 1.E-14_JPRB) THEN
  NSEC2SPM(1)=70
ELSE
  NSEC2SPM(1)=50
ENDIF
NSEC2SPM(2)=NSMAX
NSEC2SPM(3)=NSMAX
NSEC2SPM(4)=NSMAX
NSEC2SPM(5)=1
NSEC2SPM(6)=2
DO J=7,11
  NSEC2SPM(J)=0
ENDDO
NSEC2SPM(12)=2*(NFLEVG+1)
NSEC2SPM(13)=0
NSEC2SPM(14)=0
IF(NSTTYP >= 2) THEN
  NSEC2SPM(15)=180._JPRB/RPI*1000._JPRB*ASIN(RMUCEN)
  NSEC2SPM(16)=180._JPRB/RPI*1000._JPRB*RLOCEN
ELSE
  NSEC2SPM(15)=0
  NSEC2SPM(16)=0
ENDIF
DO J=17,22
  NSEC2SPM(J)=0
ENDDO

!*       1.4   INTEGER BLOCK 2, GAUSSIAN GRID REPRESENTATION.

IF(NSTTYP >= 2) THEN
  NSEC2GG(1)=34
ELSEIF(ABS(RSTRET-1.0_JPRB) >= 1.E-14_JPRB) THEN
  NSEC2GG(1)=24
ELSE
  NSEC2GG(1)=4
ENDIF
NSEC2GG(1)=4
NSEC2GG(2)=NDLON
NSEC2GG(3)=NDGLG
NSEC2GG(4)=180._JPRB/RPI*1000._JPRB*RLATIG(1)
NSEC2GG(5)=0
NSEC2GG(6)=0
NSEC2GG(7)=180._JPRB/RPI*1000._JPRB*RLATIG(NDGLG)
NSEC2GG(8)=(360*1000*(NDLON-1))/NDLON
NSEC2GG(9)=360*1000/NDLON
NSEC2GG(10)=NDGNH
NSEC2GG(11)=0
NSEC2GG(12)=0
NSEC2GG(13)=0
NSEC2GG(14)=0
IF(NSTTYP >= 2) THEN
  NSEC2GG(15)=180._JPRB/RPI*1000._JPRB*ASIN(RMUCEN)
  NSEC2GG(16)=180._JPRB/RPI*1000._JPRB*RLOCEN
ELSE
  NSEC2GG(15)=0
  NSEC2GG(16)=0
ENDIF
NSEC2GG(17)=MIN(NHTYP,1)
NSEC2GG(18)=0
!     NSEC2GG(19)=????
NSEC2GG(19)=0
NSEC2GG(20)=0
NSEC2GG(21)=0
NSEC2GG(22)=0
DO J=1,NDGLG
  NSEC2GG(22+J)=NLOENG(J)
ENDDO

!*       1.5   INTEGER BLOCK 3

NSEC3(1)=0
NSEC3(2)=-9999

!*       1.6   INTEGER BLOCK 4

DO J=1,42
  NSEC4(J)=0
ENDDO

!*       1.7   REAL BLOCK 2

RSEC2(1)=0._JPRB
RSEC2(2)=RSTRET
DO J=3,10
  RSEC2(J)=0.0_JPRB
ENDDO

DO J=0,NFLEVG
  RSEC2(J+11)=VAH(J)
  RSEC2(J+11+NFLEVG+1)=VBH(J)
ENDDO

!*       1.8   REAL BLOCK 3

RSEC3(1)=0._JPRB
RSEC3(2)=-9999._JPRB

!     ------------------------------------------------------------------

!*       2.    SET UP GRIB FIELD CODES.
!              ------------------------

!*       2.1   SPECTRAL FIELDS.

DO J=0,JPN3SP
  NGRBS3(J)=0
ENDDO
NGRBS3(1)=NGRBVO
NGRBS3(2)=NGRBD
NGRBS3(3)=NGRBT
NGRBS3(4)=NGRBQ
DO J=0,JPN2SP
  NGRBS2(J)=0
ENDDO
IF(NCONF == 201.OR.NCONF == 421.OR.NCONF == 521) THEN
  NGRBS2(1)=NGRBZ
ELSE
  NGRBS2(1)=NGRBLNSP
ENDIF

!     ------------------------------------------------------------------

!*       3.    SET TIME OF PREVIOUS P.P. TO 0 FOR ALL GRIB CODES.
!              --------------------------------------------------

NSTEPLPP(:)=0

!     ------------------------------------------------------------------

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