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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
program inpwidth
character*10 label,labelp,other1,other2
character*80 card,star,end,stop,mol1,mol2,hlin,begin
character*80 modfile,c,linefile
character*4 ref
character*5 modcard
dimension vts(3),angle(20)
data end/'END'/
data stop/'STOP'/
data mol1/'MOLECULES ON'/
data mol2/'READ MOLECULES'/
data hlin/'OPACITY ON HLINES'/
data begin/'BEGIN'/
data label/' '/
data labelp/' '/
data other1/' '/
data other2/' '/
nblo=0
npup=0
iso1=0
x1=0.
iso2=0
x2=0.
open(unit=2,file='inplines.dat',status='unknown')
open(unit=1,status='new')
open(unit=10,status='old',readonly,shared,recl=160)
open(unit=11,status='old',readonly,shared,recl=160)
open(unit=12,status='old',readonly,shared,recl=160)
open(unit=13,status='old',readonly,shared,recl=160)
open(unit=14,status='old',readonly,shared,recl=160)
open(unit=15,status='old',readonly,shared,recl=160)
open(unit=16,status='old',readonly,shared,recl=160)
open(unit=17,status='old',readonly,shared,recl=160)
open(unit=18,status='old',readonly,shared,recl=160)
type 311
311 format(3x,'star name ',$)
accept 90,star
type 1
1 format(3x,'VTUR(bulence)? (yes=1/no=0) ',$)
accept*,iturb
if(iturb.eq.1) go to 10
100 type 2
2 format(3x,'PROF(ile)? (yes=1/no=0) ',$)
accept*,iprof
if(iprof.eq.1) go to 20
200 type 3
3 format(3x,'AVER(age)? (yes=1/no=0) ',$)
accept*, iaver
if (iaver.eq.1) go to 30
300 type 4
4 format(3x,'CURV(e)? (yes=1/no=0) ',$)
accept*,icurv
if(icurv.eq.1) go to 40
400 type 5
5 format(3x,'end of data for the lines? (yes=1/no=0) ',$)
accept*,iend
if(iend.eq.1) go to 500
600 type 6
6 format(3x,'stop ? (yes=1/no=0) ',$)
accept*, istop
if(istop.eq.1) go to 60
10 card='VTUR'
write (1,90) card
90 format(a)
type 11
11 format(3x,'Number N of the microturb. velocities (NMAX=3): ',$)
accept*,nvt
type 12
12 format(3x,'Type the values of the N microturb. velocities ',$)
accept*,(vts(ivt),ivt=1,nvt)
write(1,91) nvt,(vts(ivt),ivt=1,nvt)
91 format(i5,3f5.2)
iwhat=1
type 14
14 format(3x,'Is some line file already existing?(yes=1/no=0) ',$)
accept*,iold
if(iold.eq.0) go to 66
667 read(2,190,end=66)card
190 format(a4)
if(card.eq.'AVER')then
write(1,190)card
go to 667
endif
if(card.eq.'LINE')then
read(2,874)wlobs
read(2,874)ew
write(1,9)card,ew,wlobs,star
read(2,874)gflog
read(2,911)ref
read(2,874)xj
read(2,8745)e
read(2,874)xjp
read(2,8745)ep
read(2,874)code
8745 format(1x,f12.3)
wl=wlobs
write(1,444)wl,gflog,xj,e,xjp,ep,code,label,labelp
read(2,875)nelion
read(2,874)gammar
read(2,874)gammas
read(2,874)gammaw
read(2,873)alpha
873 format(f6.3)
write(1,445)wl,nelion,gammar,gammas,gammaw,ref,nblo,nbup,iso1,
1 x1,iso2,x2,other1,other2,alpha
go to 667
endif
66 type 13
13 format(3x,'LINE ? (yes=1/no=0) ',$)
accept*,iline
if(iline.eq.1) go to 50
if(iwhat.eq.3) GO TO 200
go to (100,200,300,400),iwhat
20 card='PROF'
write(1,90) card
write(2,90)card
iwhat=2
go to 66
30 card='AVER'
write(1,90) card
write(2,90)card
iwhat=3
go to 66
40 card='CURV'
write(1,90) card
write(2,90)card
type 41
41 format(3x,'type nablog,minlog,dablog'/3x,$)
accept*,nablog,fminlog,dablog
write(1,171) nablog,fminlog,dablog
171 format(i5,2f8.2)
iwhat=4
go to 66
50 card='LINE'
write(2,190)card
type 31
31 format(3x,'wavelength (in Nm: es. 4000A=400.0 Nm): ', $)
accept*,wlobs
write(2,874) wlobs
874 format(1x,f10.4)
type 131
131 format(3x,'equivalent width (in Pm: es. 200 mA=20.0 Pm): ',$)
accept*,ew
write(2,874)ew
card='LINE'
write(1,9) card,ew,wlobs,star
9 format(a4,f10.2,f10.4,1x,a56)
type 3227
3227 format(3x,'code ',$)
accept*,code1
if(wlobs.lt.100)unit=10
if(wlobs.ge.100.and.wlobs.lt.150.)unit=11
if(wlobs.ge.150.and.wlobs.lt.200.)unit=12
if(wlobs.ge.200.and.wlobs.lt.300.)unit=13
if(wlobs.ge.300.and.wlobs.lt.400.)unit=14
if(wlobs.ge.400.and.wlobs.lt.500.)unit=15
if(wlobs.ge.500.and.wlobs.lt.600.)unit=16
if(wlobs.ge.600.and.wlobs.lt.800.)unit=17
if(wlobs.ge.800.)unit=18
do 900 iline=1,50000000
read(unit,140,end=500)wl,gflog,code,e,xj,label,ep,xjp,labelp,
1 gammar,gammas,gammaw,ref,nblo,nbup,iso1,x1,iso2,x2,other1,
2 other2,lande,landeg,isoshift,alpha
140 format(f11.4,f7.3,f6.2,f12.3,f5.1,1x,a10,f12.3,f5.1,1x,a10,
1 f6.2,f6.2,f6.2,a4,i2,i2,i3,f6.3,i3,f6.3,a10,a10,2i5,i6,f6.3)
c
if(abs(wl-wlobs).le.0.002.and.code.eq.code1)then
write(1,444) wl,gflog,xj,e,xjp,ep,code,label,labelp
444 format(f10.4,f7.3,f5.1,f12.3,f5.1,f12.3,f9.2,a10,a10)
nelem=code
icharge=(code-float(nelem))*100+0.1
zeff=icharge+1
nelion=nelem*6-6+ifix(zeff)
write(1,445)wl,nelion,gammar,gammas,gammaw,ref,nblo,nbup,iso1,
1 x1,iso2,x2,other1,other2,alpha
445 format(f10.4,i4,f6.2,f6.2,f6.2,a4,i2,i2,i3,f7.3,i3,f7.3,
1 a10,a10,f6.3)
write(2,874)gflog
write(2,911)ref
911 format(a4)
write(2,874)xj
write(2,8745)e
write(2,874)xjp
write(2,8745)ep
write(2,874)code
9011 format(a10)
write(2,875)nelion
875 format(1x,i5)
write(2,874)gammar
write(2,874) gammas
write(2,874)gammaw
write(2,873)alpha
rewind(unit)
go to 66
endif
900 continue
500 write(1,90) end
83 type 503
503 format(///,3x,'type the name of the model file ',$)
accept 90,modfile
open(unit=3,file=modfile,status='old')
do 993 i=1,500
read (3,90,end=999) c
write(modcard,'(a5)')c(1:5)
c type 342, modcard
342 format(1x,a5)
if (modcard.ne.begin)write (1,90)c
993 continue
999 close (unit=3)
write(1,90)mol1
write(1,90)mol2
write(1,90)hlin
write(1,90)begin
60 write(1,90)end
write(1,90)stop
close(unit=1)
stop
end
|
