--- trunk/libf/phylmd/FCTTRE.f90	2008/02/27 13:16:39	3
+++ trunk/Sources/phylmd/FCTTRE.f	2017/04/20 14:44:47	221
@@ -1,110 +1,49 @@
 module FCTTRE
 
-  ! From phylmd/FCTTRE.inc,v 1.2 2004/06/22 11:45:32
+  ! From phylmd/FCTTRE.inc, version 1.2, 2004/06/22 11:45:32
 
-  !      This COMDECK includes the Thermodynamical functions for the cy39
-  !       ECMWF Physics package.
-  !       Consistent with YOMCST Basic physics constants, assuming the
-  !       partial pressure of water vapour is given by a first order
-  !       Taylor expansion of Qs(T) w.r.t. to Temperature, using constants
-  !       in YOETHF
+  ! This module includes the thermodynamical functions for the cycle
+  ! 39 ECMWF physics package. Consistent with "SUPHEC_M" basic
+  ! physical constants, assuming the partial pressure of water vapour
+  ! is given by a first order Taylor expansion of "Qs(T)" with respect
+  ! to temperature, using constants in "yoethf_m".
 
-  implicit none
+  ! Probably from Buck, 1981, Journal of Applied Meteorology, volume
+  ! 20, number 12, page 1527.
 
-  LOGICAL, PARAMETER:: thermcep=.TRUE.
+  implicit none
 
 contains
 
-  REAL function FOEEW ( PTARG,PDELARG )
+  elemental REAL function FOEEW(T, ICE)
 
-    use yoethf, only: R3LES, R3IES, R4LES, R4IES
-    use YOMCST, only: rtt
+    use yoethf_m, only: R3LES, R3IES, R4LES, R4IES
+    use SUPHEC_M, only: rtt
 
-    REAL, intent(in):: PTARG, PDELARG
+    REAL, intent(in):: T
+    logical, intent(in):: ICE ! else liquid
 
     !-----------------------
 
-    FOEEW = EXP ((R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) &
-         / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) )
+    FOEEW = exp(merge(R3IES / (T - R4IES), R3lES / (T - R4lES), ice) &
+         * (T - RTT))
 
   end function FOEEW
 
   !******************************************
 
-  REAL function FOEDE(PTARG,PDELARG,P5ARG,PQSARG,PCOARG)
+  REAL function FOEDE(T, ICE, P5ARG, QS, PCOARG)
 
-    use yoethf, only: R4LES, R4IES
+    use yoethf_m, only: R4LES, R4IES
 
-    REAL, intent(in):: PTARG, PDELARG
-    real, intent(in):: P5ARG, PQSARG, PCOARG
+    REAL, intent(in):: T
+    logical, intent(in):: ICE ! else liquid
+    real, intent(in):: P5ARG, QS, PCOARG
 
     !-----------------------
 
-    FOEDE = PQSARG*PCOARG*P5ARG / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2
+    FOEDE = QS * PCOARG * P5ARG / (T - merge(R4IES, R4lES, ice))**2
 
   end function FOEDE
 
-  !******************************************
-
-  REAL function qsats(ptarg)
-
-    REAL, intent(in):: PTARG
-
-    !-----------------------
-
-    qsats = 100.0 * 0.622 * 10.0 &
-         ** (2.07023 - 0.00320991 * ptarg &
-         - 2484.896 / ptarg + 3.56654 * LOG10(ptarg))
-
-  end function qsats
-
-  !******************************************
-
-  REAL function qsatl(ptarg)
-
-    REAL, intent(in):: PTARG
-
-    !-----------------------
-
-    qsatl = 100.0 * 0.622 * 10.0 &
-         ** (23.8319 - 2948.964 / ptarg &
-         - 5.028 * LOG10(ptarg) &
-         - 29810.16 * EXP( - 0.0699382 * ptarg) &
-         + 25.21935 * EXP( - 2999.924 / ptarg))
-
-  end function qsatl
-
-  !******************************************
-
-  REAL function dqsats(ptarg,pqsarg)
-
-    use YOMCST, only: RLVTT, rcpd
-
-    REAL, intent(in):: PTARG, pqsarg
-
-    !-----------------------
-
-    dqsats = RLVTT/RCPD*pqsarg * (3.56654/ptarg &
-         +2484.896*LOG(10.)/ptarg**2 &
-         -0.00320991*LOG(10.))
-
-  end function dqsats
-
-  !******************************************
-
-  REAL function dqsatl(ptarg,pqsarg)
-
-    use YOMCST, only: RLVTT, rcpd
-
-    REAL, intent(in):: PTARG, pqsarg
-
-    !-----------------------
-
-    dqsatl = RLVTT/RCPD*pqsarg*LOG(10.)* &
-         (2948.964/ptarg**2-5.028/LOG(10.)/ptarg &
-         +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) &
-         +29810.16*0.0699382*EXP(-0.0699382*ptarg))
-
-  end function dqsatl
-
 end module FCTTRE