git push -u origin main
This commit is contained in:
@@ -0,0 +1,174 @@
|
||||
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
|
||||
Reference in New Issue
Block a user