diff options
Diffstat (limited to 'kappa9/kapreadts.for')
| -rw-r--r-- | kappa9/kapreadts.for | 58 |
1 files changed, 58 insertions, 0 deletions
diff --git a/kappa9/kapreadts.for b/kappa9/kapreadts.for new file mode 100644 index 0000000..d6f6224 --- /dev/null +++ b/kappa9/kapreadts.for @@ -0,0 +1,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 |