PROGRAM SYNSPEC
C
C =====================================================================I
C                                                                      I
C Program for evaluting synthetic spectra for a given model atmosphere I
C                                                                      I
C *****************                                                    I
C VERSION SYNSPEC54                                                    I
C *****************                                                    I
C                                                                      I
C Input: the same as input to TLUSTY or TLUSDISK - unit 5              I
C        additional 6 lines of input - unit 55 (proc. START and INIBL0)I
C        chemical composition - unit 56 (if a switch is on in unit 55) I
C        model atmosphere - unit 8  (procedures INPMOD or INKUR)       I
C        line list        - unit 19 (procedure INISET)                 I
C                                                                      I
C Output: diagnostic outprint - unit 6 (several procedures)            I
C         synthetic spectrum  - unit 7 (procedure OUTPRI)              I
C         flux in continuum   - unit 17 (procedure OUTPRI)             I
C         identification table- unit 12 (procedure INIBLA)             I
C         partial equiv.widths- unit 16 (procedure OUTPRI)             I
C         elapsed time        - unit 69 (procedure TIMING - UNIX only) I
C                                                                      I
C      -- if specific intensities are also calculated (set up by the   I
C         input on unit 55), there are two aditional output files:     I
C                                                                      I
C         specific intensities - unit 10                               I
C         specific intensities in continuum - unit 18                  I
C                                                                      I
C      -- in the iron-curtain option (IMODE=-2), there is another      I
C         output file:                                                 I
C         monochromatic opacities - unit 27                            I
C                                                                      I
C     ***  The contents of units 7 and 17 serve as an input to the     I
C          program ROTIN, which performs rotational and instrumental   I
C          ROTIN, which performs rotational and instrumental           I
C          convolutions, and sets up files for a plot.                 I
C                                                                      I
C Basic options: controlled by switch IMODE                            I
C IMODE    =  0 - normal synthetic spectrum                            I
C                 (ie. identification table + emergent flux)           I
C          =  1 - detailed profiles of a few individual lines          I
C          =  2 - emergent flux in the continuum (without the          I
C                 contribution of lines)                               I
C          = -1 - only identification table, ie. a list of lines which I
C                 contribute to opacity in a given wavelength          I
C                 region, together with their approximate equivalent   I
C                 widths. Synthetic spectrum is not calculated.        I
C          = -2 - the "iron curtain" option, ie. a monochromatic       I
c                 opacity for a homogeneous slab of a given T and n_e  I
C                                                                      I
C                                                                      I
C ==================================================================== I
C
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'LINDAT.FOR'
      include 'MODELP.FOR'
      include 'SYNTHP.FOR'
C
      OPEN(UNIT=12,STATUS='UNKNOWN')
      OPEN(UNIT=14,STATUS='UNKNOWN')
C
C     INITIALIZATION - INPUT OF BASIC PARAMETERS AND MODEL ATMOSPHERE
C
      CALL START
      if(ifeos.gt.0) imode=-3
      if(ibfac.gt.1) then
         LTE0=LTE
         LTE=.TRUE.
      END IF
      IF(IMODE.GE.-2.AND.IFEOS.LE.0) THEN
         IF(INMOD.GT.0) CALL INPMOD
         IF(INMOD.EQ.0) CALL INKUR
         IF(ICHANG.NE.0) CALL CHANGE
         IF(IBFAC.GT.1) THEN
            CALL INPBF
            LTE=LTE0
         END IF
         IF(IFWIN.GT.1) CALL SETWIN
       ELSE
         CALL INGRID(0,inext,0)
      END IF
C
      CALL INIBL0
      CALL INIMOD
      CALL TINT
c
      IMODE0=IMODE
      IF(IMODE0.EQ.-4) IMODE=2
      igrd=0
    1 continue
c
      IF(IMODE0.LE.-3.and.ifeos.le.0) CALL INIBL1(IGRD)
      IF(IFMOL.GT.0) then
         CALL MOLINI
         if(ifeos.ne.0) call eospri
      end if
c
c     zero abundances for selected species (if required)
c
      if(imode0.le.-3) call abnchn(1)
c
      IBLANK=0
      NXTSET=0
      IF(IFMOL.GT.0.AND.IMODE.LT.2) THEN
         DO ILIST=1,NMLIST
            NXTSEM(ILIST)=0
            INACTM(ILIST)=0
            NLINMT(ILIST)=0
         END DO
      END IF
c
      if(ifeos.le.0) then
      IF(IMODE.LT.2) CALL INILIN
C
      IF(IFMOL.GT.0.AND.IMODE.LT.2) THEN
         DO ILIST=1,NMLIST
            IF(IMODE.EQ.-3.AND.TEMP(1).LT.TMLIM(ILIST))
     *      CALL INMOLI(ILIST)
            IF(IMODE.GE.-2.and.imode.le.1) CALL INMOLI(ILIST)
         END DO
      END IF
      end if
c
    5 CONTINUE
c
C     ACTUAL CALCULATION OF THE SYNTHETIC SPECTRUM
C
      IF(IFEOS.GT.0) GO TO 30
   10 IBLANK=IBLANK+1
      IF(IFWIN.LE.0) THEN
         CALL RESOLV
         IF(IMODE0.LT.0) GO TO 20
         if(ifreq.le.10.and.inmod.le.1) then
            CALL RTECD
          else
            call RTE
         end if
       else
         CALL RESOLW
      end if
      CALL OUTPRI
   20 CONTINUE
      if((imode.ge.0.and.imode.ne.7.and.iprin.ge.1).or.
     *   (imode.lt.0.and.iprin.ge.2)) then
         CALL IDTAB
         IF(IFMOL.GT.0) CALL IDMTAB
      end if
      IF(IBLANK.LT.NBLANK) GO TO 10
      IF(NXTSET.EQ.1.AND.IRLIST.EQ.0) THEN 
        IF(IMODE.LT.2) CALL INILIN
        GO TO 5
      END IF
      IF(IFMOL.GT.0.AND.IMODE.LT.2.AND.IRLIST.GT.0) THEN
         DO ILIST=1,NMLIST
            IF(NXTSEM(ILIST).EQ.1.and.inactm(ilist).eq.0) THEN
               CALL INMOLI(ILIST)
               iblank=0
               GO TO 5
            END IF
         END DO
      END IF
   30 CONTINUE
c
      if(imode0.lt.-2) then
         call ingrid(1,inext,igrd)
         igrd=igrd+1
c        call timing(1,igrd)
         if(inext.gt.0) go to 1
      end if
      if(imode0.le.-3.and.ifeos.le.0) call fingrd
      call timing(2,iblank)
      END