da_effht_tl.inc

References to this file elsewhere.
1 subroutine da_effht_tl(ho,hv,sigo,sigv,mu,zcld,hdn,hup,hdninf,hupinf, &
2                      TGL_ho,TGL_hv,TGL_sigo,TGL_sigv,TGL_mu,        &
3                      TGL_zcld,TGL_hdn,TGL_hup,TGL_hdninf,TGL_hupinf)
4 
5    !--------------------------------------------------------------------
6    ! Purpose: TBD
7    ! Input  : TGL_ho, TGL_hv, TGL_sigo, TGL_sigv, TGL_mu, TGL_zcld
8    ! Output : TGL_hdn, hdn, TGL_hup, hup, 
9    !         TGL_hdninf, hdninf, TGL_hupinf, hupinf
10    !--------------------------------------------------------------------
11 
12    implicit none
13 
14    real,   intent(in  ) :: ho,hv,sigo,sigv,mu,zcld
15    real,   intent(in  ) :: TGL_ho,TGL_hv,TGL_sigo,TGL_sigv,TGL_zcld, &
16                             TGL_mu
17    real,   intent( out) :: hdn,hup,hdninf,hupinf
18    real,   intent( out) :: TGL_hdn,TGL_hup,TGL_hdninf,TGL_hupinf
19 
20    real :: gint,zgint,hint,zhint
21    real :: ginf,zginf,hinf,zhinf
22    real :: TGL_gint,TGL_zgint,TGL_hint,TGL_zhint
23    real :: TGL_ginf,TGL_zginf,TGL_hinf,TGL_zhinf
24    real :: TGL_mu2,TGL_halfmu,TGL_sixthmu2,TGL_etnthmu2
25    real :: TGL_quartmu,TGL_halfmu2
26 
27    real :: hoinv,hvinv,chio,chiv,ezho,ezhv,alpha,alph2,alph3
28    real :: beta,beta2,beta3,mu2,mualph,cplus,cmin,dplus,dmin
29    real :: chiov,chivv,chioo,chioov,chiovv,chiooo,chivvv
30    real :: h11,h21,h12,newh11
31    real :: sigoo,sigov,sigvv,sigooo,sigoov,sigovv,sigvvv
32    real :: ezhoo,ezhov,ezhvv,ezhooo,ezhoov,ezhovv,ezhvvv
33    real :: s,sprim,t,tprim,u,uprim,term1,term2,term3
34    real :: halfmu,halfmu2,sixthmu2,etnthmu2,quartmu
35 
36    real :: TGL_hoinv,TGL_hvinv,TGL_chio,TGL_chiv,TGL_ezho
37    real :: TGL_ezhv,TGL_alpha,TGL_alph2,TGL_alph3
38    real :: TGL_beta,TGL_beta2,TGL_beta3,TGL_mualph
39    real :: TGL_cplus,TGL_cmin,TGL_dplus,TGL_dmin
40    real :: TGL_chiov,TGL_chivv,TGL_chioo,TGL_chioov
41    real :: TGL_chiovv,TGL_chiooo,TGL_chivvv
42    real :: TGL_h11,TGL_h21,TGL_h12,TGL_newh11
43    real :: TGL_sigoo,TGL_sigov,TGL_sigvv,TGL_sigooo
44    real :: TGL_sigoov,TGL_sigovv,TGL_sigvvv
45    real :: TGL_ezhoo,TGL_ezhov,TGL_ezhvv,TGL_ezhooo
46    real :: TGL_ezhoov,TGL_ezhovv,TGL_ezhvvv
47    real :: TGL_s,TGL_sprim,TGL_t,TGL_tprim
48    real :: TGL_u,TGL_uprim,TGL_term1,TGL_term2,TGL_term3
49 
50        hoinv =  1.0d0/ho
51    TGL_hoinv = -1.0d0*hoinv*hoinv*TGL_ho
52 
53        hvinv =  1.0d0/hv
54    TGL_hvinv = -1.0d0*hvinv*hvinv*TGL_hv
55 
56         chio = zcld*hoinv
57     TGL_chio = TGL_zcld*hoinv + zcld*TGL_hoinv
58 
59            chiv = zcld*hvinv
60     TGL_chiv = TGL_zcld*hvinv + zcld*TGL_hvinv
61 
62         ezho = sigo*exp(-chio)
63     TGL_ezho = TGL_sigo*exp(-chio)-TGL_chio*ezho
64 
65         ezhv = sigv*exp(-chiv)
66     TGL_ezhv = TGL_sigv*exp(-chiv)-TGL_chiv*ezhv
67 
68        alpha = sigo + sigv
69    TGL_alpha = TGL_sigo + TGL_sigv
70 
71        alph2 = alpha*alpha
72    TGL_alph2 = 2.*alpha*TGL_alpha
73 
74        alph3 = alpha*alph2
75    TGL_alph3 = TGL_alpha*alph2+alpha*TGL_alph2
76 
77         beta = ezho + ezhv
78     TGL_beta = TGL_ezho + TGL_ezhv
79 
80        beta2 = beta*beta
81    TGL_beta2 = 2.*beta*TGL_beta
82 
83        beta3 = beta*beta2
84    TGL_beta3 = TGL_beta*beta2+beta*TGL_beta2
85 
86        mu2        = mu*mu
87    TGL_mu2        = 2.*mu*TGL_mu
88        halfmu     = 0.5d0*    mu
89    TGL_halfmu     = 0.5d0*TGL_mu
90        sixthmu2   =     mu2/6.0d0
91    TGL_sixthmu2   = TGL_mu2/6.0d0
92        etnthmu2   =     mu2/18.0d0
93    TGL_etnthmu2   = TGL_mu2/18.0d0
94        quartmu    = 0.25d0*    mu
95    TGL_quartmu    = 0.25d0*TGL_mu
96        halfmu2    = 0.5d0*    mu2
97    TGL_halfmu2    = 0.5d0*TGL_mu2
98 
99           mualph = mu*alpha
100    TGL_mualph = TGL_mu*alpha + mu*TGL_alpha
101 
102        cplus  = 1.0d0 +     mualph
103    TGL_cplus  =         TGL_mualph
104 
105        cmin   = 1.0d0 -     mualph
106    TGL_cmin   =       - TGL_mualph
107 
108        dplus  = halfmu2*alph2
109    TGL_dplus  = TGL_halfmu2*alph2 + halfmu2*TGL_alph2
110 
111        dmin   =     dplus
112    TGL_dmin   = TGL_dplus
113 
114    TGL_dplus  = TGL_cplus + TGL_dplus
115        dplus  =     cplus +     dplus
116 
117    TGL_dmin   = TGL_cmin  + TGL_dmin
118        dmin   =     cmin  +     dmin
119 
120 
121        h11    =     hoinv +     hvinv
122    TGL_h11    = TGL_hoinv + TGL_hvinv
123 
124        h21    =  1.0d0/(h11 + hvinv)
125    TGL_h21    = -1.0d0*h21*h21*(TGL_h11+TGL_hvinv)
126 
127        h12    =  1.0d0/(h11 + hoinv)
128    TGL_h12    = -1.0d0*h12*h12*(TGL_h11 + TGL_hoinv)
129 
130        newh11 =  1.0d0/h11
131    TGL_newh11 = -1.0d0*newh11*newh11*TGL_h11
132 
133        chiov  = 1.0d0 +     chio +     chiv
134    TGL_chiov  =         TGL_chio + TGL_chiv
135 
136        chioo  = 1.0d0 +     chio +     chio
137    TGL_chioo  =         TGL_chio + TGL_chio
138 
139        chivv  = 1.0d0 +     chiv +     chiv
140    TGL_chivv  =         TGL_chiv + TGL_chiv
141 
142        chioov =     chioo +     chiv
143    TGL_chioov = TGL_chioo + TGL_chiv
144 
145           chiovv =     chio  +     chivv
146    TGL_chiovv = TGL_chio  + TGL_chivv
147 
148        chiooo =     chioo +     chio
149    TGL_chiooo = TGL_chioo + TGL_chio
150 
151        chivvv =     chivv +     chiv
152    TGL_chivvv = TGL_chivv + TGL_chiv
153 
154    TGL_chio   =         TGL_chio
155        chio   = 1.0d0 +     chio
156 
157    TGL_chiv   =         TGL_chiv
158        chiv   = 1.0d0 +     chiv
159 
160        sigov  = sigo*sigv
161    TGL_sigov  = TGL_sigo*sigv + sigo*TGL_sigv
162 
163        sigoo  = sigo*sigo
164    TGL_sigoo  = 2.*sigo*TGL_sigo
165 
166        sigvv  = sigv*sigv
167    TGL_sigvv  = 2.*sigv*TGL_sigv
168 
169        sigooo = sigoo*sigo
170    TGL_sigooo = TGL_sigoo*sigo + sigoo*TGL_sigo
171 
172        sigoov = sigoo*sigv
173    TGL_sigoov = TGL_sigoo*sigv + sigoo*TGL_sigv
174 
175        sigovv = sigo*sigvv
176    TGL_sigovv = TGL_sigo*sigvv + sigo*TGL_sigvv
177 
178        sigvvv = sigvv*sigv
179    TGL_sigvvv = TGL_sigvv*sigv + sigvv*TGL_sigv
180 
181        ezhoo  = ezho*ezho
182    TGL_ezhoo  = 2.*ezho*TGL_ezho
183 
184        ezhov  = ezho*ezhv
185    TGL_ezhov  = TGL_ezho*ezhv + ezho*TGL_ezhv
186 
187        ezhvv  = ezhv*ezhv
188    TGL_ezhvv  = 2.*ezhv*TGL_ezhv
189 
190        ezhovv = ezho*ezhvv
191    TGL_ezhovv = TGL_ezho*ezhvv + ezho*TGL_ezhvv
192 
193        ezhoov = ezhoo*ezhv
194    TGL_ezhoov = TGL_ezhoo*ezhv + ezhoo*TGL_ezhv
195 
196        ezhooo = ezhoo*ezho
197    TGL_ezhooo = TGL_ezhoo*ezho + ezhoo*TGL_ezho
198 
199        ezhvvv = ezhvv*ezhv
200    TGL_ezhvvv = TGL_ezhvv*ezhv + ezhvv*TGL_ezhv
201 
202        s      = sigo*ho + sigv*hv
203    TGL_s      = TGL_sigo*ho + sigo*TGL_ho + TGL_sigv*hv + sigv*TGL_hv
204 
205        sprim  = ezho*ho*chio + ezhv*hv*chiv
206    TGL_sprim  = TGL_ezho*ho*chio + ezho*TGL_ho*chio + ezho*ho*TGL_chio + &
207                 TGL_ezhv*hv*chiv + ezhv*TGL_hv*chiv + ezhv*hv*TGL_chiv
208 
209        t      = sigoo*ho + 4.0d0*sigov*newh11 + sigvv*hv
210    TGL_t      = TGL_sigoo*ho + sigoo*TGL_ho + &
211                 4.0d0*(TGL_sigov*newh11 + sigov*TGL_newh11) + &
212                 TGL_sigvv*hv + sigvv*TGL_hv
213 
214        tprim  = ezhoo*ho*chioo + 4.0d0*ezhov*newh11*chiov + ezhvv*hv*chivv
215    TGL_tprim  = TGL_ezhoo*ho*chioo +ezhoo*TGL_ho*chioo + ezhoo*ho*TGL_chioo + &
216                 4.0d0*(TGL_ezhov*newh11*chiov +    &
217                        ezhov*TGL_newh11*chiov +    &
218                        ezhov*newh11*TGL_chiov ) + &
219                 TGL_ezhvv*hv*chivv + ezhvv*TGL_hv*chivv + ezhvv*hv*TGL_chivv
220 
221        u      = sigooo*ho + 9.0d0*(sigovv*h21+sigoov*h12) + sigvvv*hv
222    TGL_u      = TGL_sigooo*ho + sigooo*TGL_ho + &
223                 9.0d0*(TGL_sigovv*h21 + sigovv*TGL_h21 +    &
224                        TGL_sigoov*h12 + sigoov*TGL_h12 ) + &
225                 TGL_sigvvv*hv + sigvvv*TGL_hv
226 
227        uprim  = ezhvvv*hv*chivvv +  &
228                 9.0d0*(ezhovv*h21*chiovv + ezhoov*h12*chioov) + &
229                 ezhooo*ho*chiooo
230    TGL_uprim  = TGL_ezhvvv*hv*chivvv +ezhvvv*TGL_hv*chivvv+ ezhvvv*hv*TGL_chivvv+  &
231                  9.0d0*(TGL_ezhovv*h21*chiovv +     &
232                         ezhovv*TGL_h21*chiovv +     &
233                         ezhovv*h21*TGL_chiovv +     &
234                         TGL_ezhoov*h12*chioov +     &
235                         ezhoov*TGL_h12*chioov +     &
236                         ezhoov*h12*TGL_chioov  ) + &
237                  TGL_ezhooo*ho*chiooo + ezhooo*TGL_ho*chiooo + ezhooo*ho*TGL_chiooo
238 
239        term1  =     s -     sprim
240    TGL_term1  = TGL_s - TGL_sprim
241 
242        term2  = quartmu*(t - tprim)
243    TGL_term2  = TGL_quartmu*(t - tprim) + quartmu*(TGL_t - TGL_tprim) 
244 
245        term3  = etnthmu2*(   u -     uprim)
246    TGL_term3  = TGL_etnthmu2*(u - uprim) + etnthmu2*(TGL_u - TGL_uprim)
247 
248        zgint  = dmin*term1 +  cmin*term2 + term3
249    TGL_zgint  = TGL_dmin*term1 + dmin*TGL_term1 + &
250                 TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
251 
252     zhint  = -dplus*term1 + cplus*term2 - term3
253    TGL_zhint  = -TGL_dplus*term1 - dplus*TGL_term1 + &
254                  TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
255 
256        term2  = quartmu * t
257    TGL_term2  = TGL_quartmu*t + quartmu*TGL_t
258 
259        term3  = etnthmu2*u
260    TGL_term3  = TGL_etnthmu2*u + etnthmu2*TGL_u
261 
262        zginf  = dmin*s +  cmin*term2 + term3
263    TGL_zginf  = TGL_dmin*s + dmin*TGL_s +  &
264                 TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
265 
266        zhinf  = -dplus*s + cplus*term2 - term3
267    TGL_zhinf  = -TGL_dplus*s - dplus*TGL_s + &
268                  TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
269 
270        term1  =     alpha -     beta
271    TGL_term1  = TGL_alpha - TGL_beta
272 
273        term2  = halfmu*(   alph2 -     beta2)
274    TGL_term2  = TGL_halfmu*(alph2 - beta2) + halfmu*(TGL_alph2 - TGL_beta2)
275 
276        term3  = sixthmu2*(   alph3 -     beta3)
277    TGL_term3  = TGL_sixthmu2*(alph3 - beta3) + sixthmu2*(TGL_alph3 - TGL_beta3)
278 
279        gint   = dmin*term1 +  cmin*term2 + term3
280    TGL_gint   = TGL_dmin*term1 + dmin*TGL_term1 + &
281                 TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
282 
283        hint   = -dplus*term1 + cplus*term2 - term3
284    TGL_hint   = -TGL_dplus*term1 - dplus*TGL_term1 + &
285                  TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
286 
287        term2  = halfmu*alph2
288    TGL_term2  = TGL_halfmu*alph2 + halfmu*TGL_alph2
289 
290        term3  = sixthmu2*alph3
291    TGL_term3  = TGL_sixthmu2*alph3 + sixthmu2*TGL_alph3
292 
293        ginf   = dmin*alpha +  cmin*term2 + term3
294    TGL_ginf   = TGL_dmin*alpha + dmin*TGL_alpha +  &
295                 TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
296 
297        hinf   = -dplus*alpha + cplus*term2 - term3
298    TGL_hinf   = -TGL_dplus*alpha - dplus*TGL_alpha + &
299                  TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
300 
301        hdn    = zgint/gint
302    TGL_hdn    = TGL_zgint/gint - hdn * TGL_gint/gint
303 
304        hup    = zhint/hint
305    TGL_hup    = TGL_zhint/hint - hup*TGL_hint/hint
306 
307        hdninf = zginf/ginf
308    TGL_hdninf = TGL_zginf/ginf - hdninf*TGL_ginf/ginf
309 
310        hupinf = zhinf/hinf
311    TGL_hupinf = TGL_zhinf/hinf - hupinf*TGL_hinf/hinf
312 
313 end subroutine da_effht_tl
314 
315