SUBROUTINE PPSYDH (KDOM,KTRDDH,KTX,PDHSFD, &
& PDDHCV,PDDHCV_TOT,KDIMDOM,PDDHCS,PDDHCS_TOT,KTID,KMASK)
!****
!     ------------------------------------------------------------------

!     SYNTHESE DES MOYENNES INTERNES POUR UN DOMAINE UTILISATEUR
!     DIAGNOSTICS PAR DOMAINES HORIZONTAUX
!     ------------------------------------

!       -------------------------------------------------------
!     BUT
!     ---
!      CONSTITUER UN TABLEAU EN VUE DE SORTIES EN REGROUPANT
!     LES MOYENNES HORIZONTALES SUR DES DOMAINES INTERNES
!     ET PAR PROCESSEUR EN UN ENSEMBLE UNIQUE POUR UNE
!     SUITE DONNEE DE DOMAINES INTERNES DEFINISSANT UN DOMAINE
!     TYPE UTILISATEUR

!      LA STRUCTURE DE CE TABLEAU EST LEGEREMENT DIFFERENTE DE
!     CELLE DU TABLEAU DE CUMUL. ON TROUVE
!      DE 1 A NDHVV : VARIABLES A L'INSTANT INITIAL
!      DE NDHVV+1 A NDHCV : TENDANCES ET FLUX CUMULES DE 0 A NSTEP
!      DE NDHCV+1 A NDHCV+NDHVV : VARIABLES A L'INSTANT COURANT

!     ARGUMENTS D ENTREE
!     ------------------
!      KTRDDH (KTX) : SUITE DES DOMAINES INTERNES DEFINISSANT LE DOMAINE
!                     DEMANDE
!      KTX : NB DE DOMAINES INTERNES IMPLIQUES
!      KDOM : NUMERO DU DOMAINE COURANT
!      KDIMDOM : NOMBRE DE DOMAINES
!      PDHSFD : SURFACE OU POIDS DU DOMAINE DEMANDE

!     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
!       RG : GRAVITE
!       NSTEP : NUMERO DU PAS DE TEMPS
!       TSTEP : PAS DE TEMPS NOMINAL

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

!     SORTIES
!     -------
!      PDDHCV (0:NFLEVG,NDHCV+NDHVV) : TABLEAU DE SORTIE, PROFILS
!            CE TABLEAU EST TRAITE EN UNE DIMENSION
!      PDDHCS (NDHVS+NDHCS) : TABLEAU DE SORTIE, SOL

!     ECRIT PAR
!     --------- ALAIN JOLY

!     6/2/91
!        R. El Khatib : 01-08-07 Pruning options
!        S. Serrar :    07-09-2006 initial values for FS variables saved in
!                      PDDHFSVI (ZBUFFER dimension changed in dresddh) 
!   2006-08-22, J.M. Piriou: write DDH on LFA files: new arrays PDDHCV_TOT and PDDHCS_TOT.
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVG
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCST   , ONLY : RG
USE YOMDYN   , ONLY : TSTEP
USE YOMCT3   , ONLY : NSTEP
USE YOMMP    , ONLY : MYPROC
USE YOMLDDH  , ONLY : LHDLIST, LFLEXDIA
USE YOMMDDH  , ONLY : NDHCS    ,NDHCV    ,NDHCVSU  ,&
 & NDHCSSU  ,NDHVV    ,NDHVS    ,NDHVFS  
USE YOMTDDH  , ONLY : HDCVB0   ,HDCVB1   ,HDCS0    ,HDCS1 ,PDDHFSVI
USE OML_MOD, ONLY : OML_MAX_THREADS
USE DDH_MIX, ONLY : NTOTFIELD,NTOTVAR,LMASKDDH
IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTID, KDIMDOM, KMASK
INTEGER(KIND=JPIM),INTENT(IN)    :: KTX, KDOM
INTEGER(KIND=JPIM),INTENT(IN)    :: KTRDDH(KTX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDHSFD 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDDHCV((NFLEVG+1)*(NDHCVSU+NDHVV)) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDDHCS(NDHCSSU+NDHVS)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDDHCV_TOT((NFLEVG+1)*KDIMDOM*(NDHCVSU+NDHVV))
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDDHCS_TOT(KDIMDOM*(NDHCSSU+NDHVS))
!     ------------------------------------------------------------------
REAL(KIND=JPRB) :: ZBUFFER((NFLEVG+1)*(NDHCVSU+NDHVV)+NDHCSSU+NDHVS+NDHVFS+1)
REAL(KIND=JPRB) :: ZDDHCSI(NDHCSSU+NDHVS+NDHVFS) 
INTEGER(KIND=JPIM) :: IOFF, IPLFIL, IPLFIS, IPLVAR0, IPLVAR1, IPLVAS0,&
 & IPLVAS1, J, JCS, JCV, JDHI, ITHRMAX, JTHREAD, JLEV

REAL(KIND=JPRB) :: ZDHSFD, ZDTUSF, ZUSFC, ZUSFCG
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: IPLVAR,IPLEND 

#include "abor1.intfb.h"
#include "dresddh.intfb.h"

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

CALL GSTATS(1912,0)

IF ( LHDLIST ) THEN
  WRITE (NULOUT,*) ' '
  WRITE (NULOUT,*) ' DDH * PPSYDH - SYNTHESE '
  WRITE (NULOUT,*) ' DDH * LE DOMAINE EST LA SUITE ',&
   & (KTRDDH(JDHI),JDHI=1,KTX)  
  WRITE (NULOUT,*) ' KTX = ',KTX,' POIDS = ',PDHSFD
  WRITE (NULOUT,*) ' RG = ', RG,' NSTEP*TSTEP = ',&
   & NSTEP*TSTEP,' EN HEURES : ',NSTEP*TSTEP/3600._JPRB  
ENDIF
!*
!     ------------------------------------------------------------------
!     1.- INITIALISATION
!     POINTEUR DERNIERE VARIABLE INITIALE
IPLVAR0 = NDHVV*(NFLEVG+1)
!     POINTEUR DERNIER FLUX
IPLFIL = NDHCV*(NFLEVG+1)
!     POINTEUR DERNIERE VARIABLE ACTUELLE
IPLVAR1 = (NDHCV+NDHVV)*(NFLEVG+1)
!     POINTEUR DERNIERE VARIABLE INITIALE SOL
IPLVAS0 = NDHVS
!     POINTER LAST FREE-STYLE FLUX
IPLFIS = NDHCS
!     POINTEUR DERNIERE VARIABLE ACTUELLE SOL
IPLVAS1 = NDHCS+NDHVS

ITHRMAX=OML_MAX_THREADS()

IF ( LHDLIST ) THEN
  WRITE (NULOUT,*) ' PPSY DDH * IPLVAR0 = ',IPLVAR0,&
   & ' IPLFIL = ',IPLFIL,' IPLVAR1= ',IPLVAR1  
  WRITE (NULOUT,*) ' IPLVAS0= ',IPLVAS0,&
   & ' IPLFIS= ',IPLFIS,' IPLVAS1= ',IPLVAS1  
ENDIF

IF (LFLEXDIA) IPLVAR1=(NTOTFIELD+NTOTVAR)*(NFLEVG+1)

DO JCV = 1, IPLVAR1
  PDDHCV(JCV) = 0.0_JPRB
ENDDO

IF(.NOT.ALLOCATED(PDDHFSVI)) ALLOCATE(PDDHFSVI(NDHVFS))

ZDDHCSI(:) = 0.0_JPRB
PDDHCS(:)  = 0.0_JPRB


IF(LFLEXDIA) THEN
  IPLVAR=(1+NFLEVG)*(NTOTFIELD+NTOTVAR)
  IPLEND=NTOTFIELD*(NFLEVG+1)


  DO JTHREAD=1,ITHRMAX
    DO JDHI = 1, KTX
       WHERE(LMASKDDH(1:IPLEND)) 
         !var at time t 
         PDDHCV(1:IPLEND)=PDDHCV(1:IPLEND)+HDCVB1(1:IPLEND,KTRDDH(JDHI),JTHREAD)
       ELSEWHERE
         ! fluxes/tendencies
         PDDHCV(1:IPLEND)=PDDHCV(1:IPLEND)+HDCVB0(1:IPLEND,KTRDDH(JDHI),JTHREAD)
       ENDWHERE
       ! variables at t=0
       PDDHCV(IPLEND+1:IPLVAR)=PDDHCV(IPLEND+1:IPLVAR)+&
     & PACK(HDCVB0(1:IPLEND,KTRDDH(JDHI),JTHREAD),MASK=LMASKDDH(1:IPLEND))
    ENDDO
  ENDDO



ELSE


  !*
  !     ------------------------------------------------------------------
  !     2.- SYNTHESE DES VARIABLES INITIALES ET DES FLUX/TENDANCES
  !     CUMULES DE 0 A NSTEP

  DO JTHREAD=1,ITHRMAX
    DO JDHI = 1, KTX
      DO JCV = 1, IPLFIL
        PDDHCV(JCV) = PDDHCV(JCV) +HDCVB0(JCV,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO

    DO JDHI = 1, KTX
      DO JCS = 1, NDHVS
        ZDDHCSI(JCS) = ZDDHCSI(JCS) +HDCS0(JCS,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO

    DO JDHI = 1, KTX
      DO JCS = NDHVS+NDHVFS+1, IPLFIS
        ZDDHCSI(JCS) = ZDDHCSI(JCS) +HDCS0(JCS,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO

  ! beware, the free-style variables are currently switched around in the ZDDHCSI array
    DO JDHI = 1, KTX
      DO JCS = NDHCS+NDHVS+1, NDHCS+NDHVS+NDHVFS
        ZDDHCSI(JCS) = ZDDHCSI(JCS) +HDCS0(JCS-NDHCS,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO

  !*
  !     ------------------------------------------------------------------
  !     3.- SYNTHESE DES VARIABLES INSTANTANEES

    DO JDHI = 1, KTX
      DO JCV = 1, IPLVAR0
        PDDHCV(IPLFIL+JCV) = PDDHCV(IPLFIL+JCV) +HDCVB1(JCV,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO
    
    DO JDHI = 1, KTX
      DO JCS = 1, IPLVAS0
        ZDDHCSI(IPLFIS+JCS) = ZDDHCSI(IPLFIS+JCS) +HDCS1(JCS,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO
    
    DO JDHI = 1, KTX
      DO JCS = NDHVS+1, NDHVS+NDHVFS
        ZDDHCSI(JCS) = ZDDHCSI(JCS) + HDCS1(JCS,KTRDDH(JDHI),JTHREAD)
      ENDDO
    ENDDO

  ENDDO


ENDIF 
!*
!     ------------------------------------------------------------------
!fw
!fw       Normalisation has to be moved up into posddh
!fw       or seperate routine called by posddh since only
!fw       performed by master (if lmessp=.true.)
!fw

IOFF=0
DO J=1,(NFLEVG+1)*(NDHCVSU+NDHVV)
  ZBUFFER(J)=PDDHCV(J)
ENDDO
IOFF=(NFLEVG+1)*(NDHCVSU+NDHVV)
DO J=1,NDHCSSU+NDHVS+NDHVFS
  ZBUFFER(IOFF+J)=ZDDHCSI (J)
ENDDO
IOFF=IOFF+NDHCSSU+NDHVS+NDHVFS
ZBUFFER(IOFF+1)=PDHSFD

CALL GSTATS(1912,2)

CALL DRESDDH(ZBUFFER,KTID,KMASK)

CALL GSTATS(1912,3)

IF(MYPROC == 1) THEN
  IOFF=0
  DO J=1,(NFLEVG+1)*(NDHCVSU+NDHVV)
    PDDHCV(J)=ZBUFFER(J)
  ENDDO
  IOFF=(NFLEVG+1)*(NDHCVSU+NDHVV)
  DO J=1,NDHCSSU+NDHVS+NDHVFS
    ZDDHCSI (J)=ZBUFFER(IOFF+J)
  ENDDO
  IOFF=IOFF+NDHCSSU+NDHVS+NDHVFS
  ZDHSFD=ZBUFFER(IOFF+1)
ENDIF





!     4.- NORMALISATIONS
!         TOUTES LES INTEGRALES SPATIALES SONT RAMENEES A
!         LA SURFACE DU DOMAINE UTILISATEUR
!         LES VARIABLES SONT RAMENEES AU KG/M**2
!         LES TENDANCES ET LES FLUX SONT MULTIPLIES PAR
!                       -----------
!         LA DUREE D INTEGRATION TEMPORELLE

IF(MYPROC == 1) THEN
  IF(ZDHSFD > 0) THEN
    ZUSFCG = 1.0_JPRB/( ZDHSFD*RG )
    ZUSFC = 1.0_JPRB/ZDHSFD
    ZDTUSF = TSTEP/ZDHSFD

!     ALTITUDE, TABLEAU LOCAL A UN DOMAINE

   IF (LFLEXDIA) THEN 


     IPLVAR1=(NTOTFIELD+NTOTVAR)*(NFLEVG+1)
     IPLFIL=NTOTFIELD*(NFLEVG+1)

     WHERE (LMASKDDH(1:IPLVAR1))
       PDDHCV(1:IPLVAR1)=PDDHCV(1:IPLVAR1)*ZUSFCG ! variables at time t and 0h
     ELSEWHERE
       PDDHCV(1:IPLVAR1)=PDDHCV(1:IPLVAR1)*ZDTUSF ! fluxes and tendencies
     ENDWHERE  
     DO JCV=1,NTOTFIELD+NTOTVAR 
       DO JLEV=1,NFLEVG+1
         PDDHCV_TOT(JLEV+(NFLEVG+1)*(KDOM-1)+(NFLEVG+1)*KDIMDOM*(JCV-1))=PDDHCV(JLEV+(NFLEVG+1)*(JCV-1))
       ENDDO
     ENDDO

   ELSE 
     DO JCV = 1, IPLVAR0
       PDDHCV(JCV) = PDDHCV(JCV)*ZUSFCG
     ENDDO
     DO JCV = IPLVAR0+1, IPLFIL
       PDDHCV(JCV) = PDDHCV(JCV)*ZDTUSF
     ENDDO
     DO JCV = IPLFIL+1, IPLVAR1
       PDDHCV(JCV) = PDDHCV(JCV)*ZUSFCG
     ENDDO
 !     ALTITUDE, TABLEAU CONTENANT TOUS LES DOMAINES
     DO JCV=1,NDHVV
       DO JLEV=1,NFLEVG
         PDDHCV_TOT(JLEV+NFLEVG*(KDOM-1)+(NFLEVG+1)*KDIMDOM*(JCV-1))=PDDHCV(JLEV+1+(NFLEVG+1)*(JCV-1))
       ENDDO
     ENDDO
     DO JCV=NDHVV+1,NDHCV
       DO JLEV=1,NFLEVG+1
         PDDHCV_TOT(JLEV+(NFLEVG+1)*(KDOM-1)+(NFLEVG+1)*KDIMDOM*(JCV-1))=PDDHCV(JLEV+(NFLEVG+1)*(JCV-1))
       ENDDO
     ENDDO
     DO JCV=NDHCV+1,NDHCV+NDHVV
       DO JLEV=1,NFLEVG
         PDDHCV_TOT(JLEV+NFLEVG*(KDOM-1)+(NFLEVG+1)*KDIMDOM*(JCV-1))=PDDHCV(JLEV+1+(NFLEVG+1)*(JCV-1))
       ENDDO
     ENDDO


   ENDIF 



!     SURFACE, TABLEAU LOCAL A UN DOMAINE
    DO JCS = 1, NDHVS+NDHVFS
      ZDDHCSI(JCS) = ZDDHCSI(JCS)*ZUSFC
    ENDDO
    DO JCS = NDHVS+NDHVFS+1, IPLFIS
      ZDDHCSI(JCS) = ZDDHCSI(JCS)*ZDTUSF
    ENDDO
    DO JCS = IPLFIS+1, IPLVAS1
      ZDDHCSI(JCS) = ZDDHCSI(JCS)*ZUSFC
    ENDDO
    DO JCS = IPLVAS1+1,IPLVAS1+NDHVFS
      ZDDHCSI(JCS) = ZDDHCSI(JCS)*ZUSFC
    ENDDO

! pay : ZDDHCSI LOCAL VARIABLE, OUTPUT ARRAY PDDHCS HAS 
!       UNCHAGED DIMENSION

    DO JCS = 1 , NDHCSSU+NDHVS
      PDDHCS(JCS) = ZDDHCSI(JCS)
    ENDDO

    DO JCS = 1 , NDHVFS
      PDDHFSVI(JCS) = ZDDHCSI(NDHCSSU+NDHVS+JCS)
    ENDDO 
!     SURFACE, TABLEAU CONTENANT TOUS LES DOMAINES
    DO JCS = 1, IPLVAS1
      PDDHCS_TOT(KDOM+KDIMDOM*(JCS-1))=PDDHCS(JCS)
    ENDDO

    IF ( LHDLIST ) THEN
      WRITE (NULOUT,*) ' DDH * PPSY FINI '
    ENDIF
  ELSE
    WRITE(NULERR,*) ' ERROR PPSYDHZ ZDHSFD<=0 ',ZDHSFD
    WRITE(NULERR,*) ' KTID=',KTID,' KMASK=',KMASK
    CALL ABOR1('PPSYDH:ZDHSFD<=0')
  ENDIF
ENDIF

CALL GSTATS(1912,1)

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