<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_EFFHT_TL'><A href='../../html_code/ssmi/da_effht_tl.inc.html#DA_EFFHT_TL' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_effht_tl(ho,hv,sigo,sigv,mu,zcld,hdn,hup,hdninf,hupinf, & 1,2
TGL_ho,TGL_hv,TGL_sigo,TGL_sigv,TGL_mu, &
TGL_zcld,TGL_hdn,TGL_hup,TGL_hdninf,TGL_hupinf)
!--------------------------------------------------------------------
! Purpose: TBD
! Input : TGL_ho, TGL_hv, TGL_sigo, TGL_sigv, TGL_mu, TGL_zcld
! Output : TGL_hdn, hdn, TGL_hup, hup,
! TGL_hdninf, hdninf, TGL_hupinf, hupinf
!--------------------------------------------------------------------
implicit none
real, intent(in) :: ho,hv,sigo,sigv,mu,zcld
real, intent(in) :: TGL_ho,TGL_hv,TGL_sigo,TGL_sigv,TGL_zcld, TGL_mu
real, intent(out) :: hdn,hup,hdninf,hupinf
real, intent(out) :: TGL_hdn,TGL_hup,TGL_hdninf,TGL_hupinf
real :: gint,zgint,hint,zhint
real :: ginf,zginf,hinf,zhinf
real :: TGL_gint,TGL_zgint,TGL_hint,TGL_zhint
real :: TGL_ginf,TGL_zginf,TGL_hinf,TGL_zhinf
real :: TGL_mu2,TGL_halfmu,TGL_sixthmu2,TGL_etnthmu2
real :: TGL_quartmu,TGL_halfmu2
real :: hoinv,hvinv,chio,chiv,ezho,ezhv,alpha,alph2,alph3
real :: beta,beta2,beta3,mu2,mualph,cplus,cmin,dplus,dmin
real :: chiov,chivv,chioo,chioov,chiovv,chiooo,chivvv
real :: h11,h21,h12,newh11
real :: sigoo,sigov,sigvv,sigooo,sigoov,sigovv,sigvvv
real :: ezhoo,ezhov,ezhvv,ezhooo,ezhoov,ezhovv,ezhvvv
real :: s,sprim,t,tprim,u,uprim,term1,term2,term3
real :: halfmu,halfmu2,sixthmu2,etnthmu2,quartmu
real :: TGL_hoinv,TGL_hvinv,TGL_chio,TGL_chiv,TGL_ezho
real :: TGL_ezhv,TGL_alpha,TGL_alph2,TGL_alph3
real :: TGL_beta,TGL_beta2,TGL_beta3,TGL_mualph
real :: TGL_cplus,TGL_cmin,TGL_dplus,TGL_dmin
real :: TGL_chiov,TGL_chivv,TGL_chioo,TGL_chioov
real :: TGL_chiovv,TGL_chiooo,TGL_chivvv
real :: TGL_h11,TGL_h21,TGL_h12,TGL_newh11
real :: TGL_sigoo,TGL_sigov,TGL_sigvv,TGL_sigooo
real :: TGL_sigoov,TGL_sigovv,TGL_sigvvv
real :: TGL_ezhoo,TGL_ezhov,TGL_ezhvv,TGL_ezhooo
real :: TGL_ezhoov,TGL_ezhovv,TGL_ezhvvv
real :: TGL_s,TGL_sprim,TGL_t,TGL_tprim
real :: TGL_u,TGL_uprim,TGL_term1,TGL_term2,TGL_term3
if (trace_use) call da_trace_entry
("da_effht_tl")
hoinv = 1.0d0/ho
TGL_hoinv = -1.0d0*hoinv*hoinv*TGL_ho
hvinv = 1.0d0/hv
TGL_hvinv = -1.0d0*hvinv*hvinv*TGL_hv
chio = zcld*hoinv
TGL_chio = TGL_zcld*hoinv + zcld*TGL_hoinv
chiv = zcld*hvinv
TGL_chiv = TGL_zcld*hvinv + zcld*TGL_hvinv
ezho = sigo*exp(-chio)
TGL_ezho = TGL_sigo*exp(-chio)-TGL_chio*ezho
ezhv = sigv*exp(-chiv)
TGL_ezhv = TGL_sigv*exp(-chiv)-TGL_chiv*ezhv
alpha = sigo + sigv
TGL_alpha = TGL_sigo + TGL_sigv
alph2 = alpha*alpha
TGL_alph2 = 2.0*alpha*TGL_alpha
alph3 = alpha*alph2
TGL_alph3 = TGL_alpha*alph2+alpha*TGL_alph2
beta = ezho + ezhv
TGL_beta = TGL_ezho + TGL_ezhv
beta2 = beta*beta
TGL_beta2 = 2.0*beta*TGL_beta
beta3 = beta*beta2
TGL_beta3 = TGL_beta*beta2+beta*TGL_beta2
mu2 = mu*mu
TGL_mu2 = 2.0*mu*TGL_mu
halfmu = 0.5d0* mu
TGL_halfmu = 0.5d0*TGL_mu
sixthmu2 = mu2/6.0d0
TGL_sixthmu2 = TGL_mu2/6.0d0
etnthmu2 = mu2/18.0d0
TGL_etnthmu2 = TGL_mu2/18.0d0
quartmu = 0.25d0* mu
TGL_quartmu = 0.25d0*TGL_mu
halfmu2 = 0.5d0* mu2
TGL_halfmu2 = 0.5d0*TGL_mu2
mualph = mu*alpha
TGL_mualph = TGL_mu*alpha + mu*TGL_alpha
cplus = 1.0d0 + mualph
TGL_cplus = TGL_mualph
cmin = 1.0d0 - mualph
TGL_cmin = - TGL_mualph
dplus = halfmu2*alph2
TGL_dplus = TGL_halfmu2*alph2 + halfmu2*TGL_alph2
dmin = dplus
TGL_dmin = TGL_dplus
TGL_dplus = TGL_cplus + TGL_dplus
dplus = cplus + dplus
TGL_dmin = TGL_cmin + TGL_dmin
dmin = cmin + dmin
h11 = hoinv + hvinv
TGL_h11 = TGL_hoinv + TGL_hvinv
h21 = 1.0d0/(h11 + hvinv)
TGL_h21 = -1.0d0*h21*h21*(TGL_h11+TGL_hvinv)
h12 = 1.0d0/(h11 + hoinv)
TGL_h12 = -1.0d0*h12*h12*(TGL_h11 + TGL_hoinv)
newh11 = 1.0d0/h11
TGL_newh11 = -1.0d0*newh11*newh11*TGL_h11
chiov = 1.0d0 + chio + chiv
TGL_chiov = TGL_chio + TGL_chiv
chioo = 1.0d0 + chio + chio
TGL_chioo = TGL_chio + TGL_chio
chivv = 1.0d0 + chiv + chiv
TGL_chivv = TGL_chiv + TGL_chiv
chioov = chioo + chiv
TGL_chioov = TGL_chioo + TGL_chiv
chiovv = chio + chivv
TGL_chiovv = TGL_chio + TGL_chivv
chiooo = chioo + chio
TGL_chiooo = TGL_chioo + TGL_chio
chivvv = chivv + chiv
TGL_chivvv = TGL_chivv + TGL_chiv
TGL_chio = TGL_chio
chio = 1.0d0 + chio
TGL_chiv = TGL_chiv
chiv = 1.0d0 + chiv
sigov = sigo*sigv
TGL_sigov = TGL_sigo*sigv + sigo*TGL_sigv
sigoo = sigo*sigo
TGL_sigoo = 2.0*sigo*TGL_sigo
sigvv = sigv*sigv
TGL_sigvv = 2.0*sigv*TGL_sigv
sigooo = sigoo*sigo
TGL_sigooo = TGL_sigoo*sigo + sigoo*TGL_sigo
sigoov = sigoo*sigv
TGL_sigoov = TGL_sigoo*sigv + sigoo*TGL_sigv
sigovv = sigo*sigvv
TGL_sigovv = TGL_sigo*sigvv + sigo*TGL_sigvv
sigvvv = sigvv*sigv
TGL_sigvvv = TGL_sigvv*sigv + sigvv*TGL_sigv
ezhoo = ezho*ezho
TGL_ezhoo = 2.0*ezho*TGL_ezho
ezhov = ezho*ezhv
TGL_ezhov = TGL_ezho*ezhv + ezho*TGL_ezhv
ezhvv = ezhv*ezhv
TGL_ezhvv = 2.0*ezhv*TGL_ezhv
ezhovv = ezho*ezhvv
TGL_ezhovv = TGL_ezho*ezhvv + ezho*TGL_ezhvv
ezhoov = ezhoo*ezhv
TGL_ezhoov = TGL_ezhoo*ezhv + ezhoo*TGL_ezhv
ezhooo = ezhoo*ezho
TGL_ezhooo = TGL_ezhoo*ezho + ezhoo*TGL_ezho
ezhvvv = ezhvv*ezhv
TGL_ezhvvv = TGL_ezhvv*ezhv + ezhvv*TGL_ezhv
s = sigo*ho + sigv*hv
TGL_s = TGL_sigo*ho + sigo*TGL_ho + TGL_sigv*hv + sigv*TGL_hv
sprim = ezho*ho*chio + ezhv*hv*chiv
TGL_sprim = TGL_ezho*ho*chio + ezho*TGL_ho*chio + ezho*ho*TGL_chio + &
TGL_ezhv*hv*chiv + ezhv*TGL_hv*chiv + ezhv*hv*TGL_chiv
t = sigoo*ho + 4.0d0*sigov*newh11 + sigvv*hv
TGL_t = TGL_sigoo*ho + sigoo*TGL_ho + &
4.0d0*(TGL_sigov*newh11 + sigov*TGL_newh11) + &
TGL_sigvv*hv + sigvv*TGL_hv
tprim = ezhoo*ho*chioo + 4.0d0*ezhov*newh11*chiov + ezhvv*hv*chivv
TGL_tprim = TGL_ezhoo*ho*chioo +ezhoo*TGL_ho*chioo + ezhoo*ho*TGL_chioo + &
4.0d0*(TGL_ezhov*newh11*chiov + &
ezhov*TGL_newh11*chiov + &
ezhov*newh11*TGL_chiov ) + &
TGL_ezhvv*hv*chivv + ezhvv*TGL_hv*chivv + ezhvv*hv*TGL_chivv
u = sigooo*ho + 9.0d0*(sigovv*h21+sigoov*h12) + sigvvv*hv
TGL_u = TGL_sigooo*ho + sigooo*TGL_ho + &
9.0d0*(TGL_sigovv*h21 + sigovv*TGL_h21 + &
TGL_sigoov*h12 + sigoov*TGL_h12 ) + &
TGL_sigvvv*hv + sigvvv*TGL_hv
uprim = ezhvvv*hv*chivvv + &
9.0d0*(ezhovv*h21*chiovv + ezhoov*h12*chioov) + &
ezhooo*ho*chiooo
TGL_uprim = TGL_ezhvvv*hv*chivvv +ezhvvv*TGL_hv*chivvv+ ezhvvv*hv*TGL_chivvv+ &
9.0d0*(TGL_ezhovv*h21*chiovv + &
ezhovv*TGL_h21*chiovv + &
ezhovv*h21*TGL_chiovv + &
TGL_ezhoov*h12*chioov + &
ezhoov*TGL_h12*chioov + &
ezhoov*h12*TGL_chioov ) + &
TGL_ezhooo*ho*chiooo + ezhooo*TGL_ho*chiooo + ezhooo*ho*TGL_chiooo
term1 = s - sprim
TGL_term1 = TGL_s - TGL_sprim
term2 = quartmu*(t - tprim)
TGL_term2 = TGL_quartmu*(t - tprim) + quartmu*(TGL_t - TGL_tprim)
term3 = etnthmu2*( u - uprim)
TGL_term3 = TGL_etnthmu2*(u - uprim) + etnthmu2*(TGL_u - TGL_uprim)
zgint = dmin*term1 + cmin*term2 + term3
TGL_zgint = TGL_dmin*term1 + dmin*TGL_term1 + &
TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
zhint = -dplus*term1 + cplus*term2 - term3
TGL_zhint = -TGL_dplus*term1 - dplus*TGL_term1 + &
TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
term2 = quartmu * t
TGL_term2 = TGL_quartmu*t + quartmu*TGL_t
term3 = etnthmu2*u
TGL_term3 = TGL_etnthmu2*u + etnthmu2*TGL_u
zginf = dmin*s + cmin*term2 + term3
TGL_zginf = TGL_dmin*s + dmin*TGL_s + &
TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
zhinf = -dplus*s + cplus*term2 - term3
TGL_zhinf = -TGL_dplus*s - dplus*TGL_s + &
TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
term1 = alpha - beta
TGL_term1 = TGL_alpha - TGL_beta
term2 = halfmu*( alph2 - beta2)
TGL_term2 = TGL_halfmu*(alph2 - beta2) + halfmu*(TGL_alph2 - TGL_beta2)
term3 = sixthmu2*( alph3 - beta3)
TGL_term3 = TGL_sixthmu2*(alph3 - beta3) + sixthmu2*(TGL_alph3 - TGL_beta3)
gint = dmin*term1 + cmin*term2 + term3
TGL_gint = TGL_dmin*term1 + dmin*TGL_term1 + &
TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
hint = -dplus*term1 + cplus*term2 - term3
TGL_hint = -TGL_dplus*term1 - dplus*TGL_term1 + &
TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
term2 = halfmu*alph2
TGL_term2 = TGL_halfmu*alph2 + halfmu*TGL_alph2
term3 = sixthmu2*alph3
TGL_term3 = TGL_sixthmu2*alph3 + sixthmu2*TGL_alph3
ginf = dmin*alpha + cmin*term2 + term3
TGL_ginf = TGL_dmin*alpha + dmin*TGL_alpha + &
TGL_cmin*term2 + cmin*TGL_term2 + TGL_term3
hinf = -dplus*alpha + cplus*term2 - term3
TGL_hinf = -TGL_dplus*alpha - dplus*TGL_alpha + &
TGL_cplus*term2 + cplus*TGL_term2 - TGL_term3
hdn = zgint/gint
TGL_hdn = TGL_zgint/gint - hdn * TGL_gint/gint
hup = zhint/hint
TGL_hup = TGL_zhint/hint - hup*TGL_hint/hint
hdninf = zginf/ginf
TGL_hdninf = TGL_zginf/ginf - hdninf*TGL_ginf/ginf
hupinf = zhinf/hinf
TGL_hupinf = TGL_zhinf/hinf - hupinf*TGL_hinf/hinf
if (trace_use) call da_trace_exit("da_effht_tl")
end subroutine da_effht_tl