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