158 dimension hhh(25),ttt(25),ppp(25),vmrr(25)
159 dimension wltemp(1050),rotemp(1050),dttemp(1050),astemp(1050)
160 dimension wavobs(1024),fwhm(1024)
161 dimension rotot(1050), ttot(1050), stot(1050)
164 COMMON /getinput3/ hhh,ttt,ppp,vmrr,nb,nl,model,iaer,v,taer55,
166 COMMON /getinput4/ wavobs,fwhm
167 COMMON /getinput8/ imnn,idyy,iyrr,ihh,imm,iss
168 COMMON /geometry1/ solzni,solaz,obszni,obsphi,iday
169 COMMON /sixs1/ rotot, ttot, stot
174 COMMON /getinput14/ xpss, xppp
177 INTEGER JINDEX, NELEM
180 parameter(nt_p=26,mu_p=25,mu2_p=48,np_p=49)
181 dimension anglem(mu2_p),weightm(mu2_p),
182 s rm(-mu_p:mu_p),gb(-mu_p:mu_p),rp(np_p),gp(np_p)
183 dimension xlmus(-mu_p:mu_p,np_p),xlmuv(-mu_p:mu_p,np_p)
184 dimension angmu(10),angphi(13),brdfints(-mu_p:mu_p,np_p)
186 s brdfintv(-mu_p:mu_p,np_p),brdfdatv(10,13),robar(1501),
187 s robarp(1501),robard(1501),xlm1(-mu_p:mu_p,np_p),
188 s xlm2(-mu_p:mu_p,np_p)
190 real anglem,weightm,rm,gb,accu2,accu3
191 real rp,gp,xlmus,xlmuv,angmu,angphi,brdfints,brdfdats
192 real brdfintv,brdfdatv,robar,robarp,robard,xlm1,xlm2
193 real c,wldisc,ani,anr,aini,ainr,rocl,roel,zpl,ppl,tpl,whpl
194 real wopl,xacc,phasel,pdgs,cgaus,pha,betal,s,wlinf,wlsup,delta
195 real sigma,z,p,t,wh,wo,ext,ome,gasym,phase,roatm,dtdir
196 real dtdif,utdir,utdif,sphal,wldis,trayl,traypl,pi,pi2,step
197 real asol,phi0,avis,phiv,tu,xlon,xlat,xlonan,hna,dsol,campm
198 real phi,phirad,xmus,xmuv,xmup,xmud,adif,uw,uo3,taer55
199 real taer,v,xps,uwus,uo3us,xpp,taer55p,puw,puo3,puwus
200 real puo3us,wl,wlmoy,tamoy,tamoyp,pizmoy,pizmoyp,trmoy
201 real trmoyp,fr,rad,spalt
202 real albbrdf,par1,par2,par3,par4,robar1,xnorm1,rob,xnor,rodir
203 real rdown,rdir,robar2,xnorm2,ro,roc,roe,rapp,rocave,roeave
204 real seb,sbor,swl,sb,refet,refet1,refet2,refet3,alumet
205 real tgasm,rog,dgasm,ugasm,sdwava,sdozon,sddica,sdoxyg
206 real sdniox,sdmoca,sdmeth,suwava,suozon,sudica,suoxyg
207 real suniox,sumoca,sumeth,stwava,stozon,stdica,stoxyg,stniox
208 real stmoca,stmeth,sodray,sodaer,sodtot,fophsr,fophsa,sroray
209 real sroaer,srotot,ssdaer,sdtotr,sdtota,sdtott,sutotr,sutota
210 real sutott,sasr,sasa,sast,dtozon,dtdica,dtoxyg
211 real dtniox,dtmeth,dtmoca,utozon,utdica,utoxyg,utniox
212 real utmeth,utmoca,attwava,ttozon,ttdica,ttoxyg,ttniox
213 real ttmeth,ttmoca,dtwava,utwava,ttwava,coef,romix,rorayl
214 real roaero,phaa,phar,tsca,tray,trayp,taerp,dtott,utott
215 real astot,asray,asaer,utotr,utota,dtotr,dtota,dgtot,tgtot
217 real ugtot,edifr,edifa,tdird,tdiru,tdifd,tdifu,fra
218 real fae,avr,romeas1,romeas2,romeas3,alumeas,sodrayp
219 real ratm1,ratm2,ratm3,rsurf
220 real sodaerp,sodtotp,tdir,tdif,etn,esn,es,ea0n,ea0,ee0n
221 real ee0,tmdir,tmdif,xla0n,xla0,xltn,xlt,xlen,xle,pizera
222 real fophst,pizerr,pizert,xrad,xa,xb,xc
224 integer nt,mu,mu2,np,k,iwr,mum1,idatmp
225 integer j,iread,l,igeom,month,jday,nc,nl,idatm,iaer,iaerp,n
226 integer iwave,iinf,isup,ik,i,inhomo,idirec,ibrdf,igroun
227 integer igrou1,igrou2,isort
231 dimension c(4),wldisc(10),ani(2,3),anr(2,3),aini(2,3),ainr(2,3)
232 dimension rocl(1501),roel(1501)
233 real rn,ri,x1,x2,x3,cij,rsunph,nrsunph,rmax,rmin
234 integer icp,irsunph,i1,i2
235 character etiq1(8)*60,nsat(47)*17,atmid(7)*51,reflec(8)*71
236 character FILE*80,FILE2*80
239 common/sixs_ier/iwr,ier
240 common /mie_in/ rmax,rmin,icp,rn(10,4),ri(10,4),x1(4),x2(4),
241 s x3(4),cij(4),irsunph,rsunph(50),nrsunph(50)
246 common /sixs_planesim/zpl(34),ppl(34),tpl(34),whpl(34),wopl(34)
247 common /sixs_test/xacc
251 common /sixs_sos/phasel(10,83),cgaus(83),pdgs(83)
252 common /sixs_trunc/pha(83),betal(0:80)
253 real optics(3),struct(4)
256 real pxLt,pc,pRl,pTl,pRs
257 real pws,phi_wind,xsal,pcl,paw
258 real uli,eei,thmi,sli,cabi,cwi,vaii,rnci,rsl1i
262 common /sixs_ffu/s(1501),wlinf,wlsup
263 common /sixs_del/ delta,sigma
264 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
265 common /sixs_aer/ext(10),ome(10),gasym(10),phase(10)
266 common /sixs_disc/ roatm(3,10),dtdir(3,10),dtdif(3,10),
267 s utdir(3,10),utdif(3,10),sphal(3,10),wldis(10),trayl(10),
277 data angmu /85.0,80.0,70.0,60.0,50.0,40.0,30.0,20.0,10.0,0.00/
278 data angphi/0.00,30.0,60.0,90.0,120.0,150.0,180.0,
279 s 210.0,240.0,270.0,300.0,330.0,360.0/
284 data wldisc /0.400,0.488,0.515,0.550,0.633,
285 s 0.694,0.860,1.536,2.250,3.750/
288 s
'(1h*,22x,34h user defined conditions ,t79,1h*)',
289 s
'(1h*,22x,24h meteosat observation ,t79,1h*) ',
290 s
'(1h*,22x,25h goes east observation ,t79,1h*) ',
291 s
'(1h*,22x,25h goes west observation ,t79,1h*) ',
292 s
'(1h*,22x,30h avhrr (AM noaa) observation ,t79,1h*) ',
293 s
'(1h*,22x,30h avhrr (PM noaa) observation ,t79,1h*) ',
294 s
'(1h*,22x,24h h.r.v. observation ,t79,1h*) ',
295 s
'(1h*,22x,24h t.m. observation ,t79,1h*) '/
298 s
' constant ',
' user s ',
299 s
' meteosat ',
' goes east ',
' goes west ',
300 s
' avhrr 1 (noaa6) ',
' avhrr 2 (noaa6) ',
301 s
' avhrr 1 (noaa7) ',
' avhrr 2 (noaa7) ',
302 s
' avhrr 1 (noaa8) ',
' avhrr 2 (noaa8) ',
303 s
' avhrr 1 (noaa9) ',
' avhrr 2 (noaa9) ',
304 s
' avhrr 1 (noaa10)',
' avhrr 2 (noaa10)',
305 s
' avhrr 1 (noaa11)',
' avhrr 2 (noaa11)',
306 s
' hrv1 1 ',
' hrv1 2 ',
' hrv1 3 ',
308 s
' hrv2 1 ',
' hrv2 2 ',
' hrv2 3 ',
310 s
' tm 1 ',
' tm 2 ',
' tm 3 ',
311 s
' tm 4 ',
' tm 5 ',
' tm 7 ',
312 s
' mss 4 ',
' mss 5 ',
313 s
' mss 6 ',
' mss 7 ',
314 s
' mas 1 ',
' mas 2 ',
' mas 3 ',
315 s
' mas 4 ',
' mas 5 ',
' mas 6 ',
316 s
' mas 7 ',
' modis 3 ',
' modis 5 ',
318 s
' avhrr 1 (noaa14)',
' avhrr 2 (noaa14)'/
321 s
'no absorption computed ',
322 s
'tropical (uh2o=4.12g/cm2,uo3=.247cm-atm)',
323 s
'midlatitude summer (uh2o=2.93g/cm2,uo3=.319cm-atm)',
324 s
'midlatitude winter (uh2o=.853g/cm2,uo3=.395cm-atm)',
325 s
'subarctic summer (uh2o=2.10g/cm2,uo3=.480cm-atm)',
326 s
'subarctic winter (uh2o=.419g/cm2,uo3=.480cm-atm)',
327 s
'us standard 1962 (uh2o=1.42g/cm2,uo3=.344cm-atm)'/
330 &
'(1h*,12x,39h user defined spectral reflectance ,f6.3,t79
332 &
'(1h*,12x,27h monochromatic reflectance ,f6.3,t79,1h*)',
333 &
'(1h*,12x,39h constant reflectance over the spectra ,f6.3,t79
335 &
'(1h*,12x,39h spectral vegetation ground reflectance,f6.3,t79
337 &
'(1h*,12x,39h spectral clear water reflectance ,f6.3,t79
339 &
'(1h*,12x,39h spectral dry sand ground reflectance ,f6.3,t79
341 &
'(1h*,12x,39h spectral lake water reflectance ,f6.3,t79
343 &
'(1h*,12x,39h spectral volcanic debris reflectance ,f6.3,t79
368 angphi(k)=angphi(k)*pi/180.
371 angmu(k)=cos(angmu(k)*pi/180.)
373 call gauss(-1.,1.,anglem,weightm,mu2)
374 call gauss(0.,pi2,rp,gp,np)
421 asol = solzni * 57.2958
422 phi0 = solaz * 57.2958
423 avis = obszni * 57.2958
424 phiv = obsphi * 57.2958
450 phirad=(phi0-phiv)*pi/180.
451 if (phirad.lt.0.) phirad=phirad+2.*pi
452 if (phirad.gt.(2.*pi)) phirad=phirad-2.*pi
453 xmus=cos(asol*pi/180.)
454 xmuv=cos(avis*pi/180.)
456 xmud=-xmus*xmuv-sqrt(1.-xmus*xmus)*sqrt(1.-xmuv*xmuv)*xmup
458 if (xmud.gt.1.) xmud=1.
459 if (xmud.lt.-1.) xmud=-1.
460 adif=acos(xmud)*180./pi
516 if(idatm.EQ.7) idatm = 6
518 6
if(idatm.eq.1)
call tropic
519 if(idatm.eq.2)
call midsum
520 if(idatm.eq.3)
call midwin
521 if(idatm.eq.4)
call subsum
522 if(idatm.eq.5)
call subwin
523 if(idatm.eq.6)
call us62
525 5
if(idatm.eq.0.or.idatm.eq.8)
call us62
626 if(iaer.eq.4)
read(iread,*) (c(n),n=1,4)
627 goto(49,40,41,42,49,49,49,49,43,44,45,46,47),iaer+1
644 43
read(iread,*) rmin,rmax,icp
646 read(5,*)x1(i),x2(i),cij(i)
647 read(5,*)(rn(l,i),l=1,10)
648 read(5,*)(ri(l,i),l=1,10)
651 44
read(iread,*) rmin,rmax
652 read(iread,*) x1(1),x2(1),x3(1)
653 read(5,*)(rn(l,1),l=1,10)
654 read(5,*)(ri(l,1),l=1,10)
656 45
read(iread,*) rmin,rmax
658 read(5,*)(rn(l,1),l=1,10)
659 read(5,*)(ri(l,1),l=1,10)
663 read(5,*)rsunph(i),nrsunph(i)
664 nrsunph(i)=nrsunph(i)/(rsunph(i)**4.)/alog(10.0)
667 rmax=rsunph(irsunph)+1e-07
668 read(5,*)(rn(l,1),l=1,10)
669 read(5,*)(ri(l,1),l=1,10)
671 47
read(5,
'(A80)')file2
672 i2=
index(file2,
' ')-1
676 if (iaer.ge.8.and.iaer.le.11)
then
678 if (iaerp.eq.1)
read(5,
'(A80)')file
680 file2=file(1:i1)//
'.mie'
681 i2=
index(file2,
' ')-1
684 call aeroso(iaer,c,xmud,wldis,file2)
715 10
read(iread,*) taer55
716 v=exp(-log(taer55/2.7628)/0.79902)
718 11
call oda550(iaer,v,taer55)
790 if (xpp.gt.100.)
then
826 if ((taer55p.lt.0.).or.((taer55-taer55p).lt.accu2))
then
828 taer55p=taer55*(1.-exp(-palt/2.))
832 sha=1.-(taer55p/taer55)
833 if (sha.ge.sham)
then
834 taer55p=taer55*(1.-exp(-palt/4.))
837 taer55p=taer55*(1.-exp(-palt/sha))
871 iinf=(wlinf-.25)/0.0025+1.5
872 isup=(wlsup-.25)/0.0025+1.5
896 call discom (idatmp,iaer,xmus,xmuv,phi
897 a ,taer55,taer55p,palt,
898 a phirad,nt,mu,np,rm,gb,rp
902 s tamoy,tamoyp,pizmoy,pizmoyp)
907 if (idatmp.eq.4)
then
911 if (idatmp.eq.0)
then
1014 write(iwr, etiq1(igeom+1))
1017 write(iwr, 103)month,jday
1019 if(igeom.ne.0)
write(iwr, 101)month,jday,tu,xlat,xlon
1020 write(iwr, 102)asol,phi0
1021 write(iwr, 1110)avis,phiv,adif,phi
1025 if(idatm-7)226,227,228
1026 228
write(iwr, 1281)uw,uo3
1028 227
write(iwr, 1272)
1030 write(iwr, 1271)z(i),p(i),t(i),wh(i),wo(i)
1033 226
write(iwr, 1261)atmid(idatm+1)
1036 219
if (iaer.lt.4)
then
1037 goto(230,231,232,233),iaer+1
1039 if (iaer.ge.5.and.iaer.le.7)
goto(234,235,236),iaer-4
1040 if (iaer.eq.4)
write(iwr,133)(c(i),i=1,4)
1044 write(iwr,135)x1(i),x2(i),cij(i)
1047 if (iaer.eq.9)
write(iwr,136)x1(1),x2(1),x3(1)
1048 if (iaer.eq.10)
write(iwr,137)x1(1)
1049 if (iaer.eq.11)
write(iwr, 131)
' Sun Photometer'
1050 if (iaer.eq.12)
write(iwr,138)file2(1:i2)
1051 if (iaerp.eq.1)
write(iwr,139)file2(1:i2)
1054 234
write(iwr, 131)
' Desertic'
1056 235
write(iwr, 131)
' Smoke'
1058 236
write(iwr, 131)
' Stratospheric'
1060 233
write(iwr, 131)
' Urban'
1062 232
write(iwr, 131)
' Maritime'
1064 231
write(iwr, 131)
' Continental'
1066 230
write(iwr, 1301)
1070 if(iaer.eq.0)
write(iwr, 1401)
1071 if(iaer.eq.0)
goto 1112
1072 if(
abs(v).le.xacc)
write(iwr, 140)taer55
1073 if(
abs(v).gt.xacc)
write(iwr, 141)v,taer55
1083 if(idirec.eq.0)
then
1090 if(i.eq.iinf.or.i.eq.isup) sbor=sbor*0.5
1098 rocave=rocave+rocl(i)*sbor*swl*step
1099 roeave=roeave+roel(i)*sbor*swl*step
1100 seb=seb+sbor*swl*step
1107 if(inhomo.eq.0)
goto 260
1121 261
if (igroun.gt.0)
write(iwr, reflec(igroun+3))ro
1122 if (igroun.gt.0)
goto 158
1123 if(igroun.eq.-1)
write(iwr, reflec(1))ro
1124 if(igroun.eq.-1)
goto 158
1125 if(iwave.eq.-1)
write(iwr, reflec(2))ro
1128 if(inhomo.eq.0)
goto 999
1129 if(isort.eq.2)
goto 999
1142 if (palt.lt.1000.)
then
1165 if(l.eq.iinf.or.l.eq.isup) sbor=sbor*0.5
1166 if(iwave.eq.-1) sbor=1.0/step
1174 call interp (iaer,idatmp,wl,taer55,taer55p,xmud,
1175 s romix,rorayl,roaero,phaa,phar,tsca,
1176 s tray,trayp,taer,taerp,dtott,utott,
1177 s astot,asray,asaer,
1178 s utotr,utota,dtotr,dtota)
1180 if (iwave.eq.-2)
then
1189 rotemp(jindex) = romix
1190 dttemp(jindex) = dtott*utott
1191 astemp(jindex) = astot
1208 CALL cubspln(nelem,wltemp,rotemp,wavobs,rotot)
1209 CALL cubspln(nelem,wltemp,dttemp,wavobs,ttot)
1210 CALL cubspln(nelem,wltemp,astemp,wavobs,stot)
1211 WRITE(*,*)
'I,WAVOBS(I), ROTOT(I), TTOT(I), STOT(I)'
1213 122
WRITE(*,*) i,wavobs(i), rotot(i), ttot(i), stot(i)
1221 9257
format(79(1h*),/)
1231 98
format(///,1h*,30(1h*),16h 6s version 4.1 ,30(1h*),t79
1232 s ,1h*,/,1h*,t79,1h*,/,
1233 s 1h*,22x,34h geometrical conditions identity ,t79,1h*,/,
1234 s 1h*,22x,34h ------------------------------- ,t79,1h*)
1235 101
format(1h*,15x,7h month:,i3,7h day : ,i3,
1236 s 16h universal time:,f6.2,
1237 s 10h(hh.dd) ,t79,1h*,/,
1238 s 1h*, 15x,10hlatitude: ,f7.2,5h deg ,6x,
1239 s 12h longitude: ,f7.2,5h deg ,t79,1h*)
1240 102
format(1h*,2x,22h solar zenith angle: ,f6.2,5h deg ,
1241 s 29h solar azimuthal angle: ,f6.2,5h deg ,t79,1h*)
1242 103
format(1h*,2x,7h month:,i3,7h day : ,i3,t79,1h*)
1243 1110
format(1h*,2x,22h view zenith angle: ,f6.2,5h deg ,
1244 s 29h view azimuthal angle: ,f6.2,5h deg ,
1246 s 1h*,2x,22h scattering angle: ,f6.2,5h deg ,
1247 s 29h azimuthal angle difference: ,f6.2,5h deg ,
1249 1119
format(1h*,t79,1h*,/,
1250 s 1h*,22x,31h atmospheric model description ,t79,1h*,/,
1251 s 1h*,22x,31h ----------------------------- ,t79,1h*)
1252 1261
format(1h*,10x,30h atmospheric model identity : ,t79,1h*,/,
1253 s 1h*,15x,a51,t79,1h*)
1254 1272
format(1h*,30h atmospheric model identity : ,t79,1h*,/,
1255 s 1h*,12x,33h user defined atmospheric model ,t79,1h*,/,
1256 s 1h*,12x,11h*altitude ,11h*
pressure ,
1257 s 11h*temp. ,11h*h2o dens. ,11h*o3 dens. ,t79,1h*)
1258 1271
format(1h*,12x,5e11.4,t79,1h*)
1259 1281
format(1h*,10x,31h atmospheric model identity : ,t79,1h*,
1260 s /,1h*,12x,35h user defined
water content : uh2o=,f6.3,
1261 s 7h g/cm2 ,t79,1h*,
1262 s /,1h*,12x,35h user defined ozone content : uo3 =,f6.3,
1263 s 7h cm-atm,t79,1h*)
1264 1301
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1265 s 1h*,15x,24h no aerosols computed ,t79,1h*)
1266 131
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1267 s 1h*,15x,a15,15h aerosols model,t79,1h*)
1268 133
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1269 s 1h*,15x,29h user defined aerosols model ,t79,1h*,/,
1270 s 1h*,26x,f6.3,15h % of
dust-like,t79,1h*,/,
1271 s 1h*,26x,f6.3,19h % of
water-soluble,t79,1h*,/,
1272 s 1h*,26x,f6.3,13h % of oceanic,t79,1h*,/,
1273 s 1h*,26x,f6.3,10h % of
soot,t79,1h*)
1274 134
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1275 s 1h*,15x,29h user defined aerosols model ,t79,1h*,/,
1276 s 1h*,15x,6husing ,i1,32h log-normal size-distribution(s),t79,
1277 s 1h*,/,1h*,15x,42hmean
radius stand. dev. percent. dencity,
1279 135
format(1h*,t41,f6.4,t55,f5.3,t69,e8.3,t79,1h*)
1280 136
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1281 s 1h*,15x,29h user defined aerosols model ,t79,1h*,/,
1282 s 1h*,15x,40husing a modified gamma size-distribution,t79,1h*,/,
1283 s 1h*,19x,33halpha b gamma,t79,1h*,/,
1284 s 1h*,t20,f6.3,t31,f6.3,t47,f6.3,t79,1h*)
1285 137
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1286 s 1h*,15x,29h user defined aerosols model ,t79,1h*,/,
1287 s 1h*,15x,47husing a
power law size-distribution with alpha=,
1289 138
format(1h*,10x,25h aerosols
type identity :,t79,1h*,/,
1290 s 1h*,15x,29h user defined aerosols model ,t79,1h*,/,
1291 s 1h*,15x,25husing
data from the file:,t79,1h*,/,
1292 s 1h*,t25,a30,t79,1h*)
1293 139
format(1h*,15x,29h results saved into the file:,t79,1h*,/,
1294 s 1h*,t25,a30,t79,1h*)
1295 140
format(1h*,10x,29h optical condition identity :,t79,1h*,/,
1296 s 1h*,15x,31h user def. opt. thick. at 550nm :,f7.4,
1297 s t79,1h*,/,1h*,t79,1h*)
1298 141
format(1h*,10x,29h optical condition identity :,t79,1h*,/,
1299 s 1h*,15x,13h visibility :,f6.2,4h km ,
1300 s 20h opt. thick. 550nm :,f7.4,t79,1h*,/,
1302 148
format(1h*,22x,21h spectral condition ,t79,1h*,/,1h*,
1303 s 22x,21h ------------------ ,t79,1h*)
1304 149
format(1h*,12x,34h monochromatic calculation at wl :,
1305 s f6.3,8h micron ,t79,1h*)
1306 1510
format(1h*,10x,a17,t79,1h*,/,
1307 s 1h*,15x,26hvalue of
filter function :,t79,1h*,/,1h*,
1308 s 15x,8h wl inf=,f6.3,4h mic,2x,8h wl sup=,f6.3,4h mic,t79,1h*)
1309 168
format(1h*,t79,1h*,/,1h*,22x,14h
target type ,t79,1h*,/,1h*,
1310 s 22x,14h ----------- ,t79,1h*,/,1h*,
1311 s 10x,20h homogeneous ground ,t79,1h*)
1312 169
format(1h*,t79,1h*,/,1h*,22x,14h
target type ,t79,1h*,/,1h*,
1313 s 22x,14h ----------- ,t79,1h*,/,1h*,
1314 s 10x,41h inhomogeneous ground ,
radius of
target ,f6.3,
1316 170
format(1h*,15x,22h
target reflectance : ,t79,1h*)
1317 171
format(1h*,15x,29h environmental reflectance : ,t79,1h*)
1318 172
format(1h*,t79,1h*,/,79(1h*),///)
1319 173
format(1h*,t79,1h*,/,
1320 s 1h*,22x,30h
target elevation description ,t79,1h*,/,
1321 s 1h*,22x,30h ---------------------------- ,t79,1h*)
1322 174
format(1h*,10x,22h ground
pressure [mb] ,1x,f7.2,1x,t79,1h*)
1323 175
format(1h*,10x,22h ground altitude [km] ,f6.3,1x,t79,1h*)
1324 176
format(1h*,15x,34h gaseous content at
target level: ,t79,1h*,
1325 s /,1h*,15x,6h uh2o=,f6.3,7h g/cm2 ,
1326 s 5x,6h uo3=,f6.3,7h cm-atm,t79,1h*)
1329 178
format(1h*,t79,1h*,/,
1330 s 1h*,22x,30h plane simulation description ,t79,1h*,/,
1331 s 1h*,22x,30h ---------------------------- ,t79,1h*)
1332 179
format(1h*,10x,31h plane
pressure [mb] ,f7.2,1x,t79,1h*)
1333 180
format(1h*,10x,31h plane altitude absolute [km] ,f6.3,1x,t79,1h*)
1334 181
format(1h*,15x,37h atmosphere under plane description: ,t79,1h*)
1335 182
format(1h*,15x,26h ozone content ,f6.3,1x,t79,1h*)
1336 183
format(1h*,15x,26h h2o content ,f6.3,1x,t79,1h*)
1337 184
format(1h*,15x,26haerosol opt. thick. 550nm ,f6.3,1x,t79,1h*)
1339 1401
format(1h*,t79,1h*)
1340 1500
format(1h*,1x,42hwave total total total total atm. ,
1341 s 33hswl step sbor dsol toar ,t79,1h*,/,
1342 s 1h*,1x,42h gas scat scat spheri intr ,t79,1h*,/,
1343 s 1h*,1x,42h trans down up albedo refl ,t79,1h*)
1345 1501
format(1x,6(f6.4,1x),f6.4,1x,4(f6.4,1x),t79,1x)
1349 subroutine aeroso (iaer,co,xmud,wldis,FILE)
1351 double precision cij(4),vi(4),nis,sumni,ni(4)
1352 real co(4),dd(4,10),ci(4),ex(4,10),sc(4,10),asy(4,10)
1353 real pha(5,10,83),sca(10),wldis(10)
1354 real ex2(1,10),sc2(1,10),asy2(1,10)
1355 real ex3(1,10),sc3(1,10),asy3(1,10)
1356 real ex4(1,10),sc4(1,10),asy4(1,10)
1357 real xmud,ext,ome,gasym,phase,ph,phasel,cgaus,pdgs
1359 integer i,j,k,l,j1,j2,iaer,icp
1368 data vi /113.983516,113.983516d-06,5.1444150196,
1370 data ni /54.734,1.86855d+06,276.05,1.80582d+06/
1373 data ((ex(i,j),sc(i,j),j=1,10),i=1,1) /
1374 a 0.1796674e-01,0.1126647e-01,0.1815135e-01,0.1168918e-01,
1375 a 0.1820247e-01,0.1180978e-01,0.1827016e-01,0.1196792e-01,
1376 a 0.1842182e-01,0.1232056e-01,0.1853081e-01,0.1256952e-01,
1377 a 0.1881427e-01,0.1319347e-01,0.1974608e-01,0.1520712e-01,
1378 a 0.1910712e-01,0.1531952e-01,0.1876025e-01,0.1546761e-01/
1379 data ((ex(i,j),sc(i,j),j=1,10),i=2,2) /
1380 a 0.7653460e-06,0.7377123e-06,0.6158538e-06,0.5939413e-06,
1381 a 0.5793444e-06,0.5587120e-06,0.5351736e-06,0.5125148e-06,
1382 a 0.4480091e-06,0.4289210e-06,0.3971033e-06,0.3772760e-06,
1383 a 0.2900993e-06,0.2648252e-06,0.1161433e-06,0.9331806e-07,
1384 a 0.3975192e-07,0.3345499e-07,0.1338443e-07,0.1201109e-07/
1385 data ((ex(i,j),sc(i,j),j=1,10),i=3,3) /
1386 a 0.3499458e-02,0.3499455e-02,0.3574996e-02,0.3574993e-02,
1387 a 0.3596592e-02,0.3596591e-02,0.3622467e-02,0.3622465e-02,
1388 a 0.3676341e-02,0.3676338e-02,0.3708866e-02,0.3708858e-02,
1389 a 0.3770822e-02,0.3770696e-02,0.3692255e-02,0.3677038e-02,
1390 a 0.3267943e-02,0.3233194e-02,0.2801670e-02,0.2728013e-02/
1391 data ((ex(i,j),sc(i,j),j=1,10),i=4,4) /
1392 a 0.8609083e-06,0.2299196e-06,0.6590103e-06,0.1519321e-06,
1393 a 0.6145787e-06,0.1350890e-06,0.5537643e-06,0.1155423e-06,
1394 a 0.4503008e-06,0.8200095e-07,0.3966041e-06,0.6469735e-07,
1395 a 0.2965532e-06,0.3610638e-07,0.1493927e-06,0.6227224e-08,
1396 a 0.1017134e-06,0.1779378e-08,0.6065031e-07,0.3050002e-09/
1398 data ((ex2(i,j),sc2(i,j),j=1,10),i=1,1) /
1399 a 0.4383631e+02,0.4028625e+02,0.4212415e+02,0.3904473e+02,
1400 a 0.4157425e+02,0.3861470e+02,0.4085399e+02,0.3803645e+02,
1401 a 0.3914040e+02,0.3661054e+02,0.3789763e+02,0.3554456e+02,
1402 a 0.3467506e+02,0.3269951e+02,0.2459000e+02,0.2341019e+02,
1403 a 0.1796726e+02,0.1715375e+02,0.1057569e+02,0.1009731e+02/
1405 data ((ex3(i,j),sc3(i,j),j=1,10),i=1,1) /
1406 a 0.9539786e+05,0.9297790e+05,0.7530360e+05,0.7339717e+05,
1407 a 0.7021064e+05,0.6842549e+05,0.6421828e+05,0.6257180e+05,
1408 a 0.5243056e+05,0.5104987e+05,0.4557768e+05,0.4434877e+05,
1409 a 0.3193777e+05,0.3100621e+05,0.9637680e+04,0.9202678e+04,
1410 a 0.3610691e+04,0.3344476e+04,0.8105614e+03,0.6641915e+03/
1412 data ((ex4(i,j),sc4(i,j),j=1,10),i=1,1) /
1413 a .5427304e+08, .5427304e+08, .6198144e+08, .6198144e+08,
1414 a .6302432e+08, .6302432e+08, .6348947e+08, .6348947e+08,
1415 a .6146760e+08, .6146760e+08, .5817972e+08, .5817972e+08,
1416 a .4668909e+08, .4668909e+08, .1519062e+08, .1519062e+08,
1417 a .5133055e+07, .5133055e+07, .8998594e+06, .8998594e+06/
1419 data ((asy(i,j),j=1,10),i=1,4) /
1420 a 0.896,0.885,0.880,0.877,0.867,0.860,0.845,0.836,0.905,0.871,
1421 a 0.642,0.633,0.631,0.628,0.621,0.616,0.610,0.572,0.562,0.495,
1422 a 0.795,0.790,0.788,0.781,0.783,0.782,0.778,0.783,0.797,0.750,
1423 a 0.397,0.359,0.348,0.337,0.311,0.294,0.253,0.154,0.103,0.055/
1425 data ((asy2(i,j),j=1,10),i=1,1)/
1426 a 0.718,0.712,0.710,0.708,0.704,0.702,0.696,0.680,0.668,0.649/
1428 data ((asy3(i,j),j=1,10),i=1,1)/
1429 a 0.704,0.690,0.686,0.680,0.667,0.659,0.637,0.541,0.437,0.241/
1431 data ((asy4(i,j),j=1,10),i=1,1)/
1432 a .705, .744, .751, .757, .762, .759, .737, .586, .372, .139/
1434 common /sixs_aer/ ext(10),ome(10),gasym(10),phase(10)
1435 common /sixs_aerbas/ ph(10,83)
1436 common /sixs_sos/phasel(10,83),cgaus(83),pdgs(83)
1443 if(l.eq.4.and.iaer.eq.0) ext(l)=1.
1455 if(iaer.eq.0)
return
1458 if((xmud.ge.cgaus(k)).and.(xmud.lt.cgaus(k+1)))
go to 8
1463 coef=-(xmud-cgaus(j1))/(cgaus(j2)-cgaus(j1))
1465 if (iaer.eq.12)
then
1469 read(10,
'(8x,4(3x,f6.4,3x))')ext(l),sca(l),ome(l),gasym(l)
1473 read(10,
'(8x,10(1x,e10.4))')(phasel(l,k),l=1,10)
1477 phase(l)=phasel(l,j1)+coef*(phasel(l,j1)-phasel(l,j2))
1484 asy(1,k)=asy2(iaer-4,k)
1485 ex(1,k)=ex2(iaer-4,k)
1486 sc(1,k)=sc2(iaer-4,k)
1492 asy(1,k)=asy3(iaer-5,k)
1493 ex(1,k)=ex3(iaer-5,k)
1494 sc(1,k)=sc3(iaer-5,k)
1500 asy(1,k)=asy4(iaer-6,k)
1501 ex(1,k)=ex4(iaer-6,k)
1502 sc(1,k)=sc4(iaer-6,k)
1507 if (iaer.ge.5.and.iaer.le.11)
then
1510 if (iaer.eq.5)
call bdm
1512 if (iaer.eq.6)
call bbm
1514 if (iaer.eq.7)
call stm
1516 if (iaer.ge.8.and.iaer.le.11)
call mie(iaer,wldis,ex,sc,asy)
1519 dd(1,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
1534 dd(1,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
1542 dd(2,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
1550 dd(3,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
1558 dd(4,l)=ph(l,j1)+coef*(ph(l,j1)-ph(l,j2))
1567 3 sigm=sigm+ci(i)/vi(i)
1571 cij(j)=(ci(j)/vi(j)/sigm)
1572 4 sumni=sumni+cij(j)/ni(j)
1581 ext(l)=ex(j,l)*cij(j)+ext(l)
1582 sca(l)=sc(j,l)*cij(j)+sca(l)
1583 gasym(l)=sc(j,l)*cij(j)*asy(j,l)+gasym(l)
1584 phase(l)=sc(j,l)*cij(j)*dd(j,l)+phase(l)
1586 phasel(l,k)=sc(j,l)*cij(j)*pha(j,l,k)+phasel(l,k)
1589 ome(l)=sca(l)/ext(l)
1590 gasym(l)=gasym(l)/sca(l)
1591 phase(l)=phase(l)/sca(l)
1593 phasel(l,k)=phasel(l,k)/sca(l)
1598 if (iaer.ge.8.and.iaer.le.11)
then
1600 write(10,
'(3x,A5,1x,5(1x,A10,1x),1x,A10)')
'Wlgth',
1601 s
'Nor_Ext_Co',
'Nor_Sca_Co',
'Sg_Sca_Alb',
1602 s
'Asymm_Para',
'Extinct_Co',
'Scatter_Co'
1604 write(10,
'(2x,f6.4,4(3x,f6.4,3x),2(2x,e10.4))')
1605 s wldis(l),ext(l),sca(l),ome(l),gasym(l),ext(l)/nis,sca(l)/nis
1607 write(10,
'(//,T20,A16,/,3x,A4,1x,10(3x,f6.4,2x))')
1608 s
' Phase Function ',
'TETA',(wldis(l),l=1,10)
1610 write(10,
'(2x,f6.2,10(1x,e10.4))')180.*acos(cgaus(k))/pi,
1611 s (phasel(l,k),l=1,10)
1621 implicit double precision (a-h, o-z)
1622 save /count/, /soildata/, /aaa/, /ggg/, /ladak/
1624 dimension u1(10), u2(10), a1(10), a2(10)
1625 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
1627 double precision nnl, kk
1628 common /leafin/ nnl, vai, kk
1629 common /leafout/ refl, tran
1631 double precision ke, kab, kw
1632 dimension refr(200), ke(200), kab(200), kw(200)
1633 common /dat/ refr, ke, kab, kw
1635 dimension phis1(200), phis2(200), phis3(200), phis4(200)
1636 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2, rsl3,
1637 & rsl4, th2, rsl, rsoil, rr1soil, rrsoil
1639 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
1640 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
1641 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
1642 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
1643 & alph, salph, alpp, difmy, difsig
1644 common /cfresn/ rn, rk
1645 common /ladak/ ee, thm, sthm, cthm
1646 common /msrmdata/ th10, rncoef, cab, cw, bq
1648 data pi12/1.570796326794895d0/, pi/3.141592653589793d0/
1685 implicit double precision (a-h, o-z)
1686 save /count/, /aaa/, /ggg/
1688 dimension tt3(10), stt3(10), ctt3(10), tt2(10), stt2(10), ctt2(10)
1690 dimension u1(10), u2(10), a1(10), a2(10)
1691 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
1693 double precision nnl, kk
1694 common /leafin/ nnl, vai, kk
1695 common /leafout/ refl, tran
1697 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
1698 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
1699 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
1700 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
1701 & alph, salph, alpp, difmy, difsig
1703 data pi/3.141592653589793d0/, pi1/1.5707963268d0/, eps/.005d0/
1707 if (th .gt. eps)
goto 4
1713 th1 = (1.d0 - u2(i2))*pi1
1726 bqint = bqint + a2(i2)*(bi + bd)*sth1*cth1
1741 thi = u2(i)*(th - pi1) + pi1
1748 phi = (1.d0 - u1(j))*pi
1769 bd1 = bd1 + a1(i1)*(bi + bd)*sth1*cth1
1788 bd2 = bd2 + a2(i2)*(bi + bd)*sth1*cth1
1791 bqint = bqint + ((pi1 - th)*bd2 + th*bd1)*a1(j)
1794 bqint = bqint + bqint
1805 implicit double precision (a-h, o-z)
1806 double precision integr
1807 save /count/, /soildata/, /aaa/, /ggg/, /ladak/
1811 dimension u1(10), u2(10), a1(10), a2(10)
1812 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
1814 dimension phis1(200), phis2(200), phis3(200), phis4(200)
1815 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
1816 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
1818 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
1819 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
1820 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
1821 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
1822 & alph, salph, alpp, difmy, difsig
1823 common /ladak/ ee, thm, sthm, cthm
1825 data pi/3.14159265358979d0/, eps/.1d-4/, eps3/.01d0/
1827 integr(xx) = (1.d0 - exp(-xx))/xx
1839 if (ul .gt. eps)
goto 2
1844 if (th1 .lt. th)
goto 12
1865 calph = stt1*cp + ctt1
1880 if (st .ne. 0.d0) ctg = ct/st
1881 if (st1 .ne. 0.d0) ctg1 = ct1/st1
1889 if (ee .le. eps3)
goto 95
1890 y4 =
abs(cth + cth1)*.5d0/calp2
1891 if (y4.lt.1.d0) thp = acos(y4)
1893 95
call glak(glthp, thp)
1900 gammd = gr*rrl + gt*ttl
1924 if (ctt1 .gt. eps)
then
1930 if ((xx1 .gt. 30.d0) .or. (ctt1 .le. eps))
then
1937 easte2 = exp(-ulg1 - gma)
1938 easte4 = exp(-ulg - gma)
1939 bs1 = (easte + easte2 - easte4)*rsoil
1942 xx1 = (1.d0 - easte)/gg1
1943 xx2 = (1.d0 - easte2)/(gg1*.5d0 + bam) -
1944 & (1.d0 - easte4)/(gg1 + bam)
1946 bc1hs = xx2*(gammd + gf)
1948 bc1 = bc1d + bcsp + bc1hs
1969 implicit double precision (a-h, o-z)
1970 double precision ks, ko, m, m11, m12, m21, m22, integr
1971 save /soildata/, /aaa/, /ggg/, /ladak/
1973 dimension phis1(200), phis2(200), phis3(200), phis4(200)
1974 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
1975 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
1977 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
1978 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
1979 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
1980 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
1981 & alph, salph, alpp, difmy, difsig
1982 common /ladak/ ee, thm, sthm, cthm
1984 integr(x) = (1.d0 - exp(-x))/x
1991 rtp = (rrl + ttl)/2.d0
1995 gg = (1.289d0*difmy - 1.816d0*difsig)*(cthm**2 -
1996 & .33333333333d0) + .31823d0
1997 bf = (rrl - ttl)/2.d0*ul*gg
1998 att = (1.d0 - rtp)*ul + bf
2004 m = sqrt(att**2 - sig**2)
2007 c = (sf*sig - sb*(ks - att))/(m**2 - ks**2)
2008 d = (sb*sig + sf*(ks + att))/(m**2 - ks**2)
2012 epss = (rrsoil*(d + 1.d0) - c)*exp(-ks)
2015 m21 = (1.d0 - rrsoil*h1)*exp(-m)
2016 m22 = (1.d0 - rrsoil*h2)*exp(m)
2017 det = m11*m22 - m12*m21
2018 a = (m22*epso - m12*epss)/det
2019 b = (-m21*epso + m11*epss)/det
2022 ek = integr(ko + ks)
2024 gp = a*ep + b*em + c*ek
2026 gm = h1*a*ep + h2*b*em + d*ek
2028 ems = h1*a*exp(-m) + h2*b*exp(m) + d*exp(-ks)
2029 rplants = uf*gp + ub*gm
2030 rdsoil = rrsoil*ems*exp(-ko)
2031 bd = rplants + rdsoil
2038 subroutine glak(glth, th)
2042 implicit double precision (a-h, o-z)
2046 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
2047 common /ladak/ ee, thm, sthm, cthm
2049 data bb/1.d0/, es/0.d0/, tms/0.d0/, eps/.1d0/
2053 if (ee .lt. eps)
then
2058 if (ee .eq. 1.d0) ee = .999999d0
2059 if ((ee .ne. es) .or. (thm .ne. tms))
then
2062 u2 = sqrt(1.d0 - u1*u1)
2063 u4 = sqrt(1.d0 - u3*u3)
2064 x = log((u4 + u1)/(u2 - u3))
2065 x1 = atan2(u3, u4) - atan2(u1, u2)
2066 x2 = sthm*x - cthm*x1
2072 glth = bb/sqrt(1.d0 - (ee*cos(thm - th))**2)
2084 implicit double precision (a-h, o-z)
2087 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
2088 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
2089 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
2090 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
2091 & alph, salph, alpp, difmy, difsig
2092 common /cfresn/ rn, rk
2094 data pi12/1.570796326794895d0/
2100 ag = x2*2.d0 - 1.d0 + rn*rn
2101 bg = 1.d0 + (ag - 2.d0)*x2
2103 cg = 2.d0*ca*sqrt(xy)
2105 y = (bg + sa2*cg)*(ag + cg)
2107 yy = sqrt(sa2)/pi12/ca*rk
2120 implicit double precision (a-h, o-z)
2121 save a, b, c, cts, ths1, ths2
2122 save /count/, /soildata/, /aaa/, /ggg/
2124 dimension phis1(200), phis2(200), phis3(200), phis4(200)
2125 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
2126 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
2128 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
2129 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
2130 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
2131 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
2132 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
2133 & alph, salph, alpp, difmy, difsig
2135 data a/.45098d0/, b/5.7829d0/, c, cts/2*13.7575d0/
2136 data ths1, ths2/2*.785398163d0/
2139 if (th2 .ne. ths2)
then
2140 cts = 16.41d0 - th2*th2*4.3d0
2143 if (th1 .ne. ths1)
then
2146 a = x*7.702d0 - 4.3d0
2148 c = 16.41d0 - x*4.3d0
2151 rsoil = ((a*th + b*cp)*th + c)*x2
2152 rr1soil = (.7337d0*a + c)*x2
2164 implicit double precision (a-h, o-z)
2165 save /count/, /soildata/
2167 dimension u1(10), u2(10), a1(10), a2(10)
2168 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
2170 dimension phis1(200), phis2(200), phis3(200), phis4(200)
2171 common /soildata/phis1, phis2, phis3, phis4, rsl1, rsl2,
2172 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
2174 rsl = rsl1*phis1(jl) + rsl2*phis2(jl) +
2175 & rsl3*phis3(jl) + rsl4*phis4(jl)
2187 implicit double precision (a-h, o-z)
2189 save /aaa/, /ggg/, /ladak/
2191 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
2192 common /ggg/ gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
2193 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
2194 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
2195 & alph, salph, alpp, difmy, difsig
2196 common /ladak/ ee, thm, sthm, cthm
2198 data pi/3.14159265358979d0/, pi4/6.28318531717958d0/,
2199 & pi12/.159154943d0/, pi14/.636619773d0/, eps5/.1d-2/
2200 & , pi13/.1061032953d0/
2205 gr0 = (salph + alpp*calph)*pi13
2206 gt0 = (salph - alph*calph)*pi13
2207 if (ee .lt. .4d0)
then
2219 if (th22 .lt. t11)
goto 47
2228 if (th22 .lt. t10)
goto 50
2248 gr = gr0 - .0102d0 +
2249 & (1.742d0*difmy - .4557d0*difsig)*(gr1 - gr0)
2250 gt = gt0 + .00653d0 +
2251 & (.2693d0*difmy + 5.821d0*difsig)*(gt1 - gt0)
2252 g = (2.653d0*difmy + 1.432d0*difsig)*(sg - .5d0) + .50072d0
2253 g1 = (2.653d0*difmy + 1.432d0*difsig)*(sg1 - .5d0) + .50072d0
2263 if (y .gt. 0.d0) sgmr = sgmr + y
2264 if (y .lt. 0.d0) sgmt = sgmt - y
2274 x1 = sqrt(1.d0 - x*x)
2282 if (y .gt. 0.d0) sgmr = sgmr + y
2283 if (y .lt. 0.d0) sgmt = sgmt - y
2288 if (y .gt. 0.d0) sgmr = sgmr + y
2289 if (y .lt. 0.d0) sgmt = sgmt - y
2297 x1 = sqrt(1.d0 - x*x)
2302 x1 = sqrt(1.d0 - x*x)
2305 if (fb .lt. 0.d0) fb = fb + pi4
2313 if (fb .gt. fa)
goto 75
2330 if (y .gt. 0.d0) sgmr = sgmr + y
2331 if (y .lt. 0.d0) sgmt = sgmt - y
2332 if (i1 .le. 4)
goto 76
2336 x1 = sqrt(x1*x1 - 1.d0)
2354 x1 = sqrt(x1*x1 - 1.d0)
2364 if (x .gt. eps5)
goto 31
2367 31
if ((pi4 - x) .lt. eps5)
goto 130
2372 pp = x*ctt1*cthm*cthm
2373 y1 = x + sfb*cfb - sfa*cfa
2375 y1 = y1*cp + sp*x*(cfa + cfb)
2376 pp = pp + stt1*.5d0*y1*sthm*sthm
2377 y1 = s2*(sfb - sfa) + s3*x
2378 pp = pp + y1*sthm*cthm
2382 pp = calph*x + ctt1*(2.d0 - 3.d0*x)
2400 implicit double precision (a-h, o-z)
2402 double precision nn, k, inex
2403 common /leafin/ nn, vai, k
2404 common /leafout/ refl, tran
2405 common /nagout/ inex
2406 common /tauin/ teta, ref
2419 if (k .le. 0.d0)
then
2423 k = (1.d0 - k)*exp(-k) + k**2*inex
2438 x2 = t1**2*k**2*(nn**2 - t1)
2440 x4 = nn**4 - k**2*(nn**2 - t1)**2
2442 x6 = x5*(t1 - 1.d0) + 1.d0 - t2
2457 delta = (t**2 - r**2 - 1.d0)**2 - 4.d0*r**2
2458 alfa = (1.d0 + r**2 - t**2 + sqrt(delta))/(2.d0*r)
2459 beta = (1.d0 + r**2 - t**2 - sqrt(delta))/(2.d0*r)
2460 va = (1.d0 + r**2 - t**2 + sqrt(delta))/(2.d0*r)
2461 vb = sqrt(beta*(alfa - r)/(alfa*(beta - r)))
2462 s1 = ra*(va*vb**(vai - 1.d0) -
2463 & va**(-1.d0)*vb**(-(vai - 1.d0))) +
2464 & (ta*t - ra*r)*(vb**(vai - 1.d0) - vb**(-(vai - 1.d0)))
2465 s2 = ta*(va - va**(-1.d0))
2466 s3 = va*vb**(vai - 1.d0) - va**(-1.d0)*vb**(-(vai - 1.d0))
2467 & - r*(vb**(vai - 1.d0) - vb**(-(vai - 1.d0)))
2481 implicit double precision (a-h, o-z)
2483 double precision nn, k, inex
2484 common /leafin/ nn, vai, k
2485 common /nagout/ inex
2488 if (k .gt. 4.d0)
goto 10
2490 x = 0.5d0 * k - 1.d0
2491 y = (((((((((((((((-3.60311230482612224d-13
2492 & *x + 3.46348526554087424d-12)*x - 2.99627399604128973d-11)
2493 & *x + 2.57747807106988589d-10)*x - 2.09330568435488303d-9)
2494 & *x + 1.59501329936987818d-8)*x - 1.13717900285428895d-7)
2495 & *x + 7.55292885309152956d-7)*x - 4.64980751480619431d-6)
2496 & *x + 2.63830365675408129d-5)*x - 1.37089870978830576d-4)
2497 & *x + 6.47686503728103400d-4)*x - 2.76060141343627983d-3)
2498 & *x + 1.05306034687449505d-2)*x - 3.57191348753631956d-2)
2499 & *x + 1.07774527938978692d-1)*x - 2.96997075145080963d-1
2500 y = (y*x + 8.64664716763387311d-1)*x + 7.42047691268006429d-1
2504 10
if (k .ge. 85.d0)
go to 20
2505 x = 14.5d0 / (k + 3.25d0) - 1.d0
2506 y = (((((((((((((((-1.62806570868460749d-12
2507 & *x - 8.95400579318284288d-13)*x - 4.08352702838151578d-12)
2508 & *x - 1.45132988248537498d-11)*x - 8.35086918940757852d-11)
2509 & *x - 2.13638678953766289d-10)*x - 1.10302431467069770d-9)
2510 & *x - 3.67128915633455484d-9)*x - 1.66980544304104726d-8)
2511 & *x - 6.11774386401295125d-8)*x - 2.70306163610271497d-7)
2512 & *x - 1.05565006992891261d-6)*x - 4.72090467203711484d-6)
2513 & *x - 1.95076375089955937d-5)*x - 9.16450482931221453d-5)
2514 & *x - 4.05892130452128677d-4)*x - 2.14213055000334718d-3
2515 y = ((y*x - 1.06374875116569657d-2)*x -
2516 & 8.50699154984571871d-2)*x +
2517 & 9.23755307807784058d-1
2518 inex = exp(-k) * y / k
2541 implicit double precision (a-h, o-z)
2544 common /tauin/ teta, ref
2547 data dr/1.745329251994330d-2/, eps/.1d-6/,
2548 & pi12/1.570796326794895d0/
2555 a = (ref + 1.d0)**2/2.d0
2556 k = -(r2 - 1.d0)**2/4.d0
2559 if (
abs(teta) .le. eps)
then
2560 tau = 4.d0*ref/(ref + 1.d0)**2
2563 if (
abs(teta - pi12) .le. eps)
then
2566 xxx = (ds**2 - rp/2.d0)**2 + k
2570 b2 = ds**2 - rp/2.d0
2572 ts = (k**2/(6.d0*b**3) + k/b - b/2.d0) -
2573 & (k**2/(6.d0*a**3) + k/a - a/2.d0)
2574 tp1 = -2.d0*r2*(b - a)/rp**2
2575 tp2 = -2.d0*r2*rp*log(b/a)/rm**2
2576 tp3 = r2*(1.d0/b - 1.d0/a)/2.d0
2577 tp4 = 16.d0*r2**2*(r2**2 + 1.d0)*dlog((2.d0*rp*b - rm**2)/
2578 & (2.d0*rp*a - rm**2))/(rp**3*rm**2)
2579 tp5 = 16.d0*r2**3*(1.d0/(2.d0*rp*b - rm**2) - 1.d0/
2580 & (2.d0*rp*a - rm**2))/rp**3
2581 tp = tp1 + tp2 + tp3 + tp4 + tp5
2582 tau = (ts + tp)/(2.d0*ds**2)
2606 implicit double precision (a-h, o-z)
2608 double precision ke, kab, kw
2609 dimension ref(200), ke(200), kab(200), kw(200)
2610 common /dat/ ref, ke, kab, kw
2612 dimension phis1(200), phis2(200), phis3(200), phis4(200)
2613 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
2614 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
2616 data (ref(i), i = 1, 100)/
2617 & 1.5123,1.5094,1.5070,1.5050,1.5032,1.5019,1.5007,1.4997,1.4988,
2619 & 1.4959,1.4951,1.4943,1.4937,1.4930,1.4925,1.4920,1.4915,1.4910,
2620 & 1.4904,1.4899,1.4893,1.4887,1.4880,1.4873,1.4865,1.4856,1.4846,
2621 & 1.4836,1.4825,1.4813,1.4801,1.4788,1.4774,1.4761,1.4746,1.4732,
2622 & 1.4717,1.4701,1.4685,1.4670,1.4654,1.4639,1.4624,1.4609,1.4595,
2623 & 1.4582,1.4570,1.4559,1.4548,1.4538,1.4528,1.4519,1.4510,1.4502,
2624 & 1.4495,1.4489,1.4484,1.4480,1.4477,1.4474,1.4472,1.4470,1.4468,
2625 & 1.4467,1.4465,1.4463,1.4461,1.4458,1.4456,1.4453,1.4450,1.4447,
2626 & 1.4444,1.4440,1.4435,1.4430,1.4423,1.4417,1.4409,1.4402,1.4394,
2627 & 1.4387,1.4380,1.4374,1.4368,1.4363,1.4357,1.4352,1.4348,1.4345,
2628 & 1.4342,1.4341,1.4340,1.4340,1.4341,1.4342,1.4343,1.4345/
2630 data (ref(i), i = 101, 200)/
2631 & 1.4347,1.4348,1.4347,1.4345,1.4341,1.4336,1.4331,1.4324,1.4317,
2632 & 1.4308,1.4297,1.4284,1.4269,1.4253,1.4235,1.4216,1.4196,1.4176,
2633 & 1.4156,1.4137,1.4118,1.4100,1.4082,1.4065,1.4047,1.4029,1.4011,
2634 & 1.3993,1.3975,1.3958,1.3940,1.3923,1.3906,1.3888,1.3870,1.3851,
2635 & 1.3830,1.3808,1.3784,1.3758,1.3731,1.3703,1.3676,1.3648,1.3620,
2636 & 1.3592,1.3565,1.3537,1.3510,1.3484,1.3458,1.3433,1.3410,1.3388,
2637 & 1.3368,1.3350,1.3333,1.3317,1.3303,1.3289,1.3275,1.3263,1.3251,
2638 & 1.3239,1.3228,1.3217,1.3205,1.3194,1.3182,1.3169,1.3155,1.3140,
2639 & 1.3123,1.3105,1.3086,1.3066,1.3046,1.3026,1.3005,1.2985,1.2964,
2640 & 1.2944,1.2923,1.2902,1.2882,1.2863,1.2844,1.2826,1.2808,1.2793,
2641 & 1.2781,1.2765,1.2750,1.2738,1.2728,1.2719,1.2712,1.2708,1.2712,
2644 data (ke(i), i = 1, 100)/
2645 &.1104,.0893,.0714,.0567,.0442,.0348,.0279,.0232,.0197,.0173,.0154,
2646 &.0142,.0120,.0108,.0093,.0092,.0092,.0092,.0092,.0092,.0091,.0091,
2647 &.0091,.0091,.0091,.0090,.0090,.0090,.0090,.0090,.0089,.0089,.0089,
2648 &.0089,.0088,.0088,.0088,.0088,.0088,.0087,.0087,.0087,.0087,.0087,
2649 &.0086,.0086,.0086,.0086,.0086,.0085,.0085,.0085,.0085,.0085,.0084,
2650 &.0084,.0084,.0084,.0084,.0083,.0083,.0083,.0082,.0082,.0082,.0082,
2651 &.0082,.0081,.0081,.0081,.0081,.0081,.0080,.0080,.0080,.0080,.0080,
2652 &.0079,.0079,.0079,.0079,.0079,.0078,.0078,.0078,.0078,.0078,.0077,
2653 &.0077,.0077,.0077,.0077,.0076,.0076,.0076,.0076,.0076,.0075,.0075,
2656 data (ke(i), i = 101, 200)/
2657 &.0074,.0073,.0072,.0071,.0070,.0069,.0068,.0068,.0067,.0066,.0065,
2658 &.0064,.0063,.0062,.0062,.0061,.0060,.0059,.0058,.0057,.0056,.0056,
2659 &.0054,.0053,.0053,.0052,.0051,.0050,.0049,.0048,.0047,.0047,.0046,
2660 &.0045,.0044,.0043,.0042,.0041,.0040,.0039,.0039,.0037,.0037,.0036,
2661 &.0035,.0034,.0033,.0032,.0031,.0031,.0030,.0029,.0028,.0027,.0026,
2662 &.0025,.0025,.0024,.0023,.0022,.0021,.0020,.0019,.0019,.0018,.0017,
2663 &.0016,.0015,.0014,.0014,.0013,.0012,.0010,.0010,.0009,.0008,.0007,
2664 &.0006,.0006,.0005,.0004,.0003,.0002,.0002,.0001,15*.0000/
2667 & .04664,.04684,.04568,.04482,.04344,.04257,.04287,.04189,.04116,
2669 & .03213,.03096,.03116,.03051,.03061,.02998,.02965,.02913,.02902,
2670 & .02769,.02707,.02539,.02409,.02150,.01807,.01566,.01317,.01095,
2671 & .00929,.00849,.00803,.00788,.00757,.00734,.00713,.00692,.00693,
2672 & .00716,.00758,.00815,.00877,.00938,.00976,.01041,.01089,.01105,
2673 & .01127,.01170,.01222,.01280,.01374,.01441,.01462,.01495,.01499,
2674 & .01506,.01580,.01686,.01810,.01961,.02112,.02336,.02702,.02880,
2675 & .02992,.03142,.03171,.02961,.02621,.02078,.01518,.01020,.00718,
2676 & .00519,.00390,.00298,.00218,.00163,.00116,.00083,.00057,.00039,
2677 & .00027,.00014,.00011,.00009,.00005,112*.00000/
2680 & 111*0.,00.100,00.200,00.278,00.206,00.253,00.260,00.313,00.285,
2681 & 00.653,00.614,00.769,00.901,00.872,00.812,00.733,00.724,00.855,
2682 & 00.900,01.028,01.500,02.026,02.334,03.636,08.942,14.880,17.838,
2683 & 19.497,19.419,17.999,12.024,10.709,08.384,07.081,06.155,05.619,
2684 & 05.112,04.512,04.313,04.064,03.804,03.709,03.877,04.348,04.574,
2685 & 05.029,05.804,06.345,05.823,05.886,06.315,08.432,15.588,32.247,
2686 & 51.050,58.694,55.135,50.454,42.433,40.670,36.030,29.771,25.153,
2687 & 24.378,22.008,20.608,18.576,17.257,15.921,14.864,12.861,12.773,
2688 & 12.426,13.090,14.013,15.066,15.857,16.776,19.113,21.066,22.125,
2689 & 26.438,28.391,28.920,31.754,36.375,40.056,41.019,45.471,43.126/
2691 data (phis1(i), i = 1, 100)/
2692 & .088, .095, .102, .109, .116, .123, .130, .136, .143, .150,
2693 & .157, .164, .171, .178, .185, .192, .199, .206, .213, .220,
2694 & .227, .233, .240, .247, .254, .261, .268, .275, .282, .289,
2695 & .295, .302, .309, .316, .326, .335, .345, .356, .366, .376,
2696 & .386, .395, .404, .412, .421, .429, .436, .443, .450, .457,
2697 & .464, .470, .476, .483, .489, .495, .502, .508, .514, .520,
2698 & .526, .532, .538, .543, .549, .555, .561, .568, .574, .580,
2699 & .587, .594, .601, .608, .615, .622, .629, .637, .644, .652,
2700 & .659, .667, .674, .681, .689, .696, .702, .709, .716, .723,
2701 & .729, .735, .742, .748, .754, .760, .766, .771, .777, .782/
2703 data (phis1(i), i = 101, 200)/
2704 & .802, .819, .832, .842, .854, .868, .883, .899, .917, .935,
2705 & .954, .974, .993,1.012,1.030,1.047,1.063,1.078,1.091,1.102,
2706 & 1.111,1.118,1.126,1.137,1.150,1.163,1.176,1.187,1.192,1.188,
2707 & 1.177,1.159,1.134,1.090, .979, .830, .764, .744, .748, .777,
2708 & .823, .878, .932, .983,1.026,1.062,1.091,1.115,1.133,1.147,
2709 & 1.156,1.161,1.162,1.158,1.149,1.132,1.109,1.087,1.072,1.056,
2710 & 1.035, .989, .886, .659, .456, .350, .323, .335, .361, .396,
2711 & .438, .484, .530, .576, .622, .664, .705, .740, .768, .788,
2712 & .800, .802, .796, .794, .797, .789, .779, .756, .725, .715,
2713 & .675, .635, .585, .535, .485, .435, .385, .335, .285, .235/
2715 data (phis2(i), i = 1, 100)/
2716 & .249, .245, .241, .237, .232, .228, .222, .217, .211, .205,
2717 & .199, .193, .186, .179, .171, .163, .155, .147, .139, .130,
2718 & .121, .111, .102, .092, .081, .071, .060, .049, .038, .026,
2719 & .014, .002,-.011,-.024,-.037,-.050,-.064,-.078,-.092,-.107,
2720 & -.121,-.137,-.152,-.168,-.184,-.200,-.216,-.232,-.246,-.259,
2721 & -.270,-.280,-.289,-.297,-.303,-.308,-.313,-.317,-.322,-.325,
2722 & -.329,-.332,-.335,-.338,-.340,-.342,-.345,-.347,-.350,-.352,
2723 & -.355,-.358,-.360,-.363,-.366,-.369,-.372,-.374,-.377,-.378,
2724 & -.380,-.381,-.382,-.382,-.383,-.382,-.382,-.381,-.380,-.378,
2725 & -.376,-.373,-.370,-.367,-.363,-.359,-.354,-.349,-.344,-.338/
2727 data (phis2(i), i = 101, 200)/
2728 & -.310,-.283,-.258,-.234,-.212,-.190,-.167,-.143,-.118,-.092,
2729 & -.066,-.039,-.014, .011, .034, .057, .083, .114, .151, .192,
2730 & .233, .272, .311, .348, .380, .407, .438, .476, .521, .570,
2731 & .624, .674, .708, .766, .824, .853, .854, .852, .858, .881,
2732 & .916, .947, .973, .997,1.017,1.036,1.052,1.067,1.082,1.095,
2733 & 1.107,1.119,1.131,1.142,1.154,1.166,1.175,1.179,1.178,1.172,
2734 & 1.162,1.148,1.083, .900, .678, .538, .499, .515, .552, .598,
2735 & .653, .716, .777, .834, .886, .932, .973,1.007,1.036,1.058,
2736 & 1.075,1.086,1.091,1.091,1.086,1.076,1.060,1.039,1.012, .980,
2737 & .943, .900, .852, .799, .740, .676, .606, .532, .451, .366/
2739 data (phis3(i), i = 1, 100)/
2740 & -.417,-.384,-.351,-.318,-.285,-.253,-.221,-.189,-.157,-.126,
2741 & -.095,-.064,-.033,-.003, .027, .057, .087, .117, .146, .175,
2742 & .204, .232, .260, .289, .316, .344, .371, .399, .425, .452,
2743 & .478, .505, .525, .545, .566, .587, .606, .626, .652, .676,
2744 & .699, .722, .744, .764, .784, .804, .822, .839, .856, .872,
2745 & .886, .900, .913, .926, .937, .948, .957, .966, .974, .981,
2746 & .988, .993, .998,1.002,1.006,1.009,1.012,1.014,1.016,1.017,
2747 & 1.018,1.018,1.018,1.017,1.016,1.014,1.012,1.010,1.007,1.003,
2748 & .999, .995, .990, .984, .978, .972, .965, .957, .949, .941,
2749 & .932, .923, .913, .902, .891, .880, .868, .855, .842, .829/
2751 data (phis3(i), i = 101, 200)/
2752 & .766, .694, .620, .550, .484, .421, .361, .303, .247, .190,
2753 & .134, .079, .023,-.031,-.086,-.140,-.190,-.235,-.275,-.310,
2754 & -.340,-.367,-.394,-.422,-.452,-.484,-.513,-.541,-.565,-.578,
2755 & -.575,-.556,-.525,-.468,-.323,-.115,-.018, .002,-.003,-.029,
2756 & -.076,-.142,-.211,-.274,-.333,-.386,-.432,-.471,-.503,-.528,
2757 & -.544,-.551,-.549,-.538,-.517,-.491,-.463,-.436,-.419,-.417,
2758 & -.401,-.348,-.216, .014, .160, .203, .209, .210, .207, .200,
2759 & .189, .174, .155, .132, .105, .075, .043, .013,-.012,-.035,
2760 & -.053,-.068,-.078,-.082,-.080,-.073,-.060,-.041,-.017, .006,
2761 & .035, .065, .097, .125, .168, .180, .168, .125, .097, .065/
2763 data (phis4(i), i = 1, 100)/
2764 & .067, .077, .086, .094, .102, .111, .118, .126, .133, .140,
2765 & .146, .152, .158, .164, .169, .174, .179, .184, .188, .192,
2766 & .195, .198, .201, .204, .206, .208, .210, .212, .213, .214,
2767 & .214, .214, .214, .214, .213, .212, .211, .210, .210, .209,
2768 & .207, .205, .202, .198, .194, .189, .184, .179, .173, .167,
2769 & .161, .155, .149, .143, .136, .130, .123, .116, .108, .101,
2770 & .093, .085, .077, .068, .060, .051, .043, .034, .026, .018,
2771 & .010, .002,-.006,-.014,-.022,-.030,-.037,-.045,-.052,-.060,
2772 & -.067,-.074,-.081,-.087,-.093,-.098,-.103,-.108,-.112,-.116,
2773 & -.120,-.123,-.126,-.129,-.132,-.134,-.136,-.138,-.140,-.141/
2775 data (phis4(i), i = 101, 200)/
2776 & -.147,-.152,-.158,-.166,-.170,-.165,-.157,-.151,-.144,-.128,
2777 & -.104,-.078,-.049,-.009, .038, .082, .122, .169, .222, .272,
2778 & .317, .364, .413, .469, .532, .591, .642, .694, .748, .790,
2779 & .810, .817, .819, .740, .494, .215, .110, .125, .155, .204,
2780 & .291, .408, .521, .627, .724, .811, .884, .940, .987,1.025,
2781 & 1.053,1.071,1.077,1.072,1.046, .996, .941, .892, .857, .842,
2782 & .809, .713, .509, .055,-.236,-.324,-.336,-.320,-.308,-.294,
2783 & -.275,-.248,-.205,-.144,-.094,-.048, .005, .058, .105, .132,
2784 & .123, .079, .045, .024, .014, .018, .022,-.010,-.042,-.054,
2785 & -.055,-.060,-.060,-.055,-.050,-.046,-.042,-.038,-.034,-.030/
2791 subroutine dakg(u, a, nq)
2793 implicit double precision (a-h, o-z)
2794 dimension u(48), a(48)
2798 goto (1, 2, 1, 4, 1, 6, 1, 8, 1, 10, 1, 12, 1, 14, 1, 16, 1,
2799 & 1, 1, 20, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
2800 & 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 48), nq
2802 print *,
' *** dakg - inacceptable nq'
2806 u(2) = .577350269189626d0
2811 u(3) = .339981043584856d0
2812 u(4) = .861136311594053d0
2813 a(3) = .652145154862546d0
2814 a(4) = .347854845137454d0
2818 u(4) = .238619186083197d0
2819 u(5) = .661209386466265d0
2820 u(6) = .932469514203152d0
2821 a(4) = .467913934572691d0
2822 a(5) = .360761573048139d0
2823 a(6) = .171324492379170d0
2827 u(5) = .183434642495650d0
2828 u(6) = .525532409916329d0
2829 u(7) = .796666477413627d0
2830 u(8) = .960289856497536d0
2831 a(5) = .362683783378362d0
2832 a(6) = .313706645877887d0
2833 a(7) = .222381034453374d0
2834 a(8) = .101228536290376d0
2838 u(6) = .148874338981631d0
2839 u(7) = .433395394129247d0
2840 u(8) = .679409568299024d0
2841 u(9) = .865063366688985d0
2842 u(10) = .973906528517172d0
2843 a(6) = .295524224714753d0
2844 a(7) = .269266719309996d0
2845 a(8) = .219086362515982d0
2846 a(9) = .149451349150580d0
2847 a(10) = .666713443086881d-1
2851 u(7) = .125233408511469d0
2852 u(8) = .367831498998180d0
2853 u(9) = .587317954286617d0
2854 u(10) = .769902674194305d0
2855 u(11) = .904117256370475d0
2856 u(12) = .981560634246719d0
2857 a(7) = .249147045813402d0
2858 a(8) = .233492536538355d0
2859 a(9) = .203167426723066d0
2860 a(10) = .160078328543346d0
2861 a(11) = .106939325995318d0
2862 a(12) = .471753363865118d-1
2866 u( 8) = .108054948707344d0
2867 u( 9) = .319112368927890d0
2868 u(10) = .515248636358154d0
2869 u(11) = .687292904811685d0
2870 u(12) = .827201315069765d0
2871 u(13) = .928434883663574d0
2872 u(14) = .986283808696812d0
2873 a( 8) = .215263853463158d0
2874 a( 9) = .205198463721296d0
2875 a(10) = .185538397477938d0
2876 a(11) = .157203167158194d0
2877 a(12) = .121518570687903d0
2878 a(13) = .801580871597602d-1
2879 a(14) = .351194603317519d-1
2883 u( 9) = .950125098376374d-1
2884 u(10) = .281603550779259d0
2885 u(11) = .458016777657227d0
2886 u(12) = .617876244402643d0
2887 u(13) = .755404408355003d0
2888 u(14) = .865631202387832d0
2889 u(15) = .944575023073233d0
2890 u(16) = .989400934991650d0
2891 a( 9) = .189450610455068d0
2892 a(10) = .182603415044924d0
2893 a(11) = .169156519395003d0
2894 a(12) = .149595988816577d0
2895 a(13) = .124628971255534d0
2896 a(14) = .951585116824928d-1
2897 a(15) = .622535239386479d-1
2898 a(16) = .271524594117541d-1
2902 u(11) = .765265211334973d-1
2903 u(12) = .227785851141645d0
2904 u(13) = .373706088715420d0
2905 u(14) = .510867001950827d0
2906 u(15) = .636053680726515d0
2907 u(16) = .746331906460151d0
2908 u(17) = .839116971822219d0
2909 u(18) = .912234428251326d0
2910 u(19) = .963971927277914d0
2911 u(20) = .993128599185095d0
2912 a(11) = .152753387130726d0
2913 a(12) = .149172986472604d0
2914 a(13) = .142096109318382d0
2915 a(14) = .131688638449177d0
2916 a(15) = .118194531961518d0
2917 a(16) = .101930119817240d0
2918 a(17) = .832767415767047d-1
2919 a(18) = .626720483341091d-1
2920 a(19) = .406014298003869d-1
2921 a(20) = .176140071391521d-1
2925 u(25) = .323801709628694d-1
2926 u(26) = .970046992094627d-1
2927 u(27) = .161222356068892d0
2928 u(28) = .224763790394689d0
2929 u(29) = .287362487355456d0
2930 u(30) = .348755886292161d0
2931 u(31) = .408686481990717d0
2932 u(32) = .466902904750958d0
2933 u(33) = .523160974722233d0
2934 u(34) = .577224726083973d0
2935 u(35) = .628867396776514d0
2936 u(36) = .677872379632664d0
2937 u(37) = .724034130923815d0
2938 u(38) = .767159032515740d0
2939 u(39) = .807066204029443d0
2940 u(40) = .843588261624394d0
2941 u(41) = .876572020274247d0
2942 u(42) = .905879136715570d0
2943 u(43) = .931386690706554d0
2944 u(44) = .952987703160431d0
2945 u(45) = .970591592546247d0
2946 u(46) = .984124583722827d0
2947 u(47) = .993530172266351d0
2948 u(48) = .998771007252426d0
2949 a(25) = .647376968126839d-1
2950 a(26) = .644661644359501d-1
2951 a(27) = .639242385846482d-1
2952 a(28) = .631141922862540d-1
2953 a(29) = .620394231598927d-1
2954 a(30) = .607044391658939d-1
2955 a(31) = .591148396983956d-1
2956 a(32) = .572772921004032d-1
2957 a(33) = .551995036999842d-1
2958 a(34) = .528901894851937d-1
2959 a(35) = .503590355538545d-1
2960 a(36) = .476166584924905d-1
2961 a(37) = .446745608566943d-1
2962 a(38) = .415450829434647d-1
2963 a(39) = .382413510658307d-1
2964 a(40) = .347772225647704d-1
2965 a(41) = .311672278327981d-1
2966 a(42) = .274265097083569d-1
2967 a(43) = .235707608393244d-1
2968 a(44) = .196161604573555d-1
2969 a(45) = .155793157229438d-1
2970 a(46) = .114772345792345d-1
2971 a(47) = .732755390127626d-2
2972 a(48) = .315334605230584d-2
2993 subroutine akbrdf(eei, thmi, uli, sli, rsl1i, wlmoy, rnci,
2994 & cabi, cwi, vaii, mu, np, rm, rp, brdfint)
2997 implicit double precision (a-h, o-z)
3000 real eei, thmi, uli, sli, rsl1i, wlmoy, rnci, cabi, cwi,
3003 real rm(-mu:mu), rp(np), brdfint(-mu:mu, np)
3004 save /count/, /soildata/, /aaa/, /ggg/, /ladak/
3006 dimension u1(10), u2(10), a1(10), a2(10)
3007 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
3009 double precision nnl, kk, integr
3010 common /leafin/ nnl, vai, kk
3011 common /leafout/ refl, tran
3013 double precision ke, kab, kw
3014 dimension refr(200), ke(200), kab(200), kw(200)
3015 common /dat/ refr, ke, kab, kw
3017 dimension phis1(200), phis2(200), phis3(200), phis4(200)
3018 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
3019 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
3021 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
3022 common /ggg/gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
3023 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
3024 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
3025 & alph, salph, alpp, difmy, difsig
3026 common /cfresn/ rn, rk
3027 common /ladak/ ee, thm, sthm, cthm
3028 common /msrmdata/ th10, rncoef, cab, cw, bq
3031 data pi/3.141592653589793d0/, pir/3.14159265/
3032 data pi12/1.570796326794895d0/, dr/1.745329251994330d-2/
3033 data eps/.1d-5/, eps4/.1d-3/
3038 integr(xx) = (1.d0 - exp(-xx))/xx
3050 rsl2 = -.48d0*rsl1 + .0862d0
3053 rlambda = wlmoy*1000.d0
3055 if ((rlambda .gt. 2500.d0) .or. (rlambda .lt. 404.d0))
then
3056 print *,
'AKBRDF: wavelength out of range'
3060 if (rlambda .le. 800.d0)
then
3061 jl = nint((rlambda - 400.d0)/4.d0)
3063 jl = nint((rlambda - 800.d0)/17.d0) + 100
3071 kk = ke(jl) + cab*kab(jl) + cw*kw(jl)
3075 rrl = refl - ((1.d0 - rn)/(1.d0 + rn))**2
3085 if (
abs(th22) .lt. eps4) th22 = 0.d0
3086 eln = -log(1.d0 - ee)
3087 difmy =
abs(.059d0*eln*(thm - 1.02d0) + .02d0)
3088 difsig =
abs(.01771d0 - .0216d0*eln*(thm - .256d0))
3103 fi = rp(k) + rm(-mu)
3106 if (fi .lt. 0.) fi = fi + 2.*pir
3107 if (fi .gt. (2.*pir)) fi = fi - 2.*pir
3108 if (fi .gt. pir) fi = 2.*pir - fi
3112 if (xx .lt. eps)
then
3115 clmp1 = 1.d0 - (1.d0 - clz)*integr(xx)
3124 if (xx .lt. eps)
then
3127 clmp = 1.d0 - (1.d0 - clz)*integr(xx)
3150 implicit double precision (a-h, o-z)
3154 save /count/, /soildata/, /aaa/, /ggg/, /ladak/
3156 dimension uu(20), aa(20)
3158 dimension u1(10), u2(10), a1(10), a2(10)
3159 common /count/ jl, jj, lg, jg, lf, nnx, n1, n2, u1, u2, a1, a2
3161 dimension phis1(200), phis2(200), phis3(200), phis4(200)
3162 common /soildata/ phis1, phis2, phis3, phis4, rsl1, rsl2,
3163 & rsl3, rsl4, th2, rsl, rsoil, rr1soil, rrsoil
3165 common /aaa/ rrl, ttl, ul, sl, clmp, clmp1, bi, bd, bqint
3166 common /ggg/gr, gt, g, g1, th, sth, cth, th1, sth1, cth1,
3167 & phi, sp, cp, th22, st, ct, st1, ct1, t10, t11, e1, e2,
3168 & s2, s3, ctg, ctg1, ctt1, stt1, calph, alp2, salp2, calp2,
3169 & alph, salph, alpp, difmy, difsig
3170 common /ladak/ ee, thm, sthm, cthm
3172 data pi/3.141592653589793d0/, pi1/1.5707963268d0/
3181 call dakg(uu, aa, n)
3190 call dakg(uu, aa, n)
3199 th = (1.d0 - u2(i2))*pi1
3205 bdd = bdd + a2(i2)*bqint*sth*cth
3215 subroutine atmref (iaer,tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
3217 s phirad,nt,mu,np,rm,gb,rp,
3218 a rorayl,roaero,romix,xlm1,xlm2)
3220 real rm(-mu:mu),rp(np),gb(-mu:mu),xlm1(-mu:mu,np)
3221 real xlm2(-mu:mu,np)
3222 real tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt
3223 real phi,xmus,xmuv,phirad
3224 real rorayl,roaero,romix,delta,sigma,tamol,tamolp
3226 common /sixs_del/ delta,sigma
3232 if(palt.lt.900..and.palt.gt.0.0)
then
3238 call os(tamol,trmoy,pizmoy,tamolp,trmoyp,palt,
3239 s phirad,nt,mu,np,rm,gb,rp,
3241 rorayl=xlm1(-mu,1)/xmus
3243 if (palt.le.0.0)
then
3246 call chand(phi,xmuv,xmus,trmoy,rorayl)
3257 if(palt.gt.0.0)
then
3263 call os(tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
3264 s phirad,nt,mu,np,rm,gb,rp,
3266 romix=(xlm2(-mu,1)/xmus)
3269 call os(tamoy,tamol,pizmoy,tamoyp,tamolp,palt,
3270 s phirad,nt,mu,np,rm,gb,rp,
3272 roaero=(xlm2(-mu,1)/xmus)
3281 common/sixs_aerbas/ph(10,83)
3287 data ((phr(i,j),j=1,83),i=1,1)/
3288 &0.2150,0.2122,0.2027,0.1928,0.1884,0.1905,0.1952,0.1983,
3289 &0.1980,0.1954,0.1918,0.1874,0.1819,0.1752,0.1680,0.1612,
3290 &0.1553,0.1501,0.1457,0.1417,0.1382,0.1351,0.1326,0.1308,
3291 &0.1296,0.1292,0.1293,0.1299,0.1310,0.1328,0.1353,0.1387,
3292 &0.1429,0.1480,0.1539,0.1606,0.1682,0.1770,0.1870,0.1984,
3293 &0.2115,0.2186,0.2263,0.2432,0.2622,0.2838,0.3082,0.3358,
3294 &0.3671,0.4024,0.4423,0.4875,0.5386,0.5968,0.6630,0.7387,
3295 &0.8253,0.9247,1.0387,1.1695,1.3192,1.4909,1.6883,1.9162,
3296 &2.1797,2.4841,2.8350,3.2382,3.7008,4.2315,4.8393,5.5328,
3297 &6.3184,7.2028,8.1966,9.3190,10.591,12.016,13.541,15.036,
3298 &16.295,17.092,17.290/
3299 data ((phr(i,j),j=1,83),i=2,2)/
3300 &0.2180,0.2160,0.2091,0.2007,0.1951,0.1943,0.1972,0.2005,
3301 &0.2013,0.1986,0.1934,0.1874,0.1819,0.1771,0.1724,0.1673,
3302 &0.1619,0.1565,0.1518,0.1480,0.1449,0.1426,0.1408,0.1395,
3303 &0.1387,0.1383,0.1385,0.1392,0.1406,0.1427,0.1456,0.1492,
3304 &0.1535,0.1585,0.1644,0.1713,0.1793,0.1887,0.1995,0.2119,
3305 &0.2261,0.2339,0.2421,0.2601,0.2803,0.3029,0.3284,0.3571,
3306 &0.3896,0.4266,0.4687,0.5166,0.5710,0.6328,0.7029,0.7826,
3307 &0.8733,0.9769,1.0955,1.2314,1.3869,1.5649,1.7685,2.0010,
3308 &2.2665,2.5691,2.9134,3.3049,3.7496,4.2547,4.8268,5.4728,
3309 &6.1989,7.0122,7.9194,8.9236,10.016,11.166,12.309,13.350,
3310 &14.175,14.677,14.799/
3311 data ((phr(i,j),j=1,83),i=3,3)/
3312 &0.2171,0.2154,0.2091,0.2012,0.1955,0.1939,0.1960,0.1992,
3313 &0.2006,0.1987,0.1940,0.1879,0.1820,0.1770,0.1727,0.1684,
3314 &0.1638,0.1590,0.1544,0.1504,0.1473,0.1450,0.1433,0.1422,
3315 &0.1416,0.1414,0.1418,0.1426,0.1439,0.1459,0.1486,0.1522,
3316 &0.1566,0.1619,0.1681,0.1752,0.1835,0.1930,0.2039,0.2163,
3317 &0.2305,0.2383,0.2466,0.2650,0.2857,0.3090,0.3352,0.3647,
3318 &0.3981,0.4358,0.4785,0.5269,0.5816,0.6437,0.7143,0.7949,
3319 &0.8870,0.9923,1.1126,1.2501,1.4072,1.5866,1.7913,2.0244,
3320 &2.2894,2.5902,2.9315,3.3191,3.7594,4.2591,4.8242,5.4598,
3321 &6.1705,6.9612,7.8359,8.7939,9.8227,10.889,11.934,12.873,
3322 &13.609,14.053,14.161/
3323 data ((phr(i,j),j=1,83),i=4,4)/
3324 &0.2183,0.2168,0.2113,0.2040,0.1981,0.1956,0.1966,0.1992,
3325 &0.2011,0.2003,0.1965,0.1907,0.1843,0.1786,0.1740,0.1701,
3326 &0.1664,0.1624,0.1583,0.1543,0.1510,0.1484,0.1466,0.1454,
3327 &0.1448,0.1447,0.1451,0.1461,0.1476,0.1497,0.1525,0.1560,
3328 &0.1605,0.1660,0.1725,0.1800,0.1886,0.1984,0.2095,0.2221,
3329 &0.2364,0.2442,0.2526,0.2710,0.2920,0.3158,0.3429,0.3735,
3330 &0.4081,0.4469,0.4906,0.5399,0.5957,0.6591,0.7311,0.8132,
3331 &0.9068,1.0134,1.1350,1.2737,1.4317,1.6116,1.8158,2.0475,
3332 &2.3101,2.6080,2.9466,3.3317,3.7694,4.2645,4.8209,5.4417,
3333 &6.1298,6.8888,7.7208,8.6227,9.5794,10.558,11.502,12.339,
3334 &12.989,13.377,13.471/
3335 data ((phr(i,j),j=1,83),i=5,5)/
3336 &0.2249,0.2239,0.2197,0.2137,0.2078,0.2036,0.2019,0.2022,
3337 &0.2034,0.2038,0.2022,0.1985,0.1929,0.1865,0.1803,0.1751,
3338 &0.1711,0.1679,0.1651,0.1624,0.1597,0.1571,0.1549,0.1533,
3339 &0.1525,0.1525,0.1532,0.1545,0.1564,0.1589,0.1622,0.1662,
3340 &0.1710,0.1767,0.1832,0.1907,0.1995,0.2097,0.2215,0.2351,
3341 &0.2505,0.2589,0.2679,0.2874,0.3094,0.3341,0.3621,0.3936,
3342 &0.4294,0.4698,0.5157,0.5676,0.6266,0.6934,0.7691,0.8549,
3343 &0.9521,1.0619,1.1858,1.3254,1.4828,1.6604,1.8614,2.0895,
3344 &2.3492,2.6448,2.9802,3.3587,3.7823,4.2529,4.7729,5.3459,
3345 &5.9763,6.6683,7.4225,8.2312,9.0749,9.9191,10.715,11.405,
3346 &11.931,12.241,12.316/
3347 data ((phr(i,j),j=1,83),i=6,6)/
3348 &0.2268,0.2259,0.2225,0.2173,0.2117,0.2070,0.2041,0.2029,
3349 &0.2031,0.2034,0.2029,0.2008,0.1970,0.1919,0.1861,0.1806,
3350 &0.1758,0.1721,0.1693,0.1673,0.1655,0.1638,0.1622,0.1607,
3351 &0.1597,0.1593,0.1597,0.1609,0.1628,0.1654,0.1687,0.1728,
3352 &0.1778,0.1838,0.1908,0.1990,0.2083,0.2189,0.2309,0.2446,
3353 &0.2602,0.2687,0.2779,0.2981,0.3210,0.3470,0.3763,0.4093,
3354 &0.4464,0.4883,0.5354,0.5887,0.6488,0.7166,0.7931,0.8793,
3355 &0.9763,1.0854,1.2083,1.3469,1.5037,1.6817,1.8840,2.1140,
3356 &2.3747,2.6685,2.9974,3.3632,3.7679,4.2147,4.7080,5.2537,
3357 &5.8571,6.5215,7.2440,8.0132,8.8062,9.5882,10.315,10.936,
3358 &11.403,11.678,11.743/
3359 data ((phr(i,j),j=1,83),i=7,7)/
3360 &0.2427,0.2421,0.2399,0.2362,0.2317,0.2269,0.2224,0.2187,
3361 &0.2159,0.2139,0.2124,0.2110,0.2094,0.2072,0.2041,0.2004,
3362 &0.1962,0.1917,0.1875,0.1839,0.1810,0.1790,0.1779,0.1775,
3363 &0.1776,0.1782,0.1792,0.1805,0.1822,0.1846,0.1877,0.1917,
3364 &0.1968,0.2031,0.2106,0.2194,0.2295,0.2412,0.2545,0.2697,
3365 &0.2869,0.2963,0.3063,0.3284,0.3532,0.3812,0.4125,0.4476,
3366 &0.4868,0.5305,0.5793,0.6339,0.6951,0.7639,0.8414,0.9288,
3367 &1.0277,1.1395,1.2655,1.4074,1.5662,1.7433,1.9398,2.1574,
3368 &2.3979,2.6641,2.9597,3.2895,3.6589,4.0736,4.5385,5.0562,
3369 &5.6261,6.2424,6.8937,7.5622,8.2243,8.8516,9.4132,9.8788,
3370 &10.221,10.418,10.465/
3371 data ((phr(i,j),j=1,83),i=8,8)/
3372 &0.3408,0.3406,0.3396,0.3380,0.3356,0.3327,0.3292,0.3253,
3373 &0.3210,0.3165,0.3119,0.3072,0.3026,0.2981,0.2939,0.2898,
3374 &0.2861,0.2827,0.2797,0.2770,0.2747,0.2728,0.2712,0.2701,
3375 &0.2693,0.2690,0.2693,0.2700,0.2715,0.2737,0.2768,0.2808,
3376 &0.2861,0.2926,0.3005,0.3101,0.3214,0.3346,0.3499,0.3675,
3377 &0.3875,0.3984,0.4100,0.4354,0.4636,0.4951,0.5300,0.5686,
3378 &0.6114,0.6588,0.7114,0.7697,0.8346,0.9068,0.9874,1.0773,
3379 &1.1778,1.2898,1.4147,1.5535,1.7072,1.8766,2.0625,2.2649,
3380 &2.4840,2.7191,2.9691,3.2325,3.5070,3.7899,4.0777,4.3667,
3381 &4.6524,4.9302,5.1951,5.4422,5.6667,5.8638,6.0293,6.1597,
3382 &6.2518,6.3038,6.3160/
3383 data ((phr(i,j),j=1,83),i=9,9)/
3384 &0.4735,0.4733,0.4725,0.4711,0.4690,0.4664,0.4632,0.4596,
3385 &0.4554,0.4507,0.4457,0.4404,0.4347,0.4289,0.4229,0.4168,
3386 &0.4106,0.4046,0.3987,0.3930,0.3876,0.3825,0.3779,0.3738,
3387 &0.3704,0.3676,0.3656,0.3646,0.3645,0.3655,0.3677,0.3712,
3388 &0.3762,0.3827,0.3910,0.4011,0.4134,0.4278,0.4447,0.4643,
3389 &0.4868,0.4992,0.5124,0.5414,0.5742,0.6109,0.6519,0.6974,
3390 &0.7479,0.8036,0.8648,0.9317,1.0047,1.0838,1.1694,1.2615,
3391 &1.3601,1.4653,1.5768,1.6946,1.8182,1.9474,2.0814,2.2197,
3392 &2.3614,2.5057,2.6516,2.7980,2.9435,3.0870,3.2271,3.3623,
3393 &3.4914,3.6129,3.7254,3.8277,3.9184,3.9966,4.0611,4.1113,
3394 &4.1465,4.1662,4.1709/
3395 data ((phr(i,j),j=1,83),i=10,10)/
3396 &0.7907,0.7905,0.7895,0.7878,0.7852,0.7820,0.7780,0.7733,
3397 &0.7679,0.7619,0.7553,0.7481,0.7405,0.7324,0.7239,0.7151,
3398 &0.7061,0.6968,0.6875,0.6782,0.6690,0.6599,0.6512,0.6428,
3399 &0.6349,0.6276,0.6211,0.6154,0.6107,0.6071,0.6047,0.6037,
3400 &0.6042,0.6063,0.6102,0.6160,0.6239,0.6339,0.6462,0.6609,
3401 &0.6782,0.6878,0.6981,0.7207,0.7461,0.7743,0.8055,0.8396,
3402 &0.8768,0.9168,0.9599,1.0058,1.0545,1.1060,1.1601,1.2166,
3403 &1.2753,1.3362,1.3988,1.4630,1.5284,1.5948,1.6618,1.7290,
3404 &1.7962,1.8627,1.9284,1.9927,2.0553,2.1156,2.1734,2.2281,
3405 &2.2795,2.3271,2.3705,2.4095,2.4438,2.4729,2.4969,2.5154,
3406 &2.5283,2.5355,2.5372/
3414 common/sixs_aerbas/ph(10,83)
3420 data ((phr(i,j),j=1,83),i=1,1)/
3421 &0.8352,0.8057,0.7377,0.6569,0.5760,0.5032,0.4427,0.3969,
3422 &0.3646,0.3385,0.3125,0.2863,0.2611,0.2380,0.2175,0.1998,
3423 &0.1848,0.1722,0.1619,0.1536,0.1469,0.1416,0.1376,0.1347,
3424 &0.1329,0.1319,0.1319,0.1327,0.1343,0.1366,0.1397,0.1437,
3425 &0.1485,0.1541,0.1607,0.1682,0.1768,0.1865,0.1974,0.2097,
3426 &0.2235,0.2309,0.2388,0.2559,0.2749,0.2960,0.3196,0.3459,
3427 &0.3750,0.4073,0.4432,0.4831,0.5276,0.5774,0.6331,0.6954,
3428 &0.7652,0.8433,0.9308,1.0291,1.1399,1.2648,1.4060,1.5661,
3429 &1.7479,1.9552,2.1925,2.4657,2.7822,3.1529,3.5921,4.1201,
3430 &4.7671,5.5787,6.6249,8.0218,9.9742,12.864,17.461,25.540,
3431 &42.106,87.294,183.39/
3432 data ((phr(i,j),j=1,83),i=2,2)/
3433 &0.8002,0.7733,0.7063,0.6273,0.5489,0.4793,0.4227,0.3810,
3434 &0.3524,0.3297,0.3071,0.2839,0.2611,0.2399,0.2207,0.2039,
3435 &0.1895,0.1773,0.1672,0.1590,0.1523,0.1471,0.1431,0.1401,
3436 &0.1382,0.1373,0.1372,0.1380,0.1396,0.1419,0.1451,0.1490,
3437 &0.1539,0.1596,0.1663,0.1739,0.1826,0.1925,0.2036,0.2161,
3438 &0.2301,0.2377,0.2458,0.2632,0.2826,0.3042,0.3284,0.3553,
3439 &0.3852,0.4184,0.4553,0.4964,0.5424,0.5938,0.6514,0.7159,
3440 &0.7882,0.8693,0.9603,1.0626,1.1779,1.3081,1.4554,1.6225,
3441 &1.8124,2.0287,2.2763,2.5611,2.8904,3.2747,3.7281,4.2698,
3442 &4.9281,5.7448,6.7836,8.1481,10.017,12.714,16.878,23.920,
3443 &37.639,72.434,130.26/
3444 data ((phr(i,j),j=1,83),i=3,3)/
3445 &0.7899,0.7637,0.6974,0.6190,0.5414,0.4728,0.4173,0.3766,
3446 &0.3489,0.3271,0.3054,0.2830,0.2609,0.2402,0.2214,0.2048,
3447 &0.1906,0.1786,0.1685,0.1603,0.1537,0.1485,0.1445,0.1415,
3448 &0.1396,0.1387,0.1386,0.1394,0.1409,0.1433,0.1464,0.1504,
3449 &0.1553,0.1610,0.1677,0.1754,0.1841,0.1940,0.2052,0.2178,
3450 &0.2319,0.2395,0.2476,0.2651,0.2846,0.3064,0.3307,0.3578,
3451 &0.3879,0.4214,0.4585,0.5000,0.5464,0.5982,0.6563,0.7215,
3452 &0.7944,0.8763,0.9682,1.0715,1.1881,1.3197,1.4685,1.6375,
3453 &1.8294,2.0481,2.2983,2.5859,2.9183,3.3060,3.7626,4.3073,
3454 &4.9677,5.7846,6.8200,8.1736,10.017,12.661,16.709,23.484,
3455 &36.489,68.980,119.09/
3456 data ((phr(i,j),j=1,83),i=4,4)/
3457 &0.7770,0.7516,0.6862,0.6087,0.5323,0.4648,0.4106,0.3713,
3458 &0.3447,0.3239,0.3032,0.2817,0.2604,0.2403,0.2220,0.2058,
3459 &0.1918,0.1800,0.1700,0.1619,0.1553,0.1501,0.1461,0.1432,
3460 &0.1413,0.1403,0.1402,0.1410,0.1426,0.1449,0.1481,0.1521,
3461 &0.1570,0.1628,0.1695,0.1772,0.1860,0.1959,0.2072,0.2199,
3462 &0.2340,0.2417,0.2498,0.2675,0.2871,0.3091,0.3336,0.3608,
3463 &0.3912,0.4250,0.4625,0.5044,0.5512,0.6036,0.6623,0.7282,
3464 &0.8019,0.8848,0.9777,1.0823,1.2003,1.3336,1.4844,1.6555,
3465 &1.8498,2.0712,2.3245,2.6155,2.9515,3.3429,3.8033,4.3511,
3466 &5.0134,5.8298,6.8600,8.1995,10.012,12.589,16.495,22.954,
3467 &35.131,65.032,107.60/
3468 data ((phr(i,j),j=1,83),i=5,5)/
3469 &0.7483,0.7247,0.6618,0.5867,0.5127,0.4480,0.3967,0.3601,
3470 &0.3357,0.3169,0.2982,0.2787,0.2590,0.2403,0.2230,0.2076,
3471 &0.1942,0.1827,0.1730,0.1651,0.1586,0.1535,0.1495,0.1466,
3472 &0.1447,0.1437,0.1437,0.1445,0.1460,0.1484,0.1516,0.1557,
3473 &0.1606,0.1664,0.1732,0.1810,0.1899,0.2000,0.2114,0.2242,
3474 &0.2386,0.2464,0.2546,0.2725,0.2925,0.3147,0.3396,0.3674,
3475 &0.3983,0.4327,0.4710,0.5138,0.5616,0.6151,0.6752,0.7425,
3476 &0.8180,0.9029,0.9982,1.1054,1.2264,1.3631,1.5178,1.6933,
3477 &1.8926,2.1196,2.3789,2.6765,3.0196,3.4181,3.8851,4.4383,
3478 &5.1031,5.9162,6.9324,8.2384,9.9800,12.414,16.024,21.8313,
3479 &32.417,57.406,86.131/
3480 data ((phr(i,j),j=1,83),i=6,6)/
3481 &0.7290,0.7065,0.6456,0.5721,0.5001,0.4373,0.3879,0.3528,
3482 &0.3298,0.3122,0.2948,0.2764,0.2579,0.2400,0.2234,0.2085,
3483 &0.1955,0.1843,0.1748,0.1670,0.1606,0.1555,0.1516,0.1488,
3484 &0.1469,0.1459,0.1459,0.1467,0.1483,0.1507,0.1539,0.1579,
3485 &0.1629,0.1688,0.1756,0.1835,0.1924,0.2026,0.2141,0.2270,
3486 &0.2415,0.2494,0.2577,0.2758,0.2959,0.3185,0.3436,0.3717,
3487 &0.4030,0.4378,0.4766,0.5199,0.5684,0.6227,0.6836,0.7519,
3488 &0.8285,0.9146,1.0114,1.1203,1.2432,1.3821,1.5392,1.7174,
3489 &1.9197,2.1501,2.4131,2.7146,3.0617,3.4642,3.9347,4.4902,
3490 &5.1552,5.9644,6.9694,8.2514,9.9446,12.284,15.706,21.119,
3491 &30.763,52.922,75.133/
3492 data ((phr(i,j),j=1,83),i=7,7)/
3493 &0.6834,0.6633,0.6079,0.5390,0.4716,0.4134,0.3682,0.3368,
3494 &0.3165,0.3014,0.2865,0.2708,0.2546,0.2387,0.2237,0.2101,
3495 &0.1980,0.1875,0.1786,0.1711,0.1650,0.1601,0.1564,0.1536,
3496 &0.1518,0.1509,0.1509,0.1517,0.1534,0.1558,0.1591,0.1632,
3497 &0.1683,0.1742,0.1812,0.1892,0.1983,0.2087,0.2204,0.2337,
3498 &0.2485,0.2565,0.2650,0.2835,0.3042,0.3273,0.3531,0.3819,
3499 &0.4140,0.4499,0.4898,0.5345,0.5844,0.6405,0.7033,0.7739,
3500 &0.8531,0.9420,1.0421,1.1547,1.2818,1.4253,1.5877,1.7716,
3501 &1.9804,2.2176,2.4880,2.7971,3.1520,3.5615,4.0374,4.5953,
3502 &5.2568,6.0522,7.0261,8.2465,9.8238,11.947,14.951,19.512,
3503 &27.207,43.691,55.647/
3504 data ((phr(i,j),j=1,83),i=8,8)/
3505 &0.5664,0.5524,0.5105,0.4593,0.4056,0.3604,0.3252,0.3017,
3506 &0.2868,0.2764,0.2666,0.2562,0.2452,0.2340,0.2231,0.2127,
3507 &0.2033,0.1949,0.1876,0.1814,0.1763,0.1721,0.1689,0.1665,
3508 &0.1651,0.1644,0.1647,0.1657,0.1675,0.1702,0.1737,0.1781,
3509 &0.1835,0.1898,0.1972,0.2056,0.2153,0.2264,0.2388,0.2529,
3510 &0.2687,0.2773,0.2864,0.3062,0.3284,0.3531,0.3808,0.4118,
3511 &0.4464,0.4850,0.5281,0.5763,0.6303,0.6908,0.7586,0.8347,
3512 &0.9201,1.0159,1.1236,1.2446,1.3810,1.5344,1.7076,1.9029,
3513 &2.1236,2.3730,2.6551,2.9753,3.3383,3.7523,4.2252,4.7683,
3514 &5.3971,6.1289,6.9937,8.0270,9.2901,10.873,12.948,15.760,
3515 &20.227,26.155,28.327/
3516 data ((phr(i,j),j=1,83),i=9,9)/
3517 &0.5017,0.4916,0.4574,0.4166,0.3755,0.3366,0.3067,0.2874,
3518 &0.2748,0.2660,0.2585,0.2504,0.2418,0.2329,0.2241,0.2156,
3519 &0.2078,0.2007,0.1945,0.1891,0.1846,0.1810,0.1781,0.1761,
3520 &0.1750,0.1746,0.1750,0.1762,0.1782,0.1810,0.1848,0.1894,
3521 &0.1950,0.2016,0.2093,0.2181,0.2283,0.2398,0.2528,0.2676,
3522 &0.2841,0.2931,0.3026,0.3234,0.3466,0.3726,0.4016,0.4341,
3523 &0.4704,0.5108,0.5560,0.6065,0.6630,0.7261,0.7970,0.8761,
3524 &0.9649,1.0644,1.1759,1.3009,1.4415,1.5992,1.7762,1.9755,
3525 &2.1997,2.4512,2.7345,3.0541,3.4136,3.8188,4.2785,4.7998,
3526 &5.3909,6.0685,6.8504,7.7572,8.8313,10.118,11.724,13.933,
3527 &16.806,19.370,20.119/
3528 data ((phr(i,j),j=1,83),i=10,10)/
3529 &0.4481,0.4411,0.4148,0.3788,0.3444,0.3172,0.2972,0.2822,
3530 &0.2711,0.2632,0.2572,0.2514,0.2450,0.2379,0.2310,0.2245,
3531 &0.2183,0.2126,0.2074,0.2030,0.1993,0.1963,0.1939,0.1923,
3532 &0.1915,0.1914,0.1920,0.1934,0.1957,0.1988,0.2027,0.2076,
3533 &0.2135,0.2206,0.2287,0.2381,0.2488,0.2611,0.2750,0.2906,
3534 &0.3082,0.3178,0.3279,0.3501,0.3748,0.4024,0.4332,0.4677,
3535 &0.5062,0.5491,0.5968,0.6500,0.7094,0.7758,0.8499,0.9325,
3536 &1.0245,1.1273,1.2424,1.3710,1.5144,1.6743,1.8527,2.0524,
3537 &2.2759,2.5253,2.8026,3.1112,3.4553,3.8394,4.2681,4.7465,
3538 &5.2801,5.8742,6.5358,7.2843,8.1602,9.2141,10.458,11.804,
3539 &13.032,13.853,14.061/
3546 subroutine chand (xphi,xmuv,xmus,xtau
3558 real as0(10),as1(2),as2(2)
3559 real xphi,xmus,fac,xmuv,xtau,xrray,pi,phios,xcosf1,xcosf2
3560 real xcosf3,xbeta2,xfd,xph1,xph2,xph3,xitm, xp1, xp2, xp3
3561 real cfonc1,cfonc2,cfonc3,xlntau,xitot1,xitot2,xitot3
3563 data (as0(i),i=1,10) /.33243832,-6.777104e-02,.16285370
3564 s ,1.577425e-03,-.30924818,-1.240906e-02,-.10324388
3565 s ,3.241678e-02,.11493334,-3.503695e-02/
3566 data (as1(i),i=1,2) /.19666292, -5.439061e-02/
3567 data (as2(i),i=1,2) /.14545937,-2.910845e-02/
3572 xcosf2=cos(phios*fac)
3573 xcosf3=cos(2*phios*fac)
3577 xfd=(1-xfd)/(1+2*xfd)
3578 xph1=1+(3*xmus*xmus-1)*(3*xmuv*xmuv-1)*xfd/8.
3579 xph2=-xmus*xmuv*sqrt(1-xmus*xmus)*sqrt(1-xmuv*xmuv)
3580 xph2=xph2*xfd*xbeta2*1.5
3581 xph3=(1-xmus*xmus)*(1-xmuv*xmuv)
3582 xph3=xph3*xfd*xbeta2*0.375
3583 xitm=(1-exp(-xtau*(1/xmus+1/xmuv)))*xmus/(4*(xmus+xmuv))
3587 xitm=(1-exp(-xtau/xmus))*(1-exp(-xtau/xmuv))
3598 pl(7)=xmus*xmus+xmuv*xmuv
3600 pl(9)=xmus*xmus*xmuv*xmuv
3604 fs0=fs0+pl(i)*as0(i)
3606 fs1=pl(1)*as1(1)+pl(2)*as1(2)
3607 fs2=pl(1)*as2(1)+pl(2)*as2(2)
3608 xitot1=xp1+cfonc1*fs0*xmus
3609 xitot2=xp2+cfonc2*fs1*xmus
3610 xitot3=xp3+cfonc3*fs2*xmus
3612 xrray=xrray+xitot2*xcosf2*2
3613 xrray=xrray+xitot3*xcosf3*2
3617 subroutine csalbr(xtau,xalb)
3618 real xtau,xalb,fintexp3
3619 xalb=(3*xtau-fintexp3(xtau)*(4+2*xtau)+2*exp(-xtau))
3620 xalb=xalb/(4.+3*xtau)
3623 real function fintexp3(xtau)
3625 xx=(exp(-xtau)*(1.-xtau)+xtau*xtau*
fintexp1(xtau))/2.
3631 real xx,a(0:5),xtau,xftau
3633 data (a(i),i=0,5) /-.57721566,0.99999193,-0.24991055,
3634 c 0.05519968,-0.00976004,0.00107857/
3644 subroutine discom (idatmp,iaer,xmus,xmuv,phi,
3645 a taer55,taer55p,palt,
3646 a phirad,nt,mu,np,rm,gb,rp,
3649 real rm(-mu:mu),rp(np),gb(-mu:mu)
3650 real ftray,xlm1(-mu:mu,np),xlm2(-mu:mu,np)
3652 real taer55,taer55p,palt,phirad,ext,ome,gasym,phase,roatm
3653 real dtdir,dtdif,utdir,utdif,sphal,wldis,trayl,traypl,s
3654 real wlinf,wlsup,phasel,pdgs,cgaus,pha,betal,wl,tray,trayp,taer
3655 real taerp,piza,tamoy,tamoyp,pizmoy,rorayl
3656 real roaero,romix,ddirtt,ddiftt,udirtt,udiftt,sphalbt,ddirtr
3657 real ddiftr,udirtr,udiftr,sphalbr,ddirta,ddifta,udirta,udifta
3659 integer idatmp,iaer,nt,l,k
3660 common /sixs_aer/ext(10),ome(10),gasym(10),phase(10)
3661 common /sixs_disc/ roatm(3,10),dtdir(3,10),dtdif(3,10),
3662 a utdir(3,10),utdif(3,10),sphal(3,10),wldis(10),trayl(10),
3664 common /sixs_ffu/s(1501),wlinf,wlsup
3665 common /sixs_sos/phasel(10,83),cgaus(83),pdgs(83)
3666 common /sixs_trunc/pha(83),betal(0:80)
3674 if ((wlsup.lt.wldis(1)).and.(l.le.2))
goto 30
3675 if (wlinf.gt.wldis(10).and.(l.ge.9))
goto 30
3676 if ((l.lt.10).and.(wldis(l).lt.wlinf).and.
3677 a (wldis(l+1).lt.wlinf))
3679 if ((l.gt.1).and.(wldis(l).gt.wlsup).and.
3680 a (wldis(l-1).gt.wlsup))
3690 if (idatmp.eq.0.or.idatmp.eq.4)
then
3691 if (idatmp.eq.4) trayp=tray
3692 if (idatmp.eq.0) trayp=0.
3701 taer=taer55*ext(l)/ext(4)
3702 taerp=taer55p*ext(l)/ext(4)
3716 tamoy=taer*(1.-piza*coeff)
3717 tamoyp=taerp*(1.-piza*coeff)
3718 pizmoy=piza*(1.-coeff)/(1.-piza*coeff)
3725 call atmref(iaer,tamoy,tray,pizmoy,tamoyp,trayp,palt,
3727 s phirad,nt,mu,np,rm,gb,rp,
3728 a rorayl,roaero,romix,xlm1,xlm2)
3732 call scatra (tamoy,tamoyp,tray,trayp,pizmoy,
3733 a palt,nt,mu,rm,gb,xmus,xmuv,
3734 a ddirtt,ddiftt,udirtt,udiftt,sphalbt,
3735 a ddirtr,ddiftr,udirtr,udiftr,sphalbr,
3736 a ddirta,ddifta,udirta,udifta,sphalba)
3758 subroutine discre(ta,ha,tr,hr,it,nt,yy,dd,ppp2,ppp1,
3760 real ta,ha,tr,hr,yy,dd,ppp2,ppp1,zx,dt,ti,y1,y2,y3,x2
3766 s (
'check aerosol measurements or plane altitude')
3772 dt=2.*(ta+tr-yy)/(nt-it+1.)
3783 x2=ta*dexp(xx)+tr*exp(-y2/hr)
3786 if(xd.lt.0.00001)
go to 705
3787 if(ti-x2) 701,703,703
3793 delta=1./(1.+ta*hr/tr/ha*exp((zx-ppp1)*(1./hr-1./ha)))
3795 if(dd.ne.0) ecart=
abs((dd-delta)/dd)
3796 if((ecart.gt.0.75).and.(it.ne.0))
go to 99
3800 common /sixs_aerbas/ ph(10,83)
3806 DATA ((phr(i,j),j=1,83),i=01,01) /
3807 *0.2021e+00,0.2079e+00,0.2462e+00,0.2310e+00,0.2069e+00,0.1883e+00,
3808 *0.1750e+00,0.1624e+00,0.1458e+00,0.1241e+00,0.1013e+00,0.8379e-01,
3809 *0.7097e-01,0.6207e-01,0.5595e-01,0.5174e-01,0.4879e-01,0.4675e-01,
3810 *0.4531e-01,0.4435e-01,0.4373e-01,0.4337e-01,0.4324e-01,0.4330e-01,
3811 *0.4353e-01,0.4392e-01,0.4449e-01,0.4522e-01,0.4612e-01,0.4721e-01,
3812 *0.4850e-01,0.5001e-01,0.5177e-01,0.5381e-01,0.5616e-01,0.5885e-01,
3813 *0.6191e-01,0.6540e-01,0.6936e-01,0.7383e-01,0.7889e-01,0.8168e-01,
3814 *0.8459e-01,0.9096e-01,0.9808e-01,0.1060e+00,0.1148e+00,0.1246e+00,
3815 *0.1355e+00,0.1474e+00,0.1605e+00,0.1750e+00,0.1910e+00,0.2088e+00,
3816 *0.2284e+00,0.2501e+00,0.2739e+00,0.3000e+00,0.3284e+00,0.3594e+00,
3817 *0.3935e+00,0.4308e+00,0.4718e+00,0.5172e+00,0.5670e+00,0.6222e+00,
3818 *0.6840e+00,0.7528e+00,0.8308e+00,0.9217e+00,0.1029e+01,0.1159e+01,
3819 *0.1327e+01,0.1553e+01,0.1878e+01,0.2386e+01,0.3253e+01,0.4937e+01,
3820 *0.8737e+01,0.1952e+02,0.6427e+02,0.4929e+03,0.5169e+05/
3821 DATA ((phr(i,j),j=1,83),i=02,02) /
3822 *0.2467e+00,0.2483e+00,0.2871e+00,0.2722e+00,0.2454e+00,0.2231e+00,
3823 *0.2060e+00,0.1900e+00,0.1704e+00,0.1452e+00,0.1186e+00,0.9754e-01,
3824 *0.8182e-01,0.7067e-01,0.6284e-01,0.5734e-01,0.5345e-01,0.5070e-01,
3825 *0.4875e-01,0.4741e-01,0.4651e-01,0.4596e-01,0.4570e-01,0.4569e-01,
3826 *0.4589e-01,0.4631e-01,0.4693e-01,0.4776e-01,0.4879e-01,0.5005e-01,
3827 *0.5153e-01,0.5328e-01,0.5532e-01,0.5768e-01,0.6040e-01,0.6350e-01,
3828 *0.6704e-01,0.7104e-01,0.7559e-01,0.8071e-01,0.8648e-01,0.8967e-01,
3829 *0.9298e-01,0.1002e+00,0.1083e+00,0.1173e+00,0.1273e+00,0.1384e+00,
3830 *0.1507e+00,0.1641e+00,0.1790e+00,0.1954e+00,0.2134e+00,0.2335e+00,
3831 *0.2557e+00,0.2801e+00,0.3070e+00,0.3366e+00,0.3687e+00,0.4039e+00,
3832 *0.4427e+00,0.4850e+00,0.5316e+00,0.5834e+00,0.6402e+00,0.7032e+00,
3833 *0.7738e+00,0.8527e+00,0.9422e+00,0.1047e+01,0.1171e+01,0.1321e+01,
3834 *0.1516e+01,0.1780e+01,0.2160e+01,0.2753e+01,0.3768e+01,0.5728e+01,
3835 *0.1011e+02,0.2231e+02,0.7109e+02,0.5001e+03,0.3548e+05/
3836 DATA ((phr(i,j),j=1,83),i=03,03) /
3837 *0.2599e+00,0.2602e+00,0.2986e+00,0.2838e+00,0.2563e+00,0.2330e+00,
3838 *0.2148e+00,0.1978e+00,0.1774e+00,0.1513e+00,0.1237e+00,0.1017e+00,
3839 *0.8513e-01,0.7333e-01,0.6499e-01,0.5912e-01,0.5494e-01,0.5198e-01,
3840 *0.4986e-01,0.4840e-01,0.4742e-01,0.4681e-01,0.4651e-01,0.4647e-01,
3841 *0.4667e-01,0.4708e-01,0.4772e-01,0.4858e-01,0.4965e-01,0.5094e-01,
3842 *0.5249e-01,0.5430e-01,0.5642e-01,0.5887e-01,0.6169e-01,0.6491e-01,
3843 *0.6858e-01,0.7273e-01,0.7744e-01,0.8274e-01,0.8872e-01,0.9201e-01,
3844 *0.9544e-01,0.1029e+00,0.1113e+00,0.1206e+00,0.1309e+00,0.1424e+00,
3845 *0.1550e+00,0.1689e+00,0.1842e+00,0.2011e+00,0.2198e+00,0.2404e+00,
3846 *0.2633e+00,0.2886e+00,0.3163e+00,0.3468e+00,0.3800e+00,0.4164e+00,
3847 *0.4565e+00,0.5002e+00,0.5485e+00,0.6020e+00,0.6608e+00,0.7261e+00,
3848 *0.7993e+00,0.8810e+00,0.9739e+00,0.1083e+01,0.1211e+01,0.1368e+01,
3849 *0.1571e+01,0.1846e+01,0.2242e+01,0.2860e+01,0.3918e+01,0.5956e+01,
3850 *0.1050e+02,0.2307e+02,0.7281e+02,0.4999e+03,0.3196e+05/
3851 DATA ((phr(i,j),j=1,83),i=04,04) /
3852 *0.2765e+00,0.2752e+00,0.3129e+00,0.2981e+00,0.2697e+00,0.2452e+00,
3853 *0.2256e+00,0.2075e+00,0.1862e+00,0.1589e+00,0.1301e+00,0.1069e+00,
3854 *0.8939e-01,0.7677e-01,0.6780e-01,0.6145e-01,0.5690e-01,0.5366e-01,
3855 *0.5134e-01,0.4973e-01,0.4862e-01,0.4794e-01,0.4758e-01,0.4751e-01,
3856 *0.4769e-01,0.4811e-01,0.4877e-01,0.4965e-01,0.5076e-01,0.5212e-01,
3857 *0.5373e-01,0.5563e-01,0.5784e-01,0.6041e-01,0.6336e-01,0.6672e-01,
3858 *0.7055e-01,0.7488e-01,0.7979e-01,0.8532e-01,0.9155e-01,0.9497e-01,
3859 *0.9854e-01,0.1063e+00,0.1150e+00,0.1247e+00,0.1354e+00,0.1473e+00,
3860 *0.1604e+00,0.1748e+00,0.1907e+00,0.2083e+00,0.2276e+00,0.2491e+00,
3861 *0.2729e+00,0.2990e+00,0.3279e+00,0.3596e+00,0.3941e+00,0.4319e+00,
3862 *0.4735e+00,0.5191e+00,0.5693e+00,0.6251e+00,0.6864e+00,0.7545e+00,
3863 *0.8309e+00,0.9163e+00,0.1013e+01,0.1127e+01,0.1262e+01,0.1426e+01,
3864 *0.1640e+01,0.1928e+01,0.2345e+01,0.2995e+01,0.4106e+01,0.6242e+01,
3865 *0.1098e+02,0.2400e+02,0.7481e+02,0.4984e+03,0.2810e+05/
3866 DATA ((phr(i,j),j=1,83),i=05,05) /
3867 *0.3140e+00,0.3090e+00,0.3440e+00,0.3291e+00,0.2988e+00,0.2716e+00,
3868 *0.2491e+00,0.2285e+00,0.2053e+00,0.1759e+00,0.1447e+00,0.1190e+00,
3869 *0.9926e-01,0.8484e-01,0.7446e-01,0.6700e-01,0.6162e-01,0.5774e-01,
3870 *0.5493e-01,0.5295e-01,0.5158e-01,0.5070e-01,0.5021e-01,0.5005e-01,
3871 *0.5019e-01,0.5060e-01,0.5129e-01,0.5224e-01,0.5344e-01,0.5492e-01,
3872 *0.5668e-01,0.5876e-01,0.6118e-01,0.6400e-01,0.6723e-01,0.7091e-01,
3873 *0.7509e-01,0.7981e-01,0.8516e-01,0.9117e-01,0.9793e-01,0.1016e+00,
3874 *0.1055e+00,0.1140e+00,0.1234e+00,0.1338e+00,0.1454e+00,0.1582e+00,
3875 *0.1724e+00,0.1879e+00,0.2051e+00,0.2241e+00,0.2449e+00,0.2681e+00,
3876 *0.2937e+00,0.3220e+00,0.3531e+00,0.3873e+00,0.4247e+00,0.4656e+00,
3877 *0.5108e+00,0.5603e+00,0.6149e+00,0.6756e+00,0.7425e+00,0.8168e+00,
3878 *0.9003e+00,0.9939e+00,0.1101e+01,0.1226e+01,0.1374e+01,0.1557e+01,
3879 *0.1793e+01,0.2114e+01,0.2577e+01,0.3299e+01,0.4529e+01,0.6879e+01,
3880 *0.1204e+02,0.2596e+02,0.7866e+02,0.4906e+03,0.2124e+05/
3881 DATA ((phr(i,j),j=1,83),i=06,06) /
3882 *0.3397e+00,0.3323e+00,0.3646e+00,0.3493e+00,0.3179e+00,0.2889e+00,
3883 *0.2644e+00,0.2424e+00,0.2181e+00,0.1874e+00,0.1547e+00,0.1274e+00,
3884 *0.1062e+00,0.9063e-01,0.7928e-01,0.7107e-01,0.6509e-01,0.6076e-01,
3885 *0.5761e-01,0.5537e-01,0.5380e-01,0.5278e-01,0.5218e-01,0.5196e-01,
3886 *0.5206e-01,0.5246e-01,0.5317e-01,0.5415e-01,0.5542e-01,0.5697e-01,
3887 *0.5883e-01,0.6103e-01,0.6359e-01,0.6657e-01,0.6998e-01,0.7387e-01,
3888 *0.7829e-01,0.8327e-01,0.8891e-01,0.9524e-01,0.1024e+00,0.1063e+00,
3889 *0.1103e+00,0.1192e+00,0.1291e+00,0.1400e+00,0.1522e+00,0.1656e+00,
3890 *0.1805e+00,0.1968e+00,0.2148e+00,0.2346e+00,0.2565e+00,0.2807e+00,
3891 *0.3076e+00,0.3372e+00,0.3699e+00,0.4058e+00,0.4451e+00,0.4881e+00,
3892 *0.5357e+00,0.5878e+00,0.6454e+00,0.7094e+00,0.7800e+00,0.8586e+00,
3893 *0.9471e+00,0.1046e+01,0.1160e+01,0.1293e+01,0.1451e+01,0.1646e+01,
3894 *0.1899e+01,0.2242e+01,0.2738e+01,0.3509e+01,0.4820e+01,0.7310e+01,
3895 *0.1274e+02,0.2720e+02,0.8080e+02,0.4822e+03,0.1763e+05/
3896 DATA ((phr(i,j),j=1,83),i=07,07) /
3897 *0.3665e+00,0.3585e+00,0.3853e+00,0.3705e+00,0.3386e+00,0.3093e+00,
3898 *0.2869e+00,0.2705e+00,0.2507e+00,0.2187e+00,0.1832e+00,0.1512e+00,
3899 *0.1258e+00,0.1065e+00,0.9217e-01,0.8162e-01,0.7386e-01,0.6812e-01,
3900 *0.6393e-01,0.6088e-01,0.5870e-01,0.5723e-01,0.5631e-01,0.5585e-01,
3901 *0.5579e-01,0.5612e-01,0.5681e-01,0.5783e-01,0.5918e-01,0.6088e-01,
3902 *0.6291e-01,0.6532e-01,0.6815e-01,0.7143e-01,0.7521e-01,0.7951e-01,
3903 *0.8439e-01,0.8988e-01,0.9607e-01,0.1030e+00,0.1108e+00,0.1151e+00,
3904 *0.1196e+00,0.1293e+00,0.1400e+00,0.1520e+00,0.1652e+00,0.1799e+00,
3905 *0.1961e+00,0.2140e+00,0.2338e+00,0.2557e+00,0.2799e+00,0.3069e+00,
3906 *0.3367e+00,0.3696e+00,0.4060e+00,0.4461e+00,0.4901e+00,0.5388e+00,
3907 *0.5927e+00,0.6520e+00,0.7180e+00,0.7913e+00,0.8725e+00,0.9634e+00,
3908 *0.1066e+01,0.1181e+01,0.1314e+01,0.1469e+01,0.1655e+01,0.1885e+01,
3909 *0.2183e+01,0.2586e+01,0.3166e+01,0.4061e+01,0.5568e+01,0.8386e+01,
3910 *0.1440e+02,0.2992e+02,0.8452e+02,0.4537e+03,0.1132e+05/
3911 DATA ((phr(i,j),j=1,83),i=08,08) /
3912 *0.2248e+00,0.2041e+00,0.2013e+00,0.2015e+00,0.2038e+00,0.2142e+00,
3913 *0.2218e+00,0.2177e+00,0.2078e+00,0.1973e+00,0.1876e+00,0.1779e+00,
3914 *0.1666e+00,0.1530e+00,0.1377e+00,0.1221e+00,0.1078e+00,0.9531e-01,
3915 *0.8504e-01,0.7686e-01,0.7052e-01,0.6573e-01,0.6219e-01,0.5966e-01,
3916 *0.5794e-01,0.5689e-01,0.5645e-01,0.5656e-01,0.5718e-01,0.5825e-01,
3917 *0.5974e-01,0.6159e-01,0.6382e-01,0.6647e-01,0.6955e-01,0.7314e-01,
3918 *0.7723e-01,0.8187e-01,0.8711e-01,0.9302e-01,0.9976e-01,0.1035e+00,
3919 *0.1075e+00,0.1163e+00,0.1263e+00,0.1377e+00,0.1507e+00,0.1653e+00,
3920 *0.1819e+00,0.2008e+00,0.2222e+00,0.2467e+00,0.2745e+00,0.3060e+00,
3921 *0.3418e+00,0.3822e+00,0.4279e+00,0.4800e+00,0.5391e+00,0.6066e+00,
3922 *0.6838e+00,0.7715e+00,0.8718e+00,0.9864e+00,0.1117e+01,0.1268e+01,
3923 *0.1442e+01,0.1643e+01,0.1880e+01,0.2160e+01,0.2496e+01,0.2906e+01,
3924 *0.3423e+01,0.4095e+01,0.5014e+01,0.6356e+01,0.8465e+01,0.1211e+02,
3925 *0.1924e+02,0.3569e+02,0.8510e+02,0.3357e+03,0.3290e+04/
3926 DATA ((phr(i,j),j=1,83),i=09,09) /
3927 *0.8649e-01,0.6705e-01,0.5195e-01,0.7001e-01,0.7008e-01,0.6002e-01,
3928 *0.5176e-01,0.4616e-01,0.4241e-01,0.3977e-01,0.3795e-01,0.3668e-01,
3929 *0.3583e-01,0.3535e-01,0.3514e-01,0.3524e-01,0.3565e-01,0.3638e-01,
3930 *0.3751e-01,0.3892e-01,0.4055e-01,0.4217e-01,0.4354e-01,0.4447e-01,
3931 *0.4473e-01,0.4432e-01,0.4334e-01,0.4196e-01,0.4043e-01,0.3895e-01,
3932 *0.3767e-01,0.3668e-01,0.3599e-01,0.3567e-01,0.3568e-01,0.3603e-01,
3933 *0.3675e-01,0.3782e-01,0.3929e-01,0.4119e-01,0.4354e-01,0.4489e-01,
3934 *0.4638e-01,0.4977e-01,0.5377e-01,0.5848e-01,0.6402e-01,0.7052e-01,
3935 *0.7819e-01,0.8720e-01,0.9780e-01,0.1103e+00,0.1250e+00,0.1423e+00,
3936 *0.1629e+00,0.1872e+00,0.2164e+00,0.2514e+00,0.2934e+00,0.3442e+00,
3937 *0.4055e+00,0.4799e+00,0.5709e+00,0.6824e+00,0.8200e+00,0.9912e+00,
3938 *0.1205e+01,0.1474e+01,0.1814e+01,0.2247e+01,0.2801e+01,0.3520e+01,
3939 *0.4460e+01,0.5710e+01,0.7406e+01,0.9765e+01,0.1318e+02,0.1847e+02,
3940 *0.2749e+02,0.4547e+02,0.9155e+02,0.2798e+03,0.1582e+04/
3941 DATA ((phr(i,j),j=1,83),i=10,10) /
3942 *0.9344e-01,0.8261e-01,0.6680e-01,0.7550e-01,0.8962e-01,0.9095e-01,
3943 *0.8469e-01,0.7755e-01,0.7170e-01,0.6726e-01,0.6401e-01,0.6173e-01,
3944 *0.6034e-01,0.5974e-01,0.5979e-01,0.6028e-01,0.6096e-01,0.6155e-01,
3945 *0.6179e-01,0.6151e-01,0.6067e-01,0.5928e-01,0.5752e-01,0.5554e-01,
3946 *0.5354e-01,0.5165e-01,0.4997e-01,0.4858e-01,0.4752e-01,0.4683e-01,
3947 *0.4651e-01,0.4657e-01,0.4701e-01,0.4781e-01,0.4897e-01,0.5053e-01,
3948 *0.5250e-01,0.5493e-01,0.5787e-01,0.6137e-01,0.6550e-01,0.6782e-01,
3949 *0.7033e-01,0.7593e-01,0.8242e-01,0.8992e-01,0.9860e-01,0.1087e+00,
3950 *0.1203e+00,0.1339e+00,0.1497e+00,0.1682e+00,0.1896e+00,0.2147e+00,
3951 *0.2441e+00,0.2786e+00,0.3193e+00,0.3675e+00,0.4248e+00,0.4931e+00,
3952 *0.5747e+00,0.6726e+00,0.7902e+00,0.9324e+00,0.1105e+01,0.1316e+01,
3953 *0.1575e+01,0.1895e+01,0.2292e+01,0.2787e+01,0.3407e+01,0.4192e+01,
3954 *0.5195e+01,0.6498e+01,0.8221e+01,0.1057e+02,0.1389e+02,0.1886e+02,
3955 *0.2699e+02,0.4205e+02,0.7598e+02,0.1847e+03,0.5926e+03/
3962 subroutine enviro (difr,difa,r,palt,xmuv,
3964 real difr, difa, r, palt
3965 real fae,fra,fr,fae0,fra0,xmuv,xlnv,a0,b0,a1,b1
3966 real zmin,zmax,xcfr1,xcfr2,xcfa1,xcfa2,xcfa3
3967 real alt(16),cfr1(16),cfr2(16),cfa1(16),cfa2(16),cfa3(16)
3969 data (alt(i),i=1,16) /0.5,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,
3970 s 10.0,12.0,14.0,16.0,18.0,20.0,60.0/
3971 data (cfr1(i),i=1,16) /0.730,0.710,0.656,0.606,0.560,0.516,0.473,
3972 s 0.433,0.395,0.323,0.258,0.209,0.171,0.142,0.122,0.070/
3973 data (cfr2(i),i=1,16) /2.8,1.51,0.845,0.634,0.524,0.465,0.429,
3974 s 0.405,0.390,0.386,0.409,0.445,0.488,0.545,0.608,0.868/
3975 data (cfa1(i),i=1,16) /0.239,0.396,0.588,0.626,0.612,0.505,0.454,
3976 s 0.448,0.444,0.445,0.444,0.448,0.448,0.448,0.448,0.448/
3977 data (cfa2(i),i=1,16) /1.40,1.20,1.02,0.86,0.74,0.56,0.46,0.42,
3978 s 0.38,0.34,0.3,0.28,0.27,0.27,0.27,0.27/
3979 data (cfa3(i),i=1,16) /9.17,6.26,5.48,5.16,4.74,3.65,3.24,3.15,
3980 s 3.07,2.97,2.88,2.83,2.83,2.83,2.83,2.83/
3993 if (palt.ge.60.)
then
3994 fae0=1-0.448*exp(-r*0.27)-0.552*exp(-r*2.83)
3995 fra0=1-0.930*exp(-r*0.080)-0.070*exp(-r*1.100)
3999 if (palt.ge.alt(i))
goto 10
4000 if ((i.gt.1).and.(i.lt.16))
then
4003 xcfr1=cfr1(i-1)+(cfr1(i)-cfr1(i-1))*(zmax-palt)/(zmax-zmin)
4004 xcfr2=cfr2(i-1)+(cfr2(i)-cfr2(i-1))*(zmax-palt)/(zmax-zmin)
4005 xcfa1=cfa1(i-1)+(cfa1(i)-cfa1(i-1))*(zmax-palt)/(zmax-zmin)
4006 xcfa2=cfa2(i-1)+(cfa2(i)-cfa2(i-1))*(zmax-palt)/(zmax-zmin)
4007 xcfa3=cfa3(i-1)+(cfa3(i)-cfa3(i-1))*(zmax-palt)/(zmax-zmin)
4016 fra0=1.-xcfr1*exp(-r*xcfr2)-(1.-xcfr1)*exp(-r*0.08)
4017 fae0=1.-xcfa1*exp(-r*xcfa2)-(1.-xcfa1)*exp(-r*xcfa3)
4021 fra=fra0*(xlnv*(1-fra0)+1)
4022 fae=fae0*((1+a0*xlnv+b0*xlnv*xlnv)+fae0*(a1*xlnv+b1*xlnv*xlnv)+
4023 sfae0*fae0*((-a1-a0)*xlnv+(-b1-b0)*xlnv*xlnv))
4025 if ((difa+difr).gt.1.e-03)
then
4026 fr=(fae*difa+fra*difr)/(difa+difr)
4032 subroutine equivwl(iinf,isup,step,
4034 common /sixs_ffu/s(1501),wlinf,wlsup
4035 real step,wlmoy,s,wlinf,wlsup,seb,wlwave,sbor,wl,swl,coef
4041 if(l.eq.iinf.or.l.eq.isup) sbor=sbor*0.5
4049 wlwave=wlwave+wl*coef
4054 subroutine gauss(x1,x2,x,w,n)
4056 real x1,x2,x(n),w(n)
4057 double precision xm,xl,z,p1,p2,p3,pp,z1
4064 z=cos(3.141592654d0*(i-.25d0)/(n+.5d0))
4071 p1=((2.d0*j-1.d0)*z*p2-(j-1.d0)*p3)/j
4073 pp=n*(z*p1-p2)/(z*z-1.d0)
4076 if(
abs(z-z1).gt.eps)
go to 1
4077 if (
abs(z).lt.eps) z=0.
4080 w(i)=2.d0*xl/((1.d0-z*z)*pp*pp)
4085 subroutine interp (iaer,idatmp,wl,taer55,taer55p,xmud,
4086 a romix,rorayl,roaero,phaa,phar,tsca,
4087 a tray,trayp,taer,taerp,dtott,utott,
4088 a astot,asray,asaer,
4089 a utotr,utota,dtotr,dtota)
4091 common /sixs_aer/ext(10),ome(10),gasym(10),phase(10)
4092 common /sixs_disc/ roatm(3,10),dtdir(3,10),dtdif(3,10),
4093 a utdir(3,10),utdif(3,10),sphal(3,10),wldis(10),trayl(10),
4095 common /sixs_del/ delta,sigma
4096 Real wl,taer55,taer55p
4097 Real xmud,romix,rorayl,roaero,phaa,phar,tsca,tray
4098 Real trayp,taer,taerp,dtott,utott,astot,asray,asaer,utotr
4099 Real utota,dtotr,dtota,ext,ome,gasym,phase,roatm,dtdir
4100 Real dtdif,utdir,utdif,sphal,wldis,trayl,traypl,delta,sigma
4101 Real alphaa,betaa,alphar,betar,alphac,betac,coef,wlinf,d2
4102 Real drinf,drsup,dtinf,dtsup,dtotc,dainf,dasup,urinf,ursup
4103 Real utinf,utsup,utotc,uainf,uasup,arinf,arsup,atinf,atsup
4105 Integer iaer,idatmp,linf,ll,lsup
4136 if(wl.gt.wldis(ll).and.wl.le.wldis(ll+1)) linf=ll
4138 if(wl.gt.wldis(10)) linf=9
4157 coef=alog(wldis(lsup)/wldis(linf))
4160 if(iaer.eq.0)
goto 1240
4161 alphaa=alog(phase(lsup)/phase(linf))/coef
4162 betaa=phase(linf)/(wlinf**(alphaa))
4163 phaa=betaa*(wl**alphaa)
4165 phar=(2.*(1.-delta)/d2)*.75*(1.+xmud*xmud)+3.*delta/d2
4166 if (idatmp.eq.0)
then
4172 if(roatm(1,linf).lt..001)
then
4173 rorayl=roatm(1,linf)+(roatm(1,lsup)-roatm(1,linf))
4174 s *(wl-wldis(linf))/(wldis(lsup)-wldis(linf))
4176 alphar=alog(roatm(1,lsup)/roatm(1,linf))/ coef
4177 betar=roatm(1,linf)/(wlinf**(alphar))
4178 rorayl=betar*(wl**alphar)
4180 if(roatm(2,linf).lt..001)
then
4181 romix=roatm(2,linf)+(roatm(2,lsup)-roatm(2,linf))
4182 s *(wl-wldis(linf))/(wldis(lsup)-wldis(linf))
4184 alphac=alog(roatm(2,lsup)/roatm(2,linf))/coef
4185 betac=roatm(2,linf)/(wlinf**(alphac))
4186 romix=betac*(wl**alphac)
4188 if(iaer.eq.0)
goto 1234
4189 if(roatm(3,linf).lt..001)
then
4190 roaero=roatm(3,linf)+(roatm(3,lsup)-roatm(3,linf))
4191 s *(wl-wldis(linf))/(wldis(lsup)-wldis(linf))
4193 alphaa=alog(roatm(3,lsup)/roatm(3,linf))/coef
4194 betaa=roatm(3,linf)/(wlinf**(alphaa))
4195 roaero=betaa*(wl**alphaa)
4199 alphar=alog(trayl(lsup)/trayl(linf))/coef
4200 betar=trayl(linf)/(wlinf**(alphar))
4201 tray=betar*(wl**alphar)
4202 if (idatmp.ne.0.)
then
4203 alphar=alog(traypl(lsup)/traypl(linf))/coef
4204 betar=traypl(linf)/(wlinf**(alphar))
4205 trayp=betar*(wl**alphar)
4210 if(iaer.eq.0)
goto 1235
4211 alphaa=alog(ext(lsup)*ome(lsup)/(ext(linf)*ome(linf)))/coef
4212 betaa=ext(linf)*ome(linf)/(wlinf**(alphaa))
4213 tsca=taer55*betaa*(wl**alphaa)/ext(4)
4214 alphaa=alog(ext(lsup)/ext(linf))/coef
4215 betaa=ext(linf)/(wlinf**(alphaa))
4216 taerp=taer55p*betaa*(wl**alphaa)/ext(4)
4217 taer=taer55*betaa*(wl**alphaa)/ext(4)
4219 1235 drinf=dtdif(1,linf)+dtdir(1,linf)
4220 drsup=dtdif(1,lsup)+dtdir(1,lsup)
4221 alphar=alog(drsup/drinf)/coef
4222 betar=drinf/(wlinf**(alphar))
4223 dtotr=betar*(wl**alphar)
4224 dtinf=dtdif(2,linf)+dtdir(2,linf)
4225 dtsup=dtdif(2,lsup)+dtdir(2,lsup)
4226 alphac=alog((dtsup*drinf)/(dtinf*drsup))/coef
4227 betac=(dtinf/drinf)/(wlinf**(alphac))
4228 dtotc=betac*(wl**alphac)
4229 dainf=dtdif(3,linf)+dtdir(3,linf)
4230 dasup=dtdif(3,lsup)+dtdir(3,lsup)
4231 if(iaer.eq.0)
goto 1236
4232 alphaa=alog(dasup/dainf)/coef
4233 betaa=dainf/(wlinf**(alphaa))
4234 dtota=betaa*(wl**alphaa)
4235 1236 dtott=dtotc*dtotr
4236 urinf=utdif(1,linf)+utdir(1,linf)
4237 ursup=utdif(1,lsup)+utdir(1,lsup)
4238 alphar=alog(ursup/urinf)/ coef
4239 betar=urinf/(wlinf**(alphar))
4240 utotr=betar*(wl**alphar)
4241 utinf=utdif(2,linf)+utdir(2,linf)
4242 utsup=utdif(2,lsup)+utdir(2,lsup)
4243 alphac=alog((utsup*urinf)/(utinf*ursup))/ coef
4244 betac=(utinf/urinf)/(wlinf**(alphac))
4245 utotc=betac*(wl**alphac)
4246 uainf=utdif(3,linf)+utdir(3,linf)
4247 uasup=utdif(3,lsup)+utdir(3,lsup)
4248 if(iaer.eq.0)
goto 1237
4249 alphaa=alog(uasup/uainf)/ coef
4250 betaa=uainf/(wlinf**(alphaa))
4251 utota=betaa*(wl**alphaa)
4252 1237 utott=utotc*utotr
4255 alphar=alog(arsup/arinf)/ coef
4256 betar=arinf/(wlinf**(alphar))
4257 asray=betar*(wl**alphar)
4260 alphac=alog(atsup/atinf)/coef
4261 betac=atinf/(wlinf**(alphac))
4262 astot=betac*(wl**alphac)
4265 if(iaer.eq.0)
goto 1239
4266 alphaa=alog(aasup/aainf)/coef
4267 betaa=aainf/(wlinf**(alphaa))
4268 asaer=betaa*(wl**alphaa)
4271 subroutine iso(tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
4276 real rm(-mu:mu),gb(-mu:mu)
4280 real xpl(-25:25),psl(-1:80,-25:25),bp(0:25,-25:25),
4281 s xdel(0:30),ydel(0:30),h(0:30)
4282 real i1(0:30,-25:25),i2(0:30,-25:25),i3(-25:25),
4283 s in(-25:25),inm1(-25:25),inm2(-25:25)
4286 Real tamoy,trmoy,pizmoy
4287 Real tamoyp,trmoyp,palt
4288 Real delta,sigma,pha,betal,accu,accu2,ta,piz
4289 Real tr,trp,tap,hr,ha,zx,yy,dd,ppp2,ppp1,ca
4290 Real cr,ratio,taup,th,xt1,xt2,aaaa,ron,beta0,beta2
4291 Real tavion0,tavion1,tavion2,tavion,zi1,xpk,ypk,x,y,xpj
4292 Real z,xi1,xi2,bpjk,bpjmk,f,a,b,c,d,xx,a1,d1,g1
4294 Double precision xxx
4295 integer snt,nt,iplane,ntp,j,it,itp,i,ig,k,index,iwr,m
4298 common/sixs_del/delta,sigma
4299 common/sixs_trunc/pha(83),betal(0:80)
4300 common/sixs_ier/iwr,ier
4333 if(palt.le.900..and.palt.gt.0.0)
then
4334 if (tap.gt.1.e-03)
then
4335 ha=-palt/log(tap/ta)
4354 if((ta.le.accu2).and.(tr.gt.ta))
then
4361 if((tr.le.accu2).and.(ta.gt.tr))
then
4369 if(tr.gt.accu2.and.ta.gt.accu2)
then
4387 call discre(ta,ha,tr,hr,itp,ntp,yy,dd,ppp2,ppp1,
4391 if (xxx.lt.-18)
then
4404 xdel(it)=(1.e+00-ratio)*piz
4409 if (ntp.eq.(nt-1))
then
4414 if (taup.ge.h(i)) iplane=i
4418 xt1=
abs(h(iplane)-taup)
4419 xt2=
abs(h(iplane+1)-taup)
4420 if ((xt1.gt.th).and.(xt2.gt.th))
then
4429 if (xt2.lt.xt1) iplane=iplane+1
4432 if ( tr.gt.accu2.and.ta.gt.accu2)
then
4438 xdel(iplane)=(1.e+00-ratio)*piz
4442 if ( tr.gt.accu2.and.ta.le.accu2)
then
4447 if ( tr.le.accu2.and.ta.gt.accu2)
then
4459 aaaa=delta/(2-delta)
4460 ron=(1-aaaa)/(1+2*aaaa)
4480 call kernel(0,mu,rm,xpl,psl,bp)
4495 i1(i,k)=exp(-(ta+tr-h(i))/yy)
4518 tavion=i1(iplane,mu)
4519 tavion2=i1(iplane,mu)
4544 bpjk=bp(j,k)*x+y*(beta0+beta2*xpj*xpk)
4545 bpjmk=bp(j,-k)*x+y*(beta0+beta2*xpj*ypk)
4546 ii2=ii2+z*(xi1*bpjk+xi2*bpjmk)
4547 ii1=ii1+z*(xi1*bpjmk+xi2*bpjk)
4562 a=(i2(jj,k)-i2(i,k))/f
4567 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
4582 a=(i2(i,k)-i2(jj,k))/f
4585 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
4599 tavion0=i1(iplane,mu)
4608 if (a1.ge.accu.and.d1.ge.accu.and.tavion.ge.accu)
then
4609 y=((g1/d1-d1/a1)/((1.-g1/d1)**2)*(g1/tavion))
4618 if(a1.eq.0.)
go to 99
4619 if(d1.eq.0.)
go to 99
4620 if(i3(l).eq.0.)
go to 99
4621 y=((g1/d1-d1/a1)/((1-g1/d1)**2)*(g1/i3(l)))
4625 if(z.lt.0.0001)
then
4630 if (l.eq.0)
goto 606
4634 if(d1.eq.0.0)
go to 606
4642 if (d1.ge.accu)
then
4643 if (
abs(g1-d1).ge.accu)
then
4672 tavion=tavion+tavion0
4683 if(z.lt.0.00001)
go to 505
4687 if(ig-20) 503,503,505
4694 xf(0)=xf(0)+rm(k)*gb(k)*i3(-k)
4699 subroutine kernel(is,mu,rm,xpl,psl,bp)
4702 real psl(-1:80,-25:25),xpl(-25:25),bp(0:25,-25:25)
4704 integer is,ip1,j,i,k,ip,ig,l,lp,lm,ij
4705 double precision xdb,a,b,c,xx,rac3,x,bt,sbp
4706 common /sixs_trunc/pha(83),betal(0:80)
4709 if(is.ne.0)
go to 700
4717 if (
abs(xdb).lt.1.e-30) xdb=0.0
4724 700
if(is.ne.1)
go to 701
4730 psl(1,-j)=sqrt(x*0.5)
4731 psl(1,j)=sqrt(x*0.5)
4732 psl(2,j)=c*psl(1,j)*rac3
4741 a=a*sqrt((i+is)/x)*0.5
4743 b=a*sqrt(is/(is+1.))*sqrt((is-1.)/(is+2.))
4749 if (
abs(xdb).lt.1.e-30) xdb=0.0
4762 a=(2*l+1.)/sqrt((l+is+1.)*(l-is+1.))
4763 b=sqrt(float((l+is)*(l-is)))/(2.*l+1.)
4766 xdb=a*(c*psl(l,j)-b*psl(lm,j))
4767 if (
abs(xdb).lt.1.e-30) xdb=0.
4770 psl(lp,-j)=ig*psl(lp,j)
4785 sbp=sbp+dble(psl(l,j))*psl(l,k)*bt
4788 if (
abs(sbp).lt.1.e-30) sbp=0.
4794 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
4795 real z2(34),p2(34),t2(34),wh2(34),wo2(34)
4801 data(z2(i),i=1, 34)/
4802 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
4803 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
4804 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
4805 4 35., 40., 45., 50., 70., 100.,99999./
4806 data (p2(i),i=1,34) /
4807 a1.013e+03,9.020e+02,8.020e+02,7.100e+02,6.280e+02,5.540e+02,
4808 a4.870e+02,4.260e+02,3.720e+02,3.240e+02,2.810e+02,2.430e+02,
4809 a2.090e+02,1.790e+02,1.530e+02,1.300e+02,1.110e+02,9.500e+01,
4810 a8.120e+01,6.950e+01,5.950e+01,5.100e+01,4.370e+01,3.760e+01,
4811 a3.220e+01,2.770e+01,1.320e+01,6.520e+00,3.330e+00,1.760e+00,
4812 a9.510e-01,6.710e-02,3.000e-04,0.000e+00/
4813 data (t2(i),i=1,34) /
4814 a2.940e+02,2.900e+02,2.850e+02,2.790e+02,2.730e+02,2.670e+02,
4815 a2.610e+02,2.550e+02,2.480e+02,2.420e+02,2.350e+02,2.290e+02,
4816 a2.220e+02,2.160e+02,2.160e+02,2.160e+02,2.160e+02,2.160e+02,
4817 a2.160e+02,2.170e+02,2.180e+02,2.190e+02,2.200e+02,2.220e+02,
4818 a2.230e+02,2.240e+02,2.340e+02,2.450e+02,2.580e+02,2.700e+02,
4819 a2.760e+02,2.180e+02,2.100e+02,2.100e+02/
4820 data (wh2(i),i=1,34) /
4821 a1.400e+01,9.300e+00,5.900e+00,3.300e+00,1.900e+00,1.000e+00,
4822 a6.100e-01,3.700e-01,2.100e-01,1.200e-01,6.400e-02,2.200e-02,
4823 a6.000e-03,1.800e-03,1.000e-03,7.600e-04,6.400e-04,5.600e-04,
4824 a5.000e-04,4.900e-04,4.500e-04,5.100e-04,5.100e-04,5.400e-04,
4825 a6.000e-04,6.700e-04,3.600e-04,1.100e-04,4.300e-05,1.900e-05,
4826 a1.300e-06,1.400e-07,1.000e-09,0.000e+00/
4827 data (wo2(i),i=1,34) /
4828 a6.000e-05,6.000e-05,6.000e-05,6.200e-05,6.400e-05,6.600e-05,
4829 a6.900e-05,7.500e-05,7.900e-05,8.600e-05,9.000e-05,1.100e-04,
4830 a1.200e-04,1.500e-04,1.800e-04,1.900e-04,2.100e-04,2.400e-04,
4831 a2.800e-04,3.200e-04,3.400e-04,3.600e-04,3.600e-04,3.400e-04,
4832 a3.200e-04,3.000e-04,2.000e-04,9.200e-05,4.100e-05,1.300e-05,
4833 a4.300e-06,8.600e-08,4.300e-11,0.000e+00/
4844 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
4845 real z3(34),p3(34),t3(34),wh3(34),wo3(34)
4851 data(z3(i),i=1, 34)/
4852 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
4853 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
4854 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
4855 4 35., 40., 45., 50., 70., 100.,99999./
4856 data (p3(i),i=1,34) /
4857 a1.018e+03,8.973e+02,7.897e+02,6.938e+02,6.081e+02,5.313e+02,
4858 a4.627e+02,4.016e+02,3.473e+02,2.992e+02,2.568e+02,2.199e+02,
4859 a1.882e+02,1.610e+02,1.378e+02,1.178e+02,1.007e+02,8.610e+01,
4860 a7.350e+01,6.280e+01,5.370e+01,4.580e+01,3.910e+01,3.340e+01,
4861 a2.860e+01,2.430e+01,1.110e+01,5.180e+00,2.530e+00,1.290e+00,
4862 a6.820e-01,4.670e-02,3.000e-04,0.000e+00/
4863 data (t3(i),i=1,34) /
4864 a2.722e+02,2.687e+02,2.652e+02,2.617e+02,2.557e+02,2.497e+02,
4865 a2.437e+02,2.377e+02,2.317e+02,2.257e+02,2.197e+02,2.192e+02,
4866 a2.187e+02,2.182e+02,2.177e+02,2.172e+02,2.167e+02,2.162e+02,
4867 a2.157e+02,2.152e+02,2.152e+02,2.152e+02,2.152e+02,2.152e+02,
4868 a2.152e+02,2.152e+02,2.174e+02,2.278e+02,2.432e+02,2.585e+02,
4869 a2.657e+02,2.307e+02,2.102e+02,2.100e+02/
4870 data (wh3(i),i=1,34) /
4871 a3.500e+00,2.500e+00,1.800e+00,1.200e+00,6.600e-01,3.800e-01,
4872 a2.100e-01,8.500e-02,3.500e-02,1.600e-02,7.500e-03,6.900e-03,
4873 a6.000e-03,1.800e-03,1.000e-03,7.600e-04,6.400e-04,5.600e-04,
4874 a5.000e-04,4.900e-04,4.500e-04,5.100e-04,5.100e-04,5.400e-04,
4875 a6.000e-04,6.700e-04,3.600e-04,1.100e-04,4.300e-05,1.900e-05,
4876 a6.300e-06,1.400e-07,1.000e-09,0.000e+00/
4877 data (wo3(i),i=1,34) /
4878 a6.000e-05,5.400e-05,4.900e-05,4.900e-05,4.900e-05,5.800e-05,
4879 a6.400e-05,7.700e-05,9.000e-05,1.200e-04,1.600e-04,2.100e-04,
4880 a2.600e-04,3.000e-04,3.200e-04,3.400e-04,3.600e-04,3.900e-04,
4881 a4.100e-04,4.300e-04,4.500e-04,4.300e-04,4.300e-04,3.900e-04,
4882 a3.600e-04,3.400e-04,1.900e-04,9.200e-05,4.100e-05,1.300e-05,
4883 a4.300e-06,8.600e-08,4.300e-11,0.000e+00/
4893 subroutine mie(iaer,wldis,ex,sc,asy)
4895 double precision nr,p11(83),p1(10,4,83),ext(10,4),sca(10,4),np(4)
4896 double precision pi,r,rmind,rmaxd,r0,alpha,dr,xndpr2,Qext,Qsca
4897 double precision rlogpas
4898 real ex(4,10),sc(4,10),asy(4,10),wldis(10)
4899 real phasel,cgaus,pdgs,rmax,rmin,rn,ri,x1,x2,x3,rsunph,nrsunph
4900 real asy_n,asy_d,cij,ph
4901 integer nbmu,icp,i,j,l,k,iaer,irsunph
4902 double precision arg,ldexp
4904 common /sixs_sos/ phasel(10,83),cgaus(83),pdgs(83)
4905 common /mie_in/ rmax,rmin,icp,rn(10,4),ri(10,4),x1(4),x2(4),
4906 s x3(4),cij(4),irsunph,rsunph(50),nrsunph(50)
4907 common /sixs_aerbas/ ph(10,83)
4910 pi=4.d+00*datan(1.d+00)
4932 dr=r*(10**rlogpas-1.d+00)
4938 goto(300,301,302,303)iaer-7
4940 300 nr=dexp(-5.d-01*(dlog10(r/x1(i))/dlog10(1.d+00*x2(i)))**2.d+00)
4941 nr=nr/dsqrt(2.d+00*pi)/dlog10(1.d+00*x2(i))
4942 nr=nr/dlog(10.d+00)/r
4947 arg=-x2(i)*((r/r0)**x3(i))
4948 if (arg.gt.ldexp)
then
4949 nr=((r/r0)**x1(i))*dexp(arg)
4958 IF(r.GT.r0 ) nr= r**(-x1(i))
4964 if ((r-rsunph(j)).lt.0.000001)
then
4965 nr=(r-rsunph(j-1))/(rsunph(j)-rsunph(j-1))
4966 nr=nrsunph(j-1)+nr*(nrsunph(j)-nrsunph(j-1))
4976 xndpr2=nr*dr*pi*(r**2.d+00)
4981 if ((xndpr2*cij(i)).lt.(1.d-08/sqrt(wldis(l))))
goto 599
4983 alpha=2.d+00*pi*r/wldis(l)
4984 call exscphase(alpha,rn(l,i),ri(l,i),qext,qsca,p11)
4985 ext(l,i)=ext(l,i)+xndpr2*qext
4986 sca(l,i)=sca(l,i)+xndpr2*qsca
4989 p1(l,i,k)=p1(l,i,k)+p11(k)*xndpr2
4994 dr=r*(10**rlogpas-1.d+00)
4995 if(r.ge.rmaxd)
goto 600
5005 ext(l,i)=ext(l,i)/np(i)/1.d+03
5006 sca(l,i)=sca(l,i)/np(i)/1.d+03
5007 ex(1,l)=ex(1,l)+cij(i)*
real(ext(l,i))
5008 sc(1,l)=sc(1,l)+cij(i)*
real(sca(l,i))
5019 ph(l,k)=ph(l,k)+
real(cij(i)*p1(l,i,k)/np(i)/1.d+3)
5021 ph(l,k)=ph(l,k)/sc(1,l)
5022 asy_n=asy_n+cgaus(k)*ph(l,k)*pdgs(k)/10.
5023 asy_d=asy_d+ph(l,k)*pdgs(k)/10.
5025 asy(1,l)=asy_n/asy_d
5034 subroutine exscphase(X,nr,ni,Qext,Qsca,p11)
5036 double precision Ren,Imn,X,Up,XnumRDnY,XnumIDnY
5037 double precision XdenDnY,coxj,Qsca,Qext,xJonH,XdenGNX
5038 double precision Xnum1An,Xnum2An,XdenAn,Xden1An,Xden2An,RAnb,IAnb
5039 double precision Xnum1Bn,Xnum2Bn,XdenBn,Xden1Bn,Xden2Bn,RBnb,IBnb
5040 double precision xmud,xpond,RS1,RS2,IS1,IS2,co_n,test
5041 double precision xj(0:nser),xy(-1:nser),Rn(0:nser)
5042 double precision IDnY(0:nser),RDnX(0:nser),RDnY(0:nser)
5043 double precision IGnX(0:nser),RGnX(0:nser)
5044 double precision RAn(0:nser),IAn(0:nser),RBn(0:nser),IBn(0:nser)
5045 double precision TAUn(0:nser),PIn(0:nser),p11(83)
5046 real nr,ni,cgaus,phasel,pdgs
5047 integer N,Np,mu,mub,mu1,mu2,k,nbmu,j
5049 common /sixs_sos/ phasel(10,83),cgaus(83),pdgs(83)
5053 ren=nr/(nr*nr+ni*ni)
5054 imn=ni/(nr*nr+ni*ni)
5059 n=int(0.5d+00*(-1.d+00+dsqrt(1.d+00+4.d+00*x*x)))+1
5064 up=2.d+00*x/(2.d+00*np+1.d+00)
5065 mu1=int(np+30.*(0.10+0.35*up*(2-up*up)/2./(1-up)))
5066 np=int(x-0.5d+00+dsqrt(30.*0.35*x))
5068 up=2.d+00*x/(2.d+00*np+1.d+00)
5069 mu2=int(np+30.*(0.10+0.35*up*(2-up*up)/2./(1-up)))
5082 rn(k-1)=x/(2.d+00*k+1.d+00-x*rn(k))
5089 if (rn(k-1).gt.1.d+00)
then
5099 xj(k-1)=(2.d+00*k+1.d+00)*xj(k)/x-xj(k+1)
5101 coxj=(xj(0)-x*xj(1))*dcos(x)+x*xj(0)*sin(x)
5109 rdnx(k-1)=k/x-1.d+00/(rdnx(k)+k/x)
5110 xnumrdny=rdny(k)+ren*k/x
5111 xnumidny=idny(k)+imn*k/x
5112 xdendny=xnumrdny*xnumrdny+xnumidny*xnumidny
5113 rdny(k-1)=k*ren/x-xnumrdny/xdendny
5114 idny(k-1)=k*imn/x+xnumidny/xdendny
5129 xj(k)=rn(k-1)*xj(k-1)
5133 xy(k)=(2.d+00*k-1.d+00)*xy(k-1)/x-xy(k-2)
5134 xjonh=xj(k)/(xj(k)*xj(k)+xy(k)*xy(k))
5137 xdengnx=(rgnx(k-1)-k/x)**2.d+00+ignx(k-1)*ignx(k-1)
5138 rgnx(k)=(k/x-rgnx(k-1))/xdengnx-k/x
5139 ignx(k)=ignx(k-1)/xdengnx
5142 xnum1an=rdny(k)-nr*rdnx(k)
5143 xnum2an=idny(k)+ni*rdnx(k)
5144 xden1an=rdny(k)-nr*rgnx(k)-ni*ignx(k)
5145 xden2an=idny(k)+ni*rgnx(k)-nr*ignx(k)
5146 xdenan=xden1an*xden1an+xden2an*xden2an
5147 ranb=(xnum1an*xden1an+xnum2an*xden2an)/xdenan
5148 ianb=(-xnum1an*xden2an+xnum2an*xden1an)/xdenan
5149 ran(k)=xjonh*(xj(k)*ranb-xy(k)*ianb)
5150 ian(k)=xjonh*(xy(k)*ranb+xj(k)*ianb)
5152 xnum1bn=nr*rdny(k)+ni*idny(k)-rdnx(k)
5153 xnum2bn=nr*idny(k)-ni*rdny(k)
5154 xden1bn=nr*rdny(k)+ni*idny(k)-rgnx(k)
5155 xden2bn=nr*idny(k)-ni*rdny(k)-ignx(k)
5156 xdenbn=xden1bn*xden1bn+xden2bn*xden2bn
5157 rbnb=(xnum1bn*xden1bn+xnum2bn*xden2bn)/xdenbn
5158 ibnb=(-xnum1bn*xden2bn+xnum2bn*xden1bn)/xdenbn
5159 rbn(k)=xjonh*(xj(k)*rbnb-xy(k)*ibnb)
5160 ibn(k)=xjonh*(xy(k)*rbnb+xj(k)*ibnb)
5164 test=(ran(k)**2.+ian(k)**2.+rbn(k)**2.+ibn(k)**2.)/k
5165 if (test.lt.1.0d-14)
then
5170 xpond=2.d+00/x/x*(2.d+00*k+1)
5171 qsca=qsca+xpond*(ran(k)**2.+ian(k)**2.+rbn(k)**2.+ibn(k)**2.)
5172 qext=qext+xpond*(ran(k)+rbn(k))
5190 co_n=(2.d+00*k+1.d+00)/k/(k+1.d+00)
5191 rs1=rs1+co_n*(ran(k)*pin(k)+rbn(k)*taun(k))
5192 rs2=rs2+co_n*(ran(k)*taun(k)+rbn(k)*pin(k))
5193 is1=is1+co_n*(ian(k)*pin(k)+ibn(k)*taun(k))
5194 is2=is2+co_n*(ian(k)*taun(k)+ibn(k)*pin(k))
5195 pin(k+1)=((2.d+00*k+1)*xmud*pin(k)-(k+1.d+00)*pin(k-1))/k
5196 taun(k+1)=(k+1.d+00)*xmud*pin(k+1)-(k+2.d+00)*pin(k)
5199 p11(j)=2.d+00*(rs1*rs1+is1*is1+rs2*rs2+is2*is2)/x/x
5204 block data aeroso_data
5205 common /sixs_sos/phasel(10,83),cgaus(83),pdgs(83)
5206 real phasel,cgaus,pdgs
5208 a-1.0000,-0.9996,-0.9976,-0.9942,-0.9893,-0.9828,-0.9749,-0.9655,
5209 a-0.9546,-0.9422,-0.9285,-0.9133,-0.8967,-0.8787,-0.8594,-0.8388,
5210 a-0.8170,-0.7938,-0.7695,-0.7440,-0.7174,-0.6896,-0.6609,-0.6311,
5211 a-0.6003,-0.5687,-0.5361,-0.5028,-0.4687,-0.4339,-0.3984,-0.3623,
5212 a-0.3257,-0.2885,-0.2510,-0.2130,-0.1747,-0.1362,-0.0974,-0.0585,
5213 a-0.0195, 0.0000, 0.0195, 0.0585, 0.0974, 0.1362, 0.1747, 0.2130,
5214 a 0.2510, 0.2885, 0.3257, 0.3623, 0.3984, 0.4339, 0.4687, 0.5028,
5215 a 0.5361, 0.5687, 0.6003, 0.6311, 0.6609, 0.6896, 0.7174, 0.7440,
5216 a 0.7695, 0.7938, 0.8170, 0.8388, 0.8594, 0.8787, 0.8967, 0.9133,
5217 a 0.9285, 0.9422, 0.9546, 0.9655, 0.9749, 0.9828, 0.9893, 0.9942,
5218 a 0.9976, 0.9996, 1.0000/
5220 a 0.0000, 0.0114, 0.0266, 0.0418, 0.0569, 0.0719, 0.0868, 0.1016,
5221 a 0.1162, 0.1307, 0.1449, 0.1590, 0.1727, 0.1863, 0.1995, 0.2124,
5222 a 0.2251, 0.2373, 0.2492, 0.2606, 0.2719, 0.2826, 0.2929, 0.3027,
5223 a 0.3121, 0.3210, 0.3294, 0.3373, 0.3447, 0.3516, 0.3579, 0.3637,
5224 a 0.3690, 0.3737, 0.3778, 0.3813, 0.3842, 0.3866, 0.3884, 0.3896,
5225 a 0.3902, 0.0000, 0.3902, 0.3896, 0.3884, 0.3866, 0.3842, 0.3813,
5226 a 0.3778, 0.3737, 0.3690, 0.3637, 0.3579, 0.3516, 0.3447, 0.3373,
5227 a 0.3294, 0.3210, 0.3121, 0.3027, 0.2929, 0.2826, 0.2719, 0.2606,
5228 a 0.2492, 0.2373, 0.2251, 0.2124, 0.1995, 0.1863, 0.1727, 0.1590,
5229 a 0.1449, 0.1307, 0.1162, 0.1016, 0.0868, 0.0719, 0.0569, 0.0418,
5230 a 0.0266, 0.0114, 0.0000/
5233 common /sixs_aerbas/ ph(10,83)
5239 DATA ((phr(i,j),j=1,83),i=01,01) /
5240 *0.7855e+00,0.6283e+00,0.5465e+00,0.4693e+00,0.4153e+00,0.3917e+00,
5241 *0.3657e+00,0.3378e+00,0.3161e+00,0.3025e+00,0.2972e+00,0.2990e+00,
5242 *0.3055e+00,0.3118e+00,0.3059e+00,0.2715e+00,0.2118e+00,0.1585e+00,
5243 *0.1230e+00,0.9913e-01,0.8327e-01,0.7292e-01,0.6585e-01,0.6171e-01,
5244 *0.5883e-01,0.5780e-01,0.5791e-01,0.5893e-01,0.6144e-01,0.6406e-01,
5245 *0.6717e-01,0.6966e-01,0.7130e-01,0.7291e-01,0.7434e-01,0.7626e-01,
5246 *0.7847e-01,0.8190e-01,0.8583e-01,0.9044e-01,0.9709e-01,0.1006e+00,
5247 *0.1045e+00,0.1128e+00,0.1239e+00,0.1360e+00,0.1497e+00,0.1667e+00,
5248 *0.1856e+00,0.2070e+00,0.2323e+00,0.2615e+00,0.2948e+00,0.3326e+00,
5249 *0.3772e+00,0.4263e+00,0.4840e+00,0.5492e+00,0.6242e+00,0.7103e+00,
5250 *0.8075e+00,0.9192e+00,0.1046e+01,0.1190e+01,0.1354e+01,0.1541e+01,
5251 *0.1756e+01,0.2002e+01,0.2277e+01,0.2603e+01,0.2976e+01,0.3416e+01,
5252 *0.3931e+01,0.4563e+01,0.5372e+01,0.6490e+01,0.8191e+01,0.1111e+02,
5253 *0.1692e+02,0.3097e+02,0.7524e+02,0.2992e+03,0.1697e+04/
5254 DATA ((phr(i,j),j=1,83),i=02,02) /
5255 *0.7129e+00,0.5739e+00,0.5059e+00,0.4429e+00,0.4035e+00,0.3898e+00,
5256 *0.3678e+00,0.3416e+00,0.3195e+00,0.3042e+00,0.2975e+00,0.2961e+00,
5257 *0.2987e+00,0.2994e+00,0.2909e+00,0.2614e+00,0.2134e+00,0.1670e+00,
5258 *0.1336e+00,0.1100e+00,0.9363e-01,0.8252e-01,0.7480e-01,0.6967e-01,
5259 *0.6621e-01,0.6499e-01,0.6438e-01,0.6506e-01,0.6656e-01,0.6880e-01,
5260 *0.7108e-01,0.7332e-01,0.7497e-01,0.7681e-01,0.7860e-01,0.8093e-01,
5261 *0.8357e-01,0.8723e-01,0.9184e-01,0.9665e-01,0.1036e+00,0.1075e+00,
5262 *0.1112e+00,0.1200e+00,0.1316e+00,0.1436e+00,0.1580e+00,0.1748e+00,
5263 *0.1937e+00,0.2154e+00,0.2413e+00,0.2704e+00,0.3031e+00,0.3421e+00,
5264 *0.3856e+00,0.4356e+00,0.4928e+00,0.5586e+00,0.6333e+00,0.7196e+00,
5265 *0.8188e+00,0.9313e+00,0.1060e+01,0.1208e+01,0.1375e+01,0.1568e+01,
5266 *0.1791e+01,0.2047e+01,0.2340e+01,0.2679e+01,0.3075e+01,0.3547e+01,
5267 *0.4107e+01,0.4805e+01,0.5714e+01,0.6981e+01,0.8889e+01,0.1212e+02,
5268 *0.1839e+02,0.3283e+02,0.7515e+02,0.2626e+03,0.1134e+04/
5269 DATA ((phr(i,j),j=1,83),i=03,03) /
5270 *0.6966e+00,0.5607e+00,0.4902e+00,0.4336e+00,0.3978e+00,0.3866e+00,
5271 *0.3674e+00,0.3412e+00,0.3187e+00,0.3039e+00,0.2960e+00,0.2945e+00,
5272 *0.2960e+00,0.2961e+00,0.2874e+00,0.2591e+00,0.2133e+00,0.1692e+00,
5273 *0.1362e+00,0.1129e+00,0.9630e-01,0.8484e-01,0.7707e-01,0.7190e-01,
5274 *0.6854e-01,0.6653e-01,0.6597e-01,0.6668e-01,0.6812e-01,0.7009e-01,
5275 *0.7216e-01,0.7425e-01,0.7580e-01,0.7758e-01,0.7959e-01,0.8174e-01,
5276 *0.8490e-01,0.8852e-01,0.9294e-01,0.9864e-01,0.1048e+00,0.1084e+00,
5277 *0.1128e+00,0.1220e+00,0.1325e+00,0.1453e+00,0.1596e+00,0.1762e+00,
5278 *0.1959e+00,0.2177e+00,0.2428e+00,0.2725e+00,0.3055e+00,0.3440e+00,
5279 *0.3882e+00,0.4382e+00,0.4953e+00,0.5613e+00,0.6365e+00,0.7225e+00,
5280 *0.8218e+00,0.9344e+00,0.1065e+01,0.1212e+01,0.1381e+01,0.1577e+01,
5281 *0.1801e+01,0.2059e+01,0.2360e+01,0.2701e+01,0.3107e+01,0.3586e+01,
5282 *0.4166e+01,0.4885e+01,0.5821e+01,0.7115e+01,0.9088e+01,0.1241e+02,
5283 *0.1877e+02,0.3323e+02,0.7480e+02,0.2523e+03,0.1018e+04/
5284 DATA ((phr(i,j),j=1,83),i=04,04) /
5285 *0.6774e+00,0.5476e+00,0.4775e+00,0.4252e+00,0.3937e+00,0.3855e+00,
5286 *0.3684e+00,0.3432e+00,0.3209e+00,0.3059e+00,0.2974e+00,0.2950e+00,
5287 *0.2951e+00,0.2935e+00,0.2832e+00,0.2550e+00,0.2114e+00,0.1697e+00,
5288 *0.1380e+00,0.1153e+00,0.9882e-01,0.8737e-01,0.7952e-01,0.7423e-01,
5289 *0.7074e-01,0.6859e-01,0.6788e-01,0.6842e-01,0.6969e-01,0.7150e-01,
5290 *0.7349e-01,0.7557e-01,0.7720e-01,0.7911e-01,0.8125e-01,0.8356e-01,
5291 *0.8685e-01,0.9062e-01,0.9516e-01,0.1010e+00,0.1073e+00,0.1109e+00,
5292 *0.1154e+00,0.1247e+00,0.1352e+00,0.1482e+00,0.1626e+00,0.1793e+00,
5293 *0.1991e+00,0.2210e+00,0.2462e+00,0.2760e+00,0.3091e+00,0.3477e+00,
5294 *0.3920e+00,0.4422e+00,0.4994e+00,0.5656e+00,0.6410e+00,0.7275e+00,
5295 *0.8272e+00,0.9405e+00,0.1071e+01,0.1220e+01,0.1391e+01,0.1588e+01,
5296 *0.1815e+01,0.2077e+01,0.2382e+01,0.2731e+01,0.3145e+01,0.3636e+01,
5297 *0.4233e+01,0.4974e+01,0.5942e+01,0.7282e+01,0.9319e+01,0.1273e+02,
5298 *0.1919e+02,0.3364e+02,0.7414e+02,0.2397e+03,0.8914e+03/
5299 DATA ((phr(i,j),j=1,83),i=05,05) /
5300 *0.6153e+00,0.5058e+00,0.4382e+00,0.3950e+00,0.3738e+00,0.3731e+00,
5301 *0.3585e+00,0.3354e+00,0.3139e+00,0.2983e+00,0.2892e+00,0.2849e+00,
5302 *0.2832e+00,0.2800e+00,0.2703e+00,0.2469e+00,0.2112e+00,0.1741e+00,
5303 *0.1442e+00,0.1219e+00,0.1054e+00,0.9356e-01,0.8531e-01,0.7966e-01,
5304 *0.7561e-01,0.7323e-01,0.7198e-01,0.7214e-01,0.7291e-01,0.7415e-01,
5305 *0.7601e-01,0.7747e-01,0.7901e-01,0.8091e-01,0.8293e-01,0.8564e-01,
5306 *0.8906e-01,0.9289e-01,0.9788e-01,0.1033e+00,0.1102e+00,0.1141e+00,
5307 *0.1181e+00,0.1275e+00,0.1385e+00,0.1511e+00,0.1660e+00,0.1823e+00,
5308 *0.2018e+00,0.2241e+00,0.2491e+00,0.2784e+00,0.3123e+00,0.3503e+00,
5309 *0.3942e+00,0.4451e+00,0.5020e+00,0.5684e+00,0.6448e+00,0.7319e+00,
5310 *0.8325e+00,0.9481e+00,0.1081e+01,0.1234e+01,0.1409e+01,0.1612e+01,
5311 *0.1846e+01,0.2118e+01,0.2440e+01,0.2809e+01,0.3249e+01,0.3773e+01,
5312 *0.4413e+01,0.5211e+01,0.6259e+01,0.7710e+01,0.9888e+01,0.1347e+02,
5313 *0.2009e+02,0.3435e+02,0.7217e+02,0.2130e+03,0.6728e+03/
5314 DATA ((phr(i,j),j=1,83),i=06,06) /
5315 *0.5916e+00,0.4877e+00,0.4171e+00,0.3786e+00,0.3632e+00,0.3654e+00,
5316 *0.3546e+00,0.3335e+00,0.3124e+00,0.2967e+00,0.2869e+00,0.2822e+00,
5317 *0.2792e+00,0.2744e+00,0.2635e+00,0.2413e+00,0.2085e+00,0.1740e+00,
5318 *0.1459e+00,0.1244e+00,0.1084e+00,0.9682e-01,0.8822e-01,0.8243e-01,
5319 *0.7835e-01,0.7606e-01,0.7463e-01,0.7441e-01,0.7473e-01,0.7609e-01,
5320 *0.7739e-01,0.7905e-01,0.8078e-01,0.8256e-01,0.8474e-01,0.8745e-01,
5321 *0.9082e-01,0.9490e-01,0.9996e-01,0.1057e+00,0.1127e+00,0.1166e+00,
5322 *0.1207e+00,0.1301e+00,0.1412e+00,0.1539e+00,0.1686e+00,0.1858e+00,
5323 *0.2048e+00,0.2270e+00,0.2528e+00,0.2818e+00,0.3154e+00,0.3545e+00,
5324 *0.3980e+00,0.4487e+00,0.5067e+00,0.5728e+00,0.6491e+00,0.7374e+00,
5325 *0.8386e+00,0.9547e+00,0.1090e+01,0.1244e+01,0.1423e+01,0.1630e+01,
5326 *0.1870e+01,0.2149e+01,0.2477e+01,0.2862e+01,0.3316e+01,0.3862e+01,
5327 *0.4527e+01,0.5365e+01,0.6458e+01,0.7974e+01,0.1023e+02,0.1390e+02,
5328 *0.2058e+02,0.3459e+02,0.7042e+02,0.1961e+03,0.5608e+03/
5329 DATA ((phr(i,j),j=1,83),i=07,07) /
5330 *0.5164e+00,0.4330e+00,0.3650e+00,0.3341e+00,0.3313e+00,0.3413e+00,
5331 *0.3356e+00,0.3182e+00,0.2998e+00,0.2844e+00,0.2744e+00,0.2677e+00,
5332 *0.2626e+00,0.2560e+00,0.2453e+00,0.2267e+00,0.2009e+00,0.1730e+00,
5333 *0.1485e+00,0.1291e+00,0.1141e+00,0.1028e+00,0.9425e-01,0.8828e-01,
5334 *0.8375e-01,0.8105e-01,0.7927e-01,0.7843e-01,0.7860e-01,0.7925e-01,
5335 *0.8010e-01,0.8165e-01,0.8331e-01,0.8499e-01,0.8754e-01,0.9034e-01,
5336 *0.9390e-01,0.9825e-01,0.1034e+00,0.1093e+00,0.1164e+00,0.1203e+00,
5337 *0.1246e+00,0.1342e+00,0.1452e+00,0.1582e+00,0.1728e+00,0.1896e+00,
5338 *0.2094e+00,0.2310e+00,0.2569e+00,0.2863e+00,0.3195e+00,0.3587e+00,
5339 *0.4030e+00,0.4534e+00,0.5122e+00,0.5794e+00,0.6565e+00,0.7463e+00,
5340 *0.8505e+00,0.9697e+00,0.1109e+01,0.1270e+01,0.1457e+01,0.1674e+01,
5341 *0.1929e+01,0.2226e+01,0.2578e+01,0.2997e+01,0.3495e+01,0.4096e+01,
5342 *0.4831e+01,0.5758e+01,0.6967e+01,0.8629e+01,0.1105e+02,0.1487e+02,
5343 *0.2152e+02,0.3465e+02,0.6548e+02,0.1595e+03,0.3700e+03/
5344 DATA ((phr(i,j),j=1,83),i=08,08) /
5345 *0.3257e+00,0.2888e+00,0.2378e+00,0.2215e+00,0.2345e+00,0.2532e+00,
5346 *0.2578e+00,0.2504e+00,0.2390e+00,0.2282e+00,0.2194e+00,0.2123e+00,
5347 *0.2059e+00,0.1991e+00,0.1906e+00,0.1797e+00,0.1665e+00,0.1520e+00,
5348 *0.1379e+00,0.1254e+00,0.1147e+00,0.1061e+00,0.9917e-01,0.9373e-01,
5349 *0.8960e-01,0.8656e-01,0.8438e-01,0.8306e-01,0.8243e-01,0.8240e-01,
5350 *0.8294e-01,0.8394e-01,0.8543e-01,0.8740e-01,0.8990e-01,0.9302e-01,
5351 *0.9681e-01,0.1013e+00,0.1067e+00,0.1129e+00,0.1200e+00,0.1240e+00,
5352 *0.1283e+00,0.1379e+00,0.1490e+00,0.1618e+00,0.1764e+00,0.1932e+00,
5353 *0.2124e+00,0.2345e+00,0.2599e+00,0.2892e+00,0.3231e+00,0.3622e+00,
5354 *0.4072e+00,0.4593e+00,0.5195e+00,0.5895e+00,0.6711e+00,0.7664e+00,
5355 *0.8781e+00,0.1009e+01,0.1163e+01,0.1343e+01,0.1556e+01,0.1808e+01,
5356 *0.2107e+01,0.2464e+01,0.2891e+01,0.3405e+01,0.4025e+01,0.4779e+01,
5357 *0.5707e+01,0.6863e+01,0.8338e+01,0.1027e+02,0.1291e+02,0.1670e+02,
5358 *0.2248e+02,0.3211e+02,0.5001e+02,0.8772e+02,0.1334e+03/
5359 DATA ((phr(i,j),j=1,83),i=09,09) /
5360 *0.2139e+00,0.1949e+00,0.1618e+00,0.1541e+00,0.1685e+00,0.1828e+00,
5361 *0.1856e+00,0.1800e+00,0.1718e+00,0.1642e+00,0.1581e+00,0.1534e+00,
5362 *0.1495e+00,0.1460e+00,0.1421e+00,0.1375e+00,0.1318e+00,0.1252e+00,
5363 *0.1178e+00,0.1105e+00,0.1036e+00,0.9754e-01,0.9237e-01,0.8811e-01,
5364 *0.8468e-01,0.8198e-01,0.7994e-01,0.7852e-01,0.7768e-01,0.7741e-01,
5365 *0.7767e-01,0.7843e-01,0.7969e-01,0.8144e-01,0.8373e-01,0.8662e-01,
5366 *0.9014e-01,0.9438e-01,0.9939e-01,0.1052e+00,0.1120e+00,0.1158e+00,
5367 *0.1198e+00,0.1289e+00,0.1394e+00,0.1514e+00,0.1653e+00,0.1813e+00,
5368 *0.1997e+00,0.2208e+00,0.2453e+00,0.2736e+00,0.3064e+00,0.3444e+00,
5369 *0.3886e+00,0.4400e+00,0.5000e+00,0.5703e+00,0.6528e+00,0.7502e+00,
5370 *0.8652e+00,0.1001e+01,0.1163e+01,0.1355e+01,0.1584e+01,0.1859e+01,
5371 *0.2188e+01,0.2586e+01,0.3067e+01,0.3649e+01,0.4358e+01,0.5222e+01,
5372 *0.6282e+01,0.7594e+01,0.9235e+01,0.1132e+02,0.1404e+02,0.1768e+02,
5373 *0.2278e+02,0.3033e+02,0.4233e+02,0.6237e+02,0.7953e+02/
5374 DATA ((phr(i,j),j=1,83),i=10,10) /
5375 *0.2110e+00,0.2025e+00,0.1832e+00,0.1730e+00,0.1773e+00,0.1912e+00,
5376 *0.2055e+00,0.2138e+00,0.2152e+00,0.2113e+00,0.2040e+00,0.1946e+00,
5377 *0.1842e+00,0.1734e+00,0.1627e+00,0.1524e+00,0.1429e+00,0.1344e+00,
5378 *0.1268e+00,0.1203e+00,0.1149e+00,0.1104e+00,0.1068e+00,0.1040e+00,
5379 *0.1019e+00,0.1006e+00,0.9982e-01,0.9972e-01,0.1003e+00,0.1014e+00,
5380 *0.1031e+00,0.1054e+00,0.1084e+00,0.1119e+00,0.1162e+00,0.1212e+00,
5381 *0.1271e+00,0.1338e+00,0.1415e+00,0.1503e+00,0.1603e+00,0.1658e+00,
5382 *0.1717e+00,0.1847e+00,0.1995e+00,0.2163e+00,0.2354e+00,0.2571e+00,
5383 *0.2818e+00,0.3100e+00,0.3422e+00,0.3792e+00,0.4216e+00,0.4702e+00,
5384 *0.5261e+00,0.5903e+00,0.6644e+00,0.7500e+00,0.8493e+00,0.9645e+00,
5385 *0.1098e+01,0.1254e+01,0.1436e+01,0.1649e+01,0.1897e+01,0.2189e+01,
5386 *0.2531e+01,0.2934e+01,0.3408e+01,0.3968e+01,0.4630e+01,0.5415e+01,
5387 *0.6348e+01,0.7463e+01,0.8805e+01,0.1044e+02,0.1244e+02,0.1495e+02,
5388 *0.1816e+02,0.2237e+02,0.2799e+02,0.3517e+02,0.3934e+02/
5395 subroutine oda550 (iaer,v,
5398 double precision bnz,bnz1
5399 common /sixs_atm/ z(34),p(34),t(34),wh(34),wo(34)
5400 common /sixs_del/ delta,sigma
5401 real an5(34),an23(34)
5402 Real v,taer55,z,p,t,wh
5403 Real wo,delta,sigma,dz,bn5,bn51,bn23,bn231,az
5410 data an23 /2.828e+03,1.244e+03,5.371e+02,2.256e+02,1.192e+02
5411 a,8.987e+01,6.337e+01,5.890e+01,6.069e+01,5.818e+01,5.675e+01
5412 a,5.317e+01,5.585e+01,5.156e+01,5.048e+01,4.744e+01,4.511e+01
5413 a,4.458e+01,4.314e+01,3.634e+01,2.667e+01,1.933e+01,1.455e+01
5414 a,1.113e+01,8.826e+00,7.429e+00,2.238e+00,5.890e-01,1.550e-01
5415 a,4.082e-02,1.078e-02,5.550e-05,1.969e-08,0.000e+00/
5420 data an5 /1.378e+04,5.030e+03,1.844e+03,6.731e+02,2.453e+02
5421 a,8.987e+01,6.337e+01,5.890e+01,6.069e+01,5.818e+01,5.675e+01
5422 a,5.317e+01,5.585e+01,5.156e+01,5.048e+01,4.744e+01,4.511e+01
5423 a,4.458e+01,4.314e+01,3.634e+01,2.667e+01,1.933e+01,1.455e+01
5424 a,1.113e+01,8.826e+00,7.429e+00,2.238e+00,5.890e-01,1.550e-01
5425 a,4.082e-02,1.078e-02,5.550e-05,1.969e-08,0.000e+00/
5430 if(
abs(v).le.0.)
return
5431 if(iaer.eq.0)
return
5439 az=(115./18.)*(bn5-bn23)
5440 az1=(115./18.)*(bn51-bn231)
5441 bz=(5.*bn5/18.)-(23.*bn23/18.)
5442 bz1=(5.*bn51/18.)-(23.*bn231/18.)
5445 ev=dz*exp((dlog(bnz)+dlog(bnz1))*.5)
5446 taer55=taer55+ev*sigma*1.0e-03
5452 double precision a1,a2,a3,a4,awl,an,a
5453 real wl,tray,z,p,t,wh,wo,delta,sigma,pi,ak,dppt,sr
5457 common /sixs_atm/ z(34),p(34),t(34),wh(34),wo(34)
5458 common /sixs_del/ delta,sigma
5468 an=(8342.13+a3+a4)*1.0e-08
5470 a=(24.*pi**3)*((an*an-1.)**2)*(6.+3.*delta)/(6.-7.*delta)
5475 dppt=(288.15/1013.25)*(p(k)/t(k)+p(k+1)/t(k+1))/2.
5476 sr=(a*dppt/(awl**4)/ns*1.e+16)*1.e+05
5477 tray=tray+(z(k+1)-z(k))*sr
5481 subroutine os (tamoy,trmoy,pizmoy,tamoyp,trmoyp,palt,
5482 s phirad,nt,mu,np,rm,gb,rp,
5486 real rm(-mu:mu),gb(-mu:mu),rp(np)
5490 real xpl(-25:25),psl(-1:80,-25:25),bp(0:25,-25:25),
5491 s xdel(0:30),ydel(0:30),ch(0:30),h(0:30)
5492 real i1(0:30,-25:25),i2(0:30,-25:25),i3(-25:25),
5493 s i4(-25:25),in(-25:25),inm1(-25:25),inm2(-25:25)
5495 Real tamoy,trmoy,pizmoy
5496 Real tamoyp,trmoyp,palt,phirad
5497 Real delta,sigma,pha,betal,hr,ta,tr,trp
5498 Real tap,piz,accu,accu2,ha,xmus,zx,yy,dd,ppp2,ppp1,ca,cr,ratio
5499 Real taup,th,xt1,xt2,pi,phi,aaaa,ron
5500 Real beta0,beta2,roavion0,roavion1,roavion2,roavion,spl,sa1
5501 Real sa2,c,zi1,f,d,xpk,y
5502 Real a1,d1,g1,y1,delta0s
5504 integer nt,iwr,iplane,mum1,ntp,j,it,itp,i,l,m,iborm
5505 integer is,isp,ig,k,jj,index
5507 common/sixs_del/delta,sigma
5508 common /sixs_trunc/pha(83),betal(0:80)
5509 common/sixs_ier/iwr,ier
5510 double precision xx,xdb,bpjk,bpjmk,z,xi1,xi2,x,xpj,ypk,a,b,ii1,ii2
5546 if(palt.le.900..and.palt.gt.0.0)
then
5547 if (tap.gt.1.e-03)
then
5548 ha=-palt/log(tap/ta)
5565 if((ta.le.accu2).and.(tr.gt.ta))
then
5568 ch(j)=exp(-h(j)/xmus)/2.
5574 altc(j)=-log(h(j)/tr)*hr
5578 if((tr.le.accu2).and.(ta.gt.tr))
then
5581 ch(j)=exp(-h(j)/xmus)/2.
5587 altc(j)=-log(h(j)/ta)*ha
5592 if(tr.gt.accu2.and.ta.gt.accu2)
then
5611 call discre(ta,ha,tr,hr,itp,ntp,yy,dd,ppp2,ppp1,
5624 ch(it)=exp(-h(it)/xmus)/2.
5628 xdel(it)=(1.e+00-ratio)*piz
5634 if (ntp.eq.(nt-1))
then
5639 if (taup.ge.h(i)) iplane=i
5643 xt1=
abs(h(iplane)-taup)
5644 xt2=
abs(h(iplane+1)-taup)
5645 if ((xt1.gt.th).and.(xt2.gt.th))
then
5655 if (xt2.lt.xt1) iplane=iplane+1
5658 if ( tr.gt.accu2.and.ta.gt.accu2)
then
5665 xdel(iplane)=(1.e+00-ratio)*piz
5668 ch(iplane)=exp(-h(iplane)/xmus)/2.
5670 if ( tr.gt.accu2.and.ta.le.accu2)
then
5675 if ( tr.le.accu2.and.ta.gt.accu2)
then
5697 aaaa=delta/(2-delta)
5698 ron=(1-aaaa)/(1+2*aaaa)
5712 if(
abs(xmus-1.000000) .lt.1.e-06)iborm=0
5729 call kernel(isp,mu,rm,xpl,psl,bp)
5734 sa1=beta0+beta2*xpl(j)*spl
5746 i2(k,j)=c*(sa2*b+sa1*a)
5760 a=(i2(jj,k)-i2(i,k))/f
5765 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
5780 a=(i2(i,k)-i2(jj,k))/f
5783 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
5800 roavion2=i1(iplane,mu)
5801 roavion=i1(iplane,mu)
5829 bpjk=bp(j,k)*x+y*(beta0+beta2*xpj*xpk)
5830 bpjmk=bp(j,-k)*x+y*(beta0+beta2*xpj*ypk)
5831 xdb=z*(xi1*bpjk+xi2*bpjmk)
5833 xdb=z*(xi1*bpjmk+xi2*bpjk)
5836 if (ii2.lt.1.e-30) ii2=0.
5837 if (ii1.lt.1.e-30) ii1=0.
5853 xdb=z*(xi1*bpjk+xi2*bpjmk)
5855 xdb=z*(xi1*bpjmk+xi2*bpjk)
5858 if (ii2.lt.1.e-30) ii2=0.
5859 if (ii1.lt.1.e-30) ii1=0.
5873 a=(i2(jj,k)-i2(i,k))/f
5878 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
5879 if (
abs(zi1).le.1.e-20) zi1=0.
5894 a=(i2(i,k)-i2(jj,k))/f
5897 zi1=c*zi1+(d*(b+a*yy)+a*xx)*0.5e+00
5898 if (
abs(zi1).le.1.e-20) zi1=0.
5912 roavion0=i1(iplane,mu)
5921 if(a1.ge.accu.and.d1.ge.accu.and.roavion.ge.accu)
then
5922 y=((g1/d1-d1/a1)/((1-g1/d1)**2)*(g1/roavion))
5931 if(a1.le.accu)
go to 99
5932 if(d1.le.accu)
go to 99
5933 if(i3(l).le.accu)
go to 99
5934 y=((g1/d1-d1/a1)/((1-g1/d1)**2)*(g1/i3(l)))
5938 if(z.lt.0.0001)
then
5946 if(d1.le.accu)
go to 606
5948 if(
abs(g1-d1).le.accu)
then
5958 if(
abs(g1-d1).ge.accu)
then
5987 roavion=roavion+roavion0
5993 if (
abs(i3(l)).ge.accu)
then
5998 if(z.lt.0.00001)
go to 505
6002 if(ig-20) 503,503,505
6008 if(is.ne.0) delta0s=2
6010 i4(l)=i4(l)+delta0s*i3(l)
6019 xl(m,l)=xl(m,l)+delta0s*i3(m)*cos(is*(phi+pi))
6021 xl(m,l)=xl(m,l)+delta0s*i3(m)*cos(is*phi)
6026 xl(0,1)=xl(0,1)+rm(k)*gb(k)*i3(-k)
6029 xl(mu,1)=xl(mu,1)+delta0s*i3(mu)*cos(is*(phirad+pi))
6030 xl(-mu,1)=xl(-mu,1)+delta0s*roavion*cos(is*(phirad+pi))
6033 if (
abs(i4(l)).lt.accu)
goto 613
6037 if(z.gt.0.001)
go to 24
6045 subroutine possol (month,jday,tu,xlon,xlat,
6048 real tu,xlon,xlat,asol,phi0
6049 integer month,jday,ia,nojour
6058 call pos_fft (nojour, tu, xlon, xlat, asol, phi0)
6061 s
'The sun is not raised')
6066 integer jday, month, ia, j
6068 if (month.le.2)
then
6072 if (month.gt.8)
then
6073 j=31*(month-1)-((month-2)/2)-2+jday
6075 j=31*(month-1)-((month-1)/2)-2+jday
6077 if(ia.ne.0 .and. mod(ia,4).eq.0) j=j+1
6081 subroutine pos_fft (j,tu,xlon,xlat,asol,phi0)
6082 real tu, xlat, asol,phi0, tsm, xlon,xla, xj, tet,
6083 a a1, a2, a3, a4, a5, et, tsv, ah, b1, b2, b3, b4,
6084 a b5, b6, b7, delta, amuzero, elev, az, caz, azim, pi2
6086 parameter (pi=3.14159265,
fac=pi/180.)
6104 et=a1+a2*cos(tet)-a3*sin(tet)-a4*cos(2.*tet)-a5*sin(2.*tet)
6125 delta=b1-b2*cos(tet)+b3*sin(tet)-b4*cos(2.*tet)+b5*sin(2.*tet)-
6126 &b6*cos(3.*tet)+b7*sin(3.*tet)
6130 amuzero=sin(xla)*sin(delta)+cos(xla)*cos(delta)*cos(ah)
6132 az=cos(delta)*sin(ah)/cos(elev)
6133 if ( (
abs(az)-1.000).gt.0.00000) az =
sign(1.,az)
6134 caz=(-cos(xla)*sin(delta)+sin(xla)*cos(delta)*cos(ah))/cos(elev)
6136 if(caz.le.0.) azim=pi-azim
6137 if(caz.gt.0.and.az.le.0) azim=2*pi+azim
6140 if(azim.gt.pi2) azim=azim-pi2
6150 real z,p,t,wh,wo,zpl,ppl,tpl,whpl,wopl,xa,xb,xalt
6151 real xtemp,xwo,xwh,g,air,ro3,rt,rp,roair,ds
6152 integer i,isup,iinf,k
6153 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
6154 common /sixs_planesim/zpl(34),ppl(34),tpl(34),whpl(34),wopl(34)
6155 real rmo3(34),rmwh(34)
6156 real ps,xpp,uo3,uw,ftray
6174 if (xpp.ge.100.) xpp=1000.
6177 if (z(i).le.xpp)
goto 10
6180 xa=(z(isup)-z(iinf))/alog(p(isup)/p(iinf))
6181 xb=z(isup)-xa*alog(p(isup))
6185 xtemp=(t(isup)-t(iinf))/(z(isup)-z(iinf))
6186 xtemp=xtemp*(xalt-z(iinf))+t(iinf)
6187 xwo=(wo(isup)-wo(iinf))/(z(isup)-z(iinf))
6188 xwo=xwo*(xalt-z(iinf))+wo(iinf)
6189 xwh=(wh(isup)-wh(iinf))/(z(isup)-z(iinf))
6190 xwh=xwh*(xalt-z(iinf))+wh(iinf)
6210 whpl(i)=whpl(iinf+1)
6211 wopl(i)=wopl(iinf+1)
6224 roair=air*273.16*ppl(k)/(1013.25*tpl(k))
6225 rmwh(k)=wh(k)/(roair*1000.)
6226 rmo3(k)=wo(k)/(roair*1000.)
6227 rt=rt+(p(k+1)/t(k+1)+p(k)/t(k))*(z(k+1)-z(k))
6228 rp=rp+(ppl(k+1)/tpl(k+1)+ppl(k)/tpl(k))*(zpl(k+1)-zpl(k))
6232 ds=(ppl(k-1)-ppl(k))/ppl(1)
6233 uw=uw+((rmwh(k)+rmwh(k-1))/2.)*ds
6234 uo3=uo3+((rmo3(k)+rmo3(k-1))/2.)*ds
6237 uo3=uo3*ppl(1)*100./g
6248 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
6249 real z,p,t,wh,wo,xa,xb,xalt,xtemp,xwo,xwh,g
6250 real air,ro3,roair,ds
6251 integer i,isup,iinf,l,k
6252 real rmo3(34),rmwh(34)
6256 if (xps.ge.100.) xps=99.99
6259 if (z(i).le.xps)
goto 10
6262 xa=(z(isup)-z(iinf))/alog(p(isup)/p(iinf))
6263 xb=z(isup)-xa*alog(p(isup))
6267 xtemp=(t(isup)-t(iinf))/(z(isup)-z(iinf))
6268 xtemp=xtemp*(xalt-z(iinf))+t(iinf)
6269 xwo=(wo(isup)-wo(iinf))/(z(isup)-z(iinf))
6270 xwo=xwo*(xalt-z(iinf))+wo(iinf)
6271 xwh=(wh(isup)-wh(iinf))/(z(isup)-z(iinf))
6272 xwh=xwh*(xalt-z(iinf))+wh(iinf)
6290 z(i)=(z(34)-z(l))*(i-l)/(34-l)+z(l)
6291 p(i)=(p(34)-p(l))*(i-l)/(34-l)+p(l)
6292 t(i)=(t(34)-t(l))*(i-l)/(34-l)+t(l)
6293 wh(i)=(wh(34)-wh(l))*(i-l)/(34-l)+wh(l)
6294 wo(i)=(wo(34)-wo(l))*(i-l)/(34-l)+wo(l)
6303 roair=air*273.16*p(k)/(1013.25*t(k))
6304 rmwh(k)=wh(k)/(roair*1000.)
6305 rmo3(k)=wo(k)/(roair*1000.)
6308 ds=(p(k-1)-p(k))/p(1)
6309 uw=uw+((rmwh(k)+rmwh(k-1))/2.)*ds
6310 uo3=uo3+((rmo3(k)+rmo3(k-1))/2.)*ds
6321 common/sixs_ier/iwr,ier
6326 subroutine scatra (taer,taerp,tray,trayp,piza,
6327 a palt,nt,mu,rm,gb,xmus,xmuv,
6328 a ddirtt,ddiftt,udirtt,udiftt,sphalbt,
6329 a ddirtr,ddiftr,udirtr,udiftr,sphalbr,
6330 a ddirta,ddifta,udirta,udifta,sphalba)
6333 real rm(-mu:mu),gb(-mu:mu)
6337 real taer,taerp,tray,trayp,piza,palt,xmus,xmuv
6338 real udiftt,sphalbt,ddirtr,ddiftr,udirtr,udiftr,sphalbr
6339 real ddirtt,ddiftt,udirtt,ddirta,ddifta,udirta,udifta
6340 real sphalba,tamol,tamolp
6361 if (it.eq.2.and.taer.le.0.)
goto 1
6364 if (palt.gt.900)
then
6365 udiftt=(2./3.+xmuv)+(2./3.-xmuv)*exp(-tray/xmuv)
6366 udiftt=udiftt/((4./3.)+tray)-exp(-tray/xmuv)
6367 ddiftt=(2./3.+xmus)+(2./3.-xmus)*exp(-tray/xmus)
6368 ddiftt=ddiftt/((4./3.)+tray)-exp(-tray/xmus)
6369 ddirtt=exp(-tray/xmus)
6370 udirtt=exp(-tray/xmuv)
6371 call csalbr(tray,sphalbt)
6373 if (palt.lt.900)
then
6379 call iso(tamol,tray,piza,tamolp,trayp,palt,
6380 a nt,mu,rm,gb,xtrans)
6381 udiftt=xtrans(-1)-exp(-trayp/xmuv)
6382 udirtt=exp(-trayp/xmuv)
6386 ddiftt=(2./3.+xmus)+(2./3.-xmus)*exp(-tray/xmus)
6387 ddiftt=ddiftt/((4./3.)+tray)-exp(-tray/xmus)
6388 ddirtt=exp(-tray/xmus)
6389 udirtt=exp(-tray/xmuv)
6390 call csalbr(tray,sphalbt)
6392 if (palt.le.0.)
then
6403 call iso(taer,tamol,piza,taerp,tamolp,palt,
6404 a nt,mu,rm,gb,xtrans)
6405 udiftt=xtrans(-1)-exp(-taerp/xmuv)
6406 udirtt=exp(-taerp/xmuv)
6410 call iso(taer,tamol,piza,taerp,tamolp,999.,
6411 a nt,mu,rm,gb,xtrans)
6412 ddirtt=exp(-taer/xmus)
6413 ddiftt=xtrans(1)-exp(-taer/xmus)
6414 sphalbt=xtrans(0)*2.
6415 if (palt.le.0.)
then
6424 call iso(taer,tray,piza,taerp,trayp,palt,
6425 a nt,mu,rm,gb,xtrans)
6426 udirtt=exp(-(taerp+trayp)/xmuv)
6427 udiftt=xtrans(-1)-exp(-(taerp+trayp)/xmuv)
6431 call iso(taer,tray,piza,taerp,trayp,999.,
6432 a nt,mu,rm,gb,xtrans)
6433 ddiftt=xtrans(1)-exp(-(taer+tray)/xmus)
6434 ddirtt=exp(-(taer+tray)/xmus)
6435 sphalbt=xtrans(0)*2.
6436 if (palt.le.0.)
then
6462 common /sixs_aerbas/ ph(10,83)
6463 dimension phr(10,83)
6467 DATA ((phr(i,j),j=1,83),i=01,01) /
6468 *0.4897e+00,0.4896e+00,0.4890e+00,0.4881e+00,0.4867e+00,0.4849e+00,
6469 *0.4827e+00,0.4802e+00,0.4773e+00,0.4743e+00,0.4709e+00,0.4675e+00,
6470 *0.4638e+00,0.4601e+00,0.4563e+00,0.4526e+00,0.4489e+00,0.4453e+00,
6471 *0.4419e+00,0.4388e+00,0.4359e+00,0.4334e+00,0.4312e+00,0.4296e+00,
6472 *0.4285e+00,0.4281e+00,0.4283e+00,0.4293e+00,0.4312e+00,0.4341e+00,
6473 *0.4380e+00,0.4430e+00,0.4494e+00,0.4571e+00,0.4663e+00,0.4771e+00,
6474 *0.4896e+00,0.5041e+00,0.5206e+00,0.5392e+00,0.5603e+00,0.5717e+00,
6475 *0.5838e+00,0.6101e+00,0.6392e+00,0.6714e+00,0.7069e+00,0.7459e+00,
6476 *0.7886e+00,0.8352e+00,0.8860e+00,0.9411e+00,0.1001e+01,0.1065e+01,
6477 *0.1135e+01,0.1210e+01,0.1290e+01,0.1376e+01,0.1468e+01,0.1566e+01,
6478 *0.1670e+01,0.1781e+01,0.1897e+01,0.2019e+01,0.2148e+01,0.2282e+01,
6479 *0.2421e+01,0.2565e+01,0.2713e+01,0.2865e+01,0.3019e+01,0.3173e+01,
6480 *0.3327e+01,0.3479e+01,0.3625e+01,0.3765e+01,0.3894e+01,0.4011e+01,
6481 *0.4111e+01,0.4192e+01,0.4250e+01,0.4284e+01,0.4292e+01/
6482 DATA ((phr(i,j),j=1,83),i=02,02) /
6483 *0.5620e+00,0.5618e+00,0.5611e+00,0.5599e+00,0.5582e+00,0.5560e+00,
6484 *0.5533e+00,0.5502e+00,0.5467e+00,0.5428e+00,0.5387e+00,0.5342e+00,
6485 *0.5295e+00,0.5246e+00,0.5197e+00,0.5146e+00,0.5096e+00,0.5046e+00,
6486 *0.4998e+00,0.4951e+00,0.4907e+00,0.4866e+00,0.4829e+00,0.4797e+00,
6487 *0.4771e+00,0.4751e+00,0.4738e+00,0.4734e+00,0.4738e+00,0.4753e+00,
6488 *0.4779e+00,0.4817e+00,0.4868e+00,0.4934e+00,0.5016e+00,0.5114e+00,
6489 *0.5231e+00,0.5367e+00,0.5524e+00,0.5704e+00,0.5908e+00,0.6019e+00,
6490 *0.6137e+00,0.6393e+00,0.6678e+00,0.6993e+00,0.7340e+00,0.7720e+00,
6491 *0.8136e+00,0.8589e+00,0.9081e+00,0.9613e+00,0.1019e+01,0.1080e+01,
6492 *0.1147e+01,0.1218e+01,0.1293e+01,0.1373e+01,0.1459e+01,0.1549e+01,
6493 *0.1643e+01,0.1743e+01,0.1847e+01,0.1956e+01,0.2069e+01,0.2185e+01,
6494 *0.2305e+01,0.2428e+01,0.2553e+01,0.2679e+01,0.2806e+01,0.2931e+01,
6495 *0.3055e+01,0.3174e+01,0.3289e+01,0.3396e+01,0.3495e+01,0.3582e+01,
6496 *0.3656e+01,0.3716e+01,0.3758e+01,0.3782e+01,0.3788e+01/
6497 DATA ((phr(i,j),j=1,83),i=03,03) /
6498 *0.5834e+00,0.5832e+00,0.5825e+00,0.5813e+00,0.5795e+00,0.5771e+00,
6499 *0.5743e+00,0.5710e+00,0.5673e+00,0.5632e+00,0.5587e+00,0.5540e+00,
6500 *0.5490e+00,0.5438e+00,0.5384e+00,0.5330e+00,0.5275e+00,0.5221e+00,
6501 *0.5168e+00,0.5117e+00,0.5068e+00,0.5023e+00,0.4981e+00,0.4944e+00,
6502 *0.4913e+00,0.4889e+00,0.4871e+00,0.4862e+00,0.4862e+00,0.4872e+00,
6503 *0.4894e+00,0.4928e+00,0.4975e+00,0.5037e+00,0.5115e+00,0.5210e+00,
6504 *0.5324e+00,0.5457e+00,0.5611e+00,0.5788e+00,0.5988e+00,0.6098e+00,
6505 *0.6215e+00,0.6468e+00,0.6749e+00,0.7061e+00,0.7405e+00,0.7781e+00,
6506 *0.8193e+00,0.8641e+00,0.9127e+00,0.9652e+00,0.1022e+01,0.1083e+01,
6507 *0.1148e+01,0.1217e+01,0.1291e+01,0.1370e+01,0.1453e+01,0.1541e+01,
6508 *0.1633e+01,0.1730e+01,0.1831e+01,0.1936e+01,0.2045e+01,0.2157e+01,
6509 *0.2272e+01,0.2390e+01,0.2509e+01,0.2629e+01,0.2749e+01,0.2867e+01,
6510 *0.2984e+01,0.3096e+01,0.3203e+01,0.3304e+01,0.3395e+01,0.3476e+01,
6511 *0.3545e+01,0.3599e+01,0.3638e+01,0.3660e+01,0.3666e+01/
6512 DATA ((phr(i,j),j=1,83),i=04,04) /
6513 *0.6060e+00,0.6059e+00,0.6051e+00,0.6038e+00,0.6019e+00,0.5994e+00,
6514 *0.5964e+00,0.5929e+00,0.5889e+00,0.5846e+00,0.5798e+00,0.5747e+00,
6515 *0.5693e+00,0.5637e+00,0.5580e+00,0.5521e+00,0.5462e+00,0.5403e+00,
6516 *0.5345e+00,0.5289e+00,0.5235e+00,0.5185e+00,0.5138e+00,0.5096e+00,
6517 *0.5059e+00,0.5029e+00,0.5007e+00,0.4993e+00,0.4988e+00,0.4993e+00,
6518 *0.5010e+00,0.5040e+00,0.5083e+00,0.5142e+00,0.5216e+00,0.5307e+00,
6519 *0.5418e+00,0.5548e+00,0.5699e+00,0.5873e+00,0.6071e+00,0.6180e+00,
6520 *0.6295e+00,0.6546e+00,0.6825e+00,0.7134e+00,0.7474e+00,0.7848e+00,
6521 *0.8255e+00,0.8699e+00,0.9179e+00,0.9698e+00,0.1026e+01,0.1085e+01,
6522 *0.1150e+01,0.1218e+01,0.1290e+01,0.1367e+01,0.1448e+01,0.1534e+01,
6523 *0.1623e+01,0.1717e+01,0.1815e+01,0.1916e+01,0.2020e+01,0.2128e+01,
6524 *0.2237e+01,0.2349e+01,0.2462e+01,0.2576e+01,0.2688e+01,0.2800e+01,
6525 *0.2909e+01,0.3013e+01,0.3113e+01,0.3206e+01,0.3290e+01,0.3364e+01,
6526 *0.3427e+01,0.3477e+01,0.3512e+01,0.3532e+01,0.3537e+01/
6527 DATA ((phr(i,j),j=1,83),i=05,05) /
6528 *0.6604e+00,0.6602e+00,0.6593e+00,0.6578e+00,0.6556e+00,0.6528e+00,
6529 *0.6494e+00,0.6454e+00,0.6409e+00,0.6358e+00,0.6304e+00,0.6245e+00,
6530 *0.6182e+00,0.6117e+00,0.6050e+00,0.5981e+00,0.5911e+00,0.5841e+00,
6531 *0.5771e+00,0.5703e+00,0.5636e+00,0.5573e+00,0.5513e+00,0.5458e+00,
6532 *0.5409e+00,0.5366e+00,0.5331e+00,0.5305e+00,0.5288e+00,0.5281e+00,
6533 *0.5287e+00,0.5305e+00,0.5338e+00,0.5385e+00,0.5450e+00,0.5532e+00,
6534 *0.5633e+00,0.5754e+00,0.5897e+00,0.6062e+00,0.6252e+00,0.6356e+00,
6535 *0.6467e+00,0.6710e+00,0.6980e+00,0.7280e+00,0.7610e+00,0.7972e+00,
6536 *0.8367e+00,0.8797e+00,0.9261e+00,0.9762e+00,0.1030e+01,0.1087e+01,
6537 *0.1149e+01,0.1214e+01,0.1283e+01,0.1355e+01,0.1432e+01,0.1512e+01,
6538 *0.1595e+01,0.1682e+01,0.1772e+01,0.1865e+01,0.1961e+01,0.2058e+01,
6539 *0.2157e+01,0.2257e+01,0.2358e+01,0.2458e+01,0.2557e+01,0.2654e+01,
6540 *0.2748e+01,0.2838e+01,0.2923e+01,0.3001e+01,0.3072e+01,0.3134e+01,
6541 *0.3187e+01,0.3228e+01,0.3257e+01,0.3273e+01,0.3277e+01/
6542 DATA ((phr(i,j),j=1,83),i=06,06) /
6543 *0.6993e+00,0.6991e+00,0.6982e+00,0.6965e+00,0.6942e+00,0.6911e+00,
6544 *0.6874e+00,0.6830e+00,0.6781e+00,0.6726e+00,0.6666e+00,0.6601e+00,
6545 *0.6533e+00,0.6461e+00,0.6387e+00,0.6310e+00,0.6232e+00,0.6154e+00,
6546 *0.6076e+00,0.5998e+00,0.5923e+00,0.5851e+00,0.5782e+00,0.5717e+00,
6547 *0.5659e+00,0.5607e+00,0.5562e+00,0.5526e+00,0.5500e+00,0.5485e+00,
6548 *0.5482e+00,0.5491e+00,0.5515e+00,0.5555e+00,0.5611e+00,0.5686e+00,
6549 *0.5779e+00,0.5893e+00,0.6028e+00,0.6187e+00,0.6369e+00,0.6470e+00,
6550 *0.6577e+00,0.6812e+00,0.7074e+00,0.7366e+00,0.7687e+00,0.8040e+00,
6551 *0.8425e+00,0.8843e+00,0.9295e+00,0.9781e+00,0.1030e+01,0.1086e+01,
6552 *0.1145e+01,0.1208e+01,0.1274e+01,0.1344e+01,0.1417e+01,0.1494e+01,
6553 *0.1573e+01,0.1656e+01,0.1741e+01,0.1828e+01,0.1918e+01,0.2009e+01,
6554 *0.2101e+01,0.2194e+01,0.2287e+01,0.2380e+01,0.2470e+01,0.2559e+01,
6555 *0.2645e+01,0.2726e+01,0.2803e+01,0.2873e+01,0.2937e+01,0.2992e+01,
6556 *0.3038e+01,0.3075e+01,0.3100e+01,0.3115e+01,0.3118e+01/
6557 DATA ((phr(i,j),j=1,83),i=07,07) /
6558 *0.7916e+00,0.7914e+00,0.7903e+00,0.7883e+00,0.7855e+00,0.7818e+00,
6559 *0.7773e+00,0.7721e+00,0.7662e+00,0.7595e+00,0.7522e+00,0.7444e+00,
6560 *0.7360e+00,0.7272e+00,0.7180e+00,0.7085e+00,0.6988e+00,0.6889e+00,
6561 *0.6790e+00,0.6692e+00,0.6595e+00,0.6500e+00,0.6408e+00,0.6321e+00,
6562 *0.6239e+00,0.6164e+00,0.6097e+00,0.6038e+00,0.5989e+00,0.5952e+00,
6563 *0.5926e+00,0.5915e+00,0.5918e+00,0.5936e+00,0.5972e+00,0.6027e+00,
6564 *0.6101e+00,0.6195e+00,0.6311e+00,0.6451e+00,0.6614e+00,0.6705e+00,
6565 *0.6803e+00,0.7017e+00,0.7259e+00,0.7529e+00,0.7828e+00,0.8156e+00,
6566 *0.8514e+00,0.8903e+00,0.9323e+00,0.9774e+00,0.1026e+01,0.1077e+01,
6567 *0.1131e+01,0.1189e+01,0.1249e+01,0.1312e+01,0.1378e+01,0.1447e+01,
6568 *0.1518e+01,0.1590e+01,0.1665e+01,0.1741e+01,0.1819e+01,0.1897e+01,
6569 *0.1976e+01,0.2054e+01,0.2132e+01,0.2209e+01,0.2284e+01,0.2356e+01,
6570 *0.2426e+01,0.2491e+01,0.2552e+01,0.2607e+01,0.2657e+01,0.2700e+01,
6571 *0.2736e+01,0.2764e+01,0.2783e+01,0.2795e+01,0.2797e+01/
6572 DATA ((phr(i,j),j=1,83),i=08,08) /
6573 *0.1041e+01,0.1040e+01,0.1038e+01,0.1036e+01,0.1031e+01,0.1026e+01,
6574 *0.1019e+01,0.1011e+01,0.1002e+01,0.9924e+00,0.9814e+00,0.9694e+00,
6575 *0.9566e+00,0.9431e+00,0.9288e+00,0.9140e+00,0.8988e+00,0.8832e+00,
6576 *0.8673e+00,0.8513e+00,0.8353e+00,0.8194e+00,0.8038e+00,0.7885e+00,
6577 *0.7737e+00,0.7596e+00,0.7462e+00,0.7338e+00,0.7223e+00,0.7121e+00,
6578 *0.7031e+00,0.6955e+00,0.6895e+00,0.6852e+00,0.6827e+00,0.6820e+00,
6579 *0.6833e+00,0.6868e+00,0.6924e+00,0.7003e+00,0.7105e+00,0.7165e+00,
6580 *0.7232e+00,0.7383e+00,0.7559e+00,0.7760e+00,0.7987e+00,0.8240e+00,
6581 *0.8518e+00,0.8821e+00,0.9149e+00,0.9501e+00,0.9877e+00,0.1028e+01,
6582 *0.1069e+01,0.1113e+01,0.1159e+01,0.1207e+01,0.1256e+01,0.1306e+01,
6583 *0.1358e+01,0.1410e+01,0.1463e+01,0.1517e+01,0.1570e+01,0.1623e+01,
6584 *0.1676e+01,0.1727e+01,0.1778e+01,0.1827e+01,0.1873e+01,0.1918e+01,
6585 *0.1960e+01,0.1999e+01,0.2035e+01,0.2067e+01,0.2096e+01,0.2120e+01,
6586 *0.2140e+01,0.2156e+01,0.2167e+01,0.2173e+01,0.2174e+01/
6587 DATA ((phr(i,j),j=1,83),i=09,09) /
6588 *0.1182e+01,0.1181e+01,0.1179e+01,0.1176e+01,0.1171e+01,0.1164e+01,
6589 *0.1156e+01,0.1147e+01,0.1136e+01,0.1124e+01,0.1110e+01,0.1096e+01,
6590 *0.1080e+01,0.1064e+01,0.1046e+01,0.1028e+01,0.1009e+01,0.9903e+00,
6591 *0.9708e+00,0.9510e+00,0.9312e+00,0.9114e+00,0.8919e+00,0.8726e+00,
6592 *0.8539e+00,0.8357e+00,0.8184e+00,0.8019e+00,0.7866e+00,0.7724e+00,
6593 *0.7595e+00,0.7481e+00,0.7383e+00,0.7302e+00,0.7239e+00,0.7195e+00,
6594 *0.7171e+00,0.7168e+00,0.7188e+00,0.7229e+00,0.7294e+00,0.7335e+00,
6595 *0.7382e+00,0.7494e+00,0.7630e+00,0.7790e+00,0.7974e+00,0.8182e+00,
6596 *0.8414e+00,0.8668e+00,0.8944e+00,0.9242e+00,0.9561e+00,0.9898e+00,
6597 *0.1025e+01,0.1063e+01,0.1101e+01,0.1141e+01,0.1183e+01,0.1225e+01,
6598 *0.1268e+01,0.1311e+01,0.1355e+01,0.1399e+01,0.1442e+01,0.1485e+01,
6599 *0.1528e+01,0.1569e+01,0.1609e+01,0.1648e+01,0.1685e+01,0.1720e+01,
6600 *0.1753e+01,0.1783e+01,0.1811e+01,0.1836e+01,0.1858e+01,0.1876e+01,
6601 *0.1891e+01,0.1903e+01,0.1911e+01,0.1916e+01,0.1917e+01/
6602 DATA ((phr(i,j),j=1,83),i=10,10) /
6603 *0.1325e+01,0.1324e+01,0.1322e+01,0.1318e+01,0.1312e+01,0.1304e+01,
6604 *0.1294e+01,0.1283e+01,0.1270e+01,0.1256e+01,0.1240e+01,0.1222e+01,
6605 *0.1204e+01,0.1184e+01,0.1163e+01,0.1142e+01,0.1119e+01,0.1096e+01,
6606 *0.1073e+01,0.1049e+01,0.1025e+01,0.1001e+01,0.9776e+00,0.9541e+00,
6607 *0.9312e+00,0.9088e+00,0.8872e+00,0.8666e+00,0.8471e+00,0.8287e+00,
6608 *0.8118e+00,0.7963e+00,0.7825e+00,0.7704e+00,0.7602e+00,0.7519e+00,
6609 *0.7457e+00,0.7415e+00,0.7396e+00,0.7399e+00,0.7424e+00,0.7446e+00,
6610 *0.7473e+00,0.7545e+00,0.7640e+00,0.7758e+00,0.7899e+00,0.8063e+00,
6611 *0.8248e+00,0.8455e+00,0.8681e+00,0.8928e+00,0.9192e+00,0.9473e+00,
6612 *0.9771e+00,0.1008e+01,0.1041e+01,0.1074e+01,0.1109e+01,0.1144e+01,
6613 *0.1179e+01,0.1215e+01,0.1252e+01,0.1288e+01,0.1324e+01,0.1359e+01,
6614 *0.1393e+01,0.1427e+01,0.1460e+01,0.1491e+01,0.1521e+01,0.1549e+01,
6615 *0.1575e+01,0.1599e+01,0.1622e+01,0.1641e+01,0.1658e+01,0.1673e+01,
6616 *0.1685e+01,0.1694e+01,0.1701e+01,0.1704e+01,0.1705e+01/
6624 s tamoy,tamoyp,pizmoy,pizmoyp)
6625 real wl,taer55,taer55p,tamoy,tamoyp,pizmoy,pizmoyp,roatm
6626 real dtdir,dtdif,utdir,utdif,sphal,wldis,trayl,traypl
6627 real ext,ome,gasym,phase,pha,betal,phasel,cgaus,pdgs,coef
6628 real wlinf,alphaa,betaa,tsca,coeff
6629 integer linf,ll,lsup,k
6630 common /sixs_disc/ roatm(3,10),dtdir(3,10),dtdif(3,10),
6631 s utdir(3,10),utdif(3,10),sphal(3,10),wldis(10),trayl(10),
6633 common /sixs_aer/ext(10),ome(10),gasym(10),phase(10)
6634 common /sixs_trunc/pha(83),betal(0:80)
6635 common /sixs_sos/phasel(10,83),cgaus(83),pdgs(83)
6638 if(wl.ge.wldis(ll).and.wl.le.wldis(ll+1)) linf=ll
6640 if(wl.gt.wldis(10)) linf=9
6642 coef=alog(wldis(lsup)/wldis(linf))
6644 alphaa=alog(ext(lsup)*ome(lsup)/(ext(linf)*ome(linf)))/coef
6645 betaa=ext(linf)*ome(linf)/(wlinf**(alphaa))
6646 tsca=taer55*betaa*(wl**alphaa)/ext(4)
6647 alphaa=alog(ext(lsup)/(ext(linf)))/coef
6648 betaa=ext(linf)/(wlinf**(alphaa))
6649 tamoy=taer55*betaa*(wl**alphaa)/ext(4)
6650 tamoyp=taer55p*betaa*(wl**alphaa)/ext(4)
6654 alphaa=alog(phasel(lsup,k)/phasel(linf,k))/coef
6655 betaa=phasel(linf,k)/(wlinf**(alphaa))
6656 81 pha(k)=betaa*(wl**alphaa)
6658 tamoy=tamoy*(1.-pizmoy*coeff)
6659 tamoyp=tamoyp*(1.-pizmoyp*coeff)
6660 pizmoy=pizmoy*(1.-coeff)/(1.-pizmoy*coeff)
6663 subroutine splie2(x2a,ya,m,n,y2a)
6667 real x2a(n),ya(m,n),y2a(m,n),ytmp(nn),y2tmp(nn)
6672 call spline(x2a,ytmp,n,1.e30,1.e30,y2tmp)
6679 subroutine splin2(x1a,x2a,ya,y2a,m,n,x1,x2,y)
6683 real x1a(m),x2a(n),ya(m,n),y2a(m,n),ytmp(nn),y2tmp(nn)
6690 call splint(x2a,ytmp,y2tmp,n,x2,yytmp(j))
6692 call spline(x1a,yytmp,m,1.e30,1.e30,y2tmp)
6693 call splint(x1a,yytmp,y2tmp,m,x1,y)
6698 common/sixs_aerbas/ph(10,83)
6705 data ((phr(i,j),j=1,83),i= 1, 1)/
6706 & .4482, .4378, .3984, .3460, .3030, .2864, .3011, .3393,
6707 & .3852, .4224, .4395, .4332, .4068, .3674, .3232, .2806,
6708 & .2436, .2137, .1909, .1740, .1615, .1523, .1453, .1398,
6709 & .1356, .1324, .1300, .1284, .1277, .1278, .1286, .1303,
6710 & .1328, .1362, .1404, .1455, .1515, .1585, .1666, .1759,
6711 & .1864, .1922, .1984, .2119, .2272, .2444, .2638, .2856,
6712 & .3103, .3381, .3696, .4052, .4454, .4911, .5429, .6018,
6713 & .6687, .7447, .8309, .9284, 1.0383, 1.1614, 1.2985, 1.4500,
6714 & 1.6169, 1.8014, 2.0088, 2.2506, 2.5487, 2.9404, 3.4830, 4.2562,
6715 & 5.3583, 6.8944, 8.9537,11.5772,14.7221,18.2338,21.8390,25.1693,
6716 &27.8195,29.4297,29.8220/
6717 data ((phr(i,j),j=1,83),i= 2, 2)/
6718 & .3066, .3025, .2862, .2621, .2369, .2173, .2078, .2095,
6719 & .2201, .2355, .2504, .2607, .2637, .2589, .2472, .2305,
6720 & .2114, .1919, .1736, .1577, .1445, .1340, .1261, .1203,
6721 & .1162, .1134, .1117, .1109, .1108, .1113, .1124, .1141,
6722 & .1165, .1194, .1230, .1273, .1324, .1384, .1452, .1531,
6723 & .1620, .1669, .1722, .1838, .1969, .2117, .2285, .2475,
6724 & .2691, .2936, .3213, .3528, .3886, .4293, .4754, .5278,
6725 & .5872, .6543, .7304, .8164, .9142, 1.0260, 1.1554, 1.3080,
6726 & 1.4922, 1.7208, 2.0120, 2.3907, 2.8891, 3.5464, 4.4062, 5.5124,
6727 & 6.9014, 8.5929,10.5796,12.8175,15.2199,17.6577,19.9678,21.9699,
6728 &23.4901,24.3864,24.6019/
6729 data ((phr(i,j),j=1,83),i= 3, 3)/
6730 & .2797, .2765, .2636, .2440, .2227, .2045, .1934, .1907,
6731 & .1956, .2056, .2171, .2266, .2316, .2310, .2247, .2138,
6732 & .1998, .1843, .1689, .1546, .1422, .1319, .1237, .1176,
6733 & .1131, .1101, .1082, .1073, .1072, .1077, .1089, .1107,
6734 & .1130, .1160, .1196, .1239, .1289, .1347, .1413, .1490,
6735 & .1577, .1625, .1676, .1789, .1916, .2061, .2225, .2410,
6736 & .2621, .2859, .3130, .3437, .3785, .4179, .4626, .5133,
6737 & .5706, .6356, .7094, .7936, .8904, 1.0031, 1.1367, 1.2984,
6738 & 1.4985, 1.7518, 2.0779, 2.5018, 3.0542, 3.7695, 4.6834, 5.8280,
6739 & 7.2258, 8.8822,10.7776,12.8620,15.0519,17.2327,19.2671,21.0083,
6740 &22.3181,23.0858,23.2698/
6741 data ((phr(i,j),j=1,83),i= 4, 4)/
6742 & .2523, .2499, .2401, .2249, .2075, .1914, .1795, .1736,
6743 & .1735, .1782, .1854, .1928, .1984, .2005, .1988, .1932,
6744 & .1846, .1739, .1623, .1506, .1398, .1303, .1223, .1159,
6745 & .1110, .1076, .1054, .1042, .1039, .1044, .1055, .1073,
6746 & .1097, .1127, .1163, .1205, .1255, .1312, .1378, .1453,
6747 & .1539, .1586, .1636, .1746, .1871, .2013, .2173, .2354,
6748 & .2559, .2792, .3055, .3352, .3689, .4070, .4502, .4990,
6749 & .5545, .6178, .6905, .7747, .8738, .9921, 1.1363, 1.3153,
6750 & 1.5410, 1.8295, 2.2003, 2.6770, 3.2861, 4.0549, 5.0090, 6.1680,
6751 & 7.5404, 9.1188,10.8752,12.7575,14.6902,16.5769,18.3076,19.7692,
6752 &20.8579,21.4919,21.6435/
6753 data ((phr(i,j),j=1,83),i= 5, 5)/
6754 & .2099, .2085, .2029, .1937, .1824, .1705, .1597, .1512,
6755 & .1457, .1433, .1435, .1455, .1484, .1511, .1529, .1533,
6756 & .1519, .1489, .1445, .1391, .1331, .1270, .1212, .1158,
6757 & .1112, .1075, .1048, .1029, .1020, .1019, .1027, .1041,
6758 & .1063, .1092, .1128, .1170, .1220, .1278, .1344, .1419,
6759 & .1505, .1551, .1601, .1710, .1833, .1971, .2127, .2303,
6760 & .2501, .2724, .2976, .3260, .3583, .3950, .4371, .4857,
6761 & .5424, .6092, .6892, .7862, .9053, 1.0531, 1.2379, 1.4701,
6762 & 1.7619, 2.1272, 2.5813, 3.1398, 3.8174, 4.6261, 5.5735, 6.6598,
6763 & 7.8763, 9.2034,10.6092,12.0501,13.4719,14.8129,16.0082,16.9948,
6764 &17.7172,18.1334,18.2325/
6765 data ((phr(i,j),j=1,83),i= 6, 6)/
6766 & .1911, .1901, .1861, .1793, .1706, .1610, .1516, .1432,
6767 & .1365, .1318, .1292, .1284, .1289, .1301, .1316, .1328,
6768 & .1333, .1330, .1317, .1295, .1266, .1232, .1196, .1160,
6769 & .1126, .1096, .1072, .1054, .1043, .1040, .1044, .1056,
6770 & .1075, .1102, .1136, .1177, .1227, .1285, .1351, .1427,
6771 & .1513, .1560, .1610, .1719, .1842, .1981, .2136, .2311,
6772 & .2509, .2732, .2986, .3275, .3607, .3992, .4441, .4973,
6773 & .5608, .6374, .7309, .8458, .9877, 1.1636, 1.3815, 1.6506,
6774 & 1.9812, 2.3839, 2.8694, 3.4473, 4.1253, 4.9077, 5.7944, 6.7794,
6775 & 7.8497, 8.9848,10.1567,11.3301,12.4643,13.5152,14.4381,15.1909,
6776 &15.7373,16.0504,16.1247/
6777 data ((phr(i,j),j=1,83),i= 7, 7)/
6778 & .1657, .1652, .1631, .1595, .1546, .1488, .1424, .1358,
6779 & .1294, .1235, .1183, .1141, .1107, .1084, .1070, .1063,
6780 & .1062, .1066, .1072, .1080, .1088, .1096, .1103, .1108,
6781 & .1113, .1117, .1121, .1126, .1133, .1142, .1155, .1172,
6782 & .1193, .1221, .1255, .1296, .1345, .1402, .1469, .1547,
6783 & .1636, .1686, .1739, .1856, .1991, .2147, .2326, .2534,
6784 & .2775, .3058, .3392, .3787, .4256, .4818, .5491, .6299,
6785 & .7270, .8435, .9830, 1.1494, 1.3469, 1.5800, 1.8530, 2.1701,
6786 & 2.5350, 2.9507, 3.4187, 3.9394, 4.5111, 5.1299, 5.7894, 6.4806,
6787 & 7.1921, 7.9098, 8.6176, 9.2978, 9.9320,10.5016,10.9891,11.3786,
6788 &11.6571,11.8152,11.8525/
6789 data ((phr(i,j),j=1,83),i= 8, 8)/
6790 & .1867, .1866, .1860, .1850, .1836, .1819, .1797, .1773,
6791 & .1746, .1717, .1687, .1655, .1624, .1593, .1563, .1535,
6792 & .1509, .1487, .1469, .1455, .1447, .1444, .1449, .1460,
6793 & .1480, .1509, .1547, .1596, .1656, .1729, .1814, .1915,
6794 & .2031, .2164, .2315, .2488, .2683, .2902, .3149, .3426,
6795 & .3736, .3904, .4081, .4466, .4894, .5369, .5895, .6476,
6796 & .7117, .7821, .8593, .9436, 1.0355, 1.1354, 1.2434, 1.3598,
6797 & 1.4848, 1.6183, 1.7604, 1.9108, 2.0693, 2.2352, 2.4081, 2.5870,
6798 & 2.7711, 2.9591, 3.1498, 3.3417, 3.5332, 3.7226, 3.9080, 4.0876,
6799 & 4.2594, 4.4215, 4.5720, 4.7090, 4.8308, 4.9359, 5.0228, 5.0905,
6800 & 5.1379, 5.1645, 5.1708/
6801 data ((phr(i,j),j=1,83),i= 9, 9)/
6802 & .4829, .4828, .4824, .4816, .4804, .4790, .4772, .4751,
6803 & .4728, .4701, .4673, .4643, .4611, .4578, .4544, .4511,
6804 & .4477, .4444, .4413, .4384, .4358, .4335, .4317, .4304,
6805 & .4298, .4299, .4308, .4327, .4356, .4397, .4452, .4520,
6806 & .4605, .4708, .4829, .4971, .5135, .5323, .5536, .5776,
6807 & .6045, .6190, .6344, .6674, .7038, .7435, .7869, .8338,
6808 & .8845, .9390, .9973, 1.0594, 1.1253, 1.1949, 1.2682, 1.3449,
6809 & 1.4249, 1.5080, 1.5939, 1.6823, 1.7728, 1.8650, 1.9584, 2.0527,
6810 & 2.1472, 2.2414, 2.3347, 2.4266, 2.5162, 2.6031, 2.6866, 2.7660,
6811 & 2.8408, 2.9103, 2.9739, 3.0312, 3.0815, 3.1246, 3.1599, 3.1873,
6812 & 3.2064, 3.2170, 3.2195/
6813 data ((phr(i,j),j=1,83),i=10,10)/
6814 & 1.0488, 1.0485, 1.0470, 1.0443, 1.0405, 1.0355, 1.0295, 1.0223,
6815 & 1.0141, 1.0049, .9948, .9838, .9719, .9594, .9461, .9323,
6816 & .9180, .9032, .8882, .8730, .8577, .8425, .8273, .8125,
6817 & .7981, .7841, .7709, .7584, .7469, .7364, .7271, .7191,
6818 & .7126, .7077, .7045, .7031, .7036, .7062, .7109, .7179,
6819 & .7271, .7326, .7387, .7527, .7692, .7881, .8096, .8335,
6820 & .8599, .8886, .9198, .9532, .9888, 1.0265, 1.0661, 1.1075,
6821 & 1.1505, 1.1949, 1.2406, 1.2872, 1.3346, 1.3825, 1.4307, 1.4789,
6822 & 1.5267, 1.5741, 1.6205, 1.6659, 1.7098, 1.7521, 1.7924, 1.8305,
6823 & 1.8661, 1.8989, 1.9289, 1.9557, 1.9792, 1.9992, 2.0156, 2.0282,
6824 & 2.0370, 2.0419, 2.0431/
6833 real z4(34),p4(34),t4(34),wh4(34),wo4(34)
6835 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
6839 data(z4(i),i=1, 34)/
6840 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
6841 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
6842 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
6843 4 35., 40., 45., 50., 70., 100.,99999./
6844 data (p4(i),i=1,34) /
6845 a1.010e+03,8.960e+02,7.929e+02,7.000e+02,6.160e+02,5.410e+02,
6846 a4.730e+02,4.130e+02,3.590e+02,3.107e+02,2.677e+02,2.300e+02,
6847 a1.977e+02,1.700e+02,1.460e+02,1.250e+02,1.080e+02,9.280e+01,
6848 a7.980e+01,6.860e+01,5.890e+01,5.070e+01,4.360e+01,3.750e+01,
6849 a3.227e+01,2.780e+01,1.340e+01,6.610e+00,3.400e+00,1.810e+00,
6850 a9.870e-01,7.070e-02,3.000e-04,0.000e+00/
6851 data (t4(i),i=1,34) /
6852 a2.870e+02,2.820e+02,2.760e+02,2.710e+02,2.660e+02,2.600e+02,
6853 a2.530e+02,2.460e+02,2.390e+02,2.320e+02,2.250e+02,2.250e+02,
6854 a2.250e+02,2.250e+02,2.250e+02,2.250e+02,2.250e+02,2.250e+02,
6855 a2.250e+02,2.250e+02,2.250e+02,2.250e+02,2.250e+02,2.250e+02,
6856 a2.260e+02,2.280e+02,2.350e+02,2.470e+02,2.620e+02,2.740e+02,
6857 a2.770e+02,2.160e+02,2.100e+02,2.100e+02/
6858 data (wh4(i),i=1,34) /
6859 a9.100e+00,6.000e+00,4.200e+00,2.700e+00,1.700e+00,1.000e+00,
6860 a5.400e-01,2.900e-01,1.300e-01,4.200e-02,1.500e-02,9.400e-03,
6861 a6.000e-03,1.800e-03,1.000e-03,7.600e-04,6.400e-04,5.600e-04,
6862 a5.000e-04,4.900e-04,4.500e-04,5.100e-04,5.100e-04,5.400e-04,
6863 a6.000e-04,6.700e-04,3.600e-04,1.100e-04,4.300e-05,1.900e-05,
6864 a6.300e-06,1.400e-07,1.000e-09,0.000e+00/
6865 data (wo4(i),i=1,34) /
6866 a4.900e-05,5.400e-05,5.600e-05,5.800e-05,6.000e-05,6.400e-05,
6867 a7.100e-05,7.500e-05,7.900e-05,1.100e-04,1.300e-04,1.800e-04,
6868 a2.100e-04,2.600e-04,2.800e-04,3.200e-04,3.400e-04,3.900e-04,
6869 a4.100e-04,4.100e-04,3.900e-04,3.600e-04,3.200e-04,3.000e-04,
6870 a2.800e-04,2.600e-04,1.400e-04,9.200e-05,4.100e-05,1.300e-05,
6871 a4.300e-06,8.600e-08,4.300e-11,0.000e+00/
6883 real z5(34),p5(34),t5(34),wh5(34),wo5(34)
6885 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
6890 data(z5(i),i=1, 34)/
6891 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
6892 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
6893 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
6894 4 35., 40., 45., 50., 70., 100.,99999./
6895 data (p5(i),i=1,34) /
6896 a1.013e+03,8.878e+02,7.775e+02,6.798e+02,5.932e+02,5.158e+02,
6897 a4.467e+02,3.853e+02,3.308e+02,2.829e+02,2.418e+02,2.067e+02,
6898 a1.766e+02,1.510e+02,1.291e+02,1.103e+02,9.431e+01,8.058e+01,
6899 a6.882e+01,5.875e+01,5.014e+01,4.277e+01,3.647e+01,3.109e+01,
6900 a2.649e+01,2.256e+01,1.020e+01,4.701e+00,2.243e+00,1.113e+00,
6901 a5.719e-01,4.016e-02,3.000e-04,0.000e+00/
6902 data (t5(i),i=1,34) /
6903 a2.571e+02,2.591e+02,2.559e+02,2.527e+02,2.477e+02,2.409e+02,
6904 a2.341e+02,2.273e+02,2.206e+02,2.172e+02,2.172e+02,2.172e+02,
6905 a2.172e+02,2.172e+02,2.172e+02,2.172e+02,2.166e+02,2.160e+02,
6906 a2.154e+02,2.148e+02,2.141e+02,2.136e+02,2.130e+02,2.124e+02,
6907 a2.118e+02,2.112e+02,2.160e+02,2.222e+02,2.347e+02,2.470e+02,
6908 a2.593e+02,2.457e+02,2.100e+02,2.100e+02/
6909 data (wh5(i),i=1,34) /
6910 a1.200e+00,1.200e+00,9.400e-01,6.800e-01,4.100e-01,2.000e-01,
6911 a9.800e-02,5.400e-02,1.100e-02,8.400e-03,5.500e-03,3.800e-03,
6912 a2.600e-03,1.800e-03,1.000e-03,7.600e-04,6.400e-04,5.600e-04,
6913 a5.000e-04,4.900e-04,4.500e-04,5.100e-04,5.100e-04,5.400e-04,
6914 a6.000e-04,6.700e-04,3.600e-04,1.100e-04,4.300e-05,1.900e-05,
6915 a6.300e-06,1.400e-07,1.000e-09,0.000e+00/
6916 data (wo5(i),i=1,34) /
6917 a4.100e-05,4.100e-05,4.100e-05,4.300e-05,4.500e-05,4.700e-05,
6918 a4.900e-05,7.100e-05,9.000e-05,1.600e-04,2.400e-04,3.200e-04,
6919 a4.300e-04,4.700e-04,4.900e-04,5.600e-04,6.200e-04,6.200e-04,
6920 a6.200e-04,6.000e-04,5.600e-04,5.100e-04,4.700e-04,4.300e-04,
6921 a3.600e-04,3.200e-04,1.500e-04,9.200e-05,4.100e-05,1.300e-05,
6922 a4.300e-06,8.600e-08,4.300e-11,0.000e+00/
6934 real z1(34),p1(34),t1(34),wh1(34),wo1(34)
6936 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
6940 data(z1(i),i=1, 34)/
6941 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
6942 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
6943 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
6944 4 35., 40., 45., 50., 70., 100.,99999./
6945 data (p1(i),i=1,34)/
6946 a1.013e+03,9.040e+02,8.050e+02,7.150e+02,6.330e+02,5.590e+02,
6947 a4.920e+02,4.320e+02,3.780e+02,3.290e+02,2.860e+02,2.470e+02,
6948 a2.130e+02,1.820e+02,1.560e+02,1.320e+02,1.110e+02,9.370e+01,
6949 a7.890e+01,6.660e+01,5.650e+01,4.800e+01,4.090e+01,3.500e+01,
6950 a3.000e+01,2.570e+01,1.220e+01,6.000e+00,3.050e+00,1.590e+00,
6951 a8.540e-01,5.790e-02,3.000e-04,0.000e+00/
6952 data (t1(i),i=1,34)/
6953 a3.000e+02,2.940e+02,2.880e+02,2.840e+02,2.770e+02,2.700e+02,
6954 a2.640e+02,2.570e+02,2.500e+02,2.440e+02,2.370e+02,2.300e+02,
6955 a2.240e+02,2.170e+02,2.100e+02,2.040e+02,1.970e+02,1.950e+02,
6956 a1.990e+02,2.030e+02,2.070e+02,2.110e+02,2.150e+02,2.170e+02,
6957 a2.190e+02,2.210e+02,2.320e+02,2.430e+02,2.540e+02,2.650e+02,
6958 a2.700e+02,2.190e+02,2.100e+02,2.100e+02/
6959 data (wh1(i),i=1,34)/
6960 a1.900e+01,1.300e+01,9.300e+00,4.700e+00,2.200e+00,1.500e+00,
6961 a8.500e-01,4.700e-01,2.500e-01,1.200e-01,5.000e-02,1.700e-02,
6962 a6.000e-03,1.800e-03,1.000e-03,7.600e-04,6.400e-04,5.600e-04,
6963 a5.000e-04,4.900e-04,4.500e-04,5.100e-04,5.100e-04,5.400e-04,
6964 a6.000e-04,6.700e-04,3.600e-04,1.100e-04,4.300e-05,1.900e-05,
6965 a6.300e-06,1.400e-07,1.000e-09,0.000e+00/
6966 data (wo1(i),i=1,34)/
6967 a5.600e-05,5.600e-05,5.400e-05,5.100e-05,4.700e-05,4.500e-05,
6968 a4.300e-05,4.100e-05,3.900e-05,3.900e-05,3.900e-05,4.100e-05,
6969 a4.300e-05,4.500e-05,4.500e-05,4.700e-05,4.700e-05,6.900e-05,
6970 a9.000e-05,1.400e-04,1.900e-04,2.400e-04,2.800e-04,3.200e-04,
6971 a3.400e-04,3.400e-04,2.400e-04,9.200e-05,4.100e-05,1.300e-05,
6972 a4.300e-06,8.600e-08,4.300e-11,0.000e+00/
6983 real aa,x1,x2,a,x,rm,z1
6984 real cosang(80),weight(80),ptemp(83),pl(-1:81)
6986 integer nbmu,nang,k,j,kk,i
6987 real pha,betal,coeff
6988 common /sixs_trunc/pha(1:83),betal(0:80)
6994 call gauss(-1.,1.,cosang,weight,nang)
7010 if((rmu(j).gt.0.8))
then
7018 if((rmu(j).gt.0.94))
then
7025 aa=(alog10(pha(kk))-alog10(pha(k)))/
7026 a (acos(rmu(kk))-acos(rmu(k)))
7030 if(
abs(rmu(j)-1.).le.1d-08) a=x1-aa*x2
7031 a=x1+aa*(acos(rmu(j))-x2)
7047 pl(k+1)=((2*k+1.)*rm*pl(k)-k*pl(k-1))/(k+1.)
7048 betal(k)=betal(k)+x*pl(k)
7052 betal(k)=(2*k+1.)*0.5*betal(k)
7057 betal(k)=betal(k)/z1
7064 real z6(34),p6(34),t6(34),wh6(34),wo6(34)
7066 common /sixs_atm/z(34),p(34),t(34),wh(34),wo(34)
7070 data(z6(i),i=1, 34)/
7071 1 0., 1., 2., 3., 4., 5., 6., 7., 8.,
7072 2 9., 10., 11., 12., 13., 14., 15., 16., 17.,
7073 3 18., 19., 20., 21., 22., 23., 24., 25., 30.,
7074 4 35., 40., 45., 50., 70., 100.,99999./
7075 data (p6(i),i=1,34) /
7076 a1.013e+03,8.986e+02,7.950e+02,7.012e+02,6.166e+02,5.405e+02,
7077 a4.722e+02,4.111e+02,3.565e+02,3.080e+02,2.650e+02,2.270e+02,
7078 a1.940e+02,1.658e+02,1.417e+02,1.211e+02,1.035e+02,8.850e+01,
7079 a7.565e+01,6.467e+01,5.529e+01,4.729e+01,4.047e+01,3.467e+01,
7080 a2.972e+01,2.549e+01,1.197e+01,5.746e+00,2.871e+00,1.491e+00,
7081 a7.978e-01,5.520e-02,3.008e-04,0.000e+00/
7082 data (t6(i),i=1,34) /
7083 a2.881e+02,2.816e+02,2.751e+02,2.687e+02,2.622e+02,2.557e+02,
7084 a2.492e+02,2.427e+02,2.362e+02,2.297e+02,2.232e+02,2.168e+02,
7085 a2.166e+02,2.166e+02,2.166e+02,2.166e+02,2.166e+02,2.166e+02,
7086 a2.166e+02,2.166e+02,2.166e+02,2.176e+02,2.186e+02,2.196e+02,
7087 a2.206e+02,2.216e+02,2.265e+02,2.365e+02,2.534e+02,2.642e+02,
7088 a2.706e+02,2.197e+02,2.100e+02,2.100e+02/
7089 data (wh6(i),i=1,34) /
7090 a5.900e+00,4.200e+00,2.900e+00,1.800e+00,1.100e+00,6.400e-01,
7091 a3.800e-01,2.100e-01,1.200e-01,4.600e-02,1.800e-02,8.200e-03,
7092 a3.700e-03,1.800e-03,8.400e-04,7.200e-04,6.100e-04,5.200e-04,
7093 a4.400e-04,4.400e-04,4.400e-04,4.800e-04,5.200e-04,5.700e-04,
7094 a6.100e-04,6.600e-04,3.800e-04,1.600e-04,6.700e-05,3.200e-05,
7095 a1.200e-05,1.500e-07,1.000e-09,0.000e+00/
7096 data (wo6(i),i=1,34) /
7097 a5.400e-05,5.400e-05,5.400e-05,5.000e-05,4.600e-05,4.600e-05,
7098 a4.500e-05,4.900e-05,5.200e-05,7.100e-05,9.000e-05,1.300e-04,
7099 a1.600e-04,1.700e-04,1.900e-04,2.100e-04,2.400e-04,2.800e-04,
7100 a3.200e-04,3.500e-04,3.800e-04,3.800e-04,3.900e-04,3.800e-04,
7101 a3.600e-04,3.400e-04,2.000e-04,1.100e-04,4.900e-05,1.700e-05,
7102 a4.000e-06,8.600e-08,4.300e-11,0.000e+00/
7112 subroutine varsol (jday,month,
7116 integer jday,month,j
7124 if (month.le.2)
goto 1
7125 if (month.gt.8)
goto 2
7126 j=31*(month-1)-((month-1)/2)-2+jday
7128 1 j=31*(month-1)+jday
7130 2 j=31*(month-1)-((month-2)/2)-2+jday
7133 om=(.9856*float(j-4))*pi/180.
7134 dsol=1./((1.-.01673*cos(om))**2)
7141 common /sixs_aerbas/ ph(10,83)
7145 DATA ((phr(i,j),j=1,83),i=01,01) /
7146 *0.4115e+00,0.4045e+00,0.3805e+00,0.3495e+00,0.3192e+00,0.2943e+00,
7147 *0.2768e+00,0.2659e+00,0.2592e+00,0.2538e+00,0.2479e+00,0.2411e+00,
7148 *0.2336e+00,0.2255e+00,0.2175e+00,0.2098e+00,0.2026e+00,0.1961e+00,
7149 *0.1903e+00,0.1854e+00,0.1812e+00,0.1778e+00,0.1752e+00,0.1734e+00,
7150 *0.1723e+00,0.1719e+00,0.1724e+00,0.1736e+00,0.1756e+00,0.1784e+00,
7151 *0.1820e+00,0.1866e+00,0.1920e+00,0.1985e+00,0.2061e+00,0.2149e+00,
7152 *0.2249e+00,0.2363e+00,0.2492e+00,0.2638e+00,0.2803e+00,0.2893e+00,
7153 *0.2988e+00,0.3195e+00,0.3428e+00,0.3688e+00,0.3979e+00,0.4306e+00,
7154 *0.4671e+00,0.5079e+00,0.5537e+00,0.6048e+00,0.6622e+00,0.7264e+00,
7155 *0.7985e+00,0.8794e+00,0.9701e+00,0.1072e+01,0.1186e+01,0.1315e+01,
7156 *0.1460e+01,0.1622e+01,0.1805e+01,0.2011e+01,0.2242e+01,0.2503e+01,
7157 *0.2796e+01,0.3125e+01,0.3496e+01,0.3913e+01,0.4383e+01,0.4912e+01,
7158 *0.5510e+01,0.6185e+01,0.6951e+01,0.7825e+01,0.8828e+01,0.9991e+01,
7159 *0.1136e+02,0.1297e+02,0.1491e+02,0.1711e+02,0.1834e+02/
7160 DATA ((phr(i,j),j=1,83),i=02,02) /
7161 *0.3918e+00,0.3859e+00,0.3654e+00,0.3384e+00,0.3117e+00,0.2895e+00,
7162 *0.2736e+00,0.2635e+00,0.2571e+00,0.2522e+00,0.2470e+00,0.2411e+00,
7163 *0.2345e+00,0.2275e+00,0.2204e+00,0.2135e+00,0.2071e+00,0.2012e+00,
7164 *0.1959e+00,0.1914e+00,0.1875e+00,0.1844e+00,0.1820e+00,0.1804e+00,
7165 *0.1794e+00,0.1792e+00,0.1797e+00,0.1810e+00,0.1831e+00,0.1860e+00,
7166 *0.1898e+00,0.1945e+00,0.2001e+00,0.2068e+00,0.2146e+00,0.2236e+00,
7167 *0.2339e+00,0.2456e+00,0.2589e+00,0.2739e+00,0.2909e+00,0.3001e+00,
7168 *0.3099e+00,0.3312e+00,0.3552e+00,0.3820e+00,0.4119e+00,0.4455e+00,
7169 *0.4830e+00,0.5249e+00,0.5718e+00,0.6243e+00,0.6829e+00,0.7486e+00,
7170 *0.8221e+00,0.9045e+00,0.9968e+00,0.1100e+01,0.1216e+01,0.1346e+01,
7171 *0.1492e+01,0.1655e+01,0.1839e+01,0.2045e+01,0.2275e+01,0.2534e+01,
7172 *0.2824e+01,0.3149e+01,0.3513e+01,0.3920e+01,0.4375e+01,0.4884e+01,
7173 *0.5454e+01,0.6092e+01,0.6807e+01,0.7611e+01,0.8516e+01,0.9543e+01,
7174 *0.1071e+02,0.1205e+02,0.1357e+02,0.1518e+02,0.1599e+02/
7175 DATA ((phr(i,j),j=1,83),i=03,03) /
7176 *0.3872e+00,0.3816e+00,0.3620e+00,0.3360e+00,0.3102e+00,0.2887e+00,
7177 *0.2732e+00,0.2633e+00,0.2571e+00,0.2522e+00,0.2471e+00,0.2414e+00,
7178 *0.2350e+00,0.2283e+00,0.2214e+00,0.2148e+00,0.2085e+00,0.2028e+00,
7179 *0.1976e+00,0.1932e+00,0.1894e+00,0.1864e+00,0.1840e+00,0.1824e+00,
7180 *0.1815e+00,0.1813e+00,0.1819e+00,0.1832e+00,0.1853e+00,0.1883e+00,
7181 *0.1920e+00,0.1968e+00,0.2024e+00,0.2092e+00,0.2170e+00,0.2261e+00,
7182 *0.2364e+00,0.2483e+00,0.2617e+00,0.2768e+00,0.2939e+00,0.3032e+00,
7183 *0.3131e+00,0.3346e+00,0.3587e+00,0.3857e+00,0.4159e+00,0.4497e+00,
7184 *0.4875e+00,0.5297e+00,0.5769e+00,0.6297e+00,0.6887e+00,0.7547e+00,
7185 *0.8286e+00,0.9114e+00,0.1004e+01,0.1108e+01,0.1224e+01,0.1354e+01,
7186 *0.1500e+01,0.1664e+01,0.1847e+01,0.2053e+01,0.2284e+01,0.2542e+01,
7187 *0.2831e+01,0.3154e+01,0.3515e+01,0.3919e+01,0.4370e+01,0.4874e+01,
7188 *0.5436e+01,0.6064e+01,0.6765e+01,0.7549e+01,0.8430e+01,0.9422e+01,
7189 *0.1054e+02,0.1182e+02,0.1324e+02,0.1472e+02,0.1544e+02/
7190 DATA ((phr(i,j),j=1,83),i=04,04) /
7191 *0.3737e+00,0.3687e+00,0.3509e+00,0.3269e+00,0.3030e+00,0.2830e+00,
7192 *0.2686e+00,0.2593e+00,0.2535e+00,0.2490e+00,0.2444e+00,0.2393e+00,
7193 *0.2335e+00,0.2273e+00,0.2210e+00,0.2148e+00,0.2089e+00,0.2036e+00,
7194 *0.1987e+00,0.1945e+00,0.1910e+00,0.1881e+00,0.1859e+00,0.1844e+00,
7195 *0.1836e+00,0.1835e+00,0.1842e+00,0.1855e+00,0.1877e+00,0.1907e+00,
7196 *0.1945e+00,0.1993e+00,0.2051e+00,0.2118e+00,0.2198e+00,0.2289e+00,
7197 *0.2394e+00,0.2513e+00,0.2649e+00,0.2802e+00,0.2974e+00,0.3068e+00,
7198 *0.3168e+00,0.3385e+00,0.3628e+00,0.3901e+00,0.4206e+00,0.4547e+00,
7199 *0.4928e+00,0.5353e+00,0.5829e+00,0.6361e+00,0.6955e+00,0.7620e+00,
7200 *0.8363e+00,0.9195e+00,0.1013e+01,0.1117e+01,0.1233e+01,0.1364e+01,
7201 *0.1510e+01,0.1674e+01,0.1858e+01,0.2063e+01,0.2293e+01,0.2550e+01,
7202 *0.2838e+01,0.3160e+01,0.3518e+01,0.3919e+01,0.4365e+01,0.4863e+01,
7203 *0.5416e+01,0.6033e+01,0.6719e+01,0.7483e+01,0.8337e+01,0.9292e+01,
7204 *0.1036e+02,0.1156e+02,0.1289e+02,0.1423e+02,0.1486e+02/
7205 DATA ((phr(i,j),j=1,83),i=05,05) /
7206 *0.3651e+00,0.3607e+00,0.3449e+00,0.3233e+00,0.3016e+00,0.2832e+00,
7207 *0.2697e+00,0.2609e+00,0.2552e+00,0.2509e+00,0.2465e+00,0.2418e+00,
7208 *0.2364e+00,0.2307e+00,0.2249e+00,0.2191e+00,0.2137e+00,0.2086e+00,
7209 *0.2041e+00,0.2001e+00,0.1968e+00,0.1940e+00,0.1919e+00,0.1905e+00,
7210 *0.1898e+00,0.1897e+00,0.1904e+00,0.1919e+00,0.1941e+00,0.1971e+00,
7211 *0.2011e+00,0.2059e+00,0.2118e+00,0.2187e+00,0.2267e+00,0.2361e+00,
7212 *0.2467e+00,0.2589e+00,0.2727e+00,0.2883e+00,0.3059e+00,0.3155e+00,
7213 *0.3257e+00,0.3478e+00,0.3726e+00,0.4004e+00,0.4315e+00,0.4662e+00,
7214 *0.5050e+00,0.5483e+00,0.5967e+00,0.6507e+00,0.7110e+00,0.7783e+00,
7215 *0.8536e+00,0.9376e+00,0.1032e+01,0.1137e+01,0.1254e+01,0.1385e+01,
7216 *0.1531e+01,0.1695e+01,0.1878e+01,0.2083e+01,0.2311e+01,0.2566e+01,
7217 *0.2850e+01,0.3166e+01,0.3518e+01,0.3910e+01,0.4344e+01,0.4825e+01,
7218 *0.5358e+01,0.5947e+01,0.6597e+01,0.7314e+01,0.8106e+01,0.8978e+01,
7219 *0.9939e+01,0.1099e+02,0.1211e+02,0.1319e+02,0.1367e+02/
7220 DATA ((phr(i,j),j=1,83),i=06,06) /
7221 *0.3540e+00,0.3501e+00,0.3360e+00,0.3166e+00,0.2969e+00,0.2801e+00,
7222 *0.2677e+00,0.2594e+00,0.2541e+00,0.2500e+00,0.2461e+00,0.2417e+00,
7223 *0.2369e+00,0.2317e+00,0.2263e+00,0.2211e+00,0.2160e+00,0.2113e+00,
7224 *0.2070e+00,0.2033e+00,0.2001e+00,0.1976e+00,0.1956e+00,0.1943e+00,
7225 *0.1937e+00,0.1937e+00,0.1945e+00,0.1960e+00,0.1982e+00,0.2013e+00,
7226 *0.2053e+00,0.2102e+00,0.2162e+00,0.2232e+00,0.2313e+00,0.2408e+00,
7227 *0.2516e+00,0.2639e+00,0.2779e+00,0.2937e+00,0.3115e+00,0.3213e+00,
7228 *0.3315e+00,0.3540e+00,0.3791e+00,0.4073e+00,0.4387e+00,0.4739e+00,
7229 *0.5131e+00,0.5569e+00,0.6057e+00,0.6603e+00,0.7211e+00,0.7890e+00,
7230 *0.8647e+00,0.9493e+00,0.1044e+01,0.1149e+01,0.1267e+01,0.1398e+01,
7231 *0.1545e+01,0.1708e+01,0.1891e+01,0.2095e+01,0.2322e+01,0.2575e+01,
7232 *0.2856e+01,0.3169e+01,0.3517e+01,0.3902e+01,0.4328e+01,0.4799e+01,
7233 *0.5318e+01,0.5890e+01,0.6519e+01,0.7208e+01,0.7963e+01,0.8788e+01,
7234 *0.9685e+01,0.1065e+02,0.1166e+02,0.1261e+02,0.1301e+02/
7235 DATA ((phr(i,j),j=1,83),i=07,07) /
7236 *0.3121e+00,0.3097e+00,0.3008e+00,0.2882e+00,0.2753e+00,0.2643e+00,
7237 *0.2562e+00,0.2509e+00,0.2473e+00,0.2445e+00,0.2417e+00,0.2384e+00,
7238 *0.2348e+00,0.2307e+00,0.2265e+00,0.2223e+00,0.2182e+00,0.2144e+00,
7239 *0.2109e+00,0.2078e+00,0.2052e+00,0.2030e+00,0.2014e+00,0.2004e+00,
7240 *0.2000e+00,0.2002e+00,0.2011e+00,0.2027e+00,0.2051e+00,0.2082e+00,
7241 *0.2123e+00,0.2173e+00,0.2232e+00,0.2303e+00,0.2386e+00,0.2482e+00,
7242 *0.2591e+00,0.2717e+00,0.2859e+00,0.3019e+00,0.3201e+00,0.3300e+00,
7243 *0.3404e+00,0.3633e+00,0.3889e+00,0.4176e+00,0.4496e+00,0.4854e+00,
7244 *0.5253e+00,0.5699e+00,0.6196e+00,0.6749e+00,0.7367e+00,0.8055e+00,
7245 *0.8822e+00,0.9677e+00,0.1063e+01,0.1169e+01,0.1288e+01,0.1419e+01,
7246 *0.1566e+01,0.1730e+01,0.1912e+01,0.2115e+01,0.2341e+01,0.2591e+01,
7247 *0.2869e+01,0.3177e+01,0.3518e+01,0.3895e+01,0.4309e+01,0.4765e+01,
7248 *0.5265e+01,0.5811e+01,0.6405e+01,0.7049e+01,0.7744e+01,0.8489e+01,
7249 *0.9280e+01,0.1010e+02,0.1093e+02,0.1165e+02,0.1192e+02/
7250 DATA ((phr(i,j),j=1,83),i=08,08) /
7251 *0.3070e+00,0.3061e+00,0.3027e+00,0.2975e+00,0.2918e+00,0.2865e+00,
7252 *0.2821e+00,0.2787e+00,0.2760e+00,0.2735e+00,0.2711e+00,0.2684e+00,
7253 *0.2656e+00,0.2626e+00,0.2594e+00,0.2562e+00,0.2530e+00,0.2500e+00,
7254 *0.2471e+00,0.2446e+00,0.2423e+00,0.2404e+00,0.2390e+00,0.2380e+00,
7255 *0.2375e+00,0.2377e+00,0.2385e+00,0.2400e+00,0.2422e+00,0.2453e+00,
7256 *0.2493e+00,0.2543e+00,0.2604e+00,0.2677e+00,0.2762e+00,0.2861e+00,
7257 *0.2976e+00,0.3108e+00,0.3258e+00,0.3428e+00,0.3620e+00,0.3725e+00,
7258 *0.3836e+00,0.4079e+00,0.4351e+00,0.4655e+00,0.4993e+00,0.5371e+00,
7259 *0.5791e+00,0.6258e+00,0.6776e+00,0.7351e+00,0.7988e+00,0.8694e+00,
7260 *0.9476e+00,0.1034e+01,0.1130e+01,0.1236e+01,0.1353e+01,0.1482e+01,
7261 *0.1625e+01,0.1783e+01,0.1957e+01,0.2148e+01,0.2359e+01,0.2590e+01,
7262 *0.2844e+01,0.3121e+01,0.3424e+01,0.3754e+01,0.4112e+01,0.4498e+01,
7263 *0.4913e+01,0.5356e+01,0.5826e+01,0.6320e+01,0.6833e+01,0.7358e+01,
7264 *0.7884e+01,0.8390e+01,0.8846e+01,0.9187e+01,0.9295e+01/
7265 DATA ((phr(i,j),j=1,83),i=09,09) /
7266 *0.3321e+00,0.3315e+00,0.3294e+00,0.3266e+00,0.3238e+00,0.3214e+00,
7267 *0.3192e+00,0.3169e+00,0.3142e+00,0.3111e+00,0.3075e+00,0.3036e+00,
7268 *0.2994e+00,0.2950e+00,0.2905e+00,0.2860e+00,0.2817e+00,0.2775e+00,
7269 *0.2735e+00,0.2698e+00,0.2665e+00,0.2635e+00,0.2609e+00,0.2587e+00,
7270 *0.2571e+00,0.2561e+00,0.2556e+00,0.2558e+00,0.2568e+00,0.2586e+00,
7271 *0.2613e+00,0.2650e+00,0.2697e+00,0.2756e+00,0.2827e+00,0.2913e+00,
7272 *0.3013e+00,0.3131e+00,0.3267e+00,0.3422e+00,0.3600e+00,0.3698e+00,
7273 *0.3802e+00,0.4030e+00,0.4287e+00,0.4575e+00,0.4899e+00,0.5261e+00,
7274 *0.5665e+00,0.6115e+00,0.6617e+00,0.7175e+00,0.7795e+00,0.8484e+00,
7275 *0.9248e+00,0.1010e+01,0.1103e+01,0.1208e+01,0.1323e+01,0.1451e+01,
7276 *0.1592e+01,0.1749e+01,0.1922e+01,0.2113e+01,0.2324e+01,0.2557e+01,
7277 *0.2813e+01,0.3095e+01,0.3403e+01,0.3740e+01,0.4106e+01,0.4502e+01,
7278 *0.4928e+01,0.5383e+01,0.5863e+01,0.6364e+01,0.6878e+01,0.7395e+01,
7279 *0.7898e+01,0.8366e+01,0.8764e+01,0.9041e+01,0.9119e+01/
7280 DATA ((phr(i,j),j=1,83),i=10,10) /
7281 *0.4248e+00,0.4242e+00,0.4221e+00,0.4189e+00,0.4153e+00,0.4116e+00,
7282 *0.4081e+00,0.4045e+00,0.4006e+00,0.3964e+00,0.3918e+00,0.3869e+00,
7283 *0.3818e+00,0.3764e+00,0.3709e+00,0.3654e+00,0.3600e+00,0.3547e+00,
7284 *0.3495e+00,0.3446e+00,0.3401e+00,0.3359e+00,0.3321e+00,0.3288e+00,
7285 *0.3260e+00,0.3239e+00,0.3224e+00,0.3218e+00,0.3219e+00,0.3230e+00,
7286 *0.3251e+00,0.3282e+00,0.3326e+00,0.3383e+00,0.3455e+00,0.3542e+00,
7287 *0.3646e+00,0.3768e+00,0.3911e+00,0.4075e+00,0.4263e+00,0.4366e+00,
7288 *0.4476e+00,0.4717e+00,0.4989e+00,0.5293e+00,0.5633e+00,0.6011e+00,
7289 *0.6431e+00,0.6896e+00,0.7410e+00,0.7977e+00,0.8603e+00,0.9291e+00,
7290 *0.1005e+01,0.1088e+01,0.1179e+01,0.1278e+01,0.1387e+01,0.1506e+01,
7291 *0.1636e+01,0.1778e+01,0.1933e+01,0.2100e+01,0.2283e+01,0.2480e+01,
7292 *0.2693e+01,0.2923e+01,0.3169e+01,0.3433e+01,0.3713e+01,0.4009e+01,
7293 *0.4319e+01,0.4642e+01,0.4973e+01,0.5308e+01,0.5640e+01,0.5962e+01,
7294 *0.6262e+01,0.6528e+01,0.6740e+01,0.6876e+01,0.6911e+01/