SUBROUTINE GPRCPTL(KPROMA,KSTART,KPROF,KFLEV,PQ,PQI,PQL,PQR,PQS,PQG,PCP,&
 & PR,PKAP,PCP5,PR5,PGFL,KGFLTYP)  

!**** *GPRCPTL* - Computes Cp, R and R/Cp from Q, tangent linear

!     Purpose.
!     --------
!           COMPUTES CP AND R  AND R/CP FROM Q

!**   Interface.
!     ----------
!        *CALL* *GPRCPTL(...)*

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

!        INPUT:
!          KPROMA               - dimensioning.
!          KSTART               - start of work.
!          KPROF                - depth of work.
!          KFLEV                - number of layers.
!          PQ(KPROMA,KFLEV)     - specific humidity.
!          PQI(KPROMA,KFLEV)    - ice.
!          PQL(KPROMA,KFLEV)    - liquid water.
!          PQR(KPROMA,KFLEV)    - rain.
!          PQS(KPROMA,KFLEV)    - snow.
!          PQG(KPROMA,KFLEV)    - graupel.

!        OUTPUT:
!          PCP(KPROMA,KFLEV)    - CP
!          PR(KPROMA,KFLEV)     - R
!          PKAP(KPROMA,KFLEV)   - KAPPA

!        INPUT (trajectory):
!          PCP5(KPROMA,KFLEV)   - CP (trajectory)
!          PR5(KPROMA,KFLEV)    - R (trajectory)

!        Implicit arguments :  Physical constants from YOMCST
!        --------------------

!     Method.
!     -------
!        See documentation
!        NOTE! This is NOT an strict linearization of the corresponding
!        non-linear routine, some q-related terms have been supressed

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

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

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 88-02-04
!        J.N Thepaut: 92-04-08 . loop indexes (IO scheme)
!        E.Bazile : 94-05-19 : Liquid Water and Ice.
!        Y.Seity : 04-02-18 : add rain, graupel and snow 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        L.Isaksen     15-Jun-2005 Supress R dep. on q variables
!        M.Hamrud      15-Jan-2006  Revised GPRCP
!        Y.Bouteloup   06-04-2006 Re-introduction of R dep. on q variables under key
!        M.Jidane      08-04-2006 CY31 Phasing
!     ------------------------------------------------------------------

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

USE YOMCST    ,ONLY : RD,RV,RCPD, RCPV, RCW, RCS
USE YOM_YGFL  ,ONLY : YGFL, YGFLC, YQ, YL, YI, YR, YS, YG
USE YOMDYN    ,ONLY : LDRY_ECMWF

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

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),OPTIONAL   ,INTENT(IN)    :: PQ(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PQI(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PQL(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PQR(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PQS(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PQG(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(OUT)   :: PCP(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PGFL(KPROMA,KFLEV,YGFL%NDIM) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(OUT)   :: PR(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(OUT)   :: PKAP(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PCP5(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(IN)    :: PR5(KPROMA,KFLEV) 
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)    :: KGFLTYP

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

INTEGER(KIND=JPIM) :: JLEV, JLON, JGFL
INTEGER(KIND=JPIM) :: IACT(YGFL%NUMFLDS),IPT(YGFL%NUMFLDS),INUMACT,IGFL,IGFLTYP
LOGICAL :: LLGFL,LLQ,LLQL,LLQI,LLQR,LLQS,LLQG,LLKAP,LLR,LLCP
REAL(KIND=JPRB) :: ZPCP_R5,ZPCP_R2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

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

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

!*       1.    COMPUTES R AND CP AND KAPPA.
!              ----------------------------

LLGFL = PRESENT(PGFL)
IF(.NOT. LLGFL) THEN
  LLQ  = PRESENT(PQ)
  LLQL = PRESENT(PQL)
  LLQI = PRESENT(PQI)
  LLQR = PRESENT(PQR)
  LLQS = PRESENT(PQS)
  LLQG = PRESENT(PQG)
ENDIF
LLR   = PRESENT(PR)
LLCP  = PRESENT(PCP)
LLKAP = PRESENT(PKAP)
IF(LLKAP) THEN
  IF(.NOT. LLR)  CALL ABOR1('GPRCPTL:PKAP PRESENT REQUIRES PR PRESENT')
  IF(.NOT. LLCP) CALL ABOR1('GPRCPTL:PKAP PRESENT REQUIRES PCP PRESENT')
  IF(.NOT. PRESENT(PR5)) CALL ABOR1('GPRCPTL:PKAP PRESENT REQUIRES PR5 PRESENT')
  IF(.NOT. PRESENT(PCP5)) CALL ABOR1('GPRCPTL:PKAP PRESENT REQUIRES PCP5 PRESENT')
ENDIF

IF(LLGFL) THEN
  IGFLTYP = 0
  IF(PRESENT(KGFLTYP)) IGFLTYP=KGFLTYP
  INUMACT = 0
  DO JGFL=1,YGFL%NUMFLDS
    IF(YGFLC(JGFL)%LTHERMACT) THEN
      INUMACT = INUMACT+1
      IACT(INUMACT) = JGFL
      IF(IGFLTYP == 0) THEN
        IPT(INUMACT) = YGFLC(JGFL)%MP
      ELSEIF(IGFLTYP == 1) THEN
        IPT(INUMACT) = YGFLC(JGFL)%MP1
      ELSEIF(IGFLTYP == 5) THEN
        IPT(INUMACT) = YGFLC(JGFL)%MP5
      ELSEIF(IGFLTYP == 9) THEN
        IPT(INUMACT) = YGFLC(JGFL)%MP9
      ELSEIF(IGFLTYP == 101) THEN
        IPT(INUMACT) = YGFLC(JGFL)%MP_SL1
      ELSE
        CALL ABOR1('GPRCPTL:UNKNOWN GFL TYPE')
      ENDIF
    ENDIF
  ENDDO
ENDIF

IF (LLR) THEN
  IF (LDRY_ECMWF) THEN   ! R dependency on humidity variables supressed
    PR(KSTART:KPROF,1:KFLEV)=0.0_JPRB
  ELSE
    PR(KSTART:KPROF,1:KFLEV)=(RV-RD)*PQ(KSTART:KPROF,1:KFLEV)
  ENDIF
ENDIF
   
IF(LLGFL) THEN
  IF(LLCP) THEN
    DO JLEV=1,KFLEV
      IF(INUMACT == 0) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = 0.0_JPRB
        ENDDO
      ENDIF
       DO JGFL=1,INUMACT
        IGFL = IACT(JGFL)
        IF(JGFL == 1) THEN
          DO JLON=KSTART,KPROF
            PCP(JLON,JLEV) = &
             & (YGFLC(IGFL)%RCP-RCPD)*PGFL(JLON,JLEV,IPT(JGFL))
          ENDDO
        ELSE
          DO JLON=KSTART,KPROF
            PCP(JLON,JLEV) = PCP(JLON,JLEV)+&
             & (YGFLC(IGFL)%RCP-RCPD)*PGFL(JLON,JLEV,IPT(JGFL))
          ENDDO
        ENDIF
      ENDDO
      IF(LLKAP) THEN
        DO JLON=KSTART,KPROF
          ZPCP_R5=1.0_JPRB/PCP5(JLON,JLEV)
          ZPCP_R2=ZPCP_R5*ZPCP_R5
          PKAP(JLON,JLEV)= -PR5(JLON,JLEV)*ZPCP_R2*PCP(JLON,JLEV)  
        ENDDO
      ENDIF
    ENDDO
  ENDIF
ELSE
  IF(LLCP) THEN
    DO JLEV=1,KFLEV
      IF(LLQ .AND. YQ%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = (RCPV-RCPD)*PQ(JLON,JLEV)
        ENDDO
      ELSE
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = 0.0_JPRB
        ENDDO
      ENDIF
      IF(LLQL .AND. YL%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = PCP(JLON,JLEV)+(RCW-RCPD)*PQL(JLON,JLEV)
        ENDDO
        IF (.NOT. LDRY_ECMWF) THEN
          PR(KSTART:KPROF,JLEV)=PR(KSTART:KPROF,JLEV)-RD*PQL(KSTART:KPROF,JLEV)
        ENDIF
      ENDIF
      IF(LLQI .AND. YI%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = PCP(JLON,JLEV)+(RCS-RCPD)*PQI(JLON,JLEV)
        ENDDO
        IF (.NOT. LDRY_ECMWF) THEN
          PR(KSTART:KPROF,JLEV)=PR(KSTART:KPROF,JLEV)-RD*PQI(KSTART:KPROF,JLEV)
        ENDIF
      ENDIF
      IF(LLQR .AND. YR%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = PCP(JLON,JLEV)+(RCW-RCPD)*PQR(JLON,JLEV)
        ENDDO
        IF (.NOT. LDRY_ECMWF) THEN
          PR(KSTART:KPROF,JLEV)=PR(KSTART:KPROF,JLEV)-RD*PQR(KSTART:KPROF,JLEV)
        ENDIF
      ENDIF
      IF(LLQS .AND. YS%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = PCP(JLON,JLEV)+(RCS-RCPD)*PQS(JLON,JLEV)
        ENDDO
        IF (.NOT. LDRY_ECMWF) THEN
          PR(KSTART:KPROF,JLEV)=PR(KSTART:KPROF,JLEV)-RD*PQS(KSTART:KPROF,JLEV)
        ENDIF
      ENDIF
      IF(LLQG .AND. YG%LTHERMACT) THEN
        DO JLON=KSTART,KPROF
          PCP(JLON,JLEV) = PCP(JLON,JLEV)+(RCS-RCPD)*PQG(JLON,JLEV)
        ENDDO
        IF (.NOT. LDRY_ECMWF) THEN
          PR(KSTART:KPROF,JLEV)=PR(KSTART:KPROF,JLEV)-RD*PQG(KSTART:KPROF,JLEV)
        ENDIF
      ENDIF
      IF(LLKAP) THEN
        DO JLON=KSTART,KPROF
          ZPCP_R5=1.0_JPRB/PCP5(JLON,JLEV)
          ZPCP_R2=ZPCP_R5*ZPCP_R5
          PKAP(JLON,JLEV)= -PR5(JLON,JLEV)*ZPCP_R2*PCP(JLON,JLEV)  
          IF (.NOT. LDRY_ECMWF) THEN
            PKAP(JLON,JLEV)=PKAP(JLON,JLEV)+PR(JLON,JLEV)*ZPCP_R5
          ENDIF
        ENDDO
      ENDIF
    ENDDO
  ENDIF
ENDIF

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

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