--- trunk/phylmd/FCTTRE.f90 2014/02/05 17:51:07 78 +++ trunk/Sources/phylmd/FCTTRE.f 2017/04/20 14:44:47 221 @@ -13,97 +13,37 @@ implicit none - LOGICAL, PARAMETER:: thermcep= .TRUE. - contains - REAL function FOEEW(T, DEL) + elemental REAL function FOEEW(T, ICE) use yoethf_m, only: R3LES, R3IES, R4LES, R4IES use SUPHEC_M, only: rtt REAL, intent(in):: T - REAL, intent(in):: DEL ! 1 for ice, 0 for liquid + logical, intent(in):: ICE ! else liquid !----------------------- - FOEEW = EXP((R3LES * (1. - DEL) + R3IES * DEL) * (T - RTT) & - / (T - (R4LES * (1. - DEL) + R4IES * DEL))) + FOEEW = exp(merge(R3IES / (T - R4IES), R3lES / (T - R4lES), ice) & + * (T - RTT)) end function FOEEW !****************************************** - REAL function FOEDE(T, DEL, P5ARG, QS, PCOARG) + REAL function FOEDE(T, ICE, P5ARG, QS, PCOARG) use yoethf_m, only: R4LES, R4IES - REAL, intent(in):: T, DEL + REAL, intent(in):: T + logical, intent(in):: ICE ! else liquid real, intent(in):: P5ARG, QS, PCOARG !----------------------- - FOEDE = QS*PCOARG*P5ARG / (T-(R4LES*(1.-DEL)+R4IES*DEL))**2 + FOEDE = QS * PCOARG * P5ARG / (T - merge(R4IES, R4lES, ice))**2 end function FOEDE - !****************************************** - - REAL function qsats(t) - - REAL, intent(in):: T - - !----------------------- - - qsats = 100.0 * 0.622 & - * 10.**(2.07023 - 0.00320991 * t - 2484.896 / t + 3.56654 * LOG10(t)) - - end function qsats - - !****************************************** - - REAL function qsatl(t) - - REAL, intent(in):: T - - !----------------------- - - qsatl = 100.0 * 0.622 * 10.**(23.8319 - 2948.964 / t & - - 5.028 * LOG10(t) - 29810.16 * EXP(- 0.0699382 * t) & - + 25.21935 * EXP(- 2999.924 / t)) - - end function qsatl - - !****************************************** - - REAL function dqsats(t, qs) - - use SUPHEC_M, only: RLVTT, rcpd - - REAL, intent(in):: T, qs - - !----------------------- - - dqsats = RLVTT / RCPD * qs * (3.56654/t & - +2484.896*LOG(10.)/t**2 - 0.00320991*LOG(10.)) - - end function dqsats - - !****************************************** - - REAL function dqsatl(t, qs) - - use SUPHEC_M, only: RLVTT, rcpd - - REAL, intent(in):: T, qs - - !----------------------- - - dqsatl = RLVTT / RCPD * qs * LOG(10.) & - * (2948.964/t**2-5.028/LOG(10.)/t & - +25.21935*2999.924/t**2*EXP(-2999.924/t) & - +29810.16*0.0699382*EXP(-0.0699382*t)) - - end function dqsatl - end module FCTTRE