!OPTIONS XOPT(HSFUN)
SUBROUTINE GWPROFILTL &
 & ( KIDIA  , KFDIA , KLON , KLEV,&
 & LDGWD,&
 & KKCRITH, KCRIT , KKENVH , KKNU  , KKNU2,&
 & PAPHM15, PRHO5 , PSTAB5 , PVPH5 , PRI5 , PTAU5,&
 & PDMOD5 , PSIG  , PHSTD,&
 & PAPHM1 , PRHO  , PSTAB  , PVPH  , PRI  , PTAU,&
 & PDMOD   )  

!**** *GWPROFILTL*  Stress profile  
!                   (Tangent linear)

!     J.-F. MAHFOUF           E.C.M.W.F.               07/05/96

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

!**   INTERFACE.
!     ----------
!          FROM *GWDRAGTL*

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

!        *KIDIA*       START POINT
!        *KFDIA*       END POINT
!        *KLON*        NUMBER OF GRID POINTS PER PACKET
!        *KLEV*        NUMBER OF VERTICAL LEVELS
!        *LDGWD*       TRUE IF SSO ACTIVE
!        *KKCRITH*     MAXIMUM HALF-LEVEL FOR WAVE BREAKING
!        *KCRIT*       CRITICAL LEVEL
!        *KKENVH*      HALF-LEVEL FOR BLOCKING (TOP OF ENVELOPE LAYER)
!        *KKNU*        MODEL LEVEL AT 4*PHSTD HEIGHT 
!        *KKNU2*       MODEL LEVEL AT 3*PHSTD HEIGHT
!        *PAPHM15*     PRESSURE AT HALF LEVELS AT T-1        (Trajectory)
!        *PRHO5*       AIR DENSITY                           (Trajectory)
!        *PSTAB5*      SQUARE OF THE BRUNT-VAISALA FREQUENCY (Trajectory)
!        *PVPH5*       WIND PROJECTION ALONG SURFACE STRESS 
!                      AT HALF LEVELS                        (Trajectory)
!        *PRI5*        MEAN FLOW RICHARDSON NUMBER           (Trajectory)
!        *PTAU5*       STRESS PRODUCED BY GRAVITY WAVES      (Trajectory)
!        *PDMOD5*      MODULUS OF THE SURFACE STRESS (PART)  (Trajectory)
!        *PAPHM1*      PRESSURE AT HALF LEVELS AT T-1
!        *PRHO*        AIR DENSITY
!        *PSTAB*       SQUARE OF THE BRUNT-VAISALA FREQUENCY
!        *PVPH*        WIND PROJECTION ALONG SURFACE STRESS 
!                      AT HALF LEVELS
!        *PRI*         MEAN FLOW RICHARDSON NUMBER      
!        *PTAU*        STRESS PRODUCED BY GRAVITY WAVES
!        *PDMOD*       MODULUS OF THE SURFACE STRESS (PART)
!        *PSIG*        MEAN SLOPE OF THE SUBGRID SCALE OROGRAPHY
!        *PHSTD*       STANDARD DEVIATION OF THE SUBGRID SCALE OROGRAPHY

!     ==== OUTPUTS ===

!        *PTAU5*       STRESS PRODUCED BY GRAVITY WAVES      (Trajectory)
!        *PTAU*        STRESS PRODUCED BY GRAVITY WAVES

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

!     METHOD:
!     -------
!     THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS:
!     IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND
!     AND THE TOP OF THE BLOCKED LAYER (KKENVH).
!     IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE 
!     BLOCKED LAYER TO 3*VAROR (KKNU), TO SIMULATES LEE WAVES OR 
!     NONLINEAR GRAVITY WAVE BREAKING.
!     ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL
!     LEVEL (KCRIT) OR WHEN IT BREAKS.

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

!     REFERENCE.
!     ----------

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

!     AUTHOR.
!     -------

!     MODIFICATIONS.
!     --------------
!     MIGRATION OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOEGWD   , ONLY : GRCRIT   ,GKDRAG   ,GSSEC    ,GTSEC
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 
LOGICAL           ,INTENT(IN)    :: LDGWD(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KKCRITH(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCRIT(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KKENVH(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KKNU(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KKNU2(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM15(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRHO5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTAB5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVPH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRI5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAU5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDMOD5(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHSTD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHM1(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRHO(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTAB(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVPH(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRI(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAU(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDMOD(KLON) 
!-----------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) :: ZDZ25 (KLON,KLEV) , ZNORM5(KLON) , ZORO5(KLON)
REAL(KIND=JPRB) :: ZTAU5 (KLON,KLEV+1)
REAL(KIND=JPRB) :: ZDZ2  (KLON,KLEV) , ZNORM (KLON) , ZORO (KLON)
REAL(KIND=JPRB) :: ZTAU  (KLON,KLEV+1)

INTEGER(KIND=JPIM) :: JK, JL

REAL(KIND=JPRB) :: ZALFA5, ZALPHA, ZALPHA5, ZB, ZB5, ZDEL, ZDEL5,&
 & ZDELP, ZDELP5, ZDELPT, ZDELPT5, ZDZ2N, ZDZ2N5, &
 & ZKDRAG, ZRIW5, ZS15, ZS2, ZS25, ZS35, ZSQR, &
 & ZSQR5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

!*    COMPUTATIONAL CONSTANTS.
!     ------------- ----------

!     Constant for surface stress

IF (LHOOK) CALL DR_HOOK('GWPROFILTL',0,ZHOOK_HANDLE)
IF (LPHYLIN) THEN
  ZKDRAG=RLPDRAG
ELSE
  ZKDRAG=GKDRAG
ENDIF

DO JL=KIDIA,KFDIA
  IF(LDGWD(JL)) THEN
    IF (PHSTD(JL) < 1.0_JPRB) THEN
      ZS15=1.0_JPRB
    ELSE
      ZS15=PHSTD(JL)
    ENDIF
    ZORO (JL)=0.25_JPRB*PSIG(JL)*PDMOD (JL)/ZS15
    ZORO5(JL)=0.25_JPRB*PSIG(JL)*PDMOD5(JL)/ZS15
    ZTAU (JL,KKNU(JL)+1)=PTAU (JL,KKNU(JL)+1)
    ZTAU5(JL,KKNU(JL)+1)=PTAU5(JL,KKNU(JL)+1)
    ZTAU (JL,KLEV+1)    =PTAU (JL,KLEV+1)
    ZTAU5(JL,KLEV+1)    =PTAU5(JL,KLEV+1)
  ENDIF
ENDDO

DO JK=KLEV,2,-1

!*         1.1    CONSTANT WAVE STRESS UNTIL TOP OF THE
!                 BLOCKING LAYER.

  DO JL=KIDIA,KFDIA
    IF(LDGWD(JL)) THEN
      IF(JK >= KKNU2(JL)) THEN
        PTAU (JL,JK)=ZTAU (JL,KLEV+1)
        PTAU5(JL,JK)=ZTAU5(JL,KLEV+1)
      ENDIF
    ENDIF
  ENDDO

!*         1.2    WAVE DISPLACEMENT AT NEXT LEVEL.

!OCL  VCT(CEX)
  DO JL=KIDIA,KFDIA
    IF(LDGWD(JL)) THEN
      IF(JK < KKNU2(JL)) THEN
        ZNORM (JL)=ZKDRAG*(PRHO5(JL,JK)*PSTAB(JL,JK)&
         & *PVPH5(JL,JK)*ZORO5(JL)/(2.0_JPRB*SQRT(PSTAB5(JL,JK)))+&
         & SQRT(PSTAB5(JL,JK))*&
         & (PRHO5(JL,JK)*PVPH5(JL,JK)*ZORO (JL)+&
         & PRHO5(JL,JK)*PVPH (JL,JK)*ZORO5(JL)+&
         & PRHO (JL,JK)*PVPH5(JL,JK)*ZORO5(JL)))  
        ZNORM5(JL)=ZKDRAG*PRHO5(JL,JK)*SQRT(PSTAB5(JL,JK))&
         & *PVPH5(JL,JK)*ZORO5(JL)  
        IF (ZNORM5(JL) < GSSEC) THEN
          ZS2 =0.0_JPRB
          ZS25=GSSEC
        ELSE
          ZS2 =ZNORM (JL)
          ZS25=ZNORM5(JL)
        ENDIF
        ZDZ2 (JL,JK)=(PTAU(JL,JK+1)*ZS25-PTAU5(JL,JK+1)* ZS2)/ ZS25**2
        ZDZ25(JL,JK)= PTAU5(JL,JK+1)/ZS25
      ENDIF
    ENDIF
  ENDDO

!*         1.3    WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT
!*                AND STRESS:  BREAKING EVALUATION AND CRITICAL 
!                 LEVEL

  DO JL=KIDIA,KFDIA
    IF(LDGWD(JL)) THEN
      IF(JK < KKNU2(JL)) THEN
        IF((PTAU5(JL,JK+1) < GTSEC).OR.(JK <= KCRIT(JL))) THEN
          PTAU (JL,JK)=0.0_JPRB
          PTAU5(JL,JK)=0.0_JPRB
        ELSE
          ZSQR =PRI(JL,JK)/(2.0_JPRB*SQRT(PRI5(JL,JK)))
          ZSQR5=SQRT(PRI5(JL,JK))
          ZALFA5=SQRT(PSTAB5(JL,JK)*ZDZ25(JL,JK))/PVPH5(JL,JK)
          ZS35=(1+ZALFA5*ZSQR5)**2
          ZRIW5=PRI5(JL,JK)*(1.0_JPRB-ZALFA5)/ZS35
          IF(ZRIW5 < GRCRIT) THEN
            ZDEL =-4._JPRB*ZSQR/ZSQR5**2/GRCRIT
            ZDEL5= 4._JPRB/ZSQR5/GRCRIT+1.0_JPRB/GRCRIT**2+4._JPRB/GRCRIT
            ZB =-2.0_JPRB*ZSQR/ZSQR5**2
            ZB5=1.0_JPRB/GRCRIT+2.0_JPRB/ZSQR5
            ZALPHA =0.5_JPRB*(-ZB +ZDEL/(2.0_JPRB*SQRT(ZDEL5)))
            ZALPHA5=0.5_JPRB*(-ZB5+SQRT(ZDEL5))
            ZDZ2N =(2.0_JPRB*(PVPH5(JL,JK)*ZALPHA+&
             & PVPH (JL,JK)*ZALPHA5)*&
             & (PVPH5(JL,JK)*ZALPHA5)*PSTAB5(JL,JK)-&
             & PSTAB (JL,JK)*&
             & (PVPH5(JL,JK)*ZALPHA5)**2 )/&
             & PSTAB5(JL,JK)**2     
            ZDZ2N5=(PVPH5(JL,JK)*ZALPHA5)**2/PSTAB5(JL,JK)
            PTAU (JL,JK)=ZNORM5(JL)*ZDZ2N+ZNORM(JL)*ZDZ2N5
            PTAU5(JL,JK)=ZNORM5(JL)*ZDZ2N5
          ELSE
            PTAU(JL,JK)=ZNORM5(JL)*ZDZ2 (JL,JK)+ZNORM (JL)*ZDZ25(JL,JK)
            PTAU5(JL,JK)=ZNORM5(JL)*ZDZ25(JL,JK)
          ENDIF
          IF (PTAU5(JL,JK) > PTAU5(JL,JK+1)) THEN
            PTAU (JL,JK)=PTAU (JL,JK+1)
            PTAU5(JL,JK)=PTAU5(JL,JK+1)
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ENDDO

ENDDO

!  REORGANISATION OF THE STRESS PROFILE
!  IF BREAKING OCCURS AT LOW LEVEL:
DO JL=KIDIA,KFDIA
  IF(LDGWD(JL)) THEN
    ZTAU (JL,KKENVH(JL)) =PTAU (JL,KKENVH(JL))
    ZTAU5(JL,KKENVH(JL)) =PTAU5(JL,KKENVH(JL))
    ZTAU (JL,KKCRITH(JL))=PTAU (JL,KKCRITH(JL))
    ZTAU5(JL,KKCRITH(JL))=PTAU5(JL,KKCRITH(JL))
  ENDIF
ENDDO

DO JK=1,KLEV

  DO JL=KIDIA,KFDIA
    IF(LDGWD(JL)) THEN
      IF(JK > KKCRITH(JL).AND.JK < KKENVH(JL))THEN
        ZDELP =PAPHM1 (JL,JK)-PAPHM1 (JL,KKENVH(JL))
        ZDELP5=PAPHM15(JL,JK)-PAPHM15(JL,KKENVH(JL))
        ZDELPT =PAPHM1 (JL,KKCRITH(JL))-PAPHM1 (JL,KKENVH(JL))
        ZDELPT5=PAPHM15(JL,KKCRITH(JL))-PAPHM15(JL,KKENVH(JL))
        PTAU(JL,JK)=ZTAU(JL,KKENVH(JL)) +&
         & (((ZTAU (JL,KKCRITH(JL))-ZTAU (JL,KKENVH(JL)) )*&
         & ZDELP5 +&
         & (ZTAU5(JL,KKCRITH(JL))-ZTAU5(JL,KKENVH(JL)) )*&
         & ZDELP)* ZDELPT5-&
         & (ZTAU5(JL,KKCRITH(JL))-ZTAU5(JL,KKENVH(JL)) )*&
         & ZDELP5*ZDELPT) / ZDELPT5**2  
        PTAU5(JL,JK)=ZTAU5(JL,KKENVH(JL)) +&
         & (ZTAU5(JL,KKCRITH(JL))-ZTAU5(JL,KKENVH(JL)) )*&
         & ZDELP5/ZDELPT5  
      ENDIF
    ENDIF
  ENDDO
ENDDO

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