SUBROUTINE INISET
C     =================
C
C     SELECTION OF LINES THAT MAY CONTRIBUTE,
C     SET UP AUXILIARY FIELDS CONTAINING LINE PARAMETERS,
C     SET UP THE SET OF FREQUENCY POINTS
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'SYNTHP.FOR'
      INCLUDE 'LINDAT.FOR'
      INCLUDE 'WINCOM.FOR'
      COMMON/LIMPAR/ALAM0,ALAM1,FRMIN,FRLAST,FRLI0,FRLIM
      COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
      COMMON/CTRFUN/CINT1(MDEPTH),CINT2(MDEPTH),
     *   CTRI(MDEPTH),CTRR(MDEPTH),XKAR(MDEPTH),
     *   ABXLI(MFREQ),EMXLI(MFREQ),IJCTR(MFREQ)
      SAVE ILLAST
C
      DATA CNM,CAS /2.997925D17,2.997925D18/
c      DATA C1,C2,C3 /2.3025851, 4.2014672, 1.4387886/
C
      DO 10 I=1,MFRQ
         W(I)=0.
         IJCTR(I)=0
   10 CONTINUE
C
      IL0=0
      IPRSET=0
      NLIN=0
      IREADP=1
      IRLIST=0
      IF(IBLANK.LE.1.OR.IMODE.EQ.1.OR.IMODE.EQ.-1) IREADP=0
      IF(IBLANK.LE.1) APREV=0.
      FRMIN=CNM/ALAM0
      FRM=FRMIN
      if(ifwin.le.0) then
         ij0=3
       else
         ij0=1
      end if
      IJ=IJ0
      FREQ(IJ0)=FRM
      SPACE=SPACE0
      IF(ALAMC.GT.0.) SPACE=SPACE0*ALAM0/ALAMC
      IF(SPACE0.LT.0.) SPACE=-SPACE0
      IF(IMODE.EQ.2) THEN
         NFRP=NFREQS+1
         W0=SPACE
         GO TO 105
      END IF
C
      ISTR=0
      IJMAX=0
      IMOD1L=0
      if(ifwin.le.0) then
      CUTOFF=CUTOF0
      DOPSTD=1.E7/ALAM0*DSTD
      DISTAN=0.15*DOPSTD
      SPAC=3.E16/ALAM0/ALAM0*SPACE
      DISTA0=0.14*SPAC
      ASTD=1.0
      AVAB=ABSTD(IDSTD)*RELOP
      end if
      FRLI0=FRMIN
      IF(IBLANK.GE.2.AND.IMODE.EQ.-1) IL0=ILLAST
C
   20 CONTINUE 
C
C     set up indices of lines
C     IL0 - is the current index of line in the numbering of all lines
C
      IF(IREADP.EQ.1) THEN
         IPRSET=IPRSET+1
         IL0=INDLIP(IPRSET)
         IF(FREQ0(IL0).LT.FRMIN) THEN
            IREADP=0
            IL0=INDLIP(IPRSET-1)+1
         END IF
       ELSE
         IL0=IL0+1
      END IF
      IF(IL0.GT.NLIN0) GO TO 210
      FRLIM=FRLI0
      FR0=FREQ0(IL0)
      ALAM=CNM/FR0
C  
      if(ifwin.gt.0) then
      IF(ALAMC.GT.0.) SPACE=SPACE0*ALAM/ALAMC
      IF(SPACE0.LT.0.) SPACE=-SPACE0
      CUTOFF=CUTOF0*ALAM/ALAMC
      DOPSTD=1.E7/ALAM*DSTD
      DISTAN=0.15*DOPSTD
      SPAC=SPACE
      IF(MOD(IFREQ,10).GT.0) SPAC=3.E16/ALAM/ALAM*SPACE
      DISTA0=0.14*SPAC
      end if
C
C     set up a different starting wavelength for IMODE=1
C
      IF(IMODE.NE.1) GO TO 45
      IF(ISTR.EQ.1.OR.IJ.NE.3) GO TO 45
      IF(ALAM.LT.ALAM0+2.*CUTOFF) GO TO 45
      ALAM0=ALAM-CUTOFF+0.0001
      FRMIN=CNM/ALAM0
      FRM=FRMIN
      IJ=IJ0
      FREQ(IJ0)=FRM
   45 CONTINUE
      IF(ALAM.LT.ALAM0-CUTOFF) GO TO 20
      IF(IJ.LT.NFREQS+1) GO TO 50
      IF(ALAM.GT.ALAM1+CUTOFF) GO TO 210
C
C     SECOND SELECTION : FOR LINE STRENGHTS
C
   50 CONTINUE
      ISTR=0
      IF(IMODE.GE.1) THEN
         ISTR=1
       ELSE
         EXT=EXTIN(IL0)
         FRLI0=FR0-EXT-SPAC
         IF(FRLI0.GT.FRLIM) FRLI0=FRLIM
         frmiv=frmin
         if(ifwin.gt.0) frmiv=frmiv*(1.+vinf/2.997925e10)
         IF(ALAM.LT.ALAM0.AND.FR0-FRMIv.GT.EXT+SPAC) GO TO 20
         ISTR=1
         frmav=frmax
         if(ifwin.gt.0) frmav=frmav*(1.-vinf/2.997925e10)
         IF(IJ.GE.NFREQS+1.AND.FRMAv-FR0.GT.EXT+SPAC) GO TO 20
      END IF

C
      NLIN=NLIN+1
      if(nlin.gt.mlin) call quit(' too many lines in a set')
      INDLIN(NLIN)=IL0
      ALAMCU=ALAM+CUTOFF
C
C     FREQUENCY POINTS AND WEIGHTS
C
      IF(IJ.GE.NFREQS+1) GO TO 20
      IF(FR0.GT.FRMIN) GO TO 20
  100 DELT=ABS(FRM-FR0)
      IF(DELT.LT.DISTA0.AND.IMODE.NE.1) GO TO 20
      DFREL=CNM*(1.D0/FR0-1.D0/FRM)/SPACE
      NFRP=int(DFREL)+1
      IF(NFRP.LE.2) NFRP=2
      W0=CNM*(1.D0/FR0-1.D0/FRM)/NFRP
      FRM=FR0
  105 FRACT=FREQ(IJ)
      ALACT=CNM/FRACT
C
      DO 110 K=1,NFRP
         FRACT=FRACT-W0
         ALACT=ALACT+W0
         IF(IMODE.GE.1.OR.NFRP.EQ.2) GO TO 107
         IF(FRACT.LT.FRLIM.AND.FRACT.GT.FR0+EXT+SPAC) GO TO 110
  107    IJ=IJ+1
         IF(IJ.GT.NFREQS) GO TO 130
         FREQ(IJ)=CNM/ALACT
         W(IJ)=W(IJ)+(FREQ(IJ-1)-FREQ(IJ))*0.5
         W(IJ-1)=W(IJ-1)+(FREQ(IJ-1)-FREQ(IJ))*0.5
C        IF(FREQ(IJ).LT.FRLAST) GO TO 220
         IF(IMODE.EQ.1.AND.ALACT.GT.ALAMCU) GO TO 140
  110 CONTINUE
      IJCTR(IJ)=IL0
      IF(IMOD1L.EQ.1) GO TO 210
      DISTA0=DISTAN
      GO TO 20
C
  130 FRMAX=FREQ(NFREQS)
      ALAM1=CNM/FRMAX
      NFREQ=NFREQS
      IF(IMODE.EQ.2) GO TO 210
      IF(IMOD1L.EQ.1) GO TO 210
      GO TO 20
C
  140 IJMAX=IJ
      IJMAX=MIN(IJMAX,NFREQS)
      NFREQ=IJMAX
      IF(IL0.LT.NLIN0) THEN
         NBLANK=IBLANK+1
       ELSE
         NBLANK=IBLANK
      END IF
      GO TO 240
C
  210 NBLANK=IBLANK+1
      IF(IJ.GE.NFREQS+1) GO TO 230
      IJMAX=IJ
      IJMAX=MIN(IJMAX,NFREQS)
      NFREQ=IJMAX
      IF(IMODE.NE.1) GO TO 240
      IF(IMOD1L.EQ.1) GO TO 240
C     FR0=MAX(CNM/(ALAM+CUTOFF),FRLAST*0.99999999D0)
      FR0=FRLAST*0.99999999D0
      ALAM=CNM/FR0
      IMOD1L=1
      GO TO 100
C
  230 IJMAX=NFREQS
      NFREQ=NFREQS
  240 IF(FREQ(IJMAX).LE.FRLAST) NBLANK=IBLANK
      if(alm00.gt.0.) then
         if(freq(ijmax).ge.0.999999*cnm/alm00.and.iblank.gt.1)
     *      nblank=iblank
      end if
c
c     correction for molecular lines
c
      if(nmlist.gt.0.and.ifmol.gt.0) then
      do ilist=1,nmlist
         if(alastm(ilist).gt.0..and.alastm(ilist).le.alact) then
          nblank=iblank
          irlist=1
c         write(*,*) 'iniset mol',ilist,alastm(ilist),alam
         end if
      end do
      end if
c
      if(ifwin.le.0) then
      FREQ(1)=FREQ(3)
      FREQ(2)=FREQ(IJMAX)
      W(1)=0.5*(FREQ(1)-FREQ(2))
      W(2)=W(1)
      end if
C
C     truncate the interval if the required end is reached
C
      ijmx=2
      if(ifwin.gt.0) ijmx=ijmax
      IF(FREQ(ijmx).LT.FRLAST) THEN
         FREQ(ijmx)=FRLAST
         if(ifwin.le.0) then
         W(1)=0.5*(FREQ(1)-FREQ(2))
         W(2)=W(1)
         end if
         DO 245 IJ=IJ0,NFREQ
            IF(FREQ(IJ).LT.FRLAST) GO TO 247
            IJMAX=IJ
  245    CONTINUE
  247    NFREQ=IJMAX+1
         FREQ(NFREQ)=FRLAST
         W(NFREQ)=0.5*(FREQ(NFREQ-1)-FREQ(NFREQ))
         W(NFREQ-1)=W(NFREQ)+0.5*(FREQ(NFREQ-2)-FREQ(NFREQ-1))
      END IF
C
C     frequency interpolation coefficients
C
      IF(IMODE.NE.-1) THEN
      if(ifwin.le.0) then
      XX=FREQ(2)-FREQ(1)
      DO IJ=1,NFREQ
         WLAM(IJ)=2.997925E18/FREQ(IJ)
         FRX1(IJ)=(FREQ(IJ)-FREQ(1))/XX
         FRX2(IJ)=(FREQ(2)-FREQ(IJ))/XX
      END DO
      else
      DO IJ=1,NFREQ
         WLAM(IJ)=CAS/FREQ(IJ)
         frqobs(ij)=freq(ij)
         wlobs(ij)=wlam(ij)
         fr=freq(ij)
         BNUE(IJ)=BN*fr*fr*fr
         DO IJCI=1,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))
      END DO
      nfrobs=nfreq
      xx=freq(nfreq)-freq(1)
      end if
c
c     frequency indices of the line centers
c
      DFRCON=NFREQ-ij0
      DFRCON=-DFRCON/XX
      IFRCON=INT(DFRCON)
      DO 255 IL=1,NLIN
         fr0=freq0(indlin(il))
         XJC=3.+DFRCON*(FREQ(1)-FR0)
         IJC=INT(XJC)
         IJCNTR(IL)=IJC
         if(ijc.le.ij0.or.ijc.ge.nfreq) go to 255
         if(fr0.lt.freq(ijc)) then
            ijc0=ijc
            dfr0=freq(ijc0)-fr0
  252       ijc0=ijc0+1
            dfr=abs(freq(ijc0)-fr0)
            if(dfr.lt.dfr0) then
               ijc=ijc0
               ijc0=ijc0+1
               dfr0=dfr
               go to 252
            end if
          else if(fr0.gt.freq(ijc)) then
            ijc0=ijc
            dfr0=fr0-freq(ijc0)
  254       ijc0=ijc0-1
            dfr=abs(freq(ijc0)-fr0)
            if(dfr.lt.dfr0) then
               ijc=ijc0
               ijc0=ijc0-1
               dfr0=dfr
               go to 254
            end if
         end if
         IJCNTR(IL)=IJC
  255 continue
      END IF
C
      if(ifwin.gt.0) then
C
c     set up switches for hydrogen and He II line opacity
c
      DO  IJ=1,NFREQ
         call hylsew(ij)
         call he2sew(ij)
      end do
      end if
C
      NSP=0
      DO 260 IL=1,NLIN
         IL0=INDLIN(IL)
         ISP=ISPRF(IL0)
         IF(ISP.GT.5) THEN
            NSP=NSP+1
            ISP0(NSP)=ISP
         END IF
         INDLIP(IL)=INDLIN(IL)
  260 CONTINUE
      if(ifwin.le.0) then
      ILLAST=INDLIN(NLIN)
      else
      ILLAST=0
      IF(NLIN.GT.0) ILLAST=INDLIN(NLIN)
      end if
C
      CALL READPH
C
      IF(ALAM0.LE.APREV+0.001) NBLANK=IBLANK
      APREV=ALAM0
      ALAM0=ALAM1
      ALM00=CNM/FREQ(NFREQ)
c
c      write(6,611) iblank,nblank,irlist,aprev*10.,alam0*10.
c 611  format('inis ',2i6,i3,3f10.3)
      RETURN
      END