subroutine fpvsx_ad( t, es, t_ad, es_ad, adjoint )
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    fpvsx_ad     forward and adjoint model for saturation vapor pressure
!     prgmmr:    treadon     org: np23                date: 2003-12-18
!
! abstract:  This subroutine contains the forward and ajoint models for the
!            calculation of saturation vapor pressure.  
!
! program history log:
!   03-12-18  treadon - initial routine
!   04-06-14  treadon - reformat documenation
!
!   input argument list:
!     t       - temperature
!     t_ad    - partial derivative of vapor pressure with respect to temperature 
!     es_ad   - vapor pressure perturbation
!     adjoint - logical flag (.false.=forward model only, .true.=forward and ajoint)
!
!   output argument list:
!     es
!     t_ad    - partial derivative of vapor pressure with respect to temperature 
!     es_ad   - vapor pressure perturbation
!
! remarks:
!    The adjoint portion of this routine was generated by the 
!    Tangent linear and Adjoint Model Compiler,  TAMC 5.3.0
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$
!==============================================
! all entries are defined explicitly
!==============================================
  use kinds, only: r_kind
  use constants, only: zero, one, tmix, xai, xbi, xa, xb, ttp, psatk, init_constants
  implicit none

!==============================================
! define arguments
!==============================================
  logical     ,intent(in   ) :: adjoint
  real(r_kind),intent(inout) :: es_ad
  real(r_kind),intent(inout) :: t_ad
  real(r_kind),intent(  out) :: es
  real(r_kind),intent(in   ) :: t

!==============================================
! define local variables
!==============================================
  real(r_kind) tr_ad
  real(r_kind) w_ad
  real(r_kind) tr
  real(r_kind) w

!----------------------------------------------
! RESET LOCAL ADJOINT VARIABLES
!----------------------------------------------
  tr_ad = zero
  w_ad = zero

!----------------------------------------------
! ROUTINE BODY
!----------------------------------------------
!----------------------------------------------
! FUNCTION AND TAPE COMPUTATIONS
!----------------------------------------------
call init_constants(.false.)

  tr = ttp/t
  if (t >= ttp) then
     es = psatk*tr**xa*exp(xb*(one-tr))
  else if (t < tmix) then
     es = psatk*tr**xai*exp(xbi*(one-tr))
  else
     w = (t-tmix)/(ttp-tmix)
     es = w*psatk*tr**xa*exp(xb*(one-tr))+(one-w)*psatk*tr**xai* &
          exp(xbi*(one-tr))
  endif
  
  if (.not.adjoint) return

!----------------------------------------------
! ADJOINT COMPUTATIONS
!----------------------------------------------
  if (t >= ttp) then
     tr_ad = tr_ad+es_ad*((-(psatk*tr**xa*xb*exp(xb*(one-tr))))+psatk*xa* &
             tr**(xa-one)*exp(xb*(one-tr)))
     es_ad = zero
  else if (t < tmix) then
     tr_ad = tr_ad+es_ad*((-(psatk*tr**xai*xbi*exp(xbi*(one-tr))))+psatk* &
             xai*tr**(xai-one)*exp(xbi*(one-tr)))
     es_ad = zero
  else
     tr_ad = tr_ad+es_ad*((-(w*psatk*tr**xa*xb*exp(xb*(one-tr))))+w* &
             psatk*xa*tr**(xa-one)*exp(xb*(one-tr))-(one-w)*psatk*tr**xai*xbi* &
             exp(xbi*(one-tr))+(one-w)*psatk*xai*tr**(xai-one)*exp(xbi*(one-tr)))
     w_ad  = w_ad+es_ad*(psatk*tr**xa*exp(xb*(one-tr))-psatk*tr**xai* &
             exp(xbi*(one-tr)))
     es_ad = zero
     t_ad  = t_ad+w_ad/(ttp-tmix)
     w_ad  = zero
  endif
  t_ad  = t_ad-tr_ad*(ttp/(t*t))
  tr_ad = zero
  
  return
end subroutine fpvsx_ad




subroutine fpvsx_TL(T,dES_dT)

use kinds, only: r_single, r_kind, i_kind
use constants, only: zero, one, tmix, xai, xbi, xa, xb, ttp, psatk, init_constants

IMPLICIT NONE

REAL(r_kind) :: T, ES
REAL(r_kind) :: TR,W, DTR_DT, dES_DT, DW_DT

call init_constants(.false.)
TR = TTP/T
DTR_DT = -TTP /(T*T)


IF(T >= TTP) THEN
   dES_dT = (PSATK*XA*TR**(XA-ONE)*EXP(XB*(ONE-TR))+PSATK*TR**XA*(-XB)*EXP(XB*(ONE-TR)))*dTR_dT
ELSE IF (T < TMIX) THEN
   dES_dT = (PSATK*XAI*TR**(XAI-ONE)*EXP(XBI*(ONE-TR))+PSATK*TR**XAI*(-XBI)*EXP(XBI*(ONE-TR)))*dTR_dT
ELSE
   W      = (T - TMIX)/(TTP - TMIX)
   dW_DT  = ONE/(TTP - TMIX)
   dES_DT = PSATK*TR**XA *EXP(XB*(ONE-TR))*dW_DT + W*PSATK*XA*TR**(XA-ONE)*EXP(XB*(ONE-TR))*dTR_dT &
          + W*PSATK*TR**XA * EXP(XB*(ONE-TR))*(-XB)*dTR_dT  &
          + (ONE-W)*PSATK*XAI*TR**(XAI-ONE)*EXP(XBI*(ONE-TR))*dTR_dT &
          + (ONE-W)*PSATK*TR**XAI *(-XBI)*EXP(XBI*(ONE-TR))*dTR_dT &
          - PSATK*TR**XAI*EXP(XBI*(ONE-TR))*dW_dT
END IF


RETURN
END subroutine fpvsx_TL

