SUBROUTINE SURBOUNDAD(&
 & KPROMA,KIDIA,KFDIA,&
 & PQ5,PT5,PTS5,PAPH5,&
 & PQ,PT,PTS,PAPH,PAPHI,&
 & PWS5,PVGRAT5,PWL5,PSN5,PSLM5,&
 & PWS,PVGRAT,PWL,PSN,&
 & PES5,PWET5,PQS5,&
 & PWET,PQS,&
 & PCPTGZ,PCPTS)  

!**** *SURBOUNDAD* - ADJOINT OF TANGENT LINEAR OF SURBOUND

!     PURPOSE
!     -------

!**   INTERFACE
!     ---------

!        EXPLICIT ARGUMENTS
!        ------------------

!        KPROMA            - HORIZONTAL DIMENSION.             (INPUT-C)
!        KIDIA             - INDEX OF START POINT              (INPUT-C)
!        KFDIA             - INDEX OF END   POINT              (INPUT-C)
!        PAPHI(KPROMA)     - GEOPOTENTIAL LOWER MODEL LEVEL    (INPUT)
!        PQ(KPROMA)        - SPECIFIC HUMIDITY ON THE LOWER
!                            LEVEL.                            (INPUT)
!        PT(KPROMA)        - TEMPERATURE ON THE LOWER LEVEL    (INPUT)
!        PTS(KPROMA)       - TEMPERATURE AT THE SURFACE        (INPUT)
!        PAPH(KPROMA)      - HALF PRESSURE  ON THE LOWER
!                            LEVEL                             (INPUT)

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

!     METHOD.
!     -------
!        SEE DOCUMENTATION

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

!     REFERENCE.
!     ----------
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

!     AUTHOR.
!     -------
!        CARLA CARDINALI *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 92-05-22
!        MODIFICATION : P. MOLL 18 juillet 1996  ACHMT transplantation
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        P. Viterbo    28-May-2004 surf library and new surface units.
!        M. Ko"hler    03-Dec-2004 delete unsafe redefinition of RVTMP2
!     ------------------------------------------------------------------

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

USE YOMCST   , ONLY : RPI      ,RV       ,RCPD     ,RCPV     ,&
 & RETV     ,RCW      ,RCS      ,RLVTT    ,RLSTT    ,&
 & RTT      ,RALPW    ,RBETW    ,RGAMW    ,RALPS    ,&
 & RBETS    ,RGAMS    ,RALPD    ,RBETD    ,RGAMD  
USE YOMCT0B  , ONLY : LECMWF
USE YOETHF   , ONLY : RVTMP2
USE YOMPHY1  , ONLY : WCRIN    ,WSMX

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQ(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPH(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PAPHI(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVGRAT5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWL5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSN5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLM5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVGRAT(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWL(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSN(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PES5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWET5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS5(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWET(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTGZ(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPTS(KPROMA) 
REAL(KIND=JPRB) :: ZRH(KPROMA)
REAL(KIND=JPRB) :: ZES(KPROMA)
REAL(KIND=JPRB) :: ZHU(KPROMA),ZQSATS(KPROMA),ZHQ(KPROMA),ZESP(KPROMA)
REAL(KIND=JPRB) :: ZDELT(KPROMA),ZNEIJ(KPROMA)

INTEGER(KIND=JPIM) :: JL, JLON

REAL(KIND=JPRB) :: ZCPVMD, ZDEW, ZEW, ZQWSBCR, ZRHMAX, ZRHMIN,&
 & ZSN, ZSN5, ZVGRAT, ZVGRAT5, ZVLT, ZWET1, &
 & ZWET15, ZWET2, ZWET25, ZWL, ZWL5, ZRWLMAX, &
 & ZWLMXI, ZWLMXI5, ZWS, ZWS5, ZRQSNCR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "surf_inq.h"
END INTERFACE

#include "gprhad.intfb.h"

#include "fcttrm.h"

!     1.     DEFINITION OF THE CONSTANTS
!            ---------------------------

IF (LHOOK) CALL DR_HOOK('SURBOUNDAD',0,ZHOOK_HANDLE)
CALL SURF_INQ(PRQSNCR=ZRQSNCR,PRWLMAX=ZRWLMAX,PRQWSBCR=ZQWSBCR)

!*    1.1    PHISICAL CONSTANTS

ZVLT=4._JPRB
ZCPVMD=RCPV-RCPD

!     1.2   INITIALIZATION

DO JL=KIDIA,KFDIA
  ZES(JL)=0.0_JPRB
  ZRH(JL)=0.0_JPRB
ENDDO

IF(.NOT.LECMWF)THEN
! prepare use of achmt Ri number
  DO JLON=KIDIA,KFDIA

    ZNEIJ(JLON)=PSLM5(JLON)*PSN5(JLON)/(PSN5(JLON)+WCRIN)
    ZDELT(JLON)=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PTS5(JLON)))

    ZEW= FOEW (PTS5(JLON),ZDELT(JLON))
    ZESP(JLON)=ZEW/PAPH5(JLON)
    ZQSATS(JLON)= FOQS (ZESP(JLON))

    ZHU(JLON)=1.0_JPRB+PSLM5(JLON)*(1.0_JPRB-ZNEIJ(JLON))*(0.5_JPRB*(1.0_JPRB-COS(RPI &
     & *PWS5(JLON)/WSMX))-1.0_JPRB)  
    ZHQ(JLON)=(1.0_JPRB-ZHU(JLON))*PVGRAT5(JLON)
    ZDEW=MAX(0.0_JPRB,SIGN(1.0_JPRB,PQ5(JLON)-ZQSATS(JLON)))
    ZHU(JLON)=ZHU(JLON)+ZDEW*ZHQ(JLON)
    ZHQ(JLON)=ZHQ(JLON)-ZDEW*ZHQ(JLON)

    PQS(JLON)=PQS(JLON)+ZCPVMD*PCPTS(JLON)
    PCPTS(JLON)=0.0_JPRB
    PQ(JLON)=PQ(JLON)+ZHQ(JLON)*PQS(JLON)
    PQS(JLON)=0.0_JPRB

  ENDDO

ENDIF

!*         2.1  ADJOINT OF TANGENT LINEAR OF CP(Q)*T

DO JL=KIDIA,KFDIA
  ZSN=0._JPRB
  ZWET2=0._JPRB
  ZWL=0._JPRB
  ZWET1=0._JPRB
  ZWS=0._JPRB
  ZWLMXI=0._JPRB
  ZVGRAT=0._JPRB
  PTS(JL)=PTS(JL)+RCPD*(1.0_JPRB+RVTMP2*PWET5(JL)*PQS5(JL))*PCPTS(JL)
  PWET(JL)=PWET(JL)+PTS5(JL)*RCPD*RVTMP2*PQS5(JL)*PCPTS(JL)
  PQS(JL)=PQS(JL)+PTS5(JL)*RCPD*RVTMP2*PWET5(JL)*PCPTS(JL)
  PCPTS(JL)=0.0_JPRB
  IF(PSLM5(JL) <= 0.5_JPRB.OR.PQ5(JL) > PQS5(JL)) THEN
    PWET(JL)=0.0_JPRB
  ELSE
    ZVGRAT5=PVGRAT5(JL)*ZVLT
    ZWLMXI5=1.0_JPRB/(ZRWLMAX*(1.0_JPRB-PVGRAT5(JL)+ZVGRAT5))
    ZWS5=PWS5(JL)*ZQWSBCR
    ZWET15=0.5_JPRB*(1.0_JPRB-COS(ZWS5))
    ZWL5=PWL5(JL)*ZWLMXI5
    ZWET25=ZWL5+(1.0_JPRB-ZWL5)*ZWET15
    ZSN5=PSN5(JL)*ZRQSNCR
    ZSN=ZSN+PWET(JL)*(1.0_JPRB-ZWET25)
    ZWET2=ZWET2+(1.0_JPRB-ZSN5)*PWET(JL)
    IF(ZSN5 > 1.0_JPRB) THEN
      ZSN=0._JPRB
    ENDIF
    PSN(JL)=PSN(JL)+ZSN*ZRQSNCR
    ZWL=ZWL+ZWET2*(1.0_JPRB-ZWET15)
    ZWET1=ZWET1+(1.0_JPRB-ZWL5)*ZWET2
    ZWS=ZWS+0.5_JPRB*SIN(ZWS5)*ZWET1
    PWL(JL)=PWL(JL)+ZWL*ZWLMXI5
    ZWLMXI=ZWLMXI+PWL5(JL)*ZWL
    PWS(JL)=PWS(JL)+ZWS*ZQWSBCR
    PVGRAT(JL)=PVGRAT(JL)+ZWLMXI*ZRWLMAX*ZWLMXI5**2
    ZVGRAT=ZVGRAT-ZWLMXI*ZRWLMAX*ZWLMXI5**2
    PVGRAT(JL)=PVGRAT(JL)+ZVGRAT*ZVLT
    PWET(JL)=0.0_JPRB
  ENDIF
ENDDO

!*         2.2     COMPUTE THE ADJOINT OF TANGENT LINEAR OF THE
!                  SATURATION HUMIDITY AT THE SURFACE.

DO JL=KIDIA,KFDIA
  ZES(JL)=ZES(JL)+((PAPH5(JL)*(RETV+1.0_JPRB)-RETV*PES5(JL))&
   & +PES5(JL)*RETV)/(PAPH5(JL)*(RETV+1.0_JPRB)-RETV*PES5(JL))**2 &
   & *PQS(JL)  
  PAPH(JL)=PAPH(JL)-PES5(JL)*(RETV+1.0_JPRB)&
   & /(PAPH5(JL)*(RETV+1.0_JPRB)-RETV*PES5(JL))**2*PQS(JL)  
  PQS(JL)=0.0_JPRB
ENDDO
ZRHMAX=1._JPRB
ZRHMIN=0._JPRB
CALL GPRHAD(.FALSE.,KPROMA,KIDIA,KFDIA, 1 ,ZRHMAX,ZRHMIN,&
 & PQ,PTS,PAPH,&
 & ZES,ZRH,&
 & PES5,PAPH5,PQ5,PTS5)  

!*         2.3   ADJOINT OF TANGENT LINEAR OF CP(Q)*T+GZ.
!                ----------------------------------------
DO JL=KIDIA,KFDIA
  PT(JL)=PT(JL)+RCPD*(1.0_JPRB+RVTMP2*PQ5(JL))*PCPTGZ(JL)
  PQ(JL)=PQ(JL)+PT5(JL)*RCPD*RVTMP2*PCPTGZ(JL)
  PAPHI(JL)=PAPHI(JL)+PCPTGZ(JL)
  PCPTGZ(JL)=0.0_JPRB
ENDDO

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

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