299 lines
11 KiB
Fortran
299 lines
11 KiB
Fortran
subroutine pffe(ion,t,ane,pf)
|
|
c =============================
|
|
c
|
|
c partition functions for Fe IV to Fe IX
|
|
c after Fischel and Sparks, 1971, NASA SP-3066
|
|
c
|
|
c Output: PF partition function
|
|
c
|
|
INCLUDE 'PARAMS.FOR'
|
|
dimension tt(50),pn(10),nca(9)
|
|
dimension p4a(22),p4b(10,28),
|
|
* p5a(30),p5b(10,20),
|
|
* p6a(37),p6b(10,13),
|
|
* p7a(40),p7b(10,10),
|
|
* p8a(41),p8b(10,9),
|
|
* p9a(45),p9b(10,5)
|
|
c
|
|
parameter (xen=2.302585093,xmil=0.001,xmilen=xmil*xen)
|
|
parameter (xbtz=1.38054d-16)
|
|
c
|
|
data nca /3*0,22,30,37,40,41,45/
|
|
* nne /10/
|
|
c
|
|
data tt /
|
|
* 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.,
|
|
* 32.,34.,36.,38.,40.,42.,44.,46.,48.,
|
|
* 50.,55.,60.,65.,70.,75.,80.,85.,90.,95.,100.,125.,150./
|
|
c
|
|
data pn /-2.,-1.,0.,1.,2.,3.,4.,5.,6.,7./
|
|
c
|
|
data p4a /
|
|
* 0.778, 0.778, 0.778, 0.779, 0.783, 0.789, 0.801, 0.818,
|
|
* 0.842, 0.871, 0.906, 0.945, 0.987, 1.030, 1.074, 1.117,
|
|
* 1.160, 1.201, 1.242, 1.280, 1.317, 1.353/
|
|
c
|
|
data p4b /
|
|
* 1.406,1.393,1.389,7*1.387,
|
|
* 1.464,1.434,1.424,1.421,1.420,5*1.419,
|
|
* 1.546,1.483,1.461,1.454,1.451,1.451,4*1.450,
|
|
* 1.665,1.547,1.503,1.488,1.482,1.481,4*1.480,
|
|
* 1.826,1.636,1.553,1.524,1.514,1.510,4*1.509,
|
|
* 2.024,1.755,1.618,1.564,1.546,1.540,1.538,3*1.537,
|
|
* 2.480,2.087,1.814,1.674,1.619,1.599,1.593,1.591,1.590,1.590,
|
|
* 2.945,2.489,2.105,1.846,1.717,1.667,1.649,1.643,1.641,1.640,
|
|
* 3.379,2.897,2.452,2.089,1.859,1.751,1.710,1.696,1.691,1.689,
|
|
* 3.774,3.283,2.808,2.381,2.054,1.864,1.782,1.751,1.741,1.738,
|
|
* 4.133,3.637,3.150,2.688,2.292,2.015,1.871,1.814,1.793,1.786,
|
|
* 4.460,3.962,3.468,2.989,2.549,2.199,1.984,1.886,1.848,1.835,
|
|
* 4.757,4.258,3.762,3.274,2.809,2.406,2.121,1.972,1.908,1.886,
|
|
* 5.029,4.530,4.032,3.539,3.061,2.624,2.279,2.073,1.976,1.939,
|
|
* 5.279,4.780,4.281,3.785,3.299,2.840,2.450,2.189,2.051,1.996,
|
|
* 5.510,5.010,4.511,4.013,3.522,3.050,2.628,2.318,2.136,2.057,
|
|
* 6.014,5.514,5.014,4.515,4.018,3.530,3.065,2.666,2.381,2.228,
|
|
* 6.435,5.935,5.435,4.936,4.437,3.943,3.460,3.022,2.658,2.422,
|
|
* 6.794,6.294,5.794,5.294,4.794,4.297,3.807,3.343,2.939,2.631,
|
|
* 7.102,6.602,6.102,5.602,5.102,4.604,4.110,3.638,3.194,2.845,
|
|
* 7.370,6.870,6.370,5.870,5.370,4.871,4.375,3.892,3.439,3.052,
|
|
* 7.606,7.106,6.606,6.106,5.605,5.106,4.608,4.125,3.661,3.249,
|
|
* 7.815,7.315,6.814,6.314,5.814,5.314,4.816,4.333,3.851,3.418,
|
|
* 8.001,7.501,7.001,6.500,6.000,5.500,5.001,4.511,4.032,3.586,
|
|
* 8.168,7.668,7.168,6.668,6.168,5.667,5.168,4.680,4.197,3.741,
|
|
* 8.319,7.819,7.319,6.819,6.319,5.818,5.319,4.832,4.347,3.884,
|
|
* 8.900,8.399,7.899,7.399,6.899,6.398,5.898,5.405,4.917,4.431,
|
|
* 9.294,8.794,8.294,7.793,7.293,6.793,6.292,5.799,5.306,4.824/
|
|
c
|
|
data p5a /
|
|
* 1.235, 1.276, 1.301, 1.321, 1.339, 1.359, 1.381, 1.405,
|
|
* 1.432, 1.460, 1.489, 1.518, 1.546, 1.574, 1.601, 1.627,
|
|
* 1.652, 1.675, 1.697, 1.718, 1.738, 1.757, 1.775, 1.792,
|
|
* 1.808, 1.823, 1.838, 1.851, 1.877, 1.900/
|
|
c
|
|
data p5b /
|
|
* 1.943,1.928,1.923,7*1.921,
|
|
* 2.011,1.964,1.947,1.942,1.941,5*1.940,
|
|
* 2.144,2.025,1.980,1.965,1.960,1.958,4*1.957,
|
|
* 2.361,2.137,2.032,1.993,1.980,1.976,1.975,3*1.974,
|
|
* 2.646,2.315,2.121,2.035,2.004,1.994,1.991,1.990,1.989,1.989,
|
|
* 2.960,2.553,2.260,2.102,2.037,2.015,2.007,2.005,2.004,2.004,
|
|
* 3.274,2.823,2.450,2.205,2.086,2.040,2.025,2.020,2.018,2.018,
|
|
* 3.575,3.101,2.674,2.348,2.158,2.075,2.045,2.036,2.032,2.031,
|
|
* 4.251,3.757,3.275,2.829,2.466,2.234,2.124,2.083,2.069,2.064,
|
|
* 4.822,4.324,3.829,3.346,2.895,2.522,2.278,2.161,2.116,2.100,
|
|
* 5.308,4.808,4.310,3.816,3.334,2.888,2.525,2.297,2.187,2.145,
|
|
* 5.725,5.225,4.726,4.228,3.736,3.260,2.828,2.496,2.294,2.206,
|
|
* 6.088,5.589,5.089,4.590,4.093,3.604,3.139,2.733,2.447,2.291,
|
|
* 6.407,5.907,5.407,4.908,4.409,3.915,3.433,2.988,2.629,2.399,
|
|
* 6.689,6.189,5.689,5.189,4.690,4.193,3.704,3.236,2.832,2.535,
|
|
* 6.940,6.440,5.940,5.440,4.941,4.443,3.949,3.469,3.038,2.687,
|
|
* 7.166,6.666,6.166,5.666,5.166,4.667,4.171,3.684,3.237,2.847,
|
|
* 7.370,6.870,6.369,5.869,5.369,4.870,4.373,3.882,3.417,3.008,
|
|
* 8.150,7.649,7.149,6.649,6.149,5.649,5.149,4.651,4.167,3.700,
|
|
* 8.677,8.177,7.676,7.176,6.676,6.176,5.676,5.176,4.687,4.203/
|
|
c
|
|
data p6a /
|
|
* 1.218, 1.273, 1.309, 1.335, 1.358, 1.379, 1.400, 1.421,
|
|
* 1.442, 1.463, 1.484, 1.504, 1.523, 1.542, 1.560, 1.577,
|
|
* 1.594, 1.609, 1.624, 1.638, 1.652, 1.664, 1.677, 1.688,
|
|
* 1.699, 1.709, 1.719, 1.729, 1.746, 1.762, 1.777, 1.790,
|
|
* 1.803, 1.814, 1.825, 1.834, 1.843/
|
|
c
|
|
data p6b /
|
|
* 1.862,1.855,1.853,7*1.852,
|
|
* 1.958,1.900,1.880,1.874,1.872,5*1.871,
|
|
* 2.264,2.045,1.944,1.906,1.894,1.890,4*1.888,
|
|
* 2.776,2.386,2.119,1.984,1.930,1.912,1.906,1.904,2*1.903,
|
|
* 3.321,2.856,2.453,2.165,2.012,1.949,1.927,1.920,1.918,1.917,
|
|
* 3.821,3.333,2.868,2.465,2.178,2.025,1.963,1.941,1.934,1.932,
|
|
* 4.266,3.771,3.285,2.825,2.434,2.164,2.027,1.972,1.953,1.947,
|
|
* 4.662,4.164,3.670,3.187,2.739,2.372,2.135,2.022,1.980,1.965,
|
|
* 5.015,4.516,4.019,3.527,3.052,2.624,2.295,2.102,2.019,1.988,
|
|
* 5.332,4.832,4.344,3.838,3.351,2.889,2.493,2.217,2.075,2.017,
|
|
* 5.618,5.118,4.619,4.121,3.628,3.149,2.711,2.364,2.155,2.058,
|
|
* 6.710,6.210,5.710,5.210,4.711,4.213,3.719,3.241,2.807,2.462,
|
|
* 7.446,6.946,6.446,5.946,5.446,4.946,4.447,3.952,3.474,3.022/
|
|
c
|
|
data p7a /
|
|
* 1.074,1.130,1.167,1.194,1.215,1.234,1.250,1.266,1.280,1.293,
|
|
* 1.306,1.318,1.329,1.340,1.350,1.360,1.369,1.378,1.386,1.394,
|
|
* 1.401,1.408,1.415,1.421,1.427,1.433,1.439,1.444,1.454,1.463,
|
|
* 1.471,1.479,1.486,1.492,1.498,1.504,1.509,1.514,1.525,1.534/
|
|
c
|
|
data p7b /
|
|
* 1.555,1.546,1.544,1.543,6*1.542,
|
|
* 1.617,1.572,1.557,1.552,1.550,1.550,4*1.549,
|
|
* 1.798,1.648,1.587,1.566,1.559,1.557,4*1.556,
|
|
* 2.134,1.832,1.666,1.597,1.573,1.565,1.563,1.562,2*1.561,
|
|
* 2.550,2.138,1.836,1.671,1.602,1.578,1.570,1.568,2*1.567,
|
|
* 2.968,2.504,2.102,1.816,1.665,1.603,1.582,1.575,2*1.572,
|
|
* 3.359,2.875,2.419,2.037,1.779,1.651,1.601,1.584,1.579,1.577,
|
|
* 3.718,3.224,2.745,2.305,1.953,1.736,1.636,1.599,1.586,1.582,
|
|
* 5.097,4.598,4.098,3.601,3.110,2.638,2.217,1.899,1.719,1.643,
|
|
* 6.026,5.526,5.026,4.527,4.028,3.531,3.042,2.576,2.170,1.885/
|
|
c
|
|
data p8a /
|
|
* 0.809,0.849,0.875,0.894,0.908,0.918,0.927,0.934,0.939,0.944,
|
|
* 0.948,0.952,0.955,0.958,0.960,0.962,0.964,0.966,0.967,0.969,
|
|
* 0.970,0.971,0.973,0.974,0.975,0.975,0.976,0.977,0.978,0.980,
|
|
* 0.981,0.982,0.983,0.984,0.984,0.985,0.986,0.986,0.987,0.988,
|
|
* 0.989/
|
|
c
|
|
data p8b /
|
|
* 0.992,0.991,8*0.990,
|
|
* 1.000,0.994,0.992,7*0.991,
|
|
* 1.032,1.005,0.996,0.993,0.992,5*0.991,
|
|
* 1.129,1.040,1.008,0.997,0.993,5*0.992,
|
|
* 1.335,1.132,1.042,1.009,0.998,0.994,0.993,0.993,2*0.992,
|
|
* 1.640,1.312,1.121,1.038,1.007,0.998,0.994,3*0.993,
|
|
* 1.987,1.573,1.269,1.101,1.030,1.005,0.997,2*0.994,0.993,
|
|
* 3.514,3.017,2.526,2.053,1.628,1.305,1.119,1.039,1.010,1.000,
|
|
* 4.569,4.069,3.569,3.072,2.580,2.103,1.671,1.336,1.136,1.048/
|
|
c
|
|
data p9a /39*0.000,0.001,0.002,0.005,0.008,0.014,0.021/
|
|
c
|
|
data p9b /
|
|
* 2*0.032,8*0.031,
|
|
* 0.048,0.045,8*0.044,
|
|
* 0.076,0.065,0.061,0.060,6*0.059,
|
|
* 1.128,0.722,0.429,0.271,0.207,0.184,0.177,0.174,2*0.173,
|
|
* 2.696,2.200,1.712,1.249,0.848,0.564,0.415,0.354,0.333,0.327/
|
|
c
|
|
na=nca(ion)
|
|
nb=50-na
|
|
pne=log10(ane*xbtz*t)
|
|
t0=xmil*t
|
|
j=1
|
|
if(pne.lt.pn(1)) go to 15
|
|
if(pne.gt.pn(nne)) then
|
|
j1=nne
|
|
j2=nne
|
|
goto 16
|
|
endif
|
|
do 10 j=1,nne-1
|
|
if(pne.ge.pn(j).and.pne.lt.pn(j+1)) go to 15
|
|
10 continue
|
|
15 j1=j
|
|
j2=j1+1
|
|
if(pne.lt.pn(1)) j2=1
|
|
16 do 20 i=1,49
|
|
if(t0.ge.tt(i).and.t0.lt.tt(i+1)) go to 25
|
|
20 continue
|
|
25 i1=i
|
|
i2=i+1
|
|
if(t0.gt.tt(50)) then
|
|
i1=50
|
|
i2=50
|
|
endif
|
|
if(i2.le.na) then
|
|
if(ion.eq.4) then
|
|
px1=p4a(i1)
|
|
px2=p4a(i1)
|
|
py1=p4a(i2)
|
|
py2=p4a(i2)
|
|
else if(ion.eq.5) then
|
|
px1=p5a(i1)
|
|
px2=p5a(i1)
|
|
py1=p5a(i2)
|
|
py2=p5a(i2)
|
|
else if(ion.eq.6) then
|
|
px1=p6a(i1)
|
|
px2=p6a(i1)
|
|
py1=p6a(i2)
|
|
py2=p6a(i2)
|
|
else if(ion.eq.7) then
|
|
px1=p7a(i1)
|
|
px2=p7a(i1)
|
|
py1=p7a(i2)
|
|
py2=p7a(i2)
|
|
else if(ion.eq.8) then
|
|
px1=p8a(i1)
|
|
px2=p8a(i1)
|
|
py1=p8a(i2)
|
|
py2=p8a(i2)
|
|
else if(ion.eq.9) then
|
|
px1=p9a(i1)
|
|
px2=p9a(i1)
|
|
py1=p9a(i2)
|
|
py2=p9a(i2)
|
|
endif
|
|
else if(i1.eq.na) then
|
|
if(ion.eq.4) then
|
|
px1=p4a(i1)
|
|
px2=p4a(i1)
|
|
py1=p4b(j1,i2-na)
|
|
py2=p4b(j2,i2-na)
|
|
else if(ion.eq.5) then
|
|
px1=p5a(i1)
|
|
px2=p5a(i1)
|
|
py1=p5b(j1,i2-na)
|
|
py2=p5b(j2,i2-na)
|
|
else if(ion.eq.6) then
|
|
px1=p6a(i1)
|
|
px2=p6a(i1)
|
|
py1=p6b(j1,i2-na)
|
|
py2=p6b(j2,i2-na)
|
|
else if(ion.eq.7) then
|
|
px1=p7a(i1)
|
|
px2=p7a(i1)
|
|
py1=p7b(j1,i2-na)
|
|
py2=p7b(j2,i2-na)
|
|
else if(ion.eq.8) then
|
|
px1=p8a(i1)
|
|
px2=p8a(i1)
|
|
py1=p8b(j1,i2-na)
|
|
py2=p8b(j2,i2-na)
|
|
else if(ion.eq.9) then
|
|
px1=p9a(i1)
|
|
px2=p9a(i1)
|
|
py1=p9b(j1,i2-na)
|
|
py2=p9b(j2,i2-na)
|
|
endif
|
|
else
|
|
if(ion.eq.4) then
|
|
px1=p4b(j1,i1-na)
|
|
px2=p4b(j2,i1-na)
|
|
py1=p4b(j1,i2-na)
|
|
py2=p4b(j2,i2-na)
|
|
else if(ion.eq.5) then
|
|
px1=p5b(j1,i1-na)
|
|
px2=p5b(j2,i1-na)
|
|
py1=p5b(j1,i2-na)
|
|
py2=p5b(j2,i2-na)
|
|
else if(ion.eq.6) then
|
|
px1=p6b(j1,i1-na)
|
|
px2=p6b(j2,i1-na)
|
|
py1=p6b(j1,i2-na)
|
|
py2=p6b(j2,i2-na)
|
|
else if(ion.eq.7) then
|
|
px1=p7b(j1,i1-na)
|
|
px2=p7b(j2,i1-na)
|
|
py1=p7b(j1,i2-na)
|
|
py2=p7b(j2,i2-na)
|
|
else if(ion.eq.8) then
|
|
px1=p8b(j1,i1-na)
|
|
px2=p8b(j2,i1-na)
|
|
py1=p8b(j1,i2-na)
|
|
py2=p8b(j2,i2-na)
|
|
else if(ion.eq.9) then
|
|
px1=p9b(j1,i1-na)
|
|
px2=p9b(j2,i1-na)
|
|
py1=p9b(j1,i2-na)
|
|
py2=p9b(j2,i2-na)
|
|
endif
|
|
end if
|
|
dlgunx=px2-px1
|
|
px=px1+(pne-pn(j1))*dlgunx
|
|
dlguny=py2-py1
|
|
py=py1+(pne-pn(j1))*dlguny
|
|
delt=tt(i2)-tt(i1)
|
|
if(delt.ne.0.) then
|
|
dlgut=(py-px)/delt
|
|
pf=px+(t0-tt(i1))*dlgut
|
|
else
|
|
pf=px
|
|
endif
|
|
pf=exp(xen*pf)
|
|
return
|
|
end
|