module_mosaic_csuesat.F
References to this file elsewhere.
1 !**********************************************************************************
2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
6 !
7 ! MOSAIC module: see module_mosaic_driver.F for information and terms of use
8 !**********************************************************************************
9 module module_mosaic_csuesat
10
11 !-----------------------------------------------------------------------
12
13 implicit none
14
15 integer, parameter :: nebins=149, nebinsi=110
16
17 real, save :: estbar(nebins+1), esitbar(nebinsi+1)
18
19 real, save :: tmin = -1.0
20 real, save :: tmini = -1.0
21
22
23
24 contains
25
26
27
28 !-----------------------------------------------------------------------
29 ! following funcs from pegasus file csuesat01.f (timestamp = 09-apr-2002)
30 !-----------------------------------------------------------------------
31 ! file csuesat01.f - from stratcld.F,v on 8-oct-97
32 ! routines and common blocks renamed to allow running either
33 ! standalone gchm or coupled gchm-ccm2
34 !-----------------------------------------------------------------------
35
36
37 !-----------------------------------------------------------------------
38 real function esat_gchm( t )
39
40 ! saturation vapor pressure (dynes/cm2) with respect to water
41
42 real t
43 real av
44 integer it
45
46 if (tmin .lt. 0.0) then
47 call init_csuesat
48 endif
49
50 it=max0(1,min0(ifix(t-tmin),nebins))
51 av=amax1(amin1(t-tmin-float(it),1.),0.)
52 esat_gchm=estbar(it)*(1.-av)+estbar(it+1)*av
53 return
54 end function esat_gchm
55
56
57 !-----------------------------------------------------------------------
58 real function esati_gchm( t )
59
60 ! saturation vapor pressure (dynes/cm2) with respect to ice
61
62 real t
63 real av
64 integer it
65
66 if (tmin .lt. 0.0) then
67 call init_csuesat
68 endif
69
70 it=max0(1,min0(ifix(t-tmini),nebinsi))
71 av=amax1(amin1(t-tmini-float(it),1.),0.)
72 esati_gchm=esitbar(it)*(1.-av)+esitbar(it+1)*av
73 return
74 end function esati_gchm
75
76
77 !-----------------------------------------------------------------------
78 subroutine init_csuesat
79
80 ! calculate table of saturation vapor pressure (dynes/cm2) with respect
81 ! to water(estbar) and ice (esitbar)
82
83 integer jd, k
84 real a0, a2, a3, a3dtf, a4, a5, a6, arg, ax
85 real t, tf, tinver, z1, z2
86
87 a0=5.75185606e10
88 ax=-20.947031
89 a2=-3.56654
90 a3=-2.018890949
91 tf=273.16
92 a3dtf=a3/tf
93 tmini=163.
94 t=tmini
95
96 do 3 k=1,nebinsi+1
97 t=t+1.
98 tinver=1./t
99 arg=ax*tf*tinver+a2*alog(tf*tinver)+a3*t/tf
100 esitbar(k)=a0*exp(arg)*1.e3
101 3 continue
102
103 a0=7.95357242e+10
104 ax=-18.1972839
105 a2=5.02808
106 a3=-70242.1852
107 a4=-26.1205253
108 a5=58.0691913
109 a6=-8.03945282
110 tf=373.16
111 tmin=163.
112 t=tmin
113
114 do 4 jd=1,nebins+1
115 t=t+1.
116 z1=exp(a4*t/tf)
117 z2=exp(a6*tf/t)
118 arg=ax*tf/t+a2*alog(tf/t)+a3*z1+a5*z2
119 4 estbar(jd)=a0*exp(arg)*1.e3
120
121 return
122 end subroutine init_csuesat
123
124
125 !-----------------------------------------------------------------------
126 end module module_mosaic_csuesat