SUBROUTINE OPAINI(IMOD)
C     =======================
C
C     initialization of only depth-dependent quantities
C     for evaluation of opacities
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ODFPAR.FOR'
      INCLUDE 'ALIPAR.FOR'
      DIMENSION PRF(MFREQL),POPP(MLEVEL)
      PARAMETER (CFF1=1.3727D-25,CFF2=4.3748D-10,CFF3=2.5993D-7)
      PARAMETER (SIXTH=UN/6.,CCOR=0.09,T32=1.5D0)
      PARAMETER (SGFF0 = 3.694D8)
      DATA ICOMP /0/
C
      DO ID=1,ND
         WMT=WMM(ID)*YTOT(ID)
         T=TEMP(ID)
         ANE=ELEC(ID)
         ELEC1(ID)=UN/ANE
         DENS1(ID)=UN/DENS(ID)
         DENSI(ID)=DENS1(ID)
         DENSIM(ID)=DENSI(ID)*WMM(ID)
         ELSCAT(ID)=ANE*SIGE
         CALL DWNFR0(ID)
         CALL WNSTOR(ID)
         CALL SABOLF(ID)
         CALL REFLEV(ID,IMOD)
         CALL LEVGRP(ID,IIEXP,0,POPP)
         DO II=1,NLEVEL
            POPINV(II,ID)=0.
            IF(POPUL(II,ID).NE.0.) POPINV(II,ID)=UN/POPUL(II,ID)
         END DO
         DO II=1,NLEVEL
            IIE=IIEXP(II)
            IF(IIE.EQ.0) THEN
               IE=ILTREF(II,ID)
               PP(II,ID)=POPUL(II,ID)*POPINV(IE,ID)
               IF(IABS(IMODL(II)).LE.5) THEN
                  PT(II,ID)=POPUL(II,ID)*DSBPST(II,ID)
                  PN(II,ID)=POPUL(II,ID)*DSBPSN(II,ID)
               END IF
             ELSE IF(IIE.LT.0) THEN
               PP(II,ID)=SBPSI(II,ID)
            END IF
         END DO
         DO ION=1,NION
            USUMS(ION,ID)=USUM(ION)
            DUSMT(ION,ID)=DUSUMT(ION)
            DUSMN(ION,ID)=DUSUMN(ION)
         ENDDO
c
c        quantities for the bound-free opacity
c
         DO IBFT=1,NTRANC
            ITR=ITRBF(IBFT)
            II=ILOW(ITR)
            JJ=IUP(ITR)
            IT=ITRA(JJ,II)
            IE=IEL(II)
            NKE=NNEXT(IE)
            CORR=UN
            IF(NKE.NE.JJ) CORR=G(NKE)/G(JJ)*
     *         EXP((ENION(NKE)-ENION(JJ))*TK1(ID))
            ABTRA(ITR,ID)=POPUL(II,ID)
            EMTRA(ITR,ID)=POPUL(JJ,ID)*ANE*SBF(II)*WOP(II,ID)*CORR
            DEMLT(ITR,ID)=-(T32+FR0(ITR)*HKT1(ID))/TEMP(ID)
         END DO  
c
c        quantities for the free-free opacity
c
         IF(IELHM.GT.0) THEN
            CFFN(ID)=POPUL(NFIRST(IELH),ID)*ANE
            CFFT(ID)=CFF2-CFF3/T
         END IF
         SGFF=SGFF0/SQT1(ID)*ANE
         DO ION=1,NION
            SFF2(ION,ID)=EXP(FF(ION)*HKT1(ID))
            SFF3(ION,ID)=POPUL(NNEXT(ION),ID)*CHARG2(ION)*SGFF
            DSFF(ION,ID)=(FF(ION)*HKT1(ID)+HALF)*TEMP1(ID)
         END DO
      END DO  
      if(izscal.eq.1) then
         do id=1,nd
            densi(id)=un
            densim(id)=0.
         end do
      end if
      CALL SGMER0
C
C     initialization of the line opacity
C
      LASER=ITER.GT.ITLAS
      DO 200 ITR=1,NTRANS
         INDXA=IABS(INDEXP(ITR))
         IF(.NOT.LINE(ITR)) GO TO 200
         II=ILOW(ITR)
         JJ=IUP(ITR)
         IF(INDXA.NE.0.AND.INTMOD(ITR).NE.0 .AND. ICOMP.EQ.0) THEN
            IJL0=IFR0(ITR)
            IJL1=IFR1(ITR)
            IF(ISPODF.GE.1) THEN
               IJL0=KFR0(ITR)
               IJL1=KFR1(ITR)
            END IF
            IF(INDXA.LT.2.OR.INDXA.GT.4) THEN
               DO ID=1,ND
                  CALL LINPRO(ITR,ID,PRF)
                  DO IJ=IJL0,IJL1
                     PRFLIN(ID,IJ)=real(PRF(IJ-IJL0+1))
                  END DO
               END DO
            END IF
         END IF
         GG=G(II)/G(JJ)
         DO ID=1,ND
            IF(IFWOP(JJ).GE.0) THEN
               PI=POPUL(II,ID)*WOP(JJ,ID)
               PJ=GG*POPUL(JJ,ID)*WOP(II,ID)
             ELSE
               PI=POPUL(II,ID)
               PJ=G(II)/GMER(IMRG(JJ),ID)*POPUL(JJ,ID)*WOP(II,ID)
            END IF
            ABTRA(ITR,ID)=PI
            EMTRA(ITR,ID)=PJ*EXP(FR0(ITR)*HKT1(ID))
            DEMLT(ITR,ID)=-FR0(ITR)*HKT21(ID)
            IF(LASER) THEN
            qtt=0.
            if(pi.ne.pj) QTT=PJ/(PI-PJ)*(EXP(FR0(ITR)*HKT1(ID))-UN)
            lfr=fr0(itr).lt.frtabm.and.iadop(iatm(ii)).gt.0
            IF(QTT.LT.0. .OR. QTT.GT.QTLAS .or. lfr) THEN
               ABTRA(ITR,ID)=0.
               EMTRA(ITR,ID)=0.
               DEMLT(ITR,ID)=0.
            END IF
            END IF
c
c           set up ABTRA and EMTRA to 0 in the range where
c           the hydrogen opacity is calculated from Gomez tables
c
            if(ihgom.gt.0.and.elec(id).gt.hglim) then
               if(ii.ge.n0hn.and.ii.le.n0hn-1+ihgom) then
                  abtra(itr,id)=0.
                  emtra(itr,id)=0.
                  demlt(itr,id)=0.
               end if
            end if
         END DO  
  200 CONTINUE
      ICOMP=1
      RETURN
      END