SpectraRust/tlusty/extracted/sbfch.f
2026-03-19 22:16:23 +08:00

279 lines
17 KiB
Fortran

FUNCTION SBFCH(FR,T)
C ====================
C
C cross-section times partition function for CH
C
C from Kurucz ATLAS9
C
INCLUDE 'IMPLIC.FOR'
parameter (fihu=500.,fihui=1./fihu,
* twhu=200.,twhui=1./twhu,
* tenl=2.30258509299405E0)
c
DIMENSION CROSSCH(15,105),PARTCH(41),CROSSCHT(15)
DIMENSION C1(150),C2(150),C3(150),C4(150),C5(150)
DIMENSION C6(150),C7(150),C8(150),C9(150),C10(150)
DIMENSION C11(75)
C
EQUIVALENCE (CROSSCH(1, 1),C1(1)),(CROSSCH(1,11),C2(1))
EQUIVALENCE (CROSSCH(1,21),C3(1)),(CROSSCH(1,31),C4(1))
EQUIVALENCE (CROSSCH(1,41),C5(1)),(CROSSCH(1,51),C6(1))
EQUIVALENCE (CROSSCH(1,61),C7(1)),(CROSSCH(1,71),C8(1))
EQUIVALENCE (CROSSCH(1,81),C9(1)),(CROSSCH(1,91),C10(1))
EQUIVALENCE (CROSSCH(1,101),C11(1))
C
DATA C1/-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,
1-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,-38.000,
2 -32.727,-31.151,-30.133,-29.432,-28.925,-28.547,-28.257,
2-28.030,-27.848,-27.701,-27.580,-27.479,-27.395,-27.322,-27.261,
3 -31.588,-30.011,-28.993,-28.290,-27.784,-27.405,-27.115,
3-26.887,-26.705,-26.558,-26.437,-26.336,-26.251,-26.179,-26.117,
4 -30.407,-28.830,-27.811,-27.108,-26.601,-26.223,-25.932,
4-25.705,-25.523,-25.376,-25.255,-25.154,-25.069,-24.997,-24.935,
5 -29.513,-27.937,-26.920,-26.218,-25.712,-25.334,-25.043,
5-24.816,-24.635,-24.487,-24.366,-24.266,-24.181,-24.109,-24.047,
6 -28.910,-27.341,-26.327,-25.628,-25.123,-24.746,-24.457,
6-24.230,-24.049,-23.902,-23.782,-23.681,-23.597,-23.525,-23.464,
7 -28.517,-26.961,-25.955,-25.261,-24.760,-24.385,-24.098,
7-23.873,-23.694,-23.548,-23.429,-23.329,-23.245,-23.174,-23.113,
8 -28.213,-26.675,-25.680,-24.993,-24.497,-24.127,-23.843,
8-23.620,-23.443,-23.299,-23.181,-23.082,-22.999,-22.929,-22.869,
9 -27.942,-26.427,-25.446,-24.769,-24.280,-23.915,-23.635,
9-23.416,-23.241,-23.100,-22.983,-22.887,-22.805,-22.736,-22.677,
A -27.706,-26.210,-25.241,-24.572,-24.088,-23.728,-23.451,
A-23.235,-23.063,-22.923,-22.808,-22.713,-22.633,-22.565,-22.507/
DATA C2/-27.475,-26.000,-25.043,-24.382,-23.905,-23.548,-23.275,
1-23.062,-22.891,-22.753,-22.640,-22.546,-22.467,-22.400,-22.343,
2 -27.221,-25.783,-24.844,-24.193,-23.723,-23.372,-23.102,
2-22.892,-22.724,-22.588,-22.476,-22.384,-22.306,-22.240,-22.184,
3 -26.863,-25.506,-24.607,-23.979,-23.523,-23.182,-22.919,
3-22.714,-22.550,-22.417,-22.309,-22.218,-22.142,-22.078,-22.023,
4 -26.685,-25.347,-24.457,-23.835,-23.382,-23.044,-22.784,
4-22.580,-22.418,-22.286,-22.178,-22.089,-22.014,-21.950,-21.896,
5 -26.085,-24.903,-24.105,-23.538,-23.120,-22.805,-22.561,
5-22.370,-22.217,-22.093,-21.991,-21.906,-21.835,-21.775,-21.723,
6 -25.902,-24.727,-23.936,-23.376,-22.964,-22.654,-22.415,
6-22.227,-22.076,-21.955,-21.855,-21.772,-21.702,-21.644,-21.593,
7 -25.215,-24.196,-23.510,-23.019,-22.655,-22.378,-22.163,
7-21.992,-21.855,-21.744,-21.653,-21.577,-21.513,-21.459,-21.412,
8 -24.914,-23.937,-23.284,-22.820,-22.475,-22.212,-22.007,
8-21.845,-21.715,-21.609,-21.522,-21.449,-21.388,-21.336,-21.292,
9 -24.519,-23.637,-23.039,-22.606,-22.281,-22.030,-21.834,
9-21.678,-21.552,-21.450,-21.365,-21.295,-21.236,-21.185,-21.142,
A -24.086,-23.222,-22.650,-22.246,-21.948,-21.722,-21.546,
A-21.407,-21.296,-21.205,-21.131,-21.070,-21.018,-20.974,-20.937/
DATA C3/-23.850,-23.018,-22.472,-22.088,-21.805,-21.590,-21.422,
1-21.289,-21.182,-21.095,-21.024,-20.964,-20.914,-20.872,-20.835,
2 -23.136,-22.445,-21.994,-21.676,-21.440,-21.259,-21.117,
2-21.004,-20.912,-20.837,-20.775,-20.723,-20.679,-20.642,-20.611,
3 -23.199,-22.433,-21.927,-21.573,-21.314,-21.119,-20.969,
3-20.851,-20.758,-20.682,-20.621,-20.571,-20.529,-20.493,-20.463,
4 -22.696,-22.020,-21.585,-21.286,-21.071,-20.912,-20.791,
4-20.697,-20.622,-20.563,-20.514,-20.475,-20.442,-20.414,-20.391,
5 -22.119,-21.557,-21.194,-20.943,-20.761,-20.624,-20.518,
5-20.434,-20.367,-20.313,-20.268,-20.231,-20.201,-20.175,-20.153,
6 -21.855,-21.300,-20.931,-20.673,-20.485,-20.344,-20.235,
6-20.151,-20.084,-20.031,-19.988,-19.953,-19.924,-19.900,-19.880,
7 -21.126,-20.673,-20.382,-20.184,-20.044,-19.943,-19.868,
7-19.811,-19.769,-19.736,-19.710,-19.690,-19.674,-19.662,-19.652,
8 -20.502,-20.150,-19.922,-19.766,-19.657,-19.578,-19.520,
8-19.478,-19.446,-19.422,-19.404,-19.390,-19.379,-19.371,-19.365,
9 -20.030,-19.724,-19.530,-19.399,-19.309,-19.245,-19.199,
9-19.166,-19.142,-19.125,-19.112,-19.103,-19.096,-19.091,-19.088,
A -19.640,-19.364,-19.189,-19.074,-18.996,-18.943,-18.906,
A-18.881,-18.863,-18.852,-18.844,-18.839,-18.837,-18.836,-18.836/
DATA C4/-19.333,-19.092,-18.939,-18.838,-18.770,-18.725,-18.695,
1-18.675,-18.662,-18.655,-18.651,-18.649,-18.649,-18.651,-18.653,
2 -19.070,-18.880,-18.756,-18.674,-18.621,-18.585,-18.562,
2-18.548,-18.540,-18.536,-18.536,-18.537,-18.539,-18.542,-18.546,
3 -18.851,-18.708,-18.617,-18.558,-18.521,-18.498,-18.484,
3-18.477,-18.475,-18.476,-18.478,-18.482,-18.487,-18.493,-18.498,
4 -18.709,-18.599,-18.533,-18.494,-18.471,-18.459,-18.454,
4-18.454,-18.457,-18.462,-18.469,-18.476,-18.483,-18.490,-18.498,
5 -18.656,-18.572,-18.524,-18.497,-18.485,-18.480,-18.482,
5-18.486,-18.493,-18.501,-18.510,-18.519,-18.527,-18.536,-18.544,
6 -18.670,-18.613,-18.582,-18.566,-18.561,-18.562,-18.568,
6-18.575,-18.583,-18.592,-18.601,-18.610,-18.619,-18.627,-18.635,
7 -18.728,-18.700,-18.687,-18.683,-18.685,-18.691,-18.698,
7-18.706,-18.715,-18.723,-18.731,-18.739,-18.745,-18.752,-18.758,
8 -18.839,-18.835,-18.836,-18.842,-18.849,-18.857,-18.865,
8-18.872,-18.878,-18.883,-18.888,-18.892,-18.895,-18.898,-18.900,
9 -19.034,-19.041,-19.049,-19.057,-19.064,-19.069,-19.071,
9-19.071,-19.070,-19.068,-19.065,-19.061,-19.058,-19.054,-19.051,
A -19.372,-19.378,-19.382,-19.380,-19.372,-19.359,-19.341,
A-19.321,-19.300,-19.280,-19.261,-19.243,-19.227,-19.212,-19.199/
DATA C5/-19.780,-19.777,-19.763,-19.732,-19.686,-19.631,-19.573,
1-19.517,-19.465,-19.419,-19.379,-19.344,-19.314,-19.288,-19.265,
2 -20.151,-20.133,-20.087,-20.009,-19.911,-19.810,-19.715,
2-19.631,-19.559,-19.497,-19.446,-19.402,-19.365,-19.333,-19.306,
3 -20.525,-20.454,-20.312,-20.138,-19.970,-19.825,-19.705,
3-19.607,-19.528,-19.464,-19.411,-19.367,-19.330,-19.300,-19.274,
4 -20.869,-20.655,-20.366,-20.104,-19.894,-19.731,-19.604,
4-19.505,-19.426,-19.363,-19.312,-19.271,-19.236,-19.208,-19.184,
5 -21.179,-20.768,-20.380,-20.081,-19.856,-19.686,-19.556,
5-19.454,-19.375,-19.311,-19.260,-19.218,-19.184,-19.155,-19.131,
6 -21.167,-20.601,-20.206,-19.925,-19.719,-19.565,-19.447,
6-19.355,-19.283,-19.226,-19.180,-19.143,-19.112,-19.087,-19.066,
7 -20.918,-20.348,-19.976,-19.720,-19.536,-19.401,-19.299,
7-19.220,-19.159,-19.112,-19.073,-19.043,-19.018,-18.998,-18.981,
8 -20.753,-20.204,-19.847,-19.602,-19.427,-19.299,-19.203,
8-19.129,-19.072,-19.028,-18.993,-18.965,-18.942,-18.924,-18.909,
9 -20.456,-19.987,-19.677,-19.460,-19.302,-19.186,-19.098,
9-19.030,-18.978,-18.937,-18.904,-18.878,-18.857,-18.841,-18.827,
A -20.154,-19.734,-19.461,-19.272,-19.136,-19.035,-18.960,
A-18.902,-18.858,-18.824,-18.797,-18.775,-18.759,-18.745,-18.735/
DATA C6/-19.941,-19.544,-19.288,-19.114,-18.992,-18.903,-18.837,
1-18.788,-18.751,-18.723,-18.701,-18.684,-18.671,-18.661,-18.654,
2 -19.657,-19.321,-19.104,-18.956,-18.853,-18.779,-18.724,
2-18.684,-18.655,-18.632,-18.615,-18.602,-18.592,-18.585,-18.579,
3 -19.388,-19.109,-18.930,-18.810,-18.725,-18.664,-18.620,
3-18.586,-18.562,-18.543,-18.529,-18.518,-18.510,-18.503,-18.498,
4 -19.201,-18.953,-18.794,-18.686,-18.611,-18.556,-18.515,
4-18.485,-18.462,-18.446,-18.433,-18.423,-18.416,-18.410,-18.406,
5 -18.923,-18.719,-18.588,-18.500,-18.439,-18.396,-18.365,
5-18.344,-18.328,-18.318,-18.311,-18.307,-18.304,-18.303,-18.302,
6 -18.614,-18.458,-18.361,-18.298,-18.258,-18.232,-18.216,
6-18.206,-18.202,-18.201,-18.202,-18.205,-18.208,-18.213,-18.218,
7 -18.419,-18.295,-18.222,-18.178,-18.153,-18.139,-18.132,
7-18.131,-18.133,-18.138,-18.143,-18.150,-18.157,-18.164,-18.172,
8 -18.296,-18.201,-18.148,-18.118,-18.101,-18.094,-18.091,
8-18.093,-18.096,-18.101,-18.107,-18.113,-18.120,-18.126,-18.132,
9 -18.021,-17.992,-17.977,-17.970,-17.967,-17.968,-17.970,
9-17.974,-17.978,-17.983,-17.989,-17.994,-18.000,-18.005,-18.011,
A -17.694,-17.686,-17.686,-17.691,-17.698,-17.708,-17.718,
A-17.729,-17.740,-17.750,-17.761,-17.771,-17.781,-17.790,-17.798/
DATA C7/-17.374,-17.384,-17.400,-17.420,-17.440,-17.462,-17.483,
1-17.503,-17.523,-17.541,-17.558,-17.575,-17.590,-17.603,-17.616,
2 -17.169,-17.199,-17.230,-17.262,-17.293,-17.323,-17.351,
2-17.378,-17.404,-17.427,-17.449,-17.469,-17.488,-17.505,-17.520,
3 -17.151,-17.184,-17.217,-17.250,-17.282,-17.313,-17.342,
3-17.369,-17.395,-17.418,-17.440,-17.461,-17.480,-17.497,-17.513,
4 -17.230,-17.260,-17.290,-17.320,-17.348,-17.375,-17.401,
4-17.425,-17.448,-17.469,-17.489,-17.508,-17.525,-17.541,-17.556,
5 -17.379,-17.403,-17.425,-17.446,-17.467,-17.486,-17.505,
5-17.524,-17.541,-17.558,-17.574,-17.588,-17.602,-17.615,-17.627,
6 -17.596,-17.604,-17.609,-17.612,-17.616,-17.622,-17.628,
6-17.636,-17.644,-17.652,-17.661,-17.670,-17.679,-17.687,-17.695,
7 -17.846,-17.823,-17.795,-17.770,-17.750,-17.735,-17.725,
7-17.719,-17.716,-17.715,-17.716,-17.719,-17.722,-17.726,-17.730,
8 -18.089,-18.015,-17.942,-17.882,-17.836,-17.802,-17.777,
8-17.760,-17.748,-17.740,-17.736,-17.734,-17.733,-17.734,-17.736,
9 -18.299,-18.156,-18.038,-17.947,-17.881,-17.833,-17.798,
9-17.774,-17.757,-17.745,-17.738,-17.733,-17.730,-17.729,-17.729,
A -18.441,-18.243,-18.096,-17.991,-17.915,-17.860,-17.821,
A-17.792,-17.772,-17.757,-17.746,-17.738,-17.733,-17.730,-17.728/
DATA C8/-18.474,-18.262,-18.111,-18.004,-17.926,-17.869,-17.826,
1-17.795,-17.771,-17.753,-17.740,-17.730,-17.722,-17.717,-17.713,
2 -18.387,-18.191,-18.053,-17.952,-17.878,-17.823,-17.782,
2-17.752,-17.729,-17.711,-17.698,-17.689,-17.681,-17.676,-17.672,
3 -18.161,-17.990,-17.874,-17.793,-17.736,-17.696,-17.668,
3-17.648,-17.634,-17.625,-17.619,-17.616,-17.614,-17.614,-17.615,
4 -17.908,-17.774,-17.690,-17.637,-17.604,-17.583,-17.572,
4-17.567,-17.566,-17.568,-17.571,-17.576,-17.581,-17.587,-17.593,
5 -17.681,-17.589,-17.540,-17.515,-17.506,-17.505,-17.511,
5-17.520,-17.530,-17.542,-17.554,-17.566,-17.578,-17.589,-17.600,
6 -17.647,-17.606,-17.584,-17.575,-17.573,-17.576,-17.582,
6-17.589,-17.597,-17.605,-17.614,-17.623,-17.631,-17.639,-17.646,
7 -17.300,-17.291,-17.291,-17.297,-17.307,-17.319,-17.333,
7-17.347,-17.361,-17.375,-17.389,-17.402,-17.415,-17.427,-17.438,
8 -16.786,-16.802,-16.825,-16.853,-16.883,-16.914,-16.944,
8-16.974,-17.003,-17.030,-17.055,-17.079,-17.101,-17.122,-17.141,
9 -16.489,-16.533,-16.579,-16.625,-16.670,-16.713,-16.754,
9-16.793,-16.830,-16.864,-16.896,-16.925,-16.952,-16.977,-17.000,
A -16.694,-16.724,-16.756,-16.789,-16.823,-16.856,-16.888,
A-16.919,-16.949,-16.976,-17.002,-17.026,-17.048,-17.069,-17.088/
DATA C9/-16.935,-16.951,-16.971,-16.993,-17.016,-17.040,-17.064,
1-17.088,-17.111,-17.132,-17.153,-17.172,-17.190,-17.206,-17.222,
2 -17.200,-17.208,-17.220,-17.235,-17.251,-17.269,-17.286,
2-17.304,-17.322,-17.338,-17.354,-17.369,-17.384,-17.397,-17.409,
3 -17.597,-17.591,-17.589,-17.590,-17.594,-17.600,-17.608,
3-17.617,-17.626,-17.635,-17.645,-17.654,-17.662,-17.671,-17.679,
4 -18.166,-18.134,-18.107,-18.085,-18.068,-18.056,-18.047,
4-18.041,-18.038,-18.036,-18.035,-18.035,-18.036,-18.038,-18.039,
5 -19.000,-18.917,-18.838,-18.770,-18.714,-18.669,-18.632,
5-18.603,-18.579,-18.560,-18.545,-18.532,-18.522,-18.514,-18.507,
6 -20.313,-19.982,-19.754,-19.592,-19.472,-19.380,-19.309,
6-19.253,-19.208,-19.172,-19.143,-19.119,-19.099,-19.083,-19.069,
7 -19.751,-19.611,-19.520,-19.461,-19.423,-19.398,-19.382,
7-19.372,-19.366,-19.364,-19.363,-19.364,-19.366,-19.368,-19.371,
8 -19.581,-19.431,-19.337,-19.277,-19.240,-19.218,-19.207,
8-19.202,-19.203,-19.207,-19.212,-19.220,-19.228,-19.236,-19.245,
9 -19.685,-19.506,-19.389,-19.311,-19.258,-19.222,-19.199,
9-19.184,-19.175,-19.170,-19.168,-19.169,-19.171,-19.174,-19.177,
A -19.977,-19.756,-19.606,-19.501,-19.425,-19.370,-19.330,
A-19.300,-19.278,-19.262,-19.250,-19.241,-19.235,-19.230,-19.227/
DATA C10/-20.445,-20.158,-19.958,-19.815,-19.711,-19.633,-19.574,
1-19.528,-19.493,-19.465,-19.442,-19.425,-19.410,-19.398,-19.389,
2 -20.980,-20.625,-20.391,-20.229,-20.110,-20.020,-19.949,
2-19.892,-19.846,-19.807,-19.775,-19.748,-19.724,-19.704,-19.687,
3 -21.404,-21.023,-20.771,-20.594,-20.461,-20.358,-20.274,
3-20.205,-20.148,-20.099,-20.058,-20.022,-19.991,-19.965,-19.942,
4 -21.309,-20.970,-20.753,-20.603,-20.495,-20.412,-20.348,
4-20.295,-20.252,-20.215,-20.185,-20.158,-20.135,-20.115,-20.098,
5 -21.221,-20.906,-20.707,-20.574,-20.480,-20.412,-20.361,
5-20.322,-20.292,-20.268,-20.249,-20.233,-20.221,-20.210,-20.201,
6 -21.441,-21.097,-20.878,-20.728,-20.623,-20.546,-20.489,
6-20.446,-20.413,-20.387,-20.368,-20.352,-20.340,-20.330,-20.322,
7 -21.668,-21.305,-21.071,-20.911,-20.797,-20.713,-20.650,
7-20.602,-20.565,-20.536,-20.514,-20.496,-20.481,-20.470,-20.460,
8 -21.926,-21.556,-21.316,-21.150,-21.031,-20.942,-20.874,
8-20.822,-20.782,-20.750,-20.724,-20.704,-20.687,-20.674,-20.663,
9 -22.319,-21.937,-21.686,-21.510,-21.380,-21.282,-21.206,
9-21.147,-21.099,-21.061,-21.031,-21.006,-20.985,-20.968,-20.954,
A -22.969,-22.561,-22.288,-22.092,-21.945,-21.832,-21.743,
A-21.672,-21.616,-21.570,-21.533,-21.503,-21.477,-21.457,-21.439/
DATA C11/-24.001,-23.527,-23.199,-22.957,-22.772,-22.629,-22.516,
1-22.427,-22.355,-22.297,-22.250,-22.212,-22.180,-22.153,-22.131,
2 -24.233,-23.774,-23.477,-23.273,-23.128,-23.022,-22.943,
2-22.883,-22.837,-22.802,-22.774,-22.752,-22.735,-22.721,-22.710,
3 -24.550,-23.913,-23.521,-23.266,-23.094,-22.976,-22.893,
3-22.836,-22.796,-22.768,-22.750,-22.737,-22.730,-22.726,-22.725,
4 -24.301,-23.665,-23.274,-23.019,-22.848,-22.730,-22.648,
4-22.591,-22.552,-22.525,-22.507,-22.495,-22.489,-22.485,-22.485,
5 -24.519,-23.883,-23.491,-23.237,-23.065,-22.948,-22.866,
5-22.809,-22.770,-22.743,-22.724,-22.713,-22.706,-22.703,-22.702/
DATA PARTCH/
1 203.741, 249.643, 299.341, 353.477, 412.607, 477.237,
2 547.817, 624.786, 708.543, 799.463, 897.912, 1004.227,
3 1118.738, 1241.761, 1373.588, 1514.481, 1664.677, 1824.394,
4 1993.801, 2173.050, 2362.234, 2561.424, 2770.674, 2989.930,
5 3219.204, 3458.378, 3707.355, 3966.005, 4234.155, 4511.604,
6 4798.135, 5093.554, 5397.593, 5709.948, 6030.401, 6358.646,
7 6694.379, 7037.313, 7387.147, 7743.579, 8106.313/
DATA FREQ1/0./
C
SBFCH=0.
IF(FR.EQ.FREQ1) GO TO 30
FREQ1=FR
WAVENO=FR/2.99792458E10
EVOLT=WAVENO/8065.479
N=int(EVOLT*10.)
EN=FLOAT(N)*.1
IF(N.LT.20) RETURN
IF(N.GE.105) RETURN
c
DO IT=1,15
CROSSCHT(IT)=(CROSSCH(IT,N)+(CROSSCH(IT,N+1)-CROSSCH(IT,N))*
* (EVOLT-EN)*10.)
END DO
c
c interpolate to obtain partition function
c
30 IF(T.GE.9000.) RETURN
IF(N.LT.20) RETURN
IF(N.GE.105) RETURN
IT=int((T-1000.)*twhui+1.)
IF(IT.LT.1) IT=1
TN=FLOAT(IT)*twhu+800.
PART=PARTCH(IT)+(PARTCH(IT+1)-PARTCH(IT))*(T-TN)*twhui
c
c interpolate to obtain cross-section
c
IT=int((T-2000.)*fihui+1.)
IF(IT.LT.1) IT=1
TN=FLOAT(IT)*fihu+1500.
CHOP=EXP((CROSSCHT(IT)+(CROSSCHT(IT+1)-CROSSCHT(IT))*
* (T-TN)*fihui)*tenl)*PART
RETURN
END