!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACDRAGL (KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PAPRS,PAPRSF,PDELP,PRDELP,&
 & PU,PV,PT,PQ,&
 ! - INPUT  1D .
 & PGETRL,PVRLAN,PVRLDI,PTS,PQS,&
 ! - OUTPUT 2D .
 & PSTRDU,PSTRDV,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACDRAGL * - SIMPLIFIED EFFECT OF OROGRAPHIC GRAVITY-WAVES.

!     Subject.
!     --------
!     - COMPUTATION OF OROGRAPHIC GRAVITY-WAVES' BREAKING EFFECTS ON
!       MOMENTUM - LINEAR PART OF COMPUTATION

!**   Interface.
!     ----------
!        *CALL* *ACDRAGL*

! -   ARGUMENTS FOR INPUT
!     -------------------

! - DIMENSIONAL PARAMETERS OF PHYSICS

! KIDIA      : START OF HORIZONTAL LOOP (IST in CPG).
! KFDIA      : END OF HORIZONTAL LOOP (IEND in CPG).
! KLON       : HORIZONTAL DIMENSIONAL.
! KTDIA      : START OF THE VERTICAL LOOP IN THE PHYSIC (1 IN GENERAL).
! KLEV       : END OF VERTICAL LOOP AND VERTICAL DIMENSION "FULL LEVEL".
!              (NFLEVG in CPG).

! - THE NAME OF THE PHYSICAL VARIABLES

! - 2D (0:KLEV) .

! PAPRS      : PRESSURE ON HALF LEVELS.
! PAPHI      : GEOPOTENTIAL ON HALF LEVELS.

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIAL ON FULL LEVELS.
! PAPRSF     : PRESSURE ON FULL LEVELS.
! PDELP      : LAYER THICKNESS IN PRESSURE UNITS.
! PRDELP     : INVERSE OF LAYER THICKNESS IN PRESSURE UNITS.
! PU         : X COMPONENT OF WIND.
! PV         : Y COMPONENT OF WIND.
! PT         : TEMPERATURE.
! PQ         : SPECIFIC HUMIDITY OF WATER VAPOUR.

! - 1D (GEOGRAPHIC) .

! PGETRL     : STANDARD DEVIATION OF OROGRAPHY (unit J/KG).
! PVRLAN     : ANISOTROPY OF THE RELIEF (1 = ISOTROPY).
! PVRLDI     : ANGLE OF MAXIMAL GRADIENT OF RELIEF WITH X-AXIS.

! - 1D (PROGNOSTIC) .

! PTS        : SURFACE TEMPERATURE.
! PQS        : SURFACE SPECIFIC HUMIDITY.

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

! -   ARGUMENTS FOR OUTPUT.
!     ----------------------

! - 2D (0:KLEV) .

! PSTRDU     : FLUX "GRAVITY WAVE DRAG" "U".
! PSTRDV     : FLUX "GRAVITY WAVE DRAG" "V".

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

! -   IMPLICIT ARGUMENTS.
!     ---------------------

! COMMON/YOMCST /
! COMMON/YOMPHY0/
! COMMON/YOMPHY/
! COMMON/YOMPHY2/
! COMMON/FCTTRM/

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

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

!     Method.
!     -------

!     Author.
!     -------
!       89-12, J.F. Geleyn

!     Modifications.
!     --------------
!        95-06, keeping only linear part of computation and including
!              of computation PNBVNO, PGWDCS  - M. Janiskova
!        96-05, GWDBC,GWDCD according to ACDRAG modification
!        97-08, introduce CDLOCK - J.M. Piriou.
!        99-10, suppression of USURIC - F. Bouyssel.
!        99-12, form drag set to zero (if LSMOOTHB=.T.) :  - F. Bouyssel.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMCST   , ONLY : RPI      ,RG       ,RD       ,RV       ,&
 & RCPD     ,RCPV     ,RKAPPA   ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD  
USE YOMPHY   , ONLY : LCVPP    ,LNEIGE
USE YOMPHY0  , ONLY : GWDBC    ,GWDCD    ,GWDSE    ,HOBST
USE YOMPHY2  , ONLY : TSPHY
USE YOMSIMPHL, ONLY : LSMOOTHB

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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGETRL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVRLAN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVRLDI(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRDU(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSTRDV(KLON,0:KLEV) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZNBVNO(KLON,0:KLEV),ZNFNO(KLON,0:KLEV),ZRAPP(KLON,0:KLEV)&
 & ,ZWGHT(KLON,0:KLEV)&
 & ,ZLSCPE(KLON,KLEV),ZQSAT(KLON,KLEV),ZLH(KLON,KLEV)&
 & ,ZR(KLON,KLEV),ZIPOI(KLON,KLEV),ZPOID(KLON,KLEV)&
 & ,ZU(KLON,KLEV),ZV(KLON,KLEV)  
REAL(KIND=JPRB) :: ZGWDCS(KLON),ZCP(KLON),ZFACS(KLON)&
 & ,ZOBST(KLON),ZRS(KLON)&
 & ,ZSTUS(KLON),ZSTVS(KLON)&
 & ,ZSUMD(KLON),ZSUMF(KLON),ZSUMU(KLON),ZSUMV(KLON)&
 & ,ZSUSR(KLON),ZUSR(KLON)&
 & ,ZUSUR(KLON),ZVSUR(KLON)&
 & ,ZAA(KLON),ZBB(KLON)  

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZA, ZALP1, ZALP2, ZALPHA, ZAUSR, ZAUX, ZCIS,&
 & ZD, ZDEL1, ZDEL2, ZDELTA, ZDPHI, ZDTETA, &
 & ZDU, ZDV, ZDX, ZEPS1, ZEPS2, ZEPS3, ZEPS5, &
 & ZEPS6, ZESP, ZEW, ZGDT, ZGDTI, ZPBL, ZPBLF, &
 & ZPRRAP, ZRTI, ZRVMD, ZRZ, ZSTA, ZTUNE, ZUSTAR, &
 & ZVSTAR, ZX  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttrm.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (LHOOK) CALL DR_HOOK('ACDRAGL',0,ZHOOK_HANDLE)
IF(CDLOCK /= 'ACDRAGL') CALL ABOR1('BAD NUMBER OF ARGUMENTS!')

!*
!     ------------------------------------------------------------------
!     I - COMPUTATION OF DERIVED PARAMETERS, SECURITY CONSTANTS (FOR THE
!     ANISOTROPY FACTOR, THE SQUARE OF THE WIND SPEED, THE NORMALISED
!     STATIC STABILITY AND A PRECISION THRESHOLD FOR RECOMPUTED
!     PRESSURES) AS WELL AS LIMIT ARGUMENT FOR THE SINE FUNCTION.

ZGDT=RG*TSPHY
ZGDTI=1.0_JPRB/ZGDT

!     THE 'ALP' AND 'DEL' VALUES ARE RESULTING FROM ANALYTICAL FITS OF
!     ELLIPTIC INTEGRALS FOR THE ANISOTROPIC CASE.

ZALP1=0.75_JPRB+0.25_JPRB*LOG(16._JPRB)
ZALP2=3.5_JPRB*RPI-LOG(16._JPRB)-8._JPRB
ZDEL1=2.75_JPRB-0.75_JPRB*LOG(16._JPRB)
ZDEL2=-0.25_JPRB*RPI-LOG(16._JPRB)+4._JPRB

ZEPS1=1.E-06_JPRB
ZEPS2=1.E-04_JPRB
ZEPS3=1.E-09_JPRB
ZEPS5=1.E-06_JPRB
ZEPS6=1.E-08_JPRB

!*
!     ----------------------------------------------------------------
!     II - COMPUTATION OF SPECIFIC HUMIDITY OF SATURATION AND
!     EFFECTIVE RATIO OF L AND Cp FOR CONDENSATION/EVAPORATION,
!     COMPUTATION OF GASS CONSTANT FOR AIR

! - TEMPORARY(S) 2D (1:KLEV) .

! ZLH       : LATENT HEAT
! ZQSAT     : SPECIFIC HUMIDITY OF SATURATION
! ZLSCPE    : EFFECTIVE RATIO OF L AND Cp FOR CONDENSATION/EVAPORATION
! ZR       : GASS CONSTANT FOR AIR

! - TEMPORARY 1D

! ZCP       : VALUE OF ATMOSPHERIC Cp

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA

    ZR(JLON,JLEV)=RD*(1.0_JPRB-PQ(JLON,JLEV))+RV*PQ(JLON,JLEV)
    ZCP(JLON)=RCPD*(1.0_JPRB-PQ(JLON,JLEV))+RCPV*PQ(JLON,JLEV)

!     SNOW OPTION DEPENDENT COMPUTATIONS.

    IF (LNEIGE) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PT(JLON,JLEV)))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF

!     CALL TO THE DEFINED FUNCTION TO COMPUTE LH.

    ZLH(JLON,JLEV)= FOLH (PT(JLON,JLEV),ZDELTA)

!     COMPUTATION OF EFFECTIVE RATIO OF L AND Cp FOR COND./EVAP.

    ZLSCPE(JLON,JLEV)=ZLH(JLON,JLEV)/ZCP(JLON)

!     COMPUTATION OF Qsat(PT)

    ZEW= FOEW (PT(JLON,JLEV),ZDELTA)
    ZESP=ZEW/PAPRSF(JLON,JLEV)
    ZQSAT(JLON,JLEV)= FOQS (ZESP)

  ENDDO
ENDDO

!*
!     -----------------------------------------------------------------
!     III - COMPUTATION OF ONE OVER G TIME THE BRUNT-VAISALA FREQUENCY
!     DIVIDED BY DENSITY THE WHOLE BEING SQUARED AS WELL AS DENSITY
!     FOR G.W.D.

! - TEMPORARY(S) 2D (0:KLEV) .

! ZNBVNO    : SQUARE OF BRUNT-VAISALA FR. DIVIDED BY G AND DENSITY

! - TEMPORARY 1D

! ZGWDCS    : DENSITY AT THE SURFACE FOR OROGRAPHIC DRAG.
! ZRS       : GASS CONSTANT FOR AIR AT THE SURFACE

ZRVMD=RV-RD

DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA

    ZDPHI=PAPHIF(JLON,JLEV)-PAPHIF(JLON,JLEV+1)
    ZCIS=MAX(ZEPS2,(PU(JLON,JLEV)-PU(JLON,JLEV+1))**2+(PV(JLON,&
     & JLEV)&
     & -PV(JLON,JLEV+1))**2)  

!     PRELIMINARY STABILITY COMPUTATION.

    ZDTETA=ZR(JLON,JLEV)*PT(JLON,JLEV)-ZR(JLON,JLEV+1)*PT(JLON,&
     & JLEV+1)&
     & +RKAPPA*ZDPHI  

!     CORRECTION FOR SHALLOW CONVECTION (OPTIONAL).

    IF (LCVPP) THEN
      ZAUX=MIN(0.0_JPRB,PQ(JLON,JLEV)-ZQSAT(JLON,JLEV)-PQ(JLON,JLEV+1)&
       & +ZQSAT(JLON,JLEV+1))*(0.5_JPRB*(ZLSCPE(JLON,JLEV)&
       & +ZLSCPE(JLON,JLEV+1)))*MAX(0.0_JPRB,SIGN(1.0_JPRB,RD &
       & *(PQ(JLON,JLEV+1)-PQ(JLON,JLEV)+(ZQSAT(JLON,JLEV)&
       & -ZQSAT(JLON,JLEV+1))*PAPRS(JLON,JLEV)/PAPRS(JLON,KLEV))&
       & *(0.5_JPRB*(ZLSCPE(JLON,JLEV)+ZLSCPE(JLON,JLEV+1)))-ZDTETA))  
    ELSE
      ZAUX=0.0_JPRB
    ENDIF

!     STABILITY COMPUTATION.

    ZRTI=2.0_JPRB/(ZR(JLON,JLEV)*PT(JLON,JLEV)+ZR(JLON,JLEV+1)*PT(JLON,JLEV+1))
    ZSTA=ZDPHI*(ZDTETA+RD*ZAUX)*ZRTI

!     COMPUTATION OF ONE OVER G TIME THE BRUNT-VAISALA FREQUENCY DIVIDED
!     BY DENSITY THE WHOLE BEING SQUARED.

    ZNBVNO(JLON,JLEV)=ZSTA/(PAPRS(JLON,JLEV)*ZRTI*ZDPHI)**2

  ENDDO
ENDDO

DO JLON=KIDIA,KFDIA

  ZDPHI=PAPHIF(JLON,KLEV)-PAPHI(JLON,KLEV)

  ZRS(JLON)=RD+ZRVMD*PQS(JLON)
  ZCIS=MAX(ZEPS2,PU(JLON,KLEV)**2+PV(JLON,KLEV)**2)

!     STABILITY COMPUTATION.

  ZRTI=2.0_JPRB/(ZR(JLON,KLEV)*PT(JLON,KLEV)+RKAPPA*ZDPHI+ZRS(JLON)*PTS(JLON))
  ZSTA=ZDPHI*(ZR(JLON,KLEV)*PT(JLON,KLEV)+RKAPPA &
   & *ZDPHI-ZRS(JLON)*PTS(JLON))*ZRTI  

!     COMPUTATION OF ONE OVER G TIME THE BRUNT-VAISALA FREQUENCY DIVIDED
!     BY DENSITY THE WHOLE BEING SQUARED AS WELL AS DENSITY (FOR G.W.D.)

  ZNBVNO(JLON,KLEV)=ZSTA/(PAPRS(JLON,KLEV)*ZRTI*ZDPHI)**2
  ZGWDCS(JLON)=PAPRS(JLON,KLEV)*ZRTI
ENDDO

!*
!     ------------------------------------------------------------------
!     IV - PRELIMINARY COMPUTATIONS FOR THE LAYER'S PRESSURE THICKNESS
!     DIVIDED BY G*DT AND ITS INVERSE FOR ALL LEVELS AS WELL AS SETTING
!     TO ZERO THE WEIGHTS FOR THE INTEGRAL OVER THE DEPTH OF THE
!     OROGRAPHIC OBSTACLE.

! - TEMPORARY(S) 2D (1:KLEV) .

! ZPOID     : DP/(RG*DT) FOR A GIVEN LEVEL AND A GIVEN TIME STEP.
! ZIPOI     : INVERSE OF ZPOID.
! ZWGHT     : WEIGHTS FOR THE INTEGRAL OVER THE DEPTH OF THE OBSTACLE.

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZPOID(JLON,JLEV)=PDELP(JLON,JLEV)*ZGDTI
    ZIPOI(JLON,JLEV)=PRDELP(JLON,JLEV)*ZGDT
    ZWGHT(JLON,JLEV)=0.0_JPRB
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     V - SURFACE COMPUTATIONS AND INITIALIZATION FOR THE ASCENDING
!     LOOP.

! - TEMPORARY(S) 2D (0:KLEV) .

! ZNFNO     : NORMALISED EFECTIVE BRUNT-VAISALA FREQUENCY (N/RHO/G).
! ZRAPP     : RATIO OF THE UPPER AIR FLUX TO THE SURFACE ONE.
! ZU        : X COMPONENT OF THE EFFECTIVE WIND.
! ZV        : Y COMPONENT OF THE EFFECTIVE WIND.

!     VERTICAL AVERAGING OVER THE THICKNESS OF THE OROGRAPHIC OBSTACLE
!     AND CALCULATION OF THE EFFECTIVE VALUES (WIND AND STABILITY)
!     THROUGH LINEAR COMBINATIONS BETWEEN THE AVERAGES (CHOSEN AT THE
!     SURFACE) AND THE ORIGINAL VALUES (OBTAINED AGAIN AT THE EFFECTIVE
!     HEIGHT OF THE OBSTACLE).

! - TEMPORARY(S) 1D .

! ZOBST     : EFFECTIVE HEIGHT OF THE OBSTACLE IN PRESSURE COORDINATE.
! ZSUMF     : AVERAGED VALUE FOR A SQUARED "N/RHO/G" (<0 ACCEPTED).
! ZSUMU     : AVERAGED VALUE FOR THE "U" WIND.
! ZSUMV     : AVERAGED VALUE FOR THE "V" WIND.

!     WEIGHTED SUMMATION.

DO JLON=KIDIA,KFDIA
  ZOBST(JLON)=MIN(PAPRS(JLON,KLEV)&
   & -PAPRSF(JLON,KTDIA),MAX(PAPRS(JLON,KLEV)&
   & -PAPRSF(JLON,KLEV),HOBST*PGETRL(JLON)*ZGWDCS(JLON)))  
  ZWGHT(JLON,KLEV)=(PAPRS(JLON,KLEV)-PAPRSF(JLON,KLEV))/ZOBST(JLON)
  ZSUMU(JLON)=ZWGHT(JLON,KLEV)*PU(JLON,KLEV)
  ZSUMV(JLON)=ZWGHT(JLON,KLEV)*PV(JLON,KLEV)
  ZSUMF(JLON)=ZWGHT(JLON,KLEV)*ZNBVNO(JLON,KLEV)
ENDDO

DO JLEV=KLEV-1,KTDIA,-1

  DO JLON=KIDIA,KFDIA

    ZWGHT(JLON,JLEV)=MAX(0.0_JPRB,(PAPRSF(JLON,JLEV+1)&
     & -MAX(PAPRSF(JLON,JLEV),PAPRS(JLON,KLEV)&
     & -ZOBST(JLON)))/ZOBST(JLON))  
    ZSUMU(JLON)=ZSUMU(JLON)+0.5_JPRB*ZWGHT(JLON,JLEV)*(PU(JLON,JLEV)&
     & +PU(JLON,JLEV+1))  
    ZSUMV(JLON)=ZSUMV(JLON)+0.5_JPRB*ZWGHT(JLON,JLEV)*(PV(JLON,JLEV)&
     & +PV(JLON,JLEV+1))  
    ZSUMF(JLON)=ZSUMF(JLON)+ZWGHT(JLON,JLEV)*ZNBVNO(JLON,JLEV)
  ENDDO

ENDDO

!     LINEAR COMBINATION.

DO JLON=KIDIA,KFDIA
  ZNFNO(JLON,KLEV)=SQRT(MAX(0.0_JPRB,ZSUMF(JLON)))
  ZPBLF=1.0_JPRB-MIN(1.0_JPRB,(PAPRS(JLON,KLEV)-PAPRSF(JLON,KLEV))/ZOBST(JLON))
  ZU(JLON,KLEV)=PU(JLON,KLEV)+ZPBLF*(ZSUMU(JLON)-PU(JLON,KLEV))
  ZV(JLON,KLEV)=PV(JLON,KLEV)+ZPBLF*(ZSUMV(JLON)-PV(JLON,KLEV))
ENDDO

DO JLEV=KLEV-1,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    ZPBL=1.0_JPRB-MIN(1.0_JPRB,(PAPRS(JLON,KLEV)-PAPRS(JLON,JLEV))/ZOBST(JLON))
    ZNFNO(JLON,JLEV)=SQRT(MAX(0.0_JPRB,ZNBVNO(JLON,JLEV)+ZPBL &
     & *(ZSUMF(JLON)-ZNBVNO(JLON,JLEV))))  
    ZPBLF=1.0_JPRB-MIN(1.0_JPRB,(PAPRS(JLON,KLEV)-PAPRSF(JLON,JLEV))/ZOBST(JLON))
    ZU(JLON,JLEV)=PU(JLON,JLEV)+ZPBLF*(ZSUMU(JLON)-PU(JLON,JLEV))
    ZV(JLON,JLEV)=PV(JLON,JLEV)+ZPBLF*(ZSUMV(JLON)-PV(JLON,JLEV))
  ENDDO
ENDDO

DO JLON=KIDIA,KFDIA

!     COMPUTATION OF A FICTITIOUS WIND THAT WOULD CORRESPOND, IN THE
!     ISOTROPIC CASE, TO THE ANISOTROPIC DRAG.

! - TEMPORARY(S) 1D .

! ZUSUR     : X COMPONENT OF THE FICTITIOUS SURFACE WIND.
! ZVSUR     : Y COMPONENT OF THE FICTITIOUS SURFACE WIND.

  ZUSTAR=ZSUMU(JLON)*COS(2.0_JPRB*PVRLDI(JLON))+ZSUMV(JLON)*SIN(2.0_JPRB &
   & *PVRLDI(JLON))  
  ZVSTAR=ZSUMU(JLON)*SIN(2.0_JPRB*PVRLDI(JLON))-ZSUMV(JLON)*COS(2.0_JPRB &
   & *PVRLDI(JLON))  
  ZA=PVRLAN(JLON)**2+0.5_JPRB*(4._JPRB*(1.0_JPRB-PVRLAN(JLON))*(1.0_JPRB+ZALP1 &
   & *PVRLAN(JLON))+PVRLAN(JLON)*LOG(1.0_JPRB/MAX(ZEPS1,PVRLAN(JLON)))&
   & *(1.0_JPRB+ZALP2*PVRLAN(JLON)))/RPI  
  ZD=0.5_JPRB*(4._JPRB*(1.0_JPRB-PVRLAN(JLON))*(1.0_JPRB+ZDEL1*PVRLAN(JLON))-3._JPRB &
   & *PVRLAN(JLON)*LOG(1.0_JPRB/MAX(ZEPS1,PVRLAN(JLON)))*(1.0_JPRB+ZDEL2 &
   & *PVRLAN(JLON)))/RPI  
  ZUSUR(JLON)=ZA*ZSUMU(JLON)+ZD*ZUSTAR
  ZVSUR(JLON)=ZA*ZSUMV(JLON)+ZD*ZVSTAR

!     "LINEAR" PART OF THE COMPUTATION.

! - TEMPORARY(S) 1D .

! ZUSR      : SPEED OF FICTITIOUS SURFACE WIND.
! ZFACS     : SURFACE FACTOR FOR THE COMPUTATION OF ZRAPP.
! ZSTUS     : "LINEAR" VALUE OF THE "U" SURFACE FLUX.
! ZSTVS     : "LINEAR" VALUE OF THE "V" SURFACE FLUX.
! ZSUSR     : SURF. SCALAR PRODUCT OF EFFECTIVE AND FICITIOUS WINDS.

  ZSUSR(JLON)=MAX(ZEPS2,ZSUMU(JLON)*ZUSUR(JLON)+ZSUMV(JLON)*ZVSUR(JLON))
  ZUSR(JLON)=MAX(0.0_JPRB,SQRT(ZUSUR(JLON)**2+ZVSUR(JLON)**2))
  ZFACS(JLON)=ZNFNO(JLON,KLEV)/ZSUSR(JLON)**3
  ZRAPP(JLON,KLEV)=1.0_JPRB
  ZSTUS(JLON)=GWDSE*ZGWDCS(JLON)**2*ZNFNO(JLON,KLEV)*PGETRL(JLON)*ZUSUR(JLON)
  ZSTVS(JLON)=GWDSE*ZGWDCS(JLON)**2*ZNFNO(JLON,KLEV)*PGETRL(JLON)*ZVSUR(JLON)

  ZTUNE=GWDBC*(ZUSR(JLON)**2/ZSUSR(JLON))**2
  ZBB(JLON)=MAX(0.0_JPRB,1.0_JPRB-ZUSR(JLON)/MAX(ZEPS5,ZTUNE &
   & *HOBST*PGETRL(JLON)*ZGWDCS(JLON)&
   & *ZNFNO(JLON,KLEV)))  
  ZAA(JLON)=GWDCD*ZTUNE*ZBB(JLON)*(1.0_JPRB-ZBB(JLON))
  IF (LSMOOTHB) ZAA(JLON)=0.0_JPRB
ENDDO

!*
!     ------------------------------------------------------------------
!     VI - ASCENDING COMPUTATIONS OF THE LINEAR ESTIMATE OF THE RELATIVE
!     FLUX AND CHECKING OF THE FIRST LEVELS OF DEPOSITION AND OF
!     REFLEXION (IF THE LATTER EXISTS).

!     COMPUTATIONS IN THE VERTICAL LOOP.

DO JLEV=KLEV-1,KTDIA,-1
  DO JLON=KIDIA,KFDIA

!     "LINEAR" PART OF THE COMPUTATION.

    ZAUSR=0.5_JPRB*((ZU(JLON,JLEV)+ZU(JLON,JLEV+1))*ZUSUR(JLON)&
     & +(ZV(JLON,JLEV)+ZV(JLON,JLEV+1))*ZVSUR(JLON))  
    ZPRRAP=ZFACS(JLON)*ZAUSR**3/MAX(ZEPS3,ZNFNO(JLON,JLEV))
    ZRAPP(JLON,JLEV)=MAX(0.0_JPRB,MIN(ZRAPP(JLON,JLEV+1),ZPRRAP))
  ENDDO
ENDDO

!     UPPER BOUNDARY CONDITION AND PREPARATION OF THE DESCENDING LOOP.

DO JLON=KIDIA,KFDIA

!     "LINEAR" PART OF THE COMPUTATION.

  PSTRDU(JLON,KTDIA-1)=0.0_JPRB
  PSTRDV(JLON,KTDIA-1)=0.0_JPRB
  ZRAPP(JLON,KTDIA-1)=0.0_JPRB
ENDDO

!*
!     ------------------------------------------------------------------
!     VII - DESCENDING LOOP FOR THE COMBINATION OF EFFECTS AND THE
!     NUMERICAL SECURITIES LEADING TO THE FINAL FLUX CALCULATION.

!     PROVISIONAL FLUXES TAKING INTO ACOUNT ALL THREE EFFECTS.

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZRAPP(JLON,JLEV)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZRAPP(JLON,JLEV)))
    ZRZ=MIN(1.0_JPRB,(PAPRS(JLON,KLEV)-PAPRS(JLON,JLEV))&
     & /MAX(ZEPS6,ZBB(JLON)*HOBST*PGETRL(JLON)&
     & *ZGWDCS(JLON)))  
    ZRAPP(JLON,JLEV)=ZRAPP(JLON,JLEV)*(1.0_JPRB+ZAA(JLON)&
     & *SQRT(MAX(ZEPS6,(1.0_JPRB-ZRZ)**3/(1.0_JPRB+ZRZ &
     & *ZBB(JLON)))))  
    PSTRDU(JLON,JLEV)=ZRAPP(JLON,JLEV)*ZSTUS(JLON)
    PSTRDV(JLON,JLEV)=ZRAPP(JLON,JLEV)*ZSTVS(JLON)
  ENDDO
ENDDO

!     PSEUDO-IMPLICIT ALGORITHM WITH RESPECT TO THE EFFECTIVE SURFACE
!     WIND PROJECTED ON THE STRESS DIRECTION.

! - TEMPORARY(S) 1D .

! ZSUMD     : AVERAGED WIND TENDENCIES PROJECTED ON THE STRESS' DIREC..

!     SUMMATION FOR A TEMPORARY NORMALISED AVERAGE OF TENDENCIES.

DO JLON=KIDIA,KFDIA
  ZSUMD(JLON)=0.5_JPRB*ZWGHT(JLON,KTDIA)*ZIPOI(JLON,KTDIA)&
   & *(ZRAPP(JLON,KTDIA)-ZRAPP(JLON,KTDIA-1))  
ENDDO

DO JLEV=KTDIA+1,KLEV
  DO JLON=KIDIA,KFDIA
    ZSUMD(JLON)=ZSUMD(JLON)+0.5_JPRB*(ZWGHT(JLON,JLEV)&
     & +ZWGHT(JLON,JLEV-1))*ZIPOI(JLON,JLEV)&
     & *(ZRAPP(JLON,JLEV)-ZRAPP(JLON,JLEV-1))  
  ENDDO
ENDDO

DO JLON=KIDIA,KFDIA
  ZSUMD(JLON)=ZSUMD(JLON)+0.5_JPRB*ZWGHT(JLON,KLEV)*ZIPOI(JLON,KLEV)&
   & *(ZRAPP(JLON,KLEV)-ZRAPP(JLON,KLEV-1))  
ENDDO

!     FINAL AVERAGED VALUE, LINEAR REDUCTION FACTOR AND ITS USE.

DO JLON=KIDIA,KFDIA
  ZSUMD(JLON)=ZSUMD(JLON)*MAX(0.0_JPRB,SQRT(ZSTUS(JLON)**2+ZSTVS(JLON)**2))
  ZRAPP(JLON,KLEV)=1.0_JPRB/(1.0_JPRB+ZSUMD(JLON)*ZUSR(JLON)/ZSUSR(JLON))
ENDDO

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    PSTRDU(JLON,JLEV)=PSTRDU(JLON,JLEV)*ZRAPP(JLON,KLEV)
    PSTRDV(JLON,JLEV)=PSTRDV(JLON,JLEV)*ZRAPP(JLON,KLEV)
  ENDDO
ENDDO

!     NUMERICAL SECURITY (USE OF AN ALGORITHM INSPIRED BY THE ONE OF THE
!     MASS-FLUX TYPE DEEP CONVECTION ROUTINES).

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZDU=ZIPOI(JLON,JLEV)*(PSTRDU(JLON,JLEV-1)-PSTRDU(JLON,JLEV))
    ZDV=ZIPOI(JLON,JLEV)*(PSTRDV(JLON,JLEV-1)-PSTRDV(JLON,JLEV))
    ZDX=ZIPOI(JLON,JLEV)*(ZUSUR(JLON)*PSTRDU(JLON,JLEV)+&
     & ZVSUR(JLON)&
     & *PSTRDV(JLON,JLEV))  
    ZX=ZUSUR(JLON)*PU(JLON,JLEV)+ZVSUR(JLON)*PV(JLON,JLEV)
    ZALPHA=1.0_JPRB/(1.0_JPRB+ZDX/MAX(ZEPS2,ZX))
    PSTRDU(JLON,JLEV)=PSTRDU(JLON,JLEV-1)-ZPOID(JLON,JLEV)*ZALPHA*ZDU
    PSTRDV(JLON,JLEV)=PSTRDV(JLON,JLEV-1)-ZPOID(JLON,JLEV)*ZALPHA*ZDV
  ENDDO
ENDDO

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