SUBROUTINE GNHDLR(KPROMA,KFLEV,KST,KPROF,PT,PR,PRNHPPI,PLNPR,PALPH,POROG, &
 & PRDLR,PHIH,PHIF)

!**** *GNHDLR* - Computes the radius 'r' for the Wood and Staniforth
!     formulation of the NH deep-layer equations, when LRWSDLR=T.

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

!      Computes the radius 'r' for the Wood and Staniforth
!      formulation of the deep-layer equations (more exactly (r/a) and (a/r)).

!      r(eta) matches the following formula:
!      (G/(3 a**2)) (r(eta)**3 - r_surf**3) 
!      = sum_eta_to_surf [(RT/p) (d presim / d eta') d eta']

!      'presim' is the apparent mass vertical coordinate matching:
!      d presim/d prehyd = (r**2/a**2)*(G/g)

!      where:
!       - "G" is the gravitation constant at r=a.
!       - "prehyd" is the hydrostatic pressure.
!       - "pre" is the total pressure including non-hydrostatic effects.
!       - "R" is the air constant (including moisture effects).
!       - "T" is the temperature.
!       - "a" is the mean Earth radius.

!      This radius is used for example in metric terms or in the pressure
!      gradient term.
!      About geopotential Phi, we must notice that:
!      - If the vertical variations of "g" (gravitation acceleration) are
!        neglected (i.e. g=G everywhere): Phi=G*(r-a).
!      - If the vertical variations of "g" (gravitation acceleration) are
!        taken into account: Phi=sqrt(g*G)*(r-a)
!      - When LRWSDLG=T (i.e. g/=G), the output content of PHIH and PHIF is
!        G*(r-a), not Phi.

!      This routine does a vertical integration (according to LVERTFE) and
!      has a structure close to the one of GPGEO.

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

!        Explicit arguments :
!        --------------------
!         KPROMA   : horizontal dimensioning                          (input)
!         KFLEV    : number of levels                                 (input)
!         KST      : start of work                                    (input)
!         KPROF    : depth of work                                    (input)
!         PT       : temperature at full levels                       (input)
!         PR       : "R" at full levels                               (input)
!         PRNHPPI  : "presim/pre" at full levels                      (input)
!         PLNPR    : term "delta" at full levels                      (input)
!         PALPH    : term "alpha" at full levels                      (input)
!         POROG    : surface orography                                (input)
!         PRDLR    : array containing "r/a" and "a/r"                 (output)
!         PHIH     : geopotential height "gz" at half levels          (output)
!                    (Gz if LRWSDLG=T)
!         PHIF     : geopotential height "gz" at layers               (output)
!                    (Gz if LRWSDLG=T)

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

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

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

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!        ARPEGE documentation (IDEUL)
!        Wood and Staniforth, 2003 (in QJRMS)

!     Author.
!     -------
!        K. Yessad (METEO-FRANCE/CNRM/GMAP), after routine GPGEO.

!     Modifications.
!     --------------
!      Original : March 2008 
!   K. Yessad (March 2009): correct false comments for LRWSDLG=T
!     ------------------------------------------------------------------

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

USE YOMGEM   , ONLY : VFE_RDETAH
USE YOMCVER  , ONLY : LVERTFE
USE YOMCST   , ONLY : RA       ,RG 
USE YOMDYNA  , ONLY : LRWSDLR
USE PAR_RDLR , ONLY : JP_RSAF  ,JP_RSAH  ,JP_ASRF  ,JP_ASRH  ,JP_DIMR

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)        :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)        :: KFLEV 
INTEGER(KIND=JPIM),INTENT(IN)        :: KST 
INTEGER(KIND=JPIM),INTENT(IN)        :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)        :: PT(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)        :: PR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)        :: PRNHPPI(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)        :: PLNPR(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)        :: PALPH(KPROMA,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)        :: POROG(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)       :: PRDLR(KPROMA,0:KFLEV,JP_DIMR) 
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PHIH(KPROMA,0:KFLEV) 
REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PHIF(KPROMA,KFLEV) 

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

REAL(KIND=JPRB) :: ZIN(KPROMA,KFLEV)
REAL(KIND=JPRB) :: ZOUT(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZRDLR3F(KPROMA,KFLEV),ZRDLR3H(KPROMA,0:KFLEV)
REAL(KIND=JPRB) :: ZAG,ZRAG,ZR3

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

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

#include "abor1.intfb.h"
#include "verint.intfb.h"

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

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

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

!*       1.    COMPUTES HALF AND FULL LEVEL RADIUS.
!              ------------------------------------

IF (.NOT.LRWSDLR) THEN
  CALL ABOR1(' GNHDLR: should not be called if LRWSDLR=F!')
ENDIF

ZAG=RG*RA
ZRAG=1.0_JPRB/ZAG
ZR3=1.0_JPRB/3.0_JPRB

! Surface
DO JROF=KST,KPROF
  PRDLR(JROF,KFLEV,JP_RSAH)=1.0_JPRB+POROG(JROF)*ZRAG
  PRDLR(JROF,KFLEV,JP_ASRH)=1.0_JPRB/PRDLR(JROF,KFLEV,JP_RSAH)
  ZRDLR3H(JROF,KFLEV)=PRDLR(JROF,KFLEV,JP_RSAH)**3.0_JPRB
ENDDO
IF (PRESENT(PHIH)) PHIH(KST:KPROF,KFLEV)=POROG(KST:KPROF)

IF(LVERTFE) THEN
  ! Full levels
  DO JLEV=1,KFLEV
    DO JROF=KST,KPROF
      ZIN(JROF,JLEV)=-3.0_JPRB*ZRAG*VFE_RDETAH(JLEV)* &
       & PR(JROF,JLEV)*PT(JROF,JLEV)*PRNHPPI(JROF,JLEV)*PLNPR(JROF,JLEV)
    ENDDO
  ENDDO
  CALL VERINT(KPROMA,KST,KPROF,KFLEV,ZIN,ZOUT,1)
  DO JLEV=1,KFLEV
    DO JROF=KST,KPROF
      ZRDLR3F(JROF,JLEV)=ZOUT(JROF,JLEV-1)+ZRDLR3H(JROF,KFLEV)
      PRDLR(JROF,JLEV,JP_RSAF)=ZRDLR3F(JROF,JLEV)**ZR3
      PRDLR(JROF,JLEV,JP_ASRF)=1.0_JPRB/PRDLR(JROF,JLEV,JP_RSAF)
    ENDDO
  ENDDO
  ! Half levels
  DO JLEV=KFLEV,1,-1
    DO JROF=KST,KPROF
      ZRDLR3H(JROF,JLEV-1)=ZRDLR3H(JROF,JLEV)+3.0_JPRB*ZRAG* &
       & PR(JROF,JLEV)*PT(JROF,JLEV)*PRNHPPI(JROF,JLEV)*PLNPR(JROF,JLEV)  
      PRDLR(JROF,JLEV-1,JP_RSAH)=ZRDLR3H(JROF,JLEV-1)**ZR3
      PRDLR(JROF,JLEV-1,JP_ASRH)=1.0_JPRB/PRDLR(JROF,JLEV-1,JP_RSAH)
    ENDDO
  ENDDO
ELSE
  DO JLEV=KFLEV,1,-1
    DO JROF=KST,KPROF
      ! Half levels
      ZRDLR3H(JROF,JLEV-1)=ZRDLR3H(JROF,JLEV)+3.0_JPRB*ZRAG* &
       & PR(JROF,JLEV)*PT(JROF,JLEV)*PRNHPPI(JROF,JLEV)*PLNPR(JROF,JLEV)  
      PRDLR(JROF,JLEV-1,JP_RSAH)=ZRDLR3H(JROF,JLEV-1)**ZR3
      PRDLR(JROF,JLEV-1,JP_ASRH)=1.0_JPRB/PRDLR(JROF,JLEV-1,JP_RSAH)
      ! Full levels
      ZRDLR3F(JROF,JLEV)=ZRDLR3H(JROF,JLEV)+3.0_JPRB*ZRAG* &
       & PR(JROF,JLEV)*PT(JROF,JLEV)*PRNHPPI(JROF,JLEV)*PALPH(JROF,JLEV)
      PRDLR(JROF,JLEV,JP_RSAF)=ZRDLR3F(JROF,JLEV)**ZR3
      PRDLR(JROF,JLEV,JP_ASRF)=1.0_JPRB/PRDLR(JROF,JLEV,JP_RSAF)
    ENDDO
  ENDDO
ENDIF

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

!*       2.    COMPUTES HALF AND FULL LEVEL "Gz".
!              ----------------------------------

DO JLEV=1,KFLEV
  IF (PRESENT(PHIF)) THEN
    DO JROF=KST,KPROF
      PHIF(JROF,JLEV)=ZAG*(PRDLR(JROF,JLEV,JP_RSAF)-1.0_JPRB)
    ENDDO
  ENDIF
  IF (PRESENT(PHIH)) THEN
    DO JROF=KST,KPROF
      PHIH(JROF,JLEV-1)=ZAG*(PRDLR(JROF,JLEV-1,JP_RSAH)-1.0_JPRB)
    ENDDO
  ENDIF
ENDDO

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

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

