SUBROUTINE CUMCPL(KLEVCO,KSTA,KEND,KSTGLO,KTS,&
 & PSTRTU,PSTRTV,PFRTH,PFRSO,PFCLL,PFCLN,PFCS,PFEVL,PFEVN,&
 & PFPLCL,PFPLCN,PFPLSL,PFPLSN,&
 & PRUISS,PRUISP,PTSUR,PDNSHF,PALB)

!**** *CUMCPL* - CUMUL OF COUPLED FIELDS.

!     Purpose.
!     --------
!           DIAGNOSTICS OF PHYSICAL SURFACE FLUXES.

!**   Interface.
!     ----------
!        *CALL* *CUMCPL*

!        Explicit arguments :
!        --------------------

!       KLEVCO                 - dimension for PFRTH,PFRSO.
!       KSTA                   - first element of work.
!       KEND                   - last element of work.
!       KSTGLO                 - global offset.
!       KTS                    - NUMBER OF SURFACE TEMPERATURES (INPUT)
!       FLUXES COMING FROM THE PHYSICAL PARAMETERIZATIONS:

!       PSTRTU(NPROMM)              - FLUX TURBULENT DE QTE DE MVT "U" (INPUT)
!       PSTRTV(NPROMM)              - FLUX TURBULENT DE QTE DE MVT "V" (INPUT)
!       PFRTH (NPROMM,0:KLEVCO,KTS+1) - FLUX DE RAYONNEMENT THERMIQUE    (INPUT)
!       PFRSO (NPROMM,0:KLEVCO,KTS+1) - FLUX DE RAYONNEMENT SOLAIRE.     (INPUT)
!       PFCLL (NPROMM,KTS+1) - FLUX DE CHALEUR LATENTE EAU.     (INPUT)
!       PFCLN (NPROMM,KTS+1) - FLUX DE CHALEUR LATENTE NEIGE    (INPUT)
!       PFCS  (NPROMM,KTS+1) - FLUX DE CHALEUR SENSIBLE         (INPUT)
!       PFEVL (NPROMM,KTS+1) - FLUX D'EVAPORATION EAU           (INPUT)
!       PFEVN (NPROMM,KTS+1) - FLUX D'EVAPORATION NEIGE         (INPUT)
!       PFPLCL(NPROMM)              - PRECIP. CONVECTIVES LIQUIDES.    (INPUT)
!       PFPLCN(NPROMM)              - PRECIP. CONVECTIVES NEIGEUSES.   (INPUT)
!       PFPLSL(NPROMM)              - PRECIP. STRATIFORMES LIQUIDES.   (INPUT)
!       PFPLSN(NPROMM)              - PRECIP. STRATIFORMES NEIGEUSES.  (INPUT)
!       PRUISS(NPROMM)              - RUISSELLEMENT SURFACE            (INPUT)
!       PRUISP(NPROMM)              - RUISSELLEMENT PROFONDEUR         (INPUT)
!       PTSUR(NPROMM)               - TEMPERATURE SURFACE              (INPUT)
!       PDNSHF(NPROMM)              - DERIVATIVE OF NONSOLAR FLUX      (INPUT)
!       PALB(NPROMM)                - SURFACE ALBEDO                   (INPUT)
!        --------------------

!     Method.
!     -------
!        See documentation

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

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

!     Author.
!     -------

!        CNRM/GMGEC/EAC/JPh Piedelievre

!     Modifications.
!     --------------
!        Original : 00-11-29 from CUMCODM
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     K. Yessad (Dec 2008): remove dummy CDLOCK + cleanings
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NPROMM
USE YOMCST   , ONLY : RTT      
USE YOMDYN   , ONLY : TSTEP
USE YOMCPL   , ONLY : FCSTSU   ,FCSTSV    ,FCCHAS    ,&
 & FCRSOS   ,FCHUMS   ,FCRUIS    ,FCCHSS    ,&
 & FCHUML   ,FCHUMN   ,FCTSUR2   ,FCTSTS    ,FCTSFL  
USE YOMPHY   , ONLY : LSOLV

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVCO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTRTU(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTRTV(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRTH(NPROMM,0:KLEVCO,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRSO(NPROMM,0:KLEVCO,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCLL(NPROMM,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCLN(NPROMM,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCS(NPROMM,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFEVL(NPROMM,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFEVN(NPROMM,KTS+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLCL(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLCN(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLSL(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLSN(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRUISS(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRUISP(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSUR(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDNSHF(NPROMM) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALB(NPROMM) 

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

INTEGER(KIND=JPIM) :: IBEG, IEND, ISTA, JROF, JTS

LOGICAL :: LL_LMCCIC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CUMCPL',0,ZHOOK_HANDLE)
!     ------------------------------------------------------------------

LL_LMCCIC=.TRUE.

!     CUMUL

ISTA=KSTA
IEND=KEND
IBEG=KSTGLO-1
DO JROF=ISTA,IEND
  FCSTSU(IBEG+JROF)=FCSTSU(IBEG+JROF)+PSTRTU(JROF)*TSTEP
  FCSTSV(IBEG+JROF)=FCSTSV(IBEG+JROF)+PSTRTV(JROF)*TSTEP
  IF(LSOLV) THEN
    FCRUIS(IBEG+JROF)=FCRUIS(IBEG+JROF)+PRUISP(JROF)*TSTEP
  ELSE
    FCRUIS(IBEG+JROF)=FCRUIS(IBEG+JROF)+(PRUISS(JROF)+PRUISP(JROF))*TSTEP
  ENDIF
  FCHUML(IBEG+JROF)=FCHUML(IBEG+JROF)+(PFPLCL(JROF)+PFPLSL(JROF))*TSTEP
  FCHUMN(IBEG+JROF)=FCHUMN(IBEG+JROF)+(PFPLCN(JROF)+PFPLSN(JROF))*TSTEP
  FCTSUR2(IBEG+JROF)=FCTSUR2(IBEG+JROF)+(PTSUR(JROF)-RTT)*TSTEP
  IF(LL_LMCCIC) THEN
! we store here the albedo and derivative of non solar heat flux
    FCTSTS(IBEG+JROF)=FCTSTS(IBEG+JROF)+PALB(JROF)*TSTEP
    FCTSFL(IBEG+JROF)=FCTSFL(IBEG+JROF)+PDNSHF(JROF)*TSTEP
  ELSE
! we store the temperature variance and covariance with heat flux
    FCTSTS(IBEG+JROF)=FCTSTS(IBEG+JROF)+(PTSUR(JROF)-RTT)&
     & *(PTSUR(JROF)-RTT)*TSTEP  
    FCTSFL(IBEG+JROF)=FCTSFL(IBEG+JROF)+(PTSUR(JROF)-RTT)&
     & *(PFRTH(JROF,KLEVCO,1)+PFCLL(JROF,1)+PFCLN(JROF,1)&
     & +PFCS(JROF,1))*TSTEP  
  ENDIF
ENDDO

DO JTS=1,KTS+1
  DO JROF=ISTA,IEND
    FCCHAS(IBEG+JROF,JTS)=FCCHAS(IBEG+JROF,JTS)&
     & +(PFRTH(JROF,KLEVCO,JTS)+PFCLL(JROF,JTS)&
     & + PFCLN(JROF,JTS)+PFCS(JROF,JTS))*TSTEP  
    FCRSOS(IBEG+JROF,JTS)=FCRSOS(IBEG+JROF,JTS)+PFRSO(JROF,KLEVCO,JTS)*TSTEP
    FCHUMS(IBEG+JROF,JTS)=FCHUMS(IBEG+JROF,JTS)&
     & +(PFPLCL(JROF)+PFPLCN(JROF)+PFPLSL(JROF)+PFPLSN(JROF)&
     & + PFEVL(JROF,JTS)+PFEVN(JROF,JTS))*TSTEP  
    IF(LL_LMCCIC) THEN
! CA2 modif Laurent Terray=====> we store here the evaporation
      FCCHSS(IBEG+JROF,JTS)=FCCHSS(IBEG+JROF,JTS)&
       & +(PFEVL(JROF,JTS)+PFEVN(JROF,JTS))*TSTEP  
    ELSE
! we store the sensible heat flux
      FCCHSS(IBEG+JROF,JTS)=FCCHSS(IBEG+JROF,JTS)+PFCS(JROF,JTS)*TSTEP
    ENDIF
  ENDDO
ENDDO

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CUMCPL',1,ZHOOK_HANDLE)
END SUBROUTINE CUMCPL
