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

!**** *GPRCPAD* - Computes Cp, R and R/Cp from Q, adjoint

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

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

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

!        INPUT:
!          KPROMA               - dimensioning.
!          KSTART               - start of work.
!          KPROF                - depth of work.
!          KFLEV                - number of layers.

!        INPUT/OUTPUT:
!          PQ(KPROMA,KFLEV)     - specific humidity.
!          PQI(KPROMA,KFLEV)    - ice.
!          PQL(KPROMA,KFLEV)    - liquid water.
!          PCP(KPROMA,KFLEV)    - CP
!          PR(KPROMA,KFLEV)     - R

!        OUTPUT:
!          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-27 : Liquid Water and Ice
!        J.N Thepaut: 94-09-14 . rewriting.
!        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
!        M. Jidane : 06-04-2006 Re-introduction of R dep. on q variables under key
!     ------------------------------------------------------------------

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(INOUT) :: PQ(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PQI(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PQL(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PQR(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PQS(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PQG(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PGFL(KPROMA,KFLEV,YGFL%NDIM) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PCP(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: PR(KPROMA,KFLEV) 
REAL(KIND=JPRB),OPTIONAL   ,INTENT(INOUT) :: 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,LLALL
REAL(KIND=JPRB) :: ZPCP_R5,ZPCP_R2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('GPRCPAD',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('GPRCPAD:PKAP PRESENT REQUIRES PR PRESENT')
  IF(.NOT. LLCP) CALL ABOR1('GPRCPAD:PKAP PRESENT REQUIRES PCP PRESENT')
  IF(.NOT. PRESENT(PR5)) CALL ABOR1('GPRCPAD:PKAP PRESENT REQUIRES PR5 PRESENT')
  IF(.NOT. PRESENT(PCP5)) CALL ABOR1('GPRCPAD: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('GPRCPAD:UNKNOWN GFL TYPE')
      ENDIF
    ENDIF
  ENDDO
ENDIF

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

! R dependency on humidity variables supressed
IF (LLR .AND. LDRY_ECMWF) PR(KSTART:KPROF,1:KFLEV)=0.0_JPRB

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

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