175 lines
6.5 KiB
Fortran
175 lines
6.5 KiB
Fortran
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
|