!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACQWLSRTL ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PQ5,PT5,PAPRSF5,PDELP5,&
 & PQ,PT,PAPRSF,PDELP,&
 ! - OUTPUT 2D .
 & PFPLSL5,PFPLSN5,&
 & PFPLSL,PFPLSN,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACQWLSRTL* - TANGENT LINEAR COMPUTATION OF WET-BULB
!                  CHARACTERISTICS AND LSR.

!     Subject.
!     --------
!     Tangent linear computation of:
!     - SATURATION POINT AND WET-BULB CHARACTERISTICS .
!     - STRATIFORM PRECIPITATION FLUXES (WATER AND SNOW) .

!**   Interface.
!     ----------
!        *CALL* *ACQWLSRTL*

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

! -   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 DIMENSION.
! KTDIA      : START OF THE VERTICAL LOOP IN THE PHYSICS (1 IN GENERAL).
! KLEV       : END OF VERTICAL LOOP AND VERTICAL DIMENSION (NFLEVG in CPG).

! - THE NAME OF THE PHYSICAL VARIABLES

! - 2D (1:KLEV) .

! PAPRSF     : PRESSURE ON FULL LEVELS.
! PQ         : SPECIFIC HUMIDITY OF WATER VAPOR.
! PT         : TEMPERATURE.
! PAPRS      : PRESSION ON HALF LEVELS.
! PDELP      : LAYER THICKNESS IN PRESSURE UNITS.

! The same but for trajectory
! ---------------------------
! PAPRSF5    : PRESSURE ON FULL LEVELS.
! PQ5        : SPECIFIC HUMIDITY OF WATER VAPOR.
! PT5        : TEMPERATURE.
! PAPRS5     : PRESSION ON HALF LEVELS.
! PDELP5     : LAYER THICKNESS IN PRESSURE UNITS.

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

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

! - 2D (0:KLEV) .

! PFPLSL     : STRATIFORM PRECIPITATION AS RAIN.
! PFPLSN     : STRATIFORM PRECIPITATION AS SNOW.

! The same but for trajectory
! ---------------------------
! PFPLSL5    : STRATIFORM PRECIPITATION AS RAIN.
! PFPLSN5    : STRATIFORM PRECIPITATION AS SNOW.

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

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

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

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

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

!     Method.
!     -------

!     Author.
!     -------
!        95-05-11  M. Janiskova

!     Modifications.
!     --------------
!        97-08, introduce CDLOCK - J.M. Piriou.
!        99-12, no evaporation under rain (if LSMOOTHB=.T.) - F. Bouyssel.
!        03-06, move rnlcurv rnegat into yomphy0 (F. Bouyssel, C. Fischer)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMPHY   , ONLY : NBITER   ,LNEIGE
USE YOMPHY0  , ONLY : RNEGAT   ,RNLCURV
USE YOMPHY2  , ONLY : TSPHY
USE YOMCST   , ONLY : RG       ,RV       ,RCPD     ,RCPV     ,&
 & RETV     ,RCW      ,RCS      ,RLVTT    ,RLSTT    ,&
 & RTT      ,RALPW    ,RBETW    ,RGAMW    ,RALPS    ,&
 & RBETS    ,RGAMS    ,RALPD    ,RBETD    ,RGAMD  
USE YOMSIMPHL, ONLY : LSMOOTHA ,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)    :: PQ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLSL5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLSN5(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLSL(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLSN(KLON,0:KLEV) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZCP(KLON),ZZLH(KLON),ZQWI(KLON)&
 & ,ZLH(KLON,KLEV),ZQSAT(KLON,KLEV)&
 & ,ZPQW(KLON,KLEV),ZTW(KLON,KLEV)  
REAL(KIND=JPRB) :: ZPOID(KLON,KLEV),ZDQ(KLON),ZFPT(KLON,KLEV)

REAL(KIND=JPRB) :: ZCP5(KLON),ZZLH5(KLON),ZQWI5(KLON)&
 & ,ZLH5(KLON,KLEV),ZQSAT5(KLON,KLEV)&
 & ,ZPQW5(KLON,KLEV),ZTW5(KLON,KLEV)  
REAL(KIND=JPRB) :: ZPOID5(KLON,KLEV),ZDQ5(KLON),ZFPT5(KLON,KLEV)

INTEGER(KIND=JPIM) :: JIT, JLEV, JLON

REAL(KIND=JPRB) :: ZABS5, ZCPVMS, ZCPVMW, ZDCP, ZDELQ, ZDELQ5,&
 & ZDELT, ZDELT5, ZDELTA, ZDLEW, ZDLEW5, ZDQW, &
 & ZDQW5, ZESP, ZESP5, ZEW, ZEW5, ZGDTI, ZLOG2COSH5, &
 & ZNLMINQ, ZQ5, ZQW, ZQW5  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttrm.h"
#include "fcttrmtl.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

!*
!     ------------------------------------------------------------------
!     I - AUXILIARY CONSTANTS.

ZCPVMW=RCPV-RCW
ZCPVMS=RCPV-RCS

!*
!     ------------------------------------------------------------------
!     II - PASSIVE LOOP ON VERTICAL LEVELS.

DO JLEV=KTDIA,KLEV

!*
!     ------------------------------------------------------------------
!     III - COMPUTATION OF THE LOCAL ATMOSPHERIC LATENT HEAT.

  DO JLON=KIDIA,KFDIA

!     SNOW OPTION DEPENDENT COMPUTATIONS.

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

!     CALL TO THE DEFINED FUNCTION TO COMPUTE LH.

    ZLH5(JLON,JLEV)= FOLH (PT5(JLON,JLEV),ZDELTA)
    ZLH(JLON,JLEV)= FOLHTL (PT(JLON,JLEV),ZDELTA)

  ENDDO

!*
!     ------------------------------------------------------------------
!     IV - INITIALIZATION OF THE VARIABLES IN THE NEWTON LOOP, THE
!     TEMPORARY CP AND LH VALUES HAVING TO EVOLVE AT THE SAME TIME AS
!     THE ITERATIVE TW AND QW.

! - TEMPORARY 1D .

! ZCP       : CURRENT VALUE OF ATMOSPHERIC CP DURING THE "NBITER" LOOP.
! ZLH       : AS ZCP BUT FOR THE LATENT HEAT.

! The same but for trajectory
! ---------------------------
! ZCP5      : CURRENT VALUE OF ATMOSPHERIC CP DURING THE "NBITER" LOOP.
! ZLH5      : AS ZCP5 BUT FOR THE LATENT HEAT.

  DO JLON=KIDIA,KFDIA
    ZPQW5(JLON,JLEV)=PQ5(JLON,JLEV)
    ZPQW(JLON,JLEV)=PQ(JLON,JLEV)

    ZCP5(JLON)=RCPD*(1.0_JPRB-PQ5(JLON,JLEV))+RCPV*PQ5(JLON,JLEV)
    ZCP(JLON)=RCPD*(-PQ(JLON,JLEV))+RCPV*PQ(JLON,JLEV)

    ZTW5(JLON,JLEV)=PT5(JLON,JLEV)
    ZTW(JLON,JLEV)=PT(JLON,JLEV)

    ZZLH5(JLON)=ZLH5(JLON,JLEV)
    ZZLH(JLON)=ZLH(JLON,JLEV)
  ENDDO

!*
!     ------------------------------------------------------------------
!     V - NEWTON LOOP FOR THE "WET BULB" POINT.

  DO JIT=1,NBITER
    DO JLON=KIDIA,KFDIA

!     SNOW OPTION DEPENDENT COMPUTATIONS.

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

!     SATURATION CALCULATIONS USING THE DEFINED FUNCTIONS AND TEMPORARY
!     STORAGE OF QSAT(TW).

! - TEMPORARY 1D .

! ZQWI      : CURRENT VALUE OF ZQW TO BE REUSED AS QSAT AT JIT=1.

! The same but for trajectory
! ---------------------------
! ZQWI5     : CURRENT VALUE OF ZQW TO BE REUSED AS QSAT AT JIT=1.

      ZEW5= FOEW (ZTW5(JLON,JLEV),ZDELTA)
      ZEW= FOEWTL (ZTW(JLON,JLEV),ZTW5(JLON,JLEV),ZDELTA)

      ZESP5=ZEW5/PAPRSF5(JLON,JLEV)
      ZESP=ZEW/PAPRSF5(JLON,JLEV)&
       & -(ZEW5/PAPRSF5(JLON,JLEV)**2)*PAPRSF(JLON,JLEV)  

      ZQW5= FOQS (ZESP5)
      IF ((1.0_JPRB-ZESP5) > 0.0_JPRB) THEN
        ZQW= FOQSTL1 (ZESP,ZESP5)
      ELSE
        ZQW= FOQSTL2 (ZESP,ZESP5)
      ENDIF

      ZDLEW5=FODLEW (ZTW5(JLON,JLEV),ZDELTA)
      ZDLEW=FODLEWTL (ZTW(JLON,JLEV),ZTW5(JLON,JLEV),ZDELTA)
      ZDQW5= FODQS (ZQW5,ZESP5,ZDLEW5)
      ZDQW= FODQSTL (ZQW,ZQW5,ZESP,ZESP5,ZDLEW,ZDLEW5)

      ZQWI5(JLON)=ZQW5
      ZQWI(JLON)=ZQW

!     INCREMENTATIONS.

      ZDCP=ZCPVMW+ZDELTA*(ZCPVMS-ZCPVMW)
      ZDELQ5=(ZQW5-ZPQW5(JLON,JLEV))*ZCP5(JLON)&
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)  
      ZDELQ=ZCP5(JLON)*ZQW/(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)&
       & -ZCP5(JLON)*ZPQW(JLON,JLEV)&
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)&
       & +(ZQW5-ZPQW5(JLON,JLEV))*ZCP(JLON)&
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)&
       & -(ZQW5-ZPQW5(JLON,JLEV))*ZCP5(JLON)*ZCP(JLON)&
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)**2 &
       & -(ZQW5-ZPQW5(JLON,JLEV))*ZCP5(JLON)*ZDQW5*ZZLH(JLON)&
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)**2 &
       & -(ZQW5-ZPQW5(JLON,JLEV))*ZCP5(JLON)*ZZLH5(JLON)*ZDQW &
       & /(ZCP5(JLON)+ZZLH5(JLON)*ZDQW5)**2  

      ZCP5(JLON)=ZCP5(JLON)+ZDCP*ZDELQ5
      ZCP(JLON)=ZCP(JLON)+ZDCP*ZDELQ

      ZDELT5=-ZDELQ5*ZZLH5(JLON)/ZCP5(JLON)
      ZDELT=-ZZLH5(JLON)*ZDELQ/ZCP5(JLON)&
       & -ZDELQ5*ZZLH(JLON)/ZCP5(JLON)&
       & +ZDELQ5*ZZLH5(JLON)*ZCP(JLON)/ZCP5(JLON)**2  

      ZZLH5(JLON)=ZZLH5(JLON)+ZDCP*ZDELT5
      ZZLH(JLON)=ZZLH(JLON)+ZDCP*ZDELT

      ZPQW5(JLON,JLEV)=ZPQW5(JLON,JLEV)+ZDELQ5
      ZPQW(JLON,JLEV)=ZPQW(JLON,JLEV)+ZDELQ

      ZTW5(JLON,JLEV)=ZTW5(JLON,JLEV)+ZDELT5
      ZTW(JLON,JLEV)=ZTW(JLON,JLEV)+ZDELT
    ENDDO

!     SAVING THE SATURATION HUMIDITY AFTER THE FIRST ITERATION.

    IF (JIT == 1) THEN
      DO JLON=KIDIA,KFDIA
        ZQSAT5(JLON,JLEV)=ZQWI5(JLON)
        ZQSAT(JLON,JLEV)=ZQWI(JLON)
      ENDDO
    ENDIF

  ENDDO

!*
!     ------------------------------------------------------------------

!     VI - END OF THE VERTICAL LOOP.

ENDDO

!*
!     ------------------------------------------------------------------
!     VII - COMPUTATION OF DERIVED PARAMETERS
!           (FOR THE PRECIPITATION FLUXES).

ZGDTI=1.0_JPRB/(RG*TSPHY)

!*
!     ------------------------------------------------------------------

!     VIII - INITIALIZATION OF THE FIELDS OF PRECIPITATION.

! - TEMPORARY 2D .

! ZFPT      : TOTAL PRECIPITATION FLUX AT THE LAYER.

! The same but for trajectory
! ---------------------------
! ZFPT5     : TOTAL PRECIPITATION FLUX AT THE LAYER.

DO JLON=KIDIA,KFDIA
  PFPLSL5(JLON,KTDIA-1)=0.0_JPRB
  PFPLSL(JLON,KTDIA-1)=0.0_JPRB
  PFPLSN5(JLON,KTDIA-1)=0.0_JPRB
  PFPLSN(JLON,KTDIA-1)=0.0_JPRB
  ZFPT5(JLON,KTDIA)=0.0_JPRB
  ZFPT(JLON,KTDIA)=0.0_JPRB
ENDDO

!*
!     ------------------------------------------------------------------
!     IX - EFFECTIVE CALCULATIONS IN A VERTICAL LOOP WHERE THE
!     INFORMATION IS PASSED FROM LAYER TO LAYER.

DO JLEV=KTDIA,KLEV

!     PRELIMINARY COMPUTATIONS ("WET BULB" CORRECTION FOR Q AND INVERSE
!     OF THE PRESSURE AT BOUNDARIES, THE LAYER'S PRESSURE THICKNESS
!     DIVIDED BY G*DT FOR ALL LEVELS)  AND PROVISIONAL FLUX

! - TEMPORARY 1D .

! ZDQ       : CORRECTION OF Q TO REACH THE SATURATION BALANCE.

! The same but for trajectory
! ---------------------------
! ZDQ5      : CORRECTION OF Q TO REACH THE SATURATION BALANCE.

! - TEMPORARY 2D (1:KLEV) .

! ZPOID     : DP/(RG*DT) FOR A GIVEN LEVEL AND A GIVEN TIME STEP.

! The same but for trajectory
! ---------------------------
! ZPOID5    : DP/(RG*DT) FOR A GIVEN LEVEL AND A GIVEN TIME STEP.

  DO JLON=KIDIA,KFDIA
    IF (JLEV == KTDIA) THEN
      ZFPT5(JLON,JLEV)=0.0_JPRB
      ZFPT(JLON,JLEV)=0.0_JPRB
    ELSE
      ZPOID5(JLON,JLEV)=PDELP5(JLON,JLEV)*ZGDTI
      ZPOID(JLON,JLEV)=PDELP(JLON,JLEV)*ZGDTI

      ZDQ5(JLON)=ZPQW5(JLON,JLEV)-PQ5(JLON,JLEV)
      ZDQ(JLON)=ZPQW(JLON,JLEV)-PQ(JLON,JLEV)

      IF (LSMOOTHB) THEN
        ZFPT5(JLON,JLEV)=ZFPT5(JLON,JLEV-1)+&
         & MAX(0.0_JPRB,-ZPOID5(JLON,JLEV)*ZDQ5(JLON))  
        IF ((-ZPOID5(JLON,JLEV)*ZDQ5(JLON)) > 0.0_JPRB) THEN
          ZFPT(JLON,JLEV)=ZFPT(JLON,JLEV-1)-ZPOID5(JLON,JLEV)&
           & *ZDQ(JLON)-ZPOID(JLON,JLEV)*ZDQ5(JLON)  
        ELSE
          ZFPT(JLON,JLEV)=ZFPT(JLON,JLEV-1)
        ENDIF
      ELSE
        ZFPT5(JLON,JLEV)=MAX(0.0_JPRB &
         & ,ZFPT5(JLON,JLEV-1)-ZPOID5(JLON,JLEV)&
         & *ZDQ5(JLON))  
        IF ((ZFPT5(JLON,JLEV-1)-ZPOID5(JLON,JLEV)*ZDQ5(JLON)) > 0.0_JPRB)THEN
          ZFPT(JLON,JLEV)=ZFPT(JLON,JLEV-1)-ZPOID5(JLON,JLEV)&
           & *ZDQ(JLON)-ZPOID(JLON,JLEV)*ZDQ5(JLON)  
        ELSE
          ZFPT(JLON,JLEV)=0.0_JPRB
        ENDIF
      ENDIF
    ENDIF
  ENDDO
ENDDO

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

!     SOME SMOOTHING IF IT IS REQUIRED

    IF (LSMOOTHA) THEN
      IF (ZFPT5(JLON,JLEV) > 0.0_JPRB)THEN
        ZNLMINQ=0.0_JPRB

        ZFPT5(JLON,JLEV)=RNEGAT+ZFPT5(JLON,JLEV)
        ZFPT(JLON,JLEV)=ZFPT(JLON,JLEV)

        ZQ5=RNLCURV*(ZFPT5(JLON,JLEV)-ZNLMINQ)
        IF (ZQ5 > 17._JPRB) THEN
          ZFPT5(JLON,JLEV)=ZFPT5(JLON,JLEV)
          ZFPT(JLON,JLEV)=ZFPT(JLON,JLEV)
        ELSEIF (ZQ5 < -17._JPRB) THEN
          ZFPT5(JLON,JLEV)=ZNLMINQ
          ZFPT(JLON,JLEV)=0.0_JPRB
        ELSE
          ZABS5=ABS(ZQ5)
          ZLOG2COSH5=ZABS5+LOG(1.0_JPRB+EXP(-ZABS5-ZABS5))
          ZFPT5(JLON,JLEV)=0.5_JPRB*(ZLOG2COSH5/RNLCURV &
           & +ZFPT5(JLON,JLEV)+ZNLMINQ)  
          ZFPT(JLON,JLEV)=0.5_JPRB*(TANH(ZQ5)+1.0_JPRB)*ZFPT(JLON,JLEV)
        ENDIF
      ENDIF
    ENDIF

!     SWAP AT THE END OF THE LAYER'S COMPUTATIONS AND FLUX VALUES.

    IF (PT5(JLON,JLEV) > RTT) THEN
      PFPLSL5(JLON,JLEV)=ZFPT5(JLON,JLEV)
      PFPLSL(JLON,JLEV)=ZFPT(JLON,JLEV)

      PFPLSN5(JLON,JLEV)=0.0_JPRB
      PFPLSN(JLON,JLEV)=0.0_JPRB
    ELSE
      PFPLSL5(JLON,JLEV)=0.0_JPRB
      PFPLSL(JLON,JLEV)=0.0_JPRB

      PFPLSN5(JLON,JLEV)=ZFPT5(JLON,JLEV)
      PFPLSN(JLON,JLEV)=ZFPT(JLON,JLEV)
    ENDIF

  ENDDO
ENDDO

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