1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
PROGRAM SYNBEG
c revised 18oct99
C
C SYNBEG IS THE FIRST PROGRAM IN THE SYNTHE SERIES.
C IT READS THE INPUT PARAMETERS AND INITIALIZES TAPES 12 AND 13.
C SUBSEQUENT PROGRAMS READ THE ATOMIC AND MOLECULAR LINE DATA
C AND WRITE DATA ON TAPES 12 AND 13 FOR LINES FALLING IN
C THE WAVELENGTH INTERVAL. SYNTHE READS TAPES 12 AND 13.
C PARAMETERS ARE PASSED FROM PROGRAM TO PROGRAM VIA TAPE 93.
C LINES ARE INCLUDED OR LEFT OUT BY INCLUDING OR LEAVING OUT THE
C PROGRAM THAT READS THEM. THE NAMES OF ALL THE READING PROGRAMS
C BEGIN WITH R. A SUFFIX P MEANS THAT THE PROGRAM READS BOTH
C PREDICTED AND REAL WAVELENGTHS. THE P PROGRAMS SHOULD NOT BE USED
C FOR MAKING DETAILED LINE BY LINE COMPARISONS WITH OBSERVATIONS.
C THE ORDER OF THESE READING PROGRAMS DOES NOT MATTER
CCC EXCEPT FOR RNLTE, RLINE, RKP, AND RKPP, WHICH MUST
C EXCEPT FOR RNLTE, RLINE, AND RGFIRON WHICH MUST
C COME FIRST AND IN RELATIVE ORDER IF THEY ARE USED.
C
C RNLTE READS THE NLTE LINE LIST AND SENDS THE DATA EITHER TO SPECTR
C (IFNLTE=1, N19=0) OR TO SYNTHE (IFNLTE=0, N19=NUMBER OF LINES IN
C LTE) IF THE LINES ARE TO BE TREATED IN LTE. IN EITHER CASE THE
C LINES ARE WRITTEN ON TAPE 19.
C
CCC RLINE READS ADDITIONS AND CORRECTIONS TO KP.
C RLINE READS ADDITIONS AND CORRECTIONS TO GFIRON.
C
CCCC RKP READS KP. IT ALSO READS A FILE DELETEKP OF LINE NUMBERS
CCCC OF LINES THAT ARE TO BE DELETED AND STORES THEM IN ARRAY
CCCC NDELET. RNLTE AND RLINE WRITE IN THIS ARRAY IF THEY HAVE A
CCCC LINE THAT IS ALSO IN KP. A LIST OF IONS TO BE TOTALLY DELETED
CCCC FROM KP IS ALSO INCLUDED ON DELETEKP AND IS STORED IN ARRAY NELDLT.
C RGFIRON READS GFIRON. IT ALSO READS A FILE DELETEGFIRON OF LINE NUMBERS
C OF LINES THAT ARE TO BE DELETED AND STORES THEM IN ARRAY
C NDELET. RNLTE AND RLINE WRITE IN THIS ARRAY IF THEY HAVE A
C LINE THAT IS ALSO IN GFIRON. A LIST OF IONS TO BE TOTALLY DELETED
C FROM GFIRON IS ALSO INCLUDED ON DELETEGFIRON AND IS STORED IN ARRAY NELDLT.
C THE PRESENT TIME ATLAS7 CANNOT TREAT THE LINES ABOVE THE FIFTH STAGE OF
C IONIZATION BECAUSE PFSAHA HAS NOT YET BEEN REWRITTEN.
C
CCCC RKPP READS PREDICTED KP LINES FROM THE MILLION LINE TAPE.
C
C RBELL READS BELLLIGHT.DAT AND BELLHEAVY.DAT. THESE ARE THE LIGHT AND
C HEAVY ELEMENTS, I.E., NOT IRON GROUP, FROM KP AND VARIOUS LABORATORY
C SOURCES. THE LISTS WERE PREPARED BY BARBARA BELL. SOME OF THE LINES ARE
C GUESSED SO THAT A LINE WILL APPEAR IN THE RIGHT POSITION EVEN IF IT HAS
C THE WRONG LOG GF.
C
C DO NOT USE THESE DATA BLINDLY FOR AN ABUNDANCE ANALYSIS.
C
PARAMETER (kw=99)
DIMENSION DECKJ(7,kw)
REAL*8 WLBEG,WLEND,RESOLU,RATIO,RATIOLG
REAL*8 WBEGIN,WLLAST
DATA DECKJ/kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0.,kw*0./
READ(5,1)AIRVAC,WLBEG,WLEND,RESOLU,TURBV,IFNLTE,LINOUT,
1CUTOFF,IFPRED,NREAD
1 FORMAT(A3,7X,4F10.4,I3,I7,F10.5,2I5)
WRITE(6,2)AIRVAC,WLBEG,WLEND,RESOLU,TURBV,IFNLTE,LINOUT,
1CUTOFF,IFPRED,NREAD
2 FORMAT(1H0,A3,9H WLBEG=,F10.4,9H WLEND=,F10.4,
1 10H RESOLU=,F10.1,9H TURBV=,F5.2,10H IFNLTE=,I1,
2 10H LINOUT=,I6,10H CUTOFF=,F7.5,10H IFPRED=,I1/
3 8H NREAD,I3)
C RESOLU IS THE RESOLUTION OF THE POINT SPACING IN WL/DELTA WL
C THUS .001 NM AT 500 NM IS 500000.
C TURBV IS ADDED TO ANY MICROTURBULENCE ALREADY PRESENT IN THE MODEL
C IFNLTE=0 SYNTHE COMPUTES NLTELINES IN LTE
C IFNLTE=1 SPECTR COMPUTES NLTELINES IN NLTE
C LINOUT IS LIMIT ON PRINTOUT OF SPECTRUM
C
C LINOUT IS ALSO A SWITCH THAT TURNS OFF SAVING LINE DATA IN ORDER TO
C SPEED UP THE PROGRAMS AND SAVE ON STORAGE. IF LINOUT.LT.0 LINE
C DATA ARE NOT SAVED. IF LINOUT.GE.0 LINE DATA ARE SAVED.
C
C IFVAC DOES NOT WORK PROPERLY FOR ALL LINES ON THE KP TAPE
C CUTOFF IS THE FRACTION OF THE CONTINUUM OPACITY BELOW WHICH
C WINGS OF LINES ARE NOT COMPUTED
C IFPRED=0 LEAVE OUT LINES WITH PREDICTED WAVELENGTHS
C IFPRED=1 USE ALL LINES
C IF NREAD GT 0 READ NREAD CARDS CONTAINING DEPTH DEPENDENT
C VARIABLES FOR THE MODEL SUCH AS DEPTH DEPENDENT DOPPLER
C SHIFTS AND MAGNETIC FIELDS. UP TO SEVEN VARIABLES ARE PASSED.
IFVAC=1
IF(AIRVAC.EQ.3HAIR)IFVAC=0
IF(AIRVAC.EQ.3HVAC)IFVAC=1
RATIO=1.+1./RESOLU
RATIOLG=DLOG(RATIO)
IXWLBEG=DLOG(WLBEG)/RATIOLG
WBEGIN=DEXP(IXWLBEG*RATIOLG)
IF(WBEGIN.LT.WLBEG)THEN
IXWLBEG=IXWLBEG+1
WBEGIN=DEXP(IXWLBEG*RATIOLG)
ENDIF
IXWLEND=DLOG(WLEND)/RATIOLG
WLLAST=DEXP(IXWLEND*RATIOLG)
IF(WLLAST.GE.WLEND)THEN
IXWLEND=IXWLEND-1
WLLAST=DEXP(IXWLEND*RATIOLG)
ENDIF
LENGTH=IXWLEND-IXWLBEG+1
DWLBEG=WBEGIN*RATIO-WBEGIN
DWLLAST=WLLAST-WLLAST/RATIO
WRITE(6,3)LENGTH,RATIO,WBEGIN,DWLBEG,WLLAST,DWLLAST
3 FORMAT('0LENGTH=',I6,' RATIO=',F12.10,' WBEGIN=',F11.5,
1 ' DWLBEG=',F7.5,' WLLAST=',F11.5,' DWLLAST=',F7.5)
N19=0
C DO 5 ILINE=1,50000
C 5 NDELET(ILINE)=0
C DO 6 NELION=1,594
C 6 NELDLT(NELION)=1
NLINES=0
IF(NREAD.GT.0)THEN
READ(5,7)
DO 9 I=1,NREAD
READ(5,7)J,(DECKJ(K,J),K=1,7)
7 FORMAT(I3,7X,7F10.3)
9 WRITE(6,7)J,(DECKJ(K,J),K=1,7)
ENDIF
OPEN(UNIT=12,STATUS='NEW',FORM='UNFORMATTED')
CLOSE(UNIT=12)
OPEN(UNIT=14,STATUS='NEW',FORM='UNFORMATTED')
CLOSE(UNIT=14)
OPEN(UNIT=19,STATUS='NEW',FORM='UNFORMATTED')
CLOSE(UNIT=19)
OPEN(UNIT=20,STATUS='NEW',FORM='UNFORMATTED')
CLOSE(UNIT=20)
WRITE(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED,
1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT
CALL EXIT
END
|