12 subroutine slat_geos5_tamp_v1(im, tau_amp, xlatdeg, tau_gw)
16 real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im)
17 real(kind=kind_phys) :: latdeg, flat_gw, tem
24 latdeg = abs(xlatdeg(i))
25 if (latdeg < 15.3)
then
26 tem = (latdeg-3.0) / 8.0
27 flat_gw = 0.75 * exp(-tem * tem)
28 if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75
29 elseif (latdeg < 31.0 .and. latdeg >= 15.3)
then
31 elseif (latdeg < 60.0 .and. latdeg >= 31.0)
then
32 tem = (latdeg-60.0) / 23.0
33 flat_gw = 0.50 * exp(- tem * tem)
34 elseif (latdeg >= 60.0)
then
35 tem = (latdeg-60.0) / 70.0
36 flat_gw = 0.50 * exp(- tem * tem)
38 tau_gw(i) = tau_amp*flat_gw
45 subroutine slat_geos5_2020(im, tau_amp, xlatdeg, tau_gw)
49 real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im)
50 real(kind=kind_phys) :: latdeg, flat_gw, tem
51 real(kind=kind_phys),
parameter :: fampqbo = 1.25
52 real(kind=kind_phys),
parameter :: famp60s = 1.0
53 real(kind=kind_phys),
parameter :: famp60n = 1.0
54 real(kind=kind_phys),
parameter :: famp30 = 0.25
56 real(kind=kind_phys),
parameter :: swid15 = 12.5
57 real(kind=kind_phys),
parameter :: swid60s = 30.0
58 real(kind=kind_phys),
parameter :: swid60n = 25.0
65 latdeg = abs(xlatdeg(i))
66 if (latdeg < 15.3)
then
67 tem = (latdeg-3.0) / swid15
68 flat_gw = fampqbo * exp(-tem * tem)
69 if (latdeg <= 3.0) flat_gw = fampqbo
70 elseif (latdeg < 31.0 .and. latdeg >= 15.3)
then
72 elseif (latdeg < 60.0 .and. latdeg >= 31.0)
then
73 tem = (latdeg-60.0) / 23.0
74 flat_gw = famp60n* exp(- tem * tem)
75 elseif (latdeg >= 60.0)
then
76 tem = (latdeg-60.0) /swid60n
77 flat_gw = famp60n * exp(- tem * tem)
80 if (xlatdeg(i) <= -31.0)
then
82 if (latdeg < 60.0 .and. latdeg >= 31.0)
then
83 tem = (latdeg-60.0) / 23.0
84 flat_gw = famp60s * exp(- tem * tem)
86 if (latdeg >= 60.0)
then
87 tem = (latdeg-60.0) /swid60s
88 flat_gw = famp60s * exp(- tem * tem)
92 tau_gw(i) = tau_amp*flat_gw
98 subroutine slat_geos5(im, xlatdeg, tau_gw)
102 real(kind=kind_phys) :: xlatdeg(im)
103 real(kind=kind_phys) :: tau_gw(im)
104 real(kind=kind_phys) :: latdeg
105 real(kind=kind_phys),
parameter :: tau_amp = 3.5e-3
106 real(kind=kind_phys) :: trop_gw, flat_gw
114 if (-15.3 < latdeg .and. latdeg < 15.3)
then
115 flat_gw = trop_gw*exp(-( (abs(latdeg)-3.)/8.0)**2)
116 if (flat_gw < 1.2 .and. abs(latdeg) <= 3.) flat_gw = trop_gw
117 else if (latdeg > -31. .and. latdeg <= -15.3)
then
119 else if (latdeg < 31. .and. latdeg >= 15.3)
then
121 else if (latdeg > -60. .and. latdeg <= -31.)
then
122 flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2)
123 else if (latdeg < 60. .and. latdeg >= 31.)
then
124 flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2)
125 else if (latdeg <= -60.)
then
126 flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2)
127 else if (latdeg >= 60.)
then
128 flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2)
130 tau_gw(i) = tau_amp*flat_gw
138 subroutine get_spectra_tau_convgw &
139 (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src)
143 integer :: nw, im, levs
144 integer,
dimension(im,3) :: icld
145 real(kind=kind_phys),
dimension(im, levs) :: dcheat, scheat
146 real(kind=kind_phys),
dimension(im) :: precip, xlatd, sinlat, coslat
147 real(kind=kind_phys),
dimension(im) :: taub
148 integer,
dimension(im) :: klev, if_src
152 real(kind=kind_phys),
parameter :: precip_max = 100.
153 real(kind=kind_phys),
parameter :: tau_amp = 3.5e-3
155 integer :: i, k, klow, ktop, kmid
156 real(kind=kind_phys) :: dtot, dmax, daver
165 if (klow == -99 .and. ktop == -99)
then
171 dmax = abs(dcheat(i,k) + scheat(i,k))
173 dtot =abs(dcheat(i,k) + scheat(i,k))
174 if ( dtot > dmax)
then
187 taub(i) = tau_amp* precip(i)/precip_max*coslat(i)
194 call slat_geos5(im, xlatd, taub)
208 subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src)
209 integer :: nw, im, levs
210 real(kind=kind_phys),
dimension(im, levs) :: trig_fgf
212 real(kind=kind_phys),
dimension(im) :: xlatd, sinlat, coslat
213 real(kind=kind_phys),
dimension(im) :: taub
214 integer,
dimension(im) :: klev, if_src
217 real(kind=kind_phys),
parameter :: tlim_fgf = 100.
218 real(kind=kind_phys),
parameter :: tau_amp = 3.5e-3
219 real(kind=kind_phys),
parameter :: pmax = 750.e2, pmin = 100.e2
220 integer,
parameter :: klow =127-92, ktop=127-45
221 integer,
parameter :: kwidth = ktop-klow+1
223 real(kind=kind_phys) :: dtot, dmax, daver
224 real(kind=kind_phys) :: fnorm, tau_min
228 fnorm = 1.0 / float(kwidth)
229 tau_min = tau_amp*fnorm
238 dmax = abs(trig_fgf(i,k))
240 if (dmax >= tlim_fgf) kex = kex+1
242 dtot = abs(trig_fgf(i,k))
243 if (dtot >= tlim_fgf) kex = kex+1
244 if ( dtot > dmax)
then
250 if (dmax .ge. tlim_fgf)
then
253 taub(i) = tau_min*float(kex)
259 call slat_geos5(im, xlatd, taub)
269 subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src)
270 integer :: nw, im, levs
271 real(kind=kind_phys),
dimension(im, levs) :: trig_okw
273 real(kind=kind_phys),
dimension(im) :: xlatd, sinlat, coslat
274 real(kind=kind_phys),
dimension(im) :: taub
275 integer,
dimension(im) :: klev, if_src
278 real(kind=kind_phys),
parameter :: tlim_okw = 100.
279 real(kind=kind_phys),
parameter :: tau_amp = 35.e-3
280 real(kind=kind_phys),
parameter :: pmax = 750.e2, pmin = 100.e2
281 integer,
parameter :: klow =127-92, ktop=127-45
282 integer,
parameter :: kwidth = ktop-klow+1
284 real(kind=kind_phys) :: dtot, dmax, daver
285 real(kind=kind_phys) :: fnorm, tau_min
290 fnorm = 1./float(kwidth)
291 tau_min = tau_amp*fnorm
292 print *,
' get_spectra_tau_okwgw '
296 dmax = abs(trig_okw(i,k))
298 if (dmax >= tlim_okw) kex = kex+1
300 dtot = abs(trig_okw(i,k))
301 if (dtot >= tlim_fgf ) kex = kex+1
302 if ( dtot > dmax)
then
308 if (dmax >= tlim_okw)
then
311 taub(i) = tau_min*float(kex)
315 print *,
' get_spectra_tau_okwgw '