SUBROUTINE GPCTYTL(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)  

!**** *GPCTYTL* - Computes vertical velocities, tangent linear

!     Purpose.
!     --------
!           COMPUTES VERTICAL VELOCITIES,TANGENT LINEAR

!**   Interface.
!     ----------
!        *CALL* *GPCTYTL(...

!        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-11 . Vertical finite elements
!        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(IN)    :: PU(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PD(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRTGR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEVEL(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVVEL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDIV(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIVDP(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: 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 "verint.intfb.h"

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

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

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

!*      5.     COMPUTES V.GRAD(PS).TRAJECTORY
!              --------------------

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

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

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

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

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

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

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

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

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

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

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

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

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

