89 lines
2.5 KiB
Fortran
89 lines
2.5 KiB
Fortran
subroutine frac1
|
|
c ================
|
|
c
|
|
include 'PARAMS.FOR'
|
|
include 'MODELP.FOR'
|
|
parameter (mtemp=100,melec=60,mion1=30)
|
|
dimension xxt(mdepth),xxe(mdepth)
|
|
dimension kt0(mdepth),kn0(mdepth)
|
|
common/fracop/frac(mtemp,melec,mion1),fracm(mtemp,melec),
|
|
* itemp(mtemp),ntt
|
|
c
|
|
do id=1,nd
|
|
xxt(id)=dlog10(temp(id))
|
|
kt0(id)=2*int(20.*xxt(id))
|
|
xxe(id)=dlog10(elec(id))
|
|
kn0(id)=int(2.*xxe(id))
|
|
end do
|
|
c
|
|
DO 20 IAT=1,30
|
|
iatnum=iat
|
|
call fractn(iatnum)
|
|
if(iatnum.le.0) goto 20
|
|
do id=1,nd
|
|
if(kt0(id).lt.itemp(1)) then
|
|
kt1=1
|
|
write(6,611) id,temp(id)
|
|
611 format(' (FRACOP) Extrapol. in T (low)',i4,f7.0)
|
|
goto 41
|
|
endif
|
|
if(kt0(id).ge.itemp(ntt)) then
|
|
kt1=ntt-1
|
|
write(6,612) id,temp(id)
|
|
612 format(' (FRACOP) Extrapol. in T (high)',i4,f12.0)
|
|
goto 41
|
|
endif
|
|
do 40 it=1,ntt
|
|
if(kt0(id).eq.itemp(it)) then
|
|
kt1=it
|
|
goto 41
|
|
endif
|
|
40 continue
|
|
41 continue
|
|
if(kn0(id).lt.1) then
|
|
kn1=1
|
|
goto 49
|
|
endif
|
|
if(kn0(id).ge.60) then
|
|
kn1=59
|
|
write(6,614) id,xxe(id)
|
|
614 format(' (FRACOP) Extrapol. in Ne (high)',i4,f9.4)
|
|
goto 49
|
|
endif
|
|
kn1=kn0(id)
|
|
49 continue
|
|
xt1=0.025*itemp(kt1)
|
|
dxt=0.05
|
|
at1=(xxt(id)-xt1)/dxt
|
|
xn1=0.5*kn1
|
|
dxn=0.5
|
|
an1=(xxe(id)-xn1)/dxn
|
|
do ion=1,mion1
|
|
x11=frac(kt1,kn1,ion)
|
|
x21=frac(kt1+1,kn1,ion)
|
|
x12=frac(kt1,kn1+1,ion)
|
|
x22=frac(kt1+1,kn1+1,ion)
|
|
x1221=x11*x21*x12*x22
|
|
if(x1221.eq.0.) then
|
|
xx1=x11+at1*(x21-x11)
|
|
xx2=x12+at1*(x22-x12)
|
|
rrx=xx1+an1*(xx2-xx1)
|
|
else
|
|
x11=dlog10(x11)
|
|
x21=dlog10(x21)
|
|
x12=dlog10(x12)
|
|
x22=dlog10(x22)
|
|
xx1=x11+at1*(x21-x11)
|
|
xx2=x12+at1*(x22-x12)
|
|
rrx=xx1+an1*(xx2-xx1)
|
|
rrx=exp(2.3025851*rrx)
|
|
endif
|
|
rrr(id,ion,iat)=rrx*abndd(iat,id)*
|
|
* dens(id)/wmm(id)/ytot(id)
|
|
end do
|
|
end do
|
|
20 CONTINUE
|
|
c
|
|
return
|
|
end
|