SUBROUTINE UPDCPL(KGP)

    USE PARKIND1, ONLY : JPIM

    INTEGER(KIND=JPIM),INTENT(IN) :: KGP

#include "abor1.intfb.h"

    CALL ABOR1('UPDCPL: NOT SUPPORTED WITH OASIS3-MCT VERSION OF EC-EARTH')

END SUBROUTINE UPDCPL

#if 0

!**** *UPDCPL*

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

!     Updates the climatological data on coupled mode

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

!     CALL UPDCPL(KGP)

!     METHOD.
!     -------

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

!     UPDCAL
!     CHIEN
!     FAITOU
!     FADIES
!     FACILE
!     FAIRME

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

!        CNRM/GMGEC/EAC/Jean-Philippe Piedelievre 09-1999

!     MODIFICATIONS.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!        original 99-01-28 from updcli
!     30-10-2002 by P. Marquet : transcoded to *.f90
!        M.Hamrud      01-Jul-2006 Revised surface fields
!     30-08-2006 by A. Alias   : RZHMER replaced by RZHZ0M*RZ0MER
!     05-09-2006 by A. Alias   : RZHGLA replaced by RZHZ0G*RZ0GLA
!     Apr 2008  K. Yessad: use DISGRID instead of DISGRID_C + cleanings
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY :      NDGLG    ,NDGSAG   ,NDGENG   ,NDLON    ,&
 & NFLEVG   ,NPROMA   ,NSMAX  
USE YOMLUN   , ONLY : NULOUT   
USE YOMGEM   , ONLY : NLOENG   ,NMENG    ,VALH     ,VBH      ,&
 & NSTTYP   ,NHTYP    ,NGPTOT   ,NGPTOTG  ,&
 & RMUCEN   ,RLOCEN   ,RSTRET   ,VP00  
USE YOMLEG   , ONLY : RMU
USE YOMCST   , ONLY : RG
USE YOMPHY1  , ONLY : ALBGLA   ,ALBMER   ,EMMGLA   ,EMMMER   ,&
 & RD2GLA   ,RD2MER   ,RZ0GLA   ,RZ0MER   ,RZHZ0G   ,&
 & RZHZ0M   ,TMERGL   ,WPMX     ,WSMX     ,NTVGLA   ,&
 & NTVMER  
USE YOMPHY   , ONLY : L2PHYS   ,LSOLV
USE YOMCT0   , ONLY : NQUAD    ,NPROC
USE YOMCT3   , ONLY : NSTEP
USE YOMMCC   , ONLY : LMCC03   ,LMCC05
USE YOMRIP   , ONLY : NINDAT   ,NSTADD
USE YOMSTA   , ONLY : RDTDZ1
USE YOMMP    , ONLY : MYPROC
USE SURFACE_FIELDS_MIX, ONLY : &
 & SP_SB, YSP_SBD, YSP_SB, SP_SG, YSP_SG, &
 & SP_RR, YSP_RR, & 
 & SD_VF, YSD_VF, SD_VP, YSD_VP, &
 & SD_VV, YSD_VVD, YSD_VV

USE YOM_OAS  , ONLY : CPHAN
USE PAR_COU  , ONLY : JPFLDO2A
USE YOM_CPL  , ONLY : CL_READ

USE YOMCOM   , ONLY : NVCOM   ,SSTMSK   ,OMLDTH   ,GTTLIN   ,SSTPRE   , TRAFLX   ,LOMLDTH

USE YOMCPL   , ONLY : FCSTSU   ,FCSTSV   ,FCCHAS   ,FCRSOS   ,&
 & FCCHLL   ,FCCHLN   ,FCCHSS  

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

IMPLICIT NONE

INTEGER(KIND=JPIM) ,INTENT(IN) :: KGP

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

INTEGER(KIND=JPIM) :: JPCCL
PARAMETER(JPCCL=20)

REAL(KIND=JPRB) ::      ZREALG(NDLON*(NDGLG+2))
REAL(KIND=JPRB) ::      ZFIELDBUF(NGPTOTG),ZLSMG(NGPTOTG),ZLSM(NGPTOT)
REAL(KIND=JPRB) ::      ZFIELD(NGPTOT,KGP)

INTEGER(KIND=JPIM) ::   ILMOIS(12),IDATEF(11)
INTEGER(KIND=JPIM) ::   INFOS(3)

CHARACTER (LEN = 3)  :: CLJOBNAM_R
CHARACTER (LEN = 16) :: CLNOMC
CHARACTER (LEN = 20) :: CLNOMF,CLOST(JPCCL)

!CLIM
INTEGER(KIND=JPIM) :: info
 
INTEGER(KIND=JPIM) ::      IA0
INTEGER(KIND=JPIM) ::      IAN
INTEGER(KIND=JPIM) ::      IEND
INTEGER(KIND=JPIM) ::      IINF
INTEGER(KIND=JPIM) ::      IJ0
INTEGER(KIND=JPIM) ::      IJOUR
INTEGER(KIND=JPIM) ::      IJT1
INTEGER(KIND=JPIM) ::      IJT2
INTEGER(KIND=JPIM) ::      IM0
INTEGER(KIND=JPIM) ::      IMOIS
INTEGER(KIND=JPIM) ::      IMT1
INTEGER(KIND=JPIM) ::      IMT2
INTEGER(KIND=JPIM) ::      INBARI
INTEGER(KIND=JPIM) ::      INBARP
INTEGER(KIND=JPIM) ::      INDEX
INTEGER(KIND=JPIM) ::      INIMES
INTEGER(KIND=JPIM) ::      INULCL
INTEGER(KIND=JPIM) ::      INULCL1
INTEGER(KIND=JPIM) ::      INULCL2
INTEGER(KIND=JPIM) ::      INUM
INTEGER(KIND=JPIM) ::      IBL
INTEGER(KIND=JPIM) ::      IREG
INTEGER(KIND=JPIM) ::      IREP
INTEGER(KIND=JPIM) ::      IROF
INTEGER(KIND=JPIM) ::      IST
INTEGER(KIND=JPIM) ::      ISTEPCPL
INTEGER(KIND=JPIM) ::      IZOA
INTEGER(KIND=JPIM) ::      IZOI
INTEGER(KIND=JPIM) ::      IZOT
INTEGER(KIND=JPIM) ::      IZST

INTEGER(KIND=JPIM) ::      J
INTEGER(KIND=JPIM) ::      JCSS
INTEGER(KIND=JPIM) ::      JKGLO
INTEGER(KIND=JPIM) ::      JM
INTEGER(KIND=JPIM) ::      JNULCL
INTEGER(KIND=JPIM) ::      JROF
INTEGER(KIND=JPIM) ::      JV

REAL(KIND=JPRB) ::      ZEPS
REAL(KIND=JPRB) ::      Z_CLIM_OK

REAL(KIND=JPRB) ::      ZPOID1
REAL(KIND=JPRB) ::      ZPOID2

REAL(KIND=JPRB) ::      ZWXMER
REAL(KIND=JPRB) ::      ZWXSUR
 
LOGICAL ::      LLERFA
LOGICAL ::      LLEXIST
LOGICAL ::      LLFICP
LOGICAL ::      LLIMST
LOGICAL ::      LLNOMM
LOGICAL ::      LLOPENED
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "fcttim.h"

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

INTERFACE
END INTERFACE

#include "abor1.intfb.h"
#include "chien.intfb.h"
#include "disgrid.intfb.h"
#include "sipc_read_model.intfb.h"
#include "slab.intfb.h"
#include "updcal.intfb.h"

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

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

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

WRITE(NULOUT,*)  ' ---------------------- '
WRITE(NULOUT,*)  ' UPDCPL ON PROC ',MYPROC
WRITE(NULOUT,*)  ' ---------------------- '

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

!*    1.1 Arpege files

!SLAB MODEL (LMCC05=.TRUE.)
CLOST(1)   =  'PROFMIXLAY.DEPTH' ! epaisseur de la couche de melange oceanique.
CLOST(2)   =  'PROFGRT.THERMOCL' ! gradient thermique de la thermocline.

LLNOMM=.TRUE.
LLERFA=.TRUE.
LLIMST=.FALSE.
INIMES=1
INBARP=14
CLNOMC='Cadre.Clim'
LLFICP=.FALSE.
INULCL1=0
INULCL2=0
LLOPENED=.FALSE.
LLEXIST =.FALSE.

!* Calendar

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

!*    1.4 Physics

!        Definition of physical properties of bare sea-ice (GLA) and
!        open sea (MER). When the sea-ice is considered as sea (LMCC02=.F.),
!        the snow reservoir is no more used, and thus the physical
!        properties should include a "mean" snow cover; we introduce
!        thus the sea-ice properties (BAN).

!       Reservoirs
ZWXMER=WPMX
ZWXSUR=WSMX

INUM=0

IF (LMCC03) THEN

! SST
  IZOT=1
! SEA ICE COVER
  IZOI=2
! ALBEDO
  IZOA=3

!*        Couplage OASIS

!*    2.8 Reading surface temperature and sea-ice mask from coupler

!CLIM com (LMCC03)
  Z_CLIM_OK=0
  ISTEPCPL=NSTEP+1
  IF(NSTEP == 0) ISTEPCPL=0
!ENDCLIM

!* 1) Sea-ice surface temperature
!* 2) sea-ice index or ice fraction
!* 3) sea-ice surface albedo

! COUPLAGE A OASIS

! RECEPTION DES FLUX VENANT D'OASIS

  DO JV=1,JPFLDO2A
    INUM=INUM+1
    IF (MYPROC == 1) THEN

!* Reading of input field sea-surface-temperature SISUTESU
!* or sea-ice cover SIICECOV in shared-memory segment
!* jv is the index of the field in total number of fields jpfldo2a

      IF    ( CPHAN == 'SIPC') THEN

        CALL SIPC_READ_MODEL(JV,NGPTOTG,CLJOBNAM_R,INFOS,ZFIELDBUF)

      ELSEIF( CPHAN == 'MPI2') THEN

        CALL CLIM_IMPORT(CL_READ(JV),ISTEPCPL,ZFIELDBUF,INFO)
        IF(INFO /= Z_CLIM_OK) then
          WRITE(NULOUT,*) 'PB in READING ',CL_READ(JV),JV
          WRITE(NULOUT,*) 'COUPLAGE STEP IS =',ISTEPCPL
          WRITE(NULOUT,*) 'CLIM ERROR CODE IS =',INFO
          CALL FLUSH(NULOUT)
          CALL ABOR1('UPDCPL: ABOR1 CALLED CLIM_IMPORT')
        ENDIF
      ENDIF

      CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
      ZFIELD(:,JV)=ZFIELDBUF(:NGPTOT)
    ELSE
      CALL DISGRID(INUM,1,NGPTOT,ZFIELD(1,JV),LDC=.TRUE.,KIOPROC=1)
    ENDIF
  ENDDO

!  CORRECTION OF SURFACE TEMPERATURE BY GIBBS OROGRAPHY

  INUM=INUM+1
  IF (MYPROC == 1) THEN

!*  Opening the local climatic boundary conditions file
!*  used by the external module updcli at the beginning
!*  of the run.
!*  The geopotentiel information is avaible in the restart
!*  file but in the spectral mode. That avoids the use of
!*  a spectral-gridpoint translation....

    DO JNULCL=1,99
      INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
      IF (.NOT.LLOPENED) EXIT
    ENDDO
    INULCL=JNULCL
    CALL FAITOU (IREP,INULCL,LLNOMM,'ICMSH0123INIT','OLD',&
     & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  
    ZEPS=1.E-10_JPRB
    IINF=0
    CALL CHIEN (CLNOMC,NSTTYP,RMUCEN,RLOCEN,RSTRET,&
     & NSMAX,NDGLG,NDLON,NLOENG,NMENG,RMU,NHTYP,NFLEVG,&
     & VP00,VALH,VBH,NQUAD,IINF,NDGSAG,NDGENG,&
     & ZEPS,LLFICP,NULOUT)  
!*    Indices for horizontal loops
    IF (LLFICP) THEN
      INDEX=NLOENG(1)+1
    ELSE
      INDEX=1
    ENDIF
    CALL FACILE(IREP,INULCL,'SURF',1,'GEOPOTENTIEL',ZREALG,.FALSE.)
    CALL FAIRME (IREP,INULCL,'KEEP')
    ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
    CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
  ELSE
    CALL DISGRID(INUM,1,NGPTOT,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
  ENDIF
  ZFIELD(:,1)=ZFIELD(:,1)+RDTDZ1/RG*ZFIELDBUF(:NGPTOT)

ELSEIF (LMCC05) THEN

!  SST COM
  IZOT=1
!  SST STATISTIQUE LUE DANS LE FICHIER BCOND
  IZST=2

!* Couplage COM

!* Reads the buffers

! On  recupere TSTAT 

  DO JKGLO=1,NGPTOT,NPROMA
    IST=1
    IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
    IBL=(JKGLO-1)/NPROMA+1
    DO JROF=IST,IEND
      IROF=JROF+JKGLO-1
      ZFIELD(IROF,IZST)=SD_VP(JROF,YSD_VP%YTPC%MP,IBL)
      ZLSM(IROF)=SD_VF(JROF,YSD_VF%YLSM%MP,IBL)
    ENDDO
  ENDDO

  IF (NSTEP == 0) THEN

! Initialisation

! au premier appel, la profondeur de melange et le gradT thermocline
! ------------------------------------------------------------------
    INQUIRE(FILE='ICMCM0123INIT',EXIST=LLEXIST)

    IF (LLEXIST) THEN
! sont lus dans le fichier historique s'il existe.
! (copie de sauvegarde d'un passge anterieur)
! Attention : le fichier sera detruit apres lecture.
! (STATUS='DELETE' dans FAIRME)
! ------------------------------------------------
      IF (MYPROC == 1) THEN
!*    Opening Arpege files : month 1 for the stat-dyn mask
        WRITE(UNIT=CLNOMF,FMT='(''Const.Clim.'',I2.2)') IMT1
        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL=JNULCL
        CALL FAITOU (IREP,INULCL,LLNOMM,CLNOMF,'OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  

        PRINT *,' FICHIER ',CLNOMF,' OUVERT'

        ZEPS=1.E-10_JPRB
        IINF=0
        CALL CHIEN (CLNOMC,NSTTYP,RMUCEN,RLOCEN,RSTRET,&
         & NSMAX,NDGLG,NDLON,NLOENG,NMENG,RMU,NHTYP,NFLEVG,&
         & VP00,VALH,VBH,NQUAD,IINF,NDGSAG,NDGENG,&
         & ZEPS,LLFICP,NULOUT)  
        IF (.NOT.LLFICP) THEN
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED: LLFICP=.F.')
        ENDIF
        CALL FADIES (IREP,INULCL,IDATEF)
        IF (IDATEF(2) /= IMT1) THEN
          WRITE(NULOUT,'('' ERROR IDATEF '',11I6/'' IMT1 '',I4)')IDATEF,IMT1
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED')
        ENDIF
!*    Indices for horizontal loops
        IF (LLFICP) THEN
          INDEX=NLOENG(1)+1
        ELSE
          INDEX=1
        ENDIF

! masque dynamique-statistique (dyn=1./stat=0./+ transitions)
        CALL FACILE (IREP,INULCL,'SURF',1,'COMMASK',ZREALG,.FALSE.)

        PRINT *,' LECTURE DE COMMASK'

        ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
        WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
         & '' FIELD:'')') 'SURFCOMMASK'  
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)

        PRINT *,' ENVOIE DE COMMASK DEPUIS PROC 1'

        SSTMSK=ZFIELDBUF(:NGPTOT)

! correction de flux du au transport
        CALL FACILE (IREP,INULCL,'SURF',1,'TRANSFLUX',ZREALG,.FALSE.)

        PRINT *,' LECTURE DE TRANSFLUX'

        ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
        WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
         & '' FIELD:'')') 'SURFTRANSFLUX'  
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)

        PRINT *,' ENVOIE DE TRANSFLUX DEPUIS PROC 1'

        TRAFLX=ZFIELDBUF(:NGPTOT)

        CALL FAIRME (IREG,INULCL,'KEEP')

        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL=JNULCL
        CALL FAITOU (IREP,INULCL,LLNOMM,'ICMCM0123INIT','OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  

        PRINT *,' OUVERTURE DU FICHIER ICMCM0123INIT'

! valeurs des parametres du modele archivees a la fin du passage precedent
        DO JV=1,NVCOM
          CALL FACILE (IREP,INULCL,CLOST(JV)(1:4),1,&
           & CLOST(JV)(5:),ZREALG,.FALSE.)  

          PRINT *,' LECTURE DE ',CLOST(JV)(5:)

          ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
          WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
           & '' FIELD:'')') CLOST(JV)  
          IF (JV == 1) THEN
            OMLDTH=ZFIELDBUF(:NGPTOT)
          ELSEIF (JV == 2) THEN
            GTTLIN=ZFIELDBUF(:NGPTOT)
          ENDIF
          INUM=INUM+1
          CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)

          PRINT *,' ENVOIE DE ',CLOST(JV)(5:),' DEPUIS PROC 1'

        ENDDO
! temperature de surface archivee a la fin du passage precedent
        CALL FACILE (IREP,INULCL,'SURF',1,'TEMPERATURE',ZREALG,.FALSE.)

        PRINT *,' LECTURE DE LA TEMPERATURE'

        ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
        WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
         & '' FIELD:'')') 'SURFTEMPERATURE'  
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)

        PRINT *,' ENVOIE DE LA TEMPERATURE DEPUIS PROC 1'

! Initialisation de la temperature
        SSTPRE=ZFIELDBUF(:NGPTOT)
        CALL FAIRME (IREG,INULCL,'DELETE')
      ELSE
        INUM=INUM+1
        CALL DISGRID(INUM,1,NGPTOT,SSTMSK,LDC=.TRUE.,KIOPROC=1)

        PRINT *,' RECEPTION DE SSTMSK SUR PROC ',NPROC

        DO JV=1,NVCOM
          INUM=INUM+1
          IF (JV == 1) THEN
            CALL DISGRID(INUM,1,NGPTOT,OMLDTH,LDC=.TRUE.,KIOPROC=1)

            PRINT *,' RECEPTION DE OMLDTH SUR PROC ',NPROC

          ELSEIF (JV == 2) THEN
            CALL DISGRID(INUM,1,NGPTOT,GTTLIN,LDC=.TRUE.,KIOPROC=1)

            PRINT *,' RECEPTION DE GTTLIN SUR PROC ',NPROC

          ENDIF
        ENDDO
        INUM=INUM+1
        CALL DISGRID(INUM,1,NGPTOT,SSTPRE,LDC=.TRUE.,KIOPROC=1)

        PRINT *,' RECEPTION DE SSTPRE SUR PROC ',NPROC

      ENDIF

    ELSE

! sinon on applique la methode updcli (interpolation lineaire entre deux mois)
! pour les parametres du modele et on recupere la temperature calculee par updcli
! ---------------------------------------------------------------------------
! On  recupere TSURF dans GPPBUF ecrite par updcli

      DO JKGLO=1,NGPTOT,NPROMA
        IST=1
        IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
        IBL=(JKGLO-1)/NPROMA+1
        DO JROF=IST,IEND
          IROF=JROF+JKGLO-1
          SSTPRE(IROF)=SP_RR(JROF,YSP_RR%YT%MP,IBL)
        ENDDO
      ENDDO

!*    Opening Arpege files : month 1

      IF (MYPROC == 1) THEN
        WRITE(UNIT=CLNOMF,FMT='(''Const.Clim.'',I2.2)') IMT1
        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL1=JNULCL
        CALL FAITOU (IREP,INULCL1,LLNOMM,CLNOMF,'OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  
        ZEPS=1.E-10_JPRB
        IINF=0
        CALL CHIEN (CLNOMC,NSTTYP,RMUCEN,RLOCEN,RSTRET,&
         & NSMAX,NDGLG,NDLON,NLOENG,NMENG,RMU,NHTYP,NFLEVG,&
         & VP00,VALH,VBH,NQUAD,IINF,NDGSAG,NDGENG,&
         & ZEPS,LLFICP,NULOUT)  
        IF (.NOT.LLFICP) THEN
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED: LLFICP=.F.')
        ENDIF
        CALL FADIES (IREP,INULCL1,IDATEF)
        IF (IDATEF(2) /= IMT1) THEN
          WRITE(NULOUT,'('' ERROR IDATEF '',11I6/'' IMT1 '',I4)')IDATEF,IMT1
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED')
        ENDIF

!*    Opening Arpege files : month 2

        WRITE(UNIT=CLNOMF,FMT='(''Const.Clim.'',I2.2)') IMT2
        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL2=JNULCL
        CALL FAITOU (IREP,INULCL2,LLNOMM,CLNOMF,'OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  
        CALL FADIES (IREP,INULCL2,IDATEF)
        IF (IDATEF(2) /= IMT2) THEN
          WRITE(NULOUT,'('' ERROR IDATEF '',11I6/'' IMT2 '',I4)')IDATEF,IMT2
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED')
        ENDIF

!*    Indices for horizontal loops

        IF (LLFICP) THEN
          INDEX=NLOENG(1)+1
        ELSE
          INDEX=1
        ENDIF

! indice terre mer pour limiter les modifications aux surfaces maritimes
        CALL FACILE (IREP,INULCL1,'SURF',1,'IND.TERREMER',ZREALG,.FALSE.)
        ZLSMG=ZREALG(INDEX:NGPTOTG+INDEX-1)

        DO JV=1,NVCOM
          DO JM=1,2
            IF (JM == 1) THEN
              INULCL=INULCL1
            ELSE
              INULCL=INULCL2
            ENDIF
            CALL FACILE (IREP,INULCL,CLOST(JV)(1:4),1,&
             & CLOST(JV)(5:),ZREALG,.FALSE.)  
            WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
             & '' FIELD:'')') CLOST(JV)  
            IF (JM == 1) THEN
              ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
            ELSE
              DO JROF=1,NGPTOTG
                IF (ZLSMG(JROF) < 0.5_JPRB) THEN
                  ZFIELDBUF(JROF)=ZFIELDBUF(JROF)*ZPOID1+&
                   & ZREALG(INDEX+JROF-1)*ZPOID2  
                ENDIF
              ENDDO
            ENDIF
          ENDDO ! JM=1,2
          IF (JV == 1) THEN
            OMLDTH=ZFIELDBUF(:NGPTOT)
          ELSEIF (JV == 2) THEN
            GTTLIN=ZFIELDBUF(:NGPTOT)
          ENDIF
          INUM=INUM+1
          CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
        ENDDO

        CALL FACILE(IREP,INULCL,'SURF',1,'COMMASK',ZREALG,.FALSE.)
        WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
         & '' FIELD:'')') 'COMMASK'  
        ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
        SSTMSK=ZFIELDBUF(:NGPTOT)
        PRINT *,' LECTURE INITIALE SSTMSK'

        CALL FACILE (IREP,INULCL,'SURF',1,'TRANSFLUX',ZREALG,.FALSE.)
        ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
        WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
         & '' FIELD:'')') 'TRANSFLUX'  
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)
        TRAFLX=ZFIELDBUF(:NGPTOT)
        PRINT *,' LECTURE INITIALE TRAFLX'

        CALL FAIRME (IREG,INULCL1,'KEEP')
        CALL FAIRME (IREG,INULCL2,'KEEP')

      ELSE
! Get  data
        DO JV=1,NVCOM
          INUM=INUM+1
          IF (JV == 1) THEN
            CALL DISGRID(INUM,1,NGPTOT,OMLDTH,LDC=.TRUE.,KIOPROC=1)
          ELSEIF (JV == 2) THEN
            CALL DISGRID(INUM,1,NGPTOT,GTTLIN,LDC=.TRUE.,KIOPROC=1)
          ENDIF
        ENDDO
        INUM=INUM+1
        CALL DISGRID(INUM,1,NGPTOT,SSTMSK,LDC=.TRUE.,KIOPROC=1)
      ENDIF  !MYPROC
    ENDIF  !LEXIST

  ELSEIF (NSTEP > 0) THEN

! INPUTS du modele.

! Flux cumules sur NFRCPL*TSTEP secondes

! FCSTSU, FCSTSV : Somme (stress U et V)*TSTEP
! FCCHAS         : Somme (RTHER + CHALEAU + CHALNEI + CHASEN)*TSTEP
! FCRSOS         : Somme (RSOL)*TSTEP
! FCCHLL         : Somme (CHALEAU)*TSTEP
! FCCHLN         : Somme (CHALNEI)*TSTEP
! FCCHSS         : Somme (CHASEN)*TSTEP
! OMLDTH         : Profondeur de la couche de melange oceanique
! GTTLIN         : Gradient thermique de la thermocline
! SSTPRE         : Temperature de surface

! OUTPUTS.

! IF ( LOMLDTH ) THEN
! OMLDTH         : Profondeur de la couche de melange oceanique
! ENDIF
! GTTLIN         : Gradient thermique de la thermocline
! SSTPRE         : Temperature de surface prevue par le modele dynamique 1D
! TRAFLX         : Flux de correction pour transports.

    IF ( .NOT. LOMLDTH ) THEN

! L'evolution de la profondeur de melange n'est pas calculee par le modele
! de couche de melange

! On applique l'interpolation lineaire entre deux mois
! pour la profondeur de melange
! -----------------------------

!*    Opening Arpege files : month 1

      IF (MYPROC == 1) THEN
        WRITE(UNIT=CLNOMF,FMT='(''Const.Clim.'',I2.2)') IMT1
        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL1=JNULCL
        CALL FAITOU (IREP,INULCL1,LLNOMM,CLNOMF,'OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  
        ZEPS=1.E-10_JPRB
        IINF=0
        CALL CHIEN (CLNOMC,NSTTYP,RMUCEN,RLOCEN,RSTRET,&
         & NSMAX,NDGLG,NDLON,NLOENG,NMENG,RMU,NHTYP,NFLEVG,&
         & VP00,VALH,VBH,NQUAD,IINF,NDGSAG,NDGENG,&
         & ZEPS,LLFICP,NULOUT)  
        IF (.NOT.LLFICP) THEN
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED: LLFICP=.F.')
        ENDIF
        CALL FADIES (IREP,INULCL1,IDATEF)
        IF (IDATEF(2) /= IMT1) THEN
          WRITE(NULOUT,'('' ERROR IDATEF '',11I6/'' IMT1 '',I4)')IDATEF,IMT1
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED')
        ENDIF

!*    Opening Arpege files : month 2

        WRITE(UNIT=CLNOMF,FMT='(''Const.Clim.'',I2.2)') IMT2
        DO JNULCL=1,99
          INQUIRE(UNIT=JNULCL,OPENED=LLOPENED)
          IF (.NOT.LLOPENED) EXIT
        ENDDO
        INULCL2=JNULCL
        CALL FAITOU (IREP,INULCL2,LLNOMM,CLNOMF,'OLD',&
         & LLERFA,LLIMST,INIMES,INBARP,INBARI,CLNOMC)  
        CALL FADIES (IREP,INULCL2,IDATEF)
        IF (IDATEF(2) /= IMT2) THEN
          WRITE(NULOUT,'('' ERROR IDATEF '',11I6/'' IMT2 '',I4)')IDATEF,IMT2
          CALL ABOR1 ('UPDCPL: ABOR1 CALLED')
        ENDIF

!*    Indices for horizontal loops

        IF (LLFICP) THEN
          INDEX=NLOENG(1)+1
        ELSE
          INDEX=1
        ENDIF

        DO JM=1,2
          IF (JM == 1) THEN
            INULCL=INULCL1
          ELSE
            INULCL=INULCL2
          ENDIF
          CALL FACILE (IREP,INULCL,CLOST(1)(1:4),1,&
           & CLOST(1)(5:),ZREALG,.FALSE.)  
          WRITE(NULOUT,'(2X,A,'' READ FROM ARPEGE FILE'',&
           & '' FIELD:'')') CLOST(JV)  
          IF (JM == 1) THEN
            ZFIELDBUF=ZREALG(INDEX:NGPTOTG+INDEX-1)
          ELSE
            DO JROF=1,NGPTOTG
              IF (ZLSMG(JROF) < 0.5_JPRB) THEN
                ZFIELDBUF(JROF)=ZFIELDBUF(JROF)*ZPOID1+&
                 & ZREALG(INDEX+JROF-1)*ZPOID2  
              ENDIF
            ENDDO
          ENDIF
        ENDDO ! JM=1,2
        OMLDTH=ZFIELDBUF(:NGPTOT)
        INUM=INUM+1
        CALL DISGRID(INUM,0,NGPTOTG,ZFIELDBUF,LDC=.TRUE.,KIOPROC=1)

        CALL FAIRME (IREG,INULCL1,'KEEP')
        CALL FAIRME (IREG,INULCL2,'KEEP')

      ELSE
! Get  data
        INUM=INUM+1
        CALL DISGRID(INUM,1,NGPTOT,OMLDTH,LDC=.TRUE.,KIOPROC=1)
      ENDIF  !MYPROC

    ENDIF

    PRINT *,' NSTEP=',NSTEP,' DANS UPDCPL.F AVANT L''APPEL AU SLAB'

    CALL SLAB(ZLSM)

    PRINT *,' DANS UPDCPL.F APRET L''APPEL AU SLAB'

! Remise a zero des cumuls de flux

    FCSTSU=0.0_JPRB
    FCSTSV=0.0_JPRB
    FCCHAS=0.0_JPRB
    FCRSOS=0.0_JPRB
    FCCHLL=0.0_JPRB
    FCCHLN=0.0_JPRB
    FCCHSS=0.0_JPRB

  ENDIF !NSTEP == 0

  DO J=1,NGPTOT

! MIXAGE STATISTIQUE-DYNAMIQUE

! WARNING !!!  LE MODELE DYNAMIQUE NE GERE PAS LA BANQUISE.

    IF ( ZFIELD(J,IZST) < TMERGL ) THEN
      SSTPRE(J)=ZFIELD(J,IZST)
      ZFIELD(J,IZOT)=SSTPRE(J)
    ELSE
      SSTPRE(J)=MAX(TMERGL,SSTPRE(J))
      ZFIELD(J,IZOT)=SSTMSK(J)*SSTPRE(J)+(1.0_JPRB-SSTMSK(J))*ZFIELD(J,IZST)
      SSTPRE(J)=ZFIELD(J,IZOT)
    ENDIF

  ENDDO

ENDIF !LMCC03-LMCC05

!*    3.1   Reads the buffers

DO JKGLO=1,NGPTOT,NPROMA

  IST=1
  IEND=MIN(NPROMA,NGPTOT-JKGLO+1)
  IBL=(JKGLO-1)/NPROMA+1

  DO JROF=IST,IEND
    IROF=JROF+JKGLO-1

! no land
    IF (SD_VF(JROF,YSD_VF%YLSM%MP,IBL) < .999_JPRB) THEN

      IF (L2PHYS) THEN
        SD_VF(JROF,YSD_VF%YSST%MP,IBL)=ZFIELD(IROF,IZOT)
      ENDIF

      IF (LMCC03) THEN

        IF (ZFIELD(IROF,IZOI) < 0.5_JPRB) THEN

!            Sea to Sea or Sea Ice to Sea or the fluxes are calculated
!            only over Sea (leads)

          SD_VF(JROF,YSD_VF%YLSM%MP,IBL)=0.
          SD_VF(JROF,YSD_VF%YZ0F%MP,IBL)=RZ0MER*RG
          IF(JPFLDO2A >= 3) THEN
            SD_VF(JROF,YSD_VF%YALBF%MP,IBL)=ZFIELD(IROF,IZOA)
          ELSE
            SD_VF(JROF,YSD_VF%YALBF%MP,IBL)=ALBMER
          ENDIF
          SD_VF(JROF,YSD_VF%YEMISF%MP,IBL)=EMMMER
          SP_RR(JROF,YSP_RR%YT%MP,IBL)=ZFIELD(IROF,IZOT)
          DO JCSS=1,YSP_SBD%NLEVS
            SP_SB(JROF,JCSS,YSP_SB%YT%MP,IBL)=SP_RR(JROF,YSP_RR%YT%MP,IBL)
          ENDDO
          SP_RR(JROF,YSP_RR%YW%MP,IBL)=ZWXSUR
          SP_SB(JROF,1,YSP_SB%YQ%MP,IBL)=ZWXMER
          SP_SG(JROF,YSP_SG%YF%MP,IBL)=0.
          SD_VP(JROF,YSD_VP%YTPC%MP,IBL)=SP_RR(JROF,YSP_RR%YT%MP,IBL)
          SD_VP(JROF,YSD_VP%YWPC%MP,IBL)=WPMX
          IF (LSOLV) THEN
            SD_VV(JROF,YSD_VV%YIVEG%MP,IBL)=REAL(NTVMER)
            SD_VV(JROF,YSD_VV%YD2%MP,IBL)=RD2MER
            SD_VV(JROF,YSD_VV%YLAI%MP,IBL)=0.
            IF (YSD_VVD%NUMFLDS >= 8) THEN
              SD_VV(JROF,YSD_VV%YZ0H%MP,IBL)=RZHZ0M*RZ0MER*RG
            ENDIF
          ENDIF
        ELSEIF (ZFIELD(IROF,IZOI) < 1.5_JPRB) THEN
!            Sea Ice to Sea Ice
          SD_VF(JROF,YSD_VF%YLSM%MP,IBL)=1.
          SD_VF(JROF,YSD_VF%YZ0F%MP,IBL)=RZ0GLA*RG
          SD_VF(JROF,YSD_VF%YALBF%MP,IBL)=ALBGLA
          SD_VF(JROF,YSD_VF%YEMISF%MP,IBL)=EMMGLA
          SD_VP(JROF,YSD_VP%YTPC%MP,IBL)=TMERGL
          SD_VP(JROF,YSD_VP%YWPC%MP,IBL)=WPMX
          IF (LSOLV) THEN
            SD_VV(JROF,YSD_VV%YIVEG%MP,IBL)=REAL(NTVGLA)+.1
            SD_VV(JROF,YSD_VV%YD2%MP,IBL)=RD2GLA
            SD_VV(JROF,YSD_VV%YLAI%MP,IBL)=0.
            IF (YSD_VVD%NUMFLDS >= 8) THEN
              SD_VV(JROF,YSD_VV%YZ0H%MP,IBL)=RZHZ0G*RZ0GLA*RG
            ENDIF
          ENDIF
        ELSE
!            Sea to Sea Ice
          SD_VF(JROF,YSD_VF%YLSM%MP,IBL)=1.
          SD_VF(JROF,YSD_VF%YZ0F%MP,IBL)=RZ0GLA*RG
          SD_VF(JROF,YSD_VF%YALBF%MP,IBL)=ALBGLA
          SD_VF(JROF,YSD_VF%YEMISF%MP,IBL)=EMMGLA
          SD_VP(JROF,YSD_VP%YTPC%MP,IBL)=TMERGL
          SD_VP(JROF,YSD_VP%YWPC%MP,IBL)=WPMX
          IF (LSOLV) THEN
            SD_VV(JROF,YSD_VV%YIVEG%MP,IBL)=REAL(NTVGLA)+.1
            SD_VV(JROF,YSD_VV%YD2%MP,IBL)=RD2GLA
            SD_VV(JROF,YSD_VV%YLAI%MP,IBL)=0.
            IF (YSD_VVD%NUMFLDS >= 8) THEN
              SD_VV(JROF,YSD_VV%YZ0H%MP,IBL)=RZHZ0G*RZ0GLA*RG
            ENDIF
          ENDIF
          SP_RR(JROF,YSP_RR%YT%MP,IBL)=TMERGL
          DO JCSS=1,YSP_SBD%NLEVS
            SP_SB(JROF,JCSS,YSP_SB%YT%MP,IBL)=TMERGL
          ENDDO
        ENDIF

      ELSEIF (LMCC05) THEN

        SP_RR(JROF,YSP_RR%YT%MP,IBL)=ZFIELD(IROF,IZOT)
        DO JCSS=1,YSP_SBD%NLEVS
          SP_SB(JROF,JCSS,YSP_SB%YT%MP,IBL)=SP_RR(JROF,YSP_RR%YT%MP,IBL)
        ENDDO

      ENDIF  !LMCC03/LMCC05

    ENDIF ! no land

  ENDDO !END OF JROF=IST,IEND

ENDDO  !END OF JKGLO=1,NGPTOT,NPROMA

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

IF (LHOOK) CALL DR_HOOK('UPDCPL',1,ZHOOK_HANDLE)
END SUBROUTINE UPDCPL
#endif
