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
|
subroutine gammabark
c******************************************************************************
c This subroutine pulls in damping factors from Barklem data
c So far, these data have been compiled from:
c 1. Barklem, P. S., Piskunov, N., & O'Mara, B. J. 2000,
c A&ApS, 142, 467 for (mostly) neutral species
c 2. Barklem, P. S., & Aspelund-Johansson, J. 2005, A&Ap,
c 435, 373 for Fe II lines with E_lower < 70000 cm-1
c Added column to Barklem.dat for radiative damping, Gamma_rad. -AMcW 12/2013
c******************************************************************************
implicit real*8 (a-h,o-z)
include 'Pstuff.com'
include 'Atmos.com'
include 'Linex.com'
include 'Dampdat.com'
data firstread/0/
character*80 line
c*****on first entry to this routine, read damping data from either
c 'Barklem.dat' or 'BarklemUV.dat', depending on the wavelength region
c of the linelist; read Van der Waals params, if radiative damping
c data are present
if (firstread == 0) then
if (wave1(nlines) > 3000.) then
nwant = 35
else
nwant = 36
endif
do k=1,30000
call blankstring (line)
read (nwant,1001,end=10) line
read (line,*) wavebk(k), idbk(k), gammabk(k), alphabk(k)
if (line(34:) /= ' ') then
read(line(34:),*) gammarad(k)
else
gammarad(k) = 0.0
endif
enddo
10 numbark = k -1
firstread = 1
endif
c*****identify the Barklem list positions of the wavelength limits of
c the input line list
wavemin = 10000000.
do j=1,nlines+nstrong
if (wave1(j) < wavemin) wavemin = wave1(j)
enddo
wavemax = 0.
do j=1,nlines+nstrong
if (wave1(j) > wavemax) wavemax = wave1(j)
enddo
do k=1,numbark
if (wavemin-wavebk(k) < 1.0) then
nummin = k
exit
endif
enddo
do k=nummin,numbark
if (wavebk(k)-wavemax > 1.0) then
nummax = k
exit
endif
enddo
c*****search for Barklem data
do j=1,nlines+nstrong
gambark(j) = -1.
alpbark(j) = -1.
gamrad(j) = -1.
if (atom1(j) > 100.) cycle
iatom10 = nint(10.*atom1(j))
do k=nummin,nummax
waveerror = -(wave1(j) - wavebk(k))/wavebk(k)
iii = nint(10.*idbk(k))
if (dabs(waveerror)<5.0d-06 .and.
. iii == iatom10) then
gamrad(j) = gammarad(k)
gambark(j) = 10.**gammabk(k)
alpbark(j) = (1.-alphabk(k))/2.
exit
endif
if (waveerror > 5.0d-06) exit
enddo
enddo
c*****exit normally
return
c*****format statements
1001 format (a80)
end
|
