git push -u origin main

2026-03-19 14:05:33 +08:00
commit 1e30b7bc63
739 changed files with 572150 additions and 0 deletions
@@ -0,0 +1,88 @@
+      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