effht.inc
References to this file elsewhere.
1 !******************************************
2 !
3 ! subroutine EFFHT(HO,HV,SIGO,SIGV,MU,ZCLD,HDN,HUP,HDNinF,HUPinF)
4 !
5 ! This subroutine returns "effective emitting heights" for an atmosphere
6 ! with gaseous absorption approximated by two exponentially-decaying
7 ! profiles with distinct scale heights. For applications at
8 ! SSM/I frequencies (i.e., 19, 22, 37, 86 GHz), these absorption profiles
9 ! correspond to water vapor and dry air absorption, respectively.
10 !
11 ! Input parameters: HO, HV -- scale heights of absorption corresponding to
12 ! dry air and water vapor (km):
13 !
14 ! SIGO, SIGV -- total optical depth due to each constituent
15 ! (the present model is valid only for (sigo+sigv < 1.0) )
16 !
17 ! MU -- secant(theta), where theta is the path angle from vertical
18 !
19 ! ZCLD -- upper limit (km) of the atmospheric layer for which
20 ! hdn, hup are to be calculated. Layer extends down to the
21 ! surface. These parameters permit the separate calculation
22 ! brightness temperature contributions from a lower and
23 ! upper atmospheric layer, separated by a cloud layer at
24 ! height zcld.
25 !
26 ! Output parameters:
27 !
28 ! HDN, HUP -- "effective emitting height" of an atmospheric layer
29 ! bounded below by the surface and above at height zcld.
30 ! "Effective emitting temperature" for upward and downward
31 ! microwave radiation emitted by that layer is then given by
32 ! (Ta - gamma*hup) and (Ta - gamma*hdn), respectively, where
33 ! Ta and gamma are effective surface temperature (deg K)
34 ! and lapse rate (K / km), respectively. Brightness temperatures
35 ! due to emission from this layer are then (1 - tau)(Ta - gamma*hup)
36 ! and (1 - tau)(Ta - gamma*hdn), respectively, where tau is
37 ! the slant path transmittance of the layer at angle theta
38 !
39 ! HDinF,HUPinF -- same as hdn and hup, but for the entire
40 ! atmosphere (i.e., zcld set to infinity)
41 !
42 !
43 ! This version of EFFHT executes 83 floating point multiplications,
44 ! 11 floating point divisions, and 2 calls to exp() .
45 !
46 !----------------------------------------------
47 subroutine effht(ho,hv,sigo,sigv,mu,zcld,hdn,hup,hdninf,hupinf)
48 !
49 real ho,hv,sigo,sigv,mu,zcld,gint,zgint,hint,zhint, &
50 ginf,zginf,hinf,zhinf,hdn,hup,hdninf,hupinf
51 !
52 real hoinv,hvinv,chio,chiv,ezho,ezhv,alpha,alph2,alph3
53 real beta,beta2,beta3,mu2,mualph,cplus,cmin,dplus,dmin
54 real chiov,chivv,chioo,chioov,chiovv,chiooo,chivvv
55 real h11,h21,h12
56 real sigoo,sigov,sigvv,sigooo,sigoov,sigovv,sigvvv
57 real ezhoo,ezhov,ezhvv,ezhooo,ezhoov,ezhovv,ezhvvv
58 real s,sprim,t,tprim,u,uprim,term1,term2,term3
59 real halfmu,halfmu2,sixthmu2,etnthmu2,quartmu
60 !
61 !
62 hoinv = 1.0d0/ho
63 hvinv = 1.0d0/hv
64 chio = zcld*hoinv
65 chiv = zcld*hvinv
66 ezho = sigo*exp(-chio)
67 ezhv = sigv*exp(-chiv)
68 alpha = sigo + sigv
69 alph2 = alpha*alpha
70 alph3 = alpha*alph2
71 beta = ezho + ezhv
72 beta2 = beta*beta
73 beta3 = beta*beta2
74 !
75 mu2 = mu*mu
76 halfmu = 0.5d0*mu
77 sixthmu2 = mu2/6.0d0
78 etnthmu2 = mu2/18.0d0
79 quartmu = 0.25d0*mu
80 halfmu2 = 0.5d0*mu2
81 mualph = mu*alpha
82 cplus = 1.0d0 + mualph
83 cmin = 1.0d0 - mualph
84 dplus = halfmu2*alph2
85 dmin = dplus
86 dplus = cplus + dplus
87 dmin = cmin + dmin
88 !
89 h11 = hoinv + hvinv
90 h21 = 1.0d0/(h11 + hvinv)
91 h12 = 1.0d0/(h11 + hoinv)
92 h11 = 1.0d0/h11
93 chiov = 1.0d0 + chio + chiv
94 chioo = 1.0d0 + chio + chio
95 chivv = 1.0d0 + chiv + chiv
96 chioov = chioo + chiv
97 chiovv = chio + chivv
98 chiooo = chioo + chio
99 chivvv = chivv + chiv
100 chio = 1.0d0 + chio
101 chiv = 1.0d0 + chiv
102 sigov = sigo*sigv
103 sigoo = sigo*sigo
104 sigvv = sigv*sigv
105 sigooo = sigoo*sigo
106 sigoov = sigoo*sigv
107 sigovv = sigo*sigvv
108 sigvvv = sigvv*sigv
109 ezhoo = ezho*ezho
110 ezhov = ezho*ezhv
111 ezhvv = ezhv*ezhv
112 ezhovv = ezho*ezhvv
113 ezhoov = ezhoo*ezhv
114 ezhooo = ezhoo*ezho
115 ezhvvv = ezhvv*ezhv
116 s = sigo*ho + sigv*hv
117 sprim = ezho*ho*chio + ezhv*hv*chiv
118 t = sigoo*ho + 4.0d0*sigov*h11 + sigvv*hv
119 tprim = ezhoo*ho*chioo + 4.0d0*ezhov*h11*chiov + ezhvv*hv*chivv
120 u = sigooo*ho+9.0d0*(sigovv*h21+sigoov*h12)+sigvvv*hv
121 uprim = ezhvvv*hv*chivvv + &
122 9.0d0*(ezhovv*h21*chiovv + ezhoov*h12*chioov) + &
123 ezhooo*ho*chiooo
124 !
125 term1 = s - sprim
126 term2 = quartmu*(t - tprim)
127 term3 = etnthmu2*(u - uprim)
128 zgint = dmin*term1 + cmin*term2 + term3
129 zhint = -dplus*term1 + cplus*term2 - term3
130 term2 = quartmu*t
131 term3 = etnthmu2*u
132 zginf = dmin*s + cmin*term2 + term3
133 zhinf = -dplus*s + cplus*term2 - term3
134 term1 = alpha - beta
135 term2 = halfmu*(alph2 - beta2)
136 term3 = sixthmu2*(alph3 - beta3)
137 gint = dmin*term1 + cmin*term2 + term3
138 hint = -dplus*term1 + cplus*term2 - term3
139 term2 = halfmu*alph2
140 term3 = sixthmu2*alph3
141 ginf = dmin*alpha + cmin*term2 + term3
142 hinf = -dplus*alpha + cplus*term2 - term3
143 hdn = zgint/gint
144 hup = zhint/hint
145 hdninf = zginf/ginf
146 hupinf = zhinf/hinf
147
148 end subroutine effht
149