trunk/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

  LOGICAL, PARAMETER:: thermcep= .TRUE.

contains

  REAL function FOEEW(T, DEL)

    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

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

    FOEEW = EXP((R3LES * (1. - DEL) + R3IES * DEL) * (T - RTT) &
         / (T - (R4LES * (1. - DEL) + R4IES * DEL)))

  end function FOEEW

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

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

    use yoethf_m, only: R4LES, R4IES

    REAL, intent(in):: T, DEL
    real, intent(in):: P5ARG, QS, PCOARG

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

    FOEDE = QS*PCOARG*P5ARG / (T-(R4LES*(1.-DEL)+R4IES*DEL))**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
1	guez	3	module FCTTRE
2
3	guez	37	! 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			! 39 ECMWF Physics package. Consistent with "SUPHEC_M" basic
7			! 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	guez	37	LOGICAL, PARAMETER:: thermcep= .TRUE.
17	guez	3
18			contains
19
20	guez	37	REAL function FOEEW(T, DEL)
21	guez	3
22	guez	38	use yoethf_m, only: R3LES, R3IES, R4LES, R4IES
23			use SUPHEC_M, only: rtt
24	guez	3
25	guez	70	REAL, intent(in):: T
26			REAL, intent(in):: DEL ! 1 for ice, 0 for liquid
27	guez	3
28			!-----------------------
29
30	guez	37	FOEEW = EXP((R3LES * (1. - DEL) + R3IES * DEL) * (T - RTT) &
31			/ (T - (R4LES * (1. - DEL) + R4IES * DEL)))
32	guez	3
33			end function FOEEW
34
35			!******************************************
36
37	guez	37	REAL function FOEDE(T, DEL, P5ARG, QS, PCOARG)
38	guez	3
39	guez	38	use yoethf_m, only: R4LES, R4IES
40	guez	3
41	guez	37	REAL, intent(in):: T, DEL
42			real, intent(in):: P5ARG, QS, PCOARG
43	guez	3
44			!-----------------------
45
46	guez	37	FOEDE = QSPCOARGP5ARG / (T-(R4LES(1.-DEL)+R4IESDEL))**2
47	guez	3
48			end function FOEDE
49
50			!******************************************
51
52	guez	37	REAL function qsats(t)
53	guez	3
54	guez	37	REAL, intent(in):: T
55	guez	3
56			!-----------------------
57
58	guez	37	qsats = 100.0 * 0.622 &
59			* 10.*(2.07023 - 0.00320991 t - 2484.896 / t + 3.56654 * LOG10(t))
60	guez	3
61			end function qsats
62
63			!******************************************
64
65	guez	37	REAL function qsatl(t)
66	guez	3
67	guez	37	REAL, intent(in):: T
68	guez	3
69			!-----------------------
70
71	guez	37	qsatl = 100.0 * 0.622 * 10.**(23.8319 - 2948.964 / t &
72			- 5.028 * LOG10(t) - 29810.16 * EXP(- 0.0699382 * t) &
73			+ 25.21935 * EXP(- 2999.924 / t))
74	guez	3
75			end function qsatl
76
77			!******************************************
78
79	guez	37	REAL function dqsats(t, qs)
80	guez	3
81	guez	38	use SUPHEC_M, only: RLVTT, rcpd
82	guez	3
83	guez	37	REAL, intent(in):: T, qs
84	guez	3
85			!-----------------------
86
87	guez	37	dqsats = RLVTT / RCPD * qs * (3.56654/t &
88			+2484.896LOG(10.)/t2 - 0.00320991LOG(10.))
89	guez	3
90			end function dqsats
91
92			!******************************************
93
94	guez	37	REAL function dqsatl(t, qs)
95	guez	3
96	guez	38	use SUPHEC_M, only: RLVTT, rcpd
97	guez	3
98	guez	37	REAL, intent(in):: T, qs
99	guez	3
100			!-----------------------
101
102	guez	37	dqsatl = RLVTT / RCPD * qs * LOG(10.) &
103			* (2948.964/t**2-5.028/LOG(10.)/t &
104			+25.219352999.924/t2EXP(-2999.924/t) &
105			+29810.160.0699382EXP(-0.0699382*t))
106	guez	3
107			end function dqsatl
108
109			end module FCTTRE