SUBROUTINE RESOLW
C     =================
C
C     driver for evaluating opacities and emissivities which then
C     enter the solution of the radiative transfer equation (RTEWIN)
C     Setup opacities for a given frequency set 
C     Oversample in radial and frequency space for later interpolation
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'SYNTHP.FOR'
      INCLUDE 'WINCOM.FOR'
      PARAMETER (UN=1., TWO=2., HALF=0.5)
      DIMENSION CROSS(MCROSS,MOPAC),
     *          ABSO(MOPAC),EMIS(MOPAC),
     *          ABSOC(MFREQC),EMISC(MFREQC),SCATC(MFREQC)
      DIMENSION ABSD(MDEPTH),ASF(MDEPF),XDS(MDEPTH),XDSF(MDEPF)
      COMMON/CONOPA/CHC(MFREQC,MDEPTH),ETC(MFREQC,MDEPTH),
     *              SCC(MFREQC,MDEPTH)
      COMMON/HPOPST/HPOP
      COMMON/COPAC/AB(MOPAC,MDEPF),STH(MOPAC,MDEPF),SCH(MFREQC,MDEPF)
      COMMON/LIMPAR/ALAM0,ALAM1,FRMIN,FRLAST,FRLI0,FRLIM
      COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
      COMMON/FRQSET/IFRS,NFRS
      COMMON/EMFLUX/FLUX(MFREQ),FLUXC(MFREQC)
C
C     set up the partial line list for the current interval
C
      CALL INISET
C
C     output of information about selected lines
C
      IF(IMODE.LT.2) CALL INIBLA
C
C  Setup fine grid of frequencies
C
      CLV=UN/2.997925E10
      FQ1=FREQ(1)*(UN+VINF*CLV)
      FQ2=FREQ(NFREQ)*(UN-VINF*CLV)
      VXD=SQRT(0.3e7*TSTD)*FREQ(1)*CLV
      VXS=SPACE0*FREQ(1)*FREQ(1)*CLV*1.e-7
c     DVX=MAX(VXD,VXS)
      DVX=VXS
      NOPAC=int((FQ1-FQ2)/DVX)+1
      DVX=(FQ1-FQ2)/DFLOAT(NOPAC)
      NOPAC=NOPAC+3
      nopac=nfreq
      WRITE(6,600) NOPAC,NDF
      IF(NOPAC.GT.MOPAC) CALL quit('Too many freqs in fine grid')
      DO IJ=1,NOPAC
         FFQ(ij)=FQ1-DFLOAT(ij-1)*DVX
c         freq(ij)=ffq(ij)
c         wlam(ij)=2.997925e18/freq(ij)
         fr=freq(ij)*1.d-15
         BNUE(IJ)=BN*fr*fr*fr
         DO IJCI=IJC,NFREQC-1
            IF(WLAM(IJ).LE.WLAMC(IJCI)) GO TO 248
         END DO
  248    CONTINUE
         IJC=IJCI
         IJCINT(IJ)=MAX(IJC-1,1)
         IJCI=IJCINT(IJ)
         FRX1(IJ)=(FREQ(IJ)-FREQC(IJCI+1))/
     *            (FREQC(IJCI)-FREQC(IJCI+1))
c         write(80,681) ij,ijci,wlam(ij),wlamc(ijci),freq(ij),frx1(ij)
c  681 format(2i5,2f10.3,1p2e11.3)
      END DO
      nfreq=nopac
      DO JI=1,NOPAC-1
        FFQV(JI)=UN/(FFQ(JI)-FFQ(JI+1))
      END DO
      FFQV(NOPAC)=UN
c
c     the continuum opacities and radiation field - done only once
c
c     -----------------------------------
      if(iblank.le.1) then
C
c     determine the "core" radius and the factor that multiplies
c     H_nu at ID=1 to get physical flux there (R2F)
c
      ID0=ND
      DO WHILE(TEMP(ID0).GT.TEFF .AND. ID0.GT.1)
        ID0=ID0-1
      END DO
      ID0=ID0+1
      R2F=RD(1)*RD(1)/RD(ID0)/RD(ID0)
c
C     photoinization cross-sections
C
      CALL CROSEW(CROSS)
C
C     store opacity and emissivity in continuum
C
      DO ID=1,ND
         CALL OPACW(ID,CROSS,ABSO,EMIS,ABSOC,EMISC,SCATC,0)
         DO IJ=1,NFREQC
            CHC(IJ,ID)=ABSOC(IJ) / DENSCON(ID)
            ETC(IJ,ID)=EMISC(IJ) / DENSCON(ID)
            SCC(IJ,ID)=(SCATC(IJ)+ELEC(ID)*SIGE) / DENSCON(ID)
         END DO
      END DO
C
c     radiation field in the continuum
c
      call rtesca
      do ij=1,nfreqc
         write(17,640) wlamc(ij),fluxc(ij)*r2f
      end do
  640 FORMAT(1H ,F10.4,1PE15.5)
c
      end if
c     -----------------------------------
C
C     Store opacity and thermal source function in all frequencies 
C     and depths
C
      DO ID=1,ND
         CALL OPACW(ID,CROSS,ABSO,EMIS,ABSOC,EMISC,SCATC,1)
         DO IJ=1,NOPAC
            AB(IJ,ID)=ABSO(IJ) / DENSCON(ID)
            STH(IJ,ID)=EMIS(IJ)/ABSO(IJ)
         END DO
      END DO
C
c      do id=1,nd
c      do ij=1,nopac
c         write(92,693) id,ij,wlam(ij),ab(ij,id),sth(ij,id)
c      end do
c      end do
c  693 format(2i5,f10.3,1p2e10.3)
C
C  Interpolate to a finer radial (density) grid
C
      if(ndf.ne.nd)  then
      DO ID=1,ND
        XDS(ID)=LOG10(DENS(ID))
      END DO
      DO ID=1,NDF
        XDSF(ID)=LOG10(DENSF(ID))
      END DO
      DO IJ=1,NOPAC
        DO ID=1,ND
          ABSD(ID)=AB(IJ,ID)
        END DO
        CALL INTERP(XDS ,ABSD,XDSF ,ASF,ND,NDF,2,0,1)
        DO ID=1,NDF
          AB(IJ,ID)=ASF(ID)
        END DO
        DO ID=1,ND
          ABSD(ID)=STH(IJ,ID)
        END DO
        CALL INTERP(XDS ,ABSD,XDSF ,ASF,ND,NDF,2,0,1)
        DO ID=1,NDF
          STH(IJ,ID)=ASF(ID)
        END DO
      END DO
      DO IJ=1,NFREQC
        DO ID=1,ND
          ABSD(ID)=SCC(IJ,ID)
        END DO
        CALL INTERP(XDS ,ABSD,XDSF ,ASF,ND,NDF,2,0,1)
        DO ID=1,NDF
          SCH(IJ,ID)=ASF(ID)
        END DO
      END DO
      end if
      WRITE(6,601)
  600 FORMAT(/,' Opacity table for',i5,' frequencies and',/,
     *         '                  ',i5,' radial (density) points')
  601 FORMAT(' Done'/)
C
C
C     Loop on rays, solving radiative transfer equation
C
      DO IJ=1,NFREQ
        FLUX(IJ)=0.
      END DO
      DO IU=2,KMU
        CALL RTEWIN(IU)
      END DO
      DO IJ=1,NFREQ
        FLUX(IJ)=FLUX(IJ)*R2F
      END DO
C
      RETURN
      END