SUBROUTINE CPCUDDH (KPROMA, KSTART, KPROF, KDDHI, PDHSF,&
 & PDHCV, PDHCS, LDDYN, LDPHY,KDHCVSU)  
!****
!     ------------------------------------------------------------------

!     MOYENNES HORIZONTALES ET CUMULS SUR DOMAINES INTERNES
!     DIAGNOSTICS PAR DOMAINES HORIZONTAUX
!     ------------------------------------

!       -------------------------------------------------------
!     BUT
!     ---
!      MISE A JOUR DES TABLEAUX DE CUMULS DE /YOMTDDH/
!     AVEC LES VALEURS DU MOMENT (VARIABLES ET TENDANCES/FLUX)
!      UNE MOYENNE HORIZONTALE PARTIELLE 
!     POUR CHAQUE DOMAINE INTERNE PRESENT ET CHAQUE CHAMP,
!     EST SOIT RELEVEE (VARIABLE), SOIT CUMULEE (TENDANCE/FLUX)
!      3 OPERATIONS LOGIQUES DISTINCTES SONT RECONNUES
!     1- RELEVE DES VARIABLES INITIALES DANS HDCV0
!     2- RELEVE DES VARIABLES INSTANTANEES DANS HDCV1
!     3- CUMUL DES NOUVELLES TENDANCES DANS HDCV1
!      SUIVANT NSTEP, L UNE OU L AUTRE DE CES OPERATIONS
!      DOIT ETRE FAITE.

!      LA VECTORISATION SE FAIT SELON LE CHAMP. ON NE DISTINGUE PAS
!      SELON LES NIVEAUX
!       LA COHERENCE DANS LES DIMENSIONS EST DONC CRITIQUE !
!       --------------------------------          --------

!     ARGUMENTS D ENTREE
!     ------------------
!      KPROMA : DIMENSION HORIZONTALE
!      KSTART : DEBUT DE LA BOUCLE HORIZONTALE.
!      KPROF  : FIN DE LA BOUCLE HORIZONTALE.
!      KDDHI  : DOMAINE INTERNE AUQUEL APPARTIENT CHAQUE POINT
!      PDHSF  : POIDS HORIZONTAL DE CHAQUE POINT

!      PDHCV  : VALEUR INSTANTANEE DES CHAMPS EN CHAQUE POINT
!               PDHCV (KPROMA,0:NFLEVG,NDHCVSU) ORIGINAL
!       EST ICI PDHCV (KPROMA,NDHCVSU*(NFLEVG+1))
!      PDHCS  : VALEUR INSTANTANEE DES CHAMPS AU SOL

!     ARGUMENTS IMPLICITES
!     --------------------
!       UNITE NULOUT
!       INDICATEURS LOGIQUES, COMMON /YOMLDDH/
!         DANS LE COMDECK * YOMMDDH * POUR LES MASQUES
!       DIMENSIONS PROPRES AUX MASQUES DIAGNOSTIQUES DDH, COMMON /DDHDIM/
!       ET DIMENSIONS POUR LES TABLEAUX DE CUMULS
!         DANS LE COMDECK * YOMTDDH * POUR LES TABLEAUX DE CUMULS
!       POINTEURS PROPRES AUX TABLEAUX DE CUMULS DDH, COMMON /POMTDDH/
!       DECLARATION DES TABLEAUX DE CUMULS
!         NSTEP DANS YOMCT3
!         NSTOP DANS YOMCT0

!     AUTRES ENTREES
!     --------------

!     SORTIES
!     -------
!      MODIFICATION PARTIELLE (MAIS IRREVERSIBLE) DES PLANS
!      DES TABLEAUX DE CUMULS DE /YOMTDDH/

!     ORIGINAL
!     --------
!     91-02-01, Alain Joly.

!     MODIFIED BY
!     -----------
!     MATS HAMRUD / PEDRO VITERBO 1/93
!                REMOVE COMPUTATIONS IN THE BEGINING OF EACH TIMESTEP
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      20-Apr-2004 Remove critical region and opt.
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG
USE YOMMP    , ONLY : MYPROC
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NSTOP
USE YOMCT3   , ONLY : NSTEP
USE YOMLDDH  , ONLY : LHDHKS   ,LHDLIST    ,LFLEXDIA
USE YOMMDDH  , ONLY : NDHCS    ,NDHCV    ,NDHCVSU  ,NDHCSSU  ,&
 & NDHVV    ,NDHFVD   ,NDHVS    ,NDHVFS  ,NDHIDH  
USE YOMTDDH  , ONLY : HDCVB0   ,HDCVB1   ,HDCS0    ,HDCS1
USE OML_MOD, ONLY : OML_MY_THREAD
USE YOMPLDSW , ONLY : LOPT_SCALAR
USE DDH_MIX, ONLY  : NTOTFIELD,NTOTVAR,MK_MASK,LMASKDDH

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDHCVSU 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDDHI(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDHSF(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDHCV(KPROMA,KDHCVSU*(NFLEVG+1)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDHCS(KPROMA,NDHCSSU) 
LOGICAL           ,INTENT(IN)    :: LDDYN 
LOGICAL           ,INTENT(IN)    :: LDPHY 
!     ------------------------------------------------------------------

INTEGER(KIND=JPIM) :: IDHCVD, IDHCVP, IPLEND, IPLEND2, IPLFIL,&
 & IPLSH, IPLSTA, IPLVAR, JCV, JROF ,ITHREAD ,IDDHI
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL :: LLSAME

#include "abor1.intfb.h"

!*    SECURITES DIMENSIONS

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

IF ( NDHCV /= NDHCVSU ) THEN
  WRITE (NULOUT,*) ' ERREUR DDH *** CPCUDDH DIMENSIONS V',NDHCV, NDHCVSU
ENDIF
IF ( LHDHKS .AND. (NDHCS /= NDHCSSU) ) THEN
  WRITE (NULOUT,*) ' ERREUR DDH *** CPCUDDH DIMENSIONS S',NDHCS, NDHCSSU
ENDIF



IF (LFLEXDIA) THEN 

IPLEND=(1+NFLEVG)*NTOTFIELD
IPLVAR=(1+NFLEVG)*(NTOTFIELD-NTOTVAR)



ITHREAD=OML_MY_THREAD()


IF(.NOT.ALLOCATED(LMASKDDH)) CALL MK_MASK

IF ( NSTEP == 1.AND.LDDYN ) THEN
  !variables at initial time
  DO JROF = KSTART, KPROF
    WHERE(LMASKDDH(1:IPLEND))
       HDCVB0(1:IPLEND,KDDHI(JROF),ITHREAD) = HDCVB0(1:IPLEND,KDDHI(JROF),ITHREAD)&
       & + PDHCV(JROF,1:IPLEND)*PDHSF(JROF)  
    ENDWHERE
  ENDDO
ENDIF

 ! var/flux/tendencies at time t
  DO JROF = KSTART, KPROF
    DO JCV = 1, IPLEND
      HDCVB1(JCV,KDDHI(JROF),ITHREAD) = HDCVB1(JCV,KDDHI(JROF),ITHREAD)&
       & + PDHCV(JROF,JCV)*PDHSF(JROF)
    ENDDO
  ENDDO



ELSE 
!*
!     ------------------------------------------------------------------
!     0.- POINTEURS DE SEPARATION VARIABLES/TENDANCES-FLUX
!       DERNIER MOT CONTENANT UNE VARIABLE VERTICALE
IPLVAR = NDHVV*(NFLEVG+1)
!       DERNIER MOT CONTENANT UN CHAMP
IPLFIL = NDHCV*(NFLEVG+1)

IDHCVD = (NDHVV + NDHFVD)*(NFLEVG+1)
IDHCVP = IPLFIL - IDHCVD

IF (LDDYN.AND.LDPHY) THEN
  IPLSTA=1
  IF(NSTEP == NSTOP) THEN
    IPLEND=IPLVAR
  ELSE
    IPLEND=IPLFIL
  ENDIF
  IPLSH =0
ELSEIF(LDDYN) THEN
  IPLSTA=1
  IF(NSTEP == NSTOP) THEN
    IPLEND=IPLVAR
  ELSE
    IPLEND=IDHCVD
  ENDIF
  IPLSH =0
ELSEIF(LDPHY) THEN
  IPLSTA=IDHCVD+1
  IPLEND=IPLFIL
  IPLSH =IDHCVD
ELSE
  IPLSTA=IDHCVD+1
  IPLEND=IPLFIL
  IPLSH =IDHCVD
ENDIF

IF(NSTEP == NSTOP) THEN
  IPLEND2=NDHVS+NDHVFS
ELSE
  IPLEND2=NDHCS
ENDIF

ITHREAD=OML_MY_THREAD()
IF ( LHDLIST ) THEN
  WRITE (NULOUT,*) ' DDH * CPCU IPLVAR = ',IPLVAR,&
   & ' IPLFIL = ',IPLFIL,&
   & ' NSTEP = ',NSTEP,' NSTOP = ',NSTOP  
  WRITE (NULOUT,*) ' IPLSTA = ',IPLSTA,' IPLEND = ',IPLEND,&
   & ' IPLSH  = ',IPLSH,' LDDYN =',LDDYN,' LDPHY =',LDPHY  
ENDIF

IF(LOPT_SCALAR) THEN
  LLSAME=.TRUE.
  IDDHI=KDDHI(KSTART)
  DO JROF = KSTART+1, KPROF
    IF(IDDHI /= KDDHI(JROF)) THEN
      LLSAME=.FALSE.
    ENDIF
  ENDDO
ENDIF

!*
!     ------------------------------------------------------------------
!     1.- MOYENNES HORIZONTALES DES VARIABLES INITIALES
!       SI NSTEP = 0 SEULEMENT

IF ( NSTEP == 0.AND.LDDYN ) THEN
  DO JROF = KSTART, KPROF
    DO JCV = 1, IPLVAR
      HDCVB0(JCV,KDDHI(JROF),ITHREAD) = HDCVB0(JCV,KDDHI(JROF),ITHREAD)&
       & + PDHCV(JROF,JCV)*PDHSF(JROF)  
    ENDDO
  ENDDO
ENDIF

IF ( NSTEP == 0.AND.LDPHY ) THEN
  DO JROF = KSTART, KPROF
    if(KDDHI(JROF) < 1 .OR. KDDHI(JROF) > NDHIDH) THEN
      WRITE(NULOUT,'(A,8I8)')' CPCUDDH ERROR ',MYPROC,KDDHI(JROF),JROF,NDHIDH
      CALL ABOR1('CPCUDDH ERROR')
    ENDIF
  ENDDO
  DO JROF = KSTART, KPROF
    DO JCV = 1, NDHVS+NDHVFS
      HDCS0(JCV,KDDHI(JROF),ITHREAD) = HDCS0(JCV,KDDHI(JROF),ITHREAD)&
       & + PDHCS(JROF,JCV)*PDHSF(JROF)  
    ENDDO
  ENDDO
ENDIF
!*
!     ------------------------------------------------------------------
!     4.- CUMUL DES FLUX/TENDANCES

IF (LOPT_SCALAR) THEN
  IF(LLSAME) THEN
    DO JCV = IPLSTA, IPLEND
      DO JROF = KSTART, KPROF
        HDCVB1(JCV,IDDHI,ITHREAD) = HDCVB1(JCV,IDDHI,ITHREAD)&
         & + PDHCV(JROF,JCV-IPLSH)*PDHSF(JROF)
      ENDDO
    ENDDO
  ELSE
    DO JCV = IPLSTA, IPLEND
      DO JROF = KSTART, KPROF
        IF(PDHCV(JROF,JCV-IPLSH) /= 0.0_JPRB) THEN
          HDCVB1(JCV,KDDHI(JROF),ITHREAD) = HDCVB1(JCV,KDDHI(JROF),ITHREAD)&
           & + PDHCV(JROF,JCV-IPLSH)*PDHSF(JROF)  
        ENDIF
      ENDDO
    ENDDO
  ENDIF
  
  IF(LDPHY) THEN
    IF (LLSAME) THEN
      DO JCV = 1, IPLEND2
        DO JROF = KSTART, KPROF
          HDCS1(JCV,IDDHI,ITHREAD) = HDCS1(JCV,IDDHI,ITHREAD)&
           & + PDHCS(JROF,JCV)*PDHSF(JROF)
        ENDDO
      ENDDO
    ELSE
      DO JCV = 1, IPLEND2
        DO JROF = KSTART, KPROF
          IF(PDHCS(JROF,JCV) /= 0.0_JPRB) THEN
            HDCS1(JCV,KDDHI(JROF),ITHREAD) = HDCS1(JCV,KDDHI(JROF),ITHREAD)&
             & + PDHCS(JROF,JCV)*PDHSF(JROF) 
          ENDIF
        ENDDO
      ENDDO
    ENDIF
  ENDIF
ELSE
  DO JROF = KSTART, KPROF
    DO JCV = IPLSTA, IPLEND
      HDCVB1(JCV,KDDHI(JROF),ITHREAD) = HDCVB1(JCV,KDDHI(JROF),ITHREAD)&
       & + PDHCV(JROF,JCV-IPLSH)*PDHSF(JROF)
    ENDDO
  ENDDO

  IF(LDPHY) THEN
    DO JROF = KSTART, KPROF
      DO JCV = 1, IPLEND2
        HDCS1(JCV,KDDHI(JROF),ITHREAD) = HDCS1(JCV,KDDHI(JROF),ITHREAD)&
         & + PDHCS(JROF,JCV)*PDHSF(JROF)
      ENDDO
    ENDDO
  ENDIF
ENDIF


ENDIF 
!     ------------------------------------------------------------------

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