Sources/phylmd/FCTTRE.f

module FCTTRE

  ! From phylmd/FCTTRE.inc, version 1.2, 2004/06/22 11:45:32

  ! 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".

  ! Probably from Buck, 1981, Journal of Applied Meteorology, volume
  ! 20, number 12, page 1527.

  implicit none

contains

  elemental REAL function FOEEW(T, ICE)

    use yoethf_m, only: R3LES, R3IES, R4LES, R4IES
    use SUPHEC_M, only: rtt

    REAL, intent(in):: T
    logical, intent(in):: ICE ! else liquid

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

    FOEEW = exp(merge(R3IES / (T - R4IES), R3lES / (T - R4lES), ice) &
         * (T - RTT))

  end function FOEEW

  !******************************************

  REAL function FOEDE(T, ICE, P5ARG, QS, PCOARG)

    use yoethf_m, only: R4LES, R4IES

    REAL, intent(in):: T
    logical, intent(in):: ICE ! else liquid
    real, intent(in):: P5ARG, QS, PCOARG

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

    FOEDE = QS * PCOARG * P5ARG / (T - merge(R4IES, R4lES, ice))**2

  end function FOEDE

  !******************************************

  elemental REAL function qsats(t)

    REAL, intent(in):: T

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

    qsats = 100. * 0.622 &
         * 10.**(2.07023 - 0.00320991 * t - 2484.896 / t + 3.56654 * LOG10(t))

  end function qsats

  !******************************************

  elemental REAL function qsatl(t)

    REAL, intent(in):: T

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

    qsatl = 100. * 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
1	guez	3	module FCTTRE
2
3	guez	78	! From phylmd/FCTTRE.inc, version 1.2, 2004/06/22 11:45:32
4	guez	3
5	guez	43	! This module includes the thermodynamical functions for the cycle
6	guez	78	! 39 ECMWF physics package. Consistent with "SUPHEC_M" basic
7	guez	43	! physical constants, assuming the partial pressure of water vapour
8			! is given by a first order Taylor expansion of "Qs(T)" with respect
9			! to temperature, using constants in "yoethf_m".
10	guez	3
11	guez	70	! Probably from Buck, 1981, Journal of Applied Meteorology, volume
12			! 20, number 12, page 1527.
13	guez	43
14	guez	3	implicit none
15
16			contains
17
18	guez	109	elemental REAL function FOEEW(T, ICE)
19	guez	3
20	guez	38	use yoethf_m, only: R3LES, R3IES, R4LES, R4IES
21			use SUPHEC_M, only: rtt
22	guez	3
23	guez	70	REAL, intent(in):: T
24	guez	109	logical, intent(in):: ICE ! else liquid
25	guez	3
26			!-----------------------
27
28	guez	109	FOEEW = exp(merge(R3IES / (T - R4IES), R3lES / (T - R4lES), ice) &
29	guez	103	* (T - RTT))
30	guez	3
31			end function FOEEW
32
33			!******************************************
34
35	guez	109	REAL function FOEDE(T, ICE, P5ARG, QS, PCOARG)
36	guez	3
37	guez	38	use yoethf_m, only: R4LES, R4IES
38	guez	3
39	guez	103	REAL, intent(in):: T
40	guez	109	logical, intent(in):: ICE ! else liquid
41	guez	37	real, intent(in):: P5ARG, QS, PCOARG
42	guez	3
43			!-----------------------
44
45	guez	109	FOEDE = QS * PCOARG * P5ARG / (T - merge(R4IES, R4lES, ice))**2
46	guez	3
47			end function FOEDE
48
49			!******************************************
50
51	guez	103	elemental REAL function qsats(t)
52	guez	3
53	guez	37	REAL, intent(in):: T
54	guez	3
55			!-----------------------
56
57	guez	103	qsats = 100. * 0.622 &
58	guez	37	* 10.*(2.07023 - 0.00320991 t - 2484.896 / t + 3.56654 * LOG10(t))
59	guez	3
60			end function qsats
61
62			!******************************************
63
64	guez	103	elemental REAL function qsatl(t)
65	guez	3
66	guez	37	REAL, intent(in):: T
67	guez	3
68			!-----------------------
69
70	guez	103	qsatl = 100. * 0.622 * 10.**(23.8319 - 2948.964 / t &
71	guez	37	- 5.028 * LOG10(t) - 29810.16 * EXP(- 0.0699382 * t) &
72			+ 25.21935 * EXP(- 2999.924 / t))
73	guez	3
74			end function qsatl
75
76			!******************************************
77
78	guez	37	REAL function dqsats(t, qs)
79	guez	3
80	guez	38	use SUPHEC_M, only: RLVTT, rcpd
81	guez	3
82	guez	37	REAL, intent(in):: T, qs
83	guez	3
84			!-----------------------
85
86	guez	37	dqsats = RLVTT / RCPD * qs * (3.56654/t &
87			+2484.896LOG(10.)/t2 - 0.00320991LOG(10.))
88	guez	3
89			end function dqsats
90
91			!******************************************
92
93	guez	37	REAL function dqsatl(t, qs)
94	guez	3
95	guez	38	use SUPHEC_M, only: RLVTT, rcpd
96	guez	3
97	guez	37	REAL, intent(in):: T, qs
98	guez	3
99			!-----------------------
100
101	guez	104	dqsatl = RLVTT / RCPD * qs * LOG(10.) * (2948.964 / t**2 - 5.028 &
102			/ LOG(10.) / t + 25.21935 * 2999.924 / t*2 EXP(- 2999.924 / t) &
103			+ 29810.16 * 0.0699382 * EXP(- 0.0699382 * t))
104	guez	3
105			end function dqsatl
106
107			end module FCTTRE