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
|
PROGRAM KAPREADTS
DIMENSION AKAP(57,42,5),TABT(57),TABP(42),oldtabp(21)
dimension potlo(42),xne(42),rho(42),xnatom(42)
dimension oldpotlo(21),oldxne(21),oldrho(21),oldxnatom(21)
DATA TABT/3.30,3.320, 3.340, 3.360, 3.380, 3.400, 3.420, 3.440,
1 3.460, 3.480, 3.500, 3.520, 3.540, 3.560, 3.580, 3.600, 3.620,
2 3.640, 3.660, 3.680, 3.700, 3.730, 3.760, 3.790, 3.820, 3.850,
3 3.880, 3.910, 3.940, 3.970, 4.000, 4.050, 4.100, 4.150, 4.200,
4 4.250, 4.300, 4.350, 4.400, 4.450, 4.500, 4.550, 4.600, 4.650,
5 4.700, 4.750, 4.800, 4.850, 4.900, 4.950, 5.000, 5.050, 5.100,
6 5.150, 5.200, 5.250, 5.300/
DATA TABP/-4.000,-3.500, -3.000, -2.500, -2.000,-1.500,-1.000,
1 -0.500, 0.000, 0.500, 1.000,
1 1.250, 1.500, 1.750, 2.000, 2.250, 2.500, 2.750, 3.000, 3.200,
2 3.400, 3.600, 3.800, 4.000, 4.200, 4.400, 4.600, 4.800, 5.000,
3 5.200, 5.400, 5.600, 5.800, 6.000, 6.250, 6.500, 6.750, 7.000,
4 7.250, 7.500, 7.750, 8.000/
DATA oldTABP/ -2.000,-1.500,-1.000,-0.500, 0.000, 0.500, 1.000,
1 1.500, 2.000, 2.500, 3.000, 3.500, 4.000, 4.500, 5.000,
2 5.500, 6.000, 6.500, 7.000, 7.500, 8.000/
c DATA KTAB01/ -2.000
C 1-5200,-5132,-5044,-4888,-4694,-4508,-4360,-4257,-4197,-4170, -2.000
C 2-4154,-4122,-4029,-3840,-3576,-3270,-2942,-2604,-2266,-1933, -2.000
C 3-1451,-1011, -685, -549, -520, -520, -526, -531, -529, -513, -2.000
C 4 -492, -482, -482, -487, -482, -472, -448, -440, -435, -434, -2.000
C 5 -435, -431, -428, -428, -429, -428, -428, -430, -433, -434, -2.000
C 6 -432, -428, -423, -416, -409, -401/ -2.000
c12345678901234567890123456789012345678901234567890123456789012345678901234567890
c 2089.0 1.000e-02 1.964e+05 3.464e+10 7.482e-14 0.002 1.000000000
c 199526.0 1.000e+08 1.890e+18 1.741e+18 3.760e-06 760.414 1.000000000
do 2 iv=1,5
ITAPE=IV+10
do 112 ik=1,12
read(itape,80)
80 format(20a4)
112 continue
DO 2 IP=1,42
READ(ITAPE,1)(AKAP(IT,IP,iv),IT=1,57)
1 FORMAT(/(6X,3PF5.0,1X,F5.0,1X,F5.0,1X,F5.0,1X,F5.0,1X,F5.0,1X,
1 F5.0,1X,F5.0,1X,F5.0,1X,F5.0))
2 CONTINUE
write(2,22)
22 format(' ROSSELAND MASS ABSORPTION COEFFICIENTS'/
1' logT logP 0km/s 1km/s 2km/s 4km/s 8km/s log Ne log Na l
2og rho IPloCM-1')
c 3.32-2.00 -5.200 -5.188 -5.169 -5.139 -5.104 5.29314 10.53958-13.12598 0.002
do 8 it=1,57
do 6 iP =1,42
potlo(ip)=1.
write(2,5)tabt(it),tabp(ip),(Akap(it,ip,iv),iv=1,5),
1xne(ip),xnatom(ip),rho(ip),potlo(ip)
5 format(f5.2,f5.2,5F7.3,f9.5,f9.5,f9.5,f8.3)
6 continue
8 continue
CALL EXIT
END
|
