fmq/SpectraRust
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
ed2d107c59
SpectraRust/synspec/extracted/state0.f
Asfmq 1e30b7bc63 git push -u origin main
2026-03-19 14:05:33 +08:00

547 lines
23 KiB
Fortran
Raw Blame History

SUBROUTINE STATE0(MODOLD)
C =========================
C
C Initialization of the basic parameters for the Saha equation
C
INCLUDE 'PARAMS.FOR'
parameter (enhe1=24.5799,enhe2=54.3999)
character*4 DYP
character*80 dum
DIMENSION D(3,MATOM),XI(8,MATOM),DYP(MATOM),
* abun0(matom),abun1(matom)
C
DATA DYP/' H ',' He ',' Li ',' Be ',' B ',' C ',
* ' N ',' O ',' F ',' Ne ',' Na ',' Mg ',
* ' Al ',' Si ',' P ',' S ',' Cl ',' Ar ',
* ' K ',' Ca ',' Sc ',' Ti ',' V ',' Cr ',
* ' Mn ',' Fe ',' Co ',' Ni ',' Cu ',' Zn ',
* ' Ga ',' Ge ',' As ',' Se ',' Br ',' Kr ',
* ' Rb ',' Sr ',' Y ',' Zr ',' Nb ',' Mo ',
* ' Tc ',' Ru ',' Rh ',' Pd ',' Ag ',' Cd ',
* ' In ',' Sn ',' Sb ',' Te ',' I ',' Xe ',
* ' Cs ',' Ba ',' La ',' Ce ',' Pr ',' Nd ',
* ' Pm ',' Sm ',' Eu ',' Gd ',' Tb ',' Dy ',
* ' Ho ',' Er ',' Tm ',' Yb ',' Lu ',' Hf ',
* ' Ta ',' W ',' Re ',' Os ',' Ir ',' Pt ',
* ' Au ',' Hg ',' Tl ',' Pb ',' Bi ',' Po ',
* ' At ',' Rn ',' Fr ',' Ra ',' Ac ',' Th ',
* ' Pa ',' U ',' Np ',' Pu ',' Am ',' Cm ',
* ' Bk ',' Cf ',' Es '/
C
C Standard atomic constants for first 99 species
C Abundances for the first 30 from Grevesse & Sauval,
C (1998, Space Sci. Rev. 85, 161)
C
C Element Atomic Solar Std.
C weight abundance highest
C
C ionization stage
DATA D/ 1.008, 1.0D0, 2.,
* 4.003, 1.00D-1, 3.,
* 6.941, 1.26D-11, 3.,
* 9.012, 2.51D-11, 3.,
* 10.810, 5.0D-10, 4.,
* 12.011, 3.31D-4, 5.,
* 14.007, 8.32D-5, 5.,
* 16.000, 6.76D-4, 5.,
* 18.918, 3.16D-8, 4.,
* 20.179, 1.20D-4, 4.,
* 22.990, 2.14D-6, 4.,
* 24.305, 3.80D-5, 4.,
* 26.982, 2.95D-6, 4.,
* 28.086, 3.55D-5, 5.,
* 30.974, 2.82D-7, 5.,
* 32.060, 2.14D-5, 5.,
* 35.453, 3.16D-7, 5.,
* 39.948, 2.52D-6, 5.,
* 39.098, 1.32D-7, 5.,
* 40.080, 2.29D-6, 5.,
* 44.956, 1.48D-9, 5.,
* 47.900, 1.05D-7, 5.,
* 50.941, 1.00D-8, 5.,
* 51.996, 4.68D-7, 5.,
* 54.938, 2.45D-7, 5.,
* 55.847, 3.16D-5, 5.,
* 58.933, 8.32D-8, 5.,
* 58.700, 1.78D-6, 5.,
* 63.546, 1.62D-8, 5.,
* 65.380, 3.98D-8, 5.,
* 69.72 , 1.34896324e-09 , 3.,
* 72.60 , 4.26579633e-09 , 3.,
* 74.92 , 2.34422821e-10 , 3.,
* 78.96 , 2.23872066e-09 , 3.,
* 79.91 , 4.26579633e-10 , 3.,
* 83.80 , 1.69824373e-09 , 3.,
* 85.48 , 2.51188699e-10 , 3.,
* 87.63 , 8.51138173e-10 , 3.,
* 88.91 , 1.65958702e-10 , 3.,
* 91.22 , 4.07380181e-10 , 3.,
* 92.91 , 2.51188630e-11 , 3.,
* 95.95 , 9.12010923e-11 , 3.,
* 99.00 , 1.00000000e-24 , 3.,
* 101.1 , 6.60693531e-11 , 3.,
* 102.9 , 1.23026887e-11 , 3.,
* 106.4 , 5.01187291e-11 , 3.,
* 107.9 , 1.73780087e-11 , 3.,
* 112.4 , 5.75439927e-11 , 3.,
* 114.8 , 6.60693440e-12 , 3.,
* 118.7 , 1.38038460e-10 , 3.,
* 121.8 , 1.09647810e-11 , 3.,
* 127.6 , 1.73780087e-10 , 3.,
* 126.9 , 3.23593651e-11 , 3.,
* 131.3 , 1.69824373e-10 , 3.,
* 132.9 , 1.31825676e-11 , 3.,
* 137.4 , 1.62181025e-10 , 3.,
* 138.9 , 1.58489337e-11 , 3.,
* 140.1 , 4.07380293e-11 , 3.,
* 140.9 , 6.02559549e-12 , 3.,
* 144.3 , 2.95120943e-11 , 3.,
* 147.0 , 1.00000000e-24 , 3.,
* 150.4 , 9.33254366e-12 , 3.,
* 152.0 , 3.46736869e-12 , 3.,
* 157.3 , 1.17489770e-11 , 3.,
* 158.9 , 2.13796216e-12 , 3.,
* 162.5 , 1.41253747e-11 , 3.,
* 164.9 , 3.16227767e-12 , 3.,
* 167.3 , 8.91250917e-12 , 3.,
* 168.9 , 1.34896287e-12 , 3.,
* 173.0 , 8.91250917e-12 , 3.,
* 175.0 , 1.31825674e-12 , 3.,
* 178.5 , 5.37031822e-12 , 3.,
* 181.0 , 1.34896287e-12 , 3.,
* 183.9 , 4.78630102e-12 , 3.,
* 186.3 , 1.86208719e-12 , 3.,
* 190.2 , 2.39883290e-11 , 3.,
* 192.2 , 2.34422885e-11 , 3.,
* 195.1 , 4.78630036e-11 , 3.,
* 197.0 , 6.76082952e-12 , 3.,
* 200.6 , 1.23026887e-11 , 3.,
* 204.4 , 6.60693440e-12 , 3.,
* 207.2 , 1.12201834e-10 , 3.,
* 209.0 , 5.12861361e-12 , 3.,
* 210.0 , 1.00000000e-24 , 3.,
* 211.0 , 1.00000000e-24 , 3.,
* 222.0 , 1.00000000e-24 , 3.,
* 223.0 , 1.00000000e-24 , 3.,
* 226.1 , 1.00000000e-24 , 3.,
* 227.1 , 1.00000000e-24 , 3.,
* 232.0 , 1.20226443e-12 , 3.,
* 231.0 , 1.00000000e-24 , 3.,
* 238.0 , 3.23593651e-13 , 3.,
* 237.0 , 1.00000000e-24 , 3.,
* 244.0 , 1.00000000e-24 , 3.,
* 243.0 , 1.00000000e-24 , 3.,
* 247.0 , 1.00000000e-24 , 3.,
* 247.0 , 1.00000000e-24 , 3.,
* 251.0 , 1.00000000e-24 , 3.,
* 254.0 , 1.00000000e-24 , 3./
c
data abun0 /
* 12.00,10.93, 1.05, 1.38, 2.70, 8.39, 7.78, 8.66, 4.56, 7.84,
* 6.17, 7.53, 6.37, 7.51, 5.36, 7.14, 5.50, 6.18, 5.08, 6.31,
* 3.05, 4.90, 4.00, 5.64, 5.39, 7.45, 4.92, 6.23, 4.21, 4.60,
* 2.88, 3.58, 2.29, 3.33, 2.56, 3.28, 2.60, 2.92, 2.21, 2.59,
* 1.42, 1.92,-9.99, 1.84, 1.12, 1.69, 0.94, 1.77, 1.60, 2.00,
* 1.00, 2.19, 1.51, 2.27, 1.07, 2.17, 1.13, 1.58, 0.71, 1.45,
* -9.99, 1.01, 0.52, 1.12, 0.28, 1.14, 0.51, 0.93, 0.00, 1.08,
* 0.06, 0.88,-0.17, 1.11, 0.23, 1.45, 1.38, 1.64, 1.01, 1.13,
* 0.90, 2.00, 0.65,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99, 0.06,
* -9.99,-0.52,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99/
c
data abun1 /
* 12.00,10.93, 3.26, 1.38, 2.79, 8.43, 7.83, 8.69, 4.56, 7.93,
* 6.24, 7.60, 6.45, 7.51, 5.41, 7.12, 5.50, 6.40, 5.08, 6.34,
* 3.15, 4.95, 3.93, 5.64, 5.43, 7.50, 4.99, 6.22, 4.19, 4.56,
* 3.04, 3.65, 2.30, 3.34, 2.54, 3.25, 2.36, 2.87, 2.21, 2.58,
* 1.46, 1.88,-9.99, 1.75, 1.06, 1.65, 1.20, 1.71, 0.76, 2.04,
* 1.01, 2.18, 1.55, 2.24, 1.08, 2.18, 1.10, 1.58, 0.72, 1.42,
* -9.99, 0.96, 0.52, 1.07, 0.30, 1.10, 0.48, 0.92, 0.10, 0.92,
* 0.10, 0.85,-0.12, 0.65, 0.26, 1.40, 1.38, 1.62, 0.80, 1.17,
* 0.77, 2.04, 0.65,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99, 0.06,
* -9.99,-0.54,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99,-9.99/
C
C
C Ionization potentials for first 99 species:
DATA XI/
C
C Element Ionization potentials (eV)
C I II III IV V VI VII VIII
C
* 13.595, 0. , 0. , 0. , 0. , 0. , 0. , 0. ,
* 24.580, 54.400, 0. , 0. , 0. , 0. , 0. , 0. ,
* 5.392, 75.619,122.451, 0. , 0. , 0. , 0. , 0. ,
* 9.322, 18.206,153.850,217.713, 0. , 0. , 0. , 0. ,
* 8.296, 25.149, 37.920,259.298,340.22, 0. , 0. , 0. ,
* 11.264, 24.376, 47.864, 64.476,391.99,489.98, 0. , 0. ,
* 14.530, 29.593, 47.426, 77.450, 97.86,551.93,667.03, 0. ,
* 13.614, 35.108, 54.886, 77.394,113.87,138.08,739.11,871.39,
* 17.418, 34.980, 62.646, 87.140,114.21,157.12,185.14,953.6 ,
* 21.559, 41.070, 63.500, 97.020,126.30,157.91,207.21,239.0 ,
* 5.138, 47.290, 71.650, 98.880,138.37,172.09,208.44,264.16,
* 7.664, 15.030, 80.120,102.290,141.23,186.49,224.9 ,265.96,
* 5.984, 18.823, 28.440,119.960,153.77,190.42,241.38,284.53,
* 8.151, 16.350, 33.460, 45.140,166.73,205.11,246.41,303.07,
* 10.484, 19.720, 30.156, 51.354, 65.01,220.41,263.31,309.26,
* 10.357, 23.400, 35.000, 47.290, 72.50, 88.03,280.99,328.8 ,
* 12.970, 23.800, 39.900, 53.500, 67.80, 96.7 ,114.27,348.3 ,
* 15.755, 27.620, 40.900, 59.790, 75.00, 91.3 ,124.0 ,143.46,
* 4.339, 31.810, 46.000, 60.900, 82.6 , 99.7 ,118.0 ,155.0 ,
* 6.111, 11.870, 51.210, 67.700, 84.39,109.0 ,128.0 ,147.0 ,
* 6.560, 12.890, 24.750, 73.900, 92.0 ,111.1 ,138.0 ,158.7 ,
* 6.830, 13.630, 28.140, 43.240, 99.8 ,120.0 ,140.8 ,168.5 ,
* 6.740, 14.200, 29.700, 48.000, 65.2 ,128.9 ,151.0 ,173.7 ,
* 6.763, 16.490, 30.950, 49.600, 73.0 , 90.6 ,161.1 ,184.7 ,
* 7.432, 15.640, 33.690, 53.000, 76.0 , 97.0 ,119.24,196.46,
* 7.870, 16.183, 30.652, 54.800, 75.0 , 99.1 ,125.0 ,151.06,
* 7.860, 17.060, 33.490, 51.300, 79.5 ,102.0 ,129.0 ,157.0 ,
* 7.635, 18.168, 35.170, 54.900, 75.5 ,108.0 ,133.0 ,162.0 ,
* 7.726, 20.292, 36.830, 55.200, 79.9 ,103.0 ,139.0 ,166.0 ,
* 9.394, 17.964, 39.722, 59.400, 82.6 ,108.0 ,134.0 ,174.0 ,
* 6.000, 20.509, 30.700, 99.99,99.99,99.99,99.99,99.99,
* 7.89944,15.93462, 34.058, 45.715,99.99,99.99,99.99,99.99,
* 9.7887, 18.5892, 28.351, 99.99,99.99,99.99,99.99,99.99,
* 9.750,21.500, 32.000, 99.99,99.99,99.99,99.99,99.99,
* 11.839,21.600, 35.900, 99.99,99.99,99.99,99.99,99.99,
* 13.995,24.559, 36.900, 99.99,99.99,99.99,99.99,99.99,
* 4.175,27.500, 40.000, 99.99,99.99,99.99,99.99,99.99,
* 5.692,11.026, 43.000, 99.99,99.99,99.99,99.99,99.99,
* 6.2171,12.2236, 20.5244,60.607,99.99,99.99,99.99,99.99,
* 6.63390,13.13,23.17,34.418,80.348,99.99,99.99,99.99,
* 6.879,14.319, 25.039, 99.99,99.99,99.99,99.99,99.99,
* 7.099,16.149, 27.149, 99.99,99.99,99.99,99.99,99.99,
* 7.280,15.259, 30.000, 99.99,99.99,99.99,99.99,99.99,
* 7.364,16.759, 28.460, 99.99,99.99,99.99,99.99,99.99,
* 7.460,18.070, 31.049, 99.99,99.99,99.99,99.99,99.99,
* 8.329,19.419, 32.920, 99.99,99.99,99.99,99.99,99.99,
* 7.574,21.480, 34.819, 99.99,99.99,99.99,99.99,99.99,
* 8.990,16.903, 37.470, 99.99,99.99,99.99,99.99,99.99,
* 5.784,18.860, 28.029, 99.99,99.99,99.99,99.99,99.99,
* 7.342,14.627, 30.490,72.3,99.99,99.99,99.99,99.99,
* 8.639,16.500, 25.299,44.2,55.7,99.99,99.99,99.99,
* 9.0096,18.600, 27.96, 37.4,58.7,99.99,99.99,99.99,
* 10.454,19.090, 32.000, 99.99,99.99,99.99,99.99,99.99,
* 12.12984,20.975,31.05,45.,54.14,99.99,99.99,99.99,
* 3.893,25.100, 35.000, 99.99,99.99,99.99,99.99,99.99,
* 5.210,10.000, 37.000, 99.99,99.99,99.99,99.99,99.99,
* 5.580,11.060, 19.169, 99.99,99.99,99.99,99.99,99.99,
* 5.650,10.850, 20.080, 99.99,99.99,99.99,99.99,99.99,
* 5.419,10.550, 23.200, 99.99,99.99,99.99,99.99,99.99,
* 5.490,10.730, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 5.550,10.899, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 5.629,11.069, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 5.680,11.250, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.159,12.100, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 5.849,11.519, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 5.930,11.670, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.020,11.800, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.099,11.930, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.180,12.050, 23.700, 99.99,99.99,99.99,99.99,99.99,
* 6.250,12.170, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.099,13.899, 19.000, 99.99,99.99,99.99,99.99,99.99,
* 7.000,14.899, 23.299, 99.99,99.99,99.99,99.99,99.99,
* 7.879,16.200, 24.000, 99.99,99.99,99.99,99.99,99.99,
* 7.86404,17.700, 25.000, 99.99,99.99,99.99,99.99,99.99,
* 7.870,16.600, 26.000, 99.99,99.99,99.99,99.99,99.99,
* 8.500,17.000, 27.000, 99.99,99.99,99.99,99.99,99.99,
* 9.100,20.000, 28.000, 99.99,99.99,99.99,99.99,99.99,
* 8.95868,18.563,33.227, 99.99,99.99,99.99,99.99,99.99,
* 9.220,20.500, 30.000, 99.99,99.99,99.99,99.99,99.99,
* 10.430,18.750, 34.200, 99.99,99.99,99.99,99.99,99.99,
* 6.10829,20.4283,29.852,50.72,99.99,99.99,99.99,99.99,
* 7.416684,15.0325,31.9373,42.33,69.,99.99,99.99,99.99,
* 7.285519,16.679, 25.563,45.32,56.0,88.,99.99,99.99,
* 8.430,19.000, 27.000, 99.99,99.99,99.99,99.99,99.99,
* 9.300,20.000, 29.000, 99.99,99.99,99.99,99.99,99.99,
* 10.745,20.000, 30.000, 99.99,99.99,99.99,99.99,99.99,
* 4.000,22.000, 33.000, 99.99,99.99,99.99,99.99,99.99,
* 5.276,10.144, 34.000, 99.99,99.99,99.99,99.99,99.99,
* 6.900,12.100, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99,
* 6.000,12.000, 20.000, 99.99,99.99,99.99,99.99,99.99/
C
C
c DATA XIFE /8*0.,233.6,262.1/
c DATA NTOTA /99/
C
C An element (hydrogen through zinc) can be considered in one of
C the three following options:
C 1. explicitly - some of energy levels of some of its ionization
C states are considered explicitly, ie. their
C populations are determined by solving statistical
C equilibrium
C 2. implicitly - the atom is assumed not to contribute to
C opacity; but is allowed to contribute to the
C total number of particles and to the total charge;
C the latter is evaluated assuming LTE ionization
C balance, ie. by solving a set of Saha equations
C 3. not considered at all
C
C Input:
C
C For each element from 1 (hydrogen) to NATOMS, the following
C parameters:
C
C MA = 0 - if the element is not considered (option 3)
C = 1 - if the element is non-explicit (option 2)
C = 2 - if the element is explicit (option 1)
C = 4 - if the element is semi-explicit (i.e. behaves
C like MA=2 for continua and MA=1 for lines
C NA0,NAK - have the meaning only for MA=2; indicate that the
C explicit energy levels of the present species have
C the indices between NA0 and NAK (NAK is thus the index
C of the highest ionization state, which is represented
C as one-level ion).
C ION - has the meaning for MA=1 only;
C if ION=0, standard number of ionization degrees is
C considered
C (counting the neutral state also; so for
C instance to treat all stages of He requires
C ION=3, which is a default anyhow).
C if ION>0, then ION ionization degrees is considered
C MODPF - mode of evaluation of partition functions
C = 0 - standard evaluation (see procedure PARTF)
C > 0 - partition functions evaluated from the
C Opacity Project ionization fraction tables
C < 0 - non-standard evaluation, by user supplied
C procedure PFSPEC
C ABN - if ABN=0, solar abundance is assumed (given above;
C abundance here is assumed as relative
C to hydrogen by number
C if ABN>0, non-solar abundance ABN is assumed; in an
C arbitrary scale
C if ABN<0, non-solar abundance ABN is assumed;
C (-ABN times the solar value)
C PFS - see above
C
iabset=0
read(ibuff,'(a80)') dum
read(dum,*,iostat=kstat) natoms,iabset
if(kstat.ne.0) READ(dum,*) NATOMS
WRITE(6,600)
IAT=0
IREF=0
IF(NATOMS.LT.0) NATOMS=-NATOMS
C
DO I=1,MATOM
DO J=1,MION0
RR(I,J)=0.
END DO
if(iabset.eq.1) then
d(2,i)=10.**(abun1(i)-12.)
else if(iabset.ne.2) then
d(2,i)=10.**(abun0(i)-12.)
end if
END DO
DO ID=1,ND
YTOT(ID)=0.
WMY(ID)=0.
END DO
C
DO I=1,MATOM
TYPAT(I)=DYP(I)
LGR(I)=.TRUE.
LRM(I)=.TRUE.
IATEX(I)=-1
IF(I.LE.NATOMS) THEN
IF(MODOLD.EQ.0) THEN
READ(IBUFF,*) MA,NA0,NAK,ION,MODPF(I),ABN,
* (PFSTD(J,I),J=1,5)
MA=IABS(MA)
ELSE
READ(IBUFF,*) MA,ABN,MODPF(I)
ION=0
END IF
ELSE IF(MOD(IMODE,10).LE.1.and.imode.ne.-4) THEN
MA=1
ABN=0.
ION=0
MODPF(I)=0
ELSE
MA=0
END IF
AMAS(I)=D(1,I)
ABND(I)=D(2,I)
if(iref.gt.0) abnd(i)=d(2,i)*abnd(iref)/d(2,iref)
IONIZ(I)=int(D(3,I))
isemex(i)=0
C
C increase the standard highest ionization for Teff>30,000 K
C
IF(TEFF.GT.3.D4) THEN
IF(I.LE.8) IONIZ(I)=I+1
IF(I.GT.8.and.i.le.30) IONIZ(I)=9
END IF
C
DO J=1,9
IF(J.LE.8) ENEV(I,J)=xi(J,I)
if(enev(i,j).ge.enhe2) then
inpot(i,j)=3
else if(enev(i,j).ge.enhe1) then
inpot(i,j)=2
else
inpot(i,j)=1
end if
END DO
IF(MA.GT.0) THEN
LGR(I)=.FALSE.
IF(ABN.GT.0) ABND(I)=ABN
IF(ABN.LT.0) ABND(I)=ABS(ABN)*D(2,I)
IF(ION.NE.0) IONIZ(I)=ION
IF(ABN.GT.1.E6) THEN
READ(IBUFF,*) (ABNDD(I,ID),ID=1,ND)
ELSE
DO ID=1,ND
ABNDD(I,ID)=ABND(I)
END DO
END IF
IF(MA.EQ.1) THEN
LRM(I)=.FALSE.
IATEX(I)=0
ELSE
IAT=IAT+1
IATEX(I)=IAT
if(ma.eq.4) isemex(i)=1
if(ma.eq.5) isemex(i)=2
IF(IAT.EQ.IATREF) THEN
IREF=I
DO ID=1,ND
ABNREF(ID)=ABNDD(I,ID)
END DO
END IF
C
C store parameters for explicit atoms
C
DO ID=1,ND
ABUND(IAT,ID)=ABNDD(I,ID)
END DO
AMASS(IAT)=AMAS(I)*HMASS
NUMAT(IAT)=I
IF(MODOLD.EQ.0) THEN
N0A(IAT)=NA0
NKA(IAT)=NAK
END IF
END IF
DO ID=1,ND
YTOT(ID)=YTOT(ID)+ABNDD(I,ID)
WMY(ID)=WMY(ID)+ABNDD(I,ID)*AMAS(I)
END DO
ABN=ABND(I)/D(2,I)
IF(MA.EQ.1) WRITE(6,601) I,TYPAT(I),ABND(I),ABN
IF(MA.EQ.2) WRITE(6,602) I,TYPAT(I),ABND(I),ABN,IAT,NA0,NAK
END IF
END DO
IF(MOD(IMODE,10).LE.1) NATOMS=MATOM
DO ID=1,ND
WMM(ID)=WMY(ID)*HMASS/YTOT(ID)
END DO
DO JJ=1,NATOMS
DO ID=1,ND
RELAB(JJ,ID)=1.
END DO
END DO
C
IF(ICHEMC.NE.1) go to 100
C
C abundance change with respect to the model atmosphere input
C (unit 5);
C this option is switched on by the parameter ICHEMC (read from
C unit 55), if it is non-zero, an additional input from
C unit 56 is required
C
C unit 56 input:
C
C NCHANG - number of chemical elements for which the abundances
C are going to be changes;
C
C then there are NCHANG records, each contains:
C
C I - atomic number
C ABN - new abundance; coded using the same conventions as in
C the standard input
C
READ(56,*,ERR=566,END=566) NCHANG
WRITE(6,610)
DO II=1,NCHANG
READ(56,*) I,ABN
ABND(I)=D(2,I)
IF(ABN.GT.0) ABND(I)=ABN
IF(ABN.LT.0) ABND(I)=-ABN*D(2,I)
if(abn.gt.1.) abnd(i)=10.**(abn-12.)
IF(ABN.GT.1.E6) THEN
READ(56,*) (ABNDD(I,ID),ID=1,ND)
ELSE
DO ID=1,ND
ABNDD(I,ID)=ABND(I)
END DO
END IF
LGR(I)=.FALSE.
IATX=IATEX(I)
IF(IATX.GT.0) THEN
DO ID=1,ND
RELAB(IATX,ID)=ABNDD(I,ID)/ABUND(IATX,ID)
ABUND(IATX,ID)=ABNDD(I,ID)
END DO
END IF
ABNR=ABND(I)/D(2,I)
WRITE(6,601) I,TYPAT(I),ABND(I),ABNR
END DO
C
C renormalize abundances to have the standard element abundance
C equal to unity
C
100 IF(IREF.LE.1) RETURN
write(6,620)
DO I=1,MATOM
IAT=IATEX(I)
IF(IAT.GE.0) THEN
DO ID=1,ND
ABNDD(I,ID)=ABNDD(I,ID)/ABNREF(ID)
YTOT(ID)=YTOT(ID)+ABNDD(I,ID)
WMY(ID)=WMY(ID)+ABNDD(I,ID)*AMAS(I)
END DO
ABNR=ABND(I)/D(2,I)
IF(IAT.EQ.0) THEN
WRITE(6,601) I,TYPAT(I),ABND(I),ABNR
ELSE
DO ID=1,ND
ABUND(IAT,ID)=ABNDD(I,ID)
END DO
WRITE(6,602) I,TYPAT(I),ABND(I),ABNR,IAT,N0A(IAT),NKA(IAT)
END IF
END IF
END DO
DO ID=1,ND
WMM(ID)=WMY(ID)*HMASS/YTOT(ID)
END DO
RETURN
566 WRITE(6,656)
STOP
c
600 FORMAT(1H0//' CHEMICAL ELEMENTS INCLUDED'/
* ' --------------------------'//
* ' NUMBER ELEMENT ABUNDANCE'/1H ,16X,
* 'A=N(ELEM)/N(H) A/A(SOLAR)'/)
601 FORMAT(1H ,I4,3X,A5,1P2E14.2)
602 FORMAT(1H ,I4,3X,A5,1P2E14.2,3X,
* 'EXPLICIT: IAT=',I3,' N0A=',I3,' NKA=',I3)
610 FORMAT(//' CHEMICAL ELEMENTS INCLUDED - CHANGED (unit 56)'
* /' --------------------------'//
* ' NUMBER ELEMENT ABUNDANCE'/1H ,16X,
* 'A=N(ELEM)/N(H) A/A(SOLAR)'/)
620 FORMAT(1H0//' CHEMICAL ELEMENTS INCLUDED - RENORMALIZATION'/
* ' --------------------------'//
* ' NUMBER ELEMENT ABUNDANCE'/1H ,16X,
* 'A=N(ELEM)/N(H) A/A(SOLAR)'/)
656 FORMAT(//' CHEMICAL COMPOSITION COULD NOT BE READ FROM ',
* 'UNIT 56'//' STOP.')
END
Reference in New Issue View Git Blame Copy Permalink