SUBROUTINE OPACW(ID,CROSS,ABSO,EMIS,
     *                 ABSOC,EMISC,SCATC,MODC)
C     ========================================
C
C     Absorption, emission, and scattering coefficients
C     at depth ID and for several frequencies (some or all)
C
C     Input: ID    - depth index
C            CROSS - two dimensional array of photoionization
C                    cross-sections
C     Output: ABSO - array of absorption coefficient
C             EMIS - array of emission coefficient
C             SCAT - array of scattering coefficient (all scattering
C                    mechanisms except electron scattering)
C
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'LINDAT.FOR'
      INCLUDE 'SYNTHP.FOR'
      INCLUDE 'WINCOM.FOR'
      DIMENSION CROSS(MCROSS,MFRQ)
      DIMENSION ABSO(MFREQ),EMIS(MFREQ),SCAT(MFREQ),
     *          ABSOC(MFREQC),EMISC(MFREQC),SCATC(MFREQC),
     *          ABLIN(MFREQ),EMLIN(MFREQ),
     *          ABL1(MFREQC),EML1(MFREQC),SCL1(MFREQC)
      COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
      common/dissol/fropc(mlevel),indexp(mlevel)
      common/lasers/lasdel
      PARAMETER (UN=1.,TEN15=1.E-15,CSB=2.0706E-16,CFF=3.694E8)
C
      IF(IMODE.EQ.-1.AND.ID.NE.IDSTD) RETURN
      T=TEMP(ID)
      ANE=ELEC(ID)
      T1=UN/T
      HKT=HK*T1
      TK=HKT/H
      SRT=UN/SQRT(T)
      SGFF=CFF*SRT
      CON=CSB*T1*SRT
      conts=1.e-36/con
      ABLY=0.
      EMLY=0.
      SCLY=0.
      IJ0=2
      IF(NFREQ.EQ.1) IJ0=1
      IF(IMODE.EQ.2) IJ0=NFREQ
      M=3
C
C     Opacity and emissivity in continuum
C     **** calculated only for the continuum frequencies *****
C
      DO 200 IJ=1,NFREQC
         FR=FREQC(IJ)
         FR15=FR*TEN15
         BNU=BN*FR15*FR15*FR15
         HKF=HKT*FR
         ABF=0.
         EBF=0.
         AFF=0.
         DO 100 IL=1,NION
            N0I=NFIRST(IL)
            N1I=NLAST(IL)
            NKE=NNEXT(IL)
            XN=POPUL(NKE,ID)
C
C           Bound-free contribution + possibly
c            pseudo-continuum (accounting for dissolved fraction)
C
            DO 10 II=N0I,N1I
               SG=0.
               IF(IFWOP(II).LT.0) THEN
                  SG=SGMERG(II,ID,FR)
                ELSE
                  SG=CROSS(II,IJ)
                  IF(INDEXP(II).EQ.5) THEN
                     IZZ=IZ(IEL(II))
                     FR0=ENION(II)/6.6256E-27
                     CALL DWNFR1(FR,FR0,ID,IZZ,DW1)
                     SG=SG*DW1
                  END IF
               END IF
               ABF=ABF+SG*POPUL(II,ID)
               XX=SG*XN*EXP(ENION(II)*TK)*WOP(II,ID)
               IF(XX.lt.conts) go to 10
               EBF=EBF+XX*CON*G(II)/G(NKE)
   10       CONTINUE
            IT=IFREE(IL)
            IF(IT.EQ.0) GO TO 100
C
C           Free-free contribution
C
            IE=IL
            IF(IE.EQ.IELHM) GO TO 65
            CH=IZ(IL)*IZ(IL)
            SF1=CH*XN*SGFF/(FR*FR*FR)
C
C           The following expression is the so-called modified free-free
C           opacity, ie. allowing for the photoionization from higher,
C           non-explicit, LTE energy levels of the ion IL
C
            HKFM=HKT*MIN(FF(IL),FR)
            SF2=EXP(HKFM)
            IF(IT.NE.2) GO TO 50
            SG=GFREE(T,FR/CH)
            SF2=SF2+SG-UN
   50       SFF=SF1*SF2
            GO TO 70
   65       SFF=SFFHMI(XN,FR,T)
   70       AFF=AFF+SFF
  100    CONTINUE
C
C        Additional opacities
C
         CALL OPADD(0,ID,FR,ABAD,EMAD,SCAD)   
         IF(IOPHLI.NE.0) CALL LYMLIN(ID,FR,ABLY,EMLY,SCLY)
C
C        Total opacity and emissivity
C
         X=EXP(-HKF)
         X1=UN-X
         BNE=BNU*X*ANE
         ABSOC(IJ)=ABF+ANE*(X1*AFF-X*EBF)+ANE*SIGE+ABAD+ABLY
         EMISC(IJ)=BNE*(AFF+EBF)+EMAD+EMLY
         SCATC(IJ)=SCAD+SCLY
         ABL1(IJ)=ABLY
         EML1(IJ)=EMLY
         SCL1(IJ)=SCLY
  200 CONTINUE
c       
      if(modc.eq.0) return
c       
      IF(NFREQ.LE.2.OR.IMODE.EQ.-1) RETURN
C
C     interpolated continuum and hydrogen line opacity and emissivity
C     for all frequencies
C
      DO IJ=1,NFREQ
         IJC=IJCINT(IJ)
         ABSO(IJ)=FRX1(IJ)*ABSOC(IJC)+(1.-FRX1(IJ))*ABSOC(IJC+1)
         EMIS(IJ)=FRX1(IJ)*EMISC(IJC)+(1.-FRX1(IJ))*EMISC(IJC+1)
         SCAT(IJ)=FRX1(IJ)*SCATC(IJC)+(1.-FRX1(IJ))*SCATC(IJC+1)
      END DO
      IF(IMODE.EQ.2) GO TO 225
C
C     **** Opacity and emissivity in lines ****
C
      CALL LINOPW(ID,ABLIN,EMLIN)
      DO IJ=1,NFREQ
         ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
         EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
      END DO
C
C     **** Opacity and emissivity in molecular lines ****
C
      if(ifmol.gt.0) then
      do ilist=1,nmlist
      CALL MOLOP(ID,ABLIN,EMLIN,AVAB,ILIST)
      DO IJ=1,NFREQ
         ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
         EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
      END DO
      end do
      end if
  225 CONTINUE
C
C     **** Detailed opacity and emissivity in hydrogen lines ****
C
      CALL HYDLIW(ID,ABLIN,EMLIN)
      DO IJ=1,NFREQ
         ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
         EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
      END DO
C
C     **** Detailed opacity and emissivity in HE II lines ****
C          (for IHE2L=1)
C
      CALL HE2LIW(ID,ABLIN,EMLIN)
      DO IJ=1,NFREQ
         ABSO(IJ)=ABSO(IJ)+ABLIN(IJ)
         EMIS(IJ)=EMIS(IJ)+EMLIN(IJ)
      END DO
C
C     opacity due to detailed photoinization cross-section
C     (from tables; including resonance features)
C     The two routines may be called and correspond to different formats
C     as well as difference in INPUT!
C
      CALL PHTION(ID,ABSO,EMIS,FREQ,NFREQ)
      CALL PHTX(ID,ABSO,EMIS,FREQ,0)
C
      IF(ICONTL.EQ.1) RETURN
      DO IJ=1,NFREQC
         ABSOC(IJ)=ABSOC(IJ)-ABL1(IJ)
         EMISC(IJ)=EMISC(IJ)-EML1(IJ)
         SCATC(IJ)=SCATC(IJ)-SCL1(IJ)
      END DO
      RETURN
      END