SUBROUTINE UPDCLIE_SEA(PTSTEP)

!**** *UPDCLIE_SEA*

!     PURPOSE.
!     --------

!     Updates the climatological data for the ocean (SST and sea-ice)
!     for EC-EARTH

!**   INTERFACE.
!     ----------

!     CALL UPDCLIE_SEA(PTSTEP)

!        Explicit arguments :
!        --------------------
!        PTSTEP: TIME STEP

!     METHOD.
!     -------

!     Reads the time-varying climate fields (currently SST and sea-ice)
!     Fieds are hard-coded here
!
!     UPDCLIE_SEA is called from UPDCLIE and inherits some variables
!     required for the the updating of the climate files

!     EXTERNALS.
!     ----------

!     UPDCAL

!     AUTHORS.
!     --------

!         based on UPDCLIE, see also comments there
!
!         Klaus Wyser, SMHI, April 2010

!     MODIFICATIONS.
!     --------------

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

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOERAD   , ONLY : LPERPET
USE YOMCST   , ONLY : RDAY
USE YOMCT0   , ONLY : NSTOP    ,CNMEXP   ,LTWOTL
USE YOMDIM   , ONLY : NDGLG    ,NDGSAG   ,NDGENG   ,NDGNH    ,&
 & NFLEVG    ,NDLON  
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTMX ,NHTYP    ,&
 & NLOENG   ,NGPTOTG  
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMMCC   , ONLY : LMCCIEC
USE YOMMCC   , ONLY : NJDCR    ,NP1      ,NP2      ,&
 & NCLIMR_SEA, NCLIGC_SEA, CLIMR_SEA
USE YOMMP    , ONLY : MYPROC
USE YOMMSC   , ONLY : NINTLEN
USE YOMRIP   , ONLY : NINDAT   ,NSTADD
USE MPL_MODULE, ONLY : MPL_BROADCAST

IMPLICIT NONE

#include "abor1.intfb.h"
#include "ircvgpf.intfb.h"
#include "isndgpf.intfb.h"
#include "updcal.intfb.h"
#include "gathergpf.intfb.h"

INTEGER(KIND=JPIM) ,SAVE :: NDIFC_SEA,NJDCR_SEA,NUNITC_SEA
INTEGER(KIND=JPIM) :: NPTMP

REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSTEP 
INTEGER(KIND=JPIM) :: ILMOIS(12),IDM(3)
INTEGER(KIND=JPIM) :: IINFO(10000,2,NCLIMR_SEA)
INTEGER(KIND=JPIM) :: IGRIG(NGPTOTG)
INTEGER(KIND=JPIM) ::   ISEC0(2),ISEC1(60),ISEC2(22+(NDGENG-NDGSAG+1)),&
 & ISEC3(2),ISEC4(42)  
REAL(KIND=JPRB) ::      ZSEC2(10+2*(NFLEVG+1)),ZSEC3(2)
REAL(KIND=JPRB) :: ZBUF (NGPTOTG)
REAL(KIND=JPRB) :: ZFLD (NGPTOTMX)
CHARACTER :: CLNOMF*14

INTEGER(KIND=JPIM) :: IA, IA0, IADD, IAE, IAN, ICCYY0, ICCYYE,&
 & ICLIM, ICOU, ID, IDIF, IDIFD, IDUMY, IEND, &
 & IERR, IFIRST, &
 & IIM1, IIM2, IJ0, IJDCR, IJE, IJOUR, &
 & IJT1, IJT2, IJUL, IJUL0, IJUL1, IJUL2, IJULE, &
 & ILENBYT, ILENGG, ILEVTY, ILONG, IM, &
 & IM0, IME, IMM0, IMME, IMOIS, IMT1, &
 & IPAR, IPAR31, IPAR139, IPAR174, IPARAM, IPARAM1, IPARAM2, &
 & IPARAM3, IPARAM4, IPAR131, IPAR132, JGRIBC, IPARMAL, &
 & IBL, IPOI, IPOIN, &
 & IREPRT, IRET, IST, ISTADDE, &
 & ITAG, ITIM, ITIME, IUNITC, IWORD, &
 & IYYM0, IYYMD, IZTE, J, JCL, JF, JGL, &
 & JM, JROF, JSTGLO, JTIM, JY, II, ISST1, ISST2, ICSTEP, ISTEP, JL, ISECND

LOGICAL :: LLFIRST, LLFOUND, LLREAD
INTEGER(KIND=JPIM),SAVE :: IDATEREF=0
INTEGER(KIND=JPIM) :: IDATE

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcttim.h"

DATA LLFIRST /.TRUE./

!*
!     1. SETTING CONSTANT VALUES.
!     ---------------------------

IF (LHOOK) CALL DR_HOOK('UPDCLIE_SEA',0,ZHOOK_HANDLE)

!*    1.1 Calendar

IJ0=NDD(NINDAT)
IM0=NMM(NINDAT)
IA0=NCCAA(NINDAT)
CALL UPDCAL(IJ0,IM0,IA0,NSTADD,IJOUR,IMOIS,IAN,ILMOIS,NULOUT)
IF(IJOUR > 15)THEN
  IMT1=IMOIS
  IJT1=15
  IJT2=15+ILMOIS(IMT1)
ELSE
  IMT1=1+MOD(IMOIS+10,12)
  IJT1=15-ILMOIS(IMT1)
  IJT2=15
ENDIF

!*
!     2. OPEN AND SCAN THE FILE, IF CLIMATE FIELDS REQUIRED
!     -----------------------------------------------------

!*    2.1 OPEN CLIMATE FILE

SCANIF:IF(NCLIMR_SEA >= 1.AND.LLFIRST) THEN
  
  MYPROCIF: IF (MYPROC == 1) THEN

! ONLY PROCESSOR 1 SHOULD OPEN 

    CLNOMF='ICMSEA'//CNMEXP(1:4)//'INIT'
    WRITE(UNIT=NULOUT,FMT='(A)') ' READ SEA FIELDS FROM GRIB '
    WRITE(UNIT=NULOUT,FMT='(A,A)')&
     & ' INITIAL DATA TO BE READ FROM FILE ',CLNOMF  
    CALL PBOPEN(IUNITC,CLNOMF,'r',IRET)
    IF(IRET /= 0) THEN
      WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: PROBLEM IN PBOPEN, IRET=',IRET
      CALL ABOR1('UPDCLIE_SEA: PROBLEM IN PBOPEN')
    ENDIF

!*    2.2 READ, DECODE HEADERS, CHECK THE FIELDS AND POSITIONS THE FILE

    ILENGG=NGPTOTG
    ILENBYT=NINTLEN*ILENGG
    IPOI=0
    SCAN: DO JTIM=1,10000
      DO JCL=1,NCLIMR_SEA
        IRET=0
        CALL PBGRIB(IUNITC,IGRIG,ILENBYT,ILONG,IRET)
        IF(IRET == 0) THEN
          ILONG=ILONG/NINTLEN
        ELSEIF(IRET == -1) THEN
          ITIM=JTIM-1
          EXIT SCAN
        ELSE
          WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: PROBLEM IN PBGRIB, IRET=',IRET
          CALL ABOR1('UPDCLIE_SEA: PROBLEM IN PBGRIB')
        ENDIF
        CALL PBTELL(IUNITC,IPOIN)
        IF (IPOIN == -2) THEN
          WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: PROBLEM IN PBTELL, IRET=',IPOIN
          CALL ABOR1('UPDCLIE_SEA: PROBLEM IN PBTELL')        
        ENDIF
        CALL GSTATS(1703,0)
        CALL GRIBEX(ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,&
         & ZBUF,ILENGG,IGRIG,ILONG,IWORD,'I',IERR)  
        CALL GSTATS(1703,1)
        IPARAM=ISEC1(6)
        IYYMD=ISEC1(12)+ISEC1(11)*100+ISEC1(10)*10000+(ISEC1(21)-1)*1000000
        WRITE(NULOUT,'(A,I3,A,I8.8,A)')&
         & 'UPDCLIE_SEA: PARAMETER ',IPARAM, ' FOR DATE ',&
         & IYYMD,' FOUND IN CLIMATE FILE'  
        ILEVTY=ISEC1(7)
        IREPRT=ISEC2(1)

!      check some parameters

        IF (IREPRT /= 4) THEN
          WRITE(NULERR,'(" UPDCLIE_SEA:UNEXPECTED DATA ",&
           & "REPRESENTATION TYPE",I6)') IREPRT  
          CALL ABOR1(' UPDCLIE_SEA:INVALID DATA REPRESENTATION TYPE')
        ENDIF
        IF(ISEC2(10) /= NDGNH) THEN
          WRITE(NULERR,'(" UPDCLIE_SEA: RESOLUTION OF MODEL ",I6,&
           & " ,OF INITIAL DATA ",I6)') NDGNH,ISEC2(10)  
          CALL ABOR1(' UPDCLIE_SEA: INVALID DATA RESOLUTION')
        ENDIF
        IF(ILEVTY /= 1.AND.ILEVTY /= 112) THEN
          WRITE(NULERR,'(" UDPCLIEDM :  UNEXPECTED LEVEL TYPE ",I6)') ILEVTY
          CALL ABOR1(' UPDCLIE_SEA: INVALID LEVEL TYPE')
        ENDIF

        IF( NHTYP /= 0 )THEN
          DO JGL=1,NDGLG
            IF( NLOENG(JGL) /= ISEC2(22+JGL) )THEN
              WRITE(NULERR,*) ' UPDCLIE_SEA:'
              WRITE(NULERR,*) ' INCONSISTENT REDUCED GRID'
              WRITE(NULERR,*) ' IN MODEL ',(NLOENG(J),J=1,NDGLG)
              WRITE(NULERR,*) ' IN FILE  ',(ISEC2(22+J),J=1,NDGLG)
              CALL ABOR1(' UPDCLIE_SEA: INCONSISTENT REDUCED GRID')
            ENDIF
          ENDDO
        ENDIF

!      record/communicate field index

        IF( NCLIGC_SEA(JCL) == IPARAM )THEN
          IINFO(JTIM,1,JCL)=IPOI
          IINFO(JTIM,2,JCL)=IYYMD
        ELSE
          WRITE(NULERR,'("UPDCLIE_SEA: SKIPPING OVER FIELD,",&
           & "GRIB CODE=",I3)') IPARAM  
          WRITE(NULERR,'("UPDCLIE_SEA: EXPECTED FIELD,",&
           & "GRIB CODE=",I3)') NCLIGC_SEA(JCL)
          CALL ABOR1(' UPDCLIE_SEA: UNEXPECTED FIELD')
        ENDIF
        IPOI=IPOIN
      ENDDO
    ENDDO SCAN

! Check fields come in a consistent order and position file at the
!   right place

    ITIME=NINT(PTSTEP)
    IF (LTWOTL) THEN
      IZTE=NINT(PTSTEP*(REAL(NSTOP,JPRB)+0.5_JPRB))
    ELSE
      IZTE=ITIME*NSTOP
    ENDIF

!--
    IF (LPERPET) THEN
      ISECND=IZTE/NINT(RDAY)
      IZTE=IZTE-ISECND*NINT(RDAY)
    ENDIF
!--

    ISTADDE=IZTE/NINT(RDAY)
    CALL UPDCAL(IJ0,IM0,IA0,ISTADDE,IJE,IME,IAE,ILMOIS,NULOUT)
    IF (LMCCIEC) THEN
      IF (IJOUR > 15) THEN
        ICCYY0=IAN
        IMM0=IMOIS
      ELSE
        IMM0=1+MOD(IMOIS+10,12)
        IF (IMM0 == 12) THEN
          ICCYY0=IAN-1
        ELSE
          ICCYY0=IAN
        ENDIF
      ENDIF
      IF (IJE > 15) THEN
        IMME=1+MOD(IME,12)
        IF (IMME == 1) THEN
          ICCYYE=IAE+1
        ELSE
          ICCYYE=IAE
        ENDIF
      ELSE
        ICCYYE=IAE
        IMME=IME
      ENDIF

! Locates the first field needed

      IYYM0=IMM0+100*ICCYY0
      LLFOUND=.FALSE.
      DO J=1,ITIM
        IF (IYYM0 == IINFO(J,2,1)/100) THEN
          IFIRST=J
          IADD=IINFO(J,1,1)
          LLFOUND=.TRUE.
          EXIT
        ENDIF
      ENDDO
      IF (.NOT.LLFOUND) THEN
        CALL ABOR1(' UPDCLIE_SEA: FIRST FILE NOT FOUND')
      ENDIF

! Check all fields in the right time order

      ICOU=IFIRST
      DO JY=ICCYY0,ICCYYE
        IF (JY == ICCYY0) THEN
          IIM1=IMM0
        ELSE
          IIM1=1
        ENDIF
        IF (JY == ICCYYE) THEN
          IIM2=IMME
        ELSE
          IIM2=12
        ENDIF
        DO JM=IIM1,IIM2
          IDUMY=JM+100*JY
          DO JCL=1,NCLIMR_SEA
            IF (IDUMY /= IINFO(ICOU,2,JCL)/100) THEN
              WRITE(NULERR,'(A,I4,A,I6.6,A)')&
               & 'UPDCLIE_SEA: FIELD ',NCLIGC_SEA(JCL),' NOT FOUND FOR ',&
               & IDUMY,'00'  
              CALL ABOR1(' UPDCLIE_SEA: FIELD NOT FOUND')
            ENDIF
          ENDDO
          ICOU=ICOU+1
        ENDDO
      ENDDO
      IDIF=-999
      IJDCR=-999

    ELSE

! Locates the first field needed

      IJUL0=RJUDAT(IAN,IMOIS,IJOUR)
      DO J=1,ITIM
        IA=NCCAA(IINFO(J,2,1))
        IM=NMM(IINFO(J,2,1))
        ID=NDD(IINFO(J,2,1))
        IJUL=RJUDAT(IA,IM,ID)
        IF (IJUL > IJUL0) THEN
          IF (J == 1) THEN
            WRITE(NULERR,'(A,I8.8)')&
             & 'UPDCLIE_SEA: FIRST FILE IS FOR ',IINFO(J,2,1)  
            CALL ABOR1(' UPDCLIE_SEA: FIRST FILE NEEDED NOT FOUND')
          ENDIF
          IFIRST=J-1
          IADD=IINFO(IFIRST,1,1)
          EXIT
        ENDIF
      ENDDO

! Check all fields in the right time order

      IA=NCCAA(IINFO(IFIRST,2,1))
      IM=NMM(IINFO(IFIRST,2,1))
      ID=NDD(IINFO(IFIRST,2,1))
      IJUL1=RJUDAT(IA,IM,ID)
      IJDCR=IJUL1
      IA=NCCAA(IINFO(IFIRST+1,2,1))
      IM=NMM(IINFO(IFIRST+1,2,1))
      ID=NDD(IINFO(IFIRST+1,2,1))
      IJUL2=RJUDAT(IA,IM,ID)
      IDIF=IJUL2-IJUL1
      IF (NCLIMR_SEA > 1) THEN
        DO JCL=2,NCLIMR_SEA
          IA=NCCAA(IINFO(IFIRST,2,JCL))
          IM=NMM(IINFO(IFIRST,2,JCL))
          ID=NDD(IINFO(IFIRST,2,JCL))
          IJUL1=RJUDAT(IA,IM,ID)
          IA=NCCAA(IINFO(IFIRST+1,2,JCL))
          IM=NMM(IINFO(IFIRST+1,2,JCL))
          ID=NDD(IINFO(IFIRST+1,2,JCL))
          IJUL2=RJUDAT(IA,IM,ID)
          IDIFD=IJUL2-IJUL1
          IF (IDIFD /= IDIF) THEN
            WRITE(NULERR,'(A,2I20,A,I4)')&
             & 'UPDCLIE_SEA: JULIAN DAYS ',IJUL1,IJUL2,' FOR FIELD '&
             & ,NCLIGC_SEA(JCL)  
            WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: DIFFERENCE EXPECTED ',IDIF
            CALL ABOR1(' UPDCLIE_SEA: IRREGULARLY SPACED FIELDS')
          ENDIF
        ENDDO
      ENDIF
      DO J=IFIRST+1,ITIM-1
        DO JCL=1,NCLIMR_SEA
          IA=NCCAA(IINFO(J,2,JCL))
          IM=NMM(IINFO(J,2,JCL))
          ID=NDD(IINFO(J,2,JCL))
          IJUL1=RJUDAT(IA,IM,ID)
          IA=NCCAA(IINFO(J+1,2,JCL))
          IM=NMM(IINFO(J+1,2,JCL))
          ID=NDD(IINFO(J+1,2,JCL))
          IJUL2=RJUDAT(IA,IM,ID)
          IDIFD=IJUL2-IJUL1
          IF (IDIFD /= IDIF) THEN
            WRITE(NULERR,'(A,2I20,A,I4)')&
             & 'UPDCLIE_SEA: JULIAN DAYS ',IJUL1,IJUL2,' FOR FIELD '&
             & ,NCLIGC_SEA(JCL)  
            WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: DIFFERENCE EXPECTED ',IDIF
            CALL ABOR1(' UPDCLIE_SEA: IRREGULARLY SPACED FIELDS')
          ENDIF
        ENDDO
      ENDDO
      IJULE=RJUDAT(IAE,IME,IJE)
      DO JCL=1,NCLIMR_SEA
        IA=NCCAA(IINFO(ITIM,2,JCL))
        IM=NMM(IINFO(ITIM,2,JCL))
        ID=NDD(IINFO(ITIM,2,JCL))
        IJUL2=RJUDAT(IA,IM,ID)
        IDIFD=IJULE-IJUL2
        IF (IDIFD > IDIF) THEN
          WRITE(NULERR,'(A)')'UPDCLIE_SEA: FILE TOO SHORTJULIAN DAYS '
          WRITE(NULERR,'(A,I20)')'UPDCLIE_SEA: FORECAST ENDS ',IJULE
          WRITE(NULERR,'(A,I20)')'UPDCLIE_SEA: CLIMATE DATA ENDS ',IJUL2
          WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: DIFFERENCE EXPECTED ',IDIF
          CALL ABOR1(' UPDCLIE_SEA: IRREGULARLY SPACED FIELDS')
        ENDIF
      ENDDO
    ENDIF

! Positions the file in the first field needed

    IRET=0
    CALL PBSEEK(IUNITC,IADD,0,IRET)
    IF(IRET < 0) THEN
      WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: PROBLEM IN PBSEEK, IRET=',IRET
      CALL ABOR1('UPDCLIE_SEA: PROBLEM IN PBSEEK')
    ENDIF

! Pack message

    IDM(1)=IDIF
    IDM(2)=IJDCR
    IDM(3)=IUNITC

  ENDIF MYPROCIF

! Broadcast

  ITAG=19591234
  CALL MPL_BROADCAST(IDM,KTAG=ITAG,KROOT=1,CDSTRING='UPDCLIE_SEA')

  NDIFC_SEA=IDM(1)
  NJDCR_SEA=IDM(2)
  NUNITC_SEA=IDM(3)

ENDIF SCANIF

!*    3. READ THE FILE, IF NEEDED.
!     -----------------------------

READIF: IF(NCLIMR_SEA >= 1) THEN

!* Decide if reading time

  IF (LMCCIEC) THEN
    IF (LLFIRST) THEN
      IDATEREF=0
      LLREAD=.TRUE.
      IFIRST=2
    ELSE
      IDATE=IAN*10000+IMOIS*100+IJOUR
      WRITE(NULOUT,*) 'IDATE=',IDATE,IDATEREF
      IF (IJOUR == 16 .AND. IDATE > IDATEREF) THEN
        LLREAD=.TRUE.
        IFIRST=1
      ELSE
        LLREAD=.FALSE.
        IFIRST=1
      ENDIF
    ENDIF
  ELSE
    IF (LLFIRST) THEN
      LLREAD=.TRUE.
      IFIRST=1
    ELSE
      IFIRST=1
      IJUL=RJUDAT(IAN,IMOIS,IJOUR)
      LLREAD=NJDCR_SEA == IJUL
    ENDIF
  ENDIF

!*    3.1 READ, DECODE AND SELECT THE FIELDS

  ILENGG=NGPTOTG
  ILENBYT=NINTLEN*ILENGG
  IF (LLREAD) THEN
    FIRST: DO JF=1,IFIRST
!      IF (LMCCIEC) THEN
!        NP1=3-NP1
!        NP2=3-NP2
!      ELSE
!        NJDCR=NJDCR+NDIFC
!      ENDIF
!     NP1 and NP2 are updated in updclie
      NPTMP=NP2
      IF (IFIRST==2 .AND. JF==1) NPTMP=NP1
      READ: DO JCL=1,NCLIMR_SEA
        IPARAM=NCLIGC_SEA(JCL)
        IF (MYPROC == 1) THEN
          CALL PBGRIB(NUNITC_SEA,IGRIG,ILENBYT,ILONG,IRET)
          IF(IRET == 0) THEN
            ILONG=ILONG/NINTLEN
          ELSE
            WRITE(NULERR,'(A,I2)')'UPDCLIE_SEA: PROBLEM IN PBGRIB, IRET=',IRET
            CALL ABOR1('UPDCLIE_SEA: PROBLEM IN PBGRIB')
          ENDIF
          ZSEC3(2)=19591204.0_JPRB
          CALL GSTATS(1703,0)
          CALL GRIBEX(ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,&
           & ZBUF,ILENGG,IGRIG,ILONG,IWORD,'D',IERR)  
          CALL GSTATS(1703,1)
          IF(ISEC1(5) == 192.AND.ISEC1(6) == 31)THEN
            DO II=1,ISEC4(1)
              IF(ZBUF(II) == 19591204.0_JPRB)THEN
                ZBUF(II)=0.0_JPRB
              ENDIF
            ENDDO
          ENDIF
          IPAR=ISEC1(6)
          IYYMD=ISEC1(12)+ISEC1(11)*100+ISEC1(10)*10000+(ISEC1(21)-1)*1000000
          WRITE(NULOUT,'(A,I3,A,I8.8,A)')&
           & 'UPDCLIE_SEA: PARAMETER ',IPARAM, ' FOR DATE ',&
           & IYYMD,' READ FROM CLIMATE FILE'

          IDATEREF=IYYMD

!        distribute field to nodes

          CALL ISNDGPF(ZBUF,ZFLD)

        ENDIF

! ALL PROCESSORS SHOULD NOW RECEIVE

        CALL IRCVGPF(CLIMR_SEA(1,NPTMP,JCL),ZFLD,1)

! Synchronize IDATEREF
        ITAG=19591235
        CALL MPL_BROADCAST(IDATEREF,KTAG=ITAG,KROOT=1,CDSTRING='UPDCLIE_SEA')

      ENDDO READ
    ENDDO FIRST
  ENDIF

ENDIF READIF

LLFIRST=.FALSE.

WRITE(NULOUT,*) 'UPDCLIE_SEA finished'
CALL FLUSH(NULOUT)

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

