!OCL  NOEVAL
SUBROUTINE GPGRGEO(LDNHDYN,&
 & KPROMA,KD,KF,KFLEV,&
 & PREHYDSPRE,PT,PR,PRTL,PRTM,&
 & PLNPR,PLNPRL,PLNPRM,PALPH,PALPHL,PALPHM,&
 & PQCHAL,PQCHAM,&
 & POROGL,POROGM,&
 & PHIFL,PHIFM,PHIHL,PHIHM,&
 & PNH1L,PNH1M &
 & )  

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

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

!**** *GPGRGEO* - Computes half and full level gradient of geopotential
!                 height "gz".

!     Purpose.
!     --------

!      Expression of this term is:

!       rssavnabla (gz) = rssavnabla Phi_s
!       + vnabla {int[prehyd'=prehyds to prehyd] (-RT/pre) d prehyd'}

!      where: 
!       - "rssavnabla" is the semi-reduced horizontal gradient operator.
!         (rssavnabla = (rs/a) vnabla = M vnabla').
!       - "Phi_s = g z[surf]" is the surface orography.
!       - "prehyd" is the hydrostatic pressure.
!       - "pre" is the total pressure including non-hydrostatic effects.
!       - "prehyds" is the surface hydrostatic pressure.
!       - "R" is the air constant (including water contribution).
!       - "T" is the temperature.
!       - "rs" is the pseudo-radius (for more details see routine "gpvcrs").

!      Discretisation of the semi-reduced gradient of geopotential height
!      yields:

!      * "rssavnabla (gz)" at interlayer "lbar":

!        (rssavnabla (gz))[lbar] = (rssavnabla Phi_s)
!        + sum[k=L to l+1] (prehyd/pre)[k] R[k] T[k] (rssavnabla (delta))[k]
!        + sum[k=L to l+1] (prehyd/pre)[k] (rssavnabla (RT))[k] delta[k]
!        + sum[k=L to l+1] (prehyd/pre)[k] R[k] T[k] delta[k]
!          { (rssavnabla(prehyd)/prehyd)[k] - (rssavnabla(pre)/pre)[k] }

!        Term "sum[k=L to l+1] (prehyd/pre)[k] R[k] T[k] delta[k]
!          { (rssavnabla(prehyd)/prehyd)[k] - (rssavnabla(pre)/pre)[k] }"
!        is zero in the hydrostatic model.

!      * "rssavnabla (gz)" at layer "l":

!        (rssavnabla (gz))[l] = (rssavnabla (gz))[lbar]
!        + (prehyd/pre)[l] R[l] T[l] (rssavnabla (alpha))[l]
!        + (prehyd/pre)[l] (rssavnabla (RT))[l] alpha[l]
!        + (prehyd/pre)[l] R[l] T[l] alpha[l]
!          { (rssavnabla(prehyd)/prehyd)[l] - (rssavnabla(pre)/pre)[l] }

!        Term "(prehyd/pre)[l] R[l] T[l] alpha[l]
!          { (rssavnabla(prehyd)/prehyd)[l] - (rssavnabla(pre)/pre)[l] }"
!        is zero in the hydrostatic model.

!      "alpha[l]" and "delta[l]" are computed in routine "gpxyb" and
!      have discretisations depending on the integer variable "NDLNPR".

!      "(rssavnabla (alpha))[l]" and "(rssavnabla (delta))[l]"
!      are computed in routine "gpgrxyb" and
!      have discretisations depending on the integer variable "NDLNPR".

!      "(rssavnabla(prehyd)/prehyd)[l]" is computed in routine "gpxyb" and
!      has discretisations depending on the integer variable "NDLNPR".

!      "(rssavnabla(pre)/pre)[l]" is computed in routine "gnhgrpre".
!      It is used only in the NH model.

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

!        Explicit arguments :
!        --------------------
!         * INPUT:
!           LDNHDYN      : .F./.T.: hydrostatic/non hydrostatic model.
!           KPROMA       : horizontal dimension
!           KD           : start of work
!           KF           : working length
!           KFLEV        : number of levels
!           PREHYDSPRE   : "prehyd/pre" on layers. Contains "1" if hydrostatic
!           PR           : "R(air)" on layers
!           PT           : temperature "T" on layers
!           PRTL         : zonal component of "rssavnabla (RT)" on layers
!           PRTM         : meridian component of "rssavnabla (RT)" on layers
!           PLNPR        : "delta" on layers (is equal to
!                          "log(prehyd[lbar]/prehyd[lbar-1])" if "ndlnpr=0")
!           PLNPRL       : zonal component of "rssavnabla delta" on layers
!           PLNPRM       : meridian component of "rssavnabla delta" on layers
!           PALPH        : "alpha" on layers
!           PALPHL       : zonal component of "rssavnabla alpha" on layers
!           PALPHM       : meridian component "rssavnabla alpha" on layers
!           PQCHAL       : zonal component of
!                          "rssavnabla(log(pre/prehyd))=
!                          (rssavnabla pre)/pre - (rssavnabla(prehyd))/prehyd"
!                          on layers
!           PQCHAM       : merid component of
!                          "rssavnabla(log(pre/prehyd))=
!                          (rssavnabla pre)/pre - (rssavnabla(prehyd))/prehyd"
!                          on layers
!           POROGL       : zonal component of "rssavnabla(surf orography)"
!           POROGM       : meridian component of "rssavnabla(surf orography)"

!         * OUTPUT:
!           PHIFL        : zonal component of "rssavnabla (gz)" on layers
!           PHIFM        : merid component of "rssavnabla (gz)" on layers
!           PHIHL        : zonal component of "rssavnabla (gz)" on interlayers
!           PHIHM        : merid component of "rssavnabla (gz)" on interlayers

!         * OUTPUT OPTIONAL:
!           PNH1L        : zonal comp of RT grad(log(prehyd/pre)) at full layers
!           PNH1M        : merid comp of RT grad(log(prehyd/pre)) at full layers

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

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

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

!     Reference.
!     ----------
!        See  documentation Arpege ALGORITHME CHAPITRE 6 paragraphe 6

!     Author.
!     -------
!        K. YESSAD

!     Modifications.
!     --------------
!        Original : 00-08-11
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. YESSAD: Mar 2006: Save some quantities in optional arg for TL/AD.
!        K. Yessad (Dec 2008): remove dummy CDLOCK
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
LOGICAL           ,INTENT(IN)    :: LDNHDYN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PREHYDSPRE(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRTL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRTM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPRL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPRM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPHL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPHM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQCHAL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQCHAM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROGL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POROGM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHIFL(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHIFM(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHIHL(KPROMA,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHIHM(KPROMA,0:KFLEV) 
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PNH1L(KPROMA,KFLEV)
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PNH1M(KPROMA,KFLEV)

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

REAL(KIND=JPRB) :: ZNH1L(KPROMA,KFLEV), ZNH1M(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZGPHL(KPROMA,0:KFLEV), ZGPHM(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZINL(KPROMA,KFLEV) , ZINM(KPROMA,KFLEV)

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

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

#include "verint.intfb.h"

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

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

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

!*    1. Computation of term:
!        R[l] T[l] {(rssavnabla(prehyd)/prehyd)[l] - (rssavnabla(pre)/pre)[l]}
!        according to "lnhdyn".

IF (LDNHDYN) THEN

  DO JLEV=1,KFLEV
    ZNH1L(KD:KF,JLEV)=-PR(KD:KF,JLEV)*PT(KD:KF,JLEV)*PQCHAL(KD:KF,JLEV)
    ZNH1M(KD:KF,JLEV)=-PR(KD:KF,JLEV)*PT(KD:KF,JLEV)*PQCHAM(KD:KF,JLEV)
  ENDDO

ELSE

  ZNH1L(KD:KF,1:KFLEV)=0.0_JPRB 
  ZNH1M(KD:KF,1:KFLEV)=0.0_JPRB

ENDIF

IF (PRESENT(PNH1L)) PNH1L(KD:KF,1:KFLEV)=ZNH1L(KD:KF,1:KFLEV)
IF (PRESENT(PNH1M)) PNH1M(KD:KF,1:KFLEV)=ZNH1M(KD:KF,1:KFLEV)

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

!*    2.1 Calculation of "rssavnabla (gz)" on interlayers.
!         ("delta" and "rssavnabla delta" terms contributions.

DO JROF=KD,KF
  PHIHL(JROF,KFLEV)=POROGL(JROF)
  PHIHM(JROF,KFLEV)=POROGM(JROF)
ENDDO

DO JLEV=KFLEV,1,-1
  DO JROF=KD,KF
    PHIHL(JROF,JLEV-1)= PHIHL(JROF,JLEV)&
     & +PLNPR(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
     & (PRTL(JROF,JLEV)+ZNH1L(JROF,JLEV))&
     & +PLNPRL(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV)  
    PHIHM(JROF,JLEV-1)= PHIHM(JROF,JLEV)&
     & +PLNPR(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
     & (PRTM(JROF,JLEV)+ZNH1M(JROF,JLEV))&
     & +PLNPRM(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV)  
  ENDDO
ENDDO

!*    2.2 Calculation of "rssavnabla (gz)" on interlayers.
!         "alpha" and "rssavnabla alpha" terms contributions.

IF(LVERTFE) THEN
  DO JLEV=1,KFLEV
    DO JROF=KD,KF
      ZINL(JROF,JLEV)=(-PLNPR(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
       & (PRTL(JROF,JLEV)+ZNH1L(JROF,JLEV))&
       & -PLNPRL(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV))&
       & *VFE_RDETAH(JLEV)  
      ZINM(JROF,JLEV)=(-PLNPR(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
       & (PRTM(JROF,JLEV)+ZNH1M(JROF,JLEV))&
       & -PLNPRM(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV))&
       & *VFE_RDETAH(JLEV)  
    ENDDO
  ENDDO
  CALL VERINT(KPROMA,KD,KF,KFLEV,ZINL,ZGPHL,1)
  CALL VERINT(KPROMA,KD,KF,KFLEV,ZINM,ZGPHM,1)
  DO JLEV=1,KFLEV
    DO JROF=KD,KF
      PHIFL(JROF,JLEV)=ZGPHL(JROF,JLEV-1)+POROGL(JROF)
      PHIFM(JROF,JLEV)=ZGPHM(JROF,JLEV-1)+POROGM(JROF)
    ENDDO
  ENDDO  
ELSE
  DO JLEV=1,KFLEV
    DO JROF=KD,KF
      PHIFL(JROF,JLEV)= PHIHL(JROF,JLEV)&
       & +PALPH(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
       & (PRTL(JROF,JLEV)+ZNH1L(JROF,JLEV))&
       & +PALPHL(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV)  
      PHIFM(JROF,JLEV)= PHIHM(JROF,JLEV)&
       & +PALPH(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*&
       & (PRTM(JROF,JLEV)+ZNH1M(JROF,JLEV))&
       & +PALPHM(JROF,JLEV)*PREHYDSPRE(JROF,JLEV)*PR(JROF,JLEV)*PT(JROF,JLEV)  
    ENDDO
  ENDDO
ENDIF

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

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