SUBROUTINE GPCTYAD(KPROMA,KSTART,KPROF,KFLEV,PVDELB,PVBH,&
 & PU,PV,PD,&
 & PDELP,PRDELP,PLNPR,PALPH,PRTGR,PSPL,PSPM,&
 & PEVEL,PVVEL,PSDIV,PDIVDP,PRPREF,&
 & PU5,PV5,PD5,&
 & PDELP5,PRDELP5,PLNPR5,PALPH5,PRTGR5,PSPL5,PSPM5,&
 & PSDIV5,PRPREF5)  

!**** *GPCTYAD* - Computes vertical velocities, adjoint

!     Purpose.
!     --------
!           COMPUTES VERTICAL VELOCITIES,ADJOINT

!**   Interface.
!     ----------
!        *CALL* *GPCTYAD(...

!        Explicit arguments :
!        --------------------
!     KPROMA                 : DIMENSIONING
!     KSTART                 : START OF THE PACKET
!     KPROF                  : DEPTH OF WORK
!     KFLEV                  : VERT. DIMENSIONING
!     PVDELB(KFLEV)          : RELATED TO VERT. COORDINATE
!     PVBH  (0:KFLEV)        :  "     "      "     "    "
!     PU(KPROMA,KFLEV)     :  CONTRAVARIANT U COMPONENT OF THE WIND
!     PV(KPROMA,KFLEV)     :  CONTRAVARIANT V COMPONENT OF THE WIND
!     PD(KPROMA,KFLEV)     :  DIVERGENCE OF THE WIND
!     PDELP(KPROMA,KFLEV)   :  PRESSURE DIFFERENCE ACROSS LAYERS
!     PRDELP(KPROMA,KFLEV)  :  THEIR INVERSE
!     PLNPR(KPROMA,KFLEV)   :  LOG OF RATIO OF PRESSURE
!     PALPH(KPROMA,KFLEV)   :  FOR HYDROSTATICS
!     PRTGR(KPROMA,KFLEV)   :  FOR PRES. GRAD. TERM AND ENE. CONV.
!     PSPL(KPROMA)          :  COVARIANT E-O DERIVATIVE
!     PSPM(KPROMA)          :  COVARIANT N-S DERIVATIVE
!     PEVEL(KPROMA,0:KFLEV) :  ETADOT DP/DETA
!     PVVEL(KPROMA,KFLEV)   :  (W/P)
!     PSDIV(KPROMA,0:KFLEV) :  SUM OF DIVERGENCE
!     PDIVDP(KPROMA, KFLEV) :  DIVERGENCE (V x DELTA P)
!     PRPREF(KPROMA,KFLEV)  :  INVERSE OF FULL LEVEL PRESSURE

!        Implicit arguments :   None.
!        --------------------

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

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

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

!     Author.
!     -------
!        Jean-Noel THEPAUT METEO FRANCE/EERM/CRMD

!     Modifications.
!     --------------
!        Original : 89-12-12
!        J.N Thepaut: 92-04-08 . loop indexes (IO scheme)
!        A. Untch: 2000-12 . Vertical finite element scheme
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMCVER  , ONLY : LVERTFE
USE YOMGEM   , ONLY : VBF,  VFE_RDETAH

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVDELB(KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVBH(0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PV(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PD(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDELP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRDELP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLNPR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PALPH(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRTGR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEVEL(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVVEL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSDIV(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDIVDP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRPREF(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PD5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRTGR5(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPL5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPM5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSDIV5(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPREF5(KPROMA,KFLEV) 

!     ------------------------------------------------------------------
!          ZVP(KPROMA,KFLEV)     : V.GRAD(PS)
REAL(KIND=JPRB) :: ZVP(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZVP5(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZSDIV(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZPSDIV(KPROMA,KFLEV+1)

INTEGER(KIND=JPIM) :: JLEV, JROF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "verintad.intfb.h"

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

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

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

!*      5.     COMPUTES V.GRAD(PS).TRAJECTORY
!              AND INITIALIZES LOCAL ARRAYS
!              ------------------------------

DO JLEV=1,KFLEV
  DO JROF=KSTART,KPROF
    ZVP (JROF,JLEV)= 0.0_JPRB
    ZVP5(JROF,JLEV)= PU5(JROF,JLEV)*PSPL5(JROF)+PV5(JROF,JLEV)*PSPM5(JROF)
  ENDDO
ENDDO
!     ------------------------------------------------------------------

!*       4.    W/P.
!              ----
IF(LVERTFE) THEN
  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      PRPREF(JROF,JLEV)=PRPREF(JROF,JLEV)&
       & +(-PSDIV5(JROF,JLEV)+VBF(JLEV)*ZVP5(JROF,JLEV))*PVVEL(JROF,JLEV)  
      ZVP(JROF,JLEV)=ZVP(JROF,JLEV)&
       & +VBF(JLEV)*PRPREF5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PSDIV(JROF,JLEV)=PSDIV(JROF,JLEV)&
       & -PRPREF5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PVVEL (JROF,JLEV  )= 0.0_JPRB
    ENDDO
  ENDDO
ELSE
  DO JLEV=KFLEV,1,-1
    DO JROF=KSTART,KPROF
      PALPH (JROF,JLEV  )= PALPH(JROF,JLEV)-PD5(JROF,JLEV)*PVVEL(JROF,JLEV)
      PD    (JROF,JLEV  )= PD(JROF,JLEV)-PALPH5(JROF,JLEV)*PVVEL(JROF,JLEV)
      PRDELP(JROF,JLEV  )= PRDELP(JROF,JLEV)-PVDELB(JLEV)*&
       & PALPH5(JROF,JLEV)*ZVP5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PALPH (JROF,JLEV  )= PALPH(JROF,JLEV)-PVDELB(JLEV)*&
       & PRDELP5(JROF,JLEV)*ZVP5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      ZVP   (JROF,JLEV  )= ZVP(JROF,JLEV)-PVDELB(JLEV)*&
       & PRDELP5(JROF,JLEV)*PALPH5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PRDELP(JROF,JLEV  )= PRDELP(JROF,JLEV)-PSDIV5(JROF,JLEV-1)*&
       & PLNPR5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PSDIV (JROF,JLEV-1)= PSDIV(JROF,JLEV-1)-PRDELP5(JROF,JLEV)*&
       & PLNPR5(JROF,JLEV)*PVVEL(JROF,JLEV)  
      PLNPR (JROF,JLEV  )= PLNPR(JROF,JLEV)-PRDELP5(JROF,JLEV)*&
       & PSDIV5(JROF,JLEV-1)*PVVEL(JROF,JLEV)  
      ZVP   (JROF,JLEV  )= ZVP(JROF,JLEV)+PRTGR5(JROF,JLEV)*PVVEL(JROF,JLEV)
      PRTGR (JROF,JLEV  )= PRTGR(JROF,JLEV)+ZVP5(JROF,JLEV)*PVVEL(JROF,JLEV)
      PVVEL (JROF,JLEV  )= 0.0_JPRB
    ENDDO
  ENDDO
ENDIF

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

!*       3.    ETADOT DP/DETA.
!              ---------------

DO JROF=KSTART,KPROF
  PEVEL(JROF,0    )= 0.0_JPRB
  IF(.NOT.LVERTFE)  PEVEL(JROF,KFLEV)= 0.0_JPRB
ENDDO

IF(LVERTFE) ZPSDIV(KSTART:KPROF,:)= 0.0_JPRB
IF(LVERTFE) THEN
  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      PSDIV(JROF,JLEV)= PSDIV(JROF,JLEV)-PEVEL(JROF,JLEV)
      ZPSDIV(JROF,KFLEV+1)= ZPSDIV(JROF,KFLEV+1)&
       & +VBF(JLEV)*PEVEL(JROF,JLEV)  
      PEVEL(JROF,JLEV )= 0.0_JPRB
    ENDDO
  ENDDO
ELSE
  DO JLEV=1,KFLEV-1
    DO JROF=KSTART,KPROF
      PSDIV(JROF,KFLEV)= PSDIV(JROF,KFLEV)+PVBH(JLEV)*PEVEL(JROF,JLEV)
      PSDIV(JROF,JLEV )= PSDIV(JROF,JLEV)-PEVEL(JROF,JLEV)
      PEVEL(JROF,JLEV )= 0.0_JPRB
    ENDDO
  ENDDO
ENDIF
!     ------------------------------------------------------------------

!*       2.    SUM DIVERGENCE.
!              ---------------

IF(LVERTFE) THEN
  DO JLEV=1,KFLEV
    ZPSDIV(KSTART:KPROF,JLEV)=PSDIV(KSTART:KPROF,JLEV)
    PSDIV (KSTART:KPROF,JLEV)=0.0_JPRB
  ENDDO
  CALL VERINTAD(KPROMA,KSTART,KPROF,KFLEV,ZSDIV,ZPSDIV,0)
  DO JLEV=1,KFLEV
    DO JROF=KSTART,KPROF
      PDIVDP(JROF,JLEV)=PDIVDP(JROF,JLEV)&
       & +ZSDIV(JROF,JLEV)*VFE_RDETAH(JLEV)  
    ENDDO
  ENDDO
ELSE
  DO JLEV=KFLEV,1,-1
    DO JROF=KSTART,KPROF
      PSDIV (JROF,JLEV-1)= PSDIV(JROF,JLEV-1)+PSDIV (JROF,JLEV)
      PDIVDP(JROF,JLEV  )= PDIVDP(JROF,JLEV)+PSDIV(JROF,JLEV)
      PSDIV (JROF,JLEV  )= 0.0_JPRB
    ENDDO
  ENDDO
ENDIF

DO JROF=KSTART,KPROF
  PSDIV (JROF,0     )= 0.0_JPRB
ENDDO

DO JLEV=1,KFLEV
  DO JROF=KSTART,KPROF
    ZVP   (JROF,JLEV  )= ZVP(JROF,JLEV)+PVDELB(JLEV)*PDIVDP(JROF,JLEV)
    PDELP (JROF,JLEV  )= PDELP(JROF,JLEV)+PD5(JROF,JLEV)*PDIVDP(JROF,JLEV)
    PD    (JROF,JLEV  )= PD(JROF,JLEV)+PDELP5(JROF,JLEV)*PDIVDP(JROF,JLEV)
    PDIVDP(JROF,JLEV  )= 0.0_JPRB
  ENDDO
ENDDO

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

!*      1.    COMPUTES V.GRAD(PS).
!              --------------------

DO JLEV=1,KFLEV
  DO JROF=KSTART,KPROF
    PSPM(JROF)     = PSPM(JROF)+PV5(JROF,JLEV)*ZVP(JROF,JLEV)
    PV  (JROF,JLEV)= PV(JROF,JLEV)+PSPM5(JROF)*ZVP(JROF,JLEV)
    PSPL(JROF)     = PSPL(JROF)+PU5(JROF,JLEV)*ZVP(JROF,JLEV)
    PU  (JROF,JLEV)= PU(JROF,JLEV)+PSPL5(JROF)*ZVP(JROF,JLEV)
    ZVP (JROF,JLEV)= 0.0_JPRB
  ENDDO
ENDDO
!     ------------------------------------------------------------------

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

