AATSR.f0000644002107500000270000000666512463730616010420 0ustar jckraps subroutine aatsr(iwa)
c
c created: J. Nieke july/2003
c aatsr response function values
c are based on version (ESA/Vega/H. Tait)
c v55_srf.txt, v659_srf.txt, v870_srf.txt, v16_srf.txt
c Values are interpolated to 2.5nm wavelenght intervals
c
c
real s,wlinf,wlsup
common /sixs_ffu/ s(1501),wlinf,wlsup
real sr(8,1501),wli(8),wls(8)
integer iwa,l,i
c band 1 of AATSR (0.525000 => 0.592500um)
DATA (SR(1,L),L=1,1501)/ 111*0.,
A 0.00114, 0.00120, 0.00109, 0.00373, 0.00495, 0.01321,
A 0.03203, 0.08190, 0.25129, 0.69749, 0.97208, 1.00000,
A 0.98655, 0.92234, 0.78359, 0.64632, 0.55174, 0.50241,
A 0.41232, 0.23254, 0.10744, 0.05272, 0.02769, 0.01528,
A 0.00970, 0.00540,0.00114,
A1363*0./
c band 2 of AATSR (0.6275 => 0.6975um)
DATA (SR(2,L),L=1,1501)/ 152*0.,
A 0.00007, 0.00106, 0.00259, 0.00588, 0.01313, 0.03452,
A 0.09925, 0.25868, 0.53662, 0.75311, 0.90226, 0.99149,
A 1.00000, 0.96028, 0.90110, 0.76907, 0.47949, 0.21557,
A 0.08929, 0.04225, 0.02272, 0.01292, 0.00778, 0.00473,
A 0.00264, 0.00144, 0.00060, 0.00031,
A1321*0./
c band 3 of AATSR (0.8325 => 0.9025um)
DATA (SR(3,L),L=1,1501)/ 233*0.,
A 0.00059, 0.00104, 0.00210, 0.00389, 0.00839, 0.01991,
A 0.05815, 0.20311, 0.59432, 0.95300, 0.92949, 0.87362,
A 0.91049, 1.00000, 0.99161, 0.79466, 0.46286, 0.20633,
A 0.08993, 0.04324, 0.02196, 0.01186, 0.00674, 0.00372,
A 0.00199, 0.00099, 0.00035, 0.00001, 0.00001,
A1239*0./
c band 4 of AATSR (1.4475 => 1.7775um)
DATA (SR(4,L),L=1,1501)/ 479*0.,
A 0.00001, 0.00001, 0.00000, 0.00000, 0.00000, 0.00000,
A 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00001,
A 0.00003, 0.00007, 0.00010, 0.00016, 0.00018, 0.00019,
A 0.00038, 0.00070, 0.00074, 0.00087, 0.00099, 0.00112,
A 0.00144, 0.00178, 0.00210, 0.00252, 0.00314, 0.00381,
A 0.00482, 0.00617, 0.00808, 0.01087, 0.01507, 0.02115,
A 0.03014, 0.04352, 0.06372, 0.09368, 0.13303, 0.18172,
A 0.23900, 0.29735, 0.36285, 0.43193, 0.50378, 0.57403,
A 0.64865, 0.72474, 0.79732, 0.86795, 0.92477, 0.96695,
A 0.99173, 1.00000, 0.99937, 0.99592, 0.98624, 0.97501,
A 0.95695, 0.93594, 0.90325, 0.87127, 0.83451, 0.79304,
A 0.75320, 0.70611, 0.65958, 0.60791, 0.55348, 0.49819,
A 0.43767, 0.37291, 0.30937, 0.24880, 0.19559, 0.14848,
A 0.10947, 0.07940, 0.05786, 0.04258, 0.03172, 0.02439,
A 0.01898, 0.01500, 0.01187, 0.00984, 0.00810, 0.00664,
A 0.00558, 0.00481, 0.00407, 0.00346, 0.00293, 0.00260,
A 0.00218, 0.00180, 0.00167, 0.00149, 0.00132, 0.00127,
A 0.00118, 0.00083, 0.00056, 0.00049, 0.00048, 0.00048,
A 0.00046, 0.00043, 0.00038, 0.00031, 0.00027, 0.00024,
A 0.00024, 0.00023, 0.00024, 0.00024, 0.00024, 0.00025,
A 0.00025, 0.00026, 0.00026, 0.00027, 0.00027, 0.00027,
A 0.00028, 0.00028, 0.00028, 0.00029, 0.00029, 0.00028,
A 0.00032,
A889*0./
c channel 1 lower and upper wavelength
wli(1)=0.525
wls(1)=0.5925
c channel 2 lower and upper wavelength
wli(2)=0.6275
wls(2)=0.6975
c channel 3 lower and upper wavelength
wli(3)=0.8325
wls(3)=0.9025
c channel 4 lower and upper wavelength
wli(4)=1.4475
wls(4)=1.7775
do 1 i=1,1501
s(i)=sr(iwa,i)
1 continue
wlinf=wli(iwa)
wlsup=wls(iwa)
return
end
ABSTRA.f0000644002107500000270000003442112463730616010511 0ustar jckraps subroutine abstra (idatm,wl,xmus,xmuv,uw,uo3,uwus,uo3us,
a idatmp,uwpl,uo3pl,uwusp,uo3usp,
a dtwava,dtozon,dtdica,dtoxyg,dtniox,dtmeth,dtmoca,
a utwava,utozon,utdica,utoxyg,utniox,utmeth,utmoca,
a ttwava,ttozon,ttdica,ttoxyg,ttniox,ttmeth,ttmoca )
c transmittance calculation for ozone, water vapor,
c carbon dioxyde and oxygen.
c downward absorption water vapor dtwava
c downward absorption ozone dtozon
c downward absorption carbon diox dtdica
c downward absorption oxygen dtoxyg
c downward absorption nitrous oxi dtniox
c downward absorption methane dtmeth
c downward absorption carbon mono dtmoca
c upward absorption water vapor utwava
c upward absorption ozone utozon
c upward absorption carbon diox utdica
c upward absorption oxygen utoxyg
c upward absorption nitrous oxi utniox
c upward absorption methane utmeth
c upward absorption carbon mono utmoca
c total(on the two paths ) absorption water vapor ttwava
c total(on the two paths ) absorption ozone ttozon
c total(on the two paths ) absorption carbon diox ttdica
c total(on the two paths ) absorption oxygen ttoxyg
c total absorption nitrous oxi ttniox
c total absorption methane ttmeth
c total absorption carbon mono ttmoca
common /sixs_atm/ z(34),p(34),t(34),wh(34),wo(34)
common /sixs_planesim/ zpl(34),ppl(34),tpl(34),whpl(34),wopl(34)
real z,p,t,wh,wo
real zpl,ppl,tpl,whpl,wopl
integer iv,ivli(6),idatm,idatmp,i,id,idgaz,inu,k,n,nh
real co3(102),tnu(10,3),
a a(8),rm(34),r2(34),r3(34),tp(34),rat(10)
real rmpl(34),r2pl(34),r3pl(34),ratpl(10)
real cch2o(15)
real wl,xmus,xmuv,uw,uo3,uwus,uo3us,uwpl,uo3pl,uwusp,uo3usp
real accu,ah2o,xh,dtcont,utcont,ttcont
double precision ptest1,ptest
real dtoxyg,dtniox,dtmeth,dtmoca,dtwava,dtozon,dtdica
real utniox,utdica,utoxyg,utwava,utozon
real utmeth,utmoca,ttwava,ttozon,ttdica,ttoxyg,ttniox,ttmeth
real ttmoca
real p0,g,t0,ds,te,roair,air,roco2,rmo2,rmo3,rmn2o,rmch4
real rmco,v,te2,phi,psi,uu,u,up,uud,uut,uuu
real ud,ut,upd,upt,udp,updp,udtp,updtp
real ds2,uupl,upl,uppl
real xi,xd,ako3,test1,test2,test3,udt,atest
real updt,tt,y,utt,uptt,tn
C
data(ivli(i),i=1,6)/2500,5060,7620,10180,12740,15300/
data(co3(i),i= 1, 102)/
a 4.50e-03, 8.00e-03, 1.07e-02, 1.10e-02, 1.27e-02, 1.71e-02,
a 2.00e-02, 2.45e-02, 3.07e-02, 3.84e-02, 4.78e-02, 5.67e-02,
a 6.54e-02, 7.62e-02, 9.15e-02, 1.00e-01, 1.09e-01, 1.20e-01,
a 1.28e-01, 1.12e-01, 1.11e-01, 1.16e-01, 1.19e-01, 1.13e-01,
a 1.03e-01, 9.24e-02, 8.28e-02, 7.57e-02, 7.07e-02, 6.58e-02,
a 5.56e-02, 4.77e-02, 4.06e-02, 3.87e-02, 3.82e-02, 2.94e-02,
a 2.09e-02, 1.80e-02, 1.91e-02, 1.66e-02, 1.17e-02, 7.70e-03,
a 6.10e-03, 8.50e-03, 6.10e-03, 3.70e-03, 3.20e-03, 3.10e-03,
a 2.55e-03, 1.98e-03, 1.40e-03, 8.25e-04, 2.50e-04, 0. ,
a 0. , 0. , 5.65e-04, 2.04e-03, 7.35e-03, 2.03e-02,
a 4.98e-02, 1.18e-01, 2.46e-01, 5.18e-01, 1.02e+00, 1.95e+00,
a 3.79e+00, 6.65e+00, 1.24e+01, 2.20e+01, 3.67e+01, 5.95e+01,
a 8.50e+01, 1.26e+02, 1.68e+02, 2.06e+02, 2.42e+02, 2.71e+02,
a 2.91e+02, 3.02e+02, 3.03e+02, 2.94e+02, 2.77e+02, 2.54e+02,
a 2.26e+02, 1.96e+02, 1.68e+02, 1.44e+02, 1.17e+02, 9.75e+01,
a 7.65e+01, 6.04e+01, 4.62e+01, 3.46e+01, 2.52e+01, 2.00e+01,
a 1.57e+01, 1.20e+01, 1.00e+01, 8.80e+00, 8.30e+00, 8.60e+00/
DATA (CCH2O(I),I=1,15)/
a 0.00,0.19,0.15,0.12,0.10,0.09,0.10,0.12,0.15,0.17,0.20,0.24,
a 0.28,0.33,0.00/
accu=1.E-10
dtwava=1.
utwava=1.
ttwava=1.
dtcont=1.
utcont=1.
ttcont=1.
dtozon=1.
utozon=1.
ttozon=1.
dtdica=1.
utdica=1.
ttdica=1.
dtoxyg=1.
utoxyg=1.
ttoxyg=1.
dtniox=1.
utniox=1.
ttniox=1.
dtmeth=1.
utmeth=1.
ttmeth=1.
dtmoca=1.
utmoca=1.
ttmoca=1.
do 201 i=1,10
corig do 201 i=1,7
rat(i)=1.
tnu(i,1)=1.
tnu(i,2)=1.
tnu(i,3)=1.
201 continue
if (idatm.eq.0) return
if((xmus.eq.0.).or.(xmuv.eq.0.)) goto 95
c constants determination
p0=1013.25
g=98.1
t0=250.
c volumic mass in kilogrammes per m3
ds=0.
te=0.
roair=0.
air=0.028964/0.0224
roco2=0.044/0.0224
rmo2=0.032/0.0224
rmo3=0.048/0.0224
rmn2o=0.044/0.0224
rmch4=0.016/0.0224
rmco =0.028/0.0224
uwus=1.424
uo3us=.344
if(idatm.eq.8) goto 80
goto 90
80 rat(1)=uw/uwus
rat(2)=1.
rat(3)=1.
rat(4)=uo3/uo3us
rat(5)=1.
rat(6)=1.
rat(7)=1.
rat(8)=uw/uwus
rat(9)=uw/uwus
rat(10)=uw/uwus
90 v=1.0e+04/wl
iv=v/5.
iv=iv*5
id=((iv-2500)/10)/256+1
do 40 idgaz=1,7
c
c
if (id.le.6) inu=(iv-ivli(id))/10+1
goto(101,102,103,104,105,106),id
goto 270
106 if(idgaz.eq.1) call wava6(a,inu)
if(idgaz.eq.2) goto 270
if(idgaz.eq.3) call oxyg6(a,inu)
if(idgaz.eq.4) goto 270
if(idgaz.eq.5) call niox6(a,inu)
if(idgaz.eq.6) call meth6(a,inu)
if(idgaz.eq.7) call moca6(a,inu)
goto 271
105 if(idgaz.eq.1) call wava5(a,inu)
if(idgaz.eq.2) goto 270
if(idgaz.eq.3) call oxyg5(a,inu)
if(idgaz.eq.4) goto 270
if(idgaz.eq.5) call niox5(a,inu)
if(idgaz.eq.6) call meth5(a,inu)
if(idgaz.eq.7) call moca5(a,inu)
goto 271
104 if(idgaz.eq.1) call wava4(a,inu)
if(idgaz.eq.2) goto 270
if(idgaz.eq.3) call oxyg4(a,inu)
if(idgaz.eq.4) goto 270
if(idgaz.eq.5) call niox4(a,inu)
if(idgaz.eq.6) call meth4(a,inu)
if(idgaz.eq.7) call moca4(a,inu)
goto 271
103 if(idgaz.eq.1) call wava3(a,inu)
if(idgaz.eq.2) call dica3(a,inu)
if(idgaz.eq.3) call oxyg3(a,inu)
if(idgaz.eq.4) goto 270
if(idgaz.eq.5) call niox3(a,inu)
if(idgaz.eq.6) call meth3(a,inu)
if(idgaz.eq.7) call moca3(a,inu)
goto 271
102 if(idgaz.eq.1) call wava2(a,inu)
if(idgaz.eq.2) call dica2(a,inu)
if(idgaz.eq.3) goto 270
if(idgaz.eq.4) goto 270
if(idgaz.eq.5) call niox2(a,inu)
if(idgaz.eq.6) call meth2(a,inu)
if(idgaz.eq.7) call moca2(a,inu)
goto 271
101 if(idgaz.eq.1) call wava1(a,inu)
if(idgaz.eq.2) call dica1(a,inu)
if(idgaz.eq.3) goto 270
if(idgaz.eq.4) call ozon1(a,inu)
if(idgaz.eq.5) call niox1(a,inu)
if(idgaz.eq.6) call meth1(a,inu)
if(idgaz.eq.7) call moca1(a,inu)
goto 271
270 do 200 i=1,8
a(i)=0.
200 continue
271 continue
c mixing ratio calculation for each gaseous constituents
do k=1,33
roair=air*273.16*p(k)/(1013.25*t(k))
tp(k)=(t(k)+t(k+1))/2.
te=tp(k)-t0
te2=te*te
phi=exp(a(3)*te+a(4)*te2)
psi=exp(a(5)*te+a(6)*te2)
if(idgaz.eq.1) rm(k)=wh(k)/(roair*1000.)
if(idgaz.eq.2) rm(k)=3.3e-04*roco2/air
if(idgaz.eq.3) rm(k)=0.20947*rmo2/air
if(idgaz.eq.4) rm(k)=wo(k)/(roair*1000.)
if(idgaz.eq.5) rm(k)=310.e-09*rmn2o/air
if(idgaz.eq.6) rm(k)=1.72e-06*rmch4/air
if(idgaz.eq.7) rm(k)=1.00e-09*rmco /air
r2(k)=rm(k)*phi
r3(k)=rm(k)*psi
enddo
c
uu=0.
u=0.
up=0.
uud=0.
uut=0.
uuu=0.
ud=0.
ut=0.
upd=0.
upt=0.
udp=0.
updp=0.
udtp=0.
updtp=0.
c pressure scale integration sigma=p/p0
do 50 k=2,33
ds=(p(k-1)-p(k))/p(1)
ds2=(p(k-1)*p(k-1)-p(k)*p(k))/(2.*p(1)*p0)
uu=uu+((rm(k)+rm(k-1))/2.)*ds*rat(idgaz)
u =u +((r2(k)+r2(k-1))/2.)*ds*rat(idgaz)
up=up+((r3(k)+r3(k-1))/2.)*ds2*rat(idgaz)
50 continue
uu=uu*p(1)*100./g
u=u*p(1)*100./g
up=up*p(1)*100./g
if(idgaz.eq.4) uu=1000.*uu/rmo3
if(idgaz.eq.2) uu=1000.*uu/roco2
if(idgaz.eq.5) uu=1000.*uu/rmn2o
if(idgaz.eq.6) uu=1000.*uu/rmch4
if(idgaz.eq.7) uu=1000.*uu/rmco
c mixing ratio for plane calculation for each gaseous constituents
if ((idatmp.eq.0).or.(idatmp.eq.4)) then
uupl=uu
upl=u
uppl=up
else
do k=1,33
roair=air*273.16*ppl(k)/(1013.25*tpl(k))
tp(k)=(tpl(k)+tpl(k+1))/2.
te=tp(k)-t0
te2=te*te
phi=exp(a(3)*te+a(4)*te2)
psi=exp(a(5)*te+a(6)*te2)
if(idgaz.eq.1) rmpl(k)=whpl(k)/(roair*1000.)
if(idgaz.eq.2) rmpl(k)=3.3e-04*roco2/air
if(idgaz.eq.3) rmpl(k)=0.20947*rmo2/air
if(idgaz.eq.4) rmpl(k)=wopl(k)/(roair*1000.)
if(idgaz.eq.5) rmpl(k)=310.e-09*rmn2o/air
if(idgaz.eq.6) rmpl(k)=1.72e-06*rmch4/air
if(idgaz.eq.7) rmpl(k)=1.00e-09*rmco /air
r2pl(k)=rmpl(k)*phi
r3pl(k)=rmpl(k)*psi
enddo
c
uupl=0.
upl=0.
uppl=0.
c update ratio plane
do i=1,10
ratpl(i)=1.
enddo
if (idatmp.eq.8) then
ratpl(1)=uwpl/uwusp
ratpl(2)=1.
ratpl(3)=1.
ratpl(4)=uo3pl/uo3usp
ratpl(5)=1.
ratpl(6)=1.
ratpl(7)=1.
ratpl(8)=uwpl/uwusp
ratpl(9)=uwpl/uwusp
ratpl(10)=uwpl/uwusp
endif
c pressure scale integration sigma=p/p0
c* all gases
do k=2,33
ds=(ppl(k-1)-ppl(k))/ppl(1)
ds2=(ppl(k-1)*ppl(k-1)-ppl(k)*ppl(k))/(2.*ppl(1)*p0)
uupl=uupl+((rmpl(k)+rmpl(k-1))/2.)*ds*ratpl(idgaz)
upl =upl +((r2pl(k)+r2pl(k-1))/2.)*ds*ratpl(idgaz)
uppl=uppl+((r3pl(k)+r3pl(k-1))/2.)*ds2*ratpl(idgaz)
enddo
uupl=uupl*ppl(1)*100./g
upl=upl*ppl(1)*100./g
uppl=uppl*ppl(1)*100./g
if(idgaz.eq.4) uupl=1000*uupl/rmo3
if(idgaz.eq.2) uupl=1000*uupl/roco2
if(idgaz.eq.5) uupl=1000*uupl/rmn2o
if(idgaz.eq.6) uupl=1000*uupl/rmch4
if(idgaz.eq.7) uupl=1000*uupl/rmco
c endif test idatm =0,4
endif
c downward path
uud=uu/xmus
c upward path
uuu=uupl/xmuv
c total(down+up) path
uut=uu/xmus+uupl/xmuv
if(idgaz.eq.1) goto 146
if(idgaz.eq.2.and.iv.gt.9620) goto 147
if(idgaz.eq.3.and.iv.gt.15920) goto 147
if(idgaz.eq.4) goto 146
goto 145
146 xi=0.
n=0
xd=0.
if(iv.lt.2350.or.iv.gt.3000) goto 148
xi=(v-2350.)/50.+1.
NH=XI+1.001
XH=XI-FLOAT(NH)
AH2O=CCH2O(NH)+XH*(CCH2O(NH)-CCH2O(NH-1))
DTCONT=EXP(-AH2O*UUD)
UTCONT=EXP(-AH2O*UUU)
TTCONT=EXP(-AH2O*UUT)
148 if (idgaz.eq.1) goto 145
if(iv.lt.13000) goto 145
if(iv.le.23400) goto 130
if(iv.ge.27500) goto 135
tnu(4,1)=1.
tnu(4,2)=1.
tnu(4,3)=1.
goto 45
130 xi=(v-13000.)/200.+1.
goto 140
135 xi=(v-27500.)/500.+57.
140 n=xi+1.001
xd=xi-float(n)
ako3=co3(n)+xd*(co3(n)-co3(n-1))
test1=ako3*uud
test2=ako3*uuu
test3=ako3*uut
c exponential overflow test
if(test1.gt.86.0) test1=86.0
if(test2.gt.86.0) test2=86.0
if(test3.gt.86.0) test3=86.0
tnu(4,1)=exp(-test1)
tnu(4,2)=exp(-test2)
tnu(4,3)=exp(-test3)
goto 40
145 continue
if(idgaz.eq.4.and.iv.gt.3020) goto 147
c
c downward path
c
ud=u/xmus
upd=up/xmus
udt=ud
if(ud.eq.0.and.upd.eq.0.) udt=1.
tn=a(2)*upd/(2*udt)
atest=a(2)
if (a(2).eq.0.and.a(1).eq.0.) atest=1.
updt=upd
if(ud.eq.0.and.upd.eq.0.) updt=1.
tt=1+4*(a(1)/atest)*((ud*ud)/updt)
y=-tn*(sqrt(tt)-1)
if(idgaz.eq.1) y=-a(1)*ud/sqrt(1+(a(1)/atest)*(ud*ud/updt))
tnu(idgaz,1)=exp(y)
c
c upward path modified to take account for plane content
c
udp=upl/xmuv
updp=uppl/xmuv
udtp=udp
if(udp.eq.0.and.updp.eq.0.) udtp=1.
tn=a(2)*updp/(2*udtp)
atest=a(2)
if (a(2).eq.0.and.a(1).eq.0.) atest=1.
updtp=updp
if(udp.eq.0.and.updp.eq.0.) updtp=1.
tt=1+4*(a(1)/atest)*((udp*udp)/updtp)
y=-tn*(sqrt(tt)-1)
if(idgaz.eq.1) y=-a(1)*udp/sqrt(1+(a(1)/atest)*(udp*udp/updtp))
tnu(idgaz,2)=exp(y)
c
c total(down+up) path modified on the way up
c
ut=u/xmus+upl/xmuv
upt=up/xmus+uppl/xmuv
utt=ut
if(ut.eq.0.and.upt.eq.0.) utt=1.
tn=a(2)*upt/(2*utt)
uptt=upt
if(ut.eq.0.and.upt.eq.0.) uptt=1.
tt=1+4*(a(1)/atest)*((ut*ut)/uptt)
y=-tn*(sqrt(tt)-1)
if(idgaz.eq.1) y=-a(1)*ut/sqrt(1+(a(1)/atest)*(ut*ut/uptt))
tnu(idgaz,3)=exp(y)
goto 40
147 tnu(idgaz,1)=1.
tnu(idgaz,2)=1.
tnu(idgaz,3)=1.
40 continue
C
45 ptest1=tnu(1,1)*dtcont
ptest=ptest1
if (ptest.gt.accu) then
dtwava=ptest
else
dtwava=0.
endif
ptest1=tnu(1,2)*utcont
ptest=ptest1
if (ptest.gt.accu) then
utwava=ptest
else
utwava=0.
endif
ptest1=tnu(1,3)*ttcont
ptest=ptest1
if (ptest.gt.accu) then
ttwava=ptest
else
ttwava=0.
endif
c write(6,*) "waterbug ",ttwava,dtwava,utwava,dtwava*utwava
dtdica=tnu(2,1)
utdica=tnu(2,2)
ttdica=tnu(2,3)
dtoxyg=tnu(3,1)
utoxyg=tnu(3,2)
ttoxyg=tnu(3,3)
dtozon=tnu(4,1)
utozon=tnu(4,2)
ttozon=tnu(4,3)
dtniox=tnu(5,1)
utniox=tnu(5,2)
ttniox=tnu(5,3)
dtmeth=tnu(6,1)
utmeth=tnu(6,2)
ttmeth=tnu(6,3)
dtmoca=tnu(7,1)
utmoca=tnu(7,2)
ttmoca=tnu(7,3)
if (idatmp.eq.0) then
ttwava=dtwava
utwava=1.
ttdica=dtdica
utdica=1.
ttoxyg=dtoxyg
utoxyg=1.
ttozon=dtozon
utozon=1.
ttniox=dtniox
utniox=1.
ttmeth=dtmeth
utmeth=1.
ttmoca=dtmoca
utmoca=1.
endif
return
95 call print_error(
s 'Error on zenithal angle ( near 90 deg )')
return
end
AEROPROF.f0000644002107500000270000000375112463730616010754 0ustar jckraps subroutine aero_prof (ta,piz,tr,hr,nt,xmus,
s h,ch,ydel,xdel,altc)
include "paramdef.inc"
double precision xdel(0:nt),ydel(0:nt),ch(0:nt),h(0:nt)
double precision altc(0:nt),ta,piz,tr,hr,xmus
double precision dz,z_up,dtau_ray,dtau_aer,dtau,dtau_OS
real alt_z,taer_z,taer55_z,ssa_aer
integer j,i,nt,num_z
common /aeroprof/ num_z,alt_z(0:nt_p_max),
&taer_z(0:nt_p_max),taer55_z(0:nt_p_max)
c If the maximum aerosol height is less than 300 km, one additional
c layer is added above with the aerosol optical thickness equal to 0.
if (alt_z(0).lt.300) then
taer_z(0)=0.0
num_z=num_z+1
do i=0,num_z-1
alt_z(num_z-i)=alt_z(num_z-i-1)
taer_z(num_z-i)=taer_z(num_z-i-1)
enddo
endif
alt_z(0)=300
ssa_aer=piz
c The atmosphere is divided into nt layers with the same
c (molecular + aerosol) optical thickness.
dtau_OS=(tr+ta)/nt
i=0
dz=0.0001
h(0)=0.0
altc(0)=300.0
z_up=alt_z(0)
ch(0)=0.5
ydel(0)=1.0
xdel(0)=0.0
j=1
n=1
dtau_aer=0.0
11 i=i+1
z=alt_z(0)-dz*i
dtau_ray=tr*(exp(-z/hr)-exp(-z_up/hr))
dtau_aer=dtau_aer+taer_z(n)*dz/(alt_z(n-1)-alt_z(n))
if (z.lt.alt_z(n)) n=n+1
dtau=dtau_ray+dtau_aer
if (dtau.ge.dtau_OS) then
altc(j)=z
h(j)=h(j-1)+dtau
ch(j)=exp(-h(j)/xmus)/2
xdel(j)=dtau_aer*ssa_aer/dtau ! aerosol portion in the j-th layer
ydel(j)=dtau_ray/dtau ! molecular portion in the j-th layer
c write(6,*)j,z,dtau_ray,dtau_aer,dtau,(ta+tr)/nt
j=j+1
z_up=z
dtau_aer=0.0
endif
if(z.gt.0) goto 11
altc(nt)=0
h(nt)=tr+ta
ch(nt)=exp(-h(nt)/xmus)/2
xdel(nt)=dtau_aer*ssa_aer/dtau
ydel(nt)=dtau_ray/dtau
c checking
c do j=0,nt
c write(6,*)j,altc(j),h(j),h(j)-h(j-1)
c enddo
return
end
AEROSO.f0000644002107500000270000001640412463730616010526 0ustar jckraps subroutine aeroso (iaer,co,xmud,wldis,FILE,ipol)
c - to vary the number of quadratures
include "paramdef.inc"
integer nquad
common /num_quad/ nquad
real ph,qh,uh
common /sixs_aerbas/ ph(20,nqmax_p),qh(20,nqmax_p),uh(20,nqmax_p)
real cgaus_S(nqmax_p),pdgs_S(nqmax_p)
real phasel,qhasel,uhasel
common /sixs_phase/ phasel(20,nqmax_p),qhasel(20,nqmax_p),
&uhasel(20,nqmax_p)
integer nbmu, nbmu_2
real cosang(nqmax_p),weight(nqmax_p)
c - to vary the number of quadratures
double precision cij(4),nis,sumni,ni(4)
real co(4),dd(4,20),qq(4,20),ci(4)
real pha(5,20,nqmax_p),qha(5,20,nqmax_p),uha(5,20,nqmax_p)
real sca(20),wldis(20),uu(4,20)
real xmud,ext,ome,gasym,phase,qhase,uhase
real coef,sigm,pi
integer i,j,k,l,j1,j2,iaer,icp,ipol
character FILE*80
common /sixs_aer/ ext(20),ome(20),gasym(20),phase(20),qhase(20),
&uhase(20)
real ex,sc,asy,vi
common /sixs_coef/ ex(4,20),sc(4,20),asy(4,20),vi(4)
real wldisc(20)
data wldisc /0.350,0.400,0.412,0.443,0.470,0.488,0.515,0.550,
s 0.590,0.633,0.670,0.694,0.760,0.860,1.240,1.536,
s 1.650,1.950,2.250,3.750/
pi=4.*atan(1.)
c if(iaer.eq.0) return
if (iaer.eq.12) then
open(10,file=FILE)
read (10,*) nbmu
read(10,*)
do l=1,20
read(10,'(10x,4(3x,f8.4,3x))')ext(l),sca(l),ome(l),gasym(l)
enddo
read(10,'(///)')
do k=1,nbmu
read(10,'(8x,20(1x,e10.4))')(phasel(l,k),l=1,20)
enddo
if (ipol.ne.0)then
do k=1,nbmu
read(10,'(8x,20(1x,e10.4))')(qhasel(l,k),l=1,20)
enddo
do k=1,nbmu
read(10,'(8x,20(1x,e10.4))')(uhasel(l,k),l=1,20)
enddo
endif
nquad=nbmu
close(10)
endif
c - calculation of gauss points
nbmu=nquad
nbmu_2=(nbmu-3)/2
call gauss(-1.,1.,cosang,weight,nbmu-3)
cgaus_S(1)=-1.0
pdgs_S(1)=0.0
do j=1,nbmu_2
cgaus_S(j+1)=cosang(j)
pdgs_S(j+1)=weight(j)
enddo
cgaus_S(nbmu_2+2)=0.
pdgs_S(nbmu_2+2)=0.
do j=nbmu_2+1,nbmu-3
cgaus_S(j+2)=cosang(j)
pdgs_S(j+2)=weight(j)
enddo
cgaus_S(nbmu)=1.0
pdgs_S(nbmu)=0.
c - calculation of gauss points
do 7 k=1,nbmu-1
if((xmud.ge.cgaus_S(k)).and.(xmud.lt.cgaus_S(k+1))) go to 8
7 continue
return
8 j1=k
j2=j1+1
coef=-(xmud-cgaus_S(j1))/(cgaus_S(j2)-cgaus_S(j1))
if (iaer.eq.12) then
do l=1,20
phase(l)=phasel(l,j1)+coef*(phasel(l,j1)-phasel(l,j2))
enddo
if (ipol.ne.0)then
do l=1,20
qhase(l)=qhasel(l,j1)+coef*(qhasel(l,j1)-qhasel(l,j2))
uhase(l)=uhasel(l,j1)+coef*(uhasel(l,j1)-uhasel(l,j2))
enddo
endif
return
endif
do 1 l=1,20
ext(l)=0.
sca(l)=0.
if(l.eq.4.and.iaer.eq.0) ext(l)=1.
ome(l)=0.
gasym(l)=0.
phase(l)=0.
qhase(l)=0.
uhase(l)=0.
do 1 k=1,nbmu
phasel(l,k)=0.
qhasel(l,k)=0.
uhasel(l,k)=0.
1 continue
do 2 j=1,4
ci(j)=co(j)
2 continue
if(iaer.eq.0) goto 777
if (iaer.ge.5.and.iaer.le.11) then
c calling a special aerosol model
c (background desert model...)
if (iaer.eq.5) call bdm
c (biomass burning model...)
if (iaer.eq.6) call bbm
c (stratospherique aerosol model...)
if (iaer.eq.7) call stm
c (user defined model from size distribution)
if (iaer.ge.8.and.iaer.le.11) then
call mie(iaer,wldis,ex,sc,asy,ipol)
endif
do l=1,20
dd(1,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
do k=1,nbmu
pha(1,l,k)=ph(l,k)
enddo
enddo
if (ipol.ne.0)then
do l=1,20
qq(1,l)=qh(l,j1)+coef*(qh(l,j1)-qh(l,j2))
uu(1,l)=uh(l,j1)+coef*(uh(l,j1)-uh(l,j2))
do k=1,nbmu
qha(1,l,k)=qh(l,k)
uha(1,l,k)=uh(l,k)
enddo
enddo
endif
icp=1
cij(1)=1.00
c for normalization of the extinction coefficient
nis=1.d+00/ex(1,8)
else
c calling each sra components
icp=4
c extrapolate each component for wavelength
do l=1,20
do j=1,4
ex(j,l)=0
sc(j,l)=0.
asy(j,l)=0.
enddo
enddo
c phase function of 4 components
do j=1,4
if (j.eq.1) call dust
if (j.eq.2) call wate
if (j.eq.3) call ocea
if (j.eq.4) call soot
do l=1,20
dd(j,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
do k=1,nbmu
pha(j,l,k)=ph(l,k)
enddo
if (ipol.ne.0)then
qq(j,l)=qh(l,j1)+coef*(qh(l,j1)-qh(l,j2))
uu(j,l)=uh(l,j1)+coef*(uh(l,j1)-uh(l,j2))
do k=1,nbmu
qha(j,l,k)=qh(l,k)
uha(j,l,k)=uh(l,k)
enddo
endif
enddo
enddo
c summ of the ci/vi calculation
sigm=0.
sumni=0.0
do 3 i=1,4
3 sigm=sigm+ci(i)/vi(i)
c cij coefficients calculation
do 4 j=1,4
cij(j)=(ci(j)/vi(j)/sigm)
sumni=sumni+cij(j)*ex(j,8)
4 continue
nis=1.d+00/sumni
endif
c mixing parameters calculation
do 5 l=1,20
do 6 j=1,icp
ext(l)=ex(j,l)*cij(j)+ext(l)
sca(l)=sc(j,l)*cij(j)+sca(l)
gasym(l)=sc(j,l)*cij(j)*asy(j,l)+gasym(l)
phase(l)=sc(j,l)*cij(j)*dd(j,l)+phase(l)
do 77 k=1,nbmu
phasel(l,k)=sc(j,l)*cij(j)*pha(j,l,k)+phasel(l,k)
77 continue
if (ipol.ne.0)then
qhase(l)=sc(j,l)*cij(j)*qq(j,l)+qhase(l)
uhase(l)=sc(j,l)*cij(j)*uu(j,l)+uhase(l)
do k=1,nbmu
qhasel(l,k)=sc(j,l)*cij(j)*qha(j,l,k)+qhasel(l,k)
uhasel(l,k)=sc(j,l)*cij(j)*uha(j,l,k)+uhasel(l,k)
enddo
endif
6 continue
ome(l)=sca(l)/ext(l)
gasym(l)=gasym(l)/sca(l)
phase(l)=phase(l)/sca(l)
do 78 k=1,nbmu
phasel(l,k)=phasel(l,k)/sca(l)
78 continue
if (ipol.ne.0)then
qhase(l)=qhase(l)/sca(l)
uhase(l)=uhase(l)/sca(l)
do k=1,nbmu
qhasel(l,k)=qhasel(l,k)/sca(l)
uhasel(l,k)=uhasel(l,k)/sca(l)
enddo
endif
ext(l)=ext(l)*nis
sca(l)=sca(l)*nis
5 continue
if (iaer.ge.8.and.iaer.le.11) then
open(10,file=FILE)
write(10,*) nbmu
write(10,'(3x,A5,1x,5(1x,A10,1x),1x,A10)')'Wlgth','Nor_Ext_Co',
s 'Nor_Sca_Co','Sg_Sca_Alb','Asymm_Para','Extinct_Co','Scatter_Co'
do 79 l=1,20
write(10,'(2x,f8.4,4(3x,f8.4,3x),2(2x,e10.4))')
s wldis(l),ext(l),sca(l),ome(l),gasym(l),ext(l)/nis,sca(l)/nis
79 continue
write(10,'(//,T20,A16,/,3x,A4,1x,20(3x,f6.4,2x))')
s ' Phase Function ','TETA',(wldis(l),l=1,20)
do 76 k=1,nbmu
write(10,761)180.*acos(cgaus_S(k))/pi,(phasel(l,k),l=1,20)
76 continue
761 format (2x,f6.2,20(1x,e10.4))
if (ipol.ne.0)then
do k=1,nbmu
write(10,761)180.*acos(cgaus_S(k))/pi,(qhasel(l,k),l=1,20)
enddo
do k=1,nbmu
write(10,761)180.*acos(cgaus_S(k))/pi,(uhasel(l,k),l=1,20)
enddo
endif
close(10)
endif
777 continue
return
end
AKTOOL.f0000644002107500000270000014072012463730616010526 0ustar jckraps subroutine msrm
c
c MultiSpectral Reflectance Model 93 A.Kuusk 24.03.1993
c
implicit double precision (a-h, o-z)
save /count/, /soildata/, /aaa/, /ggg/, /ladak/
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
double precision nnl, kk
common /leafin/ nnl, vai, kk
common /leafout/ refl, tran
c
double precision ke, kab, kw
dimension refr(200), ke(200), kab(200), kw(200)
common /dat/ refr, ke, kab, kw
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2, rsl3,
& rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /cfresn/ rn, rk
common /ladak/ ee, thm, sthm, cthm
common /msrmdata/ th10, rncoef, cab, cw, bq
c
data pi12/1.570796326794895d0/, pi/3.141592653589793d0/
data eps4/.1d-3/
c
* print *, 'msrm'
c
sth10 = sin(th10)
cth10 = cos(th10)
c
sp = sin(phi)
cp = cos(phi)
th1 = th10
sth1 = sth10
cth1 = cth10
sth = sin(th)
cth = cos(th)
rrls = rrl
c
call biz
c
rrl = refl
rtp = rrl + ttl
c
call difr92
c
10 continue
c
rrl = rrls
bq = bi + bd
c
return
end
*
******************************************************************
*
subroutine akd
c bdz A.Kuusk 4.03.1988
c
implicit double precision (a-h, o-z)
save /count/, /aaa/, /ggg/
c
dimension tt3(10), stt3(10), ctt3(10), tt2(10), stt2(10), ctt2(10)
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
double precision nnl, kk
common /leafin/ nnl, vai, kk
common /leafout/ refl, tran
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
c
data pi/3.141592653589793d0/, pi1/1.5707963268d0/, eps/.005d0/
c
* print *, 'akd'
bqint = 0.d0
if (th .gt. eps) goto 4
phi = 0.d0
sp = 0.d0
cp = 1.d0
c
do 10 i2 = 1, n2
th1 = (1.d0 - u2(i2))*pi1
sth1 = sin(th1)
cth1 = cos(th1)
rrls = rrl
c
call biz
c
rrl = refl
rtp = rrl + ttl
c
call difr92
c
rrl = rrls
bqint = bqint + a2(i2)*(bi + bd)*sth1*cth1
10 continue
c
bqint = bqint*pi
goto 1
c
4 continue
do 14 i = 1, n1
thi = u1(i)*th
tt3(i) = thi
stt3(i) = sin(thi)
ctt3(i) = cos(thi)
14 continue
c
do 15 i = 1, n2
thi = u2(i)*(th - pi1) + pi1
tt2(i) = thi
stt2(i) = sin(thi)
ctt2(i) = cos(thi)
15 continue
c
do 11 j = 1, n1
phi = (1.d0 - u1(j))*pi
sp = sin(phi)
cp = cos(phi)
bd1 = 0.d0
bd2 = 0.d0
do 12 i1 = 1, n1
th1 = tt3(i1)
sth1 = stt3(i1)
cth1 = ctt3(i1)
c
rrls = rrl
c
call biz
c
rrl = refl
rtp = rrl + ttl
c
call difr92
c
rrl = rrls
c
bd1 = bd1 + a1(i1)*(bi + bd)*sth1*cth1
12 continue
c
do 13 i2 = 1, n2
th1 = tt2(i2)
sth1 = stt2(i2)
cth1 = ctt2(i2)
c
rrls = rrl
c
call biz
c
rrl = refl
rtp = rrl + ttl
c
call difr92
c
rrl = rrls
c
bd2 = bd2 + a2(i2)*(bi + bd)*sth1*cth1
13 continue
c
bqint = bqint + ((pi1 - th)*bd2 + th*bd1)*a1(j)
11 continue
c
bqint = bqint + bqint
c
1 return
end
*
******************************************************************
*
subroutine biz
c canopy reflectance of single scattering for direct radiation
c A. Kuusk 6.02.1992
c
implicit double precision (a-h, o-z)
double precision integr
save /count/, /soildata/, /aaa/, /ggg/, /ladak/
c
* dimension gj(2), g1j(2), grj(2), gtj(2), gfj(2)
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /ladak/ ee, thm, sthm, cthm
c
data pi/3.14159265358979d0/, eps/.1d-4/, eps3/.01d0/
c
integr(xx) = (1.d0 - exp(-xx))/xx
* print *, 'biz in'
ths = th
sths = sth
cths = cth
th1s = th1
sth1s = sth1
cth1s = cth1
* thms = thm
c
call soil
c
if (ul .gt. eps) goto 2
bi = rsoil
goto 1
c
2 continue
if (th1 .lt. th) goto 12
t11 = th1
st = sth
st1 = sth1
ct = cth
ct1 = cth1
t10 = th
jj = 0
goto 7
c
12 t10 = th1
st = sth1
st1 = sth
ct = cth1
ct1 = cth
t11 = th
jj = 1
c
7 continue
ctt1 = ct*ct1
stt1 = st*st1
calph = stt1*cp + ctt1
catmp = calph
alph = acos(catmp)
alp2 = alph*.5d0
* if (lf .ne. 2) then
* if( jg .gt. 2) then
* print *, ' *** biz3: jg > 2 ***'
* stop
* endif
e1 = st*ct1
e2 = ct*st1
s2 = e1*cp + e2
s3 = e1*sp
ctg = 1.d30
ctg1 = 1.d30
if (st .ne. 0.d0) ctg = ct/st
if (st1 .ne. 0.d0) ctg1 = ct1/st1
salph = sin(alph)
alpp = pi - alph
salp2 = sin(alp2)
calp2 = cos(alp2)
c
call gmf(gf)
c
if (ee .le. eps3) goto 95
y4 = abs(cth + cth1)*.5d0/calp2
if (y4.lt.1.d0) thp = acos(y4)
c
95 call glak(glthp, thp)
c
x2 = glthp*.125d0
gf = gf*x2
c
call gmd92
c
gammd = gr*rrl + gt*ttl
c
t11 = th1
st = sth
st1 = sth1
ct = cth
ct1 = cth1
t10 = th
if (jj .eq. 1) then
x = g1
g1 = g
g = x
endif
c
* print *, 'biz:2'
gg = g*g1
g = g*clmp
g1 = g1*clmp1
gg1 = g*ct1 + g1*ct
sct = sqrt(ctt1)
alpd = alp2/sl
bam = alpd*sct/ul
c
if (ctt1 .gt. eps) then
gma = alpd/sct
ulg = gg1/ctt1*ul
else
gma = 0.d0
ulg = ul
endif
ulg1 = ulg*.5d0
xx1 = ulg + gma
if ((xx1 .gt. 30.d0) .or. (ctt1 .le. eps)) then
easte = 0.d0
easte2 = 0.d0
easte4 = 0.d0
bs1 = 0.d0
else
easte = exp(-ulg)
easte2 = exp(-ulg1 - gma)
easte4 = exp(-ulg - gma)
bs1 = (easte + easte2 - easte4)*rsoil
endif
c
xx1 = (1.d0 - easte)/gg1
xx2 = (1.d0 - easte2)/(gg1*.5d0 + bam) -
& (1.d0 - easte4)/(gg1 + bam)
bc1d = xx1*gammd
bc1hs = xx2*(gammd + gf)
bcsp = xx1*gf
bc1 = bc1d + bcsp + bc1hs
bi = bc1 + bs1
c
1 continue
th = ths
sth = sths
cth = cths
th1 = th1s
sth1 = sth1s
cth1s = cth1
* thm = thms
c
return
end
*
******************************************************************
*
subroutine difr92
c diffuse fluxes according to SAIL for an elliptical LAD
c A. Kuusk 16.06.1992
c
implicit double precision (a-h, o-z)
double precision ks, ko, m, m11, m12, m21, m22, integr
save /soildata/, /aaa/, /ggg/, /ladak/
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /ladak/ ee, thm, sthm, cthm
c
integr(x) = (1.d0 - exp(-x))/x
* print *, 'difr92'
c
tsun = th1
tview = th
tants = sth1/cth1
tanto = sth/cth
rtp = (rrl + ttl)/2.d0
c
ks = g1*ul/cth1
ko = g*ul/cth
gg = (1.289d0*difmy - 1.816d0*difsig)*(cthm**2 -
& .33333333333d0) + .31823d0
bf = (rrl - ttl)/2.d0*ul*gg
att = (1.d0 - rtp)*ul + bf
sig = rtp*ul + bf
sb = ks*rtp + bf
sf = ks*rtp - bf
ub = ko*rtp + bf
uf = ko*rtp - bf
m = sqrt(att**2 - sig**2)
h1 = (att + m)/sig
h2 = 1.d0/h1
c = (sf*sig - sb*(ks - att))/(m**2 - ks**2)
d = (sb*sig + sf*(ks + att))/(m**2 - ks**2)
* epso = skyl - d*sq
epso = - d
* epss = (rrsoil*(d + 1.d0) - c)*sq*exp(-ks)
epss = (rrsoil*(d + 1.d0) - c)*exp(-ks)
m11 = h1
m12 = h2
m21 = (1.d0 - rrsoil*h1)*exp(-m)
m22 = (1.d0 - rrsoil*h2)*exp(m)
det = m11*m22 - m12*m21
a = (m22*epso - m12*epss)/det
b = (-m21*epso + m11*epss)/det
ep = integr(ko + m)
em = integr(ko - m)
ek = integr(ko + ks)
* gp = a*ep + b*em + c*ek*sq
gp = a*ep + b*em + c*ek
* gm = h1*a*ep + h2*b*em + d*ek*sq
gm = h1*a*ep + h2*b*em + d*ek
* ems = h1*a*exp(-m) + h2*b*exp(m) + d*sq*exp(-ks)
ems = h1*a*exp(-m) + h2*b*exp(m) + d*exp(-ks)
rplants = uf*gp + ub*gm
rdsoil = rrsoil*ems*exp(-ko)
bd = rplants + rdsoil
c
return
end
*
**********************************************************************
*
subroutine glak(glth, th)
c elliptical distribution
c A.Kuusk 1.03.1988
c
implicit double precision (a-h, o-z)
save /aaa/, /ladak/
save bb, es, tms
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ladak/ ee, thm, sthm, cthm
c
data bb/1.d0/, es/0.d0/, tms/0.d0/, eps/.1d0/
c
* print *, 'gl'
c
if (ee .lt. eps) then
glth = 1.d0
return
endif
c
if (ee .eq. 1.d0) ee = .999999d0
if ((ee .ne. es) .or. (thm .ne. tms)) then
u1 = ee*cthm
u3 = ee*sthm
u2 = sqrt(1.d0 - u1*u1)
u4 = sqrt(1.d0 - u3*u3)
x = log((u4 + u1)/(u2 - u3))
x1 = atan2(u3, u4) - atan2(u1, u2)
x2 = sthm*x - cthm*x1
bb = ee/x2
es = ee
tms = thm
endif
c
glth = bb/sqrt(1.d0 - (ee*cos(thm - th))**2)
c
return
end
*
******************************************************************
*
subroutine gmf(gf)
c Fresnel' reflection A.Kuusk 02.01.1991
c input parameters are ca = cos(th_incident), rn=refract.ind.,
c rk = leaf hair index
c
implicit double precision (a-h, o-z)
save /aaa/, /ggg/
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /cfresn/ rn, rk
c
data pi12/1.570796326794895d0/
c
* print *, 'gmf'
c
ca=calp2
x2 = ca*ca
ag = x2*2.d0 - 1.d0 + rn*rn
bg = 1.d0 + (ag - 2.d0)*x2
xy = ag - x2
cg = 2.d0*ca*sqrt(xy)
sa2 = 1.d0 - x2
y = (bg + sa2*cg)*(ag + cg)
y = (ag - cg)*bg/y
yy = sqrt(sa2)/pi12/ca*rk
gf = exp(-yy)*y
c
return
end
*
******************************************************************
*
subroutine soil
c Soil directional reflectance and reflectance (albedo)
c th, th1, th2 in radianes, cp = cos(phi)
c A.Kuusk 1.03.1988
c
implicit double precision (a-h, o-z)
save a, b, c, cts, ths1, ths2
save /soildata/, /aaa/, /ggg/
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
c
data a/.45098d0/, b/5.7829d0/, c, cts/2*13.7575d0/
data ths1, ths2/2*.785398163d0/
c
* print *, 'soil'
if (th2 .ne. ths2) then
cts = 16.41d0 - th2*th2*4.3d0
ths2 = th2
endif
if (th1 .ne. ths1) then
ths1 = th1
x = th1*th1
a = x*7.702d0 - 4.3d0
b = th1*7.363d0
c = 16.41d0 - x*4.3d0
endif
x2 = rsl/cts
rsoil = ((a*th + b*cp)*th + c)*x2
rr1soil = (.7337d0*a + c)*x2
rrsoil = 14.25d0*x2
c
return
end
*
******************************************************************
*
subroutine soilspec
c
c Soil spectral reflectance, Price, RSE 33:113 - 121 (1990)
c
implicit double precision (a-h, o-z)
save /count/, /soildata/
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
rsl = rsl1*phis1(jl) + rsl2*phis2(jl) +
& rsl3*phis3(jl) + rsl4*phis4(jl)
c
return
end
*
**********************************************************************
*
subroutine gmd92
c phase function and G-funktion
c A. Kuusk 22.03.1988 & 16.06.1992
c 0< = th, th1, th2<=pi/2, 0<=phi<=pi
c
implicit double precision (a-h, o-z)
dimension f(5)
save /aaa/, /ggg/, /ladak/
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /ladak/ ee, thm, sthm, cthm
c
data pi/3.14159265358979d0/, pi4/6.28318531717958d0/,
& pi12/.159154943d0/, pi14/.636619773d0/, eps5/.1d-2/
& , pi13/.1061032953d0/
c
* print *, 'gmd92'
c
c *** gammad, e = 0. ***
gr0 = (salph + alpp*calph)*pi13
gt0 = (salph - alph*calph)*pi13
if (ee .lt. .4d0) then
gr = gr0
gt = gt0
g = .5d0
g1 = .5d0
return
endif
c *** gammad, e = 1. ***
sg = 0.d0
sg1 = 0.d0
sgmr = 0.d0
sgmt = 0.d0
if (th22 .lt. t11) goto 47
l4=1
goto 61
c
46 continue
l4=2
goto 64
c
47 continue
if (th22 .lt. t10) goto 50
l4=3
goto 62
c
51 continue
l4=1
goto 65
c
50 continue
l4=4
goto 63
c
52 continue
l4=2
goto 65
c
48 continue
c
gr1 = sgmr*pi12
gt1 = sgmt*pi12
gr = gr0 - .0102d0 +
& (1.742d0*difmy - .4557d0*difsig)*(gr1 - gr0)
gt = gt0 + .00653d0 +
& (.2693d0*difmy + 5.821d0*difsig)*(gt1 - gt0)
g = (2.653d0*difmy + 1.432d0*difsig)*(sg - .5d0) + .50072d0
g1 = (2.653d0*difmy + 1.432d0*difsig)*(sg1 - .5d0) + .50072d0
c
49 continue
return
c
c ****************************** tl1 = 0., tl2=pi/2 - th1
c
61 l2=71
goto 130
71 y = pp
if (y .gt. 0.d0) sgmr = sgmr + y
if (y .lt. 0.d0) sgmt = sgmt - y
y1 = ct1*cthm
sg1 = sg1 + abs(y1)
goto (46,48,51,52),l4
c
c ****************************** tl1 = pi/2 - th1, tl2=pi/2 - th
c
62 continue
x2 = cthm/sthm
x = -ctg1*x2
x1 = sqrt(1.d0 - x*x)
fa = atan2(x1, x)
fb = pi4 - fa
l2=72
goto 30
c
72 continue
y = pp
if (y .gt. 0.d0) sgmr = sgmr + y
if (y .lt. 0.d0) sgmt = sgmt - y
l2=73
goto 130
c
73 y = pp - y
if (y .gt. 0.d0) sgmr = sgmr + y
if (y .lt. 0.d0) sgmt = sgmt - y
goto (46,48,51,52),l4
c
c ****************************** tl1 = pi/2 - th, tl2=pi/2
c
63 continue
x2 = cthm/sthm
x = -ctg1*x2
x1 = sqrt(1.d0 - x*x)
fa = atan2(x1, x)
f(2) = fa
f(3) = pi4 - fa
x = -ctg*x2
x1 = sqrt(1.d0 - x*x)
fa = atan2(x1, x)
fb = phi - fa
if (fb .lt. 0.d0) fb = fb + pi4
f(4) = fb
f(5) = phi + fa
do 75 ii = 2, 4
i1 = ii + 1
do 75 j = i1, 5
fa = f(ii)
fb = f(j)
if (fb .gt. fa) goto 75
f(ii) = fb
f(j) = fa
75 continue
f(1) = f(5) - pi4
i1 = 1
76 ii = i1
i1 = ii + 1
fa = f(ii)
fb = f(i1)
c assign 74 to l2
goto 30
c
c ****************************** tl1 = pi/2 - th, tl2=pi/2
c
74 continue
y = pp
if (y .gt. 0.d0) sgmr = sgmr + y
if (y .lt. 0.d0) sgmt = sgmt - y
if (i1 .le. 4) goto 76
c
x2 = ct*cthm
x1 = st*sthm/x2
x1 = sqrt(x1*x1 - 1.d0)
x = atan2(1.d0, x1)
x = (x + x1)*x2
y = x*pi14
sg = sg + abs(y)
goto (46,48,51,52),l4
c
c ****************************** tl1 = 0, tl2=pi/2 - th
c
64 y1 = ct*cthm
sg = sg + abs(y1)
goto (46,48,51,52),l4
c
c ****************************** tl1 = pi/2 - th1, tl2=pi/2
c
65 continue
x2 = ct1*cthm
x1 = st1*sthm/x2
x1 = sqrt(x1*x1 - 1.d0)
x = atan2(1.d0, x1)
x = (x + x1)*x2
y = x*pi14
sg1 = sg1 + abs(y)
goto (46,48,51,52),l4
c
c ****************************** p(fa, fb)
c
30 x = fb - fa
if (x .gt. eps5) goto 31
pp = 0.d0
goto 74
31 if ((pi4 - x) .lt. eps5) goto 130
sfa = sin(fa)
sfb = sin(fb)
cfa = cos(fa)
cfb = cos(fb)
pp = x*ctt1*cthm*cthm
y1 = x + sfb*cfb - sfa*cfa
x = cfa - cfb
y1 = y1*cp + sp*x*(cfa + cfb)
pp = pp + stt1*.5d0*y1*sthm*sthm
y1 = s2*(sfb - sfa) + s3*x
pp = pp + y1*sthm*cthm
goto 74
c
130 x = sthm*sthm
pp = calph*x + ctt1*(2.d0 - 3.d0*x)
pp = pp*pi
goto 74
c
end
*
******************************************************************
*
*
c ******************************************************************
c leaf reflectance and transmittance.
c Input data are refractive index n, a structure parameter N
c and an absorption coefficient k:
c the PROSPECT model, Jacquemoud & Baret, RSE 34:75-91 (1990)
c ******************************************************************
subroutine leaf
c
implicit double precision (a-h, o-z)
c
double precision nn, k, inex
common /leafin/ nn, vai, k
common /leafout/ refl, tran
common /nagout/ inex
common /tauin/ teta, ref
common /tauout/ tau
c ******************************************************************
c determination of elementary reflectances et transmittances
c ******************************************************************
c ALLEN et al., 1969, Interaction of isotropic ligth with a compact
c plant leaf, J. Opt. Soc. Am., Vol.59, 10:1376-1379
c JACQUEMOUD S. and BARET F., 1990, Prospect : a model of leaf
c optical properties spectra, Remote Sens. Environ., 34:75-91
c ******************************************************************
* print *, 'leaf'
if (k .le. 0.d0) then
k = 1.d0
else
call s13aaf
k = (1.d0 - k)*exp(-k) + k**2*inex
endif
teta = 90.d0
ref = nn
c
call tav
c
t1 = tau
teta = 59.d0
c
call tav
c
t2 = tau
x1 = 1.d0 - t1
x2 = t1**2*k**2*(nn**2 - t1)
x3 = t1**2*k*nn**2
x4 = nn**4 - k**2*(nn**2 - t1)**2
x5 = t2/t1
x6 = x5*(t1 - 1.d0) + 1.d0 - t2
r = x1 + x2/x4
t = x3/x4
ra = x5*r + x6
ta = x5*t
c ******************************************************************
c reflectances et transmittances corresponding to N elementary
c layers
c ******************************************************************
c STOKES G.G., 1862, On the intensity of the light reflected from or
c transmitted through a pile of plates, Proceedings of the Royal
c Society of London, Vol.11, 545-556
c ******************************************************************
delta = (t**2 - r**2 - 1.d0)**2 - 4.d0*r**2
alfa = (1.d0 + r**2 - t**2 + sqrt(delta))/(2.d0*r)
beta = (1.d0 + r**2 - t**2 - sqrt(delta))/(2.d0*r)
va = (1.d0 + r**2 - t**2 + sqrt(delta))/(2.d0*r)
vb = sqrt(beta*(alfa - r)/(alfa*(beta - r)))
s1 = ra*(va*vb**(vai - 1.d0) -
& va**(-1.d0)*vb**(-(vai - 1.d0))) +
& (ta*t - ra*r)*(vb**(vai - 1.d0) - vb**(-(vai - 1.d0)))
s2 = ta*(va - va**(-1.d0))
s3 = va*vb**(vai - 1.d0) - va**(-1.d0)*vb**(-(vai - 1.d0))
& - r*(vb**(vai - 1.d0) - vb**(-(vai - 1.d0)))
refl = s1/s3
tran = s2/s3
c
return
end
c ******************************************************************
c exponential integral: int(exp(-t)/t, t = x..inf)
c ******************************************************************
subroutine s13aaf
c
implicit double precision (a-h, o-z)
c
double precision nn, k, inex
common /leafin/ nn, vai, k
common /nagout/ inex
* print *, 's13aafin'
if (k .gt. 4.d0) goto 10
x = 0.5d0 * k - 1.d0
y = (((((((((((((((-3.60311230482612224d-13
& *x + 3.46348526554087424d-12)*x - 2.99627399604128973d-11)
& *x + 2.57747807106988589d-10)*x - 2.09330568435488303d-9)
& *x + 1.59501329936987818d-8)*x - 1.13717900285428895d-7)
& *x + 7.55292885309152956d-7)*x - 4.64980751480619431d-6)
& *x + 2.63830365675408129d-5)*x - 1.37089870978830576d-4)
& *x + 6.47686503728103400d-4)*x - 2.76060141343627983d-3)
& *x + 1.05306034687449505d-2)*x - 3.57191348753631956d-2)
& *x + 1.07774527938978692d-1)*x - 2.96997075145080963d-1
y = (y*x + 8.64664716763387311d-1)*x + 7.42047691268006429d-1
inex = y - log(k)
goto 30
10 if (k .ge. 85.d0) go to 20
x = 14.5d0 / (k + 3.25d0) - 1.d0
y = (((((((((((((((-1.62806570868460749d-12
& *x - 8.95400579318284288d-13)*x - 4.08352702838151578d-12)
& *x - 1.45132988248537498d-11)*x - 8.35086918940757852d-11)
& *x - 2.13638678953766289d-10)*x - 1.10302431467069770d-9)
& *x - 3.67128915633455484d-9)*x - 1.66980544304104726d-8)
& *x - 6.11774386401295125d-8)*x - 2.70306163610271497d-7)
& *x - 1.05565006992891261d-6)*x - 4.72090467203711484d-6)
& *x - 1.95076375089955937d-5)*x - 9.16450482931221453d-5)
& *x - 4.05892130452128677d-4)*x - 2.14213055000334718d-3
y = ((y*x - 1.06374875116569657d-2)*x -
& 8.50699154984571871d-2)*x +
& 9.23755307807784058d-1
inex = exp(-k) * y / k
goto 30
20 inex = 0.d0
goto 30
30 continue
* print *, 's13aafout'
return
end
c ******************************************************************
c determination of tav for any solid angle
c ******************************************************************
c STERN F., 1964, Transmission of isotropic radiation across an
c interface between two dielectrics, Appl.Opt., Vol.3, 1:111-113
c ALLEN W.A., 1973, Transmission of isotropic light across a
c dielectric surface in two and three dimensions, J.Opt.Soc.Am.,
c Vol.63, 6:664-666
c ******************************************************************
subroutine tav
c
implicit double precision (a-h, o-z)
double precision k
c
common /tauin/ teta, ref
common /tauout/ tau
c
data dr/1.745329251994330d-2/, eps/.1d-6/,
& pi12/1.570796326794895d0/
* print *, 'tavin'
teta = teta*dr
r2 = ref**2
rp = r2 + 1.d0
rm = r2 - 1.d0
a = (ref + 1.d0)**2/2.d0
k = -(r2 - 1.d0)**2/4.d0
ds = sin(teta)
if (abs(teta) .le. eps) then
tau = 4.d0*ref/(ref + 1.d0)**2
else
if (abs(teta - pi12) .le. eps) then
b1 = 0.d0
else
xxx = (ds**2 - rp/2.d0)**2 + k
b1 = sqrt(xxx)
endif
b2 = ds**2 - rp/2.d0
b = b1 - b2
ts = (k**2/(6.d0*b**3) + k/b - b/2.d0) -
& (k**2/(6.d0*a**3) + k/a - a/2.d0)
tp1 = -2.d0*r2*(b - a)/rp**2
tp2 = -2.d0*r2*rp*log(b/a)/rm**2
tp3 = r2*(1.d0/b - 1.d0/a)/2.d0
tp4 = 16.d0*r2**2*(r2**2 + 1.d0)*dlog((2.d0*rp*b - rm**2)/
& (2.d0*rp*a - rm**2))/(rp**3*rm**2)
tp5 = 16.d0*r2**3*(1.d0/(2.d0*rp*b - rm**2) - 1.d0/
& (2.d0*rp*a - rm**2))/rp**3
tp = tp1 + tp2 + tp3 + tp4 + tp5
tau = (ts + tp)/(2.d0*ds**2)
endif
* print *, 'tavout'
return
end
*
******************************************************************
*
c constant values: refractive index (ref), albino and dry leaf
c absorption (ke), chlorophyll a+b specific absorption coefficient
c (kab), water specific absorption coefficient (kw),
* and basis functions for soil spectral reflectance phis1, phis2,
* phis3 and phis4 (Price, 1990)
c ******************************************************************
c JACQUEMOUD S. AND BARET F., 1990, Prospect : a model of leaf
c optical properties spectra, Remote Sens. Environ., 34:75-91
c JACQUEMOUD S. et al., 1991, Validation d'un modele de reflectance
c spectrale et directionnnelle de sol, 5ieme Colloque International
c Mesures Physiques et Signatures en Teledetection, Courchevel
c (France), 14-18 Janvier 1991
c ******************************************************************
block data valeur
c
implicit double precision (a-h, o-z)
c
double precision ke, kab, kw
dimension ref(200), ke(200), kab(200), kw(200)
common /dat/ ref, ke, kab, kw
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
data (ref(i), i = 1, 100)/
& 1.5123,1.5094,1.5070,1.5050,1.5032,1.5019,1.5007,1.4997,1.4988,
& 1.4980,1.4969,
& 1.4959,1.4951,1.4943,1.4937,1.4930,1.4925,1.4920,1.4915,1.4910,
& 1.4904,1.4899,1.4893,1.4887,1.4880,1.4873,1.4865,1.4856,1.4846,
& 1.4836,1.4825,1.4813,1.4801,1.4788,1.4774,1.4761,1.4746,1.4732,
& 1.4717,1.4701,1.4685,1.4670,1.4654,1.4639,1.4624,1.4609,1.4595,
& 1.4582,1.4570,1.4559,1.4548,1.4538,1.4528,1.4519,1.4510,1.4502,
& 1.4495,1.4489,1.4484,1.4480,1.4477,1.4474,1.4472,1.4470,1.4468,
& 1.4467,1.4465,1.4463,1.4461,1.4458,1.4456,1.4453,1.4450,1.4447,
& 1.4444,1.4440,1.4435,1.4430,1.4423,1.4417,1.4409,1.4402,1.4394,
& 1.4387,1.4380,1.4374,1.4368,1.4363,1.4357,1.4352,1.4348,1.4345,
& 1.4342,1.4341,1.4340,1.4340,1.4341,1.4342,1.4343,1.4345/
data (ref(i), i = 101, 200)/
& 1.4347,1.4348,1.4347,1.4345,1.4341,1.4336,1.4331,1.4324,1.4317,
& 1.4308,1.4297,1.4284,1.4269,1.4253,1.4235,1.4216,1.4196,1.4176,
& 1.4156,1.4137,1.4118,1.4100,1.4082,1.4065,1.4047,1.4029,1.4011,
& 1.3993,1.3975,1.3958,1.3940,1.3923,1.3906,1.3888,1.3870,1.3851,
& 1.3830,1.3808,1.3784,1.3758,1.3731,1.3703,1.3676,1.3648,1.3620,
& 1.3592,1.3565,1.3537,1.3510,1.3484,1.3458,1.3433,1.3410,1.3388,
& 1.3368,1.3350,1.3333,1.3317,1.3303,1.3289,1.3275,1.3263,1.3251,
& 1.3239,1.3228,1.3217,1.3205,1.3194,1.3182,1.3169,1.3155,1.3140,
& 1.3123,1.3105,1.3086,1.3066,1.3046,1.3026,1.3005,1.2985,1.2964,
& 1.2944,1.2923,1.2902,1.2882,1.2863,1.2844,1.2826,1.2808,1.2793,
& 1.2781,1.2765,1.2750,1.2738,1.2728,1.2719,1.2712,1.2708,1.2712,
& 1.2736/
data (ke(i), i = 1, 100)/
&.1104,.0893,.0714,.0567,.0442,.0348,.0279,.0232,.0197,.0173,.0154,
&.0142,.0120,.0108,.0093,.0092,.0092,.0092,.0092,.0092,.0091,.0091,
&.0091,.0091,.0091,.0090,.0090,.0090,.0090,.0090,.0089,.0089,.0089,
&.0089,.0088,.0088,.0088,.0088,.0088,.0087,.0087,.0087,.0087,.0087,
&.0086,.0086,.0086,.0086,.0086,.0085,.0085,.0085,.0085,.0085,.0084,
&.0084,.0084,.0084,.0084,.0083,.0083,.0083,.0082,.0082,.0082,.0082,
&.0082,.0081,.0081,.0081,.0081,.0081,.0080,.0080,.0080,.0080,.0080,
&.0079,.0079,.0079,.0079,.0079,.0078,.0078,.0078,.0078,.0078,.0077,
&.0077,.0077,.0077,.0077,.0076,.0076,.0076,.0076,.0076,.0075,.0075,
&.0075/
data (ke(i), i = 101, 200)/
&.0074,.0073,.0072,.0071,.0070,.0069,.0068,.0068,.0067,.0066,.0065,
&.0064,.0063,.0062,.0062,.0061,.0060,.0059,.0058,.0057,.0056,.0056,
&.0054,.0053,.0053,.0052,.0051,.0050,.0049,.0048,.0047,.0047,.0046,
&.0045,.0044,.0043,.0042,.0041,.0040,.0039,.0039,.0037,.0037,.0036,
&.0035,.0034,.0033,.0032,.0031,.0031,.0030,.0029,.0028,.0027,.0026,
&.0025,.0025,.0024,.0023,.0022,.0021,.0020,.0019,.0019,.0018,.0017,
&.0016,.0015,.0014,.0014,.0013,.0012,.0010,.0010,.0009,.0008,.0007,
&.0006,.0006,.0005,.0004,.0003,.0002,.0002,.0001,15*.0000/
data kab/
& .04664,.04684,.04568,.04482,.04344,.04257,.04287,.04189,.04116,
& .03847,.03409,
& .03213,.03096,.03116,.03051,.03061,.02998,.02965,.02913,.02902,
& .02769,.02707,.02539,.02409,.02150,.01807,.01566,.01317,.01095,
& .00929,.00849,.00803,.00788,.00757,.00734,.00713,.00692,.00693,
& .00716,.00758,.00815,.00877,.00938,.00976,.01041,.01089,.01105,
& .01127,.01170,.01222,.01280,.01374,.01441,.01462,.01495,.01499,
& .01506,.01580,.01686,.01810,.01961,.02112,.02336,.02702,.02880,
& .02992,.03142,.03171,.02961,.02621,.02078,.01518,.01020,.00718,
& .00519,.00390,.00298,.00218,.00163,.00116,.00083,.00057,.00039,
& .00027,.00014,.00011,.00009,.00005,112*.00000/
data kw/
& 111*0.,00.100,00.200,00.278,00.206,00.253,00.260,00.313,00.285,
& 00.653,00.614,00.769,00.901,00.872,00.812,00.733,00.724,00.855,
& 00.900,01.028,01.500,02.026,02.334,03.636,08.942,14.880,17.838,
& 19.497,19.419,17.999,12.024,10.709,08.384,07.081,06.155,05.619,
& 05.112,04.512,04.313,04.064,03.804,03.709,03.877,04.348,04.574,
& 05.029,05.804,06.345,05.823,05.886,06.315,08.432,15.588,32.247,
& 51.050,58.694,55.135,50.454,42.433,40.670,36.030,29.771,25.153,
& 24.378,22.008,20.608,18.576,17.257,15.921,14.864,12.861,12.773,
& 12.426,13.090,14.013,15.066,15.857,16.776,19.113,21.066,22.125,
& 26.438,28.391,28.920,31.754,36.375,40.056,41.019,45.471,43.126/
data (phis1(i), i = 1, 100)/
& .088, .095, .102, .109, .116, .123, .130, .136, .143, .150,
& .157, .164, .171, .178, .185, .192, .199, .206, .213, .220,
& .227, .233, .240, .247, .254, .261, .268, .275, .282, .289,
& .295, .302, .309, .316, .326, .335, .345, .356, .366, .376,
& .386, .395, .404, .412, .421, .429, .436, .443, .450, .457,
& .464, .470, .476, .483, .489, .495, .502, .508, .514, .520,
& .526, .532, .538, .543, .549, .555, .561, .568, .574, .580,
& .587, .594, .601, .608, .615, .622, .629, .637, .644, .652,
& .659, .667, .674, .681, .689, .696, .702, .709, .716, .723,
& .729, .735, .742, .748, .754, .760, .766, .771, .777, .782/
data (phis1(i), i = 101, 200)/
& .802, .819, .832, .842, .854, .868, .883, .899, .917, .935,
& .954, .974, .993,1.012,1.030,1.047,1.063,1.078,1.091,1.102,
& 1.111,1.118,1.126,1.137,1.150,1.163,1.176,1.187,1.192,1.188,
& 1.177,1.159,1.134,1.090, .979, .830, .764, .744, .748, .777,
& .823, .878, .932, .983,1.026,1.062,1.091,1.115,1.133,1.147,
& 1.156,1.161,1.162,1.158,1.149,1.132,1.109,1.087,1.072,1.056,
& 1.035, .989, .886, .659, .456, .350, .323, .335, .361, .396,
& .438, .484, .530, .576, .622, .664, .705, .740, .768, .788,
& .800, .802, .796, .794, .797, .789, .779, .756, .725, .715,
& .675, .635, .585, .535, .485, .435, .385, .335, .285, .235/
data (phis2(i), i = 1, 100)/
& .249, .245, .241, .237, .232, .228, .222, .217, .211, .205,
& .199, .193, .186, .179, .171, .163, .155, .147, .139, .130,
& .121, .111, .102, .092, .081, .071, .060, .049, .038, .026,
& .014, .002,-.011,-.024,-.037,-.050,-.064,-.078,-.092,-.107,
& -.121,-.137,-.152,-.168,-.184,-.200,-.216,-.232,-.246,-.259,
& -.270,-.280,-.289,-.297,-.303,-.308,-.313,-.317,-.322,-.325,
& -.329,-.332,-.335,-.338,-.340,-.342,-.345,-.347,-.350,-.352,
& -.355,-.358,-.360,-.363,-.366,-.369,-.372,-.374,-.377,-.378,
& -.380,-.381,-.382,-.382,-.383,-.382,-.382,-.381,-.380,-.378,
& -.376,-.373,-.370,-.367,-.363,-.359,-.354,-.349,-.344,-.338/
data (phis2(i), i = 101, 200)/
& -.310,-.283,-.258,-.234,-.212,-.190,-.167,-.143,-.118,-.092,
& -.066,-.039,-.014, .011, .034, .057, .083, .114, .151, .192,
& .233, .272, .311, .348, .380, .407, .438, .476, .521, .570,
& .624, .674, .708, .766, .824, .853, .854, .852, .858, .881,
& .916, .947, .973, .997,1.017,1.036,1.052,1.067,1.082,1.095,
& 1.107,1.119,1.131,1.142,1.154,1.166,1.175,1.179,1.178,1.172,
& 1.162,1.148,1.083, .900, .678, .538, .499, .515, .552, .598,
& .653, .716, .777, .834, .886, .932, .973,1.007,1.036,1.058,
& 1.075,1.086,1.091,1.091,1.086,1.076,1.060,1.039,1.012, .980,
& .943, .900, .852, .799, .740, .676, .606, .532, .451, .366/
data (phis3(i), i = 1, 100)/
& -.417,-.384,-.351,-.318,-.285,-.253,-.221,-.189,-.157,-.126,
& -.095,-.064,-.033,-.003, .027, .057, .087, .117, .146, .175,
& .204, .232, .260, .289, .316, .344, .371, .399, .425, .452,
& .478, .505, .525, .545, .566, .587, .606, .626, .652, .676,
& .699, .722, .744, .764, .784, .804, .822, .839, .856, .872,
& .886, .900, .913, .926, .937, .948, .957, .966, .974, .981,
& .988, .993, .998,1.002,1.006,1.009,1.012,1.014,1.016,1.017,
& 1.018,1.018,1.018,1.017,1.016,1.014,1.012,1.010,1.007,1.003,
& .999, .995, .990, .984, .978, .972, .965, .957, .949, .941,
& .932, .923, .913, .902, .891, .880, .868, .855, .842, .829/
data (phis3(i), i = 101, 200)/
& .766, .694, .620, .550, .484, .421, .361, .303, .247, .190,
& .134, .079, .023,-.031,-.086,-.140,-.190,-.235,-.275,-.310,
& -.340,-.367,-.394,-.422,-.452,-.484,-.513,-.541,-.565,-.578,
& -.575,-.556,-.525,-.468,-.323,-.115,-.018, .002,-.003,-.029,
& -.076,-.142,-.211,-.274,-.333,-.386,-.432,-.471,-.503,-.528,
& -.544,-.551,-.549,-.538,-.517,-.491,-.463,-.436,-.419,-.417,
& -.401,-.348,-.216, .014, .160, .203, .209, .210, .207, .200,
& .189, .174, .155, .132, .105, .075, .043, .013,-.012,-.035,
& -.053,-.068,-.078,-.082,-.080,-.073,-.060,-.041,-.017, .006,
& .035, .065, .097, .125, .168, .180, .168, .125, .097, .065/
data (phis4(i), i = 1, 100)/
& .067, .077, .086, .094, .102, .111, .118, .126, .133, .140,
& .146, .152, .158, .164, .169, .174, .179, .184, .188, .192,
& .195, .198, .201, .204, .206, .208, .210, .212, .213, .214,
& .214, .214, .214, .214, .213, .212, .211, .210, .210, .209,
& .207, .205, .202, .198, .194, .189, .184, .179, .173, .167,
& .161, .155, .149, .143, .136, .130, .123, .116, .108, .101,
& .093, .085, .077, .068, .060, .051, .043, .034, .026, .018,
& .010, .002,-.006,-.014,-.022,-.030,-.037,-.045,-.052,-.060,
& -.067,-.074,-.081,-.087,-.093,-.098,-.103,-.108,-.112,-.116,
& -.120,-.123,-.126,-.129,-.132,-.134,-.136,-.138,-.140,-.141/
data (phis4(i), i = 101, 200)/
& -.147,-.152,-.158,-.166,-.170,-.165,-.157,-.151,-.144,-.128,
& -.104,-.078,-.049,-.009, .038, .082, .122, .169, .222, .272,
& .317, .364, .413, .469, .532, .591, .642, .694, .748, .790,
& .810, .817, .819, .740, .494, .215, .110, .125, .155, .204,
& .291, .408, .521, .627, .724, .811, .884, .940, .987,1.025,
& 1.053,1.071,1.077,1.072,1.046, .996, .941, .892, .857, .842,
& .809, .713, .509, .055,-.236,-.324,-.336,-.320,-.308,-.294,
& -.275,-.248,-.205,-.144,-.094,-.048, .005, .058, .105, .132,
& .123, .079, .045, .024, .014, .018, .022,-.010,-.042,-.054,
& -.055,-.060,-.060,-.055,-.050,-.046,-.042,-.038,-.034,-.030/
end
*
******************************************************************
*
subroutine dakg(u, a, nq)
c Gaussi kvadratuuri sqlmed ja kordajad, nq = 2*n, u=(-1., 1.)
implicit double precision (a-h, o-z)
dimension u(48), a(48)
c
* print *,'dakg'
n = nq/2
goto (1, 2, 1, 4, 1, 6, 1, 8, 1, 10, 1, 12, 1, 14, 1, 16, 1,
& 1, 1, 20, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
& 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 48), nq
1 continue
print *, ' *** dakg - inacceptable nq'
stop 'dakg'
c
2 continue
u(2) = .577350269189626d0
a(2) = 1.d0
goto 13
c
4 continue
u(3) = .339981043584856d0
u(4) = .861136311594053d0
a(3) = .652145154862546d0
a(4) = .347854845137454d0
goto 13
c
6 continue
u(4) = .238619186083197d0
u(5) = .661209386466265d0
u(6) = .932469514203152d0
a(4) = .467913934572691d0
a(5) = .360761573048139d0
a(6) = .171324492379170d0
goto 13
c
8 continue
u(5) = .183434642495650d0
u(6) = .525532409916329d0
u(7) = .796666477413627d0
u(8) = .960289856497536d0
a(5) = .362683783378362d0
a(6) = .313706645877887d0
a(7) = .222381034453374d0
a(8) = .101228536290376d0
goto 13
c
10 continue
u(6) = .148874338981631d0
u(7) = .433395394129247d0
u(8) = .679409568299024d0
u(9) = .865063366688985d0
u(10) = .973906528517172d0
a(6) = .295524224714753d0
a(7) = .269266719309996d0
a(8) = .219086362515982d0
a(9) = .149451349150580d0
a(10) = .666713443086881d-1
goto 13
c
12 continue
u(7) = .125233408511469d0
u(8) = .367831498998180d0
u(9) = .587317954286617d0
u(10) = .769902674194305d0
u(11) = .904117256370475d0
u(12) = .981560634246719d0
a(7) = .249147045813402d0
a(8) = .233492536538355d0
a(9) = .203167426723066d0
a(10) = .160078328543346d0
a(11) = .106939325995318d0
a(12) = .471753363865118d-1
goto 13
c
14 continue
u( 8) = .108054948707344d0
u( 9) = .319112368927890d0
u(10) = .515248636358154d0
u(11) = .687292904811685d0
u(12) = .827201315069765d0
u(13) = .928434883663574d0
u(14) = .986283808696812d0
a( 8) = .215263853463158d0
a( 9) = .205198463721296d0
a(10) = .185538397477938d0
a(11) = .157203167158194d0
a(12) = .121518570687903d0
a(13) = .801580871597602d-1
a(14) = .351194603317519d-1
goto 13
c
16 continue
u( 9) = .950125098376374d-1
u(10) = .281603550779259d0
u(11) = .458016777657227d0
u(12) = .617876244402643d0
u(13) = .755404408355003d0
u(14) = .865631202387832d0
u(15) = .944575023073233d0
u(16) = .989400934991650d0
a( 9) = .189450610455068d0
a(10) = .182603415044924d0
a(11) = .169156519395003d0
a(12) = .149595988816577d0
a(13) = .124628971255534d0
a(14) = .951585116824928d-1
a(15) = .622535239386479d-1
a(16) = .271524594117541d-1
goto 13
c
20 continue
u(11) = .765265211334973d-1
u(12) = .227785851141645d0
u(13) = .373706088715420d0
u(14) = .510867001950827d0
u(15) = .636053680726515d0
u(16) = .746331906460151d0
u(17) = .839116971822219d0
u(18) = .912234428251326d0
u(19) = .963971927277914d0
u(20) = .993128599185095d0
a(11) = .152753387130726d0
a(12) = .149172986472604d0
a(13) = .142096109318382d0
a(14) = .131688638449177d0
a(15) = .118194531961518d0
a(16) = .101930119817240d0
a(17) = .832767415767047d-1
a(18) = .626720483341091d-1
a(19) = .406014298003869d-1
a(20) = .176140071391521d-1
goto 13
c
48 continue
u(25) = .323801709628694d-1
u(26) = .970046992094627d-1
u(27) = .161222356068892d0
u(28) = .224763790394689d0
u(29) = .287362487355456d0
u(30) = .348755886292161d0
u(31) = .408686481990717d0
u(32) = .466902904750958d0
u(33) = .523160974722233d0
u(34) = .577224726083973d0
u(35) = .628867396776514d0
u(36) = .677872379632664d0
u(37) = .724034130923815d0
u(38) = .767159032515740d0
u(39) = .807066204029443d0
u(40) = .843588261624394d0
u(41) = .876572020274247d0
u(42) = .905879136715570d0
u(43) = .931386690706554d0
u(44) = .952987703160431d0
u(45) = .970591592546247d0
u(46) = .984124583722827d0
u(47) = .993530172266351d0
u(48) = .998771007252426d0
a(25) = .647376968126839d-1
a(26) = .644661644359501d-1
a(27) = .639242385846482d-1
a(28) = .631141922862540d-1
a(29) = .620394231598927d-1
a(30) = .607044391658939d-1
a(31) = .591148396983956d-1
a(32) = .572772921004032d-1
a(33) = .551995036999842d-1
a(34) = .528901894851937d-1
a(35) = .503590355538545d-1
a(36) = .476166584924905d-1
a(37) = .446745608566943d-1
a(38) = .415450829434647d-1
a(39) = .382413510658307d-1
a(40) = .347772225647704d-1
a(41) = .311672278327981d-1
a(42) = .274265097083569d-1
a(43) = .235707608393244d-1
a(44) = .196161604573555d-1
a(45) = .155793157229438d-1
a(46) = .114772345792345d-1
a(47) = .732755390127626d-2
a(48) = .315334605230584d-2
13 continue
c
nq1 = nq+1
do 15 i = 1,n
ii = nq1-i
u(i) = -u(ii)
a(i) = a(ii)
15 continue
c
return
end
*
******************************************************************
c akbrdf - an interface between 6s and msrm
c MSRM93 - MultiSpectral Reflectance Model A. Kuusk 24.03.1993
c Internet: andres@aai.ee
c
c A. Kuusk, A multispectral canopy reflectance model,
c Remote Sens. Environ., 1994, 50(2):75-82.
c
subroutine akbrdf(eei, thmi, uli, sli, rsl1i, wlmoy, rnci,
& cabi, cwi, vaii, mu, np, rm, rp, brdfint)
c See on tegelikult juba mcrm, aga clx ja clz on fikseeritud
c
implicit double precision (a-h, o-z)
double precision integr
integer np, mu
integer k, j
real eei, thmi, uli, sli, rsl1i, wlmoy, rnci, cabi, cwi,
& vaii, pir
real mu1, mu2, fi
real rm(-mu:mu), rp(np), brdfint(-mu:mu, np)
save /count/, /soildata/, /aaa/, /ggg/, /ladak/
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
double precision nnl, kk
common /leafin/ nnl, vai, kk
common /leafout/ refl, tran
c
double precision ke, kab, kw
dimension refr(200), ke(200), kab(200), kw(200)
common /dat/ refr, ke, kab, kw
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /cfresn/ rn, rk
common /ladak/ ee, thm, sthm, cthm
common /msrmdata/ th10, rncoef, cab, cw, bq
c
c
data pi/3.141592653589793d0/, pir/3.14159265/
data pi12/1.570796326794895d0/, dr/1.745329251994330d-2/
data eps/.1d-5/, eps4/.1d-3/
data lf/1/
c
* print *, 'msrm93'
c
integr(xx) = (1.d0 - exp(-xx))/xx
jg = 1
* if (lf .eq. 1) then
c
ee = eei
thm = thmi*dr
ul = uli
sl = sli
clz = .9d0
clx = .1d0
th2 = 45.d0*dr
rsl1 = rsl1i
rsl2 = -.48d0*rsl1 + .0862d0
rsl3 = 0.d0
rsl4 = 0.d0
rlambda = wlmoy*1000.d0
c
if ((rlambda .gt. 2500.d0) .or. (rlambda .lt. 404.d0)) then
print *, 'AKBRDF: wavelength out of range'
stop
endif
c
if (rlambda .le. 800.d0) then
jl = nint((rlambda - 400.d0)/4.d0)
else
jl = nint((rlambda - 800.d0)/17.d0) + 100
endif
c
rncoef = rnci
cab = cabi
cw = cwi
vai = vaii
nnl = refr(jl)
kk = ke(jl) + cab*kab(jl) + cw*kw(jl)
call leaf
c
rn = rncoef*nnl
rrl = refl - ((1.d0 - rn)/(1.d0 + rn))**2
rrls = rrl
ttl = tran
c
call soilspec
c
cthm = cos(thm)
sthm = sin(thm)
c
th22 = pi12 - thm
if (abs(th22) .lt. eps4) th22 = 0.d0
eln = -log(1.d0 - ee)
difmy = abs(.059d0*eln*(thm - 1.02d0) + .02d0)
difsig = abs(.01771d0 - .0216d0*eln*(thm - .256d0))
c
* lf = 2
* endif
c
sth10 = sin(th10)
cth10 = cos(th10)
c
mu1 = rm(0)
do 1 k = 1, np
do 2 j = 1, mu
mu2 = rm(j)
if (j .eq. mu) then
fi = rm(-mu)
else
fi = rp(k) + rm(-mu)
endif
th10 = acos(mu1)
if (fi .lt. 0.) fi = fi + 2.*pir
if (fi .gt. (2.*pir)) fi = fi - 2.*pir
if (fi .gt. pir) fi = 2.*pir - fi
tgt1 = tan(th10)
xx = tgt1*clx/sl
c
if (xx .lt. eps) then
clmp1 = clz
else
clmp1 = 1.d0 - (1.d0 - clz)*integr(xx)
endif
c
phi = fi
th1 = th10
th = acos(mu2)
tgt = tan(th)
xx = tgt*clx/sl
c
if (xx .lt. eps) then
clmp = clz
else
clmp = 1.d0 - (1.d0 - clz)*integr(xx)
endif
c
call msrm
brdfint(j, k) = bq
c
2 continue
1 continue
c
return
end
*
*
******************************************************************
*
subroutine akalbe
* & (eei, thmi, uli, sli, rsl1i, wlmoy, rnci, cabi, cwi, vaii, albbrdf)
& (albbrdf)
c
c aa94.f - albeedo integrating msrm93 over the hemisphere
c A. Kuusk 23.09.1994
c
implicit double precision (a-h, o-z)
c
* real eei, thmi, uli, sli, rsl1i, wlmoy, rnci, cabi, cwi, vaii, albbrdf
real albbrdf
save /count/, /soildata/, /aaa/, /ggg/, /ladak/
c
dimension uu(20), aa(20)
c
dimension u1(10), u2(10), a1(10), a2(10)
common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
c
dimension phis1(200), phis2(200), phis3(200), phis4(200)
common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
& rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
c
common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
common /ggg/gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
& phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
& s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
& alph, salph, alpp, difmy, difsig
common /ladak/ ee, thm, sthm, cthm
c
data pi/3.141592653589793d0/, pi1/1.5707963268d0/
c
* print *, 'aa94'
c
n1 = 6
n2 = 8
c
n = n2 + n2
ng = n + 1
call dakg(uu, aa, n)
c
do 20 i = 1, n2
i1 = ng - i
a2(i) = aa(i)
20 u2(i) = uu(i1)
c
n = n1 + n1
ng = n + 1
call dakg(uu, aa, n)
c
do 21 i = 1, n1
i1 = ng - i
a1(i) = aa(i)
21 u1(i) = uu(i1)
c
bdd = 0.d0
do 10 i2 = 1, n2
th = (1.d0 - u2(i2))*pi1
sth = sin(th)
cth = cos(th)
c
call akd
c
bdd = bdd + a2(i2)*bqint*sth*cth
10 continue
c
albbrdf = bdd*pi
c
return
end
*
******************************************************************
*
ALI.f0000644002107500000270000002066412463730616010146 0ustar jckraps subroutine ali(iwa)
common /sixs_ffu/ s(1501),wlinf,wlsup
real sr(9,1501),wli(9),wls(9)
real wlinf,wlsup,s
integer iwa,l,i
c
c 1st spectral band of ALI; band 1p
c
data (sr(1,l),l=1,1501)/ 60*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0001,0.0011,0.0084,0.1313,0.7159,0.8481,0.9010,
a0.9452,0.9771,0.9889,0.9906,0.8846,0.1411,0.0208,0.0038,
a0.0006,0.0003,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,
a1400*0./
c
c 2nd spectral band of ALI; band 1
c
data (sr(2,l),l=1,1501) / 65*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0001,0.0004,0.0014,0.0044,0.0098,0.0226,0.0763,0.3166,
a0.5795,0.6084,0.6413,0.6608,0.6771,0.7032,0.7233,0.7249,
a0.7253,0.7512,0.7960,0.8345,0.8558,0.8720,0.8795,0.8775,
a0.8799,0.8978,0.9296,0.9687,0.9861,0.9854,0.9962,0.9680,
a0.6394,0.2610,0.1008,0.0442,0.0219,0.0113,0.0058,0.0029,
a0.0014,0.0008,0.0004,0.0002,0.0001,0.0001,0.0001,0.0001,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,
a1370*0./
c
c 3rd spectral band of ALI; band 2
c
data (sr(3,l),l=1,1501)/ 95*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0001,0.0001,0.0002,
a0.0005,0.0011,0.0021,0.0038,0.0081,0.0217,0.0658,0.1825,
a0.3777,0.6131,0.7679,0.8196,0.8427,0.8554,0.8567,0.8502,
a0.8490,0.8573,0.8732,0.8969,0.9042,0.9062,0.9089,0.9126,
a0.9170,0.9170,0.9187,0.9329,0.9514,0.9537,0.9664,0.9717,
a0.9651,0.9676,0.9866,0.9995,0.9876,0.8677,0.5832,0.3143,
a0.1601,0.0824,0.0413,0.0182,0.0075,0.0029,0.0012,0.0006,
a0.0003,0.0002,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,
a1340*0./
c
c 4th spectral band of ALI; band 3
c
data (sr(4,l),l=1,1501)/ 125*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0001,0.0001,0.0003,0.0005,
a0.0009,0.0012,0.0015,0.0022,0.0036,0.0070,0.0150,0.0334,
a0.0692,0.1318,0.2436,0.4438,0.6893,0.8373,0.8585,0.8435,
a0.8591,0.8960,0.9181,0.9271,0.9341,0.9209,0.8920,0.8939,
a0.9305,0.9463,0.9286,0.9264,0.9547,0.9759,0.9617,0.9657,
a0.9958,0.9733,0.7396,0.3597,0.1325,0.0483,0.0195,0.0089,
a0.0044,0.0025,0.0014,0.0008,0.0006,0.0004,0.0002,0.0002,
a0.0001,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,
a1300*0./
c
c 5th spectral band of ALI; band 4
c
data (sr(5,l),l=1,1501)/ 195*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0002,0.0003,
a0.0006,0.0015,0.0040,0.0114,0.0300,0.0717,0.1817,0.5186,
a0.9563,0.9936,0.9853,0.9929,0.9897,0.9949,0.9829,0.9638,
a0.9497,0.9633,0.9018,0.6182,0.2122,0.0549,0.0186,0.0086,
a0.0053,0.0035,0.0021,0.0012,0.0006,0.0005,0.0003,0.0001,
a0.0001,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,
a1255*0./
c
c 6th spectral band of ALI; band 4p
c
data (sr(6,l),l=1,1501)/ 215*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0001,0.0001,0.0001,0.0002,0.0003,0.0005,
a0.0009,0.0019,0.0041,0.0103,0.0298,0.0997,0.3584,0.8497,
a1.0001,0.9855,0.9949,0.9972,0.9853,0.9723,0.9730,0.9684,
a0.9588,0.9316,0.9186,0.9158,0.9197,0.8857,0.8538,0.7765,
a0.6116,0.3680,0.1625,0.0610,0.0237,0.0101,0.0049,0.0026,
a0.0015,0.0008,0.0005,0.0005,0.0004,0.0003,0.0002,0.0002,
a0.0001,0.0003,0.0002,0.0005,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,
a1220*0./
c
c 7th spectral band of ALI; band 5p
c
data (sr(7,l),l=1,1501)/ 345*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0001,
a0.0001,0.0001,0.0002,0.0003,0.0002,0.0002,0.0002,0.0003,
a0.0003,0.0004,0.0004,0.0008,0.0009,0.0015,0.0022,0.0034,
a0.0058,0.0092,0.0140,0.0192,0.0267,0.0355,0.0498,0.0723,
a0.1116,0.1858,0.3199,0.5328,0.7562,0.9017,0.9402,0.9297,
a0.9222,0.9260,0.9362,0.9446,0.9478,0.9472,0.9457,0.9467,
a0.9516,0.9584,0.9682,0.9755,0.9810,0.9824,0.9807,0.9787,
a0.9726,0.9715,0.9696,0.9765,0.9842,0.9951,0.9996,0.9910,
a0.9682,0.9357,0.9049,0.8833,0.8706,0.8215,0.6849,0.4661,
a0.2654,0.1402,0.0764,0.0440,0.0265,0.0169,0.0113,0.0082,
a0.0059,0.0049,0.0039,0.0031,0.0026,0.0022,0.0018,0.0014,
a0.0011,0.0007,0.0005,0.0003,0.0002,0.0002,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0000,
a1055*0./
c
c 8th spectral band of ALI; band 5
c
data (sr(8,l),l=1,1501)/ 480*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0001,0.0001,0.0001,0.0001,0.0001,0.0002,0.0002,0.0003,
a0.0004,0.0005,0.0006,0.0007,0.0009,0.0011,0.0013,0.0020,
a0.0026,0.0037,0.0057,0.0086,0.0135,0.0214,0.0334,0.0518,
a0.0782,0.1146,0.1613,0.2193,0.2934,0.3864,0.4983,0.6170,
a0.7217,0.7857,0.8018,0.7861,0.7596,0.7366,0.7249,0.7270,
a0.7409,0.7616,0.7886,0.8175,0.8443,0.8656,0.8828,0.8966,
a0.9056,0.9125,0.9196,0.9252,0.9278,0.9311,0.9341,0.9360,
a0.9368,0.9382,0.9396,0.9385,0.9388,0.9372,0.9338,0.9264,
a0.9186,0.9089,0.8990,0.8885,0.8803,0.8738,0.8699,0.8706,
a0.8741,0.8822,0.8928,0.9058,0.9197,0.9353,0.9493,0.9631,
a0.9740,0.9831,0.9906,0.9959,0.9996,0.9996,0.9997,0.9969,
a0.9945,0.9895,0.9838,0.9744,0.9619,0.9451,0.9220,0.8901,
a0.8512,0.8073,0.7585,0.7115,0.6652,0.6221,0.5803,0.5416,
a0.5010,0.4546,0.4014,0.3432,0.2823,0.2229,0.1714,0.1290,
a0.0972,0.0733,0.0557,0.0427,0.0332,0.0263,0.0209,0.0168,
a0.0135,0.0109,0.0087,0.0070,0.0056,0.0043,0.0034,0.0027,
a0.0021,0.0017,0.0014,0.0011,0.0008,0.0007,0.0007,0.0004,
a0.0003,0.0003,0.0001,0.0003,0.0002,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,
a860*0./
c
c 9th spectral band of ALI; bnad 7
c
data (sr(9,l),l=1,1501)/ 685*0.,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0001,
a0.0002,0.0003,0.0003,0.0002,0.0004,0.0004,0.0004,0.0006,
a0.0006,0.0007,0.0008,0.0009,0.0010,0.0012,0.0016,0.0018,
a0.0023,0.0027,0.0033,0.0039,0.0047,0.0058,0.0069,0.0084,
a0.0104,0.0126,0.0158,0.0197,0.0244,0.0307,0.0386,0.0493,
a0.0625,0.0793,0.1010,0.1283,0.1642,0.2080,0.2619,0.3250,
a0.3987,0.4798,0.5613,0.6402,0.7113,0.7732,0.8233,0.8595,
a0.8875,0.9056,0.9190,0.9281,0.9355,0.9401,0.9440,0.9459,
a0.9476,0.9500,0.9503,0.9509,0.9513,0.9487,0.9486,0.9485,
a0.9469,0.9481,0.9464,0.9445,0.9443,0.9444,0.9397,0.9380,
a0.9410,0.9445,0.9410,0.9407,0.9432,0.9454,0.9459,0.9466,
a0.9506,0.9525,0.9571,0.9572,0.9580,0.9594,0.9627,0.9642,
a0.9669,0.9677,0.9685,0.9710,0.9724,0.9726,0.9760,0.9763,
a0.9768,0.9779,0.9773,0.9775,0.9796,0.9790,0.9802,0.9816,
a0.9806,0.9813,0.9820,0.9820,0.9840,0.9838,0.9831,0.9845,
a0.9846,0.9847,0.9874,0.9885,0.9903,0.9939,0.9941,0.9965,
a0.9974,0.9977,0.9989,0.9996,0.9982,0.9992,0.9979,0.9963,
a0.9947,0.9917,0.9887,0.9871,0.9839,0.9805,0.9787,0.9764,
a0.9744,0.9733,0.9682,0.9627,0.9567,0.9485,0.9397,0.9281,
a0.9115,0.8898,0.8607,0.8228,0.7726,0.7155,0.6492,0.5808,
a0.5112,0.4415,0.3763,0.3172,0.2647,0.2208,0.1824,0.1500,
a0.1233,0.1013,0.0832,0.0687,0.0567,0.0469,0.0390,0.0324,
a0.0268,0.0223,0.0185,0.0155,0.0130,0.0109,0.0093,0.0078,
a0.0067,0.0056,0.0048,0.0041,0.0035,0.0030,0.0026,0.0022,
a0.0019,0.0016,0.0014,0.0012,0.0011,0.0009,0.0008,0.0007,
a0.0006,0.0005,0.0005,0.0004,0.0004,0.0003,0.0003,0.0003,
a0.0002,0.0002,0.0002,0.0002,0.0001,0.0001,0.0001,0.0001,
a0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,
a0.0001,0.0001,0.0001,0.0001,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,
a570*0./
c
wli(1)=0.4225
wls(1)=0.4625
wli(2)=0.4325
wls(2)=0.550
wli(3)=0.500
wls(3)=0.630
wli(4)=0.5775
wls(4)=0.730
wli(5)=0.7525
wls(5)=0.8375
wli(6)=0.8025
wls(6)=0.935
wli(7)=1.130
wls(7)=1.345
wli(8)=1.470
wls(8)=1.820
wli(9)=1.980
wls(9)=2.530
do 1 i=1,1501
s(i)=sr(iwa,i)
1 continue
wlinf=wli(iwa)
wlsup=wls(iwa)
return
end
ASTER.f0000644002107500000270000001635412463730616010420 0ustar jckraps subroutine aster(iwa)
common /sixs_ffu/ s(1501),wlinf,wlsup
real sr(10,1501),wli(10),wls(10)
real wlinf,wlsup,s
integer iwa,l,i
c
c aster vnir band 1
c
data (sr(1,l),l=1,1501) /
& 94*0.,
& .0075, .0078, .0082, .0066, .0062, .0253, .0580, .0906,
& .1598, .2692, .3714, .4814, .6180, .7436, .8392, .9074,
& .9552, .9864,1.0003, .9986, .9804, .9372, .8900, .8734,
& .8807, .8941, .8986, .9056, .9226, .9246, .9184, .9292,
& .9434, .9495, .9520, .9547, .9590, .9619, .9528, .9234,
& .8976, .8760, .8254, .7622, .7057, .6308, .5206, .3792,
& .2503, .1634, .1155, .0862, .0598, .0448, .0355, .0187,
& .0065, .0046, .0040, .0038, .0053, .0053, .0037, .0000,
& 1343*0./
c
c aster vnir band 2
c
data (sr(2,l),l=1,1501) /
& 136*0.,
& .0038, .0036, .0008, .0004, .0028, .0027, .0006, .0041,
& .0063, .0008, .0084, .0087, .0000, .1218, .2733, .4701,
& .6735, .8347, .9709,1.0023, .9838, .9693, .9727, .9727,
& .9430, .9089, .9271, .9467, .9365, .9197, .9100, .8986,
& .8613, .8188, .7982, .7887, .7702, .7558, .6962, .6088,
& .5179, .4509, .4258, .3819, .3240, .2597, .1855, .1112,
& .0623, .0461, .0342, .0185, .0105, .0100, .0054, .0043,
& .0020,
& 1308*0./
c
c aster vnir band 3n
c
data (sr(3,l),l=1,1501) /
& 188*0.,
& .0022, .0000, .0014, .0078, .0162, .0289, .0444, .0487,
& .0509, .0738, .1178, .1774, .2504, .3628, .5441, .7950,
&1.0000,1.0182, .9516, .9033, .8953, .9222, .9639, .9906,
& .9942, .9847, .9752, .9658, .9444, .9372, .9617, .9783,
& .9820, .9924, .9984, .9918, .9795, .9759, .9855, .9840,
& .9694, .9574, .9540, .9514, .9326, .9269, .9528, .9619,
& .9489, .9419, .9429, .9351, .8916, .8217, .7367, .6191,
& .4813, .3574, .2609, .1892, .1278, .0831, .0610, .0451,
& .0318, .0267, .0252, .0217, .0134, .0068, .0070, .0071,
& .0049, .0030, .0024, .0025,
& 1237*0./
c
c aster vnir band 3b
c
data (sr(4,l),l=1,1501) /
& 188*0.,
& .0099, .0080, .0107, .0187, .0287, .0412, .0579, .0797,
& .1218, .1996, .2872, .3827, .5204, .6754, .8016, .8701,
& .8973, .9251, .9616, .9957,1.0056, .9967, .9808, .9566,
& .9279, .9045, .8983, .9049, .9030, .9019, .9129, .9200,
& .9138, .8983, .9004, .9186, .9144, .9022, .9032, .8988,
& .8883, .8852, .8883, .8928, .8960, .9056, .9202, .9102,
& .8863, .8811, .8794, .8617, .8219, .7809, .7470, .6763,
& .5576, .4183, .3163, .2605, .1963, .1353, .1021, .0795,
& .0594, .0436, .0282, .0148, .0125, .0148, .0140, .0156,
& .0146, .0038, .0042, .0171, .0145, .0070, .0095, .0069,
& .0000, .0013,
& 1231*0./
c
c aster swir band 4
c
data (sr(5,l),l=1,1501) /
& 528*0.,
& .0040, .0038, .0040, .0052, .0080, .0128, .0190, .0260,
& .0330, .0450, .0740, .0990, .1520, .2140, .3050, .4200,
& .5970, .6750, .7900, .8270, .8400, .8480, .9010, .9050,
& .9100, .9140, .9050, .9260, .9470, .9670, .9760, .9840,
& .9710, .9790, .9880,1.0000, .9920, .9840, .9780, .9710,
& .9470, .9510, .9450, .9380, .9340, .9300, .9360, .9420,
& .9140, .8970, .7980, .7000, .5970, .4610, .3700, .2630,
& .1730, .1130, .0767, .0565, .0450, .0360, .0281, .0215,
& .0160, .0117, .0083, .0058, .0040, .0027, .0019, .0014,
& .0010, .0007, .0006, .0004, .0003, .0003, .0002, .0002,
& 893*0./
c
c aster swir band 5
c
data (sr(6,l),l=1,1501) /
& 748*0.,
& .0080, .0086, .0100, .0134, .0200, .0290, .0410, .0780,
& .1310, .2050, .3030, .5410, .7050, .7790, .7910, .8030,
& .8220, .8400, .9180, .9590,1.0000, .9750, .9020, .7790,
& .6890, .5900, .4180, .3030, .2300, .1720, .1070, .0700,
& .0610, .0498, .0385, .0273, .0160, .0140, .0120, .0100,
& .0080, .0070, .0060, .0050, .0040, .0037, .0037, .0035,
& .0032, .0031, .0029, .0027, .0026, .0024, .0023, .0021,
& .0020, .0019, .0017, .0016, .0014, .0013, .0012, .0010,
& .0009, .0008,
& 687*0./
c
c aster swir band 6
c
data (sr(7,l),l=1,1501) /
& 760*0.,
& .0080, .0097, .0117, .0138, .0160, .0186, .0223, .0281,
& .0370, .0490, .0660, .1070, .1720, .2540, .3520, .5000,
& .6020, .7420, .7620, .7790, .8520, .8690, .8860, .9020,
& .9290, .9550, .9840,1.0000, .9340, .8200, .7540, .5160,
& .3280, .2380, .1640, .1070, .0570, .0468, .0365, .0263,
& .0160, .0140, .0120, .0100, .0080, .0070, .0060, .0050,
& .0040, .0034, .0031, .0029, .0026, .0022, .0018, .0015,
& .0011, .0007, .0004,
& 682*0./
c
c aster swir band 7
c
data (sr(8,l),l=1,1501) /
& 784*0.,
& .0080, .0113, .0152, .0197, .0250, .0330, .0490, .0700,
& .1150, .1760, .2500, .3850, .5080, .6560, .7950, .8690,
& .8480, .9100, .9100, .9260, .9260, .9430, .9590, .9750,
& .9750,1.0000, .9590, .8690, .7990, .7050, .6230, .5000,
& .3930, .3030, .2420, .1760, .1270, .1060, .0840, .0625,
& .0410, .0370, .0330, .0290, .0250, .0226, .0214, .0200,
& .0183, .0164, .0148, .0131, .0112, .0095, .0081, .0073,
& .0069, .0067, .0066, .0064, .0060, .0055, .0050, .0045,
& .0040, .0035, .0031, .0027, .0022, .0017, .0013, .0008,
& .0004,
& 644*0./
c
c aster swir band 8
c
data (sr(9,l),l=1,1501) /
& 800*0.,
& .0023, .0051, .0079, .0103, .0120, .0129, .0134, .0142,
& .0160, .0193, .0249, .0332, .0450, .0610, .0820, .1060,
& .1390, .2040, .2860, .4490, .6040, .7020, .8330, .9710,
& .9880, .9550, .9800, .9770, .9750, .9720, .9700, .9670,
& .9470, .9620, .9770, .9920,1.0000, .9800, .9960, .9920,
& .9960, .9550, .9630, .9060, .8370, .7840, .7020, .5800,
& .4410, .3430, .2780, .2200, .1670, .1257, .0953, .0734,
& .0570, .0440, .0336, .0257, .0200, .0163, .0141, .0129,
& .0120, .0111, .0101, .0091, .0080, .0069, .0059, .0049,
& .0040, .0032, .0024, .0018, .0012,
& 624*0./
c
c aster swir band 9
c
data (sr(10,l),l=1,1501) /
& 819*0.,
& .0004, .0009, .0015, .0021, .0029, .0037, .0047, .0057,
& .0068, .0080, .0093, .0105, .0114, .0120, .0122, .0129,
& .0151, .0200, .0290, .0450, .0650, .0780, .1100, .1550,
& .2290, .3270, .4240, .5390, .7270, .7840, .9060, .9270,
& .8980, .9000, .9010, .9030, .9040, .9060, .9310, .9270,
& .9220, .9610,1.0000, .9800, .9590, .9270, .8940, .8690,
& .8330, .8160, .7670, .7020, .6610, .5630, .4240, .3430,
& .2610, .1920, .1392, .0992, .0698, .0490, .0347, .0253,
& .0196, .0160, .0134, .0113, .0096, .0080, .0064, .0050,
& .0041, .0040, .0050, .0066, .0085,
& 605*0./
wli(1)=.485
wls(1)=.6425
wli(2)=.590
wls(2)=.730
wli(3)=.720
wls(3)=.9075
wli(4)=.720
wls(4)=.9225
wli(5)=1.570
wls(5)=1.7675
wli(6)=2.120
wls(6)=2.2825
wli(7)=2.150
wls(7)=2.295
wli(8)=2.210
wls(8)=2.390
wli(9)=2.250
wls(9)=2.440
wli(10)=2.2975
wls(10)=2.4875
do 1 i=1,1501
s(i)=sr(iwa,i)
1 continue
wlinf=wli(iwa)
wlsup=wls(iwa)
return
end
ATMREF.f0000644002107500000270000001004112463730616010503 0ustar jckraps subroutine atmref (iaer,iaer_prof,tamoy,taer,trmoy,pizmoy,piza,
s tamoyp,taerp,trmoyp,palt,phi,xmus,xmuv,phirad,nt,mu,np,rm,gb,rp,
s rorayl,roaero,romix,rqrayl,rqaero,rqmix,rurayl,ruaero,rumix,
a ipol,xlm1,xlm2,rorayl_fi,romix_fi,nfi,
a nfilut,filut,rolut,rolutq,rolutu)
real rolut(mu,61),rolutq(mu,61),rolutu(mu,61),rolutd(mu,61)
real filut(mu,61)
integer nfilut(mu)
integer mu,np,nfi
real rm(-mu:mu),rp(np),gb(-mu:mu)
real tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt
real xlm2(-mu:mu,np)
real xlphim(nfi)
real rorayl_fi(nfi),romix_fi(nfi)
real phi,xmus,xmuv,phirad
real delta,sigma,tamol,tamolp
real rorayl,roaero,romix,rqrayl,rqaero,rqmix
real rurayl,ruaero,rumix
real xlm1(-mu:mu,np),xqm1(-mu:mu,np),xum1(-mu:mu,np)
integer iaer,nt,ipol,iaer_prof
common /sixs_del/ delta,sigma
c
c atmospheric reflectances
rorayl=0.
roaero=0.
romix=0.
rqrayl=0.
rqaero=0.
rqmix=0.
rurayl=999.
ruaero=999.
rumix=999.
c
c 3 possible cases (satellite,plane,ground)
if(palt.gt.0.0)then
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
c -----rayleigh reflectance = rorayl,rprayl
tamol=0.
tamolp=0.
call ospol(iaer_prof,tamol,trmoy,piza,tamolp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolutd,rolutd,rolutd)
if (ipol.ne.1)then
rorayl=xlm1(-mu,1)/xmus
romix=rorayl
do ifi=1,nfi
rorayl_fi(ifi)=(xlphim(ifi)/xmus)
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
if (ipol.ne.0)then
c -> here we define 2 reflectances from Stockes' parameters
c but they don't have any physical interpretations, this is
c just to be coherent with the reflectance rorayl
c -> parameters rorayl2,roaero2,romix2 have been introduced
c to compute the degrees of polarization.
rorayl=xlm1(-mu,1)/xmus
rqrayl=xqm1(-mu,1)/xmus
C WRITE(6,*) "TAURAYL=",trmoy," RORAYL = ",rorayl
rqmix=rqrayl
rurayl=xum1(-mu,1)/xmus
rumix=rurayl
do ifi=1,nfi
rorayl_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
c write(6,*)'ATMREF- rayleigh',rorayl,rqrayl,rurayl
if (iaer.eq.0) then
romix=rorayl
rqmix=rqrayl
rumix=rurayl
roaero=0.0
rqaero=0.0
ruaero=0.0
return
endif
c -----aerosol reflectance = roaero,rpaero
tamol=0.
tamolp=0.
if (ipol.ne.1)then
call os(iaer_prof,tamoy,tamol,pizmoy,tamoyp,tamolp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xlphim,nfi,rolutd)
roaero=(xlm1(-mu,1)/xmus)
endif
if (ipol.ne.0)then
call ospol(iaer_prof,taer,tamol,piza,taerp,tamolp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolutd,rolutd,rolutd)
rqaero=xqm1(-mu,1)/xmus
ruaero=xum1(-mu,1)/xmus
if (ipol.eq.1)roaero=xlm1(-mu,1)/xmus
endif
c write(6,*)'ATMREF - aero', roaero,rqaero,ruaero
c -----rayleigh+aerosol reflectance = romix,rpmix
if (ipol.ne.1)then
call os(iaer_prof,tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xlphim,nfi,rolutd)
romix=(xlm1(-mu,1)/xmus)
do ifi=1,nfi
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
if (ipol.ne.0)then
call ospol(iaer_prof,taer,trmoy,piza,taerp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolut,rolutq,rolutu)
rqmix=xqm1(-mu,1)/xmus
rumix=xum1(-mu,1)/xmus
if (ipol.eq.1)then
romix=xlm1(-mu,1)/xmus
do ifi=1,nfi
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
endif
do i=1,mu
do j=1,41
rolut(i,j)=rolut(i,j)/xmus
rolutq(i,j)=rolutq(i,j)/xmus
rolutu(i,j)=rolutu(i,j)/xmus
enddo
enddo
c write(6,*)'ATMREF - mix',romix,rqmix,rumix
endif
c
return
end
ATMREF-orig.f0000644002107500000270000001004112463730616011441 0ustar jckraps subroutine atmref (iaer,iaer_prof,tamoy,taer,trmoy,pizmoy,piza,
s tamoyp,taerp,trmoyp,palt,phi,xmus,xmuv,phirad,nt,mu,np,rm,gb,rp,
s rorayl,roaero,romix,rqrayl,rqaero,rqmix,rurayl,ruaero,rumix,
a ipol,xlm1,xlm2,rorayl_fi,romix_fi,nfi,
a nfilut,filut,rolut,rolutq,rolutu)
real rolut(mu,41),rolutq(mu,41),rolutu(mu,41),rolutd(mu,41)
real filut(mu,41)
integer nfilut(mu)
integer mu,np,nfi
real rm(-mu:mu),rp(np),gb(-mu:mu)
real tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt
real xlm2(-mu:mu,np)
real xlphim(nfi)
real rorayl_fi(nfi),romix_fi(nfi)
real phi,xmus,xmuv,phirad
real delta,sigma,tamol,tamolp
real rorayl,roaero,romix,rqrayl,rqaero,rqmix
real rurayl,ruaero,rumix
real xlm1(-mu:mu,np),xqm1(-mu:mu,np),xum1(-mu:mu,np)
integer iaer,nt,ipol,iaer_prof
common /sixs_del/ delta,sigma
c
c atmospheric reflectances
rorayl=0.
roaero=0.
romix=0.
rqrayl=0.
rqaero=0.
rqmix=0.
rurayl=999.
ruaero=999.
rumix=999.
c
c 3 possible cases (satellite,plane,ground)
if(palt.gt.0.0)then
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
c -----rayleigh reflectance = rorayl,rprayl
tamol=0.
tamolp=0.
call ospol(iaer_prof,tamol,trmoy,piza,tamolp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolutd,rolutd,rolutd)
if (ipol.ne.1)then
rorayl=xlm1(-mu,1)/xmus
romix=rorayl
do ifi=1,nfi
rorayl_fi(ifi)=(xlphim(ifi)/xmus)
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
if (ipol.ne.0)then
c -> here we define 2 reflectances from Stockes' parameters
c but they don't have any physical interpretations, this is
c just to be coherent with the reflectance rorayl
c -> parameters rorayl2,roaero2,romix2 have been introduced
c to compute the degrees of polarization.
rorayl=xlm1(-mu,1)/xmus
rqrayl=xqm1(-mu,1)/xmus
C WRITE(6,*) "TAURAYL=",trmoy," RORAYL = ",rorayl
rqmix=rqrayl
rurayl=xum1(-mu,1)/xmus
rumix=rurayl
do ifi=1,nfi
rorayl_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
c write(6,*)'ATMREF- rayleigh',rorayl,rqrayl,rurayl
if (iaer.eq.0) then
romix=rorayl
rqmix=rqrayl
rumix=rurayl
roaero=0.0
rqaero=0.0
ruaero=0.0
return
endif
c -----aerosol reflectance = roaero,rpaero
tamol=0.
tamolp=0.
if (ipol.ne.1)then
call os(iaer_prof,tamoy,tamol,pizmoy,tamoyp,tamolp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xlphim,nfi,rolutd)
roaero=(xlm1(-mu,1)/xmus)
endif
if (ipol.ne.0)then
call ospol(iaer_prof,taer,tamol,piza,taerp,tamolp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolutd,rolutd,rolutd)
rqaero=xqm1(-mu,1)/xmus
ruaero=xum1(-mu,1)/xmus
if (ipol.eq.1)roaero=xlm1(-mu,1)/xmus
endif
c write(6,*)'ATMREF - aero', roaero,rqaero,ruaero
c -----rayleigh+aerosol reflectance = romix,rpmix
if (ipol.ne.1)then
call os(iaer_prof,tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xlphim,nfi,rolutd)
romix=(xlm1(-mu,1)/xmus)
do ifi=1,nfi
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
if (ipol.ne.0)then
call ospol(iaer_prof,taer,trmoy,piza,taerp,trmoyp,palt,
s phirad,nt,mu,np,rm,gb,rp,xlm1,xqm1,xum1,xlphim,nfi,
s nfilut,filut,rolut,rolutq,rolutu)
rqmix=xqm1(-mu,1)/xmus
rumix=xum1(-mu,1)/xmus
if (ipol.eq.1)then
romix=xlm1(-mu,1)/xmus
do ifi=1,nfi
romix_fi(ifi)=(xlphim(ifi)/xmus)
enddo
endif
endif
do i=1,mu
do j=1,41
rolut(i,j)=rolut(i,j)/xmus
rolutq(i,j)=rolutq(i,j)/xmus
rolutu(i,j)=rolutu(i,j)/xmus
enddo
enddo
c write(6,*)'ATMREF - mix',romix,rqmix,rumix
endif
c
return
end
AVHRR.f0000644002107500000270000005706412463730616010427 0ustar jckraps subroutine avhrr(iwa)
common /sixs_ffu/ s(1501),wlinf,wlsup
real sr(16,1501),wli(16),wls(16)
real wlinf,wlsup,s
integer iwa,l,i
c
c 1st spectral band of avhrr (noaa 6)
c
data (sr(1,l),l=1,1501,1) /
& 120*0.,
& .0000, .0178, .0355, .0533, .0710, .1655, .2600, .3545,
& .4490, .5215, .5940, .6665, .7390, .7575, .7760, .7945,
& .8130, .8113, .8095, .8078, .8060, .8201, .8343, .8484,
& .8625, .8766, .8908, .9049, .9190, .9291, .9393, .9494,
& .9595, .9696, .9798, .9899, 1.000, .9996, .9992, .9989,
& .9985, .9981, .9977, .9974, .9970, .9596, .9222, .8849,
& .8475, .8101, .7727, .7354, .6980, .6047, .5115, .4182,
& .3250, .2767, .2285, .1802, .1320, .1127, .0935, .0742,
& .0550, .0480, .0410, .0340, .0270, .0235, .0200, .0165,
& .0130, .0115, .0100, .0085, .0070, .0052, .0035, .0017,
& 1301*0./
c
c 2nd spectral band of avhrr (noaa 6)
c
data (sr(2,l),l=1,320)/ 176*0.,
& .0000, .0020, .0040, .0060, .0080, .0710, .1340, .1970,
& .2600, .3492, .4385, .5277, .6170, .6678, .7185, .7693,
& .8200, .8435, .8670, .8905, .9140, .9212, .9285, .9358,
& .9430, .9415, .9400, .9385, .9370, .9520, .9670, .9820,
& .9970, .9977, .9985, .9992, 1.000, .9813, .9625, .9438,
& .9250, .9148, .9045, .8943, .8840, .8751, .8663, .8574,
& .8485, .8396, .8307, .8219, .8130, .8100, .8070, .8040,
& .8010, .7980, .7950, .7920, .7890, .7878, .7865, .7853,
& .7840, .7828, .7815, .7803, .7790, .7751, .7713, .7674,
& .7635, .7596, .7558, .7519, .7480, .7464, .7448, .7431,
& .7415, .7399, .7383, .7366, .7350, .7225, .7100, .6975,
& .6850, .6783, .6715, .6648, .6580, .6515, .6450, .6385,
& .6320, .6270, .6220, .6170, .6120, .6093, .6065, .6038,
& .6010, .5993, .5975, .5958, .5940, .5910, .5880, .5850,
& .5820, .5720, .5620, .5520, .5420, .5243, .5065, .4887,
& .4710, .4402, .4095, .3787, .3480, .3155, .2830, .2505,
& .2180, .1935, .1690, .1445, .1200, .1055, .0910, .0765,
& .0620, .0540, .0460, .0380, .0300, .0257, .0215, .0172/
data (sr(2,l),l=321,1501)/
& .0130, .0112, .0095, .0077, .0060, .0053, .0045, .0038,
& .0030, .0025, .0020, .0015, .0010, .0010, .0010, .0010,
& .0010, .0009, .0007, .0006, .0005, .0004, .0004, .0003,
& .0002, .0002, .0001, .0001, .0000,
&1152*0./
c
c 1st spectral band of avhrr (noaa 7)
c
data (sr(3,l),l=1,1501)/ 100*0.,
a .0000, .0008, .0016, .0024, .0032, .0032, .0031, .0030,
a .0030, .0029, .0029, .0028, .0028, .0027, .0027, .0026,
a .0025, .0031, .0036, .0042, .0047, .0288, .0529, .0769,
a .1010, .1943, .2875, .3808, .4740, .5363, .5985, .6608,
a .7230, .7390, .7550, .7710, .7870, .7838, .7805, .7773,
a .7740, .7788, .7835, .7883, .7930, .8100, .8270, .8440,
a .8610, .8958, .9305, .9653,1.0000, .9860, .9720, .9580,
a .9440, .9435, .9430, .9425, .9420, .9442, .9465, .9487,
a .9510, .9575, .9640, .9705, .9770, .9135, .8500, .7865,
a .7230, .6285, .5340, .4395, .3450, .2955, .2460, .1965,
a .1470, .1280, .1090, .0900, .0710, .0638, .0565, .0493,
a .0420, .0383, .0345, .0307, .0270, .0245, .0220, .0195,
a .0170, .0158, .0145, .0132, .0120, .0114, .0107, .0101,
a .0095, .0096, .0098, .0099, .0100, .0103, .0105, .0108,
a .0110, .0100, .0090, .0080, .0070, .0052, .0035, .0017,
a .0000,
a1280*0./
c
c 2nd spectral band of avhrr (noaa 7)
c
data (sr(4,l),l=1,300)/ 156*0.,
a .0000, .0018, .0035, .0053, .0070, .0068, .0065, .0063,
a .0060, .0058, .0055, .0052, .0050, .0050, .0050, .0050,
a .0050, .0060, .0070, .0080, .0090, .0320, .0550, .0780,
a .1010, .1788, .2565, .3343, .4120, .4922, .5725, .6527,
a .7330, .7765, .8200, .8635, .9070, .9218, .9365, .9513,
a .9660, .9725, .9790, .9855, .9920, .9940, .9960, .9980,
a 1.0000, .9962,.9925, .9887, .9850, .9870, .9890, .9910,
a .9930, .9763, .9595, .9428, .9260, .9298, .9335, .9373,
a .9410, .9373, .9335, .9298, .9260, .9120, .8980, .8840,
a .8700, .8700, .8700, .8700, .8700, .8703, .8705, .8708,
a .8710, .8708, .8705, .8703, .8700, .8715, .8730, .8745,
a .8760, .8740, .8720, .8700, .8680, .8690, .8700, .8710,
a .8720, .8687, .8655, .8623, .8590, .8555, .8520, .8485,
a .8450, .8428, .8405, .8383, .8360, .8328, .8295, .8263,
a .8230, .8145, .8060, .7975, .7890, .7872, .7855, .7838,
a .7820, .7790, .7760, .7730, .7700, .7682, .7665, .7648,
a .7630, .7545, .7460, .7375, .7290, .6987, .6685, .6382,
a .6080, .5623, .5165, .4707, .4250, .3812, .3375, .2937/
data (sr(4,l),l=301,1501)/
a .2500, .2215, .1930, .1645, .1360, .1202, .1045, .0887,
a .0730, .0647, .0565, .0482, .0400, .0357, .0315, .0272,
a .0230, .0207, .0185, .0162, .0140, .0125, .0110, .0095,
a .0080, .0075, .0070, .0065, .0060, .0055, .0050, .0045,
a .0040, .0039, .0038, .0037, .0036, .0036, .0037, .0037,
a .0037, .0035, .0034, .0032, .0031, .0029, .0028, .0026,
a .0025, .0025, .0024, .0024, .0023, .0023, .0022, .0022,
a .0021, .0021, .0021, .0020, .0020, .0019, .0019, .0018,
a .0018, .0013, .0009, .0004, .0000,
a1132*0./
c
c 1st spectral band of avhrr (noaa 8)
c
data (sr(5,l),l=1,260)/ 116*0.,
a .0000, .0012, .0024, .0036, .0048, .0223, .0399, .0574,
a .0749, .1633, .2517, .3400, .4284, .4937, .5590, .6243,
a .6896, .7135, .7375, .7614, .7853, .7833, .7813, .7793,
a .7773, .7774, .7775, .7776, .7777, .7922, .8067, .8211,
a .8356, .8566, .8777, .8987, .9197, .9332, .9468, .9603,
a .9739, .9674, .9609, .9545, .9480, .9507, .9534, .9561,
a .9588, .9691, .9794, .9897,1.0000, .9692, .9385, .9077,
a .8770, .7775, .6779, .5784, .4789, .4108, .3428, .2747,
a .2067, .1782, .1497, .1213, .0928, .0820, .0712, .0604,
a .0496, .0425, .0355, .0284, .0214, .0208, .0202, .0196,
a .0190, .0167, .0145, .0122, .0100, .0095, .0090, .0085,
a .0080, .0083, .0086, .0089, .0092, .0094, .0097, .0100,
a .0103, .0100, .0096, .0093, .0090, .0086, .0083, .0079,
a .0076, .0082, .0087, .0093, .0099, .0104, .0110, .0115,
a .0121, .0114, .0108, .0101, .0094, .0088, .0081, .0075,
a .0068, .0074, .0079, .0085, .0091, .0097, .0102, .0108,
a .0114, .0115, .0115, .0116, .0117, .0118, .0119, .0119,
a .0120, .0136, .0152, .0167, .0183, .0204, .0224, .0245/
data (sr(5,l),l=261,1501)/
a .0265, .0295, .0324, .0354, .0384, .0419, .0453, .0488,
a .0522, .0514, .0507, .0499, .0491, .0467, .0443, .0420,
a .0396, .0348, .0299, .0251, .0203, .0183, .0164, .0144,
a .0125, .0118, .0110, .0103, .0095, .0083, .0071, .0060,
a .0048, .0041, .0035, .0028, .0022, .0022, .0021, .0021,
a .0021, .0016, .0010, .0005, .0000,
a1196*0./
c
c 2nd spectral band of avhrr (noaa 8)
c
data (sr(6,l),l=1,316)/ 172*0.,
a .0000, .0095, .0190, .0285, .0381, .0476, .0571, .0666,
a .0761, .1559, .2358, .3156, .3954, .4855, .5756, .6658,
a .7559, .7966, .8373, .8779, .9186, .9332, .9478, .9624,
a .9770, .9814, .9858, .9902, .9946, .9959, .9973, .9986,
a1.0000, .9965, .9930, .9896, .9861, .9796, .9731, .9666,
a .9601, .9518, .9435, .9351, .9268, .9171, .9073, .8976,
a .8879, .8791, .8703, .8615, .8527, .8439, .8351, .8263,
a .8175, .8140, .8104, .8068, .8033, .7997, .7962, .7926,
a .7891, .7871, .7850, .7830, .7810, .7790, .7769, .7749,
a .7729, .7711, .7694, .7677, .7659, .7642, .7624, .7607,
a .7589, .7558, .7528, .7497, .7466, .7436, .7405, .7375,
a .7344, .7282, .7220, .7158, .7096, .7034, .6972, .6910,
a .6848, .6781, .6713, .6646, .6579, .6511, .6444, .6376,
a .6309, .6265, .6221, .6177, .6133, .6088, .6044, .6000,
a .5956, .5888, .5820, .5752, .5684, .5616, .5548, .5480,
a .5412, .5159, .4906, .4653, .4400, .4147, .3894, .3641,
a .3388, .3061, .2734, .2408, .2081, .1851, .1621, .1392,
a .1162, .1023, .0884, .0745, .0606, .0532, .0458, .0384/
data (sr(6,l),l=317,1501)/
a .0310, .0271, .0231, .0192, .0153, .0134, .0115, .0096,
a .0077, .0071, .0065, .0059, .0053, .0046, .0040, .0034,
a .0028, .0026, .0024, .0023, .0021, .0019, .0017, .0016,
a .0014, .0012, .0010, .0009, .0007, .0005, .0003, .0002,
a .0000, 1152*0./
c
c 1st spectral band of avhrr (noaa 9)
c
data (sr(7,l),l=1,1501)/ 112*0.,
a .0000, .0001, .0003, .0004, .0006, .0040, .0074, .0108,
a .0142, .0622, .1101, .1581, .2060, .2810, .3561, .4311,
a .5061, .5500, .5940, .6379, .6818, .7127, .7437, .7746,
a .8055, .8122, .8190, .8170, .8150, .8063, .7975, .7887,
a .7800, .7881, .7962, .8044, .8125, .8335, .8544, .8753,
a .8963, .9000, .9037, .9074, .9111, .8899, .8688, .8476,
a .8265, .8198, .8130, .8110, .8090, .8277, .8464, .8650,
a .8837, .9128, .9419, .9709,1.0000, .9678, .9356, .9035,
a .8713, .7712, .6711, .5711, .4710, .4067, .3424, .2782,
a .2139, .1849, .1559, .1269, .0979, .0861, .0743, .0625,
a .0507, .0454, .0400, .0347, .0294, .0266, .0238, .0210,
a .0182, .0170, .0157, .0145, .0133, .0124, .0115, .0107,
a .0098, .0092, .0086, .0080, .0074, .0071, .0069, .0066,
a .0063, .0062, .0061, .0061, .0060, .0045, .0030, .0015,
a .0000, 1276*0./
c
c 2nd spectral band of avhrr (noaa 9)
c
data (sr(8,l),l=1,316)/ 172*0.,
a .0000, .0011, .0022, .0033, .0044, .0207, .0369, .0532,
a .0694, .1410, .2127, .2843, .3559, .4388, .5217, .6047,
a .6876, .7304, .7731, .8159, .8586, .8782, .8977, .9173,
a .9369, .9491, .9614, .9736, .9859, .9894, .9930, .9965,
a1.0000, .9956, .9912, .9869, .9825, .9699, .9574, .9448,
a .9323, .9243, .9163, .9083, .9003, .8971, .8939, .8907,
a .8875, .8881, .8887, .8893, .8899, .8931, .8963, .8994,
a .9026, .9046, .9067, .9087, .9108, .9114, .9120, .9126,
a .9132, .9065, .8997, .8930, .8863, .8807, .8750, .8694,
a .8638, .8605, .8571, .8538, .8504, .8532, .8560, .8588,
a .8616, .8644, .8672, .8701, .8729, .8749, .8770, .8790,
a .8811, .8766, .8721, .8677, .8632, .8502, .8372, .8242,
a .8112, .7959, .7806, .7653, .7500, .7423, .7347, .7270,
a .7193, .7166, .7138, .7111, .7084, .7169, .7255, .7340,
a .7425, .7382, .7338, .7295, .7251, .6819, .6387, .5955,
a .5523, .4922, .4321, .3721, .3120, .2722, .2325, .1927,
a .1529, .1336, .1144, .0951, .0759, .0673, .0586, .0500,
a .0414, .0370, .0327, .0283, .0240, .0217, .0195, .0172/
data (sr(8,l),l=317,1501)/
a .0150, .0139, .0128, .0118, .0107, .0099, .0090, .0082,
a .0074, .0070, .0066, .0061, .0057, .0054, .0051, .0049,
a .0046, .0044, .0042, .0041, .0039, .0037, .0036, .0034,
a .0033, .0032, .0031, .0030, .0029, .0028, .0027, .0026,
a .0025, .0025, .0025, .0024, .0024, .0023, .0022, .0021,
a .0020, .0019, .0018, .0018, .0017, .0016, .0015, .0015,
a .0014, .0010, .0007, .0003, .0000, 1132*0./
c
c 1st spectral band of avhrr (noaa 10)
c
data (sr(9,l),l=1,1501)/ 112*0.,
a .0000, .0005, .0010, .0015, .0020, .0023, .0025, .0028,
a .0030, .0239, .0448, .0657, .0866, .1852, .2838, .3824,
a .4810, .5470, .6130, .6790, .7450, .7640, .7830, .8020,
a .8210, .8182, .8154, .8126, .8098, .8219, .8339, .8460,
a .8580, .8808, .9035, .9263, .9490, .9607, .9723, .9840,
a .9956, .9875, .9793, .9712, .9630, .9595, .9560, .9525,
a .9490, .9618, .9745, .9872,1.0000, .9980, .9960, .9940,
a .9920, .9013, .8105, .7197, .6290, .5400, .4510, .3620,
a .2730, .2315, .1900, .1485, .1070, .0935, .0800, .0665,
a .0530, .0468, .0405, .0343, .0280, .0255, .0230, .0205,
a .0180, .0165, .0150, .0135, .0120, .0110, .0100, .0090,
a .0080, .0070, .0061, .0051, .0042, .0034, .0026, .0018,
a .0010, .0007, .0005, .0002,.0000,1288*0./
c
c 2nd spectral band of avhrr (noaa 10)
c
data (sr(10,l),l=1,284)/ 140*0.,
a .0000, .0006, .0012, .0018, .0024, .0030, .0036, .0042,
a .0048, .0049, .0049, .0050, .0051, .0051, .0052, .0052,
a .0053, .0053, .0054, .0054, .0055, .0055, .0056, .0056,
a .0057, .0054, .0050, .0047, .0044, .0041, .0037, .0034,
a .0031, .0031, .0032, .0032, .0033, .0033, .0033, .0034,
a .0034, .0239, .0445, .0650, .0855, .1561, .2267, .2974,
a .3680, .4508, .5335, .6163, .6990, .7430, .7870, .8310,
a .8750, .8918, .9085, .9253, .9420, .9510, .9600, .9690,
a .9780, .9835, .9890, .9945,1.0000, .9933, .9866, .9800,
a .9733, .9661, .9589, .9517, .9445, .9329, .9213, .9096,
a .8980, .8935, .8890, .8845, .8800, .8788, .8775, .8763,
a .8750, .8658, .8565, .8473, .8380, .8415, .8450, .8485,
a .8520, .8508, .8495, .8483, .8470, .8410, .8350, .8290,
a .8230, .8148, .8065, .7983, .7900, .7983, .8065, .8148,
a .8230, .8190, .8150, .8110, .8070, .7990, .7910, .7830,
a .7750, .7712, .7675, .7637, .7600, .7425, .7250, .7075,
a .6900, .6855, .6810, .6765, .6720, .6710, .6700, .6690,
a .6680, .6655, .6630, .6605, .6580, .6455, .6330, .6205/
data (sr(10,l),l=285,1501)/
a .6080, .5993, .5905, .5818, .5730, .5602, .5475, .5347,
a .5220, .4872, .4525, .4177, .3830, .3435, .3040, .2645,
a .2250, .2015, .1780, .1545, .1310, .1155, .1000, .0845,
a .0690, .0613, .0535, .0457, .0380, .0337, .0295, .0252,
a .0210, .0189, .0168, .0147, .0126, .0114, .0102, .0091,
a .0079, .0073, .0067, .0060, .0054, .0051, .0047, .0044,
a .0041, .0040, .0038, .0037, .0036, .0035, .0034, .0033,
a .0032, .0031, .0030, .0030, .0029, .0028, .0027, .0027,
a .0026, .0026, .0025, .0025, .0024, .0023, .0022, .0022,
a .0021, .0020, .0019, .0018, .0017, .0016, .0016, .0015,
a .0015, .0015, .0014, .0014, .0014, .0014, .0014, .0015,
a .0015, .0011, .0008, .0004, .0000, 1124*0./
c
c 1st spectral band of avhrr (noaa 11)
c
data (sr(11,l),l=1,1501)/ 116*0.,
a .0000, .0033, .0065, .0098, .0130, .0500, .0870, .1240,
a .1610, .2385, .3160, .3935, .4710, .5150, .5590, .6030,
a .6470, .6768, .7065, .7363, .7660, .7745, .7830, .7915,
a .8000, .7918, .7835, .7753, .7670, .7747, .7825, .7903,
a .7980, .8215, .8450, .8685, .8920, .8907, .8895, .8882,
a .8870, .8702, .8535, .8367, .8200, .8110, .8020, .7930,
a .7840, .8050, .8260, .8470, .8680, .9010, .9340, .9670,
a1.0000, .9562, .9125, .8687, .8250, .7192, .6135, .5077,
a .4020, .3467, .2915, .2362, .1810, .1568, .1325, .1083,
a .0840, .0735, .0630, .0525, .0420, .0380, .0340, .0300,
a .0260, .0242, .0225, .0207, .0190, .0180, .0170, .0160,
a .0150, .0137, .0125, .0112, .0100, .0087, .0075, .0062,
a .0050, .0052, .0055, .0057, .0060, .0060, .0060, .0060,
a .0060, .0060, .0060, .0060, .0060, .0045, .0030, .0015,
a .0000, 1272*0./
c
c 2nd spectral band of avhrr (noaa 11)
c
data (sr(12,l),l=1,284)/ 140*0.,
a .0000, .0005, .0010, .0015, .0020, .0025, .0030, .0035,
a .0040, .0039, .0037, .0036, .0035, .0034, .0032, .0031,
a .0030, .0029, .0028, .0026, .0025, .0024, .0023, .0021,
a .0020, .0020, .0020, .0020, .0020, .0020, .0020, .0020,
a .0020, .0028, .0035, .0043, .0050, .0173, .0295, .0418,
a .0540, .1150, .1760, .2370, .2980, .3822, .4665, .5507,
a .6350, .6865, .7380, .7895, .8410, .8623, .8835, .9048,
a .9260, .9415, .9570, .9725, .9880, .9910, .9940, .9970,
a1.0000, .9925, .9850, .9775, .9700, .9600, .9500, .9400,
a .9300, .9193, .9085, .8978, .8870, .8770, .8670, .8570,
a .8470, .8478, .8485, .8493, .8500, .8518, .8535, .8553,
a .8570, .8602, .8635, .8668, .8700, .8673, .8645, .8618,
a .8590, .8505, .8420, .8335, .8250, .8183, .8115, .8047,
a .7980, .7983, .7985, .7988, .7990, .7935, .7880, .7825,
a .7770, .7835, .7900, .7965, .8030, .8075, .8120, .8165,
a .8210, .8108, .8005, .7903, .7800, .7767, .7735, .7703,
a .7670, .7473, .7275, .7077, .6880, .6755, .6630, .6505,
a .6380, .6350, .6320, .6290, .6260, .6345, .6430, .6515/
data (sr(12,l),l=285,1501)/
a .6600, .6695, .6790, .6885, .6980, .6790, .6600, .6410,
a .6220, .5645, .5070, .4495, .3920, .3420, .2920, .2420,
a .1920, .1667, .1415, .1162, .0910, .0795, .0680, .0565,
a .0450, .0411, .0372, .0334, .0295, .0256, .0217, .0179,
a .0140, .0129, .0117, .0106, .0095, .0084, .0072, .0061,
a .0050, .0048, .0045, .0043, .0040, .0038, .0035, .0033,
a .0030, .0029, .0027, .0026, .0025, .0024, .0022, .0021,
a .0020, .0017, .0015, .0012, .0010, .0007, .0005, .0002,
a .0000, 1152*0./
c
c 1st spectral band of avhrr (noaa 12)
c
DATA (SR(13,L),L=1,1501)/ 100*0.,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0048, .0135, .0200,
A .0270, .1046, .2094, .3253, .4360, .5286, .6030, .6621,
A .7090, .7464, .7753, .7966, .8110, .8196, .8249, .8301,
A .8380, .8507, .8668, .8837, .8990, .9109, .9198, .9265,
A .9320, .9371, .9419, .9466, .9510, .9552, .9587, .9612,
A .9620, .9610, .9593, .9582, .9590, .9625, .9673, .9715,
A .9730, .9707, .9666, .9635, .9640, .9701, .9799, .9908,
A1.0000, .9805, .9590, .9407, .9180, .8357, .7325, .6205,
A .5120, .4170, .3365, .2692, .2140, .1695, .1343, .1066,
A .0850, .0679, .0546, .0442, .0360, .0294, .0240, .0196,
A .0160, .0130, .0105, .0089, .0080, .0080, .0083, .0085,
A .0080, .0064, .0041, .0018, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0024, .0056, .0087, .0110, .0118, .0117, .0112,
A .0110, .0117, .0130, .0145, .0160, .0171, .0178, .0184,
A .0190, .0197, .0205, .0213, .0220, .0226, .0229, .0228,
A .0220, .0205, .0187, .0170, .0160, .0159, .0160, .0157,
A .0140, .0106, .0063, .0023, .0000, .0001, .0018, .0038,
A .0050, .0044, .0027, .0009, .0000, .0006, .0023, .0040,
A .0050, .0046, .0032, .0015, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000,
A1200*0./
c
c 2nd spectral band of avhrr (noaa 12)
c
DATA (SR(14,L),L=1,1501)/ 160*0.,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0050, .0111, .0162, .0180, .0153, .0097, .0038,
A .0000, .0005, .0060, .0168, .0330, .0555, .0869, .1303,
A .1890, .2643, .3509, .4418, .5300, .6096, .6796, .7403,
A .7920, .8350, .8702, .8988, .9220, .9408, .9559, .9680,
A .9780, .9863, .9929, .9975,1.0000, .0115, .9987, .9958,
A .9920, .9876, .9821, .9748, .9650, .9522, .9370, .9203,
A .9030, .8858, .8694, .8543, .8410, .8299, .8207, .8129,
A .8060, .7997, .7943, .7902, .7880, .7879, .7893, .7916,
A .7940, .7959, .7971, .7972, .7960, .7935, .7900, .7860,
A .7820, .7783, .7747, .7704, .7650, .7582, .7506, .7433,
A .7370, .7326, .7299, .7288, .7290, .7303, .7323, .7350,
A .7380, .7411, .7441, .7468, .7490, .7504, .7510, .7505,
A .7490, .7463, .7421, .7365, .7290, .7197, .7086, .6960,
A .6820, .6670, .6518, .6371, .6240, .6131, .6043, .5973,
A .5920, .5881, .5857, .5849, .5860, .5889, .5929, .5969,
A .6000, .6011, .5986, .5905, .5750, .5508, .5186, .4792,
A .4340, .3842, .3326, .2822, .2360, .1964, .1633, .1357,
A .1130, .0943, .0789, .0664, .0560, .0473, .0400, .0339,
A .0290, .0250, .0217, .0191, .0170, .0152, .0137, .0123,
A .0110, .0098, .0086, .0077, .0070, .0066, .0063, .0059,
A .0050, .0035, .0019, .0005, .0000, .0006, .0019, .0033,
A .0040, .0036, .0025, .0011, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000,
A1152*0./
c
c 1st spectral band of avhrr (noaa 14) -from NOAA/POD Guide
c
DATA (SR(15,L),L=1,1501)/ 100*0.,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0000, .0000, .0000, .0000, .0000, .0000, .0000,
A .0000, .0003, .0007, .0010, .0013, .0152, .0290, .0429,
A .0568, .1226, .1884, .2543, .3201, .3727, .4254, .4780,
A .5306, .5528, .5749, .5971, .6193, .6267, .6342, .6417,
A .6492, .6538, .6583, .6629, .6675, .6734, .6793, .6853,
A .6912, .6948, .6984, .7020, .7056, .7106, .7156, .7206,
A .7256, .7243, .7229, .7216, .7203, .7188, .7174, .7159,
A .7145, .7130, .7116, .7102, .7088, .7154, .7221, .7287,
A .7353, .7292, .7232, .7172, .7111, .6501, .5891, .5281,
A .4671, .4037, .3402, .2768, .2133, .1830, .1527, .1223,
A .0920, .0797, .0675, .0553, .0431, .0406, .0381, .0357,
A .0332, .0279, .0226, .0173, .0120, .0117, .0114, .0110,
A .0107, .0100, .0093, .0086, .0080, .0076, .0072, .0069,
A .0065, .0062, .0059, .0055, .0052, .0051, .0050, .0048,
A .0047, .0048, .0049, .0050, .0051, .0051, .0050, .0050,
A .0050, .0050, .0051, .0052, .0052, .0053, .0054, .0054,
A .0055, .0057, .0059, .0061, .0063, .0068, .0072, .0076,
A .0080, .0084, .0088, .0092, .0096, .0100, .0104, .0108,
A .0113, .0116, .0119, .0122, .0125, .0127, .0128, .0130,
A .0132, .0130, .0128, .0126, .0123, .0120, .0116, .0112,
A .0108, .0104, .0099, .0095, .0090, .0086, .0082, .0078,
A .0074, .0072, .0070, .0067, .0065, .0063, .0060, .0058,
A .0055, .0053, .0050, .0048, .0046, .0044, .0042, .0040,
A .0038, .0036, .0034, .0032, .0030, .0028, .0027, .0025,
A .0023, .0022, .0022, .0021, .0020, .0019, .0018, .0017,
A .0016, .0016, .0015, .0014, .0014, .0013, .0012, .0012,
A .0011, .0011, .0011, .0011, .0011, .0011, .0011, .0011,
A .0011, .0011, .0011, .0011, .0011, .0011, .0011, .0010,
A .0010, .0010, .0010, .0010, .0010, .0010, .0010, .0010,
A .0010,
A1160*0./
c
c 2nd spectral band of avhrr (noaa 14)
c
data (sr(16,l),l=1,1501)/ 168*0.,
a .0000,.0000,.0000,.0000,.0000,.0000,.0022,.0045,
a .0067,.0090,.0107,.0125,.0143,.0160,.0543,.0925,
a .1308,.1690,.2573,.3455,.4338,.5220,.5978,.6735,
a .7492,.8250,.8503,.8755,.9007,.9260,.9362,.9465,
a .9568,.9670,.9737,.9805,.9872,.9940,.9935,.9930,
a .9925,.9920,.9940,.9960,.9980,1.000,.9885,.9770,
a .9655,.9540,.9398,.9255,.9112,.8970,.8855,.8740,
a .8625,.8510,.8400,.8290,.8180,.8070,.8052,.8035,
a .8018,.8000,.8065,.8130,.8195,.8260,.8257,.8255,
a .8253,.8250,.8245,.8240,.8235,.8230,.8230,.8230,
a .8230,.8230,.8210,.8190,.8170,.8150,.8147,.8145,
a .8142,.8140,.8183,.8225,.8267,.8310,.8367,.8425,
a .8482,.8540,.8547,.8555,.8562,.8570,.8510,.8450,
a .8390,.8330,.8170,.8010,.7850,.7690,.7587,.7485,
a .7383,.7280,.7203,.7125,.7048,.6970,.6957,.6945,
a .6932,.6920,.6970,.7020,.7070,.7120,.7035,.6950,
a .6865,.6780,.6370,.5960,.5550,.5140,.4560,.3980,
a .3400,.2820,.2458,.2095,.1732,.1370,.1190,.1010,
a .0830,.0650,.0560,.0470,.0380,.0290,.0250,.0210,
a .0170,.0130,.0095,.0060,.0050,.0040,.0020,.0000,
a .0010,.0020,.0018,.0015,.0012,.0010,.0010,.0010,
a .0010,.0010,.0008,.0005,.0003,.0000,.0000,.0000,
a 1157*0./
wli(1)=0.55
wls(1)=0.75
wli(2)=0.69
wls(2)=1.12
wli(3)=0.5
wls(3)=0.8
wli(4)=0.64
wls(4)=1.17
wli(5)=0.54
wls(5)=1.01
wli(6)=0.68
wls(6)=1.12
wli(7)=0.53
wls(7)=0.81
wli(8)=0.68
wls(8)=1.17
wli(9)=0.53
wls(9)=0.78
wli(10)=0.6
wls(10)=1.19
wli(11)=0.54
wls(11)=0.82
wli(12)=0.6
wls(12)=1.12
wli(13)=0.50
wls(13)=1.0
wli(14)=0.65
wls(14)=1.12
wli(15)=0.50
wls(15)=1.11
wli(16)=0.68
wls(16)=1.10
do 1 i=1,1501
s(i)=sr(iwa,i)
1 continue
wlinf=wli(iwa)
wlsup=wls(iwa)
return
end
BBM.f0000644002107500000270000021022112463730616010127 0ustar jckraps subroutine bbm
c - to vary the number of quadratures
include "paramdef.inc"
integer nquad
common /num_quad/ nquad
real ph,qh,uh
common /sixs_aerbas/ ph(20,nqmax_p),qh(20,nqmax_p),uh(20,nqmax_p)
real phr(20,nqdef_p),qhr(20,nqdef_p),uhr(20,nqdef_p)
c - to vary the number of quadratures
real ex,sc,asy,vi
common /sixs_coef/ ex(4,20),sc(4,20),asy(4,20),vi(4)
real ex_m(20),sc_m(20),asy_m(20)
integer i,j
c Biomass burning model
c Parameters and refractive indices - AERONET measurements
c (see Example_In_1.txt in 'Examples')
c Extinction coefficients are calculated in km-1
c*************** MIE (asy) ******************
data (asy_m(j),j=1,20)/
a 0.709,0.689,0.684,0.671,0.659,0.651,0.639,0.623,0.605,0.586,
a 0.570,0.560,0.534,0.500,0.455,0.493,0.515,0.573,0.619,0.698/
c*************** MIE (ext&sca) ******************
data (ex_m(j),sc_m(j),j=1,20) /
a 0.8254323E-01,0.7805500E-01,0.6873854E-01,0.6486657E-01,
a 0.6574472E-01,0.6199898E-01,0.5858313E-01,0.5513438E-01,
a 0.5299549E-01,0.4977275E-01,0.4958472E-01,0.4650205E-01,
a 0.4491529E-01,0.4202277E-01,0.3959285E-01,0.3691657E-01,
a 0.3440313E-01,0.3194462E-01,0.2972500E-01,0.2746937E-01,
a 0.2632282E-01,0.2421588E-01,0.2437306E-01,0.2235581E-01,
a 0.1990872E-01,0.1810272E-01,0.1504618E-01,0.1349245E-01,
a 0.6794238E-02,0.5778257E-02,0.4662405E-02,0.3859948E-02,
a 0.4203070E-02,0.3459487E-02,0.3449567E-02,0.2823499E-02,
a 0.3032236E-02,0.2492706E-02,0.2203834E-02,0.1881847E-02 /
c************** MIE (phase fun ph) ***************
DATA ((PHR(i,j),j=1,83),i= 1, 1)/
*0.1683E+00,0.1674E+00,0.1655E+00,0.1613E+00,0.1557E+00,
*0.1499E+00,0.1445E+00,0.1400E+00,0.1361E+00,0.1327E+00,
*0.1299E+00,0.1276E+00,0.1257E+00,0.1239E+00,0.1222E+00,
*0.1207E+00,0.1193E+00,0.1180E+00,0.1168E+00,0.1158E+00,
*0.1149E+00,0.1143E+00,0.1140E+00,0.1140E+00,0.1143E+00,
*0.1150E+00,0.1161E+00,0.1177E+00,0.1197E+00,0.1224E+00,
*0.1256E+00,0.1295E+00,0.1340E+00,0.1392E+00,0.1453E+00,
*0.1523E+00,0.1604E+00,0.1696E+00,0.1801E+00,0.1921E+00,
*0.2057E+00,0.2132E+00,0.2212E+00,0.2388E+00,0.2588E+00,
*0.2814E+00,0.3072E+00,0.3366E+00,0.3701E+00,0.4085E+00,
*0.4524E+00,0.5027E+00,0.5606E+00,0.6270E+00,0.7033E+00,
*0.7911E+00,0.8919E+00,0.1008E+01,0.1141E+01,0.1295E+01,
*0.1471E+01,0.1672E+01,0.1903E+01,0.2166E+01,0.2465E+01,
*0.2803E+01,0.3184E+01,0.3610E+01,0.4084E+01,0.4606E+01,
*0.5175E+01,0.5789E+01,0.6442E+01,0.7125E+01,0.7826E+01,
*0.8531E+01,0.9226E+01,0.9899E+01,0.1057E+02,0.1134E+02,
*0.1287E+02,0.2031E+02,0.5392E+02 /
DATA ((PHR(i,j),j=1,83),i= 2, 2)/
*0.1692E+00,0.1683E+00,0.1670E+00,0.1642E+00,0.1600E+00,
*0.1553E+00,0.1506E+00,0.1464E+00,0.1423E+00,0.1384E+00,
*0.1349E+00,0.1318E+00,0.1291E+00,0.1267E+00,0.1247E+00,
*0.1230E+00,0.1216E+00,0.1204E+00,0.1195E+00,0.1188E+00,
*0.1183E+00,0.1182E+00,0.1184E+00,0.1189E+00,0.1198E+00,
*0.1212E+00,0.1230E+00,0.1253E+00,0.1281E+00,0.1315E+00,
*0.1355E+00,0.1403E+00,0.1458E+00,0.1523E+00,0.1596E+00,
*0.1680E+00,0.1776E+00,0.1884E+00,0.2007E+00,0.2146E+00,
*0.2303E+00,0.2390E+00,0.2482E+00,0.2684E+00,0.2914E+00,
*0.3175E+00,0.3472E+00,0.3809E+00,0.4193E+00,0.4629E+00,
*0.5126E+00,0.5690E+00,0.6333E+00,0.7064E+00,0.7897E+00,
*0.8845E+00,0.9924E+00,0.1115E+01,0.1255E+01,0.1413E+01,
*0.1592E+01,0.1794E+01,0.2022E+01,0.2278E+01,0.2564E+01,
*0.2882E+01,0.3234E+01,0.3621E+01,0.4043E+01,0.4500E+01,
*0.4988E+01,0.5505E+01,0.6045E+01,0.6599E+01,0.7160E+01,
*0.7718E+01,0.8265E+01,0.8803E+01,0.9368E+01,0.1012E+02,
*0.1185E+02,0.2001E+02,0.4940E+02 /
DATA ((PHR(i,j),j=1,83),i= 3, 3)/
*0.1705E+00,0.1696E+00,0.1684E+00,0.1659E+00,0.1619E+00,
*0.1573E+00,0.1529E+00,0.1487E+00,0.1446E+00,0.1406E+00,
*0.1370E+00,0.1338E+00,0.1308E+00,0.1283E+00,0.1263E+00,
*0.1245E+00,0.1230E+00,0.1218E+00,0.1208E+00,0.1202E+00,
*0.1198E+00,0.1197E+00,0.1200E+00,0.1206E+00,0.1216E+00,
*0.1231E+00,0.1251E+00,0.1276E+00,0.1306E+00,0.1342E+00,
*0.1384E+00,0.1434E+00,0.1492E+00,0.1558E+00,0.1635E+00,
*0.1722E+00,0.1821E+00,0.1933E+00,0.2061E+00,0.2205E+00,
*0.2368E+00,0.2457E+00,0.2552E+00,0.2761E+00,0.2998E+00,
*0.3268E+00,0.3573E+00,0.3920E+00,0.4314E+00,0.4761E+00,
*0.5269E+00,0.5847E+00,0.6503E+00,0.7249E+00,0.8096E+00,
*0.9058E+00,0.1015E+01,0.1139E+01,0.1279E+01,0.1438E+01,
*0.1617E+01,0.1819E+01,0.2045E+01,0.2298E+01,0.2580E+01,
*0.2893E+01,0.3238E+01,0.3615E+01,0.4025E+01,0.4466E+01,
*0.4937E+01,0.5433E+01,0.5949E+01,0.6477E+01,0.7010E+01,
*0.7540E+01,0.8059E+01,0.8573E+01,0.9124E+01,0.9883E+01,
*0.1167E+02,0.2002E+02,0.4863E+02 /
DATA ((PHR(i,j),j=1,83),i= 4, 4)/
*0.1751E+00,0.1741E+00,0.1731E+00,0.1710E+00,0.1676E+00,
*0.1636E+00,0.1595E+00,0.1556E+00,0.1516E+00,0.1474E+00,
*0.1435E+00,0.1399E+00,0.1367E+00,0.1338E+00,0.1315E+00,
*0.1295E+00,0.1278E+00,0.1265E+00,0.1256E+00,0.1250E+00,
*0.1247E+00,0.1248E+00,0.1253E+00,0.1262E+00,0.1275E+00,
*0.1292E+00,0.1315E+00,0.1344E+00,0.1378E+00,0.1419E+00,
*0.1466E+00,0.1521E+00,0.1585E+00,0.1658E+00,0.1741E+00,
*0.1836E+00,0.1944E+00,0.2067E+00,0.2206E+00,0.2363E+00,
*0.2540E+00,0.2637E+00,0.2741E+00,0.2967E+00,0.3223E+00,
*0.3512E+00,0.3839E+00,0.4208E+00,0.4626E+00,0.5100E+00,
*0.5636E+00,0.6243E+00,0.6930E+00,0.7707E+00,0.8585E+00,
*0.9578E+00,0.1070E+01,0.1196E+01,0.1338E+01,0.1497E+01,
*0.1675E+01,0.1874E+01,0.2095E+01,0.2341E+01,0.2612E+01,
*0.2909E+01,0.3234E+01,0.3587E+01,0.3966E+01,0.4371E+01,
*0.4798E+01,0.5244E+01,0.5705E+01,0.6174E+01,0.6644E+01,
*0.7109E+01,0.7568E+01,0.8033E+01,0.8557E+01,0.9343E+01,
*0.1129E+02,0.2014E+02,0.4703E+02 /
DATA ((PHR(i,j),j=1,83),i= 5, 5)/
*0.1805E+00,0.1795E+00,0.1788E+00,0.1771E+00,0.1739E+00,
*0.1703E+00,0.1666E+00,0.1628E+00,0.1588E+00,0.1548E+00,
*0.1508E+00,0.1468E+00,0.1432E+00,0.1402E+00,0.1377E+00,
*0.1355E+00,0.1338E+00,0.1324E+00,0.1314E+00,0.1308E+00,
*0.1306E+00,0.1307E+00,0.1313E+00,0.1323E+00,0.1338E+00,
*0.1357E+00,0.1382E+00,0.1413E+00,0.1450E+00,0.1494E+00,
*0.1545E+00,0.1605E+00,0.1673E+00,0.1751E+00,0.1840E+00,
*0.1942E+00,0.2058E+00,0.2188E+00,0.2336E+00,0.2504E+00,
*0.2694E+00,0.2797E+00,0.2907E+00,0.3148E+00,0.3419E+00,
*0.3726E+00,0.4071E+00,0.4460E+00,0.4898E+00,0.5392E+00,
*0.5949E+00,0.6577E+00,0.7286E+00,0.8084E+00,0.8981E+00,
*0.9990E+00,0.1112E+01,0.1239E+01,0.1381E+01,0.1539E+01,
*0.1716E+01,0.1911E+01,0.2127E+01,0.2365E+01,0.2626E+01,
*0.2910E+01,0.3218E+01,0.3550E+01,0.3904E+01,0.4280E+01,
*0.4674E+01,0.5082E+01,0.5501E+01,0.5924E+01,0.6349E+01,
*0.6769E+01,0.7187E+01,0.7620E+01,0.8133E+01,0.8960E+01,
*0.1108E+02,0.2037E+02,0.4604E+02 /
DATA ((PHR(i,j),j=1,83),i= 6, 6)/
*0.1851E+00,0.1841E+00,0.1834E+00,0.1818E+00,0.1789E+00,
*0.1755E+00,0.1720E+00,0.1686E+00,0.1648E+00,0.1604E+00,
*0.1561E+00,0.1523E+00,0.1487E+00,0.1455E+00,0.1427E+00,
*0.1405E+00,0.1386E+00,0.1372E+00,0.1362E+00,0.1355E+00,
*0.1353E+00,0.1354E+00,0.1360E+00,0.1371E+00,0.1386E+00,
*0.1406E+00,0.1432E+00,0.1464E+00,0.1503E+00,0.1548E+00,
*0.1601E+00,0.1663E+00,0.1735E+00,0.1817E+00,0.1910E+00,
*0.2016E+00,0.2137E+00,0.2273E+00,0.2428E+00,0.2601E+00,
*0.2797E+00,0.2905E+00,0.3018E+00,0.3269E+00,0.3549E+00,
*0.3865E+00,0.4221E+00,0.4622E+00,0.5073E+00,0.5580E+00,
*0.6151E+00,0.6792E+00,0.7512E+00,0.8320E+00,0.9227E+00,
*0.1024E+01,0.1138E+01,0.1265E+01,0.1406E+01,0.1564E+01,
*0.1738E+01,0.1931E+01,0.2143E+01,0.2376E+01,0.2629E+01,
*0.2905E+01,0.3202E+01,0.3521E+01,0.3860E+01,0.4217E+01,
*0.4590E+01,0.4976E+01,0.5370E+01,0.5768E+01,0.6165E+01,
*0.6559E+01,0.6955E+01,0.7373E+01,0.7886E+01,0.8743E+01,
*0.1097E+02,0.2056E+02,0.4552E+02 /
DATA ((PHR(i,j),j=1,83),i= 7, 7)/
*0.1939E+00,0.1928E+00,0.1920E+00,0.1907E+00,0.1882E+00,
*0.1850E+00,0.1818E+00,0.1786E+00,0.1749E+00,0.1705E+00,
*0.1661E+00,0.1620E+00,0.1582E+00,0.1547E+00,0.1518E+00,
*0.1493E+00,0.1472E+00,0.1456E+00,0.1445E+00,0.1437E+00,
*0.1433E+00,0.1435E+00,0.1440E+00,0.1451E+00,0.1466E+00,
*0.1487E+00,0.1514E+00,0.1548E+00,0.1588E+00,0.1636E+00,
*0.1692E+00,0.1758E+00,0.1833E+00,0.1920E+00,0.2019E+00,
*0.2131E+00,0.2258E+00,0.2403E+00,0.2565E+00,0.2748E+00,
*0.2954E+00,0.3066E+00,0.3186E+00,0.3448E+00,0.3741E+00,
*0.4071E+00,0.4442E+00,0.4858E+00,0.5325E+00,0.5850E+00,
*0.6437E+00,0.7095E+00,0.7830E+00,0.8652E+00,0.9570E+00,
*0.1059E+01,0.1173E+01,0.1300E+01,0.1440E+01,0.1595E+01,
*0.1766E+01,0.1954E+01,0.2159E+01,0.2384E+01,0.2627E+01,
*0.2889E+01,0.3170E+01,0.3470E+01,0.3787E+01,0.4119E+01,
*0.4464E+01,0.4819E+01,0.5180E+01,0.5543E+01,0.5906E+01,
*0.6268E+01,0.6637E+01,0.7039E+01,0.7558E+01,0.8471E+01,
*0.1089E+02,0.2095E+02,0.4501E+02 /
DATA ((PHR(i,j),j=1,83),i= 8, 8)/
*0.2078E+00,0.2067E+00,0.2061E+00,0.2049E+00,0.2025E+00,
*0.1997E+00,0.1970E+00,0.1939E+00,0.1901E+00,0.1858E+00,
*0.1812E+00,0.1766E+00,0.1724E+00,0.1687E+00,0.1653E+00,
*0.1625E+00,0.1603E+00,0.1584E+00,0.1570E+00,0.1560E+00,
*0.1555E+00,0.1555E+00,0.1559E+00,0.1569E+00,0.1585E+00,
*0.1606E+00,0.1634E+00,0.1669E+00,0.1711E+00,0.1762E+00,
*0.1822E+00,0.1891E+00,0.1971E+00,0.2063E+00,0.2168E+00,
*0.2287E+00,0.2421E+00,0.2574E+00,0.2745E+00,0.2939E+00,
*0.3157E+00,0.3275E+00,0.3401E+00,0.3675E+00,0.3984E+00,
*0.4329E+00,0.4716E+00,0.5149E+00,0.5634E+00,0.6175E+00,
*0.6779E+00,0.7452E+00,0.8202E+00,0.9037E+00,0.9962E+00,
*0.1099E+01,0.1212E+01,0.1337E+01,0.1475E+01,0.1627E+01,
*0.1793E+01,0.1974E+01,0.2170E+01,0.2383E+01,0.2613E+01,
*0.2858E+01,0.3120E+01,0.3397E+01,0.3687E+01,0.3990E+01,
*0.4302E+01,0.4622E+01,0.4946E+01,0.5271E+01,0.5597E+01,
*0.5926E+01,0.6268E+01,0.6660E+01,0.7201E+01,0.8211E+01,
*0.1090E+02,0.2158E+02,0.4463E+02 /
DATA ((PHR(i,j),j=1,83),i= 9, 9)/
*0.2255E+00,0.2242E+00,0.2234E+00,0.2225E+00,0.2205E+00,
*0.2180E+00,0.2155E+00,0.2126E+00,0.2089E+00,0.2047E+00,
*0.2000E+00,0.1950E+00,0.1903E+00,0.1863E+00,0.1827E+00,
*0.1796E+00,0.1770E+00,0.1748E+00,0.1731E+00,0.1719E+00,
*0.1713E+00,0.1711E+00,0.1714E+00,0.1723E+00,0.1738E+00,
*0.1760E+00,0.1788E+00,0.1824E+00,0.1868E+00,0.1920E+00,
*0.1982E+00,0.2054E+00,0.2138E+00,0.2234E+00,0.2343E+00,
*0.2468E+00,0.2610E+00,0.2770E+00,0.2951E+00,0.3154E+00,
*0.3384E+00,0.3508E+00,0.3640E+00,0.3927E+00,0.4248E+00,
*0.4608E+00,0.5008E+00,0.5455E+00,0.5954E+00,0.6507E+00,
*0.7122E+00,0.7806E+00,0.8564E+00,0.9403E+00,0.1033E+01,
*0.1135E+01,0.1247E+01,0.1370E+01,0.1505E+01,0.1651E+01,
*0.1811E+01,0.1984E+01,0.2171E+01,0.2371E+01,0.2585E+01,
*0.2813E+01,0.3054E+01,0.3307E+01,0.3571E+01,0.3844E+01,
*0.4125E+01,0.4410E+01,0.4699E+01,0.4989E+01,0.5283E+01,
*0.5584E+01,0.5909E+01,0.6301E+01,0.6881E+01,0.8013E+01,
*0.1103E+02,0.2244E+02,0.4453E+02 /
DATA ((PHR(i,j),j=1,83),i=10,10)/
*0.2466E+00,0.2449E+00,0.2437E+00,0.2430E+00,0.2414E+00,
*0.2392E+00,0.2371E+00,0.2347E+00,0.2312E+00,0.2266E+00,
*0.2215E+00,0.2165E+00,0.2115E+00,0.2070E+00,0.2032E+00,
*0.1998E+00,0.1968E+00,0.1944E+00,0.1925E+00,0.1910E+00,
*0.1901E+00,0.1897E+00,0.1899E+00,0.1906E+00,0.1920E+00,
*0.1940E+00,0.1968E+00,0.2004E+00,0.2047E+00,0.2100E+00,
*0.2162E+00,0.2236E+00,0.2323E+00,0.2422E+00,0.2535E+00,
*0.2665E+00,0.2812E+00,0.2979E+00,0.3167E+00,0.3378E+00,
*0.3615E+00,0.3745E+00,0.3881E+00,0.4178E+00,0.4510E+00,
*0.4879E+00,0.5291E+00,0.5747E+00,0.6254E+00,0.6816E+00,
*0.7438E+00,0.8125E+00,0.8882E+00,0.9715E+00,0.1063E+01,
*0.1164E+01,0.1273E+01,0.1393E+01,0.1523E+01,0.1665E+01,
*0.1817E+01,0.1981E+01,0.2157E+01,0.2345E+01,0.2545E+01,
*0.2756E+01,0.2977E+01,0.3208E+01,0.3447E+01,0.3694E+01,
*0.3946E+01,0.4201E+01,0.4461E+01,0.4723E+01,0.4990E+01,
*0.5273E+01,0.5590E+01,0.5997E+01,0.6635E+01,0.7913E+01,
*0.1130E+02,0.2350E+02,0.4472E+02 /
DATA ((PHR(i,j),j=1,83),i=11,11)/
*0.2671E+00,0.2653E+00,0.2641E+00,0.2633E+00,0.2617E+00,
*0.2600E+00,0.2582E+00,0.2559E+00,0.2523E+00,0.2478E+00,
*0.2426E+00,0.2368E+00,0.2314E+00,0.2267E+00,0.2225E+00,
*0.2187E+00,0.2155E+00,0.2127E+00,0.2105E+00,0.2088E+00,
*0.2076E+00,0.2070E+00,0.2069E+00,0.2074E+00,0.2085E+00,
*0.2104E+00,0.2130E+00,0.2164E+00,0.2207E+00,0.2259E+00,
*0.2323E+00,0.2397E+00,0.2484E+00,0.2584E+00,0.2699E+00,
*0.2832E+00,0.2982E+00,0.3152E+00,0.3343E+00,0.3559E+00,
*0.3803E+00,0.3934E+00,0.4074E+00,0.4375E+00,0.4713E+00,
*0.5089E+00,0.5506E+00,0.5968E+00,0.6480E+00,0.7044E+00,
*0.7665E+00,0.8351E+00,0.9104E+00,0.9930E+00,0.1083E+01,
*0.1182E+01,0.1289E+01,0.1405E+01,0.1531E+01,0.1667E+01,
*0.1813E+01,0.1970E+01,0.2137E+01,0.2314E+01,0.2502E+01,
*0.2699E+01,0.2905E+01,0.3119E+01,0.3340E+01,0.3568E+01,
*0.3800E+01,0.4036E+01,0.4274E+01,0.4517E+01,0.4771E+01,
*0.5044E+01,0.5363E+01,0.5792E+01,0.6492E+01,0.7926E+01,
*0.1167E+02,0.2455E+02,0.4508E+02 /
DATA ((PHR(i,j),j=1,83),i=12,12)/
*0.2816E+00,0.2796E+00,0.2780E+00,0.2772E+00,0.2756E+00,
*0.2739E+00,0.2725E+00,0.2707E+00,0.2672E+00,0.2621E+00,
*0.2563E+00,0.2507E+00,0.2453E+00,0.2402E+00,0.2356E+00,
*0.2316E+00,0.2281E+00,0.2252E+00,0.2228E+00,0.2209E+00,
*0.2195E+00,0.2186E+00,0.2184E+00,0.2187E+00,0.2197E+00,
*0.2214E+00,0.2238E+00,0.2271E+00,0.2313E+00,0.2365E+00,
*0.2427E+00,0.2501E+00,0.2588E+00,0.2689E+00,0.2806E+00,
*0.2939E+00,0.3090E+00,0.3262E+00,0.3456E+00,0.3673E+00,
*0.3916E+00,0.4049E+00,0.4189E+00,0.4495E+00,0.4835E+00,
*0.5212E+00,0.5630E+00,0.6093E+00,0.6605E+00,0.7170E+00,
*0.7792E+00,0.8474E+00,0.9221E+00,0.1004E+01,0.1093E+01,
*0.1190E+01,0.1296E+01,0.1410E+01,0.1533E+01,0.1665E+01,
*0.1807E+01,0.1959E+01,0.2121E+01,0.2292E+01,0.2472E+01,
*0.2661E+01,0.2858E+01,0.3063E+01,0.3274E+01,0.3490E+01,
*0.3710E+01,0.3935E+01,0.4163E+01,0.4397E+01,0.4642E+01,
*0.4911E+01,0.5236E+01,0.5684E+01,0.6430E+01,0.7968E+01,
*0.1193E+02,0.2524E+02,0.4537E+02 /
DATA ((PHR(i,j),j=1,83),i=13,13)/
*0.3231E+00,0.3207E+00,0.3184E+00,0.3176E+00,0.3163E+00,
*0.3151E+00,0.3141E+00,0.3123E+00,0.3087E+00,0.3036E+00,
*0.2975E+00,0.2906E+00,0.2841E+00,0.2783E+00,0.2730E+00,
*0.2683E+00,0.2642E+00,0.2605E+00,0.2573E+00,0.2548E+00,
*0.2528E+00,0.2514E+00,0.2506E+00,0.2503E+00,0.2508E+00,
*0.2520E+00,0.2540E+00,0.2568E+00,0.2606E+00,0.2654E+00,
*0.2714E+00,0.2786E+00,0.2870E+00,0.2969E+00,0.3084E+00,
*0.3217E+00,0.3369E+00,0.3540E+00,0.3734E+00,0.3955E+00,
*0.4202E+00,0.4335E+00,0.4476E+00,0.4782E+00,0.5122E+00,
*0.5501E+00,0.5919E+00,0.6379E+00,0.6887E+00,0.7443E+00,
*0.8051E+00,0.8718E+00,0.9446E+00,0.1024E+01,0.1109E+01,
*0.1202E+01,0.1302E+01,0.1410E+01,0.1525E+01,0.1648E+01,
*0.1780E+01,0.1919E+01,0.2066E+01,0.2221E+01,0.2383E+01,
*0.2552E+01,0.2728E+01,0.2909E+01,0.3095E+01,0.3286E+01,
*0.3482E+01,0.3682E+01,0.3888E+01,0.4104E+01,0.4341E+01,
*0.4615E+01,0.4964E+01,0.5479E+01,0.6374E+01,0.8228E+01,
*0.1288E+02,0.2742E+02,0.4654E+02 /
DATA ((PHR(i,j),j=1,83),i=14,14)/
*0.3870E+00,0.3837E+00,0.3798E+00,0.3785E+00,0.3776E+00,
*0.3769E+00,0.3768E+00,0.3758E+00,0.3723E+00,0.3663E+00,
*0.3589E+00,0.3507E+00,0.3427E+00,0.3354E+00,0.3290E+00,
*0.3230E+00,0.3177E+00,0.3129E+00,0.3088E+00,0.3052E+00,
*0.3023E+00,0.2998E+00,0.2980E+00,0.2968E+00,0.2963E+00,
*0.2965E+00,0.2976E+00,0.2996E+00,0.3025E+00,0.3065E+00,
*0.3115E+00,0.3178E+00,0.3256E+00,0.3348E+00,0.3455E+00,
*0.3581E+00,0.3727E+00,0.3892E+00,0.4080E+00,0.4294E+00,
*0.4534E+00,0.4664E+00,0.4801E+00,0.5098E+00,0.5428E+00,
*0.5794E+00,0.6197E+00,0.6640E+00,0.7126E+00,0.7656E+00,
*0.8233E+00,0.8862E+00,0.9545E+00,0.1028E+01,0.1108E+01,
*0.1193E+01,0.1284E+01,0.1382E+01,0.1486E+01,0.1597E+01,
*0.1714E+01,0.1837E+01,0.1966E+01,0.2101E+01,0.2242E+01,
*0.2389E+01,0.2541E+01,0.2697E+01,0.2858E+01,0.3026E+01,
*0.3198E+01,0.3378E+01,0.3570E+01,0.3781E+01,0.4027E+01,
*0.4334E+01,0.4757E+01,0.5416E+01,0.6585E+01,0.8967E+01,
*0.1466E+02,0.3092E+02,0.4862E+02 /
DATA ((PHR(i,j),j=1,83),i=15,15)/
*0.5767E+00,0.5696E+00,0.5558E+00,0.5478E+00,0.5453E+00,
*0.5476E+00,0.5524E+00,0.5549E+00,0.5511E+00,0.5412E+00,
*0.5276E+00,0.5126E+00,0.4978E+00,0.4835E+00,0.4703E+00,
*0.4585E+00,0.4479E+00,0.4384E+00,0.4298E+00,0.4219E+00,
*0.4148E+00,0.4084E+00,0.4027E+00,0.3977E+00,0.3934E+00,
*0.3898E+00,0.3869E+00,0.3847E+00,0.3836E+00,0.3836E+00,
*0.3847E+00,0.3868E+00,0.3901E+00,0.3948E+00,0.4010E+00,
*0.4088E+00,0.4182E+00,0.4293E+00,0.4424E+00,0.4574E+00,
*0.4746E+00,0.4841E+00,0.4941E+00,0.5163E+00,0.5410E+00,
*0.5683E+00,0.5983E+00,0.6314E+00,0.6677E+00,0.7074E+00,
*0.7504E+00,0.7968E+00,0.8470E+00,0.9011E+00,0.9592E+00,
*0.1022E+01,0.1088E+01,0.1159E+01,0.1235E+01,0.1315E+01,
*0.1401E+01,0.1493E+01,0.1591E+01,0.1695E+01,0.1805E+01,
*0.1924E+01,0.2052E+01,0.2193E+01,0.2347E+01,0.2517E+01,
*0.2711E+01,0.2939E+01,0.3213E+01,0.3558E+01,0.4011E+01,
*0.4642E+01,0.5578E+01,0.7057E+01,0.9572E+01,0.1420E+02,
*0.2351E+02,0.4319E+02,0.5584E+02 /
DATA ((PHR(i,j),j=1,83),i=16,16)/
*0.6058E+00,0.5965E+00,0.5759E+00,0.5625E+00,0.5581E+00,
*0.5613E+00,0.5691E+00,0.5752E+00,0.5735E+00,0.5630E+00,
*0.5468E+00,0.5280E+00,0.5088E+00,0.4906E+00,0.4739E+00,
*0.4587E+00,0.4450E+00,0.4328E+00,0.4217E+00,0.4118E+00,
*0.4028E+00,0.3947E+00,0.3874E+00,0.3809E+00,0.3751E+00,
*0.3701E+00,0.3659E+00,0.3626E+00,0.3600E+00,0.3581E+00,
*0.3571E+00,0.3573E+00,0.3588E+00,0.3613E+00,0.3650E+00,
*0.3699E+00,0.3764E+00,0.3844E+00,0.3941E+00,0.4056E+00,
*0.4188E+00,0.4262E+00,0.4340E+00,0.4511E+00,0.4703E+00,
*0.4919E+00,0.5161E+00,0.5429E+00,0.5723E+00,0.6046E+00,
*0.6402E+00,0.6793E+00,0.7218E+00,0.7679E+00,0.8182E+00,
*0.8729E+00,0.9325E+00,0.9972E+00,0.1068E+01,0.1145E+01,
*0.1229E+01,0.1321E+01,0.1421E+01,0.1532E+01,0.1655E+01,
*0.1793E+01,0.1946E+01,0.2120E+01,0.2319E+01,0.2551E+01,
*0.2826E+01,0.3157E+01,0.3570E+01,0.4099E+01,0.4801E+01,
*0.5770E+01,0.7168E+01,0.9290E+01,0.1269E+02,0.1849E+02,
*0.2901E+02,0.4746E+02,0.5654E+02 /
DATA ((PHR(i,j),j=1,83),i=17,17)/
*0.5984E+00,0.5884E+00,0.5652E+00,0.5490E+00,0.5435E+00,
*0.5469E+00,0.5558E+00,0.5633E+00,0.5622E+00,0.5514E+00,
*0.5345E+00,0.5153E+00,0.4955E+00,0.4763E+00,0.4585E+00,
*0.4423E+00,0.4279E+00,0.4153E+00,0.4039E+00,0.3936E+00,
*0.3843E+00,0.3760E+00,0.3685E+00,0.3618E+00,0.3559E+00,
*0.3507E+00,0.3464E+00,0.3428E+00,0.3400E+00,0.3380E+00,
*0.3369E+00,0.3368E+00,0.3380E+00,0.3401E+00,0.3434E+00,
*0.3479E+00,0.3538E+00,0.3613E+00,0.3703E+00,0.3805E+00,
*0.3924E+00,0.3992E+00,0.4066E+00,0.4229E+00,0.4410E+00,
*0.4610E+00,0.4836E+00,0.5087E+00,0.5365E+00,0.5675E+00,
*0.6019E+00,0.6393E+00,0.6796E+00,0.7239E+00,0.7732E+00,
*0.8273E+00,0.8861E+00,0.9507E+00,0.1022E+01,0.1099E+01,
*0.1185E+01,0.1280E+01,0.1385E+01,0.1503E+01,0.1634E+01,
*0.1781E+01,0.1948E+01,0.2141E+01,0.2363E+01,0.2622E+01,
*0.2930E+01,0.3306E+01,0.3776E+01,0.4376E+01,0.5166E+01,
*0.6249E+01,0.7796E+01,0.1011E+02,0.1375E+02,0.1979E+02,
*0.3037E+02,0.4765E+02,0.5552E+02 /
DATA ((PHR(i,j),j=1,83),i=18,18)/
*0.5521E+00,0.5412E+00,0.5133E+00,0.4918E+00,0.4834E+00,
*0.4875E+00,0.4981E+00,0.5066E+00,0.5068E+00,0.4979E+00,
*0.4819E+00,0.4619E+00,0.4408E+00,0.4205E+00,0.4017E+00,
*0.3850E+00,0.3700E+00,0.3565E+00,0.3446E+00,0.3340E+00,
*0.3247E+00,0.3165E+00,0.3092E+00,0.3028E+00,0.2972E+00,
*0.2924E+00,0.2882E+00,0.2848E+00,0.2823E+00,0.2808E+00,
*0.2802E+00,0.2802E+00,0.2810E+00,0.2829E+00,0.2859E+00,
*0.2900E+00,0.2952E+00,0.3016E+00,0.3094E+00,0.3188E+00,
*0.3297E+00,0.3357E+00,0.3422E+00,0.3563E+00,0.3726E+00,
*0.3911E+00,0.4116E+00,0.4347E+00,0.4604E+00,0.4889E+00,
*0.5204E+00,0.5558E+00,0.5954E+00,0.6394E+00,0.6878E+00,
*0.7415E+00,0.8014E+00,0.8682E+00,0.9427E+00,0.1026E+01,
*0.1120E+01,0.1226E+01,0.1346E+01,0.1481E+01,0.1635E+01,
*0.1812E+01,0.2017E+01,0.2254E+01,0.2532E+01,0.2862E+01,
*0.3259E+01,0.3740E+01,0.4336E+01,0.5092E+01,0.6077E+01,
*0.7396E+01,0.9222E+01,0.1185E+02,0.1580E+02,0.2200E+02,
*0.3206E+02,0.4585E+02,0.5119E+02 /
DATA ((PHR(i,j),j=1,83),i=19,19)/
*0.4886E+00,0.4784E+00,0.4506E+00,0.4279E+00,0.4175E+00,
*0.4200E+00,0.4304E+00,0.4406E+00,0.4431E+00,0.4362E+00,
*0.4217E+00,0.4032E+00,0.3832E+00,0.3637E+00,0.3456E+00,
*0.3292E+00,0.3145E+00,0.3014E+00,0.2899E+00,0.2798E+00,
*0.2710E+00,0.2633E+00,0.2566E+00,0.2508E+00,0.2458E+00,
*0.2417E+00,0.2384E+00,0.2359E+00,0.2341E+00,0.2328E+00,
*0.2323E+00,0.2328E+00,0.2342E+00,0.2365E+00,0.2397E+00,
*0.2439E+00,0.2491E+00,0.2555E+00,0.2632E+00,0.2724E+00,
*0.2830E+00,0.2889E+00,0.2950E+00,0.3086E+00,0.3241E+00,
*0.3419E+00,0.3620E+00,0.3846E+00,0.4097E+00,0.4378E+00,
*0.4692E+00,0.5047E+00,0.5445E+00,0.5889E+00,0.6385E+00,
*0.6944E+00,0.7574E+00,0.8286E+00,0.9090E+00,0.1000E+01,
*0.1104E+01,0.1221E+01,0.1354E+01,0.1507E+01,0.1685E+01,
*0.1890E+01,0.2127E+01,0.2403E+01,0.2728E+01,0.3114E+01,
*0.3576E+01,0.4137E+01,0.4828E+01,0.5695E+01,0.6806E+01,
*0.8262E+01,0.1022E+02,0.1294E+02,0.1687E+02,0.2268E+02,
*0.3153E+02,0.4198E+02,0.4560E+02 /
DATA ((PHR(i,j),j=1,83),i=20,20)/
*0.3196E+00,0.3131E+00,0.2913E+00,0.2692E+00,0.2566E+00,
*0.2541E+00,0.2587E+00,0.2657E+00,0.2696E+00,0.2682E+00,
*0.2616E+00,0.2514E+00,0.2391E+00,0.2264E+00,0.2142E+00,
*0.2028E+00,0.1924E+00,0.1830E+00,0.1748E+00,0.1677E+00,
*0.1617E+00,0.1567E+00,0.1525E+00,0.1493E+00,0.1468E+00,
*0.1451E+00,0.1440E+00,0.1437E+00,0.1440E+00,0.1450E+00,
*0.1467E+00,0.1491E+00,0.1523E+00,0.1563E+00,0.1612E+00,
*0.1670E+00,0.1736E+00,0.1813E+00,0.1901E+00,0.2004E+00,
*0.2122E+00,0.2185E+00,0.2253E+00,0.2400E+00,0.2568E+00,
*0.2760E+00,0.2977E+00,0.3221E+00,0.3497E+00,0.3807E+00,
*0.4157E+00,0.4556E+00,0.5011E+00,0.5527E+00,0.6111E+00,
*0.6777E+00,0.7537E+00,0.8407E+00,0.9406E+00,0.1055E+01,
*0.1187E+01,0.1338E+01,0.1513E+01,0.1715E+01,0.1949E+01,
*0.2220E+01,0.2536E+01,0.2902E+01,0.3330E+01,0.3834E+01,
*0.4426E+01,0.5122E+01,0.5950E+01,0.6939E+01,0.8129E+01,
*0.9575E+01,0.1134E+02,0.1353E+02,0.1628E+02,0.1969E+02,
*0.2341E+02,0.2626E+02,0.2704E+02 /
c************** MIE (phase fun qh) ***************
DATA ((QHR(i,j),j=1,83),i= 1, 1)/
*-0.8147E-22, 0.5946E-03, 0.3607E-02, 0.7821E-02, 0.1280E-01,
* 0.1851E-01, 0.2445E-01, 0.2975E-01, 0.3412E-01, 0.3760E-01,
* 0.3991E-01, 0.4081E-01, 0.4049E-01, 0.3916E-01, 0.3692E-01,
* 0.3406E-01, 0.3081E-01, 0.2727E-01, 0.2361E-01, 0.1993E-01,
* 0.1636E-01, 0.1291E-01, 0.9661E-02, 0.6585E-02, 0.3730E-02,
* 0.1045E-02,-0.1424E-02,-0.3753E-02,-0.5895E-02,-0.7905E-02,
*-0.9782E-02,-0.1153E-01,-0.1324E-01,-0.1486E-01,-0.1649E-01,
*-0.1812E-01,-0.1973E-01,-0.2142E-01,-0.2317E-01,-0.2491E-01,
*-0.2672E-01,-0.2768E-01,-0.2862E-01,-0.3060E-01,-0.3261E-01,
*-0.3468E-01,-0.3687E-01,-0.3921E-01,-0.4172E-01,-0.4438E-01,
*-0.4723E-01,-0.5028E-01,-0.5349E-01,-0.5685E-01,-0.6038E-01,
*-0.6401E-01,-0.6770E-01,-0.7138E-01,-0.7509E-01,-0.7871E-01,
*-0.8211E-01,-0.8523E-01,-0.8791E-01,-0.9009E-01,-0.9154E-01,
*-0.9222E-01,-0.9185E-01,-0.9049E-01,-0.8802E-01,-0.8418E-01,
*-0.7929E-01,-0.7309E-01,-0.6580E-01,-0.5780E-01,-0.4918E-01,
*-0.4018E-01,-0.3185E-01,-0.2399E-01,-0.1621E-01,-0.1136E-01,
*-0.7363E-02, 0.2718E-02, 0.1537E-19 /
DATA ((QHR(i,j),j=1,83),i= 2, 2)/
*-0.3118E-21, 0.4345E-03, 0.2544E-02, 0.5349E-02, 0.8687E-02,
* 0.1250E-01, 0.1638E-01, 0.2011E-01, 0.2351E-01, 0.2636E-01,
* 0.2824E-01, 0.2929E-01, 0.2957E-01, 0.2883E-01, 0.2726E-01,
* 0.2517E-01, 0.2259E-01, 0.1966E-01, 0.1649E-01, 0.1317E-01,
* 0.9745E-02, 0.6321E-02, 0.2919E-02,-0.4226E-03,-0.3710E-02,
*-0.6925E-02,-0.1008E-01,-0.1315E-01,-0.1618E-01,-0.1911E-01,
*-0.2205E-01,-0.2493E-01,-0.2782E-01,-0.3071E-01,-0.3358E-01,
*-0.3650E-01,-0.3945E-01,-0.4242E-01,-0.4549E-01,-0.4867E-01,
*-0.5193E-01,-0.5365E-01,-0.5536E-01,-0.5900E-01,-0.6284E-01,
*-0.6686E-01,-0.7111E-01,-0.7559E-01,-0.8030E-01,-0.8522E-01,
*-0.9036E-01,-0.9562E-01,-0.1010E+00,-0.1065E+00,-0.1121E+00,
*-0.1176E+00,-0.1231E+00,-0.1285E+00,-0.1336E+00,-0.1382E+00,
*-0.1423E+00,-0.1458E+00,-0.1484E+00,-0.1500E+00,-0.1505E+00,
*-0.1496E+00,-0.1473E+00,-0.1433E+00,-0.1377E+00,-0.1303E+00,
*-0.1215E+00,-0.1110E+00,-0.9908E-01,-0.8654E-01,-0.7293E-01,
*-0.5959E-01,-0.4695E-01,-0.3430E-01,-0.2357E-01,-0.1358E-01,
*-0.2723E-02, 0.3655E-02, 0.3156E-19 /
DATA ((QHR(i,j),j=1,83),i= 3, 3)/
* 0.1009E-22, 0.3044E-03, 0.2098E-02, 0.4729E-02, 0.8006E-02,
* 0.1143E-01, 0.1476E-01, 0.1823E-01, 0.2153E-01, 0.2410E-01,
* 0.2588E-01, 0.2696E-01, 0.2721E-01, 0.2650E-01, 0.2509E-01,
* 0.2308E-01, 0.2055E-01, 0.1768E-01, 0.1456E-01, 0.1126E-01,
* 0.7818E-02, 0.4340E-02, 0.8244E-03,-0.2641E-02,-0.6093E-02,
*-0.9479E-02,-0.1283E-01,-0.1609E-01,-0.1933E-01,-0.2250E-01,
*-0.2566E-01,-0.2880E-01,-0.3192E-01,-0.3508E-01,-0.3822E-01,
*-0.4142E-01,-0.4473E-01,-0.4806E-01,-0.5149E-01,-0.5509E-01,
*-0.5882E-01,-0.6073E-01,-0.6269E-01,-0.6675E-01,-0.7103E-01,
*-0.7555E-01,-0.8027E-01,-0.8518E-01,-0.9029E-01,-0.9565E-01,
*-0.1012E+00,-0.1069E+00,-0.1127E+00,-0.1186E+00,-0.1245E+00,
*-0.1304E+00,-0.1362E+00,-0.1418E+00,-0.1471E+00,-0.1518E+00,
*-0.1559E+00,-0.1593E+00,-0.1617E+00,-0.1630E+00,-0.1630E+00,
*-0.1616E+00,-0.1587E+00,-0.1540E+00,-0.1475E+00,-0.1393E+00,
*-0.1294E+00,-0.1179E+00,-0.1053E+00,-0.9168E-01,-0.7731E-01,
*-0.6325E-01,-0.4939E-01,-0.3620E-01,-0.2499E-01,-0.1245E-01,
* 0.1652E-03, 0.6597E-02, 0.3584E-19 /
DATA ((QHR(i,j),j=1,83),i= 4, 4)/
* 0.5571E-22, 0.3220E-03, 0.1983E-02, 0.4020E-02, 0.6318E-02,
* 0.8880E-02, 0.1148E-01, 0.1409E-01, 0.1661E-01, 0.1878E-01,
* 0.2020E-01, 0.2102E-01, 0.2125E-01, 0.2055E-01, 0.1909E-01,
* 0.1715E-01, 0.1470E-01, 0.1186E-01, 0.8715E-02, 0.5332E-02,
* 0.1756E-02,-0.1907E-02,-0.5641E-02,-0.9394E-02,-0.1318E-01,
*-0.1697E-01,-0.2077E-01,-0.2453E-01,-0.2830E-01,-0.3202E-01,
*-0.3577E-01,-0.3952E-01,-0.4332E-01,-0.4720E-01,-0.5113E-01,
*-0.5521E-01,-0.5943E-01,-0.6375E-01,-0.6827E-01,-0.7298E-01,
*-0.7782E-01,-0.8034E-01,-0.8286E-01,-0.8811E-01,-0.9354E-01,
*-0.9913E-01,-0.1049E+00,-0.1109E+00,-0.1170E+00,-0.1234E+00,
*-0.1299E+00,-0.1366E+00,-0.1432E+00,-0.1500E+00,-0.1566E+00,
*-0.1632E+00,-0.1694E+00,-0.1753E+00,-0.1807E+00,-0.1853E+00,
*-0.1891E+00,-0.1919E+00,-0.1936E+00,-0.1938E+00,-0.1926E+00,
*-0.1896E+00,-0.1849E+00,-0.1783E+00,-0.1697E+00,-0.1593E+00,
*-0.1473E+00,-0.1334E+00,-0.1183E+00,-0.1027E+00,-0.8599E-01,
*-0.6991E-01,-0.5469E-01,-0.3963E-01,-0.2695E-01,-0.1460E-01,
*-0.1422E-02, 0.4893E-02, 0.2603E-19 /
DATA ((QHR(i,j),j=1,83),i= 5, 5)/
* 0.2773E-21, 0.7046E-04, 0.1388E-02, 0.3189E-02, 0.5208E-02,
* 0.7015E-02, 0.8798E-02, 0.1093E-01, 0.1294E-01, 0.1446E-01,
* 0.1564E-01, 0.1628E-01, 0.1602E-01, 0.1516E-01, 0.1378E-01,
* 0.1173E-01, 0.9185E-02, 0.6271E-02, 0.3047E-02,-0.4254E-03,
*-0.4089E-02,-0.7920E-02,-0.1189E-01,-0.1592E-01,-0.2003E-01,
*-0.2415E-01,-0.2832E-01,-0.3251E-01,-0.3674E-01,-0.4105E-01,
*-0.4540E-01,-0.4985E-01,-0.5435E-01,-0.5896E-01,-0.6369E-01,
*-0.6853E-01,-0.7357E-01,-0.7879E-01,-0.8415E-01,-0.8976E-01,
*-0.9560E-01,-0.9853E-01,-0.1016E+00,-0.1077E+00,-0.1141E+00,
*-0.1207E+00,-0.1274E+00,-0.1343E+00,-0.1413E+00,-0.1485E+00,
*-0.1557E+00,-0.1629E+00,-0.1702E+00,-0.1774E+00,-0.1844E+00,
*-0.1910E+00,-0.1973E+00,-0.2031E+00,-0.2082E+00,-0.2125E+00,
*-0.2157E+00,-0.2177E+00,-0.2184E+00,-0.2176E+00,-0.2150E+00,
*-0.2107E+00,-0.2044E+00,-0.1961E+00,-0.1858E+00,-0.1737E+00,
*-0.1595E+00,-0.1442E+00,-0.1277E+00,-0.1100E+00,-0.9253E-01,
*-0.7509E-01,-0.5763E-01,-0.4234E-01,-0.2868E-01,-0.1415E-01,
*-0.1035E-02, 0.5729E-02, 0.1868E-20 /
DATA ((QHR(i,j),j=1,83),i= 6, 6)/
* 0.2431E-21, 0.2465E-03, 0.1908E-02, 0.3314E-02, 0.4430E-02,
* 0.5859E-02, 0.7582E-02, 0.9083E-02, 0.1045E-01, 0.1186E-01,
* 0.1278E-01, 0.1308E-01, 0.1288E-01, 0.1194E-01, 0.1026E-01,
* 0.8159E-02, 0.5607E-02, 0.2638E-02,-0.6830E-03,-0.4284E-02,
*-0.8098E-02,-0.1207E-01,-0.1616E-01,-0.2037E-01,-0.2466E-01,
*-0.2907E-01,-0.3354E-01,-0.3811E-01,-0.4275E-01,-0.4745E-01,
*-0.5227E-01,-0.5715E-01,-0.6219E-01,-0.6734E-01,-0.7263E-01,
*-0.7811E-01,-0.8370E-01,-0.8947E-01,-0.9546E-01,-0.1016E+00,
*-0.1079E+00,-0.1112E+00,-0.1144E+00,-0.1212E+00,-0.1282E+00,
*-0.1353E+00,-0.1425E+00,-0.1500E+00,-0.1576E+00,-0.1653E+00,
*-0.1730E+00,-0.1807E+00,-0.1882E+00,-0.1955E+00,-0.2027E+00,
*-0.2094E+00,-0.2156E+00,-0.2211E+00,-0.2259E+00,-0.2296E+00,
*-0.2323E+00,-0.2337E+00,-0.2336E+00,-0.2319E+00,-0.2283E+00,
*-0.2229E+00,-0.2155E+00,-0.2061E+00,-0.1948E+00,-0.1813E+00,
*-0.1665E+00,-0.1500E+00,-0.1321E+00,-0.1140E+00,-0.9509E-01,
*-0.7652E-01,-0.5964E-01,-0.4320E-01,-0.2818E-01,-0.1719E-01,
*-0.6913E-02, 0.3746E-02, 0.1868E-19 /
DATA ((QHR(i,j),j=1,83),i= 7, 7)/
* 0.3840E-22, 0.2406E-03, 0.1633E-02, 0.2793E-02, 0.3662E-02,
* 0.4611E-02, 0.5610E-02, 0.6591E-02, 0.7589E-02, 0.8546E-02,
* 0.8953E-02, 0.8937E-02, 0.8554E-02, 0.7367E-02, 0.5483E-02,
* 0.3214E-02, 0.4783E-03,-0.2668E-02,-0.6167E-02,-0.9972E-02,
*-0.1405E-01,-0.1831E-01,-0.2274E-01,-0.2733E-01,-0.3207E-01,
*-0.3696E-01,-0.4198E-01,-0.4713E-01,-0.5241E-01,-0.5777E-01,
*-0.6330E-01,-0.6893E-01,-0.7474E-01,-0.8069E-01,-0.8678E-01,
*-0.9307E-01,-0.9951E-01,-0.1061E+00,-0.1129E+00,-0.1199E+00,
*-0.1270E+00,-0.1307E+00,-0.1344E+00,-0.1419E+00,-0.1497E+00,
*-0.1575E+00,-0.1656E+00,-0.1737E+00,-0.1820E+00,-0.1902E+00,
*-0.1985E+00,-0.2066E+00,-0.2144E+00,-0.2220E+00,-0.2292E+00,
*-0.2358E+00,-0.2417E+00,-0.2469E+00,-0.2510E+00,-0.2540E+00,
*-0.2557E+00,-0.2560E+00,-0.2546E+00,-0.2514E+00,-0.2464E+00,
*-0.2394E+00,-0.2304E+00,-0.2193E+00,-0.2063E+00,-0.1913E+00,
*-0.1750E+00,-0.1569E+00,-0.1378E+00,-0.1185E+00,-0.9848E-01,
*-0.7936E-01,-0.6174E-01,-0.4421E-01,-0.2929E-01,-0.1589E-01,
*-0.1659E-02, 0.5216E-02, 0.3065E-19 /
DATA ((QHR(i,j),j=1,83),i= 8, 8)/
*-0.7752E-22, 0.1308E-03, 0.1361E-02, 0.2501E-02, 0.2873E-02,
* 0.3129E-02, 0.3561E-02, 0.4080E-02, 0.4391E-02, 0.4637E-02,
* 0.4841E-02, 0.4425E-02, 0.3274E-02, 0.1732E-02,-0.3230E-03,
*-0.2992E-02,-0.6093E-02,-0.9624E-02,-0.1351E-01,-0.1771E-01,
*-0.2218E-01,-0.2695E-01,-0.3194E-01,-0.3720E-01,-0.4261E-01,
*-0.4822E-01,-0.5397E-01,-0.5992E-01,-0.6600E-01,-0.7230E-01,
*-0.7871E-01,-0.8529E-01,-0.9204E-01,-0.9895E-01,-0.1061E+00,
*-0.1133E+00,-0.1207E+00,-0.1284E+00,-0.1362E+00,-0.1442E+00,
*-0.1523E+00,-0.1565E+00,-0.1607E+00,-0.1692E+00,-0.1778E+00,
*-0.1866E+00,-0.1955E+00,-0.2043E+00,-0.2132E+00,-0.2220E+00,
*-0.2305E+00,-0.2389E+00,-0.2470E+00,-0.2545E+00,-0.2615E+00,
*-0.2678E+00,-0.2732E+00,-0.2776E+00,-0.2808E+00,-0.2828E+00,
*-0.2831E+00,-0.2819E+00,-0.2789E+00,-0.2740E+00,-0.2670E+00,
*-0.2581E+00,-0.2469E+00,-0.2337E+00,-0.2188E+00,-0.2020E+00,
*-0.1835E+00,-0.1641E+00,-0.1438E+00,-0.1228E+00,-0.1025E+00,
*-0.8210E-01,-0.6267E-01,-0.4585E-01,-0.2919E-01,-0.1669E-01,
*-0.7899E-02, 0.2972E-02, 0.2956E-19 /
DATA ((QHR(i,j),j=1,83),i= 9, 9)/
*-0.4595E-21,-0.5562E-04, 0.8731E-03, 0.1769E-02, 0.2273E-02,
* 0.2001E-02, 0.1454E-02, 0.1377E-02, 0.1316E-02, 0.8342E-03,
* 0.2139E-03,-0.7326E-03,-0.2437E-02,-0.4614E-02,-0.7176E-02,
*-0.1038E-01,-0.1407E-01,-0.1815E-01,-0.2259E-01,-0.2738E-01,
*-0.3250E-01,-0.3794E-01,-0.4368E-01,-0.4966E-01,-0.5588E-01,
*-0.6229E-01,-0.6892E-01,-0.7572E-01,-0.8272E-01,-0.8994E-01,
*-0.9734E-01,-0.1050E+00,-0.1127E+00,-0.1207E+00,-0.1289E+00,
*-0.1372E+00,-0.1458E+00,-0.1545E+00,-0.1634E+00,-0.1725E+00,
*-0.1818E+00,-0.1865E+00,-0.1912E+00,-0.2006E+00,-0.2101E+00,
*-0.2196E+00,-0.2291E+00,-0.2385E+00,-0.2477E+00,-0.2567E+00,
*-0.2654E+00,-0.2736E+00,-0.2814E+00,-0.2886E+00,-0.2950E+00,
*-0.3005E+00,-0.3050E+00,-0.3083E+00,-0.3102E+00,-0.3107E+00,
*-0.3095E+00,-0.3064E+00,-0.3015E+00,-0.2946E+00,-0.2856E+00,
*-0.2746E+00,-0.2616E+00,-0.2464E+00,-0.2294E+00,-0.2109E+00,
*-0.1905E+00,-0.1696E+00,-0.1483E+00,-0.1261E+00,-0.1049E+00,
*-0.8429E-01,-0.6387E-01,-0.4619E-01,-0.3053E-01,-0.1253E-01,
* 0.3800E-02, 0.9025E-02, 0.4461E-20 /
DATA ((QHR(i,j),j=1,83),i=10,10)/
* 0.5904E-22, 0.1192E-03, 0.1141E-02, 0.1779E-02, 0.1776E-02,
* 0.1026E-02,-0.1717E-03,-0.1086E-02,-0.1850E-02,-0.2917E-02,
*-0.4419E-02,-0.6148E-02,-0.8229E-02,-0.1107E-01,-0.1448E-01,
*-0.1832E-01,-0.2267E-01,-0.2742E-01,-0.3257E-01,-0.3809E-01,
*-0.4399E-01,-0.5018E-01,-0.5669E-01,-0.6344E-01,-0.7049E-01,
*-0.7780E-01,-0.8537E-01,-0.9313E-01,-0.1012E+00,-0.1094E+00,
*-0.1178E+00,-0.1265E+00,-0.1354E+00,-0.1445E+00,-0.1538E+00,
*-0.1632E+00,-0.1729E+00,-0.1827E+00,-0.1927E+00,-0.2028E+00,
*-0.2130E+00,-0.2181E+00,-0.2232E+00,-0.2335E+00,-0.2436E+00,
*-0.2537E+00,-0.2637E+00,-0.2733E+00,-0.2827E+00,-0.2917E+00,
*-0.3003E+00,-0.3082E+00,-0.3153E+00,-0.3218E+00,-0.3272E+00,
*-0.3315E+00,-0.3347E+00,-0.3365E+00,-0.3367E+00,-0.3352E+00,
*-0.3321E+00,-0.3271E+00,-0.3201E+00,-0.3110E+00,-0.3000E+00,
*-0.2867E+00,-0.2718E+00,-0.2549E+00,-0.2361E+00,-0.2160E+00,
*-0.1948E+00,-0.1725E+00,-0.1501E+00,-0.1277E+00,-0.1051E+00,
*-0.8435E-01,-0.6467E-01,-0.4561E-01,-0.2987E-01,-0.1121E-01,
* 0.8263E-02, 0.1151E-01,-0.7992E-22 /
DATA ((QHR(i,j),j=1,83),i=11,11)/
*-0.1272E-21,-0.5941E-04, 0.9194E-03, 0.1652E-02, 0.1544E-02,
* 0.3092E-03,-0.1378E-02,-0.2623E-02,-0.3932E-02,-0.5724E-02,
*-0.7617E-02,-0.9848E-02,-0.1289E-01,-0.1635E-01,-0.2016E-01,
*-0.2464E-01,-0.2962E-01,-0.3499E-01,-0.4076E-01,-0.4689E-01,
*-0.5339E-01,-0.6028E-01,-0.6753E-01,-0.7508E-01,-0.8294E-01,
*-0.9104E-01,-0.9942E-01,-0.1080E+00,-0.1169E+00,-0.1261E+00,
*-0.1354E+00,-0.1451E+00,-0.1549E+00,-0.1649E+00,-0.1750E+00,
*-0.1853E+00,-0.1958E+00,-0.2065E+00,-0.2171E+00,-0.2280E+00,
*-0.2388E+00,-0.2442E+00,-0.2496E+00,-0.2602E+00,-0.2708E+00,
*-0.2813E+00,-0.2915E+00,-0.3013E+00,-0.3106E+00,-0.3194E+00,
*-0.3276E+00,-0.3350E+00,-0.3416E+00,-0.3473E+00,-0.3518E+00,
*-0.3550E+00,-0.3569E+00,-0.3573E+00,-0.3560E+00,-0.3531E+00,
*-0.3483E+00,-0.3414E+00,-0.3327E+00,-0.3220E+00,-0.3092E+00,
*-0.2945E+00,-0.2780E+00,-0.2595E+00,-0.2395E+00,-0.2185E+00,
*-0.1958E+00,-0.1732E+00,-0.1505E+00,-0.1272E+00,-0.1053E+00,
*-0.8424E-01,-0.6322E-01,-0.4538E-01,-0.2927E-01,-0.1030E-01,
* 0.6477E-02, 0.1014E-01, 0.6269E-19 /
DATA ((QHR(i,j),j=1,83),i=12,12)/
* 0.5169E-21, 0.2354E-03, 0.1988E-02, 0.2646E-02, 0.1517E-02,
*-0.3247E-04,-0.1483E-02,-0.3376E-02,-0.5510E-02,-0.7429E-02,
*-0.9547E-02,-0.1226E-01,-0.1545E-01,-0.1921E-01,-0.2365E-01,
*-0.2852E-01,-0.3383E-01,-0.3961E-01,-0.4585E-01,-0.5249E-01,
*-0.5949E-01,-0.6683E-01,-0.7448E-01,-0.8249E-01,-0.9079E-01,
*-0.9942E-01,-0.1083E+00,-0.1176E+00,-0.1270E+00,-0.1368E+00,
*-0.1467E+00,-0.1568E+00,-0.1672E+00,-0.1778E+00,-0.1885E+00,
*-0.1994E+00,-0.2104E+00,-0.2215E+00,-0.2327E+00,-0.2438E+00,
*-0.2548E+00,-0.2604E+00,-0.2659E+00,-0.2769E+00,-0.2877E+00,
*-0.2981E+00,-0.3083E+00,-0.3181E+00,-0.3274E+00,-0.3360E+00,
*-0.3440E+00,-0.3512E+00,-0.3573E+00,-0.3624E+00,-0.3663E+00,
*-0.3689E+00,-0.3700E+00,-0.3694E+00,-0.3672E+00,-0.3632E+00,
*-0.3573E+00,-0.3496E+00,-0.3397E+00,-0.3278E+00,-0.3140E+00,
*-0.2983E+00,-0.2804E+00,-0.2613E+00,-0.2409E+00,-0.2190E+00,
*-0.1967E+00,-0.1735E+00,-0.1498E+00,-0.1269E+00,-0.1043E+00,
*-0.8209E-01,-0.6269E-01,-0.4434E-01,-0.2571E-01,-0.1453E-01,
*-0.6850E-02, 0.6172E-02,-0.1118E-19 /
DATA ((QHR(i,j),j=1,83),i=13,13)/
*-0.6041E-22,-0.6454E-05, 0.1224E-02, 0.2081E-02, 0.1735E-02,
*-0.2100E-03,-0.2898E-02,-0.5197E-02,-0.7650E-02,-0.1075E-01,
*-0.1402E-01,-0.1765E-01,-0.2212E-01,-0.2705E-01,-0.3236E-01,
*-0.3837E-01,-0.4492E-01,-0.5189E-01,-0.5929E-01,-0.6710E-01,
*-0.7532E-01,-0.8398E-01,-0.9306E-01,-0.1025E+00,-0.1122E+00,
*-0.1223E+00,-0.1326E+00,-0.1432E+00,-0.1540E+00,-0.1651E+00,
*-0.1765E+00,-0.1881E+00,-0.1998E+00,-0.2116E+00,-0.2236E+00,
*-0.2356E+00,-0.2477E+00,-0.2598E+00,-0.2718E+00,-0.2839E+00,
*-0.2958E+00,-0.3016E+00,-0.3073E+00,-0.3186E+00,-0.3295E+00,
*-0.3401E+00,-0.3501E+00,-0.3594E+00,-0.3680E+00,-0.3758E+00,
*-0.3826E+00,-0.3883E+00,-0.3931E+00,-0.3966E+00,-0.3985E+00,
*-0.3989E+00,-0.3978E+00,-0.3951E+00,-0.3905E+00,-0.3841E+00,
*-0.3757E+00,-0.3652E+00,-0.3529E+00,-0.3387E+00,-0.3226E+00,
*-0.3048E+00,-0.2856E+00,-0.2646E+00,-0.2424E+00,-0.2195E+00,
*-0.1954E+00,-0.1718E+00,-0.1486E+00,-0.1250E+00,-0.1030E+00,
*-0.8201E-01,-0.6086E-01,-0.4285E-01,-0.2673E-01,-0.6035E-02,
* 0.1241E-01, 0.1335E-01,-0.1961E-19 /
DATA ((QHR(i,j),j=1,83),i=14,14)/
* 0.8122E-21, 0.2142E-03, 0.1986E-02, 0.3241E-02, 0.2991E-02,
* 0.6496E-03,-0.2916E-02,-0.6280E-02,-0.9845E-02,-0.1423E-01,
*-0.1907E-01,-0.2422E-01,-0.3002E-01,-0.3654E-01,-0.4356E-01,
*-0.5120E-01,-0.5944E-01,-0.6812E-01,-0.7724E-01,-0.8682E-01,
*-0.9686E-01,-0.1073E+00,-0.1182E+00,-0.1293E+00,-0.1409E+00,
*-0.1527E+00,-0.1649E+00,-0.1772E+00,-0.1898E+00,-0.2026E+00,
*-0.2156E+00,-0.2288E+00,-0.2420E+00,-0.2553E+00,-0.2685E+00,
*-0.2817E+00,-0.2949E+00,-0.3079E+00,-0.3206E+00,-0.3331E+00,
*-0.3453E+00,-0.3512E+00,-0.3570E+00,-0.3680E+00,-0.3785E+00,
*-0.3884E+00,-0.3974E+00,-0.4054E+00,-0.4125E+00,-0.4185E+00,
*-0.4233E+00,-0.4267E+00,-0.4288E+00,-0.4294E+00,-0.4284E+00,
*-0.4257E+00,-0.4213E+00,-0.4153E+00,-0.4072E+00,-0.3973E+00,
*-0.3857E+00,-0.3721E+00,-0.3568E+00,-0.3399E+00,-0.3214E+00,
*-0.3013E+00,-0.2805E+00,-0.2583E+00,-0.2349E+00,-0.2114E+00,
*-0.1874E+00,-0.1638E+00,-0.1411E+00,-0.1184E+00,-0.9632E-01,
*-0.7641E-01,-0.5653E-01,-0.3796E-01,-0.2227E-01, 0.9910E-03,
* 0.2337E-01, 0.1932E-01,-0.4703E-19 /
DATA ((QHR(i,j),j=1,83),i=15,15)/
*-0.5817E-22, 0.1590E-02, 0.8542E-02, 0.1513E-01, 0.1713E-01,
* 0.1588E-01, 0.1285E-01, 0.7918E-02, 0.1257E-02,-0.6339E-02,
*-0.1460E-01,-0.2374E-01,-0.3360E-01,-0.4386E-01,-0.5467E-01,
*-0.6603E-01,-0.7775E-01,-0.8984E-01,-0.1023E+00,-0.1150E+00,
*-0.1281E+00,-0.1415E+00,-0.1551E+00,-0.1689E+00,-0.1828E+00,
*-0.1969E+00,-0.2110E+00,-0.2253E+00,-0.2397E+00,-0.2540E+00,
*-0.2681E+00,-0.2819E+00,-0.2954E+00,-0.3087E+00,-0.3217E+00,
*-0.3341E+00,-0.3459E+00,-0.3572E+00,-0.3677E+00,-0.3774E+00,
*-0.3862E+00,-0.3903E+00,-0.3941E+00,-0.4010E+00,-0.4069E+00,
*-0.4116E+00,-0.4151E+00,-0.4173E+00,-0.4181E+00,-0.4173E+00,
*-0.4152E+00,-0.4119E+00,-0.4070E+00,-0.4004E+00,-0.3924E+00,
*-0.3831E+00,-0.3721E+00,-0.3595E+00,-0.3460E+00,-0.3313E+00,
*-0.3152E+00,-0.2982E+00,-0.2804E+00,-0.2616E+00,-0.2422E+00,
*-0.2225E+00,-0.2020E+00,-0.1821E+00,-0.1631E+00,-0.1440E+00,
*-0.1252E+00,-0.1069E+00,-0.8852E-01,-0.7094E-01,-0.5451E-01,
*-0.3645E-01,-0.2061E-01,-0.6627E-02, 0.1133E-01, 0.1676E-01,
* 0.9972E-02, 0.9494E-02,-0.9754E-20 /
DATA ((QHR(i,j),j=1,83),i=16,16)/
*-0.8368E-21, 0.2451E-02, 0.1217E-01, 0.2345E-01, 0.3160E-01,
* 0.3488E-01, 0.3414E-01, 0.3068E-01, 0.2450E-01, 0.1602E-01,
* 0.6106E-02,-0.4311E-02,-0.1489E-01,-0.2598E-01,-0.3733E-01,
*-0.4870E-01,-0.6023E-01,-0.7193E-01,-0.8376E-01,-0.9570E-01,
*-0.1077E+00,-0.1197E+00,-0.1318E+00,-0.1438E+00,-0.1560E+00,
*-0.1683E+00,-0.1804E+00,-0.1922E+00,-0.2038E+00,-0.2152E+00,
*-0.2265E+00,-0.2375E+00,-0.2482E+00,-0.2584E+00,-0.2679E+00,
*-0.2770E+00,-0.2856E+00,-0.2934E+00,-0.3005E+00,-0.3068E+00,
*-0.3124E+00,-0.3148E+00,-0.3171E+00,-0.3206E+00,-0.3230E+00,
*-0.3243E+00,-0.3246E+00,-0.3237E+00,-0.3218E+00,-0.3189E+00,
*-0.3147E+00,-0.3092E+00,-0.3024E+00,-0.2946E+00,-0.2857E+00,
*-0.2758E+00,-0.2651E+00,-0.2534E+00,-0.2406E+00,-0.2269E+00,
*-0.2130E+00,-0.1985E+00,-0.1835E+00,-0.1682E+00,-0.1530E+00,
*-0.1376E+00,-0.1230E+00,-0.1083E+00,-0.9318E-01,-0.7926E-01,
*-0.6647E-01,-0.5371E-01,-0.4195E-01,-0.3037E-01,-0.1726E-01,
*-0.6639E-02, 0.4547E-02, 0.1789E-01, 0.2700E-01, 0.4220E-01,
* 0.5411E-01, 0.2476E-01,-0.1620E-18 /
DATA ((QHR(i,j),j=1,83),i=17,17)/
* 0.3184E-21, 0.3036E-02, 0.1478E-01, 0.2822E-01, 0.3771E-01,
* 0.4233E-01, 0.4290E-01, 0.3975E-01, 0.3343E-01, 0.2506E-01,
* 0.1513E-01, 0.4611E-02,-0.5905E-02,-0.1695E-01,-0.2829E-01,
*-0.3936E-01,-0.5042E-01,-0.6161E-01,-0.7293E-01,-0.8427E-01,
*-0.9552E-01,-0.1066E+00,-0.1176E+00,-0.1286E+00,-0.1396E+00,
*-0.1506E+00,-0.1615E+00,-0.1723E+00,-0.1828E+00,-0.1930E+00,
*-0.2030E+00,-0.2127E+00,-0.2220E+00,-0.2308E+00,-0.2393E+00,
*-0.2473E+00,-0.2547E+00,-0.2613E+00,-0.2671E+00,-0.2721E+00,
*-0.2764E+00,-0.2783E+00,-0.2801E+00,-0.2830E+00,-0.2845E+00,
*-0.2848E+00,-0.2842E+00,-0.2829E+00,-0.2807E+00,-0.2775E+00,
*-0.2732E+00,-0.2676E+00,-0.2606E+00,-0.2527E+00,-0.2444E+00,
*-0.2351E+00,-0.2249E+00,-0.2138E+00,-0.2017E+00,-0.1889E+00,
*-0.1762E+00,-0.1633E+00,-0.1496E+00,-0.1354E+00,-0.1215E+00,
*-0.1076E+00,-0.9400E-01,-0.8107E-01,-0.6851E-01,-0.5633E-01,
*-0.4594E-01,-0.3472E-01,-0.2335E-01,-0.1346E-01,-0.1714E-02,
* 0.8967E-02, 0.1804E-01, 0.3055E-01, 0.3960E-01, 0.4239E-01,
* 0.4046E-01, 0.1701E-01,-0.8898E-19 /
DATA ((QHR(i,j),j=1,83),i=18,18)/
*-0.2087E-21, 0.3408E-02, 0.1699E-01, 0.3431E-01, 0.4812E-01,
* 0.5671E-01, 0.6062E-01, 0.6023E-01, 0.5559E-01, 0.4753E-01,
* 0.3769E-01, 0.2687E-01, 0.1572E-01, 0.5064E-02,-0.5211E-02,
*-0.1539E-01,-0.2524E-01,-0.3472E-01,-0.4388E-01,-0.5283E-01,
*-0.6171E-01,-0.7056E-01,-0.7935E-01,-0.8798E-01,-0.9634E-01,
*-0.1044E+00,-0.1124E+00,-0.1202E+00,-0.1279E+00,-0.1354E+00,
*-0.1425E+00,-0.1491E+00,-0.1554E+00,-0.1613E+00,-0.1669E+00,
*-0.1719E+00,-0.1764E+00,-0.1805E+00,-0.1841E+00,-0.1871E+00,
*-0.1893E+00,-0.1901E+00,-0.1907E+00,-0.1915E+00,-0.1917E+00,
*-0.1915E+00,-0.1903E+00,-0.1882E+00,-0.1851E+00,-0.1812E+00,
*-0.1766E+00,-0.1716E+00,-0.1661E+00,-0.1597E+00,-0.1524E+00,
*-0.1444E+00,-0.1358E+00,-0.1266E+00,-0.1175E+00,-0.1082E+00,
*-0.9801E-01,-0.8756E-01,-0.7742E-01,-0.6735E-01,-0.5708E-01,
*-0.4707E-01,-0.3691E-01,-0.2738E-01,-0.1892E-01,-0.1086E-01,
*-0.2282E-02, 0.5347E-02, 0.1293E-01, 0.2113E-01, 0.2784E-01,
* 0.3647E-01, 0.4476E-01, 0.4847E-01, 0.5261E-01, 0.4889E-01,
* 0.3218E-01, 0.9915E-02,-0.4202E-19 /
DATA ((QHR(i,j),j=1,83),i=19,19)/
*-0.6358E-21, 0.3636E-02, 0.1758E-01, 0.3632E-01, 0.5343E-01,
* 0.6552E-01, 0.7210E-01, 0.7368E-01, 0.7029E-01, 0.6307E-01,
* 0.5370E-01, 0.4334E-01, 0.3290E-01, 0.2278E-01, 0.1310E-01,
* 0.3942E-02,-0.4736E-02,-0.1301E-01,-0.2087E-01,-0.2836E-01,
*-0.3556E-01,-0.4250E-01,-0.4924E-01,-0.5578E-01,-0.6216E-01,
*-0.6839E-01,-0.7430E-01,-0.7982E-01,-0.8505E-01,-0.9008E-01,
*-0.9496E-01,-0.9971E-01,-0.1042E+00,-0.1083E+00,-0.1119E+00,
*-0.1151E+00,-0.1180E+00,-0.1205E+00,-0.1226E+00,-0.1242E+00,
*-0.1254E+00,-0.1258E+00,-0.1261E+00,-0.1261E+00,-0.1256E+00,
*-0.1246E+00,-0.1230E+00,-0.1208E+00,-0.1182E+00,-0.1150E+00,
*-0.1112E+00,-0.1068E+00,-0.1017E+00,-0.9625E-01,-0.9017E-01,
*-0.8368E-01,-0.7706E-01,-0.7029E-01,-0.6295E-01,-0.5528E-01,
*-0.4748E-01,-0.3938E-01,-0.3115E-01,-0.2323E-01,-0.1557E-01,
*-0.8146E-02,-0.1446E-02, 0.5530E-02, 0.1275E-01, 0.1925E-01,
* 0.2510E-01, 0.3026E-01, 0.3444E-01, 0.3918E-01, 0.4471E-01,
* 0.4838E-01, 0.5222E-01, 0.5531E-01, 0.5415E-01, 0.5576E-01,
* 0.5041E-01, 0.1669E-01, 0.3465E-20 /
DATA ((QHR(i,j),j=1,83),i=20,20)/
*-0.3486E-21, 0.3063E-02, 0.1500E-01, 0.3242E-01, 0.5059E-01,
* 0.6610E-01, 0.7719E-01, 0.8298E-01, 0.8364E-01, 0.8023E-01,
* 0.7407E-01, 0.6634E-01, 0.5814E-01, 0.5015E-01, 0.4263E-01,
* 0.3570E-01, 0.2941E-01, 0.2374E-01, 0.1866E-01, 0.1405E-01,
* 0.9811E-02, 0.5898E-02, 0.2301E-02,-0.9949E-03,-0.4003E-02,
*-0.6763E-02,-0.9293E-02,-0.1160E-01,-0.1372E-01,-0.1571E-01,
*-0.1757E-01,-0.1933E-01,-0.2098E-01,-0.2245E-01,-0.2371E-01,
*-0.2484E-01,-0.2586E-01,-0.2679E-01,-0.2761E-01,-0.2828E-01,
*-0.2875E-01,-0.2888E-01,-0.2893E-01,-0.2891E-01,-0.2886E-01,
*-0.2874E-01,-0.2838E-01,-0.2775E-01,-0.2689E-01,-0.2574E-01,
*-0.2438E-01,-0.2294E-01,-0.2136E-01,-0.1946E-01,-0.1716E-01,
*-0.1456E-01,-0.1179E-01,-0.8944E-02,-0.6030E-02,-0.2850E-02,
* 0.8254E-03, 0.4851E-02, 0.8910E-02, 0.1301E-01, 0.1724E-01,
* 0.2144E-01, 0.2570E-01, 0.3033E-01, 0.3518E-01, 0.3978E-01,
* 0.4412E-01, 0.4825E-01, 0.5177E-01, 0.5460E-01, 0.5699E-01,
* 0.5823E-01, 0.5715E-01, 0.5342E-01, 0.4631E-01, 0.3401E-01,
* 0.1763E-01, 0.3855E-02,-0.5923E-19 /
c************** MIE (phase fun uh) ***************
DATA ((UHR(i,j),j=1,83),i= 1, 1)/
*-0.1683E+00,-0.1666E+00,-0.1609E+00,-0.1545E+00,-0.1475E+00,
*-0.1394E+00,-0.1299E+00,-0.1192E+00,-0.1076E+00,-0.9540E-01,
*-0.8296E-01,-0.7076E-01,-0.5893E-01,-0.4759E-01,-0.3696E-01,
*-0.2719E-01,-0.1822E-01,-0.1004E-01,-0.2599E-02, 0.4191E-02,
* 0.1039E-01, 0.1609E-01, 0.2137E-01, 0.2633E-01, 0.3106E-01,
* 0.3567E-01, 0.4023E-01, 0.4484E-01, 0.4953E-01, 0.5441E-01,
* 0.5956E-01, 0.6502E-01, 0.7091E-01, 0.7728E-01, 0.8429E-01,
* 0.9207E-01, 0.1007E+00, 0.1103E+00, 0.1212E+00, 0.1333E+00,
* 0.1470E+00, 0.1545E+00, 0.1624E+00, 0.1798E+00, 0.1994E+00,
* 0.2216E+00, 0.2470E+00, 0.2758E+00, 0.3088E+00, 0.3467E+00,
* 0.3902E+00, 0.4401E+00, 0.4976E+00, 0.5638E+00, 0.6399E+00,
* 0.7277E+00, 0.8287E+00, 0.9452E+00, 0.1079E+01, 0.1234E+01,
* 0.1411E+01, 0.1614E+01, 0.1847E+01, 0.2113E+01, 0.2414E+01,
* 0.2756E+01, 0.3141E+01, 0.3571E+01, 0.4049E+01, 0.4575E+01,
* 0.5149E+01, 0.5768E+01, 0.6424E+01, 0.7111E+01, 0.7816E+01,
* 0.8524E+01, 0.9220E+01, 0.9895E+01, 0.1056E+02, 0.1134E+02,
* 0.1287E+02, 0.2031E+02, 0.5392E+02 /
DATA ((UHR(i,j),j=1,83),i= 2, 2)/
*-0.1692E+00,-0.1675E+00,-0.1617E+00,-0.1561E+00,-0.1509E+00,
*-0.1451E+00,-0.1383E+00,-0.1303E+00,-0.1215E+00,-0.1119E+00,
*-0.1019E+00,-0.9168E-01,-0.8136E-01,-0.7113E-01,-0.6131E-01,
*-0.5187E-01,-0.4284E-01,-0.3436E-01,-0.2636E-01,-0.1881E-01,
*-0.1167E-01,-0.4909E-02, 0.1533E-02, 0.7717E-02, 0.1373E-01,
* 0.1963E-01, 0.2550E-01, 0.3138E-01, 0.3742E-01, 0.4363E-01,
* 0.5018E-01, 0.5710E-01, 0.6449E-01, 0.7247E-01, 0.8112E-01,
* 0.9063E-01, 0.1011E+00, 0.1126E+00, 0.1254E+00, 0.1398E+00,
* 0.1558E+00, 0.1646E+00, 0.1739E+00, 0.1944E+00, 0.2176E+00,
* 0.2438E+00, 0.2737E+00, 0.3075E+00, 0.3461E+00, 0.3899E+00,
* 0.4399E+00, 0.4967E+00, 0.5615E+00, 0.6352E+00, 0.7194E+00,
* 0.8153E+00, 0.9245E+00, 0.1049E+01, 0.1190E+01, 0.1351E+01,
* 0.1532E+01, 0.1737E+01, 0.1968E+01, 0.2228E+01, 0.2518E+01,
* 0.2840E+01, 0.3196E+01, 0.3587E+01, 0.4014E+01, 0.4475E+01,
* 0.4967E+01, 0.5488E+01, 0.6031E+01, 0.6589E+01, 0.7152E+01,
* 0.7712E+01, 0.8260E+01, 0.8799E+01, 0.9365E+01, 0.1012E+02,
* 0.1185E+02, 0.2001E+02, 0.4940E+02 /
DATA ((UHR(i,j),j=1,83),i= 3, 3)/
*-0.1705E+00,-0.1687E+00,-0.1628E+00,-0.1573E+00,-0.1524E+00,
*-0.1469E+00,-0.1406E+00,-0.1332E+00,-0.1248E+00,-0.1159E+00,
*-0.1064E+00,-0.9649E-01,-0.8643E-01,-0.7656E-01,-0.6697E-01,
*-0.5761E-01,-0.4865E-01,-0.4014E-01,-0.3205E-01,-0.2439E-01,
*-0.1710E-01,-0.1016E-01,-0.3480E-02, 0.2951E-02, 0.9236E-02,
* 0.1540E-01, 0.2154E-01, 0.2771E-01, 0.3404E-01, 0.4057E-01,
* 0.4741E-01, 0.5465E-01, 0.6238E-01, 0.7075E-01, 0.7981E-01,
* 0.8974E-01, 0.1007E+00, 0.1127E+00, 0.1261E+00, 0.1412E+00,
* 0.1579E+00, 0.1671E+00, 0.1768E+00, 0.1980E+00, 0.2221E+00,
* 0.2494E+00, 0.2802E+00, 0.3152E+00, 0.3550E+00, 0.4001E+00,
* 0.4514E+00, 0.5098E+00, 0.5763E+00, 0.6517E+00, 0.7376E+00,
* 0.8352E+00, 0.9461E+00, 0.1072E+01, 0.1214E+01, 0.1376E+01,
* 0.1557E+01, 0.1762E+01, 0.1992E+01, 0.2249E+01, 0.2535E+01,
* 0.2852E+01, 0.3200E+01, 0.3582E+01, 0.3996E+01, 0.4442E+01,
* 0.4916E+01, 0.5416E+01, 0.5936E+01, 0.6467E+01, 0.7003E+01,
* 0.7534E+01, 0.8054E+01, 0.8569E+01, 0.9120E+01, 0.9879E+01,
* 0.1166E+02, 0.2002E+02, 0.4863E+02 /
DATA ((UHR(i,j),j=1,83),i= 4, 4)/
*-0.1751E+00,-0.1732E+00,-0.1670E+00,-0.1615E+00,-0.1570E+00,
*-0.1524E+00,-0.1472E+00,-0.1409E+00,-0.1338E+00,-0.1258E+00,
*-0.1174E+00,-0.1086E+00,-0.9941E-01,-0.9014E-01,-0.8106E-01,
*-0.7211E-01,-0.6334E-01,-0.5492E-01,-0.4679E-01,-0.3893E-01,
*-0.3135E-01,-0.2403E-01,-0.1693E-01,-0.9997E-02,-0.3159E-02,
* 0.3634E-02, 0.1045E-01, 0.1733E-01, 0.2443E-01, 0.3174E-01,
* 0.3944E-01, 0.4756E-01, 0.5622E-01, 0.6557E-01, 0.7570E-01,
* 0.8684E-01, 0.9909E-01, 0.1126E+00, 0.1277E+00, 0.1445E+00,
* 0.1632E+00, 0.1733E+00, 0.1841E+00, 0.2076E+00, 0.2340E+00,
* 0.2637E+00, 0.2972E+00, 0.3350E+00, 0.3777E+00, 0.4261E+00,
* 0.4808E+00, 0.5428E+00, 0.6130E+00, 0.6924E+00, 0.7821E+00,
* 0.8834E+00, 0.9977E+00, 0.1126E+01, 0.1271E+01, 0.1433E+01,
* 0.1615E+01, 0.1817E+01, 0.2043E+01, 0.2292E+01, 0.2568E+01,
* 0.2870E+01, 0.3199E+01, 0.3556E+01, 0.3939E+01, 0.4348E+01,
* 0.4780E+01, 0.5230E+01, 0.5693E+01, 0.6165E+01, 0.6636E+01,
* 0.7103E+01, 0.7563E+01, 0.8029E+01, 0.8553E+01, 0.9339E+01,
* 0.1129E+02, 0.2013E+02, 0.4703E+02 /
DATA ((UHR(i,j),j=1,83),i= 5, 5)/
*-0.1805E+00,-0.1785E+00,-0.1720E+00,-0.1662E+00,-0.1618E+00,
*-0.1579E+00,-0.1535E+00,-0.1481E+00,-0.1417E+00,-0.1349E+00,
*-0.1274E+00,-0.1191E+00,-0.1106E+00,-0.1021E+00,-0.9344E-01,
*-0.8482E-01,-0.7640E-01,-0.6808E-01,-0.5996E-01,-0.5207E-01,
*-0.4438E-01,-0.3685E-01,-0.2944E-01,-0.2211E-01,-0.1483E-01,
*-0.7576E-02,-0.2282E-03, 0.7266E-02, 0.1500E-01, 0.2306E-01,
* 0.3148E-01, 0.4044E-01, 0.5002E-01, 0.6036E-01, 0.7158E-01,
* 0.8377E-01, 0.9721E-01, 0.1121E+00, 0.1285E+00, 0.1467E+00,
* 0.1671E+00, 0.1781E+00, 0.1898E+00, 0.2152E+00, 0.2437E+00,
* 0.2756E+00, 0.3115E+00, 0.3518E+00, 0.3972E+00, 0.4482E+00,
* 0.5057E+00, 0.5705E+00, 0.6434E+00, 0.7255E+00, 0.8178E+00,
* 0.9214E+00, 0.1038E+01, 0.1168E+01, 0.1313E+01, 0.1475E+01,
* 0.1655E+01, 0.1855E+01, 0.2075E+01, 0.2318E+01, 0.2583E+01,
* 0.2872E+01, 0.3185E+01, 0.3521E+01, 0.3879E+01, 0.4259E+01,
* 0.4657E+01, 0.5068E+01, 0.5490E+01, 0.5916E+01, 0.6342E+01,
* 0.6763E+01, 0.7181E+01, 0.7615E+01, 0.8129E+01, 0.8956E+01,
* 0.1107E+02, 0.2036E+02, 0.4604E+02 /
DATA ((UHR(i,j),j=1,83),i= 6, 6)/
*-0.1851E+00,-0.1831E+00,-0.1763E+00,-0.1704E+00,-0.1661E+00,
*-0.1625E+00,-0.1585E+00,-0.1536E+00,-0.1479E+00,-0.1413E+00,
*-0.1341E+00,-0.1265E+00,-0.1186E+00,-0.1102E+00,-0.1019E+00,
*-0.9357E-01,-0.8525E-01,-0.7711E-01,-0.6908E-01,-0.6115E-01,
*-0.5335E-01,-0.4566E-01,-0.3810E-01,-0.3058E-01,-0.2305E-01,
*-0.1545E-01,-0.7721E-02, 0.1950E-03, 0.8363E-02, 0.1688E-01,
* 0.2589E-01, 0.3542E-01, 0.4561E-01, 0.5655E-01, 0.6843E-01,
* 0.8143E-01, 0.9566E-01, 0.1113E+00, 0.1287E+00, 0.1479E+00,
* 0.1693E+00, 0.1809E+00, 0.1932E+00, 0.2198E+00, 0.2496E+00,
* 0.2830E+00, 0.3203E+00, 0.3622E+00, 0.4093E+00, 0.4621E+00,
* 0.5214E+00, 0.5879E+00, 0.6625E+00, 0.7461E+00, 0.8398E+00,
* 0.9446E+00, 0.1062E+01, 0.1192E+01, 0.1338E+01, 0.1499E+01,
* 0.1678E+01, 0.1875E+01, 0.2091E+01, 0.2329E+01, 0.2587E+01,
* 0.2867E+01, 0.3169E+01, 0.3493E+01, 0.3836E+01, 0.4197E+01,
* 0.4574E+01, 0.4962E+01, 0.5359E+01, 0.5759E+01, 0.6157E+01,
* 0.6553E+01, 0.6949E+01, 0.7368E+01, 0.7881E+01, 0.8738E+01,
* 0.1097E+02, 0.2056E+02, 0.4552E+02 /
DATA ((UHR(i,j),j=1,83),i= 7, 7)/
*-0.1939E+00,-0.1918E+00,-0.1844E+00,-0.1782E+00,-0.1740E+00,
*-0.1707E+00,-0.1672E+00,-0.1628E+00,-0.1577E+00,-0.1518E+00,
*-0.1453E+00,-0.1384E+00,-0.1309E+00,-0.1230E+00,-0.1152E+00,
*-0.1072E+00,-0.9906E-01,-0.9106E-01,-0.8309E-01,-0.7515E-01,
*-0.6723E-01,-0.5937E-01,-0.5153E-01,-0.4368E-01,-0.3574E-01,
*-0.2767E-01,-0.1942E-01,-0.1095E-01,-0.2114E-02, 0.7110E-02,
* 0.1689E-01, 0.2727E-01, 0.3836E-01, 0.5030E-01, 0.6322E-01,
* 0.7734E-01, 0.9277E-01, 0.1097E+00, 0.1284E+00, 0.1491E+00,
* 0.1720E+00, 0.1845E+00, 0.1975E+00, 0.2260E+00, 0.2578E+00,
* 0.2932E+00, 0.3328E+00, 0.3769E+00, 0.4263E+00, 0.4816E+00,
* 0.5433E+00, 0.6121E+00, 0.6890E+00, 0.7746E+00, 0.8701E+00,
* 0.9763E+00, 0.1094E+01, 0.1225E+01, 0.1370E+01, 0.1529E+01,
* 0.1705E+01, 0.1898E+01, 0.2108E+01, 0.2338E+01, 0.2586E+01,
* 0.2853E+01, 0.3139E+01, 0.3443E+01, 0.3764E+01, 0.4100E+01,
* 0.4448E+01, 0.4806E+01, 0.5169E+01, 0.5535E+01, 0.5898E+01,
* 0.6261E+01, 0.6631E+01, 0.7033E+01, 0.7553E+01, 0.8466E+01,
* 0.1088E+02, 0.2095E+02, 0.4501E+02 /
DATA ((UHR(i,j),j=1,83),i= 8, 8)/
*-0.2078E+00,-0.2055E+00,-0.1975E+00,-0.1903E+00,-0.1858E+00,
*-0.1828E+00,-0.1800E+00,-0.1764E+00,-0.1720E+00,-0.1669E+00,
*-0.1610E+00,-0.1545E+00,-0.1477E+00,-0.1405E+00,-0.1329E+00,
*-0.1252E+00,-0.1175E+00,-0.1096E+00,-0.1017E+00,-0.9372E-01,
*-0.8572E-01,-0.7766E-01,-0.6952E-01,-0.6124E-01,-0.5284E-01,
*-0.4421E-01,-0.3533E-01,-0.2609E-01,-0.1648E-01,-0.6367E-02,
* 0.4304E-02, 0.1569E-01, 0.2791E-01, 0.4108E-01, 0.5538E-01,
* 0.7092E-01, 0.8791E-01, 0.1066E+00, 0.1271E+00, 0.1496E+00,
* 0.1746E+00, 0.1881E+00, 0.2023E+00, 0.2330E+00, 0.2670E+00,
* 0.3049E+00, 0.3471E+00, 0.3939E+00, 0.4461E+00, 0.5040E+00,
* 0.5683E+00, 0.6398E+00, 0.7190E+00, 0.8069E+00, 0.9040E+00,
* 0.1011E+01, 0.1130E+01, 0.1260E+01, 0.1403E+01, 0.1560E+01,
* 0.1731E+01, 0.1917E+01, 0.2120E+01, 0.2338E+01, 0.2572E+01,
* 0.2823E+01, 0.3089E+01, 0.3370E+01, 0.3665E+01, 0.3971E+01,
* 0.4287E+01, 0.4610E+01, 0.4935E+01, 0.5263E+01, 0.5590E+01,
* 0.5919E+01, 0.6262E+01, 0.6653E+01, 0.7195E+01, 0.8206E+01,
* 0.1089E+02, 0.2157E+02, 0.4463E+02 /
DATA ((UHR(i,j),j=1,83),i= 9, 9)/
*-0.2255E+00,-0.2229E+00,-0.2138E+00,-0.2058E+00,-0.2011E+00,
*-0.1982E+00,-0.1958E+00,-0.1927E+00,-0.1888E+00,-0.1846E+00,
*-0.1795E+00,-0.1735E+00,-0.1671E+00,-0.1605E+00,-0.1535E+00,
*-0.1462E+00,-0.1387E+00,-0.1310E+00,-0.1232E+00,-0.1153E+00,
*-0.1072E+00,-0.9901E-01,-0.9058E-01,-0.8192E-01,-0.7302E-01,
*-0.6387E-01,-0.5434E-01,-0.4439E-01,-0.3392E-01,-0.2284E-01,
*-0.1112E-01, 0.1434E-02, 0.1493E-01, 0.2953E-01, 0.4533E-01,
* 0.6244E-01, 0.8117E-01, 0.1017E+00, 0.1241E+00, 0.1489E+00,
* 0.1761E+00, 0.1907E+00, 0.2061E+00, 0.2392E+00, 0.2758E+00,
* 0.3163E+00, 0.3610E+00, 0.4104E+00, 0.4651E+00, 0.5254E+00,
* 0.5920E+00, 0.6657E+00, 0.7469E+00, 0.8362E+00, 0.9344E+00,
* 0.1042E+01, 0.1160E+01, 0.1289E+01, 0.1430E+01, 0.1583E+01,
* 0.1748E+01, 0.1927E+01, 0.2119E+01, 0.2325E+01, 0.2545E+01,
* 0.2779E+01, 0.3024E+01, 0.3281E+01, 0.3549E+01, 0.3826E+01,
* 0.4110E+01, 0.4398E+01, 0.4689E+01, 0.4981E+01, 0.5275E+01,
* 0.5577E+01, 0.5901E+01, 0.6294E+01, 0.6874E+01, 0.8007E+01,
* 0.1103E+02, 0.2244E+02, 0.4453E+02 /
DATA ((UHR(i,j),j=1,83),i=10,10)/
*-0.2466E+00,-0.2436E+00,-0.2333E+00,-0.2244E+00,-0.2192E+00,
*-0.2163E+00,-0.2141E+00,-0.2115E+00,-0.2082E+00,-0.2043E+00,
*-0.1998E+00,-0.1946E+00,-0.1887E+00,-0.1825E+00,-0.1760E+00,
*-0.1691E+00,-0.1618E+00,-0.1544E+00,-0.1467E+00,-0.1388E+00,
*-0.1307E+00,-0.1223E+00,-0.1136E+00,-0.1046E+00,-0.9524E-01,
*-0.8549E-01,-0.7529E-01,-0.6458E-01,-0.5320E-01,-0.4114E-01,
*-0.2824E-01,-0.1442E-01, 0.3993E-03, 0.1642E-01, 0.3373E-01,
* 0.5256E-01, 0.7304E-01, 0.9537E-01, 0.1199E+00, 0.1468E+00,
* 0.1762E+00, 0.1919E+00, 0.2084E+00, 0.2439E+00, 0.2829E+00,
* 0.3258E+00, 0.3729E+00, 0.4247E+00, 0.4815E+00, 0.5440E+00,
* 0.6125E+00, 0.6877E+00, 0.7701E+00, 0.8601E+00, 0.9584E+00,
* 0.1066E+01, 0.1182E+01, 0.1309E+01, 0.1446E+01, 0.1594E+01,
* 0.1753E+01, 0.1924E+01, 0.2106E+01, 0.2300E+01, 0.2505E+01,
* 0.2721E+01, 0.2947E+01, 0.3182E+01, 0.3426E+01, 0.3676E+01,
* 0.3931E+01, 0.4189E+01, 0.4450E+01, 0.4713E+01, 0.4982E+01,
* 0.5264E+01, 0.5581E+01, 0.5989E+01, 0.6627E+01, 0.7906E+01,
* 0.1130E+02, 0.2350E+02, 0.4472E+02 /
DATA ((UHR(i,j),j=1,83),i=11,11)/
*-0.2671E+00,-0.2639E+00,-0.2524E+00,-0.2420E+00,-0.2360E+00,
*-0.2330E+00,-0.2312E+00,-0.2290E+00,-0.2261E+00,-0.2228E+00,
*-0.2188E+00,-0.2136E+00,-0.2081E+00,-0.2023E+00,-0.1960E+00,
*-0.1893E+00,-0.1823E+00,-0.1750E+00,-0.1673E+00,-0.1594E+00,
*-0.1512E+00,-0.1426E+00,-0.1337E+00,-0.1243E+00,-0.1145E+00,
*-0.1043E+00,-0.9346E-01,-0.8205E-01,-0.6991E-01,-0.5697E-01,
*-0.4322E-01,-0.2843E-01,-0.1248E-01, 0.4781E-02, 0.2342E-01,
* 0.4355E-01, 0.6549E-01, 0.8940E-01, 0.1154E+00, 0.1439E+00,
* 0.1750E+00, 0.1916E+00, 0.2091E+00, 0.2463E+00, 0.2871E+00,
* 0.3318E+00, 0.3807E+00, 0.4342E+00, 0.4928E+00, 0.5566E+00,
* 0.6263E+00, 0.7024E+00, 0.7854E+00, 0.8755E+00, 0.9734E+00,
* 0.1080E+01, 0.1194E+01, 0.1318E+01, 0.1452E+01, 0.1595E+01,
* 0.1748E+01, 0.1912E+01, 0.2085E+01, 0.2268E+01, 0.2462E+01,
* 0.2665E+01, 0.2875E+01, 0.3094E+01, 0.3319E+01, 0.3550E+01,
* 0.3785E+01, 0.4023E+01, 0.4263E+01, 0.4507E+01, 0.4761E+01,
* 0.5034E+01, 0.5354E+01, 0.5782E+01, 0.6483E+01, 0.7919E+01,
* 0.1166E+02, 0.2455E+02, 0.4508E+02 /
DATA ((UHR(i,j),j=1,83),i=12,12)/
*-0.2816E+00,-0.2782E+00,-0.2661E+00,-0.2548E+00,-0.2481E+00,
*-0.2450E+00,-0.2432E+00,-0.2411E+00,-0.2386E+00,-0.2351E+00,
*-0.2310E+00,-0.2265E+00,-0.2214E+00,-0.2155E+00,-0.2092E+00,
*-0.2026E+00,-0.1956E+00,-0.1884E+00,-0.1808E+00,-0.1728E+00,
*-0.1644E+00,-0.1557E+00,-0.1466E+00,-0.1371E+00,-0.1270E+00,
*-0.1164E+00,-0.1052E+00,-0.9330E-01,-0.8071E-01,-0.6727E-01,
*-0.5284E-01,-0.3740E-01,-0.2079E-01,-0.2916E-02, 0.1647E-01,
* 0.3753E-01, 0.6036E-01, 0.8519E-01, 0.1122E+00, 0.1416E+00,
* 0.1737E+00, 0.1909E+00, 0.2089E+00, 0.2472E+00, 0.2889E+00,
* 0.3346E+00, 0.3844E+00, 0.4388E+00, 0.4981E+00, 0.5628E+00,
* 0.6333E+00, 0.7096E+00, 0.7926E+00, 0.8827E+00, 0.9802E+00,
* 0.1085E+01, 0.1199E+01, 0.1321E+01, 0.1452E+01, 0.1592E+01,
* 0.1741E+01, 0.1900E+01, 0.2068E+01, 0.2246E+01, 0.2432E+01,
* 0.2626E+01, 0.2828E+01, 0.3038E+01, 0.3252E+01, 0.3472E+01,
* 0.3695E+01, 0.3921E+01, 0.4151E+01, 0.4386E+01, 0.4631E+01,
* 0.4900E+01, 0.5225E+01, 0.5673E+01, 0.6420E+01, 0.7960E+01,
* 0.1193E+02, 0.2524E+02, 0.4537E+02 /
DATA ((UHR(i,j),j=1,83),i=13,13)/
*-0.3231E+00,-0.3191E+00,-0.3044E+00,-0.2904E+00,-0.2822E+00,
*-0.2784E+00,-0.2767E+00,-0.2749E+00,-0.2725E+00,-0.2699E+00,
*-0.2664E+00,-0.2619E+00,-0.2568E+00,-0.2515E+00,-0.2455E+00,
*-0.2391E+00,-0.2323E+00,-0.2249E+00,-0.2171E+00,-0.2090E+00,
*-0.2004E+00,-0.1913E+00,-0.1816E+00,-0.1714E+00,-0.1606E+00,
*-0.1491E+00,-0.1370E+00,-0.1240E+00,-0.1102E+00,-0.9530E-01,
*-0.7947E-01,-0.6242E-01,-0.4403E-01,-0.2415E-01,-0.2749E-02,
* 0.2029E-01, 0.4528E-01, 0.7237E-01, 0.1017E+00, 0.1336E+00,
* 0.1682E+00, 0.1864E+00, 0.2056E+00, 0.2462E+00, 0.2904E+00,
* 0.3383E+00, 0.3902E+00, 0.4465E+00, 0.5074E+00, 0.5731E+00,
* 0.6440E+00, 0.7208E+00, 0.8036E+00, 0.8925E+00, 0.9879E+00,
* 0.1090E+01, 0.1200E+01, 0.1316E+01, 0.1440E+01, 0.1572E+01,
* 0.1711E+01, 0.1858E+01, 0.2012E+01, 0.2174E+01, 0.2342E+01,
* 0.2517E+01, 0.2698E+01, 0.2883E+01, 0.3073E+01, 0.3267E+01,
* 0.3465E+01, 0.3667E+01, 0.3874E+01, 0.4091E+01, 0.4328E+01,
* 0.4601E+01, 0.4951E+01, 0.5466E+01, 0.6362E+01, 0.8219E+01,
* 0.1287E+02, 0.2742E+02, 0.4654E+02 /
DATA ((UHR(i,j),j=1,83),i=14,14)/
*-0.3870E+00,-0.3820E+00,-0.3635E+00,-0.3450E+00,-0.3336E+00,
*-0.3280E+00,-0.3257E+00,-0.3238E+00,-0.3216E+00,-0.3193E+00,
*-0.3162E+00,-0.3121E+00,-0.3073E+00,-0.3021E+00,-0.2965E+00,
*-0.2900E+00,-0.2831E+00,-0.2756E+00,-0.2676E+00,-0.2591E+00,
*-0.2500E+00,-0.2403E+00,-0.2298E+00,-0.2187E+00,-0.2068E+00,
*-0.1941E+00,-0.1806E+00,-0.1662E+00,-0.1507E+00,-0.1340E+00,
*-0.1162E+00,-0.9703E-01,-0.7642E-01,-0.5423E-01,-0.3043E-01,
*-0.4862E-02, 0.2265E-01, 0.5229E-01, 0.8431E-01, 0.1189E+00,
* 0.1559E+00, 0.1754E+00, 0.1957E+00, 0.2387E+00, 0.2851E+00,
* 0.3348E+00, 0.3882E+00, 0.4456E+00, 0.5071E+00, 0.5729E+00,
* 0.6432E+00, 0.7186E+00, 0.7990E+00, 0.8845E+00, 0.9754E+00,
* 0.1072E+01, 0.1174E+01, 0.1282E+01, 0.1396E+01, 0.1516E+01,
* 0.1642E+01, 0.1773E+01, 0.1910E+01, 0.2052E+01, 0.2200E+01,
* 0.2352E+01, 0.2509E+01, 0.2669E+01, 0.2835E+01, 0.3005E+01,
* 0.3179E+01, 0.3361E+01, 0.3554E+01, 0.3765E+01, 0.4010E+01,
* 0.4316E+01, 0.4739E+01, 0.5399E+01, 0.6569E+01, 0.8955E+01,
* 0.1466E+02, 0.3092E+02, 0.4862E+02 /
DATA ((UHR(i,j),j=1,83),i=15,15)/
*-0.5767E+00,-0.5675E+00,-0.5318E+00,-0.4900E+00,-0.4589E+00,
*-0.4414E+00,-0.4325E+00,-0.4271E+00,-0.4230E+00,-0.4193E+00,
*-0.4158E+00,-0.4119E+00,-0.4072E+00,-0.4016E+00,-0.3952E+00,
*-0.3882E+00,-0.3806E+00,-0.3723E+00,-0.3632E+00,-0.3534E+00,
*-0.3428E+00,-0.3313E+00,-0.3190E+00,-0.3058E+00,-0.2917E+00,
*-0.2766E+00,-0.2605E+00,-0.2431E+00,-0.2248E+00,-0.2052E+00,
*-0.1844E+00,-0.1624E+00,-0.1390E+00,-0.1141E+00,-0.8766E-01,
*-0.5953E-01,-0.2973E-01, 0.1805E-02, 0.3501E-01, 0.7009E-01,
* 0.1074E+00, 0.1270E+00, 0.1470E+00, 0.1886E+00, 0.2322E+00,
* 0.2785E+00, 0.3272E+00, 0.3784E+00, 0.4322E+00, 0.4890E+00,
* 0.5486E+00, 0.6108E+00, 0.6761E+00, 0.7449E+00, 0.8168E+00,
* 0.8919E+00, 0.9705E+00, 0.1053E+01, 0.1140E+01, 0.1230E+01,
* 0.1324E+01, 0.1424E+01, 0.1529E+01, 0.1639E+01, 0.1755E+01,
* 0.1878E+01, 0.2010E+01, 0.2154E+01, 0.2310E+01, 0.2482E+01,
* 0.2677E+01, 0.2904E+01, 0.3178E+01, 0.3521E+01, 0.3972E+01,
* 0.4601E+01, 0.5536E+01, 0.7019E+01, 0.9541E+01, 0.1418E+02,
* 0.2350E+02, 0.4319E+02, 0.5584E+02 /
DATA ((UHR(i,j),j=1,83),i=16,16)/
*-0.6058E+00,-0.5946E+00,-0.5508E+00,-0.4965E+00,-0.4520E+00,
*-0.4228E+00,-0.4053E+00,-0.3942E+00,-0.3865E+00,-0.3809E+00,
*-0.3762E+00,-0.3717E+00,-0.3671E+00,-0.3620E+00,-0.3564E+00,
*-0.3500E+00,-0.3428E+00,-0.3350E+00,-0.3266E+00,-0.3174E+00,
*-0.3075E+00,-0.2969E+00,-0.2855E+00,-0.2733E+00,-0.2602E+00,
*-0.2463E+00,-0.2315E+00,-0.2159E+00,-0.1993E+00,-0.1816E+00,
*-0.1629E+00,-0.1430E+00,-0.1220E+00,-0.9988E-01,-0.7664E-01,
*-0.5214E-01,-0.2643E-01, 0.7463E-03, 0.2965E-01, 0.6005E-01,
* 0.9169E-01, 0.1081E+00, 0.1249E+00, 0.1600E+00, 0.1971E+00,
* 0.2359E+00, 0.2766E+00, 0.3194E+00, 0.3645E+00, 0.4119E+00,
* 0.4617E+00, 0.5146E+00, 0.5701E+00, 0.6283E+00, 0.6899E+00,
* 0.7556E+00, 0.8252E+00, 0.8988E+00, 0.9776E+00, 0.1063E+01,
* 0.1153E+01, 0.1251E+01, 0.1357E+01, 0.1472E+01, 0.1599E+01,
* 0.1740E+01, 0.1895E+01, 0.2071E+01, 0.2271E+01, 0.2504E+01,
* 0.2778E+01, 0.3109E+01, 0.3521E+01, 0.4046E+01, 0.4745E+01,
* 0.5712E+01, 0.7112E+01, 0.9242E+01, 0.1266E+02, 0.1847E+02,
* 0.2900E+02, 0.4746E+02, 0.5654E+02 /
DATA ((UHR(i,j),j=1,83),i=17,17)/
*-0.5984E+00,-0.5867E+00,-0.5407E+00,-0.4824E+00,-0.4333E+00,
*-0.4002E+00,-0.3797E+00,-0.3663E+00,-0.3571E+00,-0.3504E+00,
*-0.3452E+00,-0.3410E+00,-0.3365E+00,-0.3314E+00,-0.3259E+00,
*-0.3197E+00,-0.3130E+00,-0.3059E+00,-0.2981E+00,-0.2895E+00,
*-0.2802E+00,-0.2702E+00,-0.2596E+00,-0.2483E+00,-0.2361E+00,
*-0.2230E+00,-0.2091E+00,-0.1945E+00,-0.1790E+00,-0.1626E+00,
*-0.1451E+00,-0.1265E+00,-0.1071E+00,-0.8671E-01,-0.6516E-01,
*-0.4238E-01,-0.1840E-01, 0.6810E-02, 0.3332E-01, 0.6119E-01,
* 0.9053E-01, 0.1058E+00, 0.1215E+00, 0.1541E+00, 0.1884E+00,
* 0.2243E+00, 0.2621E+00, 0.3020E+00, 0.3441E+00, 0.3888E+00,
* 0.4361E+00, 0.4857E+00, 0.5378E+00, 0.5931E+00, 0.6526E+00,
* 0.7162E+00, 0.7841E+00, 0.8567E+00, 0.9346E+00, 0.1019E+01,
* 0.1111E+01, 0.1211E+01, 0.1320E+01, 0.1442E+01, 0.1576E+01,
* 0.1725E+01, 0.1895E+01, 0.2089E+01, 0.2311E+01, 0.2571E+01,
* 0.2878E+01, 0.3253E+01, 0.3722E+01, 0.4319E+01, 0.5105E+01,
* 0.6187E+01, 0.7737E+01, 0.1006E+02, 0.1371E+02, 0.1976E+02,
* 0.3036E+02, 0.4765E+02, 0.5552E+02 /
DATA ((UHR(i,j),j=1,83),i=18,18)/
*-0.5521E+00,-0.5399E+00,-0.4910E+00,-0.4261E+00,-0.3694E+00,
*-0.3292E+00,-0.3030E+00,-0.2853E+00,-0.2727E+00,-0.2638E+00,
*-0.2573E+00,-0.2520E+00,-0.2473E+00,-0.2428E+00,-0.2380E+00,
*-0.2332E+00,-0.2280E+00,-0.2221E+00,-0.2158E+00,-0.2090E+00,
*-0.2017E+00,-0.1938E+00,-0.1853E+00,-0.1761E+00,-0.1665E+00,
*-0.1563E+00,-0.1453E+00,-0.1336E+00,-0.1211E+00,-0.1079E+00,
*-0.9412E-01,-0.7967E-01,-0.6432E-01,-0.4798E-01,-0.3074E-01,
*-0.1255E-01, 0.6715E-02, 0.2704E-01, 0.4837E-01, 0.7090E-01,
* 0.9491E-01, 0.1074E+00, 0.1203E+00, 0.1470E+00, 0.1751E+00,
* 0.2051E+00, 0.2371E+00, 0.2710E+00, 0.3070E+00, 0.3454E+00,
* 0.3865E+00, 0.4307E+00, 0.4786E+00, 0.5304E+00, 0.5861E+00,
* 0.6462E+00, 0.7119E+00, 0.7842E+00, 0.8637E+00, 0.9510E+00,
* 0.1049E+01, 0.1158E+01, 0.1280E+01, 0.1418E+01, 0.1574E+01,
* 0.1752E+01, 0.1957E+01, 0.2194E+01, 0.2473E+01, 0.2803E+01,
* 0.3198E+01, 0.3678E+01, 0.4272E+01, 0.5025E+01, 0.6008E+01,
* 0.7326E+01, 0.9156E+01, 0.1179E+02, 0.1576E+02, 0.2198E+02,
* 0.3205E+02, 0.4585E+02, 0.5119E+02 /
DATA ((UHR(i,j),j=1,83),i=19,19)/
*-0.4886E+00,-0.4774E+00,-0.4325E+00,-0.3705E+00,-0.3132E+00,
*-0.2692E+00,-0.2385E+00,-0.2168E+00,-0.2012E+00,-0.1902E+00,
*-0.1821E+00,-0.1759E+00,-0.1711E+00,-0.1671E+00,-0.1633E+00,
*-0.1593E+00,-0.1550E+00,-0.1504E+00,-0.1454E+00,-0.1402E+00,
*-0.1346E+00,-0.1285E+00,-0.1219E+00,-0.1149E+00,-0.1073E+00,
*-0.9929E-01,-0.9078E-01,-0.8176E-01,-0.7214E-01,-0.6190E-01,
*-0.5100E-01,-0.3936E-01,-0.2691E-01,-0.1377E-01, 0.6039E-04,
* 0.1462E-01, 0.2999E-01, 0.4641E-01, 0.6409E-01, 0.8289E-01,
* 0.1026E+00, 0.1129E+00, 0.1235E+00, 0.1461E+00, 0.1705E+00,
* 0.1965E+00, 0.2244E+00, 0.2545E+00, 0.2869E+00, 0.3219E+00,
* 0.3598E+00, 0.4014E+00, 0.4468E+00, 0.4963E+00, 0.5505E+00,
* 0.6109E+00, 0.6778E+00, 0.7523E+00, 0.8358E+00, 0.9299E+00,
* 0.1035E+01, 0.1154E+01, 0.1289E+01, 0.1443E+01, 0.1621E+01,
* 0.1827E+01, 0.2064E+01, 0.2340E+01, 0.2665E+01, 0.3050E+01,
* 0.3512E+01, 0.4072E+01, 0.4761E+01, 0.5626E+01, 0.6735E+01,
* 0.8192E+01, 0.1016E+02, 0.1289E+02, 0.1684E+02, 0.2266E+02,
* 0.3152E+02, 0.4198E+02, 0.4560E+02 /
DATA ((UHR(i,j),j=1,83),i=20,20)/
*-0.3196E+00,-0.3128E+00,-0.2855E+00,-0.2438E+00,-0.1991E+00,
*-0.1599E+00,-0.1282E+00,-0.1026E+00,-0.8219E-01,-0.6633E-01,
*-0.5402E-01,-0.4447E-01,-0.3721E-01,-0.3163E-01,-0.2718E-01,
*-0.2343E-01,-0.2005E-01,-0.1687E-01,-0.1383E-01,-0.1089E-01,
*-0.7955E-02,-0.4932E-02,-0.1737E-02, 0.1654E-02, 0.5222E-02,
* 0.9004E-02, 0.1308E-01, 0.1754E-01, 0.2240E-01, 0.2764E-01,
* 0.3327E-01, 0.3941E-01, 0.4619E-01, 0.5358E-01, 0.6158E-01,
* 0.7025E-01, 0.7974E-01, 0.9017E-01, 0.1017E+00, 0.1144E+00,
* 0.1283E+00, 0.1357E+00, 0.1436E+00, 0.1605E+00, 0.1793E+00,
* 0.2003E+00, 0.2236E+00, 0.2496E+00, 0.2786E+00, 0.3110E+00,
* 0.3472E+00, 0.3883E+00, 0.4348E+00, 0.4871E+00, 0.5462E+00,
* 0.6134E+00, 0.6898E+00, 0.7771E+00, 0.8773E+00, 0.9922E+00,
* 0.1124E+01, 0.1275E+01, 0.1450E+01, 0.1652E+01, 0.1886E+01,
* 0.2157E+01, 0.2473E+01, 0.2839E+01, 0.3268E+01, 0.3773E+01,
* 0.4366E+01, 0.5063E+01, 0.5892E+01, 0.6882E+01, 0.8075E+01,
* 0.9525E+01, 0.1130E+02, 0.1350E+02, 0.1626E+02, 0.1969E+02,
* 0.2340E+02, 0.2626E+02, 0.2704E+02 /
do 1 i=1,20
asy(1,i)=asy_m(i)
ex(1,i)=ex_m(i)
sc(1,i)=sc_m(i)
do 1 j=1,nquad
ph(i,j)=phr(i,j)
qh(i,j)=qhr(i,j)
uh(i,j)=uhr(i,j)
1 continue
return
end
BDM.f0000644002107500000270000021032112463730616010132 0ustar jckraps subroutine bdm
c - to vary the number of quadratures
include "paramdef.inc"
integer nquad
common /num_quad/ nquad
real ph,qh,uh
common /sixs_aerbas/ ph(20,nqmax_p),qh(20,nqmax_p),uh(20,nqmax_p)
real phr(20,nqdef_p),qhr(20,nqdef_p),uhr(20,nqdef_p)
c - to vary the number of quadratures
real ex,sc,asy,vi
common /sixs_coef/ ex(4,20),sc(4,20),asy(4,20),vi(4)
real ex_m(20),sc_m(20),asy_m(20)
integer i,j
c Background desert model
c Parameters and refractive indices - G.A. d'Almeida, 'Atmospheric
c aerosols. Global climatology and radiative characteristics', 1991,
c pp.48,80,102.
c Extinction coefficients are calculated in km-1
c*************** MIE (asy) ******************
data (asy_m(j),j=1,20)/
a 0.701,0.690,0.687,0.681,0.677,0.675,0.671,0.665,0.660,0.655,
a 0.651,0.648,0.639,0.626,0.583,0.587,0.583,0.595,0.605,0.547/
c*************** MIE (ext&sca) ******************
data (ex_m(j),sc_m(j),j=1,20) /
a 0.9978367E-01,0.8870113E-01,0.9390490E-01,0.8606911E-01,
a 0.9241579E-01,0.8536333E-01,0.8848752E-01,0.8329929E-01,
a 0.8496436E-01,0.8053116E-01,0.8261336E-01,0.7846993E-01,
a 0.7913338E-01,0.7561909E-01,0.7475012E-01,0.7217911E-01,
a 0.6989562E-01,0.6785794E-01,0.6496391E-01,0.6316575E-01,
a 0.6097984E-01,0.5937214E-01,0.5852314E-01,0.5706264E-01,
a 0.5225345E-01,0.5114494E-01,0.4403058E-01,0.4369425E-01,
a 0.2414531E-01,0.2392341E-01,0.1078730E-01,0.1061324E-01,
a 0.8476357E-02,0.8300470E-02,0.3624489E-02,0.3460222E-02,
a 0.1813242E-02,0.1624963E-02,0.1101573E-02,0.6737047E-03 /
c************** MIE (phase fun ph) ***************
DATA ((PHR(i,j),j=1,83),i= 1, 1)/
*0.3494E+00,0.3432E+00,0.3196E+00,0.2868E+00,0.2541E+00,
*0.2281E+00,0.2113E+00,0.2032E+00,0.2008E+00,0.2006E+00,
*0.1999E+00,0.1976E+00,0.1935E+00,0.1877E+00,0.1811E+00,
*0.1740E+00,0.1670E+00,0.1603E+00,0.1543E+00,0.1490E+00,
*0.1445E+00,0.1407E+00,0.1378E+00,0.1357E+00,0.1343E+00,
*0.1336E+00,0.1336E+00,0.1344E+00,0.1358E+00,0.1380E+00,
*0.1410E+00,0.1446E+00,0.1491E+00,0.1543E+00,0.1605E+00,
*0.1676E+00,0.1757E+00,0.1849E+00,0.1953E+00,0.2070E+00,
*0.2202E+00,0.2274E+00,0.2351E+00,0.2518E+00,0.2706E+00,
*0.2918E+00,0.3155E+00,0.3422E+00,0.3722E+00,0.4060E+00,
*0.4442E+00,0.4873E+00,0.5361E+00,0.5913E+00,0.6539E+00,
*0.7251E+00,0.8061E+00,0.8983E+00,0.1004E+01,0.1124E+01,
*0.1262E+01,0.1420E+01,0.1602E+01,0.1812E+01,0.2054E+01,
*0.2333E+01,0.2655E+01,0.3030E+01,0.3465E+01,0.3971E+01,
*0.4562E+01,0.5253E+01,0.6062E+01,0.7012E+01,0.8127E+01,
*0.9440E+01,0.1098E+02,0.1278E+02,0.1487E+02,0.1727E+02,
*0.2006E+02,0.2372E+02,0.2698E+02 /
DATA ((PHR(i,j),j=1,83),i= 2, 2)/
*0.3524E+00,0.3465E+00,0.3245E+00,0.2939E+00,0.2629E+00,
*0.2374E+00,0.2201E+00,0.2108E+00,0.2069E+00,0.2052E+00,
*0.2036E+00,0.2008E+00,0.1966E+00,0.1910E+00,0.1847E+00,
*0.1780E+00,0.1714E+00,0.1651E+00,0.1594E+00,0.1543E+00,
*0.1499E+00,0.1463E+00,0.1435E+00,0.1414E+00,0.1400E+00,
*0.1393E+00,0.1394E+00,0.1402E+00,0.1417E+00,0.1440E+00,
*0.1470E+00,0.1507E+00,0.1554E+00,0.1608E+00,0.1672E+00,
*0.1745E+00,0.1829E+00,0.1925E+00,0.2034E+00,0.2156E+00,
*0.2294E+00,0.2370E+00,0.2450E+00,0.2625E+00,0.2822E+00,
*0.3043E+00,0.3291E+00,0.3571E+00,0.3886E+00,0.4241E+00,
*0.4642E+00,0.5095E+00,0.5606E+00,0.6185E+00,0.6842E+00,
*0.7589E+00,0.8437E+00,0.9403E+00,0.1050E+01,0.1176E+01,
*0.1320E+01,0.1484E+01,0.1672E+01,0.1888E+01,0.2136E+01,
*0.2420E+01,0.2748E+01,0.3124E+01,0.3558E+01,0.4057E+01,
*0.4632E+01,0.5295E+01,0.6059E+01,0.6938E+01,0.7948E+01,
*0.9106E+01,0.1043E+02,0.1193E+02,0.1361E+02,0.1549E+02,
*0.1763E+02,0.2043E+02,0.2269E+02 /
DATA ((PHR(i,j),j=1,83),i= 3, 3)/
*0.3543E+00,0.3485E+00,0.3269E+00,0.2968E+00,0.2661E+00,
*0.2406E+00,0.2232E+00,0.2135E+00,0.2092E+00,0.2072E+00,
*0.2053E+00,0.2023E+00,0.1979E+00,0.1923E+00,0.1860E+00,
*0.1794E+00,0.1728E+00,0.1665E+00,0.1608E+00,0.1558E+00,
*0.1514E+00,0.1478E+00,0.1450E+00,0.1428E+00,0.1414E+00,
*0.1408E+00,0.1409E+00,0.1417E+00,0.1432E+00,0.1455E+00,
*0.1485E+00,0.1523E+00,0.1569E+00,0.1624E+00,0.1688E+00,
*0.1762E+00,0.1847E+00,0.1944E+00,0.2053E+00,0.2177E+00,
*0.2317E+00,0.2393E+00,0.2474E+00,0.2651E+00,0.2850E+00,
*0.3073E+00,0.3324E+00,0.3607E+00,0.3925E+00,0.4285E+00,
*0.4690E+00,0.5148E+00,0.5664E+00,0.6250E+00,0.6913E+00,
*0.7667E+00,0.8523E+00,0.9499E+00,0.1061E+01,0.1188E+01,
*0.1333E+01,0.1498E+01,0.1687E+01,0.1904E+01,0.2153E+01,
*0.2438E+01,0.2766E+01,0.3142E+01,0.3575E+01,0.4071E+01,
*0.4642E+01,0.5297E+01,0.6050E+01,0.6913E+01,0.7900E+01,
*0.9025E+01,0.1030E+02,0.1174E+02,0.1335E+02,0.1513E+02,
*0.1715E+02,0.1978E+02,0.2187E+02 /
DATA ((PHR(i,j),j=1,83),i= 4, 4)/
*0.3623E+00,0.3565E+00,0.3352E+00,0.3054E+00,0.2749E+00,
*0.2493E+00,0.2313E+00,0.2208E+00,0.2155E+00,0.2125E+00,
*0.2098E+00,0.2063E+00,0.2016E+00,0.1959E+00,0.1895E+00,
*0.1829E+00,0.1763E+00,0.1701E+00,0.1645E+00,0.1595E+00,
*0.1552E+00,0.1516E+00,0.1488E+00,0.1466E+00,0.1452E+00,
*0.1445E+00,0.1446E+00,0.1455E+00,0.1470E+00,0.1494E+00,
*0.1524E+00,0.1563E+00,0.1611E+00,0.1667E+00,0.1732E+00,
*0.1808E+00,0.1895E+00,0.1994E+00,0.2106E+00,0.2233E+00,
*0.2376E+00,0.2454E+00,0.2537E+00,0.2719E+00,0.2923E+00,
*0.3152E+00,0.3410E+00,0.3700E+00,0.4027E+00,0.4396E+00,
*0.4812E+00,0.5281E+00,0.5811E+00,0.6410E+00,0.7090E+00,
*0.7862E+00,0.8738E+00,0.9734E+00,0.1087E+01,0.1216E+01,
*0.1363E+01,0.1531E+01,0.1723E+01,0.1942E+01,0.2193E+01,
*0.2479E+01,0.2807E+01,0.3182E+01,0.3610E+01,0.4099E+01,
*0.4658E+01,0.5295E+01,0.6019E+01,0.6842E+01,0.7773E+01,
*0.8821E+01,0.9994E+01,0.1130E+02,0.1273E+02,0.1430E+02,
*0.1607E+02,0.1836E+02,0.2008E+02 /
DATA ((PHR(i,j),j=1,83),i= 5, 5)/
*0.3549E+00,0.3494E+00,0.3296E+00,0.3019E+00,0.2732E+00,
*0.2488E+00,0.2314E+00,0.2207E+00,0.2151E+00,0.2118E+00,
*0.2089E+00,0.2053E+00,0.2006E+00,0.1952E+00,0.1892E+00,
*0.1829E+00,0.1767E+00,0.1709E+00,0.1655E+00,0.1607E+00,
*0.1566E+00,0.1531E+00,0.1504E+00,0.1484E+00,0.1472E+00,
*0.1467E+00,0.1469E+00,0.1478E+00,0.1495E+00,0.1519E+00,
*0.1550E+00,0.1590E+00,0.1638E+00,0.1695E+00,0.1762E+00,
*0.1839E+00,0.1928E+00,0.2028E+00,0.2143E+00,0.2273E+00,
*0.2419E+00,0.2499E+00,0.2583E+00,0.2768E+00,0.2975E+00,
*0.3209E+00,0.3473E+00,0.3769E+00,0.4103E+00,0.4479E+00,
*0.4902E+00,0.5381E+00,0.5922E+00,0.6533E+00,0.7226E+00,
*0.8010E+00,0.8901E+00,0.9913E+00,0.1106E+01,0.1237E+01,
*0.1387E+01,0.1556E+01,0.1750E+01,0.1971E+01,0.2223E+01,
*0.2510E+01,0.2838E+01,0.3211E+01,0.3636E+01,0.4120E+01,
*0.4669E+01,0.5292E+01,0.5996E+01,0.6790E+01,0.7681E+01,
*0.8675E+01,0.9777E+01,0.1099E+02,0.1230E+02,0.1373E+02,
*0.1535E+02,0.1742E+02,0.1891E+02 /
DATA ((PHR(i,j),j=1,83),i= 6, 6)/
*0.3501E+00,0.3448E+00,0.3255E+00,0.2985E+00,0.2707E+00,
*0.2469E+00,0.2298E+00,0.2193E+00,0.2136E+00,0.2101E+00,
*0.2071E+00,0.2036E+00,0.1992E+00,0.1941E+00,0.1883E+00,
*0.1823E+00,0.1764E+00,0.1708E+00,0.1657E+00,0.1611E+00,
*0.1572E+00,0.1539E+00,0.1513E+00,0.1495E+00,0.1483E+00,
*0.1478E+00,0.1481E+00,0.1490E+00,0.1507E+00,0.1532E+00,
*0.1565E+00,0.1606E+00,0.1655E+00,0.1713E+00,0.1781E+00,
*0.1859E+00,0.1949E+00,0.2052E+00,0.2168E+00,0.2299E+00,
*0.2446E+00,0.2527E+00,0.2612E+00,0.2800E+00,0.3012E+00,
*0.3249E+00,0.3515E+00,0.3815E+00,0.4152E+00,0.4533E+00,
*0.4962E+00,0.5446E+00,0.5993E+00,0.6612E+00,0.7312E+00,
*0.8106E+00,0.9005E+00,0.1003E+01,0.1119E+01,0.1251E+01,
*0.1401E+01,0.1572E+01,0.1766E+01,0.1988E+01,0.2241E+01,
*0.2528E+01,0.2855E+01,0.3227E+01,0.3651E+01,0.4130E+01,
*0.4674E+01,0.5288E+01,0.5980E+01,0.6756E+01,0.7623E+01,
*0.8585E+01,0.9645E+01,0.1080E+02,0.1205E+02,0.1341E+02,
*0.1495E+02,0.1689E+02,0.1825E+02 /
DATA ((PHR(i,j),j=1,83),i= 7, 7)/
*0.3444E+00,0.3394E+00,0.3213E+00,0.2961E+00,0.2698E+00,
*0.2470E+00,0.2303E+00,0.2198E+00,0.2138E+00,0.2100E+00,
*0.2067E+00,0.2031E+00,0.1988E+00,0.1938E+00,0.1883E+00,
*0.1826E+00,0.1770E+00,0.1717E+00,0.1668E+00,0.1625E+00,
*0.1587E+00,0.1557E+00,0.1532E+00,0.1515E+00,0.1504E+00,
*0.1500E+00,0.1503E+00,0.1513E+00,0.1531E+00,0.1557E+00,
*0.1591E+00,0.1632E+00,0.1683E+00,0.1742E+00,0.1811E+00,
*0.1891E+00,0.1983E+00,0.2087E+00,0.2205E+00,0.2339E+00,
*0.2489E+00,0.2572E+00,0.2659E+00,0.2851E+00,0.3066E+00,
*0.3307E+00,0.3579E+00,0.3884E+00,0.4228E+00,0.4616E+00,
*0.5053E+00,0.5546E+00,0.6102E+00,0.6730E+00,0.7442E+00,
*0.8247E+00,0.9160E+00,0.1020E+01,0.1137E+01,0.1270E+01,
*0.1422E+01,0.1594E+01,0.1790E+01,0.2013E+01,0.2266E+01,
*0.2553E+01,0.2879E+01,0.3249E+01,0.3668E+01,0.4141E+01,
*0.4675E+01,0.5276E+01,0.5948E+01,0.6698E+01,0.7530E+01,
*0.8446E+01,0.9447E+01,0.1053E+02,0.1169E+02,0.1295E+02,
*0.1436E+02,0.1613E+02,0.1732E+02 /
DATA ((PHR(i,j),j=1,83),i= 8, 8)/
*0.3445E+00,0.3396E+00,0.3223E+00,0.2982E+00,0.2729E+00,
*0.2510E+00,0.2345E+00,0.2236E+00,0.2170E+00,0.2127E+00,
*0.2091E+00,0.2051E+00,0.2005E+00,0.1955E+00,0.1901E+00,
*0.1846E+00,0.1791E+00,0.1740E+00,0.1692E+00,0.1650E+00,
*0.1613E+00,0.1584E+00,0.1560E+00,0.1544E+00,0.1535E+00,
*0.1533E+00,0.1537E+00,0.1549E+00,0.1567E+00,0.1594E+00,
*0.1628E+00,0.1671E+00,0.1722E+00,0.1783E+00,0.1854E+00,
*0.1937E+00,0.2030E+00,0.2137E+00,0.2258E+00,0.2394E+00,
*0.2549E+00,0.2633E+00,0.2723E+00,0.2918E+00,0.3139E+00,
*0.3386E+00,0.3665E+00,0.3978E+00,0.4330E+00,0.4725E+00,
*0.5171E+00,0.5675E+00,0.6243E+00,0.6885E+00,0.7609E+00,
*0.8428E+00,0.9356E+00,0.1041E+01,0.1159E+01,0.1294E+01,
*0.1447E+01,0.1621E+01,0.1818E+01,0.2041E+01,0.2294E+01,
*0.2580E+01,0.2904E+01,0.3270E+01,0.3682E+01,0.4147E+01,
*0.4667E+01,0.5249E+01,0.5897E+01,0.6614E+01,0.7403E+01,
*0.8264E+01,0.9196E+01,0.1020E+02,0.1126E+02,0.1241E+02,
*0.1370E+02,0.1529E+02,0.1632E+02 /
DATA ((PHR(i,j),j=1,83),i= 9, 9)/
*0.3352E+00,0.3308E+00,0.3154E+00,0.2937E+00,0.2706E+00,
*0.2501E+00,0.2344E+00,0.2238E+00,0.2170E+00,0.2124E+00,
*0.2085E+00,0.2045E+00,0.2001E+00,0.1952E+00,0.1902E+00,
*0.1851E+00,0.1800E+00,0.1752E+00,0.1708E+00,0.1669E+00,
*0.1636E+00,0.1608E+00,0.1587E+00,0.1572E+00,0.1564E+00,
*0.1563E+00,0.1569E+00,0.1582E+00,0.1602E+00,0.1630E+00,
*0.1665E+00,0.1709E+00,0.1762E+00,0.1825E+00,0.1898E+00,
*0.1982E+00,0.2078E+00,0.2187E+00,0.2312E+00,0.2453E+00,
*0.2612E+00,0.2699E+00,0.2791E+00,0.2991E+00,0.3216E+00,
*0.3469E+00,0.3755E+00,0.4076E+00,0.4437E+00,0.4843E+00,
*0.5299E+00,0.5814E+00,0.6394E+00,0.7048E+00,0.7786E+00,
*0.8620E+00,0.9562E+00,0.1063E+01,0.1183E+01,0.1320E+01,
*0.1474E+01,0.1649E+01,0.1846E+01,0.2070E+01,0.2322E+01,
*0.2607E+01,0.2928E+01,0.3289E+01,0.3695E+01,0.4149E+01,
*0.4656E+01,0.5219E+01,0.5841E+01,0.6526E+01,0.7273E+01,
*0.8082E+01,0.8949E+01,0.9871E+01,0.1085E+02,0.1189E+02,
*0.1306E+02,0.1448E+02,0.1535E+02 /
DATA ((PHR(i,j),j=1,83),i=10,10)/
*0.3251E+00,0.3211E+00,0.3071E+00,0.2874E+00,0.2664E+00,
*0.2475E+00,0.2326E+00,0.2224E+00,0.2157E+00,0.2109E+00,
*0.2069E+00,0.2030E+00,0.1989E+00,0.1944E+00,0.1897E+00,
*0.1850E+00,0.1804E+00,0.1760E+00,0.1720E+00,0.1685E+00,
*0.1655E+00,0.1630E+00,0.1611E+00,0.1599E+00,0.1592E+00,
*0.1592E+00,0.1600E+00,0.1614E+00,0.1636E+00,0.1665E+00,
*0.1703E+00,0.1749E+00,0.1804E+00,0.1868E+00,0.1944E+00,
*0.2030E+00,0.2129E+00,0.2242E+00,0.2370E+00,0.2515E+00,
*0.2678E+00,0.2767E+00,0.2861E+00,0.3068E+00,0.3299E+00,
*0.3559E+00,0.3852E+00,0.4180E+00,0.4550E+00,0.4965E+00,
*0.5433E+00,0.5959E+00,0.6550E+00,0.7216E+00,0.7967E+00,
*0.8815E+00,0.9772E+00,0.1085E+01,0.1207E+01,0.1345E+01,
*0.1500E+01,0.1675E+01,0.1873E+01,0.2096E+01,0.2348E+01,
*0.2631E+01,0.2948E+01,0.3304E+01,0.3702E+01,0.4146E+01,
*0.4638E+01,0.5182E+01,0.5780E+01,0.6433E+01,0.7141E+01,
*0.7901E+01,0.8711E+01,0.9564E+01,0.1046E+02,0.1142E+02,
*0.1249E+02,0.1378E+02,0.1452E+02 /
DATA ((PHR(i,j),j=1,83),i=11,11)/
*0.3184E+00,0.3146E+00,0.3017E+00,0.2836E+00,0.2641E+00,
*0.2464E+00,0.2325E+00,0.2226E+00,0.2159E+00,0.2111E+00,
*0.2070E+00,0.2030E+00,0.1989E+00,0.1945E+00,0.1901E+00,
*0.1856E+00,0.1813E+00,0.1772E+00,0.1735E+00,0.1701E+00,
*0.1673E+00,0.1651E+00,0.1633E+00,0.1622E+00,0.1618E+00,
*0.1620E+00,0.1629E+00,0.1645E+00,0.1668E+00,0.1698E+00,
*0.1737E+00,0.1784E+00,0.1840E+00,0.1907E+00,0.1984E+00,
*0.2073E+00,0.2174E+00,0.2289E+00,0.2420E+00,0.2568E+00,
*0.2735E+00,0.2826E+00,0.2923E+00,0.3133E+00,0.3369E+00,
*0.3635E+00,0.3934E+00,0.4269E+00,0.4646E+00,0.5069E+00,
*0.5544E+00,0.6078E+00,0.6680E+00,0.7357E+00,0.8118E+00,
*0.8976E+00,0.9943E+00,0.1103E+01,0.1226E+01,0.1365E+01,
*0.1521E+01,0.1696E+01,0.1894E+01,0.2117E+01,0.2367E+01,
*0.2647E+01,0.2962E+01,0.3313E+01,0.3704E+01,0.4138E+01,
*0.4618E+01,0.5146E+01,0.5724E+01,0.6352E+01,0.7029E+01,
*0.7752E+01,0.8518E+01,0.9322E+01,0.1017E+02,0.1106E+02,
*0.1207E+02,0.1326E+02,0.1392E+02 /
DATA ((PHR(i,j),j=1,83),i=12,12)/
*0.3186E+00,0.3148E+00,0.3016E+00,0.2834E+00,0.2641E+00,
*0.2469E+00,0.2333E+00,0.2235E+00,0.2168E+00,0.2118E+00,
*0.2076E+00,0.2036E+00,0.1995E+00,0.1952E+00,0.1909E+00,
*0.1865E+00,0.1823E+00,0.1783E+00,0.1747E+00,0.1715E+00,
*0.1688E+00,0.1666E+00,0.1650E+00,0.1640E+00,0.1637E+00,
*0.1639E+00,0.1649E+00,0.1665E+00,0.1688E+00,0.1720E+00,
*0.1760E+00,0.1808E+00,0.1866E+00,0.1934E+00,0.2012E+00,
*0.2102E+00,0.2205E+00,0.2323E+00,0.2455E+00,0.2605E+00,
*0.2773E+00,0.2865E+00,0.2963E+00,0.3177E+00,0.3417E+00,
*0.3687E+00,0.3989E+00,0.4328E+00,0.4709E+00,0.5136E+00,
*0.5616E+00,0.6156E+00,0.6763E+00,0.7446E+00,0.8214E+00,
*0.9078E+00,0.1005E+01,0.1115E+01,0.1238E+01,0.1376E+01,
*0.1533E+01,0.1708E+01,0.1906E+01,0.2128E+01,0.2377E+01,
*0.2656E+01,0.2968E+01,0.3315E+01,0.3702E+01,0.4130E+01,
*0.4602E+01,0.5120E+01,0.5686E+01,0.6298E+01,0.6956E+01,
*0.7656E+01,0.8395E+01,0.9171E+01,0.9985E+01,0.1085E+02,
*0.1183E+02,0.1296E+02,0.1358E+02 /
DATA ((PHR(i,j),j=1,83),i=13,13)/
*0.3108E+00,0.3076E+00,0.2963E+00,0.2807E+00,0.2639E+00,
*0.2484E+00,0.2357E+00,0.2264E+00,0.2198E+00,0.2147E+00,
*0.2103E+00,0.2061E+00,0.2020E+00,0.1978E+00,0.1936E+00,
*0.1895E+00,0.1856E+00,0.1820E+00,0.1786E+00,0.1757E+00,
*0.1733E+00,0.1714E+00,0.1700E+00,0.1692E+00,0.1690E+00,
*0.1694E+00,0.1705E+00,0.1724E+00,0.1749E+00,0.1783E+00,
*0.1824E+00,0.1874E+00,0.1934E+00,0.2005E+00,0.2086E+00,
*0.2180E+00,0.2286E+00,0.2407E+00,0.2545E+00,0.2701E+00,
*0.2876E+00,0.2972E+00,0.3073E+00,0.3293E+00,0.3541E+00,
*0.3819E+00,0.4131E+00,0.4481E+00,0.4874E+00,0.5314E+00,
*0.5807E+00,0.6361E+00,0.6982E+00,0.7679E+00,0.8462E+00,
*0.9340E+00,0.1033E+01,0.1143E+01,0.1268E+01,0.1407E+01,
*0.1564E+01,0.1740E+01,0.1936E+01,0.2156E+01,0.2402E+01,
*0.2676E+01,0.2981E+01,0.3319E+01,0.3693E+01,0.4104E+01,
*0.4556E+01,0.5048E+01,0.5581E+01,0.6154E+01,0.6766E+01,
*0.7412E+01,0.8090E+01,0.8797E+01,0.9536E+01,0.1032E+02,
*0.1120E+02,0.1220E+02,0.1271E+02 /
DATA ((PHR(i,j),j=1,83),i=14,14)/
*0.3172E+00,0.3140E+00,0.3035E+00,0.2893E+00,0.2739E+00,
*0.2593E+00,0.2471E+00,0.2379E+00,0.2310E+00,0.2253E+00,
*0.2203E+00,0.2156E+00,0.2110E+00,0.2065E+00,0.2022E+00,
*0.1981E+00,0.1942E+00,0.1907E+00,0.1875E+00,0.1847E+00,
*0.1824E+00,0.1806E+00,0.1793E+00,0.1786E+00,0.1785E+00,
*0.1791E+00,0.1804E+00,0.1824E+00,0.1851E+00,0.1886E+00,
*0.1930E+00,0.1982E+00,0.2045E+00,0.2119E+00,0.2205E+00,
*0.2303E+00,0.2414E+00,0.2542E+00,0.2686E+00,0.2849E+00,
*0.3032E+00,0.3133E+00,0.3239E+00,0.3469E+00,0.3728E+00,
*0.4017E+00,0.4343E+00,0.4707E+00,0.5115E+00,0.5570E+00,
*0.6080E+00,0.6651E+00,0.7289E+00,0.8003E+00,0.8802E+00,
*0.9697E+00,0.1070E+01,0.1182E+01,0.1307E+01,0.1447E+01,
*0.1603E+01,0.1777E+01,0.1970E+01,0.2186E+01,0.2426E+01,
*0.2691E+01,0.2984E+01,0.3308E+01,0.3662E+01,0.4050E+01,
*0.4472E+01,0.4927E+01,0.5417E+01,0.5939E+01,0.6490E+01,
*0.7069E+01,0.7672E+01,0.8297E+01,0.8950E+01,0.9647E+01,
*0.1042E+02,0.1126E+02,0.1165E+02 /
DATA ((PHR(i,j),j=1,83),i=15,15)/
*0.3355E+00,0.3327E+00,0.3233E+00,0.3114E+00,0.2995E+00,
*0.2889E+00,0.2799E+00,0.2725E+00,0.2664E+00,0.2611E+00,
*0.2560E+00,0.2509E+00,0.2459E+00,0.2412E+00,0.2367E+00,
*0.2326E+00,0.2287E+00,0.2253E+00,0.2223E+00,0.2197E+00,
*0.2176E+00,0.2160E+00,0.2150E+00,0.2145E+00,0.2147E+00,
*0.2156E+00,0.2171E+00,0.2193E+00,0.2224E+00,0.2264E+00,
*0.2313E+00,0.2373E+00,0.2444E+00,0.2526E+00,0.2622E+00,
*0.2733E+00,0.2859E+00,0.3002E+00,0.3164E+00,0.3346E+00,
*0.3552E+00,0.3664E+00,0.3782E+00,0.4040E+00,0.4329E+00,
*0.4650E+00,0.5009E+00,0.5408E+00,0.5851E+00,0.6343E+00,
*0.6890E+00,0.7496E+00,0.8170E+00,0.8915E+00,0.9741E+00,
*0.1065E+01,0.1166E+01,0.1277E+01,0.1400E+01,0.1536E+01,
*0.1685E+01,0.1848E+01,0.2028E+01,0.2224E+01,0.2439E+01,
*0.2673E+01,0.2927E+01,0.3201E+01,0.3497E+01,0.3815E+01,
*0.4154E+01,0.4515E+01,0.4896E+01,0.5296E+01,0.5714E+01,
*0.6150E+01,0.6604E+01,0.7079E+01,0.7583E+01,0.8128E+01,
*0.8710E+01,0.9260E+01,0.9472E+01 /
DATA ((PHR(i,j),j=1,83),i=16,16)/
*0.2986E+00,0.2970E+00,0.2925E+00,0.2886E+00,0.2868E+00,
*0.2865E+00,0.2862E+00,0.2849E+00,0.2824E+00,0.2789E+00,
*0.2746E+00,0.2696E+00,0.2644E+00,0.2592E+00,0.2541E+00,
*0.2492E+00,0.2446E+00,0.2403E+00,0.2364E+00,0.2329E+00,
*0.2299E+00,0.2274E+00,0.2253E+00,0.2238E+00,0.2229E+00,
*0.2226E+00,0.2229E+00,0.2239E+00,0.2258E+00,0.2284E+00,
*0.2320E+00,0.2365E+00,0.2421E+00,0.2488E+00,0.2568E+00,
*0.2662E+00,0.2772E+00,0.2898E+00,0.3042E+00,0.3207E+00,
*0.3395E+00,0.3497E+00,0.3606E+00,0.3844E+00,0.4113E+00,
*0.4415E+00,0.4752E+00,0.5129E+00,0.5551E+00,0.6021E+00,
*0.6544E+00,0.7126E+00,0.7774E+00,0.8494E+00,0.9292E+00,
*0.1018E+01,0.1116E+01,0.1225E+01,0.1345E+01,0.1478E+01,
*0.1625E+01,0.1788E+01,0.1967E+01,0.2164E+01,0.2380E+01,
*0.2618E+01,0.2879E+01,0.3164E+01,0.3475E+01,0.3814E+01,
*0.4181E+01,0.4578E+01,0.5006E+01,0.5466E+01,0.5960E+01,
*0.6490E+01,0.7058E+01,0.7669E+01,0.8329E+01,0.9041E+01,
*0.9780E+01,0.1043E+02,0.1066E+02 /
DATA ((PHR(i,j),j=1,83),i=17,17)/
*0.3040E+00,0.3027E+00,0.2989E+00,0.2955E+00,0.2941E+00,
*0.2941E+00,0.2940E+00,0.2929E+00,0.2906E+00,0.2870E+00,
*0.2828E+00,0.2783E+00,0.2735E+00,0.2686E+00,0.2637E+00,
*0.2588E+00,0.2543E+00,0.2501E+00,0.2461E+00,0.2426E+00,
*0.2394E+00,0.2367E+00,0.2344E+00,0.2326E+00,0.2315E+00,
*0.2308E+00,0.2309E+00,0.2316E+00,0.2331E+00,0.2354E+00,
*0.2386E+00,0.2427E+00,0.2479E+00,0.2543E+00,0.2619E+00,
*0.2709E+00,0.2814E+00,0.2936E+00,0.3077E+00,0.3237E+00,
*0.3419E+00,0.3519E+00,0.3626E+00,0.3860E+00,0.4123E+00,
*0.4418E+00,0.4750E+00,0.5120E+00,0.5534E+00,0.5996E+00,
*0.6511E+00,0.7084E+00,0.7719E+00,0.8426E+00,0.9211E+00,
*0.1008E+01,0.1105E+01,0.1211E+01,0.1329E+01,0.1460E+01,
*0.1604E+01,0.1764E+01,0.1940E+01,0.2134E+01,0.2348E+01,
*0.2583E+01,0.2842E+01,0.3125E+01,0.3436E+01,0.3776E+01,
*0.4146E+01,0.4550E+01,0.4989E+01,0.5464E+01,0.5978E+01,
*0.6535E+01,0.7138E+01,0.7793E+01,0.8502E+01,0.9258E+01,
*0.1003E+02,0.1069E+02,0.1091E+02 /
DATA ((PHR(i,j),j=1,83),i=18,18)/
*0.3020E+00,0.3011E+00,0.2986E+00,0.2971E+00,0.2968E+00,
*0.2964E+00,0.2950E+00,0.2928E+00,0.2901E+00,0.2870E+00,
*0.2837E+00,0.2804E+00,0.2771E+00,0.2737E+00,0.2704E+00,
*0.2671E+00,0.2638E+00,0.2605E+00,0.2574E+00,0.2543E+00,
*0.2515E+00,0.2488E+00,0.2464E+00,0.2444E+00,0.2427E+00,
*0.2414E+00,0.2407E+00,0.2405E+00,0.2409E+00,0.2420E+00,
*0.2439E+00,0.2466E+00,0.2503E+00,0.2549E+00,0.2607E+00,
*0.2678E+00,0.2762E+00,0.2861E+00,0.2977E+00,0.3111E+00,
*0.3266E+00,0.3351E+00,0.3442E+00,0.3643E+00,0.3871E+00,
*0.4128E+00,0.4418E+00,0.4743E+00,0.5109E+00,0.5517E+00,
*0.5974E+00,0.6483E+00,0.7051E+00,0.7684E+00,0.8389E+00,
*0.9173E+00,0.1004E+01,0.1102E+01,0.1209E+01,0.1330E+01,
*0.1464E+01,0.1613E+01,0.1780E+01,0.1966E+01,0.2174E+01,
*0.2408E+01,0.2671E+01,0.2967E+01,0.3301E+01,0.3679E+01,
*0.4109E+01,0.4597E+01,0.5153E+01,0.5786E+01,0.6507E+01,
*0.7327E+01,0.8254E+01,0.9293E+01,0.1044E+02,0.1166E+02,
*0.1287E+02,0.1383E+02,0.1415E+02 /
DATA ((PHR(i,j),j=1,83),i=19,19)/
*0.3020E+00,0.3015E+00,0.3003E+00,0.2996E+00,0.2990E+00,
*0.2979E+00,0.2962E+00,0.2942E+00,0.2919E+00,0.2895E+00,
*0.2869E+00,0.2842E+00,0.2814E+00,0.2785E+00,0.2757E+00,
*0.2728E+00,0.2699E+00,0.2670E+00,0.2643E+00,0.2615E+00,
*0.2590E+00,0.2565E+00,0.2542E+00,0.2522E+00,0.2504E+00,
*0.2490E+00,0.2479E+00,0.2473E+00,0.2472E+00,0.2477E+00,
*0.2488E+00,0.2507E+00,0.2534E+00,0.2570E+00,0.2616E+00,
*0.2673E+00,0.2743E+00,0.2826E+00,0.2925E+00,0.3040E+00,
*0.3173E+00,0.3247E+00,0.3327E+00,0.3502E+00,0.3702E+00,
*0.3928E+00,0.4183E+00,0.4471E+00,0.4794E+00,0.5156E+00,
*0.5562E+00,0.6014E+00,0.6520E+00,0.7083E+00,0.7711E+00,
*0.8412E+00,0.9192E+00,0.1006E+01,0.1104E+01,0.1212E+01,
*0.1334E+01,0.1471E+01,0.1625E+01,0.1799E+01,0.1996E+01,
*0.2221E+01,0.2479E+01,0.2776E+01,0.3120E+01,0.3521E+01,
*0.3991E+01,0.4547E+01,0.5206E+01,0.5990E+01,0.6924E+01,
*0.8032E+01,0.9334E+01,0.1084E+02,0.1253E+02,0.1434E+02,
*0.1609E+02,0.1744E+02,0.1785E+02 /
DATA ((PHR(i,j),j=1,83),i=20,20)/
*0.3991E+00,0.3988E+00,0.3978E+00,0.3964E+00,0.3948E+00,
*0.3929E+00,0.3906E+00,0.3879E+00,0.3847E+00,0.3812E+00,
*0.3773E+00,0.3732E+00,0.3689E+00,0.3645E+00,0.3599E+00,
*0.3552E+00,0.3504E+00,0.3457E+00,0.3409E+00,0.3363E+00,
*0.3317E+00,0.3274E+00,0.3232E+00,0.3193E+00,0.3157E+00,
*0.3125E+00,0.3098E+00,0.3076E+00,0.3059E+00,0.3049E+00,
*0.3047E+00,0.3053E+00,0.3067E+00,0.3092E+00,0.3128E+00,
*0.3175E+00,0.3236E+00,0.3312E+00,0.3403E+00,0.3511E+00,
*0.3638E+00,0.3709E+00,0.3786E+00,0.3955E+00,0.4149E+00,
*0.4369E+00,0.4618E+00,0.4899E+00,0.5214E+00,0.5566E+00,
*0.5960E+00,0.6400E+00,0.6890E+00,0.7437E+00,0.8045E+00,
*0.8724E+00,0.9480E+00,0.1033E+01,0.1127E+01,0.1233E+01,
*0.1352E+01,0.1485E+01,0.1636E+01,0.1807E+01,0.2001E+01,
*0.2222E+01,0.2475E+01,0.2764E+01,0.3097E+01,0.3479E+01,
*0.3919E+01,0.4426E+01,0.5008E+01,0.5672E+01,0.6425E+01,
*0.7267E+01,0.8194E+01,0.9184E+01,0.1020E+02,0.1118E+02,
*0.1203E+02,0.1261E+02,0.1277E+02 /
c************** MIE (phase fun qh) ***************
DATA ((QHR(i,j),j=1,83),i= 1, 1)/
* 0.3388E-22, 0.2705E-02, 0.1324E-01, 0.2911E-01, 0.4717E-01,
* 0.6492E-01, 0.8049E-01, 0.9251E-01, 0.1002E+00, 0.1033E+00,
* 0.1023E+00, 0.9820E-01, 0.9197E-01, 0.8458E-01, 0.7677E-01,
* 0.6906E-01, 0.6178E-01, 0.5510E-01, 0.4908E-01, 0.4371E-01,
* 0.3894E-01, 0.3476E-01, 0.3108E-01, 0.2789E-01, 0.2512E-01,
* 0.2270E-01, 0.2055E-01, 0.1865E-01, 0.1696E-01, 0.1549E-01,
* 0.1422E-01, 0.1313E-01, 0.1218E-01, 0.1132E-01, 0.1057E-01,
* 0.9939E-02, 0.9418E-02, 0.9008E-02, 0.8688E-02, 0.8454E-02,
* 0.8315E-02, 0.8279E-02, 0.8274E-02, 0.8317E-02, 0.8427E-02,
* 0.8611E-02, 0.8898E-02, 0.9317E-02, 0.9885E-02, 0.1060E-01,
* 0.1144E-01, 0.1236E-01, 0.1335E-01, 0.1448E-01, 0.1579E-01,
* 0.1730E-01, 0.1901E-01, 0.2089E-01, 0.2289E-01, 0.2500E-01,
* 0.2724E-01, 0.2958E-01, 0.3201E-01, 0.3457E-01, 0.3722E-01,
* 0.3991E-01, 0.4262E-01, 0.4526E-01, 0.4769E-01, 0.4990E-01,
* 0.5190E-01, 0.5358E-01, 0.5490E-01, 0.5561E-01, 0.5517E-01,
* 0.5310E-01, 0.4897E-01, 0.4243E-01, 0.3358E-01, 0.2348E-01,
* 0.1324E-01, 0.4093E-02, 0.2630E-19 /
DATA ((QHR(i,j),j=1,83),i= 2, 2)/
* 0.4524E-21, 0.2675E-02, 0.1299E-01, 0.2843E-01, 0.4600E-01,
* 0.6326E-01, 0.7840E-01, 0.9019E-01, 0.9788E-01, 0.1013E+00,
* 0.1007E+00, 0.9713E-01, 0.9141E-01, 0.8445E-01, 0.7692E-01,
* 0.6936E-01, 0.6210E-01, 0.5530E-01, 0.4908E-01, 0.4347E-01,
* 0.3845E-01, 0.3399E-01, 0.3003E-01, 0.2650E-01, 0.2336E-01,
* 0.2058E-01, 0.1810E-01, 0.1588E-01, 0.1389E-01, 0.1210E-01,
* 0.1049E-01, 0.9040E-02, 0.7753E-02, 0.6579E-02, 0.5498E-02,
* 0.4519E-02, 0.3644E-02, 0.2878E-02, 0.2215E-02, 0.1623E-02,
* 0.1075E-02, 0.8190E-03, 0.5775E-03, 0.1801E-03,-0.7529E-04,
*-0.2034E-03,-0.2525E-03,-0.2500E-03,-0.1807E-03,-0.4815E-05,
* 0.3298E-03, 0.8693E-03, 0.1601E-02, 0.2449E-02, 0.3380E-02,
* 0.4453E-02, 0.5747E-02, 0.7287E-02, 0.9066E-02, 0.1106E-01,
* 0.1320E-01, 0.1545E-01, 0.1787E-01, 0.2050E-01, 0.2332E-01,
* 0.2633E-01, 0.2944E-01, 0.3244E-01, 0.3529E-01, 0.3801E-01,
* 0.4048E-01, 0.4266E-01, 0.4448E-01, 0.4553E-01, 0.4543E-01,
* 0.4400E-01, 0.4066E-01, 0.3529E-01, 0.2826E-01, 0.1954E-01,
* 0.1043E-01, 0.3119E-02, 0.8522E-20 /
DATA ((QHR(i,j),j=1,83),i= 3, 3)/
* 0.1156E-20, 0.2647E-02, 0.1288E-01, 0.2824E-01, 0.4582E-01,
* 0.6312E-01, 0.7832E-01, 0.9019E-01, 0.9795E-01, 0.1013E+00,
* 0.1008E+00, 0.9717E-01, 0.9146E-01, 0.8452E-01, 0.7705E-01,
* 0.6952E-01, 0.6226E-01, 0.5544E-01, 0.4917E-01, 0.4350E-01,
* 0.3843E-01, 0.3390E-01, 0.2987E-01, 0.2624E-01, 0.2298E-01,
* 0.2005E-01, 0.1747E-01, 0.1518E-01, 0.1315E-01, 0.1131E-01,
* 0.9615E-02, 0.8054E-02, 0.6657E-02, 0.5420E-02, 0.4300E-02,
* 0.3277E-02, 0.2335E-02, 0.1467E-02, 0.6896E-03, 0.8981E-07,
*-0.6248E-03,-0.9151E-03,-0.1198E-02,-0.1684E-02,-0.2032E-02,
*-0.2242E-02,-0.2364E-02,-0.2436E-02,-0.2463E-02,-0.2424E-02,
*-0.2243E-02,-0.1825E-02,-0.1160E-02,-0.3305E-03, 0.5932E-03,
* 0.1609E-02, 0.2774E-02, 0.4151E-02, 0.5802E-02, 0.7710E-02,
* 0.9820E-02, 0.1213E-01, 0.1464E-01, 0.1728E-01, 0.2005E-01,
* 0.2297E-01, 0.2595E-01, 0.2892E-01, 0.3194E-01, 0.3488E-01,
* 0.3759E-01, 0.4001E-01, 0.4182E-01, 0.4259E-01, 0.4208E-01,
* 0.4009E-01, 0.3629E-01, 0.3098E-01, 0.2458E-01, 0.1666E-01,
* 0.8573E-02, 0.2603E-02, 0.2928E-19 /
DATA ((QHR(i,j),j=1,83),i= 4, 4)/
*-0.4206E-21, 0.2749E-02, 0.1315E-01, 0.2850E-01, 0.4587E-01,
* 0.6291E-01, 0.7786E-01, 0.8953E-01, 0.9722E-01, 0.1007E+00,
* 0.1003E+00, 0.9695E-01, 0.9147E-01, 0.8470E-01, 0.7729E-01,
* 0.6979E-01, 0.6249E-01, 0.5559E-01, 0.4919E-01, 0.4336E-01,
* 0.3811E-01, 0.3340E-01, 0.2917E-01, 0.2535E-01, 0.2190E-01,
* 0.1881E-01, 0.1603E-01, 0.1352E-01, 0.1125E-01, 0.9161E-02,
* 0.7240E-02, 0.5479E-02, 0.3894E-02, 0.2435E-02, 0.1059E-02,
*-0.2257E-03,-0.1414E-02,-0.2500E-02,-0.3482E-02,-0.4388E-02,
*-0.5269E-02,-0.5701E-02,-0.6128E-02,-0.6891E-02,-0.7481E-02,
*-0.7917E-02,-0.8283E-02,-0.8634E-02,-0.8953E-02,-0.9183E-02,
*-0.9235E-02,-0.9017E-02,-0.8550E-02,-0.7968E-02,-0.7338E-02,
*-0.6589E-02,-0.5593E-02,-0.4297E-02,-0.2697E-02,-0.8211E-03,
* 0.1227E-02, 0.3444E-02, 0.5887E-02, 0.8595E-02, 0.1154E-01,
* 0.1478E-01, 0.1818E-01, 0.2150E-01, 0.2474E-01, 0.2793E-01,
* 0.3089E-01, 0.3357E-01, 0.3595E-01, 0.3750E-01, 0.3791E-01,
* 0.3714E-01, 0.3449E-01, 0.3004E-01, 0.2432E-01, 0.1679E-01,
* 0.8710E-02, 0.2571E-02, 0.2363E-19 /
DATA ((QHR(i,j),j=1,83),i= 5, 5)/
*-0.4642E-22, 0.2556E-02, 0.1228E-01, 0.2679E-01, 0.4345E-01,
* 0.6001E-01, 0.7472E-01, 0.8634E-01, 0.9402E-01, 0.9753E-01,
* 0.9730E-01, 0.9412E-01, 0.8888E-01, 0.8243E-01, 0.7540E-01,
* 0.6823E-01, 0.6118E-01, 0.5445E-01, 0.4815E-01, 0.4235E-01,
* 0.3707E-01, 0.3226E-01, 0.2790E-01, 0.2393E-01, 0.2031E-01,
* 0.1701E-01, 0.1404E-01, 0.1136E-01, 0.8930E-02, 0.6697E-02,
* 0.4618E-02, 0.2658E-02, 0.8311E-03,-0.8244E-03,-0.2341E-02,
*-0.3768E-02,-0.5133E-02,-0.6448E-02,-0.7699E-02,-0.8860E-02,
*-0.9916E-02,-0.1041E-01,-0.1088E-01,-0.1179E-01,-0.1266E-01,
*-0.1345E-01,-0.1412E-01,-0.1469E-01,-0.1514E-01,-0.1550E-01,
*-0.1578E-01,-0.1594E-01,-0.1592E-01,-0.1563E-01,-0.1510E-01,
*-0.1440E-01,-0.1360E-01,-0.1263E-01,-0.1141E-01,-0.9913E-02,
*-0.8059E-02,-0.5823E-02,-0.3285E-02,-0.5974E-03, 0.2233E-02,
* 0.5150E-02, 0.8199E-02, 0.1154E-01, 0.1528E-01, 0.1913E-01,
* 0.2285E-01, 0.2626E-01, 0.2879E-01, 0.3028E-01, 0.3065E-01,
* 0.2939E-01, 0.2662E-01, 0.2267E-01, 0.1759E-01, 0.1192E-01,
* 0.6591E-02, 0.2086E-02, 0.2318E-19 /
DATA ((QHR(i,j),j=1,83),i= 6, 6)/
* 0.1625E-22, 0.2573E-02, 0.1220E-01, 0.2625E-01, 0.4214E-01,
* 0.5787E-01, 0.7184E-01, 0.8289E-01, 0.9034E-01, 0.9399E-01,
* 0.9414E-01, 0.9147E-01, 0.8675E-01, 0.8068E-01, 0.7386E-01,
* 0.6680E-01, 0.5986E-01, 0.5322E-01, 0.4700E-01, 0.4123E-01,
* 0.3592E-01, 0.3107E-01, 0.2665E-01, 0.2265E-01, 0.1904E-01,
* 0.1576E-01, 0.1275E-01, 0.9934E-02, 0.7307E-02, 0.4879E-02,
* 0.2661E-02, 0.6367E-03,-0.1255E-02,-0.3091E-02,-0.4850E-02,
*-0.6497E-02,-0.8032E-02,-0.9461E-02,-0.1081E-01,-0.1211E-01,
*-0.1337E-01,-0.1398E-01,-0.1457E-01,-0.1566E-01,-0.1668E-01,
*-0.1763E-01,-0.1853E-01,-0.1934E-01,-0.2002E-01,-0.2054E-01,
*-0.2091E-01,-0.2115E-01,-0.2127E-01,-0.2128E-01,-0.2112E-01,
*-0.2072E-01,-0.1999E-01,-0.1894E-01,-0.1763E-01,-0.1604E-01,
*-0.1424E-01,-0.1226E-01,-0.1000E-01,-0.7301E-02,-0.4210E-02,
*-0.7418E-03, 0.3032E-02, 0.6862E-02, 0.1054E-01, 0.1419E-01,
* 0.1776E-01, 0.2117E-01, 0.2459E-01, 0.2764E-01, 0.2974E-01,
* 0.3066E-01, 0.2970E-01, 0.2647E-01, 0.2148E-01, 0.1532E-01,
* 0.8717E-02, 0.2570E-02, 0.2508E-19 /
DATA ((QHR(i,j),j=1,83),i= 7, 7)/
* 0.5125E-21, 0.2459E-02, 0.1162E-01, 0.2501E-01, 0.4023E-01,
* 0.5535E-01, 0.6887E-01, 0.7967E-01, 0.8708E-01, 0.9086E-01,
* 0.9122E-01, 0.8882E-01, 0.8440E-01, 0.7862E-01, 0.7208E-01,
* 0.6526E-01, 0.5848E-01, 0.5192E-01, 0.4570E-01, 0.3991E-01,
* 0.3457E-01, 0.2967E-01, 0.2519E-01, 0.2107E-01, 0.1728E-01,
* 0.1382E-01, 0.1064E-01, 0.7682E-02, 0.4928E-02, 0.2351E-02,
*-0.6637E-04,-0.2319E-02,-0.4410E-02,-0.6406E-02,-0.8340E-02,
*-0.1019E-01,-0.1195E-01,-0.1361E-01,-0.1518E-01,-0.1668E-01,
*-0.1818E-01,-0.1892E-01,-0.1966E-01,-0.2106E-01,-0.2230E-01,
*-0.2341E-01,-0.2447E-01,-0.2552E-01,-0.2651E-01,-0.2740E-01,
*-0.2810E-01,-0.2856E-01,-0.2879E-01,-0.2890E-01,-0.2894E-01,
*-0.2880E-01,-0.2833E-01,-0.2751E-01,-0.2636E-01,-0.2487E-01,
*-0.2313E-01,-0.2114E-01,-0.1883E-01,-0.1609E-01,-0.1296E-01,
*-0.9384E-02,-0.5490E-02,-0.1521E-02, 0.2468E-02, 0.6546E-02,
* 0.1053E-01, 0.1434E-01, 0.1803E-01, 0.2113E-01, 0.2331E-01,
* 0.2455E-01, 0.2408E-01, 0.2180E-01, 0.1828E-01, 0.1307E-01,
* 0.7038E-02, 0.2041E-02, 0.1995E-19 /
DATA ((QHR(i,j),j=1,83),i= 8, 8)/
*-0.3431E-22, 0.2397E-02, 0.1118E-01, 0.2394E-01, 0.3859E-01,
* 0.5328E-01, 0.6650E-01, 0.7715E-01, 0.8439E-01, 0.8803E-01,
* 0.8844E-01, 0.8620E-01, 0.8197E-01, 0.7644E-01, 0.7019E-01,
* 0.6359E-01, 0.5697E-01, 0.5056E-01, 0.4446E-01, 0.3871E-01,
* 0.3329E-01, 0.2823E-01, 0.2353E-01, 0.1923E-01, 0.1528E-01,
* 0.1161E-01, 0.8164E-02, 0.4941E-02, 0.1932E-02,-0.8723E-03,
*-0.3485E-02,-0.5947E-02,-0.8331E-02,-0.1062E-01,-0.1279E-01,
*-0.1487E-01,-0.1687E-01,-0.1880E-01,-0.2068E-01,-0.2250E-01,
*-0.2423E-01,-0.2505E-01,-0.2585E-01,-0.2742E-01,-0.2903E-01,
*-0.3062E-01,-0.3210E-01,-0.3340E-01,-0.3454E-01,-0.3552E-01,
*-0.3636E-01,-0.3719E-01,-0.3801E-01,-0.3861E-01,-0.3884E-01,
*-0.3868E-01,-0.3827E-01,-0.3766E-01,-0.3684E-01,-0.3575E-01,
*-0.3421E-01,-0.3221E-01,-0.2979E-01,-0.2700E-01,-0.2382E-01,
*-0.2038E-01,-0.1664E-01,-0.1243E-01,-0.7940E-02,-0.3224E-02,
* 0.1704E-02, 0.6477E-02, 0.1076E-01, 0.1462E-01, 0.1760E-01,
* 0.1876E-01, 0.1840E-01, 0.1628E-01, 0.1222E-01, 0.9020E-02,
* 0.6669E-02, 0.2401E-02,-0.4543E-20 /
DATA ((QHR(i,j),j=1,83),i= 9, 9)/
* 0.5428E-21, 0.2160E-02, 0.1018E-01, 0.2199E-01, 0.3564E-01,
* 0.4949E-01, 0.6216E-01, 0.7251E-01, 0.7971E-01, 0.8344E-01,
* 0.8402E-01, 0.8198E-01, 0.7805E-01, 0.7290E-01, 0.6704E-01,
* 0.6082E-01, 0.5446E-01, 0.4816E-01, 0.4206E-01, 0.3627E-01,
* 0.3084E-01, 0.2575E-01, 0.2099E-01, 0.1652E-01, 0.1233E-01,
* 0.8374E-02, 0.4708E-02, 0.1307E-02,-0.1890E-02,-0.4921E-02,
*-0.7821E-02,-0.1063E-01,-0.1333E-01,-0.1588E-01,-0.1830E-01,
*-0.2066E-01,-0.2297E-01,-0.2525E-01,-0.2748E-01,-0.2965E-01,
*-0.3172E-01,-0.3272E-01,-0.3372E-01,-0.3568E-01,-0.3761E-01,
*-0.3945E-01,-0.4119E-01,-0.4283E-01,-0.4435E-01,-0.4579E-01,
*-0.4714E-01,-0.4834E-01,-0.4932E-01,-0.4999E-01,-0.5036E-01,
*-0.5054E-01,-0.5054E-01,-0.5029E-01,-0.4966E-01,-0.4864E-01,
*-0.4712E-01,-0.4506E-01,-0.4254E-01,-0.3967E-01,-0.3646E-01,
*-0.3293E-01,-0.2902E-01,-0.2457E-01,-0.1945E-01,-0.1405E-01,
*-0.8622E-02,-0.3265E-02, 0.1392E-02, 0.5168E-02, 0.8102E-02,
* 0.9738E-02, 0.1022E-01, 0.9905E-02, 0.8604E-02, 0.6227E-02,
* 0.3512E-02, 0.1108E-02, 0.1924E-19 /
DATA ((QHR(i,j),j=1,83),i=10,10)/
*-0.3477E-21, 0.2034E-02, 0.9499E-02, 0.2036E-01, 0.3281E-01,
* 0.4547E-01, 0.5712E-01, 0.6669E-01, 0.7353E-01, 0.7731E-01,
* 0.7815E-01, 0.7657E-01, 0.7319E-01, 0.6854E-01, 0.6305E-01,
* 0.5711E-01, 0.5099E-01, 0.4485E-01, 0.3885E-01, 0.3311E-01,
* 0.2767E-01, 0.2255E-01, 0.1772E-01, 0.1313E-01, 0.8757E-02,
* 0.4622E-02, 0.7392E-03,-0.2913E-02,-0.6355E-02,-0.9660E-02,
*-0.1289E-01,-0.1603E-01,-0.1901E-01,-0.2186E-01,-0.2463E-01,
*-0.2736E-01,-0.3004E-01,-0.3268E-01,-0.3525E-01,-0.3774E-01,
*-0.4020E-01,-0.4143E-01,-0.4268E-01,-0.4512E-01,-0.4739E-01,
*-0.4951E-01,-0.5156E-01,-0.5360E-01,-0.5561E-01,-0.5757E-01,
*-0.5935E-01,-0.6080E-01,-0.6189E-01,-0.6279E-01,-0.6358E-01,
*-0.6419E-01,-0.6450E-01,-0.6438E-01,-0.6376E-01,-0.6267E-01,
*-0.6117E-01,-0.5918E-01,-0.5666E-01,-0.5367E-01,-0.5018E-01,
*-0.4604E-01,-0.4141E-01,-0.3642E-01,-0.3102E-01,-0.2535E-01,
*-0.1955E-01,-0.1368E-01,-0.7927E-02,-0.2870E-02, 0.1242E-02,
* 0.4428E-02, 0.6122E-02, 0.6821E-02, 0.7160E-02, 0.5520E-02,
* 0.2549E-02, 0.8291E-03,-0.1758E-19 /
DATA ((QHR(i,j),j=1,83),i=11,11)/
* 0.8851E-21, 0.1859E-02, 0.8720E-02, 0.1878E-01, 0.3043E-01,
* 0.4237E-01, 0.5343E-01, 0.6265E-01, 0.6924E-01, 0.7287E-01,
* 0.7377E-01, 0.7232E-01, 0.6910E-01, 0.6470E-01, 0.5955E-01,
* 0.5392E-01, 0.4805E-01, 0.4211E-01, 0.3624E-01, 0.3055E-01,
* 0.2510E-01, 0.1989E-01, 0.1493E-01, 0.1020E-01, 0.5681E-02,
* 0.1362E-02,-0.2723E-02,-0.6589E-02,-0.1029E-01,-0.1385E-01,
*-0.1729E-01,-0.2066E-01,-0.2394E-01,-0.2709E-01,-0.3014E-01,
*-0.3314E-01,-0.3610E-01,-0.3903E-01,-0.4192E-01,-0.4476E-01,
*-0.4752E-01,-0.4886E-01,-0.5020E-01,-0.5284E-01,-0.5546E-01,
*-0.5801E-01,-0.6046E-01,-0.6278E-01,-0.6498E-01,-0.6706E-01,
*-0.6903E-01,-0.7085E-01,-0.7245E-01,-0.7371E-01,-0.7462E-01,
*-0.7526E-01,-0.7566E-01,-0.7574E-01,-0.7537E-01,-0.7453E-01,
*-0.7312E-01,-0.7107E-01,-0.6842E-01,-0.6529E-01,-0.6165E-01,
*-0.5757E-01,-0.5295E-01,-0.4765E-01,-0.4154E-01,-0.3501E-01,
*-0.2830E-01,-0.2156E-01,-0.1537E-01,-0.9855E-02,-0.4989E-02,
*-0.1263E-02, 0.1438E-02, 0.3321E-02, 0.4031E-02, 0.3630E-02,
* 0.2530E-02, 0.8873E-03, 0.1537E-19 /
DATA ((QHR(i,j),j=1,83),i=12,12)/
*-0.1670E-21, 0.1944E-02, 0.8894E-02, 0.1865E-01, 0.2968E-01,
* 0.4087E-01, 0.5121E-01, 0.5986E-01, 0.6614E-01, 0.6972E-01,
* 0.7074E-01, 0.6963E-01, 0.6680E-01, 0.6265E-01, 0.5758E-01,
* 0.5196E-01, 0.4612E-01, 0.4027E-01, 0.3450E-01, 0.2886E-01,
* 0.2337E-01, 0.1809E-01, 0.1304E-01, 0.8231E-02, 0.3693E-02,
*-0.6171E-03,-0.4788E-02,-0.8846E-02,-0.1278E-01,-0.1657E-01,
*-0.2018E-01,-0.2364E-01,-0.2705E-01,-0.3045E-01,-0.3378E-01,
*-0.3701E-01,-0.4015E-01,-0.4324E-01,-0.4629E-01,-0.4933E-01,
*-0.5233E-01,-0.5380E-01,-0.5523E-01,-0.5803E-01,-0.6083E-01,
*-0.6364E-01,-0.6638E-01,-0.6896E-01,-0.7134E-01,-0.7353E-01,
*-0.7556E-01,-0.7749E-01,-0.7926E-01,-0.8082E-01,-0.8205E-01,
*-0.8287E-01,-0.8326E-01,-0.8319E-01,-0.8271E-01,-0.8176E-01,
*-0.8032E-01,-0.7839E-01,-0.7590E-01,-0.7263E-01,-0.6863E-01,
*-0.6393E-01,-0.5859E-01,-0.5273E-01,-0.4664E-01,-0.4024E-01,
*-0.3349E-01,-0.2651E-01,-0.1924E-01,-0.1195E-01,-0.5381E-02,
* 0.1154E-03, 0.4222E-02, 0.6402E-02, 0.6872E-02, 0.6538E-02,
* 0.5064E-02, 0.1805E-02, 0.9720E-20 /
DATA ((QHR(i,j),j=1,83),i=13,13)/
* 0.5713E-21, 0.1640E-02, 0.7646E-02, 0.1635E-01, 0.2638E-01,
* 0.3671E-01, 0.4640E-01, 0.5457E-01, 0.6050E-01, 0.6385E-01,
* 0.6477E-01, 0.6359E-01, 0.6079E-01, 0.5688E-01, 0.5218E-01,
* 0.4696E-01, 0.4140E-01, 0.3567E-01, 0.2990E-01, 0.2421E-01,
* 0.1867E-01, 0.1328E-01, 0.8065E-02, 0.3014E-02,-0.1891E-02,
*-0.6651E-02,-0.1122E-01,-0.1560E-01,-0.1985E-01,-0.2400E-01,
*-0.2805E-01,-0.3205E-01,-0.3599E-01,-0.3980E-01,-0.4353E-01,
*-0.4721E-01,-0.5087E-01,-0.5451E-01,-0.5812E-01,-0.6167E-01,
*-0.6515E-01,-0.6685E-01,-0.6855E-01,-0.7192E-01,-0.7525E-01,
*-0.7848E-01,-0.8160E-01,-0.8460E-01,-0.8744E-01,-0.9016E-01,
*-0.9273E-01,-0.9511E-01,-0.9719E-01,-0.9889E-01,-0.1002E+00,
*-0.1012E+00,-0.1019E+00,-0.1022E+00,-0.1019E+00,-0.1010E+00,
*-0.9950E-01,-0.9723E-01,-0.9427E-01,-0.9069E-01,-0.8647E-01,
*-0.8165E-01,-0.7613E-01,-0.6981E-01,-0.6258E-01,-0.5483E-01,
*-0.4683E-01,-0.3863E-01,-0.3081E-01,-0.2360E-01,-0.1695E-01,
*-0.1129E-01,-0.6603E-02,-0.2679E-02, 0.6384E-04, 0.1208E-02,
* 0.1158E-02, 0.4679E-03, 0.3459E-20 /
DATA ((QHR(i,j),j=1,83),i=14,14)/
*-0.3391E-21, 0.1558E-02, 0.7150E-02, 0.1507E-01, 0.2396E-01,
* 0.3316E-01, 0.4196E-01, 0.4932E-01, 0.5460E-01, 0.5752E-01,
* 0.5818E-01, 0.5695E-01, 0.5431E-01, 0.5058E-01, 0.4604E-01,
* 0.4093E-01, 0.3542E-01, 0.2967E-01, 0.2380E-01, 0.1795E-01,
* 0.1220E-01, 0.6539E-02, 0.9936E-03,-0.4447E-02,-0.9836E-02,
*-0.1513E-01,-0.2026E-01,-0.2521E-01,-0.3004E-01,-0.3479E-01,
*-0.3953E-01,-0.4426E-01,-0.4888E-01,-0.5337E-01,-0.5779E-01,
*-0.6219E-01,-0.6658E-01,-0.7095E-01,-0.7529E-01,-0.7954E-01,
*-0.8370E-01,-0.8577E-01,-0.8785E-01,-0.9198E-01,-0.9597E-01,
*-0.9978E-01,-0.1035E+00,-0.1070E+00,-0.1105E+00,-0.1138E+00,
*-0.1170E+00,-0.1197E+00,-0.1220E+00,-0.1239E+00,-0.1254E+00,
*-0.1267E+00,-0.1275E+00,-0.1278E+00,-0.1273E+00,-0.1261E+00,
*-0.1242E+00,-0.1215E+00,-0.1180E+00,-0.1138E+00,-0.1089E+00,
*-0.1030E+00,-0.9632E-01,-0.8884E-01,-0.8055E-01,-0.7182E-01,
*-0.6271E-01,-0.5320E-01,-0.4376E-01,-0.3485E-01,-0.2659E-01,
*-0.1935E-01,-0.1351E-01,-0.8481E-02,-0.3919E-02,-0.2001E-02,
*-0.1903E-02,-0.4805E-03,-0.1251E-20 /
DATA ((QHR(i,j),j=1,83),i=15,15)/
*-0.1315E-21, 0.1259E-02, 0.5558E-02, 0.1106E-01, 0.1676E-01,
* 0.2214E-01, 0.2691E-01, 0.3081E-01, 0.3335E-01, 0.3421E-01,
* 0.3352E-01, 0.3156E-01, 0.2855E-01, 0.2461E-01, 0.1986E-01,
* 0.1447E-01, 0.8665E-02, 0.2619E-02,-0.3626E-02,-0.1010E-01,
*-0.1679E-01,-0.2363E-01,-0.3055E-01,-0.3751E-01,-0.4444E-01,
*-0.5139E-01,-0.5843E-01,-0.6553E-01,-0.7263E-01,-0.7968E-01,
*-0.8668E-01,-0.9364E-01,-0.1006E+00,-0.1076E+00,-0.1146E+00,
*-0.1215E+00,-0.1283E+00,-0.1350E+00,-0.1416E+00,-0.1482E+00,
*-0.1547E+00,-0.1578E+00,-0.1609E+00,-0.1670E+00,-0.1729E+00,
*-0.1787E+00,-0.1842E+00,-0.1893E+00,-0.1940E+00,-0.1983E+00,
*-0.2021E+00,-0.2055E+00,-0.2084E+00,-0.2109E+00,-0.2125E+00,
*-0.2132E+00,-0.2130E+00,-0.2120E+00,-0.2102E+00,-0.2075E+00,
*-0.2036E+00,-0.1986E+00,-0.1925E+00,-0.1852E+00,-0.1768E+00,
*-0.1672E+00,-0.1564E+00,-0.1447E+00,-0.1322E+00,-0.1193E+00,
*-0.1056E+00,-0.9127E-01,-0.7654E-01,-0.6181E-01,-0.4789E-01,
*-0.3535E-01,-0.2416E-01,-0.1481E-01,-0.7809E-02,-0.2425E-02,
* 0.7463E-03, 0.6630E-03,-0.2429E-19 /
DATA ((QHR(i,j),j=1,83),i=16,16)/
* 0.2669E-21, 0.2490E-03, 0.1557E-02, 0.3470E-02, 0.4990E-02,
* 0.5817E-02, 0.5650E-02, 0.4433E-02, 0.2410E-02,-0.3422E-03,
*-0.3735E-02,-0.7634E-02,-0.1195E-01,-0.1662E-01,-0.2170E-01,
*-0.2725E-01,-0.3320E-01,-0.3944E-01,-0.4594E-01,-0.5273E-01,
*-0.5979E-01,-0.6710E-01,-0.7461E-01,-0.8231E-01,-0.9016E-01,
*-0.9814E-01,-0.1063E+00,-0.1145E+00,-0.1230E+00,-0.1314E+00,
*-0.1400E+00,-0.1487E+00,-0.1574E+00,-0.1662E+00,-0.1749E+00,
*-0.1837E+00,-0.1925E+00,-0.2012E+00,-0.2099E+00,-0.2185E+00,
*-0.2270E+00,-0.2311E+00,-0.2352E+00,-0.2433E+00,-0.2512E+00,
*-0.2588E+00,-0.2660E+00,-0.2728E+00,-0.2792E+00,-0.2851E+00,
*-0.2903E+00,-0.2950E+00,-0.2989E+00,-0.3021E+00,-0.3043E+00,
*-0.3055E+00,-0.3056E+00,-0.3046E+00,-0.3023E+00,-0.2987E+00,
*-0.2936E+00,-0.2870E+00,-0.2790E+00,-0.2692E+00,-0.2577E+00,
*-0.2446E+00,-0.2300E+00,-0.2139E+00,-0.1965E+00,-0.1777E+00,
*-0.1578E+00,-0.1373E+00,-0.1168E+00,-0.9640E-01,-0.7634E-01,
*-0.5701E-01,-0.3961E-01,-0.2516E-01,-0.1338E-01,-0.5261E-02,
*-0.1734E-02,-0.3817E-03,-0.7847E-20 /
DATA ((QHR(i,j),j=1,83),i=17,17)/
* 0.3473E-21, 0.9441E-04, 0.6895E-03, 0.1715E-02, 0.2543E-02,
* 0.2424E-02, 0.1184E-02,-0.1028E-02,-0.3976E-02,-0.7404E-02,
*-0.1123E-01,-0.1541E-01,-0.1992E-01,-0.2481E-01,-0.3006E-01,
*-0.3562E-01,-0.4158E-01,-0.4796E-01,-0.5468E-01,-0.6169E-01,
*-0.6896E-01,-0.7648E-01,-0.8426E-01,-0.9226E-01,-0.1004E+00,
*-0.1088E+00,-0.1174E+00,-0.1261E+00,-0.1350E+00,-0.1440E+00,
*-0.1531E+00,-0.1622E+00,-0.1714E+00,-0.1807E+00,-0.1901E+00,
*-0.1994E+00,-0.2087E+00,-0.2180E+00,-0.2271E+00,-0.2362E+00,
*-0.2451E+00,-0.2495E+00,-0.2538E+00,-0.2623E+00,-0.2706E+00,
*-0.2785E+00,-0.2860E+00,-0.2931E+00,-0.2998E+00,-0.3058E+00,
*-0.3113E+00,-0.3160E+00,-0.3199E+00,-0.3229E+00,-0.3250E+00,
*-0.3261E+00,-0.3261E+00,-0.3247E+00,-0.3220E+00,-0.3179E+00,
*-0.3123E+00,-0.3052E+00,-0.2963E+00,-0.2858E+00,-0.2735E+00,
*-0.2595E+00,-0.2438E+00,-0.2265E+00,-0.2078E+00,-0.1878E+00,
*-0.1669E+00,-0.1450E+00,-0.1230E+00,-0.1012E+00,-0.8006E-01,
*-0.6003E-01,-0.4183E-01,-0.2630E-01,-0.1460E-01,-0.6345E-02,
*-0.1145E-02, 0.1771E-03, 0.4417E-20 /
DATA ((QHR(i,j),j=1,83),i=18,18)/
* 0.2287E-22,-0.7661E-04,-0.1820E-03,-0.3819E-03,-0.1410E-02,
*-0.3696E-02,-0.7124E-02,-0.1130E-01,-0.1590E-01,-0.2082E-01,
*-0.2596E-01,-0.3131E-01,-0.3684E-01,-0.4254E-01,-0.4843E-01,
*-0.5451E-01,-0.6080E-01,-0.6736E-01,-0.7417E-01,-0.8127E-01,
*-0.8867E-01,-0.9636E-01,-0.1044E+00,-0.1127E+00,-0.1213E+00,
*-0.1301E+00,-0.1392E+00,-0.1486E+00,-0.1581E+00,-0.1679E+00,
*-0.1778E+00,-0.1878E+00,-0.1980E+00,-0.2082E+00,-0.2185E+00,
*-0.2289E+00,-0.2392E+00,-0.2496E+00,-0.2598E+00,-0.2699E+00,
*-0.2799E+00,-0.2849E+00,-0.2897E+00,-0.2993E+00,-0.3086E+00,
*-0.3175E+00,-0.3260E+00,-0.3340E+00,-0.3415E+00,-0.3483E+00,
*-0.3545E+00,-0.3600E+00,-0.3645E+00,-0.3682E+00,-0.3708E+00,
*-0.3723E+00,-0.3725E+00,-0.3714E+00,-0.3689E+00,-0.3649E+00,
*-0.3593E+00,-0.3519E+00,-0.3428E+00,-0.3318E+00,-0.3188E+00,
*-0.3039E+00,-0.2870E+00,-0.2682E+00,-0.2474E+00,-0.2249E+00,
*-0.2008E+00,-0.1755E+00,-0.1495E+00,-0.1230E+00,-0.9693E-01,
*-0.7212E-01,-0.4973E-01,-0.3077E-01,-0.1595E-01,-0.6038E-02,
*-0.1019E-02, 0.1302E-03,-0.4145E-21 /
DATA ((QHR(i,j),j=1,83),i=19,19)/
*-0.1316E-21, 0.1287E-04,-0.7324E-04,-0.7375E-03,-0.2397E-02,
*-0.4972E-02,-0.8190E-02,-0.1191E-01,-0.1606E-01,-0.2061E-01,
*-0.2556E-01,-0.3088E-01,-0.3658E-01,-0.4264E-01,-0.4903E-01,
*-0.5574E-01,-0.6275E-01,-0.7004E-01,-0.7761E-01,-0.8543E-01,
*-0.9352E-01,-0.1018E+00,-0.1104E+00,-0.1192E+00,-0.1283E+00,
*-0.1376E+00,-0.1471E+00,-0.1569E+00,-0.1668E+00,-0.1769E+00,
*-0.1872E+00,-0.1976E+00,-0.2082E+00,-0.2188E+00,-0.2294E+00,
*-0.2401E+00,-0.2508E+00,-0.2614E+00,-0.2719E+00,-0.2823E+00,
*-0.2925E+00,-0.2975E+00,-0.3025E+00,-0.3122E+00,-0.3216E+00,
*-0.3305E+00,-0.3391E+00,-0.3472E+00,-0.3546E+00,-0.3615E+00,
*-0.3677E+00,-0.3730E+00,-0.3776E+00,-0.3812E+00,-0.3838E+00,
*-0.3854E+00,-0.3857E+00,-0.3849E+00,-0.3826E+00,-0.3790E+00,
*-0.3739E+00,-0.3673E+00,-0.3589E+00,-0.3489E+00,-0.3371E+00,
*-0.3234E+00,-0.3078E+00,-0.2903E+00,-0.2709E+00,-0.2495E+00,
*-0.2262E+00,-0.2013E+00,-0.1747E+00,-0.1470E+00,-0.1187E+00,
*-0.9077E-01,-0.6426E-01,-0.4063E-01,-0.2163E-01,-0.8394E-02,
*-0.1355E-02, 0.2122E-03, 0.3172E-21 /
DATA ((QHR(i,j),j=1,83),i=20,20)/
* 0.1171E-21,-0.1182E-03,-0.6476E-03,-0.1734E-02,-0.3588E-02,
*-0.6341E-02,-0.9982E-02,-0.1441E-01,-0.1953E-01,-0.2524E-01,
*-0.3147E-01,-0.3817E-01,-0.4530E-01,-0.5285E-01,-0.6078E-01,
*-0.6908E-01,-0.7774E-01,-0.8673E-01,-0.9606E-01,-0.1057E+00,
*-0.1156E+00,-0.1258E+00,-0.1363E+00,-0.1470E+00,-0.1579E+00,
*-0.1690E+00,-0.1802E+00,-0.1915E+00,-0.2029E+00,-0.2144E+00,
*-0.2258E+00,-0.2372E+00,-0.2485E+00,-0.2597E+00,-0.2708E+00,
*-0.2816E+00,-0.2922E+00,-0.3025E+00,-0.3125E+00,-0.3220E+00,
*-0.3312E+00,-0.3356E+00,-0.3398E+00,-0.3479E+00,-0.3555E+00,
*-0.3624E+00,-0.3687E+00,-0.3742E+00,-0.3790E+00,-0.3830E+00,
*-0.3861E+00,-0.3884E+00,-0.3897E+00,-0.3900E+00,-0.3893E+00,
*-0.3875E+00,-0.3846E+00,-0.3806E+00,-0.3755E+00,-0.3691E+00,
*-0.3615E+00,-0.3526E+00,-0.3424E+00,-0.3308E+00,-0.3178E+00,
*-0.3034E+00,-0.2875E+00,-0.2702E+00,-0.2514E+00,-0.2310E+00,
*-0.2093E+00,-0.1864E+00,-0.1624E+00,-0.1377E+00,-0.1128E+00,
*-0.8848E-01,-0.6550E-01,-0.4484E-01,-0.2749E-01,-0.1423E-01,
*-0.5446E-02,-0.9621E-03, 0.1176E-19 /
c************** MIE (phase fun uh) ***************
DATA ((UHR(i,j),j=1,83),i= 1, 1)/
*-0.3494E+00,-0.3431E+00,-0.3173E+00,-0.2772E+00,-0.2303E+00,
*-0.1834E+00,-0.1408E+00,-0.1042E+00,-0.7359E-01,-0.4855E-01,
*-0.2835E-01,-0.1232E-01, 0.1890E-03, 0.9855E-02, 0.1727E-01,
* 0.2297E-01, 0.2739E-01, 0.3090E-01, 0.3380E-01, 0.3630E-01,
* 0.3857E-01, 0.4074E-01, 0.4290E-01, 0.4513E-01, 0.4753E-01,
* 0.5015E-01, 0.5307E-01, 0.5632E-01, 0.5992E-01, 0.6392E-01,
* 0.6836E-01, 0.7330E-01, 0.7882E-01, 0.8499E-01, 0.9188E-01,
* 0.9958E-01, 0.1082E+00, 0.1177E+00, 0.1283E+00, 0.1402E+00,
* 0.1535E+00, 0.1607E+00, 0.1683E+00, 0.1850E+00, 0.2036E+00,
* 0.2244E+00, 0.2478E+00, 0.2741E+00, 0.3037E+00, 0.3371E+00,
* 0.3747E+00, 0.4173E+00, 0.4654E+00, 0.5200E+00, 0.5820E+00,
* 0.6525E+00, 0.7328E+00, 0.8244E+00, 0.9291E+00, 0.1049E+01,
* 0.1186E+01, 0.1344E+01, 0.1526E+01, 0.1736E+01, 0.1977E+01,
* 0.2257E+01, 0.2580E+01, 0.2956E+01, 0.3392E+01, 0.3901E+01,
* 0.4494E+01, 0.5188E+01, 0.6001E+01, 0.6955E+01, 0.8078E+01,
* 0.9399E+01, 0.1095E+02, 0.1276E+02, 0.1486E+02, 0.1727E+02,
* 0.2006E+02, 0.2372E+02, 0.2698E+02 /
DATA ((UHR(i,j),j=1,83),i= 2, 2)/
*-0.3524E+00,-0.3463E+00,-0.3220E+00,-0.2842E+00,-0.2399E+00,
*-0.1954E+00,-0.1544E+00,-0.1187E+00,-0.8839E-01,-0.6310E-01,
*-0.4229E-01,-0.2541E-01,-0.1182E-01,-0.9428E-03, 0.7715E-02,
* 0.1460E-01, 0.2010E-01, 0.2458E-01, 0.2833E-01, 0.3160E-01,
* 0.3459E-01, 0.3743E-01, 0.4021E-01, 0.4304E-01, 0.4599E-01,
* 0.4911E-01, 0.5246E-01, 0.5609E-01, 0.6006E-01, 0.6444E-01,
* 0.6928E-01, 0.7463E-01, 0.8056E-01, 0.8714E-01, 0.9447E-01,
* 0.1026E+00, 0.1117E+00, 0.1218E+00, 0.1330E+00, 0.1456E+00,
* 0.1596E+00, 0.1672E+00, 0.1752E+00, 0.1927E+00, 0.2123E+00,
* 0.2343E+00, 0.2590E+00, 0.2868E+00, 0.3180E+00, 0.3533E+00,
* 0.3930E+00, 0.4378E+00, 0.4886E+00, 0.5461E+00, 0.6114E+00,
* 0.6857E+00, 0.7702E+00, 0.8665E+00, 0.9763E+00, 0.1102E+01,
* 0.1245E+01, 0.1410E+01, 0.1598E+01, 0.1814E+01, 0.2063E+01,
* 0.2348E+01, 0.2677E+01, 0.3055E+01, 0.3491E+01, 0.3992E+01,
* 0.4570E+01, 0.5236E+01, 0.6004E+01, 0.6888E+01, 0.7905E+01,
* 0.9071E+01, 0.1040E+02, 0.1191E+02, 0.1360E+02, 0.1549E+02,
* 0.1763E+02, 0.2043E+02, 0.2269E+02 /
DATA ((UHR(i,j),j=1,83),i= 3, 3)/
*-0.3543E+00,-0.3483E+00,-0.3242E+00,-0.2868E+00,-0.2430E+00,
*-0.1988E+00,-0.1580E+00,-0.1225E+00,-0.9214E-01,-0.6671E-01,
*-0.4569E-01,-0.2853E-01,-0.1465E-01,-0.3506E-02, 0.5396E-02,
* 0.1252E-01, 0.1826E-01, 0.2297E-01, 0.2693E-01, 0.3039E-01,
* 0.3353E-01, 0.3652E-01, 0.3945E-01, 0.4244E-01, 0.4552E-01,
* 0.4876E-01, 0.5219E-01, 0.5589E-01, 0.5993E-01, 0.6441E-01,
* 0.6937E-01, 0.7486E-01, 0.8092E-01, 0.8762E-01, 0.9504E-01,
* 0.1033E+00, 0.1124E+00, 0.1227E+00, 0.1341E+00, 0.1468E+00,
* 0.1610E+00, 0.1687E+00, 0.1768E+00, 0.1946E+00, 0.2144E+00,
* 0.2367E+00, 0.2617E+00, 0.2898E+00, 0.3214E+00, 0.3571E+00,
* 0.3973E+00, 0.4427E+00, 0.4940E+00, 0.5522E+00, 0.6183E+00,
* 0.6933E+00, 0.7787E+00, 0.8760E+00, 0.9869E+00, 0.1114E+01,
* 0.1258E+01, 0.1424E+01, 0.1614E+01, 0.1831E+01, 0.2081E+01,
* 0.2367E+01, 0.2696E+01, 0.3074E+01, 0.3509E+01, 0.4008E+01,
* 0.4581E+01, 0.5240E+01, 0.5997E+01, 0.6864E+01, 0.7858E+01,
* 0.8991E+01, 0.1028E+02, 0.1172E+02, 0.1334E+02, 0.1512E+02,
* 0.1715E+02, 0.1978E+02, 0.2187E+02 /
DATA ((UHR(i,j),j=1,83),i= 4, 4)/
*-0.3623E+00,-0.3563E+00,-0.3319E+00,-0.2945E+00,-0.2511E+00,
*-0.2074E+00,-0.1670E+00,-0.1316E+00,-0.1013E+00,-0.7564E-01,
*-0.5424E-01,-0.3660E-01,-0.2215E-01,-0.1035E-01,-0.7512E-03,
* 0.7037E-02, 0.1339E-01, 0.1864E-01, 0.2309E-01, 0.2701E-01,
* 0.3060E-01, 0.3398E-01, 0.3728E-01, 0.4060E-01, 0.4399E-01,
* 0.4752E-01, 0.5126E-01, 0.5525E-01, 0.5956E-01, 0.6429E-01,
* 0.6950E-01, 0.7522E-01, 0.8152E-01, 0.8848E-01, 0.9621E-01,
* 0.1048E+00, 0.1143E+00, 0.1249E+00, 0.1367E+00, 0.1498E+00,
* 0.1645E+00, 0.1725E+00, 0.1809E+00, 0.1991E+00, 0.2196E+00,
* 0.2426E+00, 0.2684E+00, 0.2974E+00, 0.3300E+00, 0.3668E+00,
* 0.4082E+00, 0.4549E+00, 0.5077E+00, 0.5675E+00, 0.6353E+00,
* 0.7124E+00, 0.8000E+00, 0.8996E+00, 0.1013E+01, 0.1142E+01,
* 0.1290E+01, 0.1458E+01, 0.1650E+01, 0.1870E+01, 0.2122E+01,
* 0.2410E+01, 0.2740E+01, 0.3116E+01, 0.3547E+01, 0.4039E+01,
* 0.4600E+01, 0.5240E+01, 0.5969E+01, 0.6796E+01, 0.7733E+01,
* 0.8788E+01, 0.9970E+01, 0.1128E+02, 0.1272E+02, 0.1429E+02,
* 0.1607E+02, 0.1836E+02, 0.2008E+02 /
DATA ((UHR(i,j),j=1,83),i= 5, 5)/
*-0.3549E+00,-0.3492E+00,-0.3263E+00,-0.2913E+00,-0.2506E+00,
*-0.2094E+00,-0.1712E+00,-0.1373E+00,-0.1079E+00,-0.8269E-01,
*-0.6136E-01,-0.4350E-01,-0.2875E-01,-0.1668E-01,-0.6828E-02,
* 0.1283E-02, 0.8046E-02, 0.1379E-01, 0.1875E-01, 0.2312E-01,
* 0.2708E-01, 0.3080E-01, 0.3440E-01, 0.3798E-01, 0.4162E-01,
* 0.4539E-01, 0.4934E-01, 0.5356E-01, 0.5811E-01, 0.6307E-01,
* 0.6851E-01, 0.7449E-01, 0.8109E-01, 0.8833E-01, 0.9631E-01,
* 0.1051E+00, 0.1149E+00, 0.1258E+00, 0.1380E+00, 0.1515E+00,
* 0.1665E+00, 0.1747E+00, 0.1833E+00, 0.2021E+00, 0.2232E+00,
* 0.2467E+00, 0.2731E+00, 0.3028E+00, 0.3362E+00, 0.3737E+00,
* 0.4161E+00, 0.4640E+00, 0.5180E+00, 0.5792E+00, 0.6484E+00,
* 0.7269E+00, 0.8160E+00, 0.9173E+00, 0.1033E+01, 0.1164E+01,
* 0.1314E+01, 0.1484E+01, 0.1678E+01, 0.1900E+01, 0.2154E+01,
* 0.2442E+01, 0.2772E+01, 0.3147E+01, 0.3575E+01, 0.4061E+01,
* 0.4614E+01, 0.5240E+01, 0.5948E+01, 0.6747E+01, 0.7644E+01,
* 0.8645E+01, 0.9754E+01, 0.1097E+02, 0.1229E+02, 0.1373E+02,
* 0.1535E+02, 0.1742E+02, 0.1891E+02 /
DATA ((UHR(i,j),j=1,83),i= 6, 6)/
*-0.3501E+00,-0.3445E+00,-0.3222E+00,-0.2883E+00,-0.2490E+00,
*-0.2093E+00,-0.1723E+00,-0.1395E+00,-0.1110E+00,-0.8637E-01,
*-0.6546E-01,-0.4792E-01,-0.3327E-01,-0.2107E-01,-0.1092E-01,
*-0.2495E-02, 0.4536E-02, 0.1048E-01, 0.1563E-01, 0.2023E-01,
* 0.2445E-01, 0.2841E-01, 0.3223E-01, 0.3598E-01, 0.3978E-01,
* 0.4373E-01, 0.4791E-01, 0.5235E-01, 0.5711E-01, 0.6224E-01,
* 0.6780E-01, 0.7387E-01, 0.8054E-01, 0.8792E-01, 0.9610E-01,
* 0.1052E+00, 0.1152E+00, 0.1263E+00, 0.1386E+00, 0.1524E+00,
* 0.1677E+00, 0.1760E+00, 0.1848E+00, 0.2039E+00, 0.2253E+00,
* 0.2493E+00, 0.2761E+00, 0.3063E+00, 0.3402E+00, 0.3784E+00,
* 0.4213E+00, 0.4698E+00, 0.5245E+00, 0.5865E+00, 0.6567E+00,
* 0.7362E+00, 0.8264E+00, 0.9289E+00, 0.1045E+01, 0.1178E+01,
* 0.1328E+01, 0.1500E+01, 0.1696E+01, 0.1919E+01, 0.2173E+01,
* 0.2462E+01, 0.2791E+01, 0.3166E+01, 0.3591E+01, 0.4074E+01,
* 0.4621E+01, 0.5238E+01, 0.5934E+01, 0.6715E+01, 0.7588E+01,
* 0.8556E+01, 0.9623E+01, 0.1079E+02, 0.1205E+02, 0.1341E+02,
* 0.1495E+02, 0.1689E+02, 0.1825E+02 /
DATA ((UHR(i,j),j=1,83),i= 7, 7)/
*-0.3444E+00,-0.3391E+00,-0.3180E+00,-0.2860E+00,-0.2488E+00,
*-0.2111E+00,-0.1758E+00,-0.1442E+00,-0.1165E+00,-0.9248E-01,
*-0.7187E-01,-0.5442E-01,-0.3969E-01,-0.2726E-01,-0.1682E-01,
*-0.8060E-02,-0.6755E-03, 0.5616E-02, 0.1109E-01, 0.1600E-01,
* 0.2054E-01, 0.2481E-01, 0.2894E-01, 0.3302E-01, 0.3715E-01,
* 0.4138E-01, 0.4580E-01, 0.5046E-01, 0.5543E-01, 0.6080E-01,
* 0.6664E-01, 0.7299E-01, 0.7993E-01, 0.8757E-01, 0.9601E-01,
* 0.1053E+00, 0.1157E+00, 0.1271E+00, 0.1398E+00, 0.1539E+00,
* 0.1697E+00, 0.1782E+00, 0.1872E+00, 0.2068E+00, 0.2287E+00,
* 0.2532E+00, 0.2807E+00, 0.3116E+00, 0.3463E+00, 0.3853E+00,
* 0.4292E+00, 0.4786E+00, 0.5344E+00, 0.5976E+00, 0.6690E+00,
* 0.7500E+00, 0.8417E+00, 0.9457E+00, 0.1064E+01, 0.1198E+01,
* 0.1350E+01, 0.1523E+01, 0.1720E+01, 0.1944E+01, 0.2199E+01,
* 0.2488E+01, 0.2817E+01, 0.3189E+01, 0.3611E+01, 0.4087E+01,
* 0.4624E+01, 0.5228E+01, 0.5905E+01, 0.6660E+01, 0.7497E+01,
* 0.8420E+01, 0.9427E+01, 0.1052E+02, 0.1169E+02, 0.1294E+02,
* 0.1436E+02, 0.1613E+02, 0.1732E+02 /
DATA ((UHR(i,j),j=1,83),i= 8, 8)/
*-0.3445E+00,-0.3392E+00,-0.3184E+00,-0.2873E+00,-0.2518E+00,
*-0.2159E+00,-0.1822E+00,-0.1519E+00,-0.1249E+00,-0.1012E+00,
*-0.8062E-01,-0.6291E-01,-0.4783E-01,-0.3512E-01,-0.2442E-01,
*-0.1535E-01,-0.7550E-02,-0.7200E-03, 0.5353E-02, 0.1080E-01,
* 0.1576E-01, 0.2041E-01, 0.2486E-01, 0.2924E-01, 0.3364E-01,
* 0.3816E-01, 0.4288E-01, 0.4787E-01, 0.5320E-01, 0.5889E-01,
* 0.6502E-01, 0.7168E-01, 0.7899E-01, 0.8699E-01, 0.9579E-01,
* 0.1055E+00, 0.1163E+00, 0.1281E+00, 0.1413E+00, 0.1559E+00,
* 0.1722E+00, 0.1810E+00, 0.1904E+00, 0.2106E+00, 0.2333E+00,
* 0.2586E+00, 0.2869E+00, 0.3186E+00, 0.3542E+00, 0.3943E+00,
* 0.4393E+00, 0.4902E+00, 0.5475E+00, 0.6121E+00, 0.6851E+00,
* 0.7675E+00, 0.8608E+00, 0.9665E+00, 0.1086E+01, 0.1222E+01,
* 0.1376E+01, 0.1551E+01, 0.1749E+01, 0.1974E+01, 0.2229E+01,
* 0.2517E+01, 0.2843E+01, 0.3212E+01, 0.3627E+01, 0.4095E+01,
* 0.4619E+01, 0.5204E+01, 0.5856E+01, 0.6577E+01, 0.7371E+01,
* 0.8238E+01, 0.9177E+01, 0.1018E+02, 0.1125E+02, 0.1240E+02,
* 0.1370E+02, 0.1529E+02, 0.1632E+02 /
DATA ((UHR(i,j),j=1,83),i= 9, 9)/
*-0.3352E+00,-0.3305E+00,-0.3116E+00,-0.2833E+00,-0.2507E+00,
*-0.2175E+00,-0.1862E+00,-0.1577E+00,-0.1321E+00,-0.1093E+00,
*-0.8922E-01,-0.7179E-01,-0.5683E-01,-0.4406E-01,-0.3314E-01,
*-0.2373E-01,-0.1554E-01,-0.8318E-02,-0.1873E-02, 0.3948E-02,
* 0.9322E-02, 0.1440E-01, 0.1931E-01, 0.2414E-01, 0.2899E-01,
* 0.3392E-01, 0.3900E-01, 0.4432E-01, 0.4995E-01, 0.5599E-01,
* 0.6253E-01, 0.6964E-01, 0.7738E-01, 0.8581E-01, 0.9503E-01,
* 0.1051E+00, 0.1163E+00, 0.1287E+00, 0.1424E+00, 0.1577E+00,
* 0.1746E+00, 0.1837E+00, 0.1933E+00, 0.2143E+00, 0.2377E+00,
* 0.2638E+00, 0.2931E+00, 0.3258E+00, 0.3626E+00, 0.4038E+00,
* 0.4501E+00, 0.5023E+00, 0.5610E+00, 0.6271E+00, 0.7017E+00,
* 0.7859E+00, 0.8810E+00, 0.9885E+00, 0.1110E+01, 0.1248E+01,
* 0.1404E+01, 0.1580E+01, 0.1779E+01, 0.2004E+01, 0.2259E+01,
* 0.2546E+01, 0.2870E+01, 0.3234E+01, 0.3643E+01, 0.4100E+01,
* 0.4610E+01, 0.5177E+01, 0.5803E+01, 0.6492E+01, 0.7244E+01,
* 0.8058E+01, 0.8932E+01, 0.9860E+01, 0.1084E+02, 0.1188E+02,
* 0.1306E+02, 0.1448E+02, 0.1535E+02 /
DATA ((UHR(i,j),j=1,83),i=10,10)/
*-0.3251E+00,-0.3208E+00,-0.3035E+00,-0.2777E+00,-0.2480E+00,
*-0.2176E+00,-0.1886E+00,-0.1621E+00,-0.1382E+00,-0.1167E+00,
*-0.9761E-01,-0.8091E-01,-0.6630E-01,-0.5355E-01,-0.4243E-01,
*-0.3274E-01,-0.2422E-01,-0.1669E-01,-0.9947E-02,-0.3766E-02,
* 0.2012E-02, 0.7505E-02, 0.1284E-01, 0.1812E-01, 0.2341E-01,
* 0.2877E-01, 0.3426E-01, 0.3997E-01, 0.4599E-01, 0.5244E-01,
* 0.5940E-01, 0.6693E-01, 0.7507E-01, 0.8392E-01, 0.9360E-01,
* 0.1042E+00, 0.1159E+00, 0.1289E+00, 0.1432E+00, 0.1591E+00,
* 0.1766E+00, 0.1861E+00, 0.1961E+00, 0.2179E+00, 0.2421E+00,
* 0.2691E+00, 0.2994E+00, 0.3332E+00, 0.3711E+00, 0.4136E+00,
* 0.4612E+00, 0.5147E+00, 0.5748E+00, 0.6424E+00, 0.7186E+00,
* 0.8045E+00, 0.9014E+00, 0.1011E+01, 0.1134E+01, 0.1273E+01,
* 0.1430E+01, 0.1607E+01, 0.1807E+01, 0.2033E+01, 0.2287E+01,
* 0.2572E+01, 0.2893E+01, 0.3252E+01, 0.3653E+01, 0.4100E+01,
* 0.4596E+01, 0.5143E+01, 0.5745E+01, 0.6403E+01, 0.7115E+01,
* 0.7881E+01, 0.8695E+01, 0.9554E+01, 0.1046E+02, 0.1142E+02,
* 0.1249E+02, 0.1378E+02, 0.1452E+02 /
DATA ((UHR(i,j),j=1,83),i=11,11)/
*-0.3184E+00,-0.3143E+00,-0.2983E+00,-0.2743E+00,-0.2467E+00,
*-0.2186E+00,-0.1917E+00,-0.1669E+00,-0.1442E+00,-0.1236E+00,
*-0.1050E+00,-0.8855E-01,-0.7408E-01,-0.6144E-01,-0.5037E-01,
*-0.4060E-01,-0.3190E-01,-0.2406E-01,-0.1693E-01,-0.1038E-01,
*-0.4264E-02, 0.1565E-02, 0.7208E-02, 0.1278E-01, 0.1836E-01,
* 0.2402E-01, 0.2983E-01, 0.3589E-01, 0.4227E-01, 0.4906E-01,
* 0.5635E-01, 0.6423E-01, 0.7277E-01, 0.8204E-01, 0.9214E-01,
* 0.1032E+00, 0.1153E+00, 0.1287E+00, 0.1436E+00, 0.1600E+00,
* 0.1782E+00, 0.1880E+00, 0.1983E+00, 0.2207E+00, 0.2457E+00,
* 0.2735E+00, 0.3046E+00, 0.3393E+00, 0.3781E+00, 0.4216E+00,
* 0.4703E+00, 0.5250E+00, 0.5864E+00, 0.6552E+00, 0.7327E+00,
* 0.8199E+00, 0.9180E+00, 0.1028E+01, 0.1153E+01, 0.1293E+01,
* 0.1451E+01, 0.1629E+01, 0.1829E+01, 0.2054E+01, 0.2307E+01,
* 0.2590E+01, 0.2908E+01, 0.3262E+01, 0.3656E+01, 0.4094E+01,
* 0.4578E+01, 0.5109E+01, 0.5691E+01, 0.6323E+01, 0.7004E+01,
* 0.7732E+01, 0.8503E+01, 0.9312E+01, 0.1016E+02, 0.1106E+02,
* 0.1207E+02, 0.1326E+02, 0.1392E+02 /
DATA ((UHR(i,j),j=1,83),i=12,12)/
*-0.3186E+00,-0.3144E+00,-0.2981E+00,-0.2741E+00,-0.2470E+00,
*-0.2197E+00,-0.1936E+00,-0.1696E+00,-0.1476E+00,-0.1275E+00,
*-0.1095E+00,-0.9341E-01,-0.7916E-01,-0.6654E-01,-0.5536E-01,
*-0.4542E-01,-0.3658E-01,-0.2863E-01,-0.2137E-01,-0.1463E-01,
*-0.8288E-02,-0.2231E-02, 0.3630E-02, 0.9366E-02, 0.1510E-01,
* 0.2095E-01, 0.2701E-01, 0.3334E-01, 0.4000E-01, 0.4704E-01,
* 0.5452E-01, 0.6255E-01, 0.7126E-01, 0.8076E-01, 0.9113E-01,
* 0.1025E+00, 0.1150E+00, 0.1288E+00, 0.1439E+00, 0.1606E+00,
* 0.1792E+00, 0.1892E+00, 0.1998E+00, 0.2227E+00, 0.2481E+00,
* 0.2765E+00, 0.3081E+00, 0.3433E+00, 0.3827E+00, 0.4268E+00,
* 0.4762E+00, 0.5315E+00, 0.5936E+00, 0.6634E+00, 0.7417E+00,
* 0.8296E+00, 0.9285E+00, 0.1040E+01, 0.1165E+01, 0.1305E+01,
* 0.1464E+01, 0.1642E+01, 0.1842E+01, 0.2067E+01, 0.2318E+01,
* 0.2600E+01, 0.2915E+01, 0.3266E+01, 0.3656E+01, 0.4088E+01,
* 0.4563E+01, 0.5085E+01, 0.5654E+01, 0.6270E+01, 0.6932E+01,
* 0.7637E+01, 0.8381E+01, 0.9161E+01, 0.9979E+01, 0.1085E+02,
* 0.1183E+02, 0.1296E+02, 0.1358E+02 /
DATA ((UHR(i,j),j=1,83),i=13,13)/
*-0.3108E+00,-0.3072E+00,-0.2930E+00,-0.2720E+00,-0.2480E+00,
*-0.2234E+00,-0.2000E+00,-0.1781E+00,-0.1578E+00,-0.1390E+00,
*-0.1218E+00,-0.1062E+00,-0.9233E-01,-0.7991E-01,-0.6879E-01,
*-0.5878E-01,-0.4968E-01,-0.4133E-01,-0.3361E-01,-0.2642E-01,
*-0.1962E-01,-0.1307E-01,-0.6688E-02,-0.3697E-03, 0.5976E-02,
* 0.1241E-01, 0.1899E-01, 0.2584E-01, 0.3303E-01, 0.4065E-01,
* 0.4879E-01, 0.5756E-01, 0.6701E-01, 0.7723E-01, 0.8834E-01,
* 0.1004E+00, 0.1137E+00, 0.1283E+00, 0.1444E+00, 0.1622E+00,
* 0.1817E+00, 0.1923E+00, 0.2034E+00, 0.2274E+00, 0.2541E+00,
* 0.2838E+00, 0.3168E+00, 0.3536E+00, 0.3946E+00, 0.4403E+00,
* 0.4914E+00, 0.5487E+00, 0.6127E+00, 0.6842E+00, 0.7644E+00,
* 0.8543E+00, 0.9550E+00, 0.1068E+01, 0.1195E+01, 0.1337E+01,
* 0.1496E+01, 0.1674E+01, 0.1873E+01, 0.2096E+01, 0.2345E+01,
* 0.2622E+01, 0.2931E+01, 0.3272E+01, 0.3649E+01, 0.4065E+01,
* 0.4520E+01, 0.5015E+01, 0.5552E+01, 0.6129E+01, 0.6744E+01,
* 0.7395E+01, 0.8078E+01, 0.8789E+01, 0.9531E+01, 0.1032E+02,
* 0.1120E+02, 0.1220E+02, 0.1271E+02 /
DATA ((UHR(i,j),j=1,83),i=14,14)/
*-0.3172E+00,-0.3136E+00,-0.2996E+00,-0.2795E+00,-0.2570E+00,
*-0.2344E+00,-0.2128E+00,-0.1927E+00,-0.1739E+00,-0.1563E+00,
*-0.1401E+00,-0.1252E+00,-0.1117E+00,-0.9936E-01,-0.8813E-01,
*-0.7783E-01,-0.6833E-01,-0.5951E-01,-0.5130E-01,-0.4354E-01,
*-0.3608E-01,-0.2884E-01,-0.2171E-01,-0.1462E-01,-0.7470E-02,
*-0.2342E-03, 0.7158E-02, 0.1482E-01, 0.2285E-01, 0.3135E-01,
* 0.4045E-01, 0.5020E-01, 0.6063E-01, 0.7189E-01, 0.8408E-01,
* 0.9732E-01, 0.1118E+00, 0.1277E+00, 0.1452E+00, 0.1643E+00,
* 0.1854E+00, 0.1968E+00, 0.2087E+00, 0.2344E+00, 0.2629E+00,
* 0.2945E+00, 0.3295E+00, 0.3684E+00, 0.4116E+00, 0.4596E+00,
* 0.5131E+00, 0.5728E+00, 0.6391E+00, 0.7130E+00, 0.7955E+00,
* 0.8877E+00, 0.9905E+00, 0.1105E+01, 0.1233E+01, 0.1376E+01,
* 0.1535E+01, 0.1712E+01, 0.1909E+01, 0.2128E+01, 0.2371E+01,
* 0.2640E+01, 0.2938E+01, 0.3264E+01, 0.3623E+01, 0.4014E+01,
* 0.4439E+01, 0.4898E+01, 0.5391E+01, 0.5916E+01, 0.6471E+01,
* 0.7054E+01, 0.7660E+01, 0.8289E+01, 0.8945E+01, 0.9644E+01,
* 0.1042E+02, 0.1126E+02, 0.1165E+02 /
DATA ((UHR(i,j),j=1,83),i=15,15)/
*-0.3355E+00,-0.3325E+00,-0.3208E+00,-0.3041E+00,-0.2862E+00,
*-0.2690E+00,-0.2532E+00,-0.2386E+00,-0.2248E+00,-0.2116E+00,
*-0.1991E+00,-0.1873E+00,-0.1761E+00,-0.1653E+00,-0.1551E+00,
*-0.1452E+00,-0.1356E+00,-0.1263E+00,-0.1172E+00,-0.1082E+00,
*-0.9927E-01,-0.9033E-01,-0.8133E-01,-0.7222E-01,-0.6290E-01,
*-0.5327E-01,-0.4328E-01,-0.3285E-01,-0.2188E-01,-0.1031E-01,
* 0.1921E-02, 0.1493E-01, 0.2884E-01, 0.4377E-01, 0.5984E-01,
* 0.7724E-01, 0.9610E-01, 0.1165E+00, 0.1386E+00, 0.1627E+00,
* 0.1890E+00, 0.2030E+00, 0.2177E+00, 0.2491E+00, 0.2835E+00,
* 0.3211E+00, 0.3623E+00, 0.4076E+00, 0.4572E+00, 0.5118E+00,
* 0.5717E+00, 0.6376E+00, 0.7102E+00, 0.7899E+00, 0.8775E+00,
* 0.9738E+00, 0.1080E+01, 0.1196E+01, 0.1324E+01, 0.1464E+01,
* 0.1618E+01, 0.1786E+01, 0.1971E+01, 0.2172E+01, 0.2391E+01,
* 0.2629E+01, 0.2887E+01, 0.3165E+01, 0.3465E+01, 0.3787E+01,
* 0.4129E+01, 0.4493E+01, 0.4876E+01, 0.5278E+01, 0.5699E+01,
* 0.6137E+01, 0.6593E+01, 0.7071E+01, 0.7579E+01, 0.8125E+01,
* 0.8710E+01, 0.9260E+01, 0.9472E+01 /
DATA ((UHR(i,j),j=1,83),i=16,16)/
*-0.2986E+00,-0.2969E+00,-0.2903E+00,-0.2811E+00,-0.2717E+00,
*-0.2631E+00,-0.2554E+00,-0.2484E+00,-0.2417E+00,-0.2351E+00,
*-0.2286E+00,-0.2220E+00,-0.2154E+00,-0.2086E+00,-0.2016E+00,
*-0.1945E+00,-0.1874E+00,-0.1801E+00,-0.1726E+00,-0.1650E+00,
*-0.1572E+00,-0.1491E+00,-0.1408E+00,-0.1322E+00,-0.1231E+00,
*-0.1137E+00,-0.1038E+00,-0.9336E-01,-0.8228E-01,-0.7050E-01,
*-0.5794E-01,-0.4453E-01,-0.3018E-01,-0.1472E-01, 0.1974E-02,
* 0.1998E-01, 0.3942E-01, 0.6046E-01, 0.8329E-01, 0.1081E+00,
* 0.1351E+00, 0.1495E+00, 0.1645E+00, 0.1965E+00, 0.2314E+00,
* 0.2696E+00, 0.3113E+00, 0.3569E+00, 0.4069E+00, 0.4615E+00,
* 0.5214E+00, 0.5872E+00, 0.6594E+00, 0.7386E+00, 0.8256E+00,
* 0.9211E+00, 0.1026E+01, 0.1141E+01, 0.1268E+01, 0.1407E+01,
* 0.1561E+01, 0.1729E+01, 0.1913E+01, 0.2115E+01, 0.2337E+01,
* 0.2580E+01, 0.2845E+01, 0.3134E+01, 0.3449E+01, 0.3791E+01,
* 0.4161E+01, 0.4561E+01, 0.4991E+01, 0.5453E+01, 0.5949E+01,
* 0.6480E+01, 0.7049E+01, 0.7661E+01, 0.8324E+01, 0.9038E+01,
* 0.9780E+01, 0.1043E+02, 0.1066E+02 /
DATA ((UHR(i,j),j=1,83),i=17,17)/
*-0.3040E+00,-0.3026E+00,-0.2970E+00,-0.2890E+00,-0.2804E+00,
*-0.2723E+00,-0.2650E+00,-0.2584E+00,-0.2524E+00,-0.2467E+00,
*-0.2410E+00,-0.2351E+00,-0.2291E+00,-0.2229E+00,-0.2165E+00,
*-0.2098E+00,-0.2029E+00,-0.1959E+00,-0.1887E+00,-0.1813E+00,
*-0.1736E+00,-0.1656E+00,-0.1573E+00,-0.1486E+00,-0.1396E+00,
*-0.1300E+00,-0.1199E+00,-0.1093E+00,-0.9800E-01,-0.8599E-01,
*-0.7316E-01,-0.5941E-01,-0.4468E-01,-0.2888E-01,-0.1189E-01,
* 0.6459E-02, 0.2630E-01, 0.4776E-01, 0.7101E-01, 0.9619E-01,
* 0.1235E+00, 0.1381E+00, 0.1532E+00, 0.1856E+00, 0.2209E+00,
* 0.2593E+00, 0.3012E+00, 0.3470E+00, 0.3969E+00, 0.4516E+00,
* 0.5115E+00, 0.5770E+00, 0.6487E+00, 0.7273E+00, 0.8135E+00,
* 0.9082E+00, 0.1012E+01, 0.1126E+01, 0.1251E+01, 0.1388E+01,
* 0.1539E+01, 0.1705E+01, 0.1887E+01, 0.2086E+01, 0.2305E+01,
* 0.2545E+01, 0.2808E+01, 0.3096E+01, 0.3411E+01, 0.3754E+01,
* 0.4127E+01, 0.4534E+01, 0.4975E+01, 0.5452E+01, 0.5968E+01,
* 0.6526E+01, 0.7131E+01, 0.7787E+01, 0.8497E+01, 0.9256E+01,
* 0.1003E+02, 0.1069E+02, 0.1091E+02 /
DATA ((UHR(i,j),j=1,83),i=18,18)/
*-0.3020E+00,-0.3010E+00,-0.2972E+00,-0.2919E+00,-0.2865E+00,
*-0.2817E+00,-0.2774E+00,-0.2735E+00,-0.2698E+00,-0.2660E+00,
*-0.2621E+00,-0.2579E+00,-0.2534E+00,-0.2488E+00,-0.2438E+00,
*-0.2386E+00,-0.2331E+00,-0.2273E+00,-0.2212E+00,-0.2148E+00,
*-0.2081E+00,-0.2010E+00,-0.1934E+00,-0.1855E+00,-0.1770E+00,
*-0.1681E+00,-0.1586E+00,-0.1484E+00,-0.1376E+00,-0.1260E+00,
*-0.1137E+00,-0.1004E+00,-0.8612E-01,-0.7079E-01,-0.5430E-01,
*-0.3653E-01,-0.1736E-01, 0.3350E-02, 0.2573E-01, 0.4993E-01,
* 0.7616E-01, 0.9008E-01, 0.1046E+00, 0.1354E+00, 0.1689E+00,
* 0.2052E+00, 0.2448E+00, 0.2878E+00, 0.3347E+00, 0.3858E+00,
* 0.4416E+00, 0.5025E+00, 0.5690E+00, 0.6418E+00, 0.7216E+00,
* 0.8090E+00, 0.9050E+00, 0.1010E+01, 0.1127E+01, 0.1255E+01,
* 0.1396E+01, 0.1552E+01, 0.1725E+01, 0.1918E+01, 0.2132E+01,
* 0.2371E+01, 0.2639E+01, 0.2939E+01, 0.3277E+01, 0.3659E+01,
* 0.4091E+01, 0.4582E+01, 0.5141E+01, 0.5776E+01, 0.6499E+01,
* 0.7321E+01, 0.8249E+01, 0.9290E+01, 0.1044E+02, 0.1166E+02,
* 0.1286E+02, 0.1383E+02, 0.1415E+02 /
DATA ((UHR(i,j),j=1,83),i=19,19)/
*-0.3020E+00,-0.3015E+00,-0.2993E+00,-0.2963E+00,-0.2934E+00,
*-0.2907E+00,-0.2882E+00,-0.2857E+00,-0.2830E+00,-0.2802E+00,
*-0.2770E+00,-0.2736E+00,-0.2699E+00,-0.2659E+00,-0.2616E+00,
*-0.2570E+00,-0.2520E+00,-0.2466E+00,-0.2409E+00,-0.2349E+00,
*-0.2284E+00,-0.2216E+00,-0.2143E+00,-0.2066E+00,-0.1983E+00,
*-0.1896E+00,-0.1802E+00,-0.1702E+00,-0.1596E+00,-0.1482E+00,
*-0.1360E+00,-0.1229E+00,-0.1089E+00,-0.9387E-01,-0.7772E-01,
*-0.6037E-01,-0.4170E-01,-0.2161E-01, 0.3854E-04, 0.2337E-01,
* 0.4855E-01, 0.6188E-01, 0.7573E-01, 0.1051E+00, 0.1368E+00,
* 0.1712E+00, 0.2084E+00, 0.2487E+00, 0.2924E+00, 0.3399E+00,
* 0.3915E+00, 0.4477E+00, 0.5089E+00, 0.5756E+00, 0.6486E+00,
* 0.7285E+00, 0.8160E+00, 0.9123E+00, 0.1018E+01, 0.1135E+01,
* 0.1265E+01, 0.1409E+01, 0.1570E+01, 0.1751E+01, 0.1954E+01,
* 0.2185E+01, 0.2447E+01, 0.2749E+01, 0.3097E+01, 0.3501E+01,
* 0.3975E+01, 0.4533E+01, 0.5195E+01, 0.5981E+01, 0.6917E+01,
* 0.8026E+01, 0.9330E+01, 0.1084E+02, 0.1253E+02, 0.1434E+02,
* 0.1609E+02, 0.1744E+02, 0.1785E+02 /
DATA ((UHR(i,j),j=1,83),i=20,20)/
*-0.3991E+00,-0.3988E+00,-0.3975E+00,-0.3952E+00,-0.3922E+00,
*-0.3886E+00,-0.3846E+00,-0.3804E+00,-0.3758E+00,-0.3710E+00,
*-0.3658E+00,-0.3604E+00,-0.3545E+00,-0.3484E+00,-0.3418E+00,
*-0.3349E+00,-0.3275E+00,-0.3197E+00,-0.3115E+00,-0.3028E+00,
*-0.2937E+00,-0.2840E+00,-0.2737E+00,-0.2629E+00,-0.2515E+00,
*-0.2395E+00,-0.2268E+00,-0.2133E+00,-0.1991E+00,-0.1841E+00,
*-0.1682E+00,-0.1513E+00,-0.1335E+00,-0.1146E+00,-0.9463E-01,
*-0.7341E-01,-0.5089E-01,-0.2699E-01,-0.1594E-02, 0.2540E-01,
* 0.5413E-01, 0.6918E-01, 0.8472E-01, 0.1173E+00, 0.1521E+00,
* 0.1893E+00, 0.2290E+00, 0.2716E+00, 0.3172E+00, 0.3663E+00,
* 0.4191E+00, 0.4760E+00, 0.5375E+00, 0.6042E+00, 0.6765E+00,
* 0.7554E+00, 0.8415E+00, 0.9359E+00, 0.1040E+01, 0.1154E+01,
* 0.1281E+01, 0.1423E+01, 0.1581E+01, 0.1758E+01, 0.1958E+01,
* 0.2185E+01, 0.2443E+01, 0.2737E+01, 0.3073E+01, 0.3459E+01,
* 0.3903E+01, 0.4412E+01, 0.4996E+01, 0.5663E+01, 0.6418E+01,
* 0.7263E+01, 0.8190E+01, 0.9182E+01, 0.1020E+02, 0.1118E+02,
* 0.1203E+02, 0.1261E+02, 0.1277E+02 /
do 1 i=1,20
asy(1,i)=asy_m(i)
ex(1,i)=ex_m(i)
sc(1,i)=sc_m(i)
do 1 j=1,nquad
ph(i,j)=phr(i,j)
qh(i,j)=qhr(i,j)
uh(i,j)=uhr(i,j)
1 continue
return
end
BRDFGRID.f0000644002107500000270000000117412463730616010717 0ustar jckraps subroutine brdfgrid(mu,np,rm,rp,brdfdat,angmu,angphi,
s brdfint)
integer mu,np
real rp(np),brdfint(-mu:mu,np),rm(-mu:mu)
s ,angmu(10),angphi(13),brdfdat(10,13)
real brdftemp(10,13)
real gaussmu,gaussphi,y
integer j,k
do 10 j=1,np
do 10 k=1,mu
10 brdfint(k,j)=0.
call splie2(angphi,brdfdat,10,13,brdftemp)
do 1 j=1,np
do 2 k=1,mu
gaussmu=rm(k)
gaussphi=rp(j)
call splin2(angmu,angphi,brdfdat,brdftemp,10,13,
s gaussmu,gaussphi,
s y)
brdfint(k,j)=y
2 continue
1 continue
return
end
CAVIS.f0000644002107500000270000001215512463730616010402 0ustar jckraps subroutine CAVIS(iwa)
common /sixs_ffu/ s(1501),wlinf,wlsup
real sr(11,1501),wli(11),wls(11)
real wlinf,wlsup,s
integer iwa,l,i
c band 1 of CAVIS - 411 (cw=411nm)
data (sr(1,l),l=1,1501,1) / 60*0.,
A .0010, .0114, .2511, .8372, .9964, .9758, .9121, .9627,
A .6977, .0436, .0010,
A1430*0./
c band 2 of CAVIS - 492 (cw=492nm)
data (sr(2,l),l=1,1501,1) / 81*0.,
A .0009, .0058, .0691, .5020, .9597, .9655, .9880, .9927,
A .9740, .9680, .9918, .9843, .9868, .9752, .9843, .9767,
A .9907, .9517, .9889, .9785, .9921, .9819, .8671, .3483,
A .0516, .0071, .0017,
A1393*0./
c band 3 of CAVIS - 661 (cw=661nm)
data (sr(3,l),l=1,1501,1) / 151*0.,
A .0023, .0132, .1567, .7720, .9694, .9956, .9972, .9942,
A .9942, .9759, .9827, .9917, .9845, .9978, .9944, .9919,
A .9808, .9623, .9847, .9935, .9884, .9886, .8216, .2743,
A .0602, .0148, .0042, .0012,
A1322*0./
c band 4 of CAVIS - 864 (cw=864nm)
data (sr(4,l),l=1,1501,1) / 230*0.,
A .0011, .0023, .0049, .0115, .0271, .0652, .1513, .3377,
A .6238, .8782, .9830, .9966, .9979, .9974, .9966, .9984,
A .9989, .9979, .9958, .9952, .9974, .9980, .9918, .9155,
A .6906, .3826, .1699, .0726, .0306, .0138, .0064, .0032,
A .0017, .0008,
A1237*0./
c band 5 of CAVIS - 908 (cw=908nm)
data (sr(5,l),l=1,1501,1) / 253*0.,
A .0003, .0019, .0050, .0126, .0325, .0851, .2395, .5346,
A .8500, .9770, .9991, .9939, .9904, .9917, .9912, .9909,
A .9799, .8881, .5993, .2709, .1025, .0386, .0166, .0075,
A .0036, .0018, .0008,
A1221*0./
c band 6 of CAVIS - 940 (cw=940nm)
data (sr(6,l),l=1,1501,1) / 265*0.,
A .0008, .0020, .0040, .0082, .0182, .0441, .1254, .3326,
A .6447, .8628, .9688, .9976, .9769, .9575, .9521, .9489,
A .9472, .9586, .9782, .9629, .8109, .5071, .2398, .1012,
A .0455, .0210, .0103, .0051, .0027, .0014, .0003,
A1205*0./
c band 7 of CAVIS - 1225 (cw=1225nm)
data (sr(7,l),l=1,1501,1) / 379*0.,
A .0012, .0024, .0049, .0101, .0223, .0451, .0874, .1778,
A .3793, .7024, .9409, .9990, .9966, .9979, .9949, .9886,
A .9816, .9766, .9710, .9632, .8896, .6735, .3883, .1910,
A .0941, .0479, .0216, .0095, .0045, .0022, .0012,
A1091*0./
c band 8 of CAVIS - 1373 (cw=1373nm)
data (sr(8,l),l=1,1501,1) / 435*0.,
A .0003, .0013, .0022, .0041, .0076, .0144, .0287, .0534,
A .1045, .2019, .3848, .6245, .8395, .9596, .9976, .9954,
A .9791, .9657, .9599, .9594, .9590, .9605, .9714, .9769,
A .9530, .8768, .7021, .4720, .2739, .1477, .0827, .0470,
A .0262, .0146, .0085, .0050, .0030, .0018, .0011,
A1027*0./
c band 9 of CAVIS - 1645 (cw=1645nm)
data (sr(9,l),l=1,1501,1) / 532*0.,
A .0005, .0013, .0018, .0026, .0039, .0058, .0088, .0134,
A .0198, .0287, .0411, .0582, .0862, .1361, .2249, .3800,
A .5676, .7178, .8096, .8750, .9316, .9641, .9736, .9741,
A .9828, .9918, .9999, .9947, .9865, .9852, .9830, .9790,
A .9758, .9758, .9879, .9982, .9708, .8802, .7561, .6342,
A .5175, .3852, .2552, .1580, .0982, .0645, .0442, .0301,
A .0207, .0143, .0097, .0064, .0042, .0029, .0021, .0016,
A .0012, .0008,
A911*0./
c band 10 of CAVIS - 2145 (cw=2145nm)
data (sr(10,l),l=1,1501,1) / 724*0.,
A .0005, .0013, .0019, .0027, .0040, .0059, .0088, .0132,
A .0197, .0294, .0421, .0534, .0693, .0924, .1251, .1731,
A .2425, .3395, .4673, .6215, .7730, .8929, .9617, .9855,
A .9882, .9834, .9791, .9790, .9823, .9878, .9910, .9953,
A .9972, .9992, .9998, .9996, .9991, .9989, .9991, .9970,
A .9968, .9958, .9938, .9947, .9944, .9957, .9958, .9951,
A .9945, .9936, .9903, .9868, .9836, .9811, .9804, .9812,
A .9847, .9878, .9913, .9957, .9969, .9968, .9957, .9922,
A .9903, .9886, .9915, .9923, .9900, .9755, .9366, .8664,
A .7671, .6426, .5176, .4057, .3122, .2408, .1863, .1474,
A .1174, .0938, .0739, .0524, .0361, .0250, .0171, .0120,
A .0085, .0061, .0045, .0033, .0025, .0019, .0015, .0012,
A .0005,
A680*0./
c band 11 of CAVIS - 556 (cw=556nm)
data (sr(11,l),l=1,1501,1) / 108*0.,
A .0008, .0118, .1968, .6787, .9708, .9798, .9849, .9730,
A .9648, .9362, .9634, .9778, .9833, .9841, .9975, .9904,
A .9820, .9833, .9739, .9757, .9673, .9763, .9697, .9715,
A .9719, .7535, .2679, .0529, .0109, .0028, .0006,
A1362*0./
c
c lower and upper wavelength
wli(1)=0.4000
wls(1)=0.4250
wli(2)=0.4525
wls(2)=0.5175
wli(3)=0.6275
wls(3)=0.6950
wli(4)=0.8250
wls(4)=0.9075
wli(5)=0.8825
wls(5)=0.9475
wli(6)=0.9125
wls(6)=0.9875
wli(7)=1.1975
wls(7)=1.2725
wli(8)=1.3375
wls(8)=1.4325
wli(9)=1.5800
wls(9)=1.7225
wli(10)=2.0600
wls(10)=2.3000
wli(11)=0.5200
wls(11)=0.5950
do 1 i=1,1501
s(i)=sr(iwa,i)
1 continue
wlinf=wli(iwa)
wlsup=wls(iwa)
return
end
CHAND.f0000644002107500000270000000400212463730616010342 0ustar jckraps subroutine chand (xphi,xmuv,xmus,xtau
s ,xrray)
c input parameters: xphi,xmus,xmuv,xtau
c xphi: azimuthal difference between sun and observation (xphi=0,
c in backscattering) and expressed in degree (0.:360.)
c xmus: cosine of the sun zenith angle
c xmuv: cosine of the observation zenith angle
c xtau: molecular optical depth
c output parameter: xrray : molecular reflectance (0.:1.)
c constant : xdep: depolarization factor (0.0279)
real xdep,pl(10)
real fs0,fs1,fs2
real as0(10),as1(2),as2(2)
real xphi,xmus,fac,xmuv,xtau,xrray,pi,phios,xcosf1,xcosf2
real xcosf3,xbeta2,xfd,xph1,xph2,xph3,xitm, xp1, xp2, xp3
real cfonc1,cfonc2,cfonc3,xlntau,xitot1,xitot2,xitot3
integer i
data (as0(i),i=1,10) /.33243832,-6.777104e-02,.16285370
s ,1.577425e-03,-.30924818,-1.240906e-02,-.10324388
s ,3.241678e-02,.11493334,-3.503695e-02/
data (as1(i),i=1,2) /.19666292, -5.439061e-02/
data (as2(i),i=1,2) /.14545937,-2.910845e-02/
pi=3.1415927
fac=pi/180.
phios=180.-xphi
xcosf1=1.
xcosf2=cos(phios*fac)
xcosf3=cos(2*phios*fac)
xbeta2=0.5
xdep=0.0279
xfd=xdep/(2-xdep)
xfd=(1-xfd)/(1+2*xfd)
xph1=1+(3*xmus*xmus-1)*(3*xmuv*xmuv-1)*xfd/8.
xph2=-xmus*xmuv*sqrt(1-xmus*xmus)*sqrt(1-xmuv*xmuv)
xph2=xph2*xfd*xbeta2*1.5
xph3=(1-xmus*xmus)*(1-xmuv*xmuv)
xph3=xph3*xfd*xbeta2*0.375
xitm=(1-exp(-xtau*(1/xmus+1/xmuv)))*xmus/(4*(xmus+xmuv))
xp1=xph1*xitm
xp2=xph2*xitm
xp3=xph3*xitm
xitm=(1-exp(-xtau/xmus))*(1-exp(-xtau/xmuv))
cfonc1=xph1*xitm
cfonc2=xph2*xitm
cfonc3=xph3*xitm
xlntau=log(xtau)
pl(1)=1.
pl(2)=xlntau
pl(3)=xmus+xmuv
pl(4)=xlntau*pl(3)
pl(5)=xmus*xmuv
pl(6)=xlntau*pl(5)
pl(7)=xmus*xmus+xmuv*xmuv
pl(8)=xlntau*pl(7)
pl(9)=xmus*xmus*xmuv*xmuv
pl(10)=xlntau*pl(9)
fs0=0.
do i=1,10
fs0=fs0+pl(i)*as0(i)
enddo
fs1=pl(1)*as1(1)+pl(2)*as1(2)
fs2=pl(1)*as2(1)+pl(2)*as2(2)
xitot1=xp1+cfonc1*fs0*xmus
xitot2=xp2+cfonc2*fs1*xmus
xitot3=xp3+cfonc3*fs2*xmus
xrray=xitot1*xcosf1
xrray=xrray+xitot2*xcosf2*2
xrray=xrray+xitot3*xcosf3*2
xrray=xrray/xmus
return
end
CLEARW.f0000644002107500000270000000354512463730616010515 0ustar jckraps subroutine clearw (r)
real sr(1501),r(1501)
integer l,i
c clear water reflectance
c warning : values of dry sand ground reflectance are given
c between 0.5 and 1.0 microns. outside this interval the
c values are set to 0.
data (sr(l),l=1,135)/ 58*0.,
a .00000, .02050, .04100, .04100, .04100, .04100, .04100,
a .04100, .04100, .04100, .04100, .04100, .04100, .04100,
a .04100, .04100, .04100, .04100, .04100, .04100, .04100,
a .04100, .04100, .04100, .04100, .04100, .04100, .04100,
a .04100, .04100, .04100, .04100, .04100, .04100, .04100,
a .04100, .04100, .04100, .04100, .04100, .04100, .04100,
a .04100, .04150, .04200, .04250, .04300, .04350, .04400,
a .04400, .04400, .04500, .04600, .04650, .04700, .04800,
a .04900, .04950, .05000, .05100, .05200, .05300, .05400,
a .05450, .05500, .05550, .05600, .05750, .05900, .05950,
a .06000, .06050, .06100, .06100, .06100, .06000, .05900/
data (sr(l),l=136,1501)/
a .05800, .05700, .05550, .05400, .05350, .05300, .05200,
a .05100, .05050, .05000, .04950, .04900, .04800, .04700,
a .04650, .04600, .04600, .04600, .04550, .04500, .04450,
a .04400, .04350, .04300, .04300, .04300, .04200, .04100,
a .04050, .04000, .03900, .03800, .03750, .03700, .03700,
a .03700, .03650, .03600, .03450, .03300, .03250, .03200,
a .03150, .03100, .03000, .02900, .02800, .02700, .02550,
a .02400, .02350, .02300, .02200, .02100, .01950, .01800,
a .01650, .01500, .01350, .01200, .01050, .00900, .00850,
a .00800, .00700, .00600, .00500, .00400, .00300, .00200,
a .00150, .00100, .00050, .00000, .00000, .00000, .00000,
a .00000, .00000, .00000, .00000, .00000, .00000, .00000,
a .00000, .00000,
a1280*0./
do 1 i=1,1501
r(i)=sr(i)
1 continue
return
end
CSALBR.f0000644002107500000270000000132712463730616010502 0ustar jckraps subroutine csalbr(xtau,xalb)
real xtau,xalb,fintexp3
xalb=(3*xtau-fintexp3(xtau)*(4+2*xtau)+2*exp(-xtau))
xalb=xalb/(4.+3*xtau)
return
end
real function fintexp3(xtau)
real xx,xtau,fintexp1
xx=(exp(-xtau)*(1.-xtau)+xtau*xtau*fintexp1(xtau))/2.
fintexp3=xx
return
end
real function fintexp1(xtau)
c accuracy 2e-07... for 0 0 for north lat., < 0 for south lat. c
c long. must be > 0 for east long., <0 for west long. c
c c
c solar and viewing positions are computed c
c c
c**********************************************************************c
read(iread,*) igeom
if (igeom.lt.0) then
if (igeom.lt.-10) then
igmax=int(abs(igeom/10))
igeom=igeom+igmax*10
endif
ilut=0
igeom=0
endif
ilut=0
goto(1001,1002,1003,1004,1005,1006,1007),igeom
c igeom=0.....
read(iread,*) asol,phi0,avis,phiv,month,jday
goto 22
c
1001 read(iread,*) month,jday,tu,nc,nl
call posmto(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1002 read(iread,*) month,jday,tu,nc,nl
call posge(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1003 read(iread,*) month,jday,tu,nc,nl
call posgw(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1004 read(iread,*) month,jday,tu,nc,xlonan,hna
campm=1.0
call posnoa(month,jday,tu,nc,xlonan,hna,campm,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1005 read(iread,*) month,jday,tu,nc,xlonan,hna
campm=-1.0
call posnoa(month,jday,tu,nc,xlonan,hna,campm,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1006 read(iread,*) month,jday,tu,xlon,xlat
call posspo(month,jday,tu,xlon,xlat,
a asol,phi0,avis,phiv)
goto 22
1007 read(iread,*) month,jday,tu,xlon,xlat
call poslan(month,jday,tu,xlon,xlat,
s asol,phi0,avis,phiv)
22 continue
if(ier) stop
dsol=1.
call varsol(jday,month,dsol)
c**********************************************************************c
c c
c / scattered direction c
c / c
c / c
c / adif c
c incident + + + + + + + + + + + + + + + c
c direction c
c c
c**********************************************************************c
phi=abs(phiv-phi0)
phirad=(phi0-phiv)*pi/180.
if (phirad.lt.0.) phirad=phirad+2.*pi
if (phirad.gt.(2.*pi)) phirad=phirad-2.*pi
xmus=cos(asol*pi/180.)
xmuv=cos(avis*pi/180.)
xmup=cos(phirad)
xmud=-xmus*xmuv-sqrt(1.-xmus*xmus)*sqrt(1.-xmuv*xmuv)*xmup
c test vermote bug
if (xmud.gt.1.) xmud=1.
if (xmud.lt.-1.) xmud=-1.
adif=acos(xmud)*180./pi
c**********************************************************************c
c idatm atmospheric model c
c -------------------- c
c c
c c
c you select one of the following standard atmosphere: idatm=0 to 6 c
c 0 no gaseous absorption c
c 1 tropical ) c
c 2 midlatitude summer ) c
c 3 midlatitude winter ) c
c 4 subarctic summer ) from lowtran c
c 5 subarctic winter ) c
c 6 us standard 62 ) c
c c
c or you define your own atmospheric model idatm=7 or 8 c
c 7 user profile (radiosonde data on 34 levels) c
c enter altitude ( in km ) c
c pressure ( in mb ) c
c temperature ( in k ) c
c h2o density (in g/m3) c
c o3 density (in g/m3) c
c c
c for example, altitudes are from 0 to 25km step of 1km c
c from 25 to 50km step of 5km c
c and two values at 70km and 100km c
c so you have 34*5 values to input. c
c 8 enter water vapor and ozone contents c
c uw (in g/cm2 ) c
c uo3 (in cm-atm) c
c profil is taken from us62 c
c c
c**********************************************************************c
uw=0.
uo3=0.
read(iread,*) idatm
if(idatm.eq.0) go to 5
if(idatm.eq.8) read(iread,*) uw,uo3
if(idatm.ne.7) go to 6
do 7 k=1,34
read(iread,*) z(k),p(k),t(k),wh(k),wo(k)
7 continue
go to 5
6 if(idatm.eq.1) call tropic
if(idatm.eq.2) call midsum
if(idatm.eq.3) call midwin
if(idatm.eq.4) call subsum
if(idatm.eq.5) call subwin
if(idatm.eq.6) call us62
c we have to define an atmosphere to compute rayleigh optical depth
5 if(idatm.eq.0.or.idatm.eq.8) call us62
c**********************************************************************c
c THIS OPTION IS NOT AVAILABLE THE CODE RUNS WITH IPOL=1 c
c ipol computation of the atmospheric polarization c
c ------------------------------------------- c
c c
c**********************************************************************c
c read(iread,*) ipol
ipol=1
c write(6,*) "WARNING IPOL IS EQUAL 0"
c**********************************************************************c
c c
c iaer aerosol model(type) and profile c
c -------------- c
c iaer = -1 The user-defined profile. You have to input the c
c number of layers first, then the height (km), c
c optical thickness (at 550 nm), and type of aerosol c
c (see below) for each layer, starting from the c
c ground. The present version of the program works c
c only with the same type of aerosol for each layer. c
c c
c Example for iaer = -1: c
c 4 c
c 2.0 0.200 1 c
c 10.0 0.025 1 c
c 8.0 0.003 1 c
c 80.0 0.000 1 c
c c
c The maximum total height of all layers cannot exceed 300 km. c
c c
c If you do not input iaer = -1, the program will use the default c
c exponential profile. In this case, you need to select one of c
c the following standard aerosol models: c
c c
c iaer = 0 no aerosols c
c 1 continental ) c
c 2 maritime ) according to d'Almeida's models c
c 3 urban ) (see the manual) c
c 5 background desert ) c
c 6 biomass burning ) from AERONET measurements c
c 7 stratospheric ) according to Russel's model c
c c
c or you define your own model using basic components: iaer=4 c
c 4 enter the volumetric percentage of each component c
c c(1) = volumetric % of dust-like c
c c(2) = volumetric % of water-soluble c
c c(3) = volumetric % of oceanic c
c c(4) = volumetric % of soot c
c between 0 to 1 c
c c
c or you define your own model using a size distribution function: c
c 8 Multimodal Log-Normal distribution (up to 4 modes) c
c 9 Modified Gamma distribution c
c 10 Junge Power-Law distribution c
c c
c or you define a model using sun-photometer measurements: c
c 11 Sun Photometer distribution (50 values max) c
c you have to enter: r and dV/d(logr) c
c where r is the radius (in micron), V is the volume, c
c and dV/d(logr) is in (cm3/cm2/micron) c
c then you have to enter: nr and ni for each wavelength c
c where nr and ni are respectively the real and the c
c imaginary parts of the refractive index c
c c
c or you can use the results computed and saved previously c
c 12 Reading of data previously saved into FILE c
c you have to enter the identification name FILE in the c
c next line of inputs. c
c c
c c
c iaerp and FILE aerosol model(type)-Printing of results c
c --------------------------------------- c
c c
c For iaer=8,9,10,and 11: c
c results from the MIE subroutine may be saved into the file c
c FILE.mie (Extinction and scattering coefficients, single c
c scattering albedo, asymmetry parameter, phase function at c
c predefined wavelengths) and then can be re-used with the c
c option iaer=12 where FILE is an identification name you c
c have to enter. c
c c
c So, if you select iaer=8,9,10, or 11, you will have to enter c
c iaerp after the inputs requested by options 8,9,10, or 11: c
c c
c iaerp=0 results will not be saved c
c iaerp=1 results will be saved into the file FILE.mie c
c next line enter FILE c
c c
c c
c Example for iaer and iaerp c
c 8 Multimodal Log-Normal distribution selected c
c 0.001 20 3 Rmin, Rmax, 3 components c
c 0.471 2.512 0.17 Rmean, Sigma, % density - 1st component c
c 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.528 c
c 1.52 1.462 1.4 1.368 1.276 1.22 1.2 nr for 20 wavelengths c
c 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 c
c 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.0085 0.011 ni c
c 0.0285 2.239 0.61 Rmean, Sigma, % density - 2nd component c
c 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.528 c
c 1.52 1.51 1.42 1.42 1.42 1.42 1.452 nr for 20 wavelengths c
c 0.005 0.005 0.005 0.005 0.005 0.005 0.0053 0.006 0.006 0.0067 0.007 c
c 0.007 0.0088 0.0109 0.0189 0.0218 0.0195 0.0675 0.046 0.004 ni c
c 0.0118 2.0 0.22 Rmean, Sigma, % density - 3rd component c
c 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 c
c 1.75 1.77 1.791 1.796 1.808 1.815 1.9 nr for 20 wavelengths c
c 0.465 0.46 0.4588 0.4557 0.453 0.4512 0.447 0.44 0.436 0.435 0.433 c
c 0.4306 0.43 0.433 0.4496 0.4629 0.472 0.488 0.5 0.57 ni c
c 1 Results will be saved into FILE.mie c
c Urban_Indust Identification of the output file (FILE) c
c -> results will be saved into Urban_Indust.mie c
c c
c**********************************************************************c
rmin=0.
rmax=0.
icp=1
do i=1,4
x1(i)=0.0
x2(i)=0.0
x3(i)=0.0
do l=1,20
rn(l,i)=0.0
ri(l,i)=0.0
enddo
enddo
do i=1,50
rsunph(i)=0.
nrsunph(i)=0.
enddo
cij(1)=1.00
taer=0.
taer55=0.
iaer_prof=0
read(iread,*) iaer
c the user-defined aerosol profile
if (iaer.lt.0) then
total_height=0.0
iaer_prof=1
num_z=0
do i=0,50
alt_z(i)=0.0
taer55_z(i)=0.0
taer_z(i)=0.0
height_z(i)=0.0
enddo
read(5,*) num_z
do i=0,num_z-1
read(5,*) height_z(num_z-i),taer55_z(num_z-i),iaer
alt_z(num_z-1-i)=total_height+height_z(num_z-i)
total_height=total_height+height_z(num_z-i)
taer55=taer55+taer55_z(num_z-i)
enddo
endif
c the user-defined aerosol profile
if (iaer.ge.0.and.iaer.le.7) nquad=nqdef_p
if (iaer.ge.8.and.iaer.le.11) nquad=nquad_p
if(iaer.eq.4) read(iread,*) (c(n),n=1,4)
goto(49,40,41,42,49,49,49,49,43,44,45,46,47),iaer+1
40 c(1)=0.70
c(2)=0.29
c(3)=0.00
c(4)=0.01
go to 49
41 c(1)=0.00
c(2)=0.05
c(3)=0.95
c(4)=0.00
go to 49
42 c(1)=0.17
c(2)=0.61
c(3)=0.00
c(4)=0.22
go to 49
43 read(iread,*) rmin,rmax,icp
do i=1,icp
read(5,*)x1(i),x2(i),cij(i)
read(5,*)(rn(l,i),l=1,20)
read(5,*)(ri(l,i),l=1,20)
enddo
do i=1,icp
cij_out(i)=cij(i)
enddo
go to 49
44 read(iread,*) rmin,rmax
read(iread,*) x1(1),x2(1),x3(1)
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
45 read(iread,*) rmin,rmax
read(iread,*) x1(1)
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
46 read(5,*)irsunph
do i=1,irsunph
read(5,*)rsunph(i),nrsunph(i)
C nrsunph(i)=nrsunph(i)/(rsunph(i)**4.)/(4*3.1415/3)
enddo
rmin=rsunph(1)
rmax=rsunph(irsunph)+1e-07
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
47 read(5,'(A80)')FILE2
i2=index(FILE2,' ')-1
go to 49
49 continue
if (iaer.ge.8.and.iaer.le.11)then
read(5,*)iaerp
if (iaerp.eq.1)read(5,'(A80)')FILE
i1=index(FILE,' ')-1
FILE2=FILE(1:I1)//'.mie'
i2=index(FILE2,' ')-1
endif
call aeroso(iaer,c,xmud,wldis,FILE2,ipol)
c**********************************************************************c
c aerosol model (concentration) c
c ---------------------------- c
c (only for the default exponential profile) c
c c
c v if you have an estimate of the meteorological c
c parameter: the visibility v, enter directly the c
c value of v in km (the aerosol optical depth will c
c be computed from a standard aerosol profile) c
c c
c v=0, taer55 if you have an estimate of aerosol optical depth , c
c enter v=0 for the visibility and enter the aerosol c
c optical depth at 550 c
c c
c v=-1 warning: if iaer=0, enter v=-1 c
c c
c**********************************************************************c
if (iaer_prof.eq.0) then
read(iread,*) v
if(v) 71,10,11
10 read(iread,*) taer55
v=exp(-log(taer55/2.7628)/0.79902)
goto 71
11 call oda550(iaer,v,taer55)
71 continue
endif
c**********************************************************************c
c xps is the parameter to express the altitude of target c
c c
c c
c xps >=0. the pressure is given in mb c
c c
c xps <0. means you know the altitude of the target c
c expressed in km and you put that value as xps c
c c
c c
c**********************************************************************c
771 read(iread,*) xps
if (idatm.ne.8) then
call pressure(uw,uo3,xps)
else
call pressure(uwus,uo3us,xps)
endif
c**********************************************************************c
c c
c xpp is the parameter to express the sensor altitude c
c c
c c
c xpp= -1000 means that the sensor is a board a satellite c
c xpp= 0 means that the sensor is at the ground level c
c c
c c
c for aircraft simulations c
c -100< xpp <0 means you know the altitude of the sensor expressed c
c in kilometers units c
c this altitude is relative to the target altitude c
c c
c for aircraft simulations only, you have to give c
c puw,po3 (water vapor content,ozone content between the c
c aircraft and the surface) c
c taerp (the aerosol optical thickness at 550nm between the c
c aircraft and the surface) c
c if these data are not available, enter negative values for all c
c of them, puw,po3 will then be interpolated from the us62 standard c
C profile according to the values at ground level. Taerp will be c
c computed according to a 2km exponential profile for aerosol. c
c**********************************************************************c
read(iread,*) xpp
xpp=-xpp
if (xpp.le.0.0) then
c ground measurement option
palt=0.
pps=p(1)
idatmp=0
taer55p=0.
puw=0.
puoz=0.
else
if (xpp.ge.100.) then
c satellite case of equivalent
palt=1000.
pps=0.
taer55p=taer55
ftray=1.
idatmp=4
else
c "real" plane case
read(iread,*) puw,puo3
if (puw.lt.0.) then
call presplane(puw,puo3,xpp,ftray)
idatmp=2
if (idatm.eq.8) then
puwus=puw
puo3us=puo3
puw=puw*uw/uwus
puo3=puo3*uo3/uo3us
idatmp=8
endif
else
call presplane(puwus,puo3us,xpp,ftray)
idatmp=8
endif
if(ier) stop
palt=zpl(34)-z(1)
pps=ppl(34)
read(iread,*) taer55p
if ((taer55p.lt.0.).or.((taer55-taer55p).lt.accu2)) then
c a scale heigh of 2km is assumed in case no value is given for taer55p
taer55p=taer55*(1.-exp(-palt/2.))
else
C compute effective scale heigh
sham=exp(-palt/4.)
sha=1.-(taer55p/taer55)
if (sha.ge.sham) then
taer55p=taer55*(1.-exp(-palt/4.))
else
sha=-palt/log(sha)
taer55p=taer55*(1.-exp(-palt/sha))
endif
endif
endif
endif
c**********************************************************************c
c iwave input of the spectral conditions c
c -------------------------------- c
c c
c you choose to define your own spectral conditions: iwave=-1,0 or 1 c
c (three user s conditions ) c
c -2 enter wlinf, wlsup, the filter function will be equal to 1c
c over the whole band (as iwave=0) but step by step output c
c will be printed c
c -1 enter wl (monochr. cond, gaseous absorption is included) c
c c
c 0 enter wlinf, wlsup. the filter function will be equal to 1c
c over the whole band. c
c c
c 1 enter wlinf, wlsup and user's filter function s(lambda) c
c ( by step of 0.0025 micrometer). c
c c
c c
c or you select one of the following satellite spectral bands: c
c with indication in brackets of the band limits used in the code : c
c iwave=2 to 60 c
c 2 vis band of meteosat ( 0.350-1.110 ) c
c 3 vis band of goes east ( 0.490-0.900 ) c
c 4 vis band of goes west ( 0.490-0.900 ) c
c 5 1st band of avhrr(noaa6) ( 0.550-0.750 ) c
c 6 2nd " ( 0.690-1.120 ) c
c 7 1st band of avhrr(noaa7) ( 0.500-0.800 ) c
c 8 2nd " ( 0.640-1.170 ) c
c 9 1st band of avhrr(noaa8) ( 0.540-1.010 ) c
c 10 2nd " ( 0.680-1.120 ) c
c 11 1st band of avhrr(noaa9) ( 0.530-0.810 ) c
c 12 2nd " ( 0.680-1.170 ) c
c 13 1st band of avhrr(noaa10 ( 0.530-0.780 ) c
c 14 2nd " ( 0.600-1.190 ) c
c 15 1st band of avhrr(noaa11 ( 0.540-0.820 ) c
c 16 2nd " ( 0.600-1.120 ) c
c 17 1st band of hrv1(spot1) ( 0.470-0.650 ) c
c 18 2nd " ( 0.600-0.720 ) c
c 19 3rd " ( 0.730-0.930 ) c
c 20 pan " ( 0.470-0.790 ) c
c 21 1st band of hrv2(spot1) ( 0.470-0.650 ) c
c 22 2nd " ( 0.590-0.730 ) c
c 23 3rd " ( 0.740-0.940 ) c
c 24 pan " ( 0.470-0.790 ) c
c 25 1st band of tm(landsat5) ( 0.430-0.560 ) c
c 26 2nd " ( 0.500-0.650 ) c
c 27 3rd " ( 0.580-0.740 ) c
c 28 4th " ( 0.730-0.950 ) c
c 29 5th " ( 1.5025-1.890 ) c
c 30 7th " ( 1.950-2.410 ) c
c 31 MSS band 1 (0.475-0.640) c
c 32 MSS band 2 (0.580-0.750) c
c 33 MSS band 3 (0.655-0.855) c
c 34 MSS band 4 ( 0.785-1.100 ) c
c 35 1st band of MAS (ER2) ( 0.5025-0.5875) c
c 36 2nd " ( 0.6075-0.7000) c
c 37 3rd " ( 0.8300-0.9125) c
c 38 4th " ( 0.9000-0.9975) c
c 39 5th " ( 1.8200-1.9575) c
c 40 6th " ( 2.0950-2.1925) c
c 41 7th " ( 3.5800-3.8700) c
c 42 MODIS band 1 ( 0.6100-0.6850) c
c 43 MODIS band 2 ( 0.8200-0.9025) c
c 44 MODIS band 3 ( 0.4500-0.4825) c
c 45 MODIS band 4 ( 0.5400-0.5700) c
c 46 MODIS band 5 ( 1.2150-1.2700) c
c 47 MODIS band 6 ( 1.6000-1.6650) c
c 48 MODIS band 7 ( 2.0575-2.1825) c
c 49 1st band of avhrr(noaa12 ( 0.500-1.000 ) c
c 50 2nd " ( 0.650-1.120 ) c
c 51 1st band of avhrr(noaa14 ( 0.500-1.110 ) c
c 52 2nd " ( 0.680-1.100 ) c
c 53 POLDER band 1 ( 0.4125-0.4775) c
c 54 POLDER band 2 (non polar( 0.4100-0.5225) c
c 55 POLDER band 3 (non polar( 0.5325-0.5950) c
c 56 POLDER band 4 P1 ( 0.6300-0.7025) c
c 57 POLDER band 5 (non polar( 0.7450-0.7800) c
c 58 POLDER band 6 (non polar( 0.7000-0.8300) c
c 59 POLDER band 7 P1 ( 0.8100-0.9200) c
c 60 POLDER band 8 (non polar( 0.8650-0.9400) c
c 61 SEAWIFS band 1 ( 0.3825-0.70) c
c 62 SEAWIFS band 2 ( 0.3800-0.58) c
c 63 SEAWIFS band 3 ( 0.3800-1.02) c
c 64 SEAWIFS band 4 ( 0.3800-1.02) c
c 65 SEAWIFS band 5 ( 0.3825-1.15) c
c 66 SEAWIFS band 6 ( 0.3825-1.05) c
c 67 SEAWIFS band 7 ( 0.3800-1.15) c
c 68 SEAWIFS band 8 ( 0.3800-1.15) c
c 69 AATSR band 1 ( 0.5250-0.5925) c
c 70 AATSR band 2 ( 0.6275-0.6975) c
c 71 AATSR band 3 ( 0.8325-0.9025) c
c 72 AATSR band 4 ( 1.4475-1.7775) c
c 73 MERIS band 01 ( 0.412) c
c 74 MERIS band 02 ( 0.442) c
c 75 MERIS band 03 ( 0.489) c
c 76 MERIS band 04 ( 0.509) c
c 77 MERIS band 05 ( 0.559) c
c 78 MERIS band 06 ( 0.619) c
c 79 MERIS band 07 ( 0.664) c
c 80 MERIS band 08 ( 0.681) c
c 81 MERIS band 09 ( 0.708) c
c 82 MERIS band 10 ( 0.753) c
c 83 MERIS band 11 ( 0.760) c
c 84 MERIS band 12 ( 0.778) c
c 85 MERIS band 13 ( 0.865) c
c 86 MERIS band 14 ( 0.885) c
c 87 MERIS band 15 ( 0.900) c
c 88 GLI band 1 (0.380-1km) c
c 89 GLI band 2 (0.400-1km) c
c 90 GLI band 3 (0.412-1km) c
c 91 GLI band 4 (0.443-1km) c
c 92 GLI band 5 (0.460-1km) c
c 93 GLI band 6 (0.490-1km) c
c 94 GLI band 7 (0.520-1km) c
c 95 GLI band 8 (0.545-1km) c
c 96 GLI band 9 (0.565-1km) c
c 97 GLI band 10 (0.625-1km) c
c 98 GLI band 11 (0.666-1km) c
c 99 GLI band 12 (0.680-1km) c
c 100 GLI band 13 (0.678-1km) c
c 101 GLI band 14 (0.710-1km) c
c 102 GLI band 15 (0.710-1km) c
c 103 GLI band 16 (0.749-1km) c
c 104 GLI band 17 (0.763-1km) c
c 105 GLI band 18 (0.865-1km) c
c 106 GLI band 19 (0.865-1km) c
c 107 GLI band 20 (0.460-0.25km) c
c 108 GLI band 21 (0.545-0.25km) c
c 109 GLI band 22 (0.660-0.25km) c
c 110 GLI band 23 (0.825-0.25km) c
c 111 GLI band 24 (1.050-1km) c
c 112 GLI band 25 (1.135-1km) c
c 113 GLI band 26 (1.240-1km) c
c 114 GLI band 27 (1.338-1km) c
c 115 GLI band 28 (1.640-1km) c
c 116 GLI band 29 (2.210-1km) c
c 117 GLI band 30 (3.715-1km) c
c 118 ALI band 1p (0.4225-0.4625) c
c 119 ALI band 1 (0.4325-0.550) c
c 120 ALI band 2 (0.500-0.630) c
c 121 ALI band 3 (0.5755-0.730) c
c 122 ALI band 4 (0.7525-0.8375) c
c 123 ALI band 4p (0.8025-0.935) c
c 124 ALI band 5p (1.130-1.345) c
c 125 ALI band 5 (1.470-1.820) c
c 126 ALI band 7 (1.980-2.530) c
c 127 ASTER band 1 (0.485-0.6425) c
c 128 ASTER band 2 (0.590-0.730) c
c 129 ASTER band 3n (0.720-0.9075) c
c 130 ASTER band 3b (0.720-0.9225) c
c 131 ASTER band 4 (1.570-1.7675) c
c 132 ASTER band 5 (2.120-2.2825) c
c 133 ASTER band 6 (2.150-2.295) c
c 134 ASTER band 7 (2.210-2.390) c
c 135 ASTER band 8 (2.250-2.440) c
c 136 ASTER band 9 (2.2975-2.4875) c
c 137 ETM band 1 (0.435-0.52) c
c 138 ETM band 2 (0.5-0.6225) c
c 139 ETM band 3 (0.615-0.7025) c
c 140 ETM band 4 (0.74-0.9125) c
c 141 ETM band 5 (1.51-1.7875) c
c 142 ETM band 7 (2.015-2.3775) c
c 143 HYPBLUE band 1 (0.4375-0.500) c
c 144 HYPBLUE band 2 (0.435-0.52) c
c 145 VGT band 1 (0.4175-0.500) c
c 146 VGT band 2 (0.5975-0.7675) c
c 147 VGT band 3 (0.7325-0.9575) c
c 148 VGT band 4 (1.5225-1.800) c
c 149 VIIRS band M1 (0.4025-0.4225) c
c 150 VIIRS band M2 (0.4350-0.4550) c
c 151 VIIRS band M3 (0.4775-0.4975) c
c 152 VIIRS band M4 (0.5450-0.5650) c
c 153 VIIRS band M5 (0.6625-0.6825) c
c 154 VIIRS band M6 (0.7375-0.7525) c
c 155 VIIRS band M7 (0.8450-0.8850) c
c 156 VIIRS band M8 (1.2300-1.2500) c
c 157 VIIRS band M9 (1.3700-1.3850) c
c 158 VIIRS band M10 (1.5800-1.6400) c
c 159 VIIRS band M11 (2.2250-2.2750) c
c 160 VIIRS band M12 (3.6100-3.7900) c
c 161 VIIRS band I1 (0.6000-0.6800) c
c 162 VIIRS band I2 (0.8450-0.8850) c
c 163 VIIRS band I3 (1.5800-1.6400) c
c 164 VIIRS band I4 (3.5500-3.9300) c
c 165 LDCM band 1 (0.4275-0.4575) c
c 166 LDCM band 2 (0.4375-0.5275) c
c 167 LDCM band 3 (0.5125-0.6000) c
c 168 LDCM band 4 (0.6275-0.6825) c
c 169 LDCM band 5 (0.8300-0.8950) c
c 170 LDCM band 6 (1.5175-1.6950) c
c 171 LDCM band 7 (2.0375-2.3500) c
c 172 LDCM band 8 (0.4875-0.6925) c
c 173 LDCM band 9 (1.3425-1.4025) c
c 174 MODISkm band 8 (0.4025-0.4225) c
c 175 MODISkm band 9 (0.4325-0.4500) c
c 176 MODISkm band 10 (0.4775-0.4950) c
c 177 MODISkm band 11 (0.5200-0.5400) c
c 178 MODISkm band 12 (0.5375-0.5550) c
c 179 MODISkm band 13 (0.6575-0.6750) c
c 180 MODISkm band 14 (0.6675-0.6875) c
c 181 MODISkm band 15 (0.7375-0.7575) c
c 182 MODISkm band 16 (0.8525-0.8825) c
c 183 MODISkm band 17 (0.8725-0.9375) c
c 184 MODISkm band 18 (0.9225-0.9475) c
c 185 MODISkm band 19 (0.8900-0.9875) c
c 186 CAVIS band 1 (0.4275-0.4575) c
c 187 CAVIS band 2 (0.4375-0.5275) c
c 188 CAVIS band 3 (0.5125-0.6000) c
c 189 CAVIS band 4 (0.6275-0.6825) c
c 190 CAVIS band 5 (0.8300-0.8950) c
c 191 CAVIS band 6 (1.3425-1.4025) c
c 192 CAVIS band 7 (1.5175-1.6950) c
c 193 CAVIS band 8 (2.0375-2.3500) c
c 194 CAVIS band 9 (0.4875-0.6925) c
c 195 CAVIS band 10 (0.4875-0.6925) c
c 196 CAVIS band 11 (0.5100-0.6200) c
c 197 DMC band 1 (0.4875-0.6925) c
c 198 DMC band 2 (0.6100-0.7100) c
c 199 DMC band 3 (0.7525-0.9275) c
c note: wl has to be in micrometer c
c**********************************************************************c
do 38 l=iinf,isup
s(l)=1.
38 continue
read(iread,*) iwave
if (iwave.eq.-2) goto 1600
if (iwave) 16,17,18
16 read(iread,*) wl
wlinf=wl
wlsup=wl
go to 19
17 read(iread,*) wlinf,wlsup
go to 19
1600 read(iread,*) wlinf,wlsup
go to 19
c 110
c 111 band of meteosat (2)
c 112 band of goes (3,4)
c 114 band of avhr (5,16)
c 118 band of hrv1 (17,24)
c 121 band of tm (25,30)
c 127 band of mss (31,34)
c 128 band of MAS (35,41)
c 129 MODIS band (42,49)
c 130 band of avhrr (50,53)
c 131 POLDER band (54,61)
c 113 SEAWIFS band (62,69)
c 150 AATSR band (70,73)
c 151 MERIS band (74,88)
c 152 GLI band (89,118)
c 153 ALI band (119,127)
c 154 ASTER band (128,137)
c 155 ETM band (138,143)
c 156 HYPBLUE band (144,145)
c 157 VGT band (146,149)
c 159 VIIRS band (149,164)
c 161 LDCM band (165,173)
c 162 MODIS1km band (174,185)
c 163 CAVIS band (186,196)
c 164 DMC band (197,199)
18 goto (110,
s 111,
s 112,112,
s 114,114,114,114,114,114,114,114,114,114,114,114,
s 118,118,118,118,118,118,118,118,
s 121,121,121,121,121,121,
s 127,127,127,127,
s 128,128,128,128,128,128,128,
s 129,129,129,129,129,129,129,
s 130,130,130,130,
s 131,131,131,131,131,131,131,131,
s 113,113,113,113,113,113,113,113,
s 150,150,150,150,
s 151,151,151,151,151,151,151,151,
s 151,151,151,151,151,151,151,
s 152,152,152,152,152,152,152,152,152,152,
s 152,152,152,152,152,152,152,152,152,152,
s 152,152,152,152,152,152,152,152,152,152,
s 153,153,153,153,153,153,153,153,153,
s 154,154,154,154,154,154,154,154,154,154,
s 155,155,155,155,155,155,
s 156,156,
s 157,157,157,157,
s 159,159,159,159,159,159,159,159,159,159,
s 159,159,159,159,159,159,
s 161,161,161,161,161,161,161,161,161,
s 162,162,162,162,162,162,162,162,162,162,162,162,
s 163,163,163,163,163,163,163,163,163,163,163,
s 164,164,164),iwave
110 read(iread,*) wlinf,wlsup
iinf=(wlinf-.25)/0.0025+1.5
isup=(wlsup-.25)/0.0025+1.5
do 1113 ik=iinf,isup
s(ik)=0.
1113 continue
read(iread,*) (s(i),i=iinf,isup)
goto 20
111 call meteo
go to 19
112 call goes(iwave-2)
go to 19
114 call avhrr(iwave-4)
go to 19
118 call hrv(iwave-16)
go to 19
121 call tm(iwave-24)
go to 19
127 call mss(iwave-30)
goto 19
128 call mas(iwave-34)
goto 19
129 call modis(iwave-41)
goto 19
130 call avhrr(iwave-48)
goto 19
131 call polder(iwave-52)
goto 19
113 call seawifs(iwave-60)
goto 19
150 call aatsr(iwave-68)
goto 19
151 call meris(iwave-72)
goto 19
152 call gli(iwave-87)
goto 19
153 call ali(iwave-117)
goto 19
154 call aster(iwave-126)
goto 19
155 call etm(iwave-136)
goto 19
156 call hypblue(iwave-142)
goto 19
157 call vgt(iwave-144)
goto 19
159 call viirs(iwave-148)
goto 19
161 call ldcm(iwave-164)
goto 19
162 call modis1km(iwave-173)
goto 19
163 call cavis(iwave-185)
goto 19
164 call dmc(iwave-196)
goto 19
19 iinf=(wlinf-.25)/0.0025+1.5
isup=(wlsup-.25)/0.0025+1.5
if (iprtspr.eq.1) then
do i=iinf,isup
write(6,*) "spres ",(i-1)*0.0025+0.25,s(i)
enddo
endif
20 continue
C***********************************************************************
C LOOK UP TABLE INITIALIZATION
C***********************************************************************
C initialization of look up table variable
C Write(6,*) "TOTO THE HERO"
do i=1,mu
nfilut(i)=0
do j=1,41
rolut(i,j)=0.
rolutq(i,j)=0.
rolutu(i,j)=0.
filut(i,j)=0.
roluti(i,j)=0.
rolutiq(i,j)=0.
rolutiu(i,j)=0.
enddo
enddo
xmus=cos(asol*pi/180.)
its=acos(xmus)*180.0/pi
C Case standart LUT
if (ilut.eq.1) then
do i=1,mu-1
lutmuv=rm(i)
luttv=acos(lutmuv)*180./pi
iscama=(180-abs(luttv-its))
iscami=(180-(luttv+its))
nbisca=int(0.01+(iscama-iscami)/4.0)+1
nfilut(i)=nbisca
filut(i,1)=0.0
filut(i,nbisca)=180.0
scaa=iscama
do j=2,nfilut(i)-1
scaa=scaa-4.0
cscaa=cos(scaa*pi/180.)
cfi=-(cscaa+xmus*lutmuv)/(sqrt(1-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv))
filut(i,j)=acos(cfi)*180.0/pi
enddo
enddo
i=mu
lutmuv=cos(avis*pi/180.)
luttv=acos(lutmuv)*180./pi
iscama=(180-abs(luttv-its))
iscami=(180-(luttv+its))
nbisca=int((iscama-iscami)/4)+1
nfilut(i)=nbisca
filut(i,1)=0.0
filut(i,nbisca)=180.0
scaa=iscama
do j=2,nfilut(i)-1
scaa=scaa-4.0
cscaa=cos(scaa*pi/180.)
cfi=-(cscaa+xmus*lutmuv)/(sqrt(1-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv))
filut(i,j)=acos(cfi)*180.0/pi
enddo
endif
C END Case standart LUT
C Case LUT for APS
if (ilut.eq.3) then
do i=1,mu-1
nbisca=2
nfilut(i)=nbisca
filut(i,1)=(phi0-phiv)
filut(i,nbisca)=(phi0-phiv)+180.0
enddo
i=mu
nbisca=1
nfilut(i)=nbisca
filut(i,1)=(phi0-phiv)
endif
C END Case LUT for APS
CCCC Check initialization (debug)
do i=1,mu
lutmuv=rm(i)
luttv=acos(lutmuv)*180./pi
do j=1,nfilut(i)
cscaa=-xmus*lutmuv-cos(filut(i,j)*pi/180.)*sqrt(1.-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv)
scaa=acos(cscaa)*180./pi
write(6,*) its,luttv,filut(i,j),scaa
enddo
enddo
CCCC Check initialization (debug)
C***********************************************************************
C END LOOK UP TABLE INITIALIZATION
C***********************************************************************
c**********************************************************************c
c here, we first compute an equivalent wavelenght which is the input c
c value for monochromatic conditions or the integrated value for a c
c filter functionr (call equivwl) then, the atmospheric properties are c
c computed for that wavelength (call discom then call specinterp) c
c molecular optical thickness is computed too (call odrayl). lastly c
c the successive order of scattering code is called three times. c
c first for a sun at thetas with the scattering properties of aerosols c
c and molecules, second with a pure molecular atmosphere, then with thec
c actual atmosphere for a sun at thetav. the iso code allows us to c
c compute the scattering transmissions and the spherical albedo. all c
c these computations are performed for checking the accuracy of the c
c analytical expressions and in addition for computing the averaged c
c directional reflectances c
c**********************************************************************c
if(iwave.ne.-1) then
call equivwl(iinf,isup,step,
s wlmoy)
else
wlmoy=wl
endif
call discom (idatmp,iaer,iaer_prof,xmus,xmuv,phi,taer55,taer55p,
a palt,phirad,nt,mu,np,rm,gb,rp,ftray,ipol,xlm1,xlm2,
a roatm_fi,nfi,
a nfilut,filut,roluts,rolutsq,rolutsu)
c write(6,*) "wlmoy",wlmoy
if(iaer.ne.0) then
call specinterp(wlmoy,taer55,taer55p,
s tamoy,tamoyp,pizmoy,pizmoyp,ipol)
else
tamoy=0.
tamoyp=0.
endif
call odrayl(wlmoy,
s trmoy)
trmoyp=trmoy*ftray
if (idatmp.eq.4) then
trmoyp=trmoy
tamoyp=tamoy
endif
if (idatmp.eq.0) then
trmoyp=0.
tamoyp=0.
endif
c*********************************************************************c
c inhomo ground reflectance (type) c
c ------------------ c
c c
c you consider an homogeneous surface: c
c enter - inhomo=0 c
c you may consider directional surface effects c
c idirec=0 (no directional effect) c
c you have to specify the surface reflectance:c
c igroun (see note1) which is uniform and c
c lambertian c
c idirec=1 ( directional effect) c
c you have to specify the brdf of the surface c
c for the actual solar illumination you are c
c considering as well as the for a sun c
c which would be at an angle thetav, in c
c addition you have to give the surface c
c albedo (spherical albedo). you can also c
c select one of the selected model from the c
c ibrdf value (see note2). 3 reflectances c
c are computed, robar,robarp and robard c
c c
c you consider a non uniform surface, the surface is considered as a c
c circular target with a reflectance roc and of radius r c
c (expressed in km) within an environment of reflectance c
c roe c
c enter - inhomo=1, then c
c igrou1,igrou2,rad c
c - the target reflectance :igrou1 (see note1) c
c - the envir. reflectance :igrou2 (see note1) c
c - the target radius in km c
c c
c c
c ****tree**** c
c c
c inhomo c
c / \ c
c / \ c
c / \ c
c / \ c
c ------- 0 ------- -----1 ----- c
c / / \ \ c
c idirec / \ \ c
c / \ / \ \ c
c / \ / \ \ c
c / \ igrou1 igrou2 rad c
c 0 1 roc roe f(r) c
c / \ c
c / \ c
c igroun ibrdf c
c (roc = roe) (roc) c
c (robar) c
c (robarp) c
c (robard) c
c c
c ground reflectance (spectral variation) c
c --------------------------------------- c
c note1: values of the reflectance selected by igroun,igrou1 or igrou2 c
c may correspond to the following cases, c
c 0 constant value of ro (or roc,or roe) whatever the wavelen c
c gth. you enter this constant value of ro (or roc or roe). c
c -1 you have to enter the value of ro (or roc,or roe) by step c
c of 0.0025 micron from wlinf to wlsup (if you have used thec
c satellite bands,see implicit values for these limits). c
c 1 mean spectral value of green vegetation c
c 2 mean spectral value of clear water c
c 3 mean spectral value of sand c
c 4 mean spectral value of lake water c
c c
c ground reflectance (brdf) c
c ------------------------- c
c note2: values of the directional reflectance is assumed spectrally c
c independent, so you have to specify, the brdf at the c
c wavelength for monochromatic condition of the mean value c
c over the spectral band c
c 0 you have to enter the value of ro for sun at thetas by c
c step of 10 degrees for zenith view angles (from 0 to 80 c
c and the value for 85) and by step of 30 degrees for c
c azimuth view angles from 0 to 360 degrees, you have to do c
c same for a sun which would be at thetav. in addition, the c
c spherical albedo of the surface has to be specified ,as c
C well as the observed reflectance in the selected geometry c
c rodir(sun zenith,view zenith, relative azimuth). c
c c
c you also may select one of the following models c
c 1 hapke model c
c the parameters are: om,af,s0,h c
c om= albedo c
c af=assymetry parameter for the phase function c
c s0=amplitude of hot spot c
c h=width of the hot spot c
c c
c 2 verstraete et al. model c
c the parameters are: c
c there is three lines of parameters: c
c line 1 (choice of options) c
c line 2 (structural parameters) c
c line 3 (optical parameters) c
c line 1: opt3 opt4 opt5 c
c opt1=1 parametrized model (see verstraete et al., c
c JGR, 95, 11755-11765, 1990) c
c opt2=1 reflectance factor (see pinty et al., JGR, c
c 95, 11767-11775, 1990) c
c opt3=0 for given values of kappa (see struc below)c
c 1 for goudriaan's parameterization of kappa c
c 2 for dickinson et al's correction to c
c goudriaan's parameterization of kappa (see c
c dickinson et al., agricultural and forest c
c meteorology, 52, 109-131, 1990) c
c ---see the manual for complete references---- c
c opt4=0 for isotropic phase function c
c 1 for heyney and greensteins' phase function c
c 2 for legendre polynomial phase function c
c opt5=0 for single scattering only c
c 1 for dickinson et al. parameterization of c
c multiple scattering c
c line 2: str1 str2 str3 str4 c
c str1='leaf area density', in m2 m-3 c
c str2=radius of the sun flecks on the scatterer (m)c
c str3=leaf orientation parameter: c
c if opt3=0 then str3=kappa1 c
c if opt3=1 or 2 then str3=chil c
c str4=leaf orientation parameter (continued): c
c if opt3=0 then str4=kappa2 c
c if opt3=1 or 2 then str4 is not used c
c line 3: optics1 optics2 optics3 c
c optics1=single scattering albedo, n/d value c
c between 0.0 and 1.0 c
c optics2= phase function parameter: c
c if opt4=0 then this input is not used c
c if opt4=1 then asymmetry factor, n/d value c
c between -1.0and 1.0 c
c if opt4=2 then first coefficient of legendre c
c polynomial c
c optics3=second coefficient of legendre polynomial c
c (if opt4=2) c
c c
c 3 Roujean et al. model c
c the parameters are: k0,k1,k2 c
c k0=albedo. c
c k1=geometric parameter for hot spot effect c
c k2=geometric parameter for hot spot effect c
c c
c 4 walthall et al. model c
c the parameters are: a,ap,b,c c
c a=term in square ts*tv c
c ap=term in square ts*ts+tv*tv c
c b=term in ts*tv*cos(phi) (limacon de pascal) c
c c=albedo c
c c
c 5 minnaert model c
c the parameters are: par1,par2 c
c c
c 6 Ocean c
c the parameter are: pws,phi_wind,xsal,pcl c
c pws=wind speed (in m/s) c
c phi_wind=azim. of the wind (in degres) c
c xsal=salinity (in ppt) xsal=34.3ppt if xsal<0 c
c pcl=pigment concentration (in mg/m3) c
c c
c 7 Iaquinta and Pinty model c
c the parameters are: c
c there is 3 lines of parameters: c
c line 1: choice of option (pild,pihs) c
c line 2: structural parameters (pxLt,pc) c
c line 3: optical parameters (pRl,pTl,pRs) c
c Line 1: pild,pihs c
c pild=1 planophile leaf distribution c
c pild=2 erectophile leaf distribution c
c pild=3 plagiophile leaf distribution c
c pild=4 extremophile leaf distribution c
c pild=5 uniform leaf distribution c
c c
c pihs=0 no hot spot c
c pihs=1 hot spot c
c Line 2: pxLt,pc c
c pxLt=Leaf area index [1.,15.] c
c pc=Hot spot parameter: 2*r*Lambda [0.,2.] c
c Line 3: pRl,pTl,pRs c
c pRl=Leaf reflectance [0.,0.99] c
c pTl=Leaf transmitance [0.,0.99] c
c pRs=Soil albedo [0.,0.99] c
c NB: pRl+PTl <0.99 c
c c
c 8 Rahman et al. model c
c the parameters are: rho0,af,xk c
c rho0=Intensity of the reflectance of the surface c
c cover, N/D value greater or equal to 0 c
c af=Asymmetry factor, N/D value between -1.0 and 1.0 c
c xk=Structural parameter of the medium c
c 9 Kuusk's multispectral CR model c
c Reference: c
c Kuusk A. A multispectral canopy reflectance model. c
c Remote Sens. Environ., 1994, 50:75-82 c
c c
c c
c the parameters are: c
c c
c line 1: structural parameters (ul,eps,thm,sl) c
c line 2: optical parameters (cAB,cW,N,cn,s1) c
c c
c ul=LAI [0.1...10] c
c eps,thm - LAD parameters c
c eps [0.0..0.9] thm [0.0..90.0] c
c sl - relative leaf size [0.01..1.0] c
c cAB - chlorophyll content, ug/cm^2 [30] c
c cW - leaf water equivalent thickness [0.01..0.03] c
c N - the effective number of elementary layers c
c inside a leaf [1.225] c
c cn - the ratio of refractive indices of the leaf c
c surface wax and internal material [1.0] c
c s1 - the weight of the 1st Price function for the c
c soil reflectance [0.1..0.8] c
c 10 MODIS operational BDRF c
c the parameters are: p1,p2,p3 c
c p1 weight for lambertian kernel c
c p2 weight for Ross Thick kernel c
c p3 weight for Li Sparse kernel c
c 11 RossLiMaigan BDRF model c
c the parameters are: p1,p2,p3 c
c p1 weight for lambertian kernel c
c p2 weight for Ross Thick with Hot Spot kernel c
c p3 weight for Li Sparse kernel c
c**********************************************************************c
fr=0.
rad=0.
do 1116 ik=iinf,isup
rocl(ik)=0.
roel(ik)=0.
1116 continue
c**********************************************************************c
c uniform or non-uniform surface conditions c
c**********************************************************************c
read(iread,*) inhomo
if(inhomo) 30,30,31
30 read(iread,*) idirec
if(idirec)21,21,25
c**********************************************************************c
c uniform conditions with brdf conditions c
c**********************************************************************c
c
25 read(iread,*) ibrdf
c*********************************************************************c
if(ibrdf)23,23,24
c**********************************************************************c
c brdf from in-situ measurements c
c**********************************************************************c
23 do 900 k=1,13
read(iread,*) (brdfdats(10-j+1,k),j=1,10)
900 continue
do 901 k=1,13
read(iread,*) (brdfdatv(10-j+1,k),j=1,10)
901 continue
read(iread,*) albbrdf
read(iread,*) rodir
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call brdfgrid(mu,np,rm,rp,brdfdats,angmu,angphi,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call brdfgrid(mu,np,rm,rp,brdfdatv,angmu,angphi,
s brdfintv)
brdfints(mu,1)=rodir
do l=iinf,isup
sbrdf(l)=rodir
enddo
go to 69
c**********************************************************************c
c brdf from hapke's model c
c**********************************************************************c
24 if(ibrdf.eq.1) then
read(iread,*) par1,par2,par3,par4
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call hapkbrdf(par1,par2,par3,par4,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call hapkbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call hapkbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfintv)
call hapkalbe(par1,par2,par3,par4,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from verstraete et al's model c
c**********************************************************************c
if(ibrdf.eq.2) then
read(iread,*) (options(i),i=3,5)
options(1)=1
options(2)=1
read(iread,*) (struct(i),i=1,4)
read(iread,*) (optics(i),i=1,3)
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call versbrdf(options,optics,struct,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call versbrdf(options,optics,struct,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call versbrdf(options,optics,struct,mu,np,rm,rp,
s brdfintv)
call versalbe(options,optics,struct,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from Roujean et al's model c
c**********************************************************************c
if(ibrdf.eq.3) then
read(iread,*) par1,par2,par3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call roujbrdf(par1,par2,par3,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call roujbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call roujbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfintv)
call roujalbe(par1,par2,par3,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from walthall et al's model
c**********************************************************************c
if(ibrdf.eq.4) then
read(iread,*) par1,par2,par3,par4
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call waltbrdf(par1,par2,par3,par4,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call waltbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call waltbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfintv)
call waltalbe(par1,par2,par3,par4,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from minnaert's model c
c**********************************************************************c
if(ibrdf.eq.5) then
read(iread,*) par1,par2
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call minnbrdf(par1,par2,1,1,srm,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call minnbrdf(par1,par2,mu,np,rm,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call minnbrdf(par1,par2,mu,np,rm,
s brdfintv)
call minnalbe(par1,par2,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from ocean condition
c**********************************************************************c
if(ibrdf.eq.6) then
read(iread,*) pws,phi_wind,xsal,pcl
if (xsal.lt.0.001)xsal=34.3
paw=phi0-phi_wind
do l=iinf,isup
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
wl=.25+(l-1)*step
call oceabrdf(pws,paw,xsal,pcl,wl,rfoam,rwat,rglit,
s 1,1,srm,srp,
s sbrdftmp)
rfoaml(l)=rfoam
rwatl(l)=rwat
rglitl(l)=rglit
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call oceabrdf(pws,paw,xsal,pcl,wlmoy,rfoam,rwat,rglit,
s mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call oceabrdf(pws,paw,xsal,pcl,wlmoy,rfoam,rwat,rglit,
s mu,np,rm,rp,
s brdfintv)
call oceaalbe(pws,paw,xsal,pcl,wlmoy,
s albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from Iaquinta and Pinty model
c**********************************************************************c
if(ibrdf.eq.7) then
read(iread,*) pild,pihs
read(iread,*) pxLt,pc
read(iread,*) pRl,pTl,pRs
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,mu,np,rm,rp,
s brdfintv)
call iapialbe(pild,pxlt,prl,ptl,prs,pihs,pc,
s albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from Rahman model
c**********************************************************************c
if(ibrdf.eq.8) then
read(iread,*) par1,par2,par3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call rahmbrdf(par1,par2,par3,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rahmbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call rahmbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfintv)
call rahmalbe(par1,par2,par3,
s albbrdf)
c call for ground boundary condition in OSSURF
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rahmbrdffos(par1,par2,par3,mu,rm,rosur,
s wfisur,fisur)
c write(6,*) "rosur ",rosur
go to 69
endif
c
c**********************************************************************c
c brdf from kuusk's msrm model c
c**********************************************************************c
if(ibrdf.eq.9) then
read(iread,*) uli,eei,thmi,sli
read(iread,*) cabi,cwi,vaii,rnci,rsl1i
do l=iinf,isup
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
wl=.25+(l-1)*step
call akbrdf(eei,thmi,uli,sli,rsl1i,wl,rnci,cabi,cwi,vaii
s ,1,1,srm,srp,sbrdftmp)
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call akbrdf(eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii
& ,mu,np,rm,rp,brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call akbrdf(eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii
& ,mu,np,rm,rp,brdfintv)
c
call akalbe
* & (eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii,albbrdf)
& (albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from MODIS BRDF model c
c**********************************************************************c
if(ibrdf.eq.10) then
read(iread,*)p1,p2,p3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call modisbrdf(p1,p2,p3
s ,1,1,srm,srp,sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call modisbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call modisbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfintv)
c
call modisalbe(p1,p2,p3
& ,albbrdf)
c call for ground boundary condition in OSSURF
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call modisbrdffos(p1,p2,p3,mu,rm,
s rosur,wfisur,fisur)
go to 69
endif
c
c**********************************************************************c
c brdf from ROSSLIMAIGNAN BRDF model c
c**********************************************************************c
if(ibrdf.eq.11) then
read(iread,*)p1,p2,p3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call rlmaignanbrdf(p1,p2,p3
s ,1,1,srm,srp,sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
c stop
c
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rlmaignanbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call rlmaignanbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfintv)
c
call rlmaignanalbe(p1,p2,p3
& ,albbrdf)
c write(6,*) "GOT TILL HERE "
c call for ground boundary condition in OSSURF
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rlmaignanbrdffos(p1,p2,p3,mu,rm,
s rosur,wfisur,fisur)
c do i=0,mu
c do j=1,mu
c do k=1,83
c write(6,*) i,j,k,rosur(i,j,k),acos(rm(i))*180./pi,acos(rm(j))*180./pi,fisur(k)*180./pi+180.
c enddo
c enddo
c enddo
go to 69
endif
c
c
69 continue
c**********************************************************************c
c compute the downward irradiance for a sun at thetas and then at c
c tetav c
c**********************************************************************c
c call os to compute downward radiation field for robar
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
spalt=1000.
c write(6,*) iaer_prof,tamoy,trmoy,pizmoy,tamoyp,trmoyp,spalt,
c s phirad,nt,mu,np,rm,gb,rp,
c s xlmus,xlphim,nfi,rolut
call os(iaer_prof,tamoy,trmoy,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,
s xlmus,xlphim,nfi,rolut)
c write(6,*) xlmus
romixatm=(xlmus(-mu,1)/xmus)
c write(6,*) "romix atm", romix,tamoy,trmoy,phirad
c call os to compute downward radiation field for robarp
if (idatmp.ne.0) then
rm(-mu)=-xmus
rm(mu)=xmus
rm(0)=-xmuv
call os(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,
s xlmuv,xlphim,nfi,rolut)
endif
c call ossurf to compute the actual brdf coupling
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
spalt=1000.
call ossurf(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,rosur,wfisur,fisur,
s xlsurf,xlphim,nfi,rolutsurf)
romixsur=(xlsurf(-mu,1)/xmus)-romixatm
c write(6,*) "romix surf", romix
c call ISO (twice) to compute the spherical albedo for the equivalent wavelength
c and diffuse and direct transmission at equivalent vavelength
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=xmus
call iso(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
a nt,mu,rm,gb,lxtrans)
ludiftt=lxtrans(1)-exp(-(tamoyp+trmoyp)/xmuv)
ludirtt=exp(-(tamoyp+trmoyp)/xmuv)
rm(-mu)=-xmus
rm(mu)=xmus
rm(0)=xmus
call iso(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
a nt,mu,rm,gb,lxtrans)
lddiftt=lxtrans(1)-exp(-(tamoyp+trmoyp)/xmus)
lddirtt=exp(-(tamoyp+trmoyp)/xmus)
lsphalbt=lxtrans(0)*2.
c write(6,*) "sphalbt ddiftt ddirtt udiftt udirtt",
c a lsphalbt,lddiftt,lddirtt,ludiftt,ludirtt,xmus,xmuv
c stop
c**********************************************************************c
c the downward irradiance was computed for a sun at thetas and c
c several viewing directions (mu zenith times np azimuth). then, the c
c code computes the product of ldown*brdf integrated over the total c
c hemisphere and gives the averaged directional reflectance after the c
c normalization. the resulting reflectance is named robar c
c**********************************************************************c
robar1=0.
xnorm1=0.
c write(6,*) xlmus
do 83 j=1,np
rob=0.
xnor=0.
do 84 k=1,mu-1
rdown=xlmus(-k,j)
rdir=brdfintv(k,j)
rob=rob+rdown*rdir*rm(k)*gb(k)
xnor=xnor+rdown*rm(k)*gb(k)
84 continue
robar1=robar1+rob*gp(j)
xnorm1=xnorm1+xnor*gp(j)
83 continue
c**********************************************************************c
c the downward irradiance was computed for a sun at thetav and c
c several viewing directions (mu zenith times np azimuth). then, the c
c code computes the product of ldown*brdf integrated over the total c
c hemisphere and gives the averaged directional reflectance after the c
c normalization. the resulting reflectance is named robarp c
c**********************************************************************c
robar2=0.
xnorm2=0.
do 85 j=1,np
rob=0.
xnor=0.
do 86 k=1,mu-1
rdown=xlmuv(-k,j)
rdir=brdfints(k,j)
rob=rob+rdown*rdir*rm(k)*gb(k)
xnor=xnor+rdown*rm(k)*gb(k)
86 continue
robar2=robar2+rob*gp(j)
xnorm2=xnorm2+xnor*gp(j)
85 continue
c Write(6,*) "ROBAR",robar1,robar2,xnorm1,xnorm2,romix
c robard is assumed equal to albbrdf
c print 301,brdfints(mu,1),robar1,xnorm1,
c s robar2,xnorm2,albbrdf
c print 301,robar1/xnorm1,robar2/xnorm2
c print 301,betal(0)/3,pizmoy
c301 format(6(f10.4,2x))
c501 format(5(i10,2x))
rbar=robar1/xnorm1
rbarp=robar2/xnorm2
rbarc=rbar*lddiftt*ludirtt
rbarpc=rbarp*ludiftt*lddirtt
rdirc=sbrdftmp(1,1)*ludirtt*lddirtt
write(6,*) "romixsur,rbarc,rbarpc,rdirc",romixsur,rbarc,rbarpc,rdirc
coefc=-(romixsur-rbarc-rbarpc-rdirc)
c write(6,*) " lddiftt,ludiftt ", lddiftt,ludiftt
coefb=lddiftt*ludiftt
coefa=(lddiftt+lddirtt)*(ludiftt+ludirtt)*lsphalbt
a /(1.-lsphalbt*albbrdf)
write(6,*) "a,b,c",coefa,coefb,coefc
write(6,*) "discri2 ",(coefb*coefb-4*coefa*coefc)
discri=sqrt(coefb*coefb-4*coefa*coefc)
rbard=(-coefb+discri)/(2*coefa)
Write(6,*) "rbard albbrdf 1rst iteration", rbard,albbrdf
coefa=(lddiftt+lddirtt)*(ludiftt+ludirtt)*lsphalbt
a /(1.-lsphalbt*rbard)
write(6,*) "a,b,c",coefa,coefb,coefc
write(6,*) "discri2 ",(coefb*coefb-4*coefa*coefc)
discri=sqrt(coefb*coefb-4*coefa*coefc)
rbard=(-coefb+discri)/(2*coefa)
Write(6,*) "rbard albbrdf 2nd iteration", rbard,albbrdf
do 335 l=iinf,isup
rocl(l)=sbrdf(l)
roel(l)=sbrdf(l)
robar(l)=robar1/xnorm1
if (idatmp.ne.0) then
robarp(l)=robar2/xnorm2
else
robarp(l)=0.
xnorm2=1.
robar2=0.
endif
robard(l)=albbrdf
robard(l)=rbard
335 continue
go to 34
c**********************************************************************c
c uniform surface with lambertian conditions c
c**********************************************************************c
21 read(iread,*) igroun
if(igroun) 29,32,33
29 read(iread,*) nwlinf,nwlsup
niinf=(nwlinf-.25)/0.0025+1.5
nisup=(nwlsup-.25)/0.0025+1.5
read(iread,*) (rocl(i),i=niinf,nisup)
goto 36
32 read(iread,*) ro
do 35 l=iinf,isup
rocl(l)=ro
35 continue
goto 36
33 if(igroun.eq.1) call vegeta(rocl)
if(igroun.eq.2) call clearw(rocl)
if(igroun.eq.3) call sand (rocl)
if(igroun.eq.4) call lakew (rocl)
36 do 39 l=iinf,isup
roel(l)=rocl(l)
39 continue
go to 34
c**********************************************************************c
c non-uniform conditions with lambertian conditions c
c**********************************************************************c
31 read(iread,*) igrou1,igrou2,rad
if(igrou1) 59,60,63
59 read(iread,*) (rocl(i),i=iinf,isup)
goto 61
60 read(iread,*) roc
do 64 l=iinf,isup
rocl(l)=roc
64 continue
go to 61
63 if(igrou1.eq.1) call vegeta(rocl)
if(igrou1.eq.2) call clearw(rocl)
if(igrou1.eq.3) call sand (rocl)
if(igrou1.eq.4) call lakew (rocl)
61 if(igrou2) 66,62,65
66 read(iread,*) (roel(i),i=iinf,isup)
goto 34
62 read(iread,*) roe
do 67 l=iinf,isup
roel(l)=roe
67 continue
go to 34
65 if(igrou2.eq.1) call vegeta(roel)
if(igrou2.eq.2) call clearw(roel)
if(igrou2.eq.3) call sand (roel)
if(igrou2.eq.4) call lakew (roel)
34 continue
c**********************************************************************c
c c
c irapp that input parameter allows to activate atmospheric c
c correction mode c
c c
c -1: No atmospheric Correction is performed c
c 0,1: Atmospheric Correction with Lambertian assumption c
c and with the assumption that c
c target BRDF is proportional to the input BRDF (see c
c case idirec=1) c
c c
c rapp parameter that contains the reflectance/radiance c
c to be corrected. c
c c
c if rapp >0. : the code retrieve the value of the c
c surface reflectance (rog) that will produce a radiance c
c equal to rapp [w/m2/str/mic] in the atmospheric c
c conditions described by user before c
c c
c if -1. 0 for north lat., < 0 for south lat. c
c long. must be > 0 for east long., <0 for west long. c
c c
c solar and viewing positions are computed c
c c
c**********************************************************************c
read(iread,*) igeom
if (igeom.lt.0) then
if (igeom.lt.-10) then
igmax=int(abs(igeom/10))
igeom=igeom+igmax*10
endif
ilut=0
igeom=0
endif
ilut=1
goto(1001,1002,1003,1004,1005,1006,1007),igeom
c igeom=0.....
read(iread,*) asol,phi0,avis,phiv,month,jday
goto 22
c
1001 read(iread,*) month,jday,tu,nc,nl
call posmto(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1002 read(iread,*) month,jday,tu,nc,nl
call posge(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1003 read(iread,*) month,jday,tu,nc,nl
call posgw(month,jday,tu,nc,nl,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1004 read(iread,*) month,jday,tu,nc,xlonan,hna
campm=1.0
call posnoa(month,jday,tu,nc,xlonan,hna,campm,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1005 read(iread,*) month,jday,tu,nc,xlonan,hna
campm=-1.0
call posnoa(month,jday,tu,nc,xlonan,hna,campm,
1 asol,phi0,avis,phiv,xlon,xlat)
goto 22
1006 read(iread,*) month,jday,tu,xlon,xlat
call posspo(month,jday,tu,xlon,xlat,
a asol,phi0,avis,phiv)
goto 22
1007 read(iread,*) month,jday,tu,xlon,xlat
call poslan(month,jday,tu,xlon,xlat,
s asol,phi0,avis,phiv)
22 continue
if(ier) stop
dsol=1.
call varsol(jday,month,dsol)
c**********************************************************************c
c c
c / scattered direction c
c / c
c / c
c / adif c
c incident + + + + + + + + + + + + + + + c
c direction c
c c
c**********************************************************************c
phi=abs(phiv-phi0)
phirad=(phi0-phiv)*pi/180.
if (phirad.lt.0.) phirad=phirad+2.*pi
if (phirad.gt.(2.*pi)) phirad=phirad-2.*pi
xmus=cos(asol*pi/180.)
xmuv=cos(avis*pi/180.)
xmup=cos(phirad)
xmud=-xmus*xmuv-sqrt(1.-xmus*xmus)*sqrt(1.-xmuv*xmuv)*xmup
c test vermote bug
if (xmud.gt.1.) xmud=1.
if (xmud.lt.-1.) xmud=-1.
adif=acos(xmud)*180./pi
c**********************************************************************c
c idatm atmospheric model c
c -------------------- c
c c
c c
c you select one of the following standard atmosphere: idatm=0 to 6 c
c 0 no gaseous absorption c
c 1 tropical ) c
c 2 midlatitude summer ) c
c 3 midlatitude winter ) c
c 4 subarctic summer ) from lowtran c
c 5 subarctic winter ) c
c 6 us standard 62 ) c
c c
c or you define your own atmospheric model idatm=7 or 8 c
c 7 user profile (radiosonde data on 34 levels) c
c enter altitude ( in km ) c
c pressure ( in mb ) c
c temperature ( in k ) c
c h2o density (in g/m3) c
c o3 density (in g/m3) c
c c
c for example, altitudes are from 0 to 25km step of 1km c
c from 25 to 50km step of 5km c
c and two values at 70km and 100km c
c so you have 34*5 values to input. c
c 8 enter water vapor and ozone contents c
c uw (in g/cm2 ) c
c uo3 (in cm-atm) c
c profil is taken from us62 c
c c
c**********************************************************************c
uw=0.
uo3=0.
read(iread,*) idatm
if(idatm.eq.0) go to 5
if(idatm.eq.8) read(iread,*) uw,uo3
if(idatm.ne.7) go to 6
do 7 k=1,34
read(iread,*) z(k),p(k),t(k),wh(k),wo(k)
7 continue
go to 5
6 if(idatm.eq.1) call tropic
if(idatm.eq.2) call midsum
if(idatm.eq.3) call midwin
if(idatm.eq.4) call subsum
if(idatm.eq.5) call subwin
if(idatm.eq.6) call us62
c we have to define an atmosphere to compute rayleigh optical depth
5 if(idatm.eq.0.or.idatm.eq.8) call us62
c**********************************************************************c
c THIS OPTION IS NOT AVAILABLE THE CODE RUNS WITH IPOL=1 c
c ipol computation of the atmospheric polarization c
c ------------------------------------------- c
c c
c**********************************************************************c
c read(iread,*) ipol
ipol=1
c write(6,*) "WARNING IPOL IS EQUAL 0"
c**********************************************************************c
c c
c iaer aerosol model(type) and profile c
c -------------- c
c iaer = -1 The user-defined profile. You have to input the c
c number of layers first, then the height (km), c
c optical thickness (at 550 nm), and type of aerosol c
c (see below) for each layer, starting from the c
c ground. The present version of the program works c
c only with the same type of aerosol for each layer. c
c c
c Example for iaer = -1: c
c 4 c
c 2.0 0.200 1 c
c 10.0 0.025 1 c
c 8.0 0.003 1 c
c 80.0 0.000 1 c
c c
c The maximum total height of all layers cannot exceed 300 km. c
c c
c If you do not input iaer = -1, the program will use the default c
c exponential profile. In this case, you need to select one of c
c the following standard aerosol models: c
c c
c iaer = 0 no aerosols c
c 1 continental ) c
c 2 maritime ) according to d'Almeida's models c
c 3 urban ) (see the manual) c
c 5 background desert ) c
c 6 biomass burning ) from AERONET measurements c
c 7 stratospheric ) according to Russel's model c
c c
c or you define your own model using basic components: iaer=4 c
c 4 enter the volumetric percentage of each component c
c c(1) = volumetric % of dust-like c
c c(2) = volumetric % of water-soluble c
c c(3) = volumetric % of oceanic c
c c(4) = volumetric % of soot c
c between 0 to 1 c
c c
c or you define your own model using a size distribution function: c
c 8 Multimodal Log-Normal distribution (up to 4 modes) c
c 9 Modified Gamma distribution c
c 10 Junge Power-Law distribution c
c c
c or you define a model using sun-photometer measurements: c
c 11 Sun Photometer distribution (50 values max) c
c you have to enter: r and dV/d(logr) c
c where r is the radius (in micron), V is the volume, c
c and dV/d(logr) is in (cm3/cm2/micron) c
c then you have to enter: nr and ni for each wavelength c
c where nr and ni are respectively the real and the c
c imaginary parts of the refractive index c
c c
c or you can use the results computed and saved previously c
c 12 Reading of data previously saved into FILE c
c you have to enter the identification name FILE in the c
c next line of inputs. c
c c
c c
c iaerp and FILE aerosol model(type)-Printing of results c
c --------------------------------------- c
c c
c For iaer=8,9,10,and 11: c
c results from the MIE subroutine may be saved into the file c
c FILE.mie (Extinction and scattering coefficients, single c
c scattering albedo, asymmetry parameter, phase function at c
c predefined wavelengths) and then can be re-used with the c
c option iaer=12 where FILE is an identification name you c
c have to enter. c
c c
c So, if you select iaer=8,9,10, or 11, you will have to enter c
c iaerp after the inputs requested by options 8,9,10, or 11: c
c c
c iaerp=0 results will not be saved c
c iaerp=1 results will be saved into the file FILE.mie c
c next line enter FILE c
c c
c c
c Example for iaer and iaerp c
c 8 Multimodal Log-Normal distribution selected c
c 0.001 20 3 Rmin, Rmax, 3 components c
c 0.471 2.512 0.17 Rmean, Sigma, % density - 1st component c
c 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.528 c
c 1.52 1.462 1.4 1.368 1.276 1.22 1.2 nr for 20 wavelengths c
c 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.008 c
c 0.008 0.008 0.008 0.008 0.008 0.008 0.008 0.0085 0.011 ni c
c 0.0285 2.239 0.61 Rmean, Sigma, % density - 2nd component c
c 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.53 1.528 c
c 1.52 1.51 1.42 1.42 1.42 1.42 1.452 nr for 20 wavelengths c
c 0.005 0.005 0.005 0.005 0.005 0.005 0.0053 0.006 0.006 0.0067 0.007 c
c 0.007 0.0088 0.0109 0.0189 0.0218 0.0195 0.0675 0.046 0.004 ni c
c 0.0118 2.0 0.22 Rmean, Sigma, % density - 3rd component c
c 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 1.75 c
c 1.75 1.77 1.791 1.796 1.808 1.815 1.9 nr for 20 wavelengths c
c 0.465 0.46 0.4588 0.4557 0.453 0.4512 0.447 0.44 0.436 0.435 0.433 c
c 0.4306 0.43 0.433 0.4496 0.4629 0.472 0.488 0.5 0.57 ni c
c 1 Results will be saved into FILE.mie c
c Urban_Indust Identification of the output file (FILE) c
c -> results will be saved into Urban_Indust.mie c
c c
c**********************************************************************c
rmin=0.
rmax=0.
icp=1
do i=1,4
x1(i)=0.0
x2(i)=0.0
x3(i)=0.0
do l=1,20
rn(l,i)=0.0
ri(l,i)=0.0
enddo
enddo
do i=1,50
rsunph(i)=0.
nrsunph(i)=0.
enddo
cij(1)=1.00
taer=0.
taer55=0.
iaer_prof=0
read(iread,*) iaer
c the user-defined aerosol profile
if (iaer.lt.0) then
total_height=0.0
iaer_prof=1
num_z=0
do i=0,50
alt_z(i)=0.0
taer55_z(i)=0.0
taer_z(i)=0.0
height_z(i)=0.0
enddo
read(5,*) num_z
do i=0,num_z-1
read(5,*) height_z(num_z-i),taer55_z(num_z-i),iaer
alt_z(num_z-1-i)=total_height+height_z(num_z-i)
total_height=total_height+height_z(num_z-i)
taer55=taer55+taer55_z(num_z-i)
enddo
endif
c the user-defined aerosol profile
if (iaer.ge.0.and.iaer.le.7) nquad=nqdef_p
if (iaer.ge.8.and.iaer.le.11) nquad=nquad_p
if(iaer.eq.4) read(iread,*) (c(n),n=1,4)
goto(49,40,41,42,49,49,49,49,43,44,45,46,47),iaer+1
40 c(1)=0.70
c(2)=0.29
c(3)=0.00
c(4)=0.01
go to 49
41 c(1)=0.00
c(2)=0.05
c(3)=0.95
c(4)=0.00
go to 49
42 c(1)=0.17
c(2)=0.61
c(3)=0.00
c(4)=0.22
go to 49
43 read(iread,*) rmin,rmax,icp
do i=1,icp
read(5,*)x1(i),x2(i),cij(i)
read(5,*)(rn(l,i),l=1,20)
read(5,*)(ri(l,i),l=1,20)
enddo
do i=1,icp
cij_out(i)=cij(i)
enddo
go to 49
44 read(iread,*) rmin,rmax
read(iread,*) x1(1),x2(1),x3(1)
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
45 read(iread,*) rmin,rmax
read(iread,*) x1(1)
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
46 read(5,*)irsunph
do i=1,irsunph
read(5,*)rsunph(i),nrsunph(i)
C nrsunph(i)=nrsunph(i)/(rsunph(i)**4.)/(4*3.1415/3)
enddo
rmin=rsunph(1)
rmax=rsunph(irsunph)+1e-07
read(5,*)(rn(l,1),l=1,20)
read(5,*)(ri(l,1),l=1,20)
go to 49
47 read(5,'(A80)')FILE2
i2=index(FILE2,' ')-1
go to 49
49 continue
if (iaer.ge.8.and.iaer.le.11)then
read(5,*)iaerp
if (iaerp.eq.1)read(5,'(A80)')FILE
i1=index(FILE,' ')-1
FILE2=FILE(1:I1)//'.mie'
i2=index(FILE2,' ')-1
endif
call aeroso(iaer,c,xmud,wldis,FILE2,ipol)
c**********************************************************************c
c aerosol model (concentration) c
c ---------------------------- c
c (only for the default exponential profile) c
c c
c v if you have an estimate of the meteorological c
c parameter: the visibility v, enter directly the c
c value of v in km (the aerosol optical depth will c
c be computed from a standard aerosol profile) c
c c
c v=0, taer55 if you have an estimate of aerosol optical depth , c
c enter v=0 for the visibility and enter the aerosol c
c optical depth at 550 c
c c
c v=-1 warning: if iaer=0, enter v=-1 c
c c
c**********************************************************************c
if (iaer_prof.eq.0) then
read(iread,*) v
if(v) 71,10,11
10 read(iread,*) taer55
v=exp(-log(taer55/2.7628)/0.79902)
goto 71
11 call oda550(iaer,v,taer55)
71 continue
endif
c**********************************************************************c
c xps is the parameter to express the altitude of target c
c c
c c
c xps >=0. the pressure is given in mb c
c c
c xps <0. means you know the altitude of the target c
c expressed in km and you put that value as xps c
c c
c c
c**********************************************************************c
771 read(iread,*) xps
if (idatm.ne.8) then
call pressure(uw,uo3,xps)
else
call pressure(uwus,uo3us,xps)
endif
c**********************************************************************c
c c
c xpp is the parameter to express the sensor altitude c
c c
c c
c xpp= -1000 means that the sensor is a board a satellite c
c xpp= 0 means that the sensor is at the ground level c
c c
c c
c for aircraft simulations c
c -100< xpp <0 means you know the altitude of the sensor expressed c
c in kilometers units c
c this altitude is relative to the target altitude c
c c
c for aircraft simulations only, you have to give c
c puw,po3 (water vapor content,ozone content between the c
c aircraft and the surface) c
c taerp (the aerosol optical thickness at 550nm between the c
c aircraft and the surface) c
c if these data are not available, enter negative values for all c
c of them, puw,po3 will then be interpolated from the us62 standard c
C profile according to the values at ground level. Taerp will be c
c computed according to a 2km exponential profile for aerosol. c
c**********************************************************************c
read(iread,*) xpp
xpp=-xpp
if (xpp.le.0.0) then
c ground measurement option
palt=0.
pps=p(1)
idatmp=0
taer55p=0.
puw=0.
puoz=0.
else
if (xpp.ge.100.) then
c satellite case of equivalent
palt=1000.
pps=0.
taer55p=taer55
ftray=1.
idatmp=4
else
c "real" plane case
read(iread,*) puw,puo3
if (puw.lt.0.) then
call presplane(puw,puo3,xpp,ftray)
idatmp=2
if (idatm.eq.8) then
puwus=puw
puo3us=puo3
puw=puw*uw/uwus
puo3=puo3*uo3/uo3us
idatmp=8
endif
else
call presplane(puwus,puo3us,xpp,ftray)
idatmp=8
endif
if(ier) stop
palt=zpl(34)-z(1)
pps=ppl(34)
read(iread,*) taer55p
if ((taer55p.lt.0.).or.((taer55-taer55p).lt.accu2)) then
c a scale heigh of 2km is assumed in case no value is given for taer55p
taer55p=taer55*(1.-exp(-palt/2.))
else
C compute effective scale heigh
sham=exp(-palt/4.)
sha=1.-(taer55p/taer55)
if (sha.ge.sham) then
taer55p=taer55*(1.-exp(-palt/4.))
else
sha=-palt/log(sha)
taer55p=taer55*(1.-exp(-palt/sha))
endif
endif
endif
endif
c**********************************************************************c
c iwave input of the spectral conditions c
c -------------------------------- c
c c
c you choose to define your own spectral conditions: iwave=-1,0 or 1 c
c (three user s conditions ) c
c -2 enter wlinf, wlsup, the filter function will be equal to 1c
c over the whole band (as iwave=0) but step by step output c
c will be printed c
c -1 enter wl (monochr. cond, gaseous absorption is included) c
c c
c 0 enter wlinf, wlsup. the filter function will be equal to 1c
c over the whole band. c
c c
c 1 enter wlinf, wlsup and user's filter function s(lambda) c
c ( by step of 0.0025 micrometer). c
c c
c c
c or you select one of the following satellite spectral bands: c
c with indication in brackets of the band limits used in the code : c
c iwave=2 to 60 c
c 2 vis band of meteosat ( 0.350-1.110 ) c
c 3 vis band of goes east ( 0.490-0.900 ) c
c 4 vis band of goes west ( 0.490-0.900 ) c
c 5 1st band of avhrr(noaa6) ( 0.550-0.750 ) c
c 6 2nd " ( 0.690-1.120 ) c
c 7 1st band of avhrr(noaa7) ( 0.500-0.800 ) c
c 8 2nd " ( 0.640-1.170 ) c
c 9 1st band of avhrr(noaa8) ( 0.540-1.010 ) c
c 10 2nd " ( 0.680-1.120 ) c
c 11 1st band of avhrr(noaa9) ( 0.530-0.810 ) c
c 12 2nd " ( 0.680-1.170 ) c
c 13 1st band of avhrr(noaa10 ( 0.530-0.780 ) c
c 14 2nd " ( 0.600-1.190 ) c
c 15 1st band of avhrr(noaa11 ( 0.540-0.820 ) c
c 16 2nd " ( 0.600-1.120 ) c
c 17 1st band of hrv1(spot1) ( 0.470-0.650 ) c
c 18 2nd " ( 0.600-0.720 ) c
c 19 3rd " ( 0.730-0.930 ) c
c 20 pan " ( 0.470-0.790 ) c
c 21 1st band of hrv2(spot1) ( 0.470-0.650 ) c
c 22 2nd " ( 0.590-0.730 ) c
c 23 3rd " ( 0.740-0.940 ) c
c 24 pan " ( 0.470-0.790 ) c
c 25 1st band of tm(landsat5) ( 0.430-0.560 ) c
c 26 2nd " ( 0.500-0.650 ) c
c 27 3rd " ( 0.580-0.740 ) c
c 28 4th " ( 0.730-0.950 ) c
c 29 5th " ( 1.5025-1.890 ) c
c 30 7th " ( 1.950-2.410 ) c
c 31 MSS band 1 (0.475-0.640) c
c 32 MSS band 2 (0.580-0.750) c
c 33 MSS band 3 (0.655-0.855) c
c 34 MSS band 4 ( 0.785-1.100 ) c
c 35 1st band of MAS (ER2) ( 0.5025-0.5875) c
c 36 2nd " ( 0.6075-0.7000) c
c 37 3rd " ( 0.8300-0.9125) c
c 38 4th " ( 0.9000-0.9975) c
c 39 5th " ( 1.8200-1.9575) c
c 40 6th " ( 2.0950-2.1925) c
c 41 7th " ( 3.5800-3.8700) c
c 42 MODIS band 1 ( 0.6100-0.6850) c
c 43 MODIS band 2 ( 0.8200-0.9025) c
c 44 MODIS band 3 ( 0.4500-0.4825) c
c 45 MODIS band 4 ( 0.5400-0.5700) c
c 46 MODIS band 5 ( 1.2150-1.2700) c
c 47 MODIS band 6 ( 1.6000-1.6650) c
c 48 MODIS band 7 ( 2.0575-2.1825) c
c 49 1st band of avhrr(noaa12 ( 0.500-1.000 ) c
c 50 2nd " ( 0.650-1.120 ) c
c 51 1st band of avhrr(noaa14 ( 0.500-1.110 ) c
c 52 2nd " ( 0.680-1.100 ) c
c 53 POLDER band 1 ( 0.4125-0.4775) c
c 54 POLDER band 2 (non polar( 0.4100-0.5225) c
c 55 POLDER band 3 (non polar( 0.5325-0.5950) c
c 56 POLDER band 4 P1 ( 0.6300-0.7025) c
c 57 POLDER band 5 (non polar( 0.7450-0.7800) c
c 58 POLDER band 6 (non polar( 0.7000-0.8300) c
c 59 POLDER band 7 P1 ( 0.8100-0.9200) c
c 60 POLDER band 8 (non polar( 0.8650-0.9400) c
c 61 SEAWIFS band 1 ( 0.3825-0.70) c
c 62 SEAWIFS band 2 ( 0.3800-0.58) c
c 63 SEAWIFS band 3 ( 0.3800-1.02) c
c 64 SEAWIFS band 4 ( 0.3800-1.02) c
c 65 SEAWIFS band 5 ( 0.3825-1.15) c
c 66 SEAWIFS band 6 ( 0.3825-1.05) c
c 67 SEAWIFS band 7 ( 0.3800-1.15) c
c 68 SEAWIFS band 8 ( 0.3800-1.15) c
c 69 AATSR band 1 ( 0.5250-0.5925) c
c 70 AATSR band 2 ( 0.6275-0.6975) c
c 71 AATSR band 3 ( 0.8325-0.9025) c
c 72 AATSR band 4 ( 1.4475-1.7775) c
c 73 MERIS band 01 ( 0.412) c
c 74 MERIS band 02 ( 0.442) c
c 75 MERIS band 03 ( 0.489) c
c 76 MERIS band 04 ( 0.509) c
c 77 MERIS band 05 ( 0.559) c
c 78 MERIS band 06 ( 0.619) c
c 79 MERIS band 07 ( 0.664) c
c 80 MERIS band 08 ( 0.681) c
c 81 MERIS band 09 ( 0.708) c
c 82 MERIS band 10 ( 0.753) c
c 83 MERIS band 11 ( 0.760) c
c 84 MERIS band 12 ( 0.778) c
c 85 MERIS band 13 ( 0.865) c
c 86 MERIS band 14 ( 0.885) c
c 87 MERIS band 15 ( 0.900) c
c 88 GLI band 1 (0.380-1km) c
c 89 GLI band 2 (0.400-1km) c
c 90 GLI band 3 (0.412-1km) c
c 91 GLI band 4 (0.443-1km) c
c 92 GLI band 5 (0.460-1km) c
c 93 GLI band 6 (0.490-1km) c
c 94 GLI band 7 (0.520-1km) c
c 95 GLI band 8 (0.545-1km) c
c 96 GLI band 9 (0.565-1km) c
c 97 GLI band 10 (0.625-1km) c
c 98 GLI band 11 (0.666-1km) c
c 99 GLI band 12 (0.680-1km) c
c 100 GLI band 13 (0.678-1km) c
c 101 GLI band 14 (0.710-1km) c
c 102 GLI band 15 (0.710-1km) c
c 103 GLI band 16 (0.749-1km) c
c 104 GLI band 17 (0.763-1km) c
c 105 GLI band 18 (0.865-1km) c
c 106 GLI band 19 (0.865-1km) c
c 107 GLI band 20 (0.460-0.25km) c
c 108 GLI band 21 (0.545-0.25km) c
c 109 GLI band 22 (0.660-0.25km) c
c 110 GLI band 23 (0.825-0.25km) c
c 111 GLI band 24 (1.050-1km) c
c 112 GLI band 25 (1.135-1km) c
c 113 GLI band 26 (1.240-1km) c
c 114 GLI band 27 (1.338-1km) c
c 115 GLI band 28 (1.640-1km) c
c 116 GLI band 29 (2.210-1km) c
c 117 GLI band 30 (3.715-1km) c
c 118 ALI band 1p (0.4225-0.4625) c
c 119 ALI band 1 (0.4325-0.550) c
c 120 ALI band 2 (0.500-0.630) c
c 121 ALI band 3 (0.5755-0.730) c
c 122 ALI band 4 (0.7525-0.8375) c
c 123 ALI band 4p (0.8025-0.935) c
c 124 ALI band 5p (1.130-1.345) c
c 125 ALI band 5 (1.470-1.820) c
c 126 ALI band 7 (1.980-2.530) c
c 127 ASTER band 1 (0.485-0.6425) c
c 128 ASTER band 2 (0.590-0.730) c
c 129 ASTER band 3n (0.720-0.9075) c
c 130 ASTER band 3b (0.720-0.9225) c
c 131 ASTER band 4 (1.570-1.7675) c
c 132 ASTER band 5 (2.120-2.2825) c
c 133 ASTER band 6 (2.150-2.295) c
c 134 ASTER band 7 (2.210-2.390) c
c 135 ASTER band 8 (2.250-2.440) c
c 136 ASTER band 9 (2.2975-2.4875) c
c 137 ETM band 1 (0.435-0.52) c
c 138 ETM band 2 (0.5-0.6225) c
c 139 ETM band 3 (0.615-0.7025) c
c 140 ETM band 4 (0.74-0.9125) c
c 141 ETM band 5 (1.51-1.7875) c
c 142 ETM band 7 (2.015-2.3775) c
c 143 HYPBLUE band 1 (0.4375-0.500) c
c 144 HYPBLUE band 2 (0.435-0.52) c
c 145 VGT band 1 (0.4175-0.500) c
c 146 VGT band 2 (0.5975-0.7675) c
c 147 VGT band 3 (0.7325-0.9575) c
c 148 VGT band 4 (1.5225-1.800) c
c 149 VIIRS band M1 (0.4025-0.4225) c
c 150 VIIRS band M2 (0.4350-0.4550) c
c 151 VIIRS band M3 (0.4775-0.4975) c
c 152 VIIRS band M4 (0.5450-0.5650) c
c 153 VIIRS band M5 (0.6625-0.6825) c
c 154 VIIRS band M6 (0.7375-0.7525) c
c 155 VIIRS band M7 (0.8450-0.8850) c
c 156 VIIRS band M8 (1.2300-1.2500) c
c 157 VIIRS band M9 (1.3700-1.3850) c
c 158 VIIRS band M10 (1.5800-1.6400) c
c 159 VIIRS band M11 (2.2250-2.2750) c
c 160 VIIRS band M12 (3.6100-3.7900) c
c 161 VIIRS band I1 (0.6000-0.6800) c
c 162 VIIRS band I2 (0.8450-0.8850) c
c 163 VIIRS band I3 (1.5800-1.6400) c
c 164 VIIRS band I4 (3.5500-3.9300) c
c 165 LDCM band 1 (0.4275-0.4575) c
c 166 LDCM band 2 (0.4375-0.5275) c
c 167 LDCM band 3 (0.5125-0.6000) c
c 168 LDCM band 4 (0.6275-0.6825) c
c 169 LDCM band 5 (0.8300-0.8950) c
c 170 LDCM band 6 (1.5175-1.6950) c
c 171 LDCM band 7 (2.0375-2.3500) c
c 172 LDCM band 8 (0.4875-0.6925) c
c 173 LDCM band 9 (1.3425-1.4025) c
c 174 MODISkm band 8 (0.4025-0.4225) c
c 175 MODISkm band 9 (0.4325-0.4500) c
c 176 MODISkm band 10 (0.4775-0.4950) c
c 177 MODISkm band 11 (0.5200-0.5400) c
c 178 MODISkm band 12 (0.5375-0.5550) c
c 179 MODISkm band 13 (0.6575-0.6750) c
c 180 MODISkm band 14 (0.6675-0.6875) c
c 181 MODISkm band 15 (0.7375-0.7575) c
c 182 MODISkm band 16 (0.8525-0.8825) c
c 183 MODISkm band 17 (0.8725-0.9375) c
c 184 MODISkm band 18 (0.9225-0.9475) c
c 185 MODISkm band 19 (0.8900-0.9875) c
c 186 CAVIS band 1 (0.4275-0.4575) c
c 187 CAVIS band 2 (0.4375-0.5275) c
c 188 CAVIS band 3 (0.5125-0.6000) c
c 189 CAVIS band 4 (0.6275-0.6825) c
c 190 CAVIS band 5 (0.8300-0.8950) c
c 191 CAVIS band 6 (1.3425-1.4025) c
c 192 CAVIS band 7 (1.5175-1.6950) c
c 193 CAVIS band 8 (2.0375-2.3500) c
c 194 CAVIS band 9 (0.4875-0.6925) c
c 195 CAVIS band 10 (0.4875-0.6925) c
c 196 CAVIS band 11 (0.5100-0.6200) c
c 197 DMC band 1 (0.4875-0.6925) c
c 198 DMC band 2 (0.6100-0.7100) c
c 199 DMC band 3 (0.7525-0.9275) c
c note: wl has to be in micrometer c
c**********************************************************************c
do 38 l=iinf,isup
s(l)=1.
38 continue
read(iread,*) iwave
if (iwave.eq.-2) goto 1600
if (iwave) 16,17,18
16 read(iread,*) wl
wlinf=wl
wlsup=wl
go to 19
17 read(iread,*) wlinf,wlsup
go to 19
1600 read(iread,*) wlinf,wlsup
go to 19
c 110
c 111 band of meteosat (2)
c 112 band of goes (3,4)
c 114 band of avhr (5,16)
c 118 band of hrv1 (17,24)
c 121 band of tm (25,30)
c 127 band of mss (31,34)
c 128 band of MAS (35,41)
c 129 MODIS band (42,49)
c 130 band of avhrr (50,53)
c 131 POLDER band (54,61)
c 113 SEAWIFS band (62,69)
c 150 AATSR band (70,73)
c 151 MERIS band (74,88)
c 152 GLI band (89,118)
c 153 ALI band (119,127)
c 154 ASTER band (128,137)
c 155 ETM band (138,143)
c 156 HYPBLUE band (144,145)
c 157 VGT band (146,149)
c 159 VIIRS band (149,164)
c 161 LDCM band (165,173)
c 162 MODIS1km band (174,185)
c 163 CAVIS band (186,196)
c 164 DMC band (197,199)
18 goto (110,
s 111,
s 112,112,
s 114,114,114,114,114,114,114,114,114,114,114,114,
s 118,118,118,118,118,118,118,118,
s 121,121,121,121,121,121,
s 127,127,127,127,
s 128,128,128,128,128,128,128,
s 129,129,129,129,129,129,129,
s 130,130,130,130,
s 131,131,131,131,131,131,131,131,
s 113,113,113,113,113,113,113,113,
s 150,150,150,150,
s 151,151,151,151,151,151,151,151,
s 151,151,151,151,151,151,151,
s 152,152,152,152,152,152,152,152,152,152,
s 152,152,152,152,152,152,152,152,152,152,
s 152,152,152,152,152,152,152,152,152,152,
s 153,153,153,153,153,153,153,153,153,
s 154,154,154,154,154,154,154,154,154,154,
s 155,155,155,155,155,155,
s 156,156,
s 157,157,157,157,
s 159,159,159,159,159,159,159,159,159,159,
s 159,159,159,159,159,159,
s 161,161,161,161,161,161,161,161,161,
s 162,162,162,162,162,162,162,162,162,162,162,162,
s 163,163,163,163,163,163,163,163,163,163,163,
s 164,164,164),iwave
110 read(iread,*) wlinf,wlsup
iinf=(wlinf-.25)/0.0025+1.5
isup=(wlsup-.25)/0.0025+1.5
do 1113 ik=iinf,isup
s(ik)=0.
1113 continue
read(iread,*) (s(i),i=iinf,isup)
goto 20
111 call meteo
go to 19
112 call goes(iwave-2)
go to 19
114 call avhrr(iwave-4)
go to 19
118 call hrv(iwave-16)
go to 19
121 call tm(iwave-24)
go to 19
127 call mss(iwave-30)
goto 19
128 call mas(iwave-34)
goto 19
129 call modis(iwave-41)
goto 19
130 call avhrr(iwave-48)
goto 19
131 call polder(iwave-52)
goto 19
113 call seawifs(iwave-60)
goto 19
150 call aatsr(iwave-68)
goto 19
151 call meris(iwave-72)
goto 19
152 call gli(iwave-87)
goto 19
153 call ali(iwave-117)
goto 19
154 call aster(iwave-126)
goto 19
155 call etm(iwave-136)
goto 19
156 call hypblue(iwave-142)
goto 19
157 call vgt(iwave-144)
goto 19
159 call viirs(iwave-148)
goto 19
161 call ldcm(iwave-164)
goto 19
162 call modis1km(iwave-173)
goto 19
163 call cavis(iwave-185)
goto 19
164 call dmc(iwave-196)
goto 19
19 iinf=(wlinf-.25)/0.0025+1.5
isup=(wlsup-.25)/0.0025+1.5
20 continue
C***********************************************************************
C LOOK UP TABLE INITIALIZATION
C***********************************************************************
C initialization of look up table variable
C Write(6,*) "TOTO THE HERO"
do i=1,mu
nfilut(i)=0
do j=1,61
rolut(i,j)=0.
rolutq(i,j)=0.
rolutu(i,j)=0.
filut(i,j)=0.
roluti(i,j)=0.
rolutiq(i,j)=0.
rolutiu(i,j)=0.
enddo
enddo
xmus=cos(asol*pi/180.)
its=acos(xmus)*180.0/pi
C Case standart LUT
if (ilut.eq.1) then
do i=1,mu-1
lutmuv=rm(i)
luttv=acos(lutmuv)*180./pi
iscama=(180-abs(luttv-its))
iscami=(180-(luttv+its))
if (abs(iscama-iscami).gt.1.E-03) then
frac=(iscama-iscami)-int((iscama-iscami)/4.0)*4.
if (frac.gt.1.E-03) then
nbisca=int((iscama-iscami)/4.0)+2
else
nbisca=int((iscama-iscami)/4.0)+1
endif
else
nbisca=1
endif
nfilut(i)=nbisca
filut(i,1)=0.0
filut(i,nbisca)=180.0
scaa=iscama
do j=2,nfilut(i)-1
scaa=scaa-4.0
cscaa=cos(scaa*pi/180.)
cfi=-(cscaa+xmus*lutmuv)/(sqrt(1-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv))
filut(i,j)=acos(cfi)*180.0/pi
enddo
C write(6,*) "LOOKUP DEBUG ", its,luttv,nbisca,iscama,iscami
enddo
i=mu
lutmuv=cos(avis*pi/180.)
luttv=acos(lutmuv)*180./pi
iscama=(180-abs(luttv-its))
iscami=(180-(luttv+its))
if (abs(iscama-iscami).gt.1.E-03) then
nbisca=int((iscama-iscami)/4)+2
else
nbisca=1
endif
nfilut(i)=nbisca
filut(i,1)=0.0
filut(i,nbisca)=180.0
scaa=iscama
do j=2,nfilut(i)-1
scaa=scaa-4.0
cscaa=cos(scaa*pi/180.)
cfi=-(cscaa+xmus*lutmuv)/(sqrt(1-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv))
filut(i,j)=acos(cfi)*180.0/pi
enddo
endif
C END Case standart LUT
C Case LUT for APS
if (ilut.eq.3) then
do i=1,mu-1
nbisca=2
nfilut(i)=nbisca
filut(i,1)=(phi0-phiv)
filut(i,nbisca)=(phi0-phiv)+180.0
enddo
i=mu
nbisca=1
nfilut(i)=nbisca
filut(i,1)=(phi0-phiv)
endif
C END Case LUT for APS
CCCC Check initialization (debug)
do i=1,mu
lutmuv=rm(i)
luttv=acos(lutmuv)*180./pi
do j=1,nfilut(i)
cscaa=-xmus*lutmuv-cos(filut(i,j)*pi/180.)*sqrt(1.-xmus*xmus)
S *sqrt(1.-lutmuv*lutmuv)
scaa=acos(cscaa)*180./pi
write(6,*) its,luttv,filut(i,j),scaa
enddo
enddo
CCCC Check initialization (debug)
C***********************************************************************
C END LOOK UP TABLE INITIALIZATION
C***********************************************************************
c**********************************************************************c
c here, we first compute an equivalent wavelenght which is the input c
c value for monochromatic conditions or the integrated value for a c
c filter functionr (call equivwl) then, the atmospheric properties are c
c computed for that wavelength (call discom then call specinterp) c
c molecular optical thickness is computed too (call odrayl). lastly c
c the successive order of scattering code is called three times. c
c first for a sun at thetas with the scattering properties of aerosols c
c and molecules, second with a pure molecular atmosphere, then with thec
c actual atmosphere for a sun at thetav. the iso code allows us to c
c compute the scattering transmissions and the spherical albedo. all c
c these computations are performed for checking the accuracy of the c
c analytical expressions and in addition for computing the averaged c
c directional reflectances c
c**********************************************************************c
if(iwave.ne.-1) then
call equivwl(iinf,isup,step,
s wlmoy)
else
wlmoy=wl
endif
call discom (idatmp,iaer,iaer_prof,xmus,xmuv,phi,taer55,taer55p,
a palt,phirad,nt,mu,np,rm,gb,rp,ftray,ipol,xlm1,xlm2,
a roatm_fi,nfi,
a nfilut,filut,roluts,rolutsq,rolutsu)
c write(6,*) "wlmoy",wlmoy
if(iaer.ne.0) then
call specinterp(wlmoy,taer55,taer55p,
s tamoy,tamoyp,pizmoy,pizmoyp,ipol)
endif
call odrayl(wlmoy,
s trmoy)
trmoyp=trmoy*ftray
if (idatmp.eq.4) then
trmoyp=trmoy
tamoyp=tamoy
endif
if (idatmp.eq.0) then
trmoyp=0.
tamoyp=0.
endif
c*********************************************************************c
c inhomo ground reflectance (type) c
c ------------------ c
c c
c you consider an homogeneous surface: c
c enter - inhomo=0 c
c you may consider directional surface effects c
c idirec=0 (no directional effect) c
c you have to specify the surface reflectance:c
c igroun (see note1) which is uniform and c
c lambertian c
c idirec=1 ( directional effect) c
c you have to specify the brdf of the surface c
c for the actual solar illumination you are c
c considering as well as the brdf for a sun c
c which would be at an angle thetav, in c
c addition you have to give the surface c
c albedo (spherical albedo). you can also c
c select one of the selected model from the c
c ibrdf value (see note2). 3 reflectances c
c are computed, robar,robarp and robard c
c c
c you consider a non uniform surface, the surface is considered as a c
c circular target with a reflectance roc and of radius r c
c (expressed in km) within an environment of reflectance c
c roe c
c enter - inhomo=1, then c
c igrou1,igrou2,rad c
c - the target reflectance :igrou1 (see note1) c
c - the envir. reflectance :igrou2 (see note1) c
c - the target radius in km c
c c
c c
c ****tree**** c
c c
c inhomo c
c / \ c
c / \ c
c / \ c
c / \ c
c ------- 0 ------- -----1 ----- c
c / / \ \ c
c idirec / \ \ c
c / \ / \ \ c
c / \ / \ \ c
c / \ igrou1 igrou2 rad c
c 0 1 roc roe f(r) c
c / \ c
c / \ c
c igroun ibrdf c
c (roc = roe) (roc) c
c (robar) c
c (robarp) c
c (robard) c
c c
c ground reflectance (spectral variation) c
c --------------------------------------- c
c note1: values of the reflectance selected by igroun,igrou1 or igrou2 c
c may correspond to the following cases, c
c 0 constant value of ro (or roc,or roe) whatever the wavelen c
c gth. you enter this constant value of ro (or roc or roe). c
c -1 you have to enter the value of ro (or roc,or roe) by step c
c of 0.0025 micron from wlinf to wlsup (if you have used thec
c satellite bands,see implicit values for these limits). c
c 1 mean spectral value of green vegetation c
c 2 mean spectral value of clear water c
c 3 mean spectral value of sand c
c 4 mean spectral value of lake water c
c c
c ground reflectance (brdf) c
c ------------------------- c
c note2: values of the directional reflectance is assumed spectrally c
c independent, so you have to specify, the brdf at the c
c wavelength for monochromatic condition of the mean value c
c over the spectral band c
c 0 you have to enter the value of ro for sun at thetas by c
c step of 10 degrees for zenith view angles (from 0 to 80 c
c and the value for 85) and by step of 30 degrees for c
c azimuth view angles from 0 to 360 degrees, you have to do c
c same for a sun which would be at thetav. in addition, the c
c spherical albedo of the surface has to be specified ,as c
C well as the observed reflectance in the selected geometry c
c rodir(sun zenith,view zenith, relative azimuth). c
c c
c you also may select one of the following models c
c 1 hapke model c
c the parameters are: om,af,s0,h c
c om= albedo c
c af=assymetry parameter for the phase function c
c s0=amplitude of hot spot c
c h=width of the hot spot c
c c
c 2 verstraete et al. model c
c the parameters are: c
c there is three lines of parameters: c
c line 1 (choice of options) c
c line 2 (structural parameters) c
c line 3 (optical parameters) c
c line 1: opt3 opt4 opt5 c
c opt1=1 parametrized model (see verstraete et al., c
c JGR, 95, 11755-11765, 1990) c
c opt2=1 reflectance factor (see pinty et al., JGR, c
c 95, 11767-11775, 1990) c
c opt3=0 for given values of kappa (see struc below)c
c 1 for goudriaan's parameterization of kappa c
c 2 for dickinson et al's correction to c
c goudriaan's parameterization of kappa (see c
c dickinson et al., agricultural and forest c
c meteorology, 52, 109-131, 1990) c
c ---see the manual for complete references---- c
c opt4=0 for isotropic phase function c
c 1 for heyney and greensteins' phase function c
c 2 for legendre polynomial phase function c
c opt5=0 for single scattering only c
c 1 for dickinson et al. parameterization of c
c multiple scattering c
c line 2: str1 str2 str3 str4 c
c str1='leaf area density', in m2 m-3 c
c str2=radius of the sun flecks on the scatterer (m)c
c str3=leaf orientation parameter: c
c if opt3=0 then str3=kappa1 c
c if opt3=1 or 2 then str3=chil c
c str4=leaf orientation parameter (continued): c
c if opt3=0 then str4=kappa2 c
c if opt3=1 or 2 then str4 is not used c
c line 3: optics1 optics2 optics3 c
c optics1=single scattering albedo, n/d value c
c between 0.0 and 1.0 c
c optics2= phase function parameter: c
c if opt4=0 then this input is not used c
c if opt4=1 then asymmetry factor, n/d value c
c between -1.0and 1.0 c
c if opt4=2 then first coefficient of legendre c
c polynomial c
c optics3=second coefficient of legendre polynomial c
c (if opt4=2) c
c c
c 3 Roujean et al. model c
c the parameters are: k0,k1,k2 c
c k0=albedo. c
c k1=geometric parameter for hot spot effect c
c k2=geometric parameter for hot spot effect c
c c
c 4 walthall et al. model c
c the parameters are: a,ap,b,c c
c a=term in square ts*tv c
c ap=term in square ts*ts+tv*tv c
c b=term in ts*tv*cos(phi) (limacon de pascal) c
c c=albedo c
c c
c 5 minnaert model c
c the parameters are: par1,par2 c
c c
c 6 Ocean c
c the parameter are: pws,phi_wind,xsal,pcl c
c pws=wind speed (in m/s) c
c phi_wind=azim. of the wind (in degres) c
c xsal=salinity (in ppt) xsal=34.3ppt if xsal<0 c
c pcl=pigment concentration (in mg/m3) c
c c
c 7 Iaquinta and Pinty model c
c the parameters are: c
c there is 3 lines of parameters: c
c line 1: choice of option (pild,pihs) c
c line 2: structural parameters (pxLt,pc) c
c line 3: optical parameters (pRl,pTl,pRs) c
c Line 1: pild,pihs c
c pild=1 planophile leaf distribution c
c pild=2 erectophile leaf distribution c
c pild=3 plagiophile leaf distribution c
c pild=4 extremophile leaf distribution c
c pild=5 uniform leaf distribution c
c c
c pihs=0 no hot spot c
c pihs=1 hot spot c
c Line 2: pxLt,pc c
c pxLt=Leaf area index [1.,15.] c
c pc=Hot spot parameter: 2*r*Lambda [0.,2.] c
c Line 3: pRl,pTl,pRs c
c pRl=Leaf reflectance [0.,0.99] c
c pTl=Leaf transmitance [0.,0.99] c
c pRs=Soil albedo [0.,0.99] c
c NB: pRl+PTl <0.99 c
c c
c 8 Rahman et al. model c
c the parameters are: rho0,af,xk c
c rho0=Intensity of the reflectance of the surface c
c cover, N/D value greater or equal to 0 c
c af=Asymmetry factor, N/D value between -1.0 and 1.0 c
c xk=Structural parameter of the medium c
c 9 Kuusk's multispectral CR model c
c Reference: c
c Kuusk A. A multispectral canopy reflectance model. c
c Remote Sens. Environ., 1994, 50:75-82 c
c c
c c
c the parameters are: c
c c
c line 1: structural parameters (ul,eps,thm,sl) c
c line 2: optical parameters (cAB,cW,N,cn,s1) c
c c
c ul=LAI [0.1...10] c
c eps,thm - LAD parameters c
c eps [0.0..0.9] thm [0.0..90.0] c
c sl - relative leaf size [0.01..1.0] c
c cAB - chlorophyll content, ug/cm^2 [30] c
c cW - leaf water equivalent thickness [0.01..0.03] c
c N - the effective number of elementary layers c
c inside a leaf [1.225] c
c cn - the ratio of refractive indices of the leaf c
c surface wax and internal material [1.0] c
c s1 - the weight of the 1st Price function for the c
c soil reflectance [0.1..0.8] c
c 10 MODIS operational BDRF c
c the parameters are: p1,p2,p3 c
c p1 weight for lambertian kernel c
c p2 weight for Ross Thick kernel c
c p3 weight for Li Sparse kernel c
c**********************************************************************c
fr=0.
rad=0.
do 1116 ik=iinf,isup
rocl(ik)=0.
roel(ik)=0.
1116 continue
c**********************************************************************c
c uniform or non-uniform surface conditions c
c**********************************************************************c
read(iread,*) inhomo
if(inhomo) 30,30,31
30 read(iread,*) idirec
if(idirec)21,21,25
c**********************************************************************c
c uniform conditions with brdf conditions c
c**********************************************************************c
c
25 read(iread,*) ibrdf
c*********************************************************************c
if(ibrdf)23,23,24
c**********************************************************************c
c brdf from in-situ measurements c
c**********************************************************************c
23 do 900 k=1,13
read(iread,*) (brdfdats(10-j+1,k),j=1,10)
900 continue
do 901 k=1,13
read(iread,*) (brdfdatv(10-j+1,k),j=1,10)
901 continue
read(iread,*) albbrdf
read(iread,*) rodir
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call brdfgrid(mu,np,rm,rp,brdfdats,angmu,angphi,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call brdfgrid(mu,np,rm,rp,brdfdatv,angmu,angphi,
s brdfintv)
brdfints(mu,1)=rodir
do l=iinf,isup
sbrdf(l)=rodir
enddo
go to 69
c**********************************************************************c
c brdf from hapke's model c
c**********************************************************************c
24 if(ibrdf.eq.1) then
read(iread,*) par1,par2,par3,par4
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call hapkbrdf(par1,par2,par3,par4,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call hapkbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call hapkbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfintv)
call hapkalbe(par1,par2,par3,par4,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from verstraete et al's model c
c**********************************************************************c
if(ibrdf.eq.2) then
read(iread,*) (options(i),i=3,5)
options(1)=1
options(2)=1
read(iread,*) (struct(i),i=1,4)
read(iread,*) (optics(i),i=1,3)
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call versbrdf(options,optics,struct,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call versbrdf(options,optics,struct,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call versbrdf(options,optics,struct,mu,np,rm,rp,
s brdfintv)
call versalbe(options,optics,struct,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from Roujean et al's model c
c**********************************************************************c
if(ibrdf.eq.3) then
read(iread,*) par1,par2,par3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call roujbrdf(par1,par2,par3,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call roujbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call roujbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfintv)
call roujalbe(par1,par2,par3,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from walthall et al's model
c**********************************************************************c
if(ibrdf.eq.4) then
read(iread,*) par1,par2,par3,par4
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call waltbrdf(par1,par2,par3,par4,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call waltbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call waltbrdf(par1,par2,par3,par4,mu,np,rm,rp,
s brdfintv)
call waltalbe(par1,par2,par3,par4,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from minnaert's model c
c**********************************************************************c
if(ibrdf.eq.5) then
read(iread,*) par1,par2
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call minnbrdf(par1,par2,1,1,srm,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call minnbrdf(par1,par2,mu,np,rm,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call minnbrdf(par1,par2,mu,np,rm,
s brdfintv)
call minnalbe(par1,par2,
s albbrdf)
go to 69
endif
c**********************************************************************c
c brdf from ocean condition
c**********************************************************************c
if(ibrdf.eq.6) then
read(iread,*) pws,phi_wind,xsal,pcl
if (xsal.lt.0.001)xsal=34.3
paw=phi0-phi_wind
do l=iinf,isup
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
wl=.25+(l-1)*step
call oceabrdf(pws,paw,xsal,pcl,wl,rfoam,rwat,rglit,
s 1,1,srm,srp,
s sbrdftmp)
rfoaml(l)=rfoam
rwatl(l)=rwat
rglitl(l)=rglit
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call oceabrdf(pws,paw,xsal,pcl,wlmoy,rfoam,rwat,rglit,
s mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call oceabrdf(pws,paw,xsal,pcl,wlmoy,rfoam,rwat,rglit,
s mu,np,rm,rp,
s brdfintv)
call oceaalbe(pws,paw,xsal,pcl,wlmoy,
s albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from Iaquinta and Pinty model
c**********************************************************************c
if(ibrdf.eq.7) then
read(iread,*) pild,pihs
read(iread,*) pxLt,pc
read(iread,*) pRl,pTl,pRs
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call iapibrdf(pild,pxlt,prl,ptl,prs,pihs,pc,mu,np,rm,rp,
s brdfintv)
call iapialbe(pild,pxlt,prl,ptl,prs,pihs,pc,
s albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from Rahman model
c**********************************************************************c
if(ibrdf.eq.8) then
read(iread,*) par1,par2,par3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call rahmbrdf(par1,par2,par3,1,1,srm,srp,
s sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rahmbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call rahmbrdf(par1,par2,par3,mu,np,rm,rp,
s brdfintv)
call rahmalbe(par1,par2,par3,
s albbrdf)
c call for ground boundary condition in OSSURF
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call rahmbrdffos(par1,par2,par3,mu,rm,rosur,
s wfisur,fisur)
c write(6,*) "rosur ",rosur
go to 69
endif
c
c**********************************************************************c
c brdf from kuusk's msrm model c
c**********************************************************************c
if(ibrdf.eq.9) then
read(iread,*) uli,eei,thmi,sli
read(iread,*) cabi,cwi,vaii,rnci,rsl1i
do l=iinf,isup
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
wl=.25+(l-1)*step
call akbrdf(eei,thmi,uli,sli,rsl1i,wl,rnci,cabi,cwi,vaii
s ,1,1,srm,srp,sbrdftmp)
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call akbrdf(eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii
& ,mu,np,rm,rp,brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call akbrdf(eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii
& ,mu,np,rm,rp,brdfintv)
c
call akalbe
* & (eei,thmi,uli,sli,rsl1i,wlmoy,rnci,cabi,cwi,vaii,albbrdf)
& (albbrdf)
go to 69
endif
c
c**********************************************************************c
c brdf from MODIS BRDF model c
c**********************************************************************c
if(ibrdf.eq.10) then
read(iread,*)p1,p2,p3
srm(-1)=phirad
srm(1)=xmuv
srm(0)=xmus
call modisbrdf(p1,p2,p3
s ,1,1,srm,srp,sbrdftmp)
do l=iinf,isup
sbrdf(l)=sbrdftmp(1,1)
enddo
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call modisbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfints)
rm(-mu)=2.*pi-phirad
rm(mu)=xmus
rm(0)=xmuv
call modisbrdf(p1,p2,p3
& ,mu,np,rm,rp,brdfintv)
c
call modisalbe(p1,p2,p3
& ,albbrdf)
c call for ground boundary condition in OSSURF
rm(-mu)=phirad
rm(mu)=xmuv
rm(0)=xmus
call modisbrdffos(p1,p2,p3,mu,rm,
s rosur,wfisur,fisur)
go to 69
endif
c
69 continue
c**********************************************************************c
c compute the downward irradiance for a sun at thetas and then at c
c tetav c
c**********************************************************************c
c call os to compute downward radiation field for robar
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
spalt=1000.
call os(iaer_prof,tamoy,trmoy,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,
s xlmus,xlphim,nfi,rolut)
romix=(xlmus(-mu,1)/xmus)
c write(6,*) "romix atm", romix,tamoy,trmoy,phirad
c call os to compute downward radiation field for robarp
if (idatmp.ne.0) then
rm(-mu)=-xmus
rm(mu)=xmus
rm(0)=-xmuv
call os(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,
s xlmuv,xlphim,nfi,rolut)
endif
c call ossurf to compute the actual brdf coupling
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=-xmus
spalt=1000.
call ossurf(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
s phirad,nt,mu,np,rm,gb,rp,rosur,wfisur,fisur,
s xlsurf,xlphim,nfi,rolutsurf)
romix=(xlsurf(-mu,1)/xmus)-romix
c write(6,*) "romix surf", romix
c call ISO (twice) to compute the spherical albedo for the equivalent wavelength
c and diffuse and direct transmission at equivalent vavelength
rm(-mu)=-xmuv
rm(mu)=xmuv
rm(0)=xmus
call iso(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
a nt,mu,rm,gb,lxtrans)
ludiftt=lxtrans(1)-exp(-(tamoyp+trmoyp)/xmuv)
ludirtt=exp(-(tamoyp+trmoyp)/xmuv)
rm(-mu)=-xmus
rm(mu)=xmus
rm(0)=xmus
call iso(iaer_prof,tamoyp,trmoyp,pizmoy,tamoyp,trmoyp,spalt,
a nt,mu,rm,gb,lxtrans)
lddiftt=lxtrans(1)-exp(-(tamoyp+trmoyp)/xmus)
lddirtt=exp(-(tamoyp+trmoyp)/xmus)
lsphalbt=lxtrans(0)*2.
c write(6,*) "sphalbt ddiftt ddirtt udiftt udirtt",
c a lsphalbt,lddiftt,lddirtt,ludiftt,ludirtt,xmus,xmuv
c stop
c**********************************************************************c
c the downward irradiance was computed for a sun at thetas and c
c several viewing directions (mu zenith times np azimuth). then, the c
c code computes the product of ldown*brdf integrated over the total c
c hemisphere and gives the averaged directional reflectance after the c
c normalization. the resulting reflectance is named robar c
c**********************************************************************c
robar1=0.
xnorm1=0.
do 83 j=1,np
rob=0.
xnor=0.
do 84 k=1,mu-1
rdown=xlmus(-k,j)
rdir=brdfintv(k,j)
rob=rob+rdown*rdir*rm(k)*gb(k)
xnor=xnor+rdown*rm(k)*gb(k)
84 continue
robar1=robar1+rob*gp(j)
xnorm1=xnorm1+xnor*gp(j)
83 continue
c**********************************************************************c
c the downward irradiance was computed for a sun at thetav and c
c several viewing directions (mu zenith times np azimuth). then, the c
c code computes the product of ldown*brdf integrated over the total c
c hemisphere and gives the averaged directional reflectance after the c
c normalization. the resulting reflectance is named robarp c
c**********************************************************************c
robar2=0.
xnorm2=0.
do 85 j=1,np
rob=0.
xnor=0.
do 86 k=1,mu-1
rdown=xlmuv(-k,j)
rdir=brdfints(k,j)
rob=rob+rdown*rdir*rm(k)*gb(k)
xnor=xnor+rdown*rm(k)*gb(k)
86 continue
robar2=robar2+rob*gp(j)
xnorm2=xnorm2+xnor*gp(j)
85 continue
c Write(6,*) "ROBAR",robar1,robar2,xnorm1,xnorm2,romix
c robard is assumed equal to albbrdf
c print 301,brdfints(mu,1),robar1,xnorm1,
c s robar2,xnorm2,albbrdf
c print 301,robar1/xnorm1,robar2/xnorm2
c print 301,betal(0)/3,pizmoy
c301 format(6(f10.4,2x))
c501 format(5(i10,2x))
rbar=robar1/xnorm1
rbarp=robar2/xnorm2
rbarc=rbar*lddiftt*ludirtt
rbarpc=rbarp*ludiftt*lddirtt
rdirc=sbrdftmp(1,1)*ludirtt*lddirtt
c write(6,*) "rdirc rbarc rbarpc",rdirc,rbarc,rbarpc
coefc=-(romix-rbarc-rbarpc-rdirc)
c write(6,*) " lddiftt,ludiftt ", lddiftt,ludiftt
coefb=lddiftt*ludiftt
coefa=(lddiftt+lddirtt)*(ludiftt+ludirtt)*lsphalbt
a /(1.-lsphalbt*albbrdf)
c write(6,*) "a,b,c",coefa,coefb,coefc
discri=sqrt(coefb*coefb-4*coefa*coefc)
rbard=(-coefb+discri)/(2*coefa)
c Write(6,*) "rbard albbrdf 1rst iteration", rbard,albbrdf
coefa=(lddiftt+lddirtt)*(ludiftt+ludirtt)*lsphalbt
a /(1.-lsphalbt*rbard)
discri=sqrt(coefb*coefb-4*coefa*coefc)
rbard=(-coefb+discri)/(2*coefa)
c Write(6,*) "rbard albbrdf 2nd iteration", rbard,albbrdf
do 335 l=iinf,isup
rocl(l)=sbrdf(l)
roel(l)=sbrdf(l)
robar(l)=robar1/xnorm1
if (idatmp.ne.0) then
robarp(l)=robar2/xnorm2
else
robarp(l)=0.
xnorm2=1.
robar2=0.
endif
robard(l)=albbrdf
robard(l)=rbard
335 continue
go to 34
c**********************************************************************c
c uniform surface with lambertian conditions c
c**********************************************************************c
21 read(iread,*) igroun
if(igroun) 29,32,33
29 read(iread,*) nwlinf,nwlsup
niinf=(nwlinf-.25)/0.0025+1.5
nisup=(nwlsup-.25)/0.0025+1.5
read(iread,*) (rocl(i),i=niinf,nisup)
goto 36
32 read(iread,*) ro
do 35 l=iinf,isup
rocl(l)=ro
35 continue
goto 36
33 if(igroun.eq.1) call vegeta(rocl)
if(igroun.eq.2) call clearw(rocl)
if(igroun.eq.3) call sand (rocl)
if(igroun.eq.4) call lakew (rocl)
36 do 39 l=iinf,isup
roel(l)=rocl(l)
39 continue
go to 34
c**********************************************************************c
c non-uniform conditions with lambertian conditions c
c**********************************************************************c
31 read(iread,*) igrou1,igrou2,rad
if(igrou1) 59,60,63
59 read(iread,*) (rocl(i),i=iinf,isup)
goto 61
60 read(iread,*) roc
do 64 l=iinf,isup
rocl(l)=roc
64 continue
go to 61
63 if(igrou1.eq.1) call vegeta(rocl)
if(igrou1.eq.2) call clearw(rocl)
if(igrou1.eq.3) call sand (rocl)
if(igrou1.eq.4) call lakew (rocl)
61 if(igrou2) 66,62,65
66 read(iread,*) (roel(i),i=iinf,isup)
goto 34
62 read(iread,*) roe
do 67 l=iinf,isup
roel(l)=roe
67 continue
go to 34
65 if(igrou2.eq.1) call vegeta(roel)
if(igrou2.eq.2) call clearw(roel)
if(igrou2.eq.3) call sand (roel)
if(igrou2.eq.4) call lakew (roel)
34 continue
c**********************************************************************c
c c
c irapp that input parameter allows to activate atmospheric c
c correction mode c
c c
c -1: No atmospheric Correction is performed c
c 0,1: Atmospheric Correction with Lambertian assumption c
c and with the assumption that c
c target BRDF is proportional to the input BRDF (see c
c case idirec=1) c
c c
c rapp parameter that contains the reflectance/radiance c
c to be corrected. c
c c
c if rapp >0. : the code retrieve the value of the c
c surface reflectance (rog) that will produce a radiance c
c equal to rapp [w/m2/str/mic] in the atmospheric c
c conditions described by user before c
c c
c if -1.