!OPTIONS XOPT(HSFUN)
SUBROUTINE GWDRAG(KIDIA,KFDIA,KLON,KLEV,&
 & PAPHM1,PAPM1,PGEOM1,&
 & PTM1,PUM1,PVM1,&
 & PHSTD,PGAMMA,PTHETA,PSIG,&
 ! TENDENCY COEFFICIENTS (OUTPUT)
 & PSOTEU,PSOTEV,PSOBETA) 
                               

!**** *GWDRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION.

!     PURPOSE.
!     --------

!          COMPUTES THE COEFFICIENTS FOR COMPUTATION OF THE 
!          PHYSICAL TENDENCIES OF THE PROGNOSTIC VARIABLES U,V  AND T DUE TO  
!          VERTICAL TRANSPORTS BY SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
!          THE TENDENCIES AND OTHER DIAGNOSTIC QUANTITIES ARE THEN COMPUTER 
!          IN CALLPAR.  

!          NOTE THAT THE VERTICAL INDEXING OF PAPHM1 IS FROM 0:KLEV TO MAKE IT 
!          COMPATIBLE WITH CALLPAR

!**   INTERFACE.
!     ----------
!          CALLED FROM *CALLPAR*.

!          THE ROUTINE TAKES ITS INPUT FROM THE LONG-TERM STORAGE:
!          U,V,T AND P AT T-1.

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===

!        *KIDIA*       START POINT
!        *KFDIA*       END POINT
!        *KLON*        NUMBER OF GRID POINTS PER PACKET
!        *KLEV*        NUMBER OF VERTICAL LEVELS
!        *KGL1*        ROW NUMBER FOR PRINTINGS  (UNSUED)
!        *PHSTD*       STANDARD DEVIATION OF THE SUBGRID SCALE OROGRAPHY
!        *PTHETA*      GEOGRAPHICAL ORIENTATION 
!                      OF THE SUBGRID SCALE OROGRAPHY
!        *PGAMMA*      ANISOTROPY OF THE SUBGRID SCALE OROGRAPHY
!        *PSIG*        MEAN SLOPE OF THE SUBGRID SCALE OROGRAPHY
!        *PAPHM1*      PRESSURE AT HALF LEVELS AT T-1
!        *PAPM1*       PRESSURE AT FULL LEVELS AT T-1
!        *PGEOM1*      GEOPOTENTIAL AT T-1
!        *PTM1*        TEMPERATURE AT T-1
!        *PUM1*        X-VELOCITY COMPONENT AT T-1
!        *PVM1*        Y-VELOCITY COMPONENT AT T-1

!     ==== OUTPUTS ===

!        *PSOTEU*     EXPLICIT TENDENCY COEFFICIENT OF U-COMP OF WIND
!        *PSOTEV*     EXPLICIT TENDENCY COEFFICIENT OF V-COMP OF WIND
!        *PSOBETA*    IMPLICIT TENDENCY COEFFICIENT OF U,V-COMP OF WIND
!        *LLGWD*      TRUE IF PHSTD > 50 (IE GWDRAG SCHEME ACTIVE)

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------
!         THE SCHEME CONSISTS OF THREE PARTS,THE CALCULATION OF LOWLEVEL
!         DRAG DUE TO WAKE EFFECTS OF THE SUBGRID OROGRAPHY,THE GRAVITY 
!         WAVE STRESS AND THE STRESS PROFILE IN THE VERTICAL.
!         THE STRESS IS COMPUTED USING A LOW-LEVEL WIND,STATIC STABILITY
!         AND  SUBGRID OROGRAPHIC PARAMETERS.THESE ARE THE STANDARD 
!         DEVIATION OF THE HEIGHT,THE ANGLE RELATIVE TO EAST, THE
!         ANISOTROPY,AND THE SLOPE.
!         A WAV RICHARDSON NUMBER IS COMPUTED AT EACH LEVEL AND BY
!         REQUIRING THAT ITS VALUE IS NEVER LESS THAN A CRITICAL ONE
!         A VALUE OF STRESS IS DETERMINED AT EACH MODEL LEVEL.
!         THE CRITICAL FROUDE NUMBER OF THE FLOW DETERMINES THE DEPTH OF
!         THE LOWLEVEL DRAG.  

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------
!         SEE MODEL DOCUMENTATION

!        SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S."

!     AUTHOR.
!     -------
!     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.

!     MODIFICATIONS.
!     --------------
!     REVISED BY MARTIN MILLER   E.C.M.W.F.   22/03/89.
!     NEW VERSION MARTIN MILLER  E.C.M.W.F.   1993
!     CODED FOR IFS BY F.LOTT    E.C.M.W.F.   22/11/93
!     D.Salmond  15-Oct-01 FULLIMP mods
!     M.Hamrud   01-Oct-2003 CY28 Cleaning
!     A.Brown    17-Aug-2004 Introduction of cutoff moutain
!     A. Orr     01-Nov-2005 Subgrid oro and vdf integrated together
!     P.Bechtold 14-Jan-2009 move IKTOP computation to setup routine
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG
USE YOEGWD   , ONLY : GKDRAG   ,GKWAKE  ,NGWDLIM,GTENLIM,&
                     &NGWDTOP  ,GRFPLM
USE YOEPHLI  , ONLY : LPHYLIN  ,RLPDRAG

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,0:KLEV) !note callpar indexing convention 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHSTD(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGAMMA(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTHETA(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIG(KLON) 

!          ========OUTPUTS======

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSOTEU(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSOTEV(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSOBETA(KLON,KLEV)

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

!*       0.1   ARGUMENTS
!              ---------

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

!              ------------
INTEGER(KIND=JPIM) ::  &
 & ICRIT(KLON),&
 & IKCRITH(KLON),&
 & IKENVH(KLON),&
 & IKNU(KLON),&
 & IKNU2(KLON)  

REAL(KIND=JPRB) ::   ZTAU(KLON,KLEV+1),&
 & ZSTAB(KLON,KLEV+1),&
 & ZVPH(KLON,KLEV+1),&
 & ZRHO(KLON,KLEV+1),&
 & ZRI(KLON,KLEV+1),&
 & ZPSI(KLON,KLEV+1),&
 & ZZDEP(KLON,KLEV)  
REAL(KIND=JPRB) ::  ZULOW(KLON),&
 & ZVLOW(KLON),&
 & ZNU(KLON),&
 & ZD1(KLON),&
 & ZD2(KLON),&
 & ZDMOD(KLON)  

INTEGER(KIND=JPIM) :: ILEVP1, ILONS, JK, JL, IKTOP

REAL(KIND=JPRB) :: ZABSV, ZB, ZBLOCK, ZC, ZCONB,&
 & ZCS, ZDELP, ZDELP0, ZEFF, ZKDRAG, &
 & ZRATIO, ZSS, ZSTD, ZTEMP, ZZD1
REAL(KIND=JPRB) :: ZHOOK_HANDLE

LOGICAL :: LLGWD(KLON)

#include "gwprofil.intfb.h"
#include "gwsetup.intfb.h"

!*************************************************************

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

!*         1.    INITIALIZATION
!                --------------

IF (LHOOK) CALL DR_HOOK('GWDRAG',0,ZHOOK_HANDLE)
ILONS=KFDIA-KIDIA+1
!     ------------------------------------------------------------------

!       SELECT POINTS FOR SCHEME TO OPERATE(SGS OROG >50METRES)  ****

DO JL=KIDIA,KFDIA
  IF (PHSTD(JL) > 50._JPRB) THEN
    LLGWD(JL)=.TRUE.
  ELSE
    LLGWD(JL)=.FALSE.
  ENDIF
ENDDO

!       Constant for surface stress

IF (LPHYLIN) THEN
  ZKDRAG=RLPDRAG
ELSE
  ZKDRAG=GKDRAG
ENDIF

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

!*         2.     PRECOMPUTE BASIC STATE VARIABLES.
!*                ---------- ----- ----- ----------

CALL GWSETUP &
 & ( KIDIA , KFDIA , KLON  , KLEV , LLGWD,&
 & IKCRITH, ICRIT,&
 & IKENVH,IKNU,IKNU2,&
 & PAPHM1, PAPM1 , PUM1   , PVM1 , PTM1 , PGEOM1, PHSTD,&
 & ZRHO  , ZRI   , ZSTAB  , ZTAU , ZVPH , ZPSI , ZZDEP,&
 & ZULOW , ZVLOW,&
 & PTHETA , PGAMMA,ZNU  ,ZD1  , ZD2, ZDMOD )  

!***********************************************************

!*         3.      COMPUTE THE SURFACE GRAVITY WAVE STRESS
!                  ---------------------------------------

ZBLOCK=0.0_JPRB

DO JL=KIDIA,KFDIA
  IF(LLGWD(JL)) THEN
 
    ZBLOCK=(PGEOM1(JL,IKENVH(JL))/RG)    
    ZSTD=PHSTD(JL)
    ZEFF=MAX(0.0_JPRB,3._JPRB*ZSTD-ZBLOCK)*2.0_JPRB
    ZTAU(JL,KLEV+1)=ZKDRAG*ZRHO(JL,KLEV+1)*PSIG(JL)*ZEFF**2 &
     &/9._JPRB/ZSTD*ZVPH(JL,KLEV+1)*ZDMOD(JL)*SQRT(ZSTAB(JL,KLEV+1))

  ELSE
    ZTAU(JL,KLEV+1)=0.0_JPRB
  ENDIF

ENDDO

!*         4.      COMPUTE GRAVITY WAVE STRESS PROFILE.
!*                 -----------------------------------

CALL GWPROFIL &
 & ( KIDIA ,  KFDIA , KLON  , KLEV,&
 & LLGWD,&
 & IKCRITH, ICRIT , IKENVH, IKNU,&
 & IKNU2  , PAPHM1, ZRHO  , ZSTAB , ZVPH,&
 & ZRI    , ZTAU  , ZDMOD , PSIG  , PHSTD)  


!*         5.      COMPUTE TENDENCY COEFFICIENTS.
!*                 -----------------------------

DO JK=1,KLEV
 DO JL=KIDIA,KFDIA
  PSOTEU(JL,JK)=0.0_JPRB
  PSOTEV(JL,JK)=0.0_JPRB
  PSOBETA(JL,JK)=0.0_JPRB
 ENDDO
ENDDO 


ILEVP1=KLEV+1

IKTOP=NGWDTOP

DO JK=1,KLEV
!OCL  VCT(CEX)
  DO JL=KIDIA,KFDIA
    IF(LLGWD(JL)) THEN
!      COMPUTE EXPLICIT COEFFICENTS FOR GRAVITY WAVE PORTION 
!      INITIALLY SET IMPLICIT BLOCKING COEFFICENTS TO ZERO 

      ZDELP =PAPHM1(JL,JK)-PAPHM1(JL,JK-1)
! adjust in pressure < 0.1hPa
      IF( PAPM1(JL,JK) < GRFPLM) THEN
        ZDELP0=PAPHM1(JL,IKTOP)-PAPHM1 (JL,0)
        ZTEMP=-RG*(ZTAU(JL,IKTOP+1)-ZTAU(JL,1))*ZDELP/ &
         &        (ZVPH(JL,ILEVP1)*ZDELP0**2)
      ELSE
        ZTEMP =-RG*(ZTAU(JL,JK+1)-ZTAU(JL,JK))/(ZDELP*ZVPH(JL,ILEVP1))
      ENDIF
      PSOTEU(JL,JK)=(ZULOW(JL)*ZD1(JL)-ZVLOW(JL)*ZD2(JL))*ZTEMP/ZDMOD(JL)
      PSOTEV(JL,JK)=(ZVLOW(JL)*ZD1(JL)+ZULOW(JL)*ZD2(JL))*ZTEMP/ZDMOD(JL)
      PSOBETA(JL,JK)=0.0_JPRB
      
!      LIMIT THE WIND TENDENCIES IN THE STRATOSPHERE (probably not necessary now ?)
       IF(JK < NGWDLIM) THEN
        PSOTEU(JL,JK)=SIGN(MIN(ABS(PSOTEU(JL,JK)),GTENLIM),PSOTEU(JL,JK))
        PSOTEV(JL,JK)=SIGN(MIN(ABS(PSOTEV(JL,JK)),GTENLIM),PSOTEV(JL,JK))
       ENDIF

!     FOR BLOCKING LEVELS RECALCULATE THE IMPLICIT COEFFICIENTS
!     AND SET EXPLICIT GRAVITY WAVE COEFFICIENTS TO ZERO      
      IF(JK >= IKENVH(JL)) THEN
        ZB    =1.0_JPRB-0.18_JPRB*PGAMMA(JL)-0.04_JPRB*PGAMMA(JL)**2
        ZC    =0.48_JPRB*PGAMMA(JL)+0.3_JPRB*PGAMMA(JL)**2
        ZCS   =COS(ZPSI(JL,JK))**2
        ZSS   =1.0_JPRB-ZCS
        ZCONB =GKWAKE*PSIG(JL)/(2.0_JPRB*PHSTD(JL)) !  ZCONB INDEPENDENT OF ZTMST
        ZABSV =0.5_JPRB*SQRT(PUM1(JL,JK)**2+PVM1(JL,JK)**2)
        ZZD1  =ZB*ZCS+ZC*ZSS
        ZRATIO=(ZCS+PGAMMA(JL)*ZSS)/(PGAMMA(JL)*ZCS+ZSS)      
        PSOBETA(JL,JK)=MAX(0.0_JPRB,2.0_JPRB-1.0_JPRB/ZRATIO)*ZCONB*ZZDEP(JL,JK)*ZZD1*ZABSV 
        PSOTEU(JL,JK)=0.0_JPRB
        PSOTEV(JL,JK)=0.0_JPRB
      ENDIF

    ENDIF
  ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('GWDRAG',1,ZHOOK_HANDLE)
END SUBROUTINE GWDRAG
