SpectraRust/tlusty/extracted/partf.f
2026-03-19 14:05:33 +08:00

984 lines
45 KiB
Fortran

SUBROUTINE PARTF(IAT,IZI,T,ANE,XMAX,U,DUT,DUN)
C ==============================================
C
C Partition functions
C The standard evaluation is for hydrogen through zinc, for
C neutrals and first four ionization degrees.
C Basically after Traving, Baschek, and Holweger, Abhand. Hamburg.
C Sternwarte. Band VIII, Nr. 1 (1966)
C
C For higher atomic numbers modified Kurucz routine PFSAHA,
C called PFHEAV here is used. The routine was provided by
C Charles Proffitt.
C
C The routine calls special procedures for Fe and Ni; or
C the values based on the tabulated Opacity Project ionization
C fractions
C
C Input:
C IAT - atomic number
C IZI - ionic charge (=1 for neutrals, =2 for once ionized, etc)
C T - temperature
C ANE - electron density
C XMAX - principal quantum number of the last bound level
C
C Output:
C U - partition function
C DUT - derivative dU/dT
C DUN - derivative dU/d(ANE)
C
C Quantities in COMMON/PFSTDS:
C for MODPF(IAT) < 0 - non-standard, user supplied procedure
C for evaluating partition functions PFSPEC
C = 0 - standard expressions
C After Traving, Baschek, and Holweger, Abhand.
C Hamburg. Sternwarte, Band VIII, Nr. 1 (1966)
C > 0 - partition functions evaluated from the
C Opacity Project ionization fractions
C (by routine OPFRAC)
C PFSTD(IAT,IZI) - see above
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
COMMON/PFSTDS/PFSTD(matom,30),MODPF(matom)
common/irwint/iirwin
PARAMETER (NIONS=123, NSS=222)
c PARAMETER (UN=1.D0, HALF=0.5D0, TWO=2.D0, TRHA=1.5D0,
PARAMETER (TRHA=1.5D0,
* THIRD=UN/3.D0, SIXTH=UN/6.D0)
REAL*4 AHH( 6), ALB(12), AB (11), AC (19), AN (30), AO (49),
* AF (34), ANN(23), ANA(19), AMG(15), AAL(17), ASI(23),
* AP (19), AS (29), ACL(28), AAR(25), AK (30), ACA(17),
* ASC(24), ATI(33), AV (33), ACR(29), AMN(28), AFE(35),
* ACO(29), ANI(23), ACU(20), AZN(18)
REAL*4 GHH( 6), GLB(12), GB (11), GC (19), GN (30), GO (49),
* GF (34), GNN(23), GNA(19), GMG(15), GAL(17), GSI(23),
* GP (19), GS (29), GCL(28), GAR(25), GK (30), GCA(17),
* GSC(24), GTI(33), GV (33), GCR(29), GMN(28), GFE(35),
* GCO(29), GNI(23), GCU(20), GZN(18)
REAL*4 XL1(99), XL2(123), XL(222),
* CH1(66), CH2(72), CH3(55), CH4(29), CHION(222)
REAL*4 ALF(678), GAM(678)
C INTEGER*2 II1(5,15),II2(5,15),INDEX0(5,30),
INTEGER II1(5,15),II2(5,15),INDEX0(5,30),
* IS1(53),IS2(70),IS(123),INDEXS(123),
* IM1(99),IM2(123),IM(222),INDEXM(222),
* IGP1(99),IGP2(123),IGPR(222),
* IG01(53),IG02(70),IG0(123)
DIMENSION IGLE(28)
C
EQUIVALENCE ( AHH(1), ALF( 1)),( ALB(1), ALF( 7)),
* ( AB (1), ALF( 19)),
* ( AC (1), ALF( 30)),( AN (1), ALF( 49)),
* ( AO (1), ALF( 79)),( AF (1), ALF(128)),
* ( ANN(1), ALF(162)),( ANA(1), ALF(185)),
* ( AMG(1), ALF(204)),( AAL(1), ALF(219)),
* ( ASI(1), ALF(236)),( AP (1), ALF(259)),
* ( AS (1), ALF(278)),( ACL(1), ALF(307)),
* ( AAR(1), ALF(335)),( AK (1), ALF(360)),
* ( ACA(1), ALF(390)),( ASC(1), ALF(407)),
* ( ATI(1), ALF(431)),( AV (1), ALF(464)),
* ( ACR(1), ALF(497)),( AMN(1), ALF(526)),
* ( AFE(1), ALF(554)),( ACO(1), ALF(589)),
* ( ANI(1), ALF(618)),( ACU(1), ALF(641)),
* ( AZN(1), ALF(661))
EQUIVALENCE ( GHH(1), GAM( 1)),( GLB(1), GAM( 7)),
* ( GB (1), GAM( 19)),
* ( GC (1), GAM( 30)),( GN (1), GAM( 49)),
* ( GO (1), GAM( 79)),( GF (1), GAM(128)),
* ( GNN(1), GAM(162)),( GNA(1), GAM(185)),
* ( GMG(1), GAM(204)),( GAL(1), GAM(219)),
* ( GSI(1), GAM(236)),( GP (1), GAM(259)),
* ( GS (1), GAM(278)),( GCL(1), GAM(307)),
* ( GAR(1), GAM(335)),( GK (1), GAM(360)),
* ( GCA(1), GAM(390)),( GSC(1), GAM(407)),
* ( GTI(1), GAM(431)),( GV (1), GAM(464)),
* ( GCR(1), GAM(497)),( GMN(1), GAM(526)),
* ( GFE(1), GAM(554)),( GCO(1), GAM(589)),
* ( GNI(1), GAM(618)),( GCU(1), GAM(641)),
* ( GZN(1), GAM(661))
EQUIVALENCE ( CH1(1), CHION( 1)),
* ( CH2(1), CHION( 67)),
* ( CH3(1), CHION(139)),
* ( CH4(1), CHION(194)),
* ( XL1(1), XL( 1)),
* ( XL2(1), XL(100))
EQUIVALENCE ( IS1(1), IS(1)), ( IS2(1), IS( 54)),
* ( IM1(1), IM(1)), ( IM2(1), IM(100)),
* (IGP1(1),IGPR(1)), (IGP2(1),IGPR(100)),
* (IG01(1), IG0(1)), (IG02(1), IG0( 54)),
* (II1(1,1),INDEX0(1,1)),(II2(1,1),INDEX0(1,16))
C
DATA IGLE/2,1,2,1,6,9,4,9,6,1,2,1,6,9,4,9,6,1,
* 10,21,28,25,6,25,28,21,10,21/
C
C Internal numbering of ions; each line corresponds to one species,
C starting from hydrogen.
C 0 means that the ion does not exist
C negative number means that partition function is assumed constant
C (ie even for MODPF=0) and equal to ABS(that value)
C
DATA II1 / 1, -1, 0, 0, 0,
* 2, 3, -1, 0, 0,
* 4, 5, -2, -1, 0,
* 6, 7, -1, -2, -1,
* 8, 9, 10, -1, -2,
* 11, 12, 13, 14, -1,
* 15, 16, 17, 18, 19,
* 20, 21, 22, 23, 24,
* 25, 26, 27, 28, -6,
* 29, 30, 31, 32, -9,
* 33, 34, 35, 36, -4,
* 37, 38, 39, 40, -9,
* 41, 42, 43, 44, -6,
* 45, 46, 47, 48, -1,
* 49, 50, 51, 52, 53 /
DATA II2 / 54, 55, 56, 57, 58,
* 59, 60, 61, 62, 63,
* 64, 65, 66, 67, 68,
* 69, 70, 71, 72, 73,
* 74, 75, 76, 77, -9,
* 78, 76, 80, 81, 82,
* 83, 84, 85, 86, 87,
* 88, 89, 90, 91, 92,
* 93, 94, 95, 96, 97,
* 98, 99, 100, 101, 102,
* 103, 104, 105, 106, 107,
* 108, 109, 110, 111, -25,
* 112, 113, 114, 115, -1,
* 116, 117, 118, 119, -1,
* 120, 121, 122, 123, -1 /
C
C Statistical weights of the ground states
C
DATA IG01 / 2,
* 1, 2,
* 2, 1,
* 1, 2,
* 2, 1, 2,
* 1, 2, 1, 2,
* 4, 1, 2, 1, 2,
* 5, 4, 1, 2, 1,
* 4, 5, 4, 1,
* 1, 4, 5, 4,
* 2, 1, 4, 5,
* 1, 2, 1, 4,
* 2, 1, 2, 1,
* 1, 2, 1, 2,
* 4, 1, 2, 1, 2 /
DATA IG02 / 5, 4, 1, 2, 1,
* 4, 5, 4, 1, 2,
* 1, 4, 5, 4, 1,
* 2, 1, 4, 5, 4,
* 1, 2, 1, 4,
* 4, 3, 4, 1, 4,
* 5, 4, 5, 4, 1,
* 4, 1, 4, 5, 4,
* 7, 6, 1, 4, 5,
* 6, 7, 6, 1, 4,
* 9, 10, 9, 6, 1,
* 10, 9, 10, 20,
* 9, 6, 9, 28,
* 2, 1, 6, 21,
* 1, 2, 1, 10 /
C
DATA IS1 / 1,
* 1, 1,
* 1, 1,
* 2, 1,
* 1, 2, 1,
* 1, 2, 2, 1,
* 2, 2, 3, 2, 1,
* 3, 4, 3, 5, 2,
* 2, 3, 4, 3,
* 2, 2, 3, 2,
* 1, 2, 2, 3,
* 1, 1, 2, 2,
* 2, 2, 1, 2,
* 1, 2, 2, 1,
* 2, 1, 1, 1, 1 /
DATA IS2 / 3, 2, 1, 2, 2,
* 2, 3, 2, 1, 1,
* 2, 2, 3, 1, 1,
* 1, 2, 3, 3, 2,
* 2, 1, 2, 2,
* 3, 1, 1, 1, 1,
* 3, 2, 1, 1, 1,
* 2, 3, 1, 1, 1,
* 3, 2, 1, 1, 1,
* 3, 2, 1, 1, 1,
* 3, 2, 2, 1, 1,
* 4, 2, 1, 1,
* 2, 2, 1, 1,
* 3, 2, 1, 1,
* 3, 3, 1, 1 /
C
DATA IM1 / 2,
* 2, 2,
* 2, 2,
* 3, 2, 3,
* 3, 3, 2, 3,
* 4, 3, 3, 3, 3, 3,
* 3, 3, 4, 3, 3, 4, 2, 3, 2, 3,
* 4, 2, 2, 4, 2, 3, 3, 4, 4, 2,
* 3, 4, 2, 2, 2, 3, 3,
* 3, 3, 4, 2, 2,
* 4, 2, 3, 2, 5, 2, 2,
* 2, 2, 3, 2, 4, 2, 2, 4, 2,
* 2, 2, 2, 3, 2, 4, 2, 2,
* 3, 3, 2, 2, 3, 2,
* 3, 2, 3, 2, 3, 2, 2,
* 5, 4, 4, 4, 3, 3,
* 3, 2, 4, 4, 3, 3 /
DATA IM2 / 4, 2, 2, 4, 2, 5, 4, 2, 3, 1,
* 3, 2, 5, 2, 2, 4, 2, 4, 4,
* 2, 2, 3, 2, 4, 2, 2, 4, 4,
* 3, 2, 3, 3, 2, 3,
* 4, 2, 2, 4, 2,
* 3, 2, 3, 2, 2, 3, 2,
* 4, 3, 3, 5, 4, 2, 3,
* 6, 4, 3, 6, 3, 5, 4, 2,
* 5, 3, 5, 4, 4, 4, 4, 4,
* 3, 3, 3, 4, 4, 4, 4, 4,
* 3, 2, 3, 4, 4, 4, 4, 4,
* 4, 4, 3, 5, 3, 4, 4, 4, 4,
* 5, 3, 3, 3, 5, 4, 5, 1,
* 6, 3, 5, 3, 5, 1,
* 2, 3, 3, 4, 3, 4, 1,
* 2, 2, 2, 3, 3, 2, 3, 1 /
C
DATA IGP1 / 2,
* 4, 2,
* 2, 4,
* 4, 12, 2,
* 2, 4, 12, 2,
* 12, 2, 18, 4, 12, 2,
* 18, 10, 12, 24, 2, 18, 6, 4, 12, 2,
* 8, 20, 12, 18, 10, 2, 10, 12, 24, 20,
* 2, 18, 6, 18, 10, 4, 12,
* 18, 10, 8, 20, 12,
* 18, 10, 2, 10, 12, 24, 20,
* 8, 4, 18, 10, 8, 20, 12, 18, 10,
* 2, 8, 4, 18, 10, 8, 20, 12,
* 4, 2, 8, 4, 18, 10,
* 2, 18, 4, 12, 2, 8, 4,
* 12, 2, 18, 4, 12, 2,
* 18, 10, 12, 2, 4, 2 /
DATA IGP2 / 8, 20, 12, 18, 10, 12, 2, 18, 4, 12,
* 18, 10, 8, 20, 12, 18, 10, 12, 2,
* 8, 4, 18, 10, 8, 20, 12, 18, 12,
* 2, 8, 4, 18, 10, 2,
* 8, 20, 12, 18, 10,
* 4, 20, 2, 8, 4, 18, 10,
* 30, 42, 18, 20, 2, 12, 18,
* 56, 56, 28, 42, 10, 20, 2, 12,
* 50, 70, 56, 72, 64, 42, 20, 2,
* 12, 60, 40, 50, 18, 56, 42, 20,
* 14, 10, 50, 12, 72, 50, 56, 42,
* 60, 56, 40, 50, 18, 12, 72, 50, 56,
* 42, 70, 42, 18, 56, 24, 50, 12,
* 20, 56, 42, 18, 56, 50,
* 2, 30, 10, 20, 56, 42, 56,
* 4, 8, 12, 2, 30, 10, 20, 42 /
C
DATA XL1 /11.0,
* 8.0,12.0,
* 6.0, 6.0,
* 6.0, 4.0, 8.0,
* 9.0, 6.0, 4.0, 6.0,
* 6.0, 6.0, 5.0, 6.1, 5.0, 6.0,
* 6.1, 4.0, 5.0, 3.9, 6.0, 5.0, 4.0, 6.0, 6.3, 6.0,
* 8.0, 6.0, 3.4, 6.0, 5.0, 3.9, 3.9, 6.0, 4.9, 4.0,
* 5.9, 5.0, 4.9, 4.0, 4.0, 6.0, 6.0,
* 4.0, 4.0, 5.0, 4.0, 4.0,
* 5.0, 4.0, 3.9, 4.0, 5.0, 5.0, 4.0,
* 6.0, 6.0, 5.0, 4.0, 3.9, 4.0, 4.0, 5.0, 5.0,
* 7.0, 4.0, 4.0, 4.0, 4.0, 5.0, 5.0, 5.0,
* 7.0, 7.0, 5.0, 5.0, 5.0, 5.0,
* 7.0, 4.0, 7.0, 4.0, 7.0, 5.0, 5.0,
* 6.1, 5.9, 5.0, 5.0, 5.0, 7.0,
* 5.0, 5.0, 5.0, 7.0, 8.6, 8.0 /
DATA XL2 / 6.0, 5.0, 5.0, 5.0, 5.0, 3.5, 5.0,14.4, 5.0, 4.0,
* 6.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.2,
* 6.0, 6.0, 5.1, 5.0, 5.0, 5.0, 5.0, 5.0, 4.0,
* 7.0, 5.0, 5.0, 6.0, 6.0, 5.0,
* 6.0, 5.0, 5.0, 3.6, 4.0,
* 5.9, 6.0, 7.0, 5.0, 4.9, 5.0, 4.3,
* 4.9, 4.9, 5.0, 5.0, 6.0, 4.6, 3.8,
* 5.0, 4.7, 5.0, 5.0, 5.0, 5.0, 6.0, 4.8,
* 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0,11.2,
* 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.2,
* 6.0, 5.0, 6.0, 7.0, 5.0, 5.0, 5.0, 5.0,
* 5.0, 5.0, 5.0, 5.0, 5.0, 6.0, 5.0, 3.6, 3.8,
* 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 5.0, 3.0,
* 5.4, 5.0, 9.0, 5.0, 5.0, 3.0,
* 8.0, 6.0, 5.0, 7.0, 5.0, 5.0, 2.9,
* 8.0, 5.0, 5.0, 8.0, 5.0, 5.0, 5.0, 2.8 /
C
C
DATA CH1 / 13.595 ,
* 24.580 , 54.403 ,
* 5.390 , 75.619 ,
* 9.320 , 13.278 , 18.206 ,
* 8.296 , 25.149 , 31.146 , 37.920 ,
* 11.256 , 24.376 , 30.868 , 47.871 , 55.873 ,
* 64.476 ,
* 14.529 , 16.428 , 29.593 , 36.693 ,
* 47.426 , 55.765 , 63.626 , 77.450 , 87.445 ,
* 97.863 ,
* 13.614 , 16.938 , 18.630 ,
* 35.108 , 37.621 , 40.461 , 42.584 ,
* 54.886 , 63.733 , 70.556 ,
* 77.394 , 87.609 , 97.077 , 103.911 , 106.116 ,
* 113.873 , 125.863 ,
* 17.418 , 20.009 , 34.977 , 39.204 , 41.368 ,
* 62.646 , 65.774 , 69.282 , 71.882 ,
* 87.139 , 97.852 , 106.089 ,
* 21.559 , 21.656 , 41.071 , 44.274 ,
* 63.729 , 68.806 , 71.434 , 97.162 , 100.917 /
DATA CH2 / 5.138 , 47.290 , 47.459 , 71.647 , 75.504 ,
* 98.880 , 104.778 , 107.864 ,
* 7.644 , 15.031 , 80.117 , 80.393 ,
* 109.294 , 113.799 ,
* 5.984 , 10.634 , 18.823 , 25.496 ,
* 28.441 , 119.957 , 120.383 ,
* 8.149 , 16.339 , 22.894 ,
* 33.459 , 42.333 , 45.130 ,
* 10.474 , 11.585 , 19.720 ,
* 30.156 , 51.354 , 65.007 ,
* 10.357 , 12.200 , 13.401 , 23.405 , 24.807 ,
* 35.047 , 47.292 , 57.681 , 72.474 , 85.701 ,
* 13.014 , 14.458 , 23.798 , 26.041 , 27.501 ,
* 39.904 , 41.610 , 53.450 , 67.801 ,
* 15.755 , 15.933 , 27.619 , 29.355 ,
* 40.899 , 42.407 , 45.234 , 59.793 , 75.002 ,
* 4.339 , 31.810 , 32.079 ,
* 45.738 , 47.768 , 50.515 ,
* 60.897 , 63.890 , 65.849 , 82.799 , 85.150 /
DATA CH3 / 6.111 , 7.808 , 11.868 ,
* 51.207 , 51.596 , 67.181 , 69.536 ,
* 6.538 , 7.147 , 8.042 ,
* 12.891 , 24.752 , 74.090 , 91.847 ,
* 6.818 , 6.953 , 7.411 ,
* 13.635 , 14.685 , 28.137 , 43.236 , 100.083 ,
* 6.738 , 7.101 , 14.205 , 15.670 , 16.277 ,
* 29.748 , 48.464 , 65.198 ,
* 6.763 , 8.285 , 9.221 ,
* 16.493 , 18.662 , 30.950 , 49.580 , 73.093 ,
* 7.432 , 8.606 , 9.240 , 15.636 , 18.963 ,
* 33.690 , 53.001 , 76.006 ,
* 7.896 , 8.195 , 8.927 , 16.178 , 18.662 ,
* 30.640 , 34.607 , 56.001 , 79.001 /
DATA CH4 / 7.863 , 8.378 , 9.160 , 9.519 ,
* 17.052 , 18.958 , 33.491 , 53.001 ,
* 7.633 , 8.793 , 18.147 , 20.233 , 35.161 ,
* 56.025 ,
* 7.724 , 10.532 , 10.980 ,
* 20.286 , 27.985 , 36.826 , 61.975 ,
* 9.391 , 17.503 , 17.166 ,
* 17.959 , 27.757 , 28.310 , 39.701 , 65.074 /
C
C data for hydrogen and helium
C
DATA AHH / 20.4976, 747.5023,
* 28.1703, 527.8296, 22.2809, 987.7189 /
DATA GHH / 10.853 , 13.342 ,
* 21.170 , 24.125 , 43.708 , 53.542 /
C
C data for lithium and beryllium
C
DATA ALB / 8.4915, 97.5015, 23.3299, 192.6701,
* 9.1849, 32.9263, 183.8887, 19.9563, 88.0437,
* 6.0478, 35.9723, 233.9798 /
DATA GLB / 2.022 , 4.604 , 62.032 , 72.624 ,
* 2.735 , 6.774 , 8.569 , 10.750 , 11.672 ,
* 3.967 , 12.758 , 16.692 /
C
C data for boron
C
DATA AB / 4.0086, 19.6741, 402.3110,
* 9.7257, 30.9262, 186.3466, 44.1629, 60.8371,
* 6.0084, 23.5767, 76.4149 /
DATA GB / 0.002 , 3.971 , 7.882 ,
* 4.720 , 13.477 , 22.103 , 23.056 , 24.734 ,
* 6.000 , 24.540 , 32.300 /
C
C data for carbon
C
DATA AC / 8.0158, 5.8833, 33.7521, 595.3432,
* 4.0003, 17.0841, 82.9154,
* 15.9808, 48.2044, 435.8093,
* 10.0281, 15.7574, 186.2109,
* 15.4127, 55.9559, 243.6311,
* 6.0057, 23.5757, 76.4185 /
DATA GC / 0.004 , 1.359 , 6.454 , 10.376 ,
* 0.008 , 16.546 , 21.614 ,
* 5.688 , 15.801 , 26.269 ,
* 6.691 , 25.034 , 40.975 ,
* 17.604 , 36.180 , 47.133 ,
* 8.005 , 40.804 , 54.492 /
C
C data for nitrogen
C
DATA AN / 14.0499, 30.8008, 883.1443,
* 10.0000, 16.0000, 64.0000,
* 8.0462, 6.2669, 17.8696, 282.8084,
* 7.3751, 33.1390, 215.4829,
* 4.0003, 19.3533, 80.6462,
* 13.0998, 19.6425, 94.3035, 370.9539,
* 16.0000, 38.0000,
* 10.3289, 14.5021, 187.1624, 108.1615, 191.8383,
* 6.0044, 23.5612, 76.4344 /
DATA GN / 2.554 , 9.169 , 13.651 ,
* 12.353 , 13.784 , 14.874 ,
* 0.014 , 2.131 , 15.745 , 24.949 ,
* 6.376 , 14.246 , 29.465 ,
* 0.022 , 31.259 , 41.428 ,
* 7.212 , 15.228 , 34.387 , 46.708 ,
* 46.475 , 49.468 ,
* 8.693 , 37.650 , 65.479 , 61.155 , 79.196 ,
* 9.999 , 60.991 , 82.262 /
C
C data for oxygen
C
DATA AO / 4.0029, 5.3656, 36.2853,1044.3447,
* 131.0217, 868.9779, 14.8533, 93.1466,
* 12.7843, 5.6828, 98.0919, 829.4396,
* 50.9878, 199.0120, 2.0000, 6.0000, 10.0000,
* 10.0000, 30.0000, 50.0000,
* 8.0703, 5.7144, 84.1156, 529.0927,
* 5.6609, 28.9355, 111.3620, 494.0413,
* 45.5249, 134.4751,
* 4.0003, 21.2937, 78.7058,
* 12.8293, 16.2730, 123.6578, 327.2396,
* 48.7883, 102.2117, 20.0060, 161.9903,
* 28.4184, 61.5816,
* 10.5563, 13.2950, 188.1390,
* 14.6560, 129.4922, 470.8512 /
DATA GO / 0.022 , 2.019 , 9.812 , 13.087 ,
* 13.804 , 16.061 , 14.293 , 16.114 ,
* 3.472 , 7.437 , 22.579 , 32.035 ,
* 27.774 , 33.678 , 28.118 , 31.019 , 34.204 ,
* 30.892 , 33.189 , 36.181 ,
* 0.032 , 2.760 , 35.328 , 48.277 ,
* 7.662 , 16.786 , 42.657 , 54.522 ,
* 50.204 , 56.044 ,
* 0.048 , 50.089 , 66.604 ,
* 8.954 , 18.031 , 57.755 , 72.594 ,
* 68.388 , 82.397 , 31.960 , 76.876 ,
* 75.686 , 80.388 ,
* 10.747 , 52.323 , 94.976 ,
* 27.405 , 86.350 , 109.917 /
C
C data for fluor
C
DATA AF / 2.0001, 39.9012, 122.0986,
* 10.0000, 30.0000, 50.0000,
* 4.0199, 5.5741, 22.1839, 190.2179,
* 53.0383, 126.9616, 31.6894, 75.3105,
* 13.5014, 7.9936, 55.7981, 298.7039,
* 26.2496, 63.7503, 2.0000, 6.0000, 10.0000,
* 28.7150, 71.2850,
* 8.0153, 6.1931, 21.7287, 48.7780, 278.2782,
* 178.5560, 421.4435, 51.7632, 95.2368 /
DATA GF / 0.050 , 13.317 , 15.692 ,
* 15.361 , 17.128 , 18.498 ,
* 0.048 , 2.735 , 20.079 , 30.277 ,
* 27.548 , 32.532 , 30.391 , 34.707 ,
* 4.479 , 12.072 , 31.662 , 51.432 ,
* 44.283 , 50.964 , 46.193 , 50.436 , 54.880 ,
* 50.816 , 57.479 ,
* 0.058 , 3.434 , 14.892 , 37.472 , 69.883 ,
* 67.810 , 83.105 , 72.435 , 79.747 /
C
C data for neon
C
DATA ANN / 34.5080, 365.4919, 16.5768, 183.4231,
* 2.0007, 89.5607, 380.4381, 26.4473, 63.5527,
* 4.0342, 5.6162, 11.5176, 72.8273,
* 48.5684, 131.4315, 31.1710, 76.8290,
* 14.0482, 13.3077, 52.7897, 467.8487,
* 54.2196, 195.7800 /
DATA GNN / 17.796 , 20.730 , 17.879 , 20.855 ,
* 0.097 , 29.878 , 37.221 , 31.913 , 37.551 ,
* 0.092 , 3.424 , 24.806 , 46.616 ,
* 45.643 , 54.147 , 48.359 , 57.420 ,
* 5.453 , 18.560 , 46.583 , 80.101 ,
* 70.337 , 85.789 /
C
C data for sodium
C
DATA ANA / 11.6348, 158.3593,
* 21.0453, 50.9546, 10.1389, 25.8611,
* 2.0019, 38.0569, 137.9398, 28.3106, 61.6893,
* 4.0334, 5.8560, 18.1786, 208.9142,
* 93.6895, 406.3095, 60.4276, 239.5719 /
DATA GNA / 2.400 , 4.552 ,
* 34.367 , 40.566 , 34.676 , 40.764 ,
* 0.170 , 44.554 , 57.142 , 51.689 , 60.576 ,
* 0.152 , 4.260 , 36.635 , 83.254 ,
* 72.561 , 89.475 , 75.839 , 92.582 /
C
C data for magnesium
C
DATA AMG / 10.7445, 291.5057, 53.7488,
* 6.2270, 31.1291, 132.6438,
* 40.4379, 159.5618, 20.3845, 79.6154,
* 2.0007, 106.8977, 343.1010, 10.1326, 237.8581/
DATA GMG / 2.805 , 6.777 , 9.254 ,
* 4.459 , 9.789 , 13.137 ,
* 57.413 , 71.252 , 58.010 , 71.660 ,
* 0.276 , 74.440 , 94.447 , 54.472 , 95.858 /
C
C data for aluminium
C
DATA AAL / 4.0009, 11.7804, 142.2179, 13.6585, 96.3371,
* 10.0807, 49.5843, 285.3343, 14.6872, 59.3122,
* 6.3277, 29.5086, 134.1634,
* 46.3164, 153.6833, 22.9896, 77.0103 /
DATA GAL / 0.014 , 3.841 , 5.420 , 3.727 , 8.833 ,
* 4.749 , 11.902 , 16.719 , 11.310 , 18.268 ,
* 6.751 , 16.681 , 24.151 ,
* 83.551 , 104.787 , 84.293 , 105.171 /
C
C data for silicon
C
DATA ASI / 7.9658, 4.6762, 1.3512, 123.2267, 443.7797,
* 4.0000, 7.4186, 24.1754, 60.4060,
* 14.4695, 11.9721, 26.5062, 269.0521,
* 9.1793, 4.8766, 29.1442, 52.7998,
* 13.2674, 36.0417, 180.6910,
* 6.4839, 27.6851, 135.8301 /
DATA GSI / 0.020 , 0.752 , 1.614 , 5.831 , 7.431 ,
* 0.036 , 8.795 , 11.208 , 13.835 ,
* 5.418 , 7.825 , 14.440 , 19.412 ,
* 6.572 , 11.449 , 18.424 , 25.457 ,
* 15.682 , 27.010 , 34.599 ,
* 9.042 , 24.101 , 37.445 /
C
C data for phosphorus
C
DATA AP / 13.5211, 22.2130, 353.2583, 10.0000, 150.0000,
* 8.0241, 5.8085, 51.7542, 252.4002,
* 4.0021, 20.7985, 62.4194, 200.7786,
* 11.7414, 63.5124, 179.7420,
* 6.8835, 32.7777, 228.3366 /
DATA GP / 1.514 , 5.575 , 9.247 , 8.076 , 10.735 ,
* 0.043 , 1.212 , 8.545 , 15.525 ,
* 0.074 , 7.674 , 16.639 , 25.118 ,
* 8.992 , 24.473 , 40.704 ,
* 11.464 , 33.732 , 55.455 /
C
C data for sulphur
C
DATA AS / 3.9615, 5.0780, 15.0944, 362.8588,
* 51.5995, 268.4002, 12.0000, 276.0000,
* 11.4377, 5.5126, 141.0009, 254.0478,
* 33.0518, 126.9479,
* 4.0707, 4.0637, 5.7245, 144.6376, 106.4909,
* 4.0011, 19.2813, 27.5990, 35.1179,
* 94.7454, 283.2486,
* 10.5474, 28.7137, 65.7378, 24.0000 /
DATA GS / 0.053 , 1.121 , 5.812 , 9.425 ,
* 8.936 , 11.277 , 9.600 , 12.551 ,
* 1.892 , 3.646 , 13.550 , 19.376 ,
* 16.253 , 21.062 ,
* 0.043 , 0.123 , 1.590 , 13.712 , 22.050 ,
* 0.118 , 9.545 , 18.179 , 31.441 ,
* 30.664 , 56.150 ,
* 10.704 , 27.075 , 50.599 , 43.034 /
C
C data for chlorine
C
DATA ACL / 2.0007, 62.5048, 669.4942, 29.0259, 130.9740,
* 3.9064, 0.3993, 5.3570, 60.3424, 119.9913,
* 138.1567, 278.8418, 102.3681, 158.6314,
* 12.6089, 5.9527, 110.5635, 262.8715,
* 69.2035, 100.7960,
* 7.3458, 5.6638, 44.1256, 202.7846,
* 4.0037, 21.8663, 40.5363, 57.5919 /
DATA GCL / 0.110 , 9.919 , 12.280 , 11.017 , 13.532 ,
* 0.092 , 0.581 , 1.620 , 13.121 , 19.787 ,
* 16.365 , 21.988 , 18.065 , 23.594 ,
* 2.358 , 5.708 , 19.084 , 30.683 ,
* 24.880 , 33.229 ,
* 0.102 , 1.391 , 14.709 , 36.968 ,
* 0.185 , 11.783 , 25.653 , 44.698 /
C
C data for argon
C
DATA AAR / 43.6623, 324.3375, 20.8298, 163.1701,
* 2.0026, 137.4515, 258.5445, 62.8129, 149.1867,
* 4.0495, 14.4466, 46.8234, 124.6651,
* 151.9828, 268.0157, 101.1302, 150.8691,
* 13.3718, 8.6528, 60.4614, 285.5072,
* 6.7655, 4.7684, 12.8631, 54.5260 /
DATA GAR / 12.638 , 14.958 , 12.833 , 15.139 ,
* 0.178 , 17.522 , 23.584 , 20.464 , 25.150 ,
* 0.151 , 1.561 , 17.399 , 30.871 ,
* 24.684 , 33.978 , 27.091 , 36.481 ,
* 2.810 , 8.877 , 24.351 , 44.489 ,
* 0.144 , 1.160 , 10.210 , 27.178 /
C
C data for potassium
C
DATA AK / 12.9782, 148.6673, 6.3493,
* 66.3444, 101.6553, 4.0001, 13.4465, 46.5534,
* 2.0171, 116.4767, 713.4965, 63.5907, 396.4079,
* 2.0000, 10.0000, 30.0000,
* 4.0702, 5.7791, 52.6795, 327.4539,
* 62.8604, 357.1331, 55.9337, 196.0646,
* 10.9275, 5.5398, 43.2761, 76.2560,
* 42.0000, 18.0000 /
DATA GK / 1.871 , 3.713 , 18.172 ,
* 21.185 , 27.705 , 2.059 , 23.709 , 28.542 ,
* 0.273 , 26.709 , 39.640 , 31.220 , 41.865 ,
* 29.955 , 37.557 , 42.862 ,
* 0.228 , 2.274 , 21.703 , 50.191 ,
* 32.145 , 49.262 , 34.155 , 51.718 ,
* 3.043 , 5.479 , 20.547 , 30.680 ,
* 36.275 , 47.345 /
C
C data for calcium
C
DATA ACA / 18.2366, 27.5012, 149.2617, 94.5242, 705.4711,
* 11.8706, 14.0710, 106.0547,
* 57.2414, 110.7567, 29.8121, 54.1874,
* 2.0184, 97.5784, 282.3939, 209.1871, 252.8129/
DATA GCA / 2.050 , 3.349 , 5.321 , 4.873 , 7.017 ,
* 1.769 , 5.109 , 9.524 ,
* 27.271 , 41.561 , 29.172 , 42.140 ,
* 0.394 , 28.930 , 52.618 , 38.593 , 49.646 /
C
C data for scandium
C
DATA ASC / 6.0014, 83.1958, 67.3666, 329.4354,
* 44.0793, 169.9969, 533.9195,
* 34.1642, 124.8475, 228.9879,
* 11.9979, 16.9280, 28.4778, 82.0418, 234.5360,
* 6.0042, 2.7101, 13.9801, 65.3039,
* 12.0000, 12.0000,
* 2.0051, 2.9621, 29.0306 /
DATA GSC / 0.021 , 2.056 , 3.551 , 5.465 ,
* 1.535 , 3.797 , 6.203 ,
* 2.389 , 4.858 , 7.141 ,
* 0.011 , 0.430 , 1.156 , 3.711 , 8.863 ,
* 0.025 , 3.499 , 10.463 , 18.606 ,
* 41.779 , 57.217 ,
* 0.539 , 24.442 , 51.079 /
C
C data for titanium
C
DATA ATI / 7.0887, 8.9186, 17.5633, 206.6832, 438.5735,
* 654.1721,
* 38.0462, 69.6271, 364.2845, 832.0408,
* 98.8562, 57.9934, 442.1498,
* 19.7843, 32.0637, 37.0895, 110.6682, 288.4946,
* 521.8837,
* 10.0000, 34.0000, 120.0000,
* 16.1691, 22.3550, 24.1646, 83.5128, 222.7963,
* 6.0020, 4.6177, 25.2636, 52.1162,
* 12.0000, 8.0000 /
DATA GTI / 0.021 , 0.048 , 1.029 , 2.183 , 4.109 ,
* 5.785 ,
* 0.846 , 1.792 , 3.836 , 5.787 ,
* 2.561 , 4.869 , 6.340 ,
* 0.023 , 0.124 , 0.774 , 1.810 , 4.980 ,
* 9.585 ,
* 1.082 , 4.928 , 11.279 ,
* 0.041 , 1.375 , 4.768 , 10.985 , 19.769 ,
* 0.048 , 11.577 , 24.531 , 36.489 ,
* 54.436 , 75.373 /
C
C data for vanadium
C
DATA AV / 15.2627, 23.9869, 51.3053, 570.3384,1650.9417,
* 162.2829, 298.8303, 908.8852,
* 23.6736, 37.1624, 86.8011, 300.7440, 864.5880,
* 57.8961, 79.4605, 214.9007, 864.7425,
* 61.8508, 64.0845, 192.8298, 718.2349,
* 23.8116, 68.2495, 135.0613, 536.7632,
* 15.9543, 22.5542, 71.4921, 248.9544,
* 6.0006, 5.8785, 50.5077, 97.6129 /
DATA GV / 0.026 , 0.145 , 0.718 , 2.586 , 5.458 ,
* 2.171 , 4.153 , 6.097 ,
* 0.009 , 0.366 , 1.504 , 5.294 , 10.126 ,
* 1.796 , 2.353 , 6.068 , 12.269 ,
* 2.560 , 3.674 , 6.593 , 12.880 ,
* 0.045 , 1.684 , 8.162 , 21.262 ,
* 0.065 , 1.746 , 15.158 , 33.141 ,
* 0.077 , 21.229 , 44.134 , 60.203 /
C
C data for chromium
C
DATA ACR / 30.1842, 79.2847, 149.5293,
* 215.3696, 119.1974, 741.4321,
* 184.9946,1352.5038, 784.4937,
* 46.6191, 160.1361, 488.0449, 657.1928,
* 47.1742, 267.0275, 441.1324, 150.6650,
* 24.3768, 122.8359, 285.5092, 794.1654,
* 24.2296, 75.0258, 172.9452, 543.6511,
* 15.9819, 17.6800, 95.2003, 225.0947 /
DATA GCR / 0.993 , 3.070 , 5.673 ,
* 3.339 , 4.801 , 7.198 ,
* 2.829 , 4.990 , 7.643 ,
* 1.645 , 3.727 , 7.181 , 12.299 ,
* 2.902 , 4.273 , 8.569 , 14.912 ,
* 0.047 , 2.566 , 9.441 , 21.198 ,
* 0.078 , 2.242 , 15.638 , 32.725 ,
* 0.103 , 2.146 , 26.153 , 49.381 /
C
C data for manganese
C
DATA AMN / 53.9107, 81.3931, 546.6945 ,
* 144.1893, 407.8029, 45.6177, 298.4423,2410.9335,
* 22.6382, 93.8419, 183.9367, 907.5765,
* 137.0409, 168.6783, 329.0287, 773.2513,
* 70.1925, 72.3372, 213.9512, 539.5165,
* 24.2373, 93.5415, 456.6167, 506.5484,
* 24.7687, 66.9896, 264.1853, 484.0161 /
DATA GMN / 2.527 , 4.204 , 6.602 ,
* 4.155 , 7.321 , 2.285 , 5.631 , 8.448 ,
* 1.496 , 3.839 , 7.751 , 13.484 ,
* 3.681 , 6.054 , 9.934 , 14.936 ,
* 3.531 , 6.967 , 15.222 , 25.069 ,
* 0.071 , 2.896 , 20.725 , 37.383 ,
* 0.126 , 2.660 , 28.528 , 53.413 /
C
C data for iron
C
DATA AFE / 14.4102, 2.7050, 421.6612, 940.1484,
* 36.2187, 22.8883, 239.5997, 825.2919,
* 110.0242, 992.3040, 640.6715,
* 17.0494, 32.3783, 34.3184, 420.9626,1067.2064,
* 154.0059, 462.1117, 329.8618,
* 15.7906, 47.1186, 279.9292, 692.1005,
* 91.0206, 206.3082, 706.9927, 836.6689,
* 40.0790, 27.6965, 28.2243, 18.0001,
* 24.0899, 89.6340, 51.5756, 241.6980 /
DATA GFE / 0.066 , 0.339 , 2.897 , 6.585 ,
* 0.923 , 1.679 , 4.620 , 7.053 ,
* 4.249 , 5.875 , 7.781 ,
* 0.062 , 0.283 , 1.504 , 5.430 , 11.210 ,
* 2.792 , 7.627 , 13.623 ,
* 0.077 , 3.723 , 12.137 , 23.700 ,
* 2.688 , 7.595 , 15.444 , 25.587 ,
* 3.982 , 4.677 , 6.453 , 23.561 ,
* 0.102 , 3.354 , 22.954 , 33.796 /
C
C data for cobalt
C
DATA ACO / 11.9120, 20.4424, 28.3863, 132.5038, 600.7461,
* 33.3092, 237.4331, 977.2502,
* 55.5396, 318.8169, 619.6366,
* 32.6900, 83.8694, 107.4378,
* 11.2593, 38.2239, 22.9964, 261.3486, 637.1485,
* 23.0233, 41.6599, 264.6460, 181.6699,
* 16.0356, 7.8633, 70.3158, 423.3512, 742.3553,
* 0. /
DATA GCO / 0.112 , 0.341 , 0.809 , 3.808 , 6.723 ,
* 2.057 , 3.484 , 7.210 ,
* 2.405 , 5.133 , 8.097 ,
* 2.084 , 5.291 , 8.426 ,
* 0.135 , 0.517 , 1.606 , 6.772 , 12.622 ,
* 2.512 , 4.348 , 8.253 , 15.377 ,
* 0.132 , 0.863 , 3.086 , 11.789 , 23.263 ,
* 0. /
C
C data for nickel
C
DATA ANI / 7.1268, 12.4486, 11.9953, 10.0546, 114.1658,
* 391.2064,
* 26.3908, 213.8081, 938.7927,
* 4.1421, 37.3781, 25.9712, 333.3397, 311.1633,
* 33.1031, 184.1854, 136.7072,
* 11.1915, 5.4174, 53.6793, 460.6781, 380.0056,
* 0. /
DATA GNI / 0.026 , 0.137 , 0.315 , 1.778 , 4.029 ,
* 6.621 ,
* 2.249 , 4.042 , 7.621 ,
* 0.191 , 1.235 , 3.358 , 8.429 , 17.096 ,
* 3.472 , 9.065 , 16.556 ,
* 0.194 , 1.305 , 5.813 , 14.172 , 26.169 ,
* 0. /
C
C data for copper
C
DATA ACU / 11.0549, 238.9423, 10.3077, 126.2990,1073.3876,
* 30.0000, 50.0000, 60.0000,
* 19.2984, 50.5974, 240.2021,1216.9016,
* 48.3048, 583.2011, 320.4931,
* 4.0155, 70.3264, 313.1213, 536.5331,
* 0. /
DATA GCU / 4.212 , 7.227 , 1.493 , 5.859 , 9.709 ,
* 7.081 , 9.362 , 10.130 ,
* 2.865 , 8.260 , 14.431 , 18.292 ,
* 9.650 , 14.640 , 24.320 ,
* 0.337 , 8.520 , 16.925 , 28.342 ,
* 0. /
C
C data for zinc
C
DATA AZN / 15.9880, 484.0042, 18.5863, 123.4134,
* 3.0000, 189.0000,
* 6.1902, 38.9317, 204.8780,
* 10.2588, 89.3771, 370.3640, 30.0000, 128.0000,
* 24.6904, 106.7491, 439.5586,
* 0. /
DATA GZN / 4.546 , 8.840 , 10.247 , 16.620 ,
* 11.175 , 16.321 ,
* 6.113 , 12.964 , 16.444 ,
* 7.926 , 13.633 , 24.353 , 16.286 , 24.910 ,
* 10.291 , 20.689 , 32.077 ,
* 0. /
C
DATA ICOMP /0/
C
c SAVE ALF,GAM,XL,CHION,INDEX0,INDEXS,INDEXM,IGPR,IG0,ICOMP
C
C Initialization of auxiliary arrays (executed only once)
C
IF(ICOMP.EQ.0) THEN
IND=1
DO K=1,NIONS
INDEXS(K)=IND
IND=IND+IS(K)
END DO
IND=1
DO K=1,NSS
INDEXM(K)=IND
IND=IND+IM(K)
END DO
ICOMP=1
END IF
C
MODE=MODPF(IAT)
IF(MODE.GT.0) GO TO 80
IF(IAT.EQ.26 .AND. IZI.GE.4 .AND. IZI.LE.9) GO TO 170
IF(IAT.EQ.28 .AND. IZI.GE.4 .AND. IZI.LE.9) GO TO 171
IF(IZI.LE.0.OR.IAT.LE.0) GO TO 70
IF(IZI.GT.5) THEN
IF(IAT.LT.IZI) THEN
U=1.
DUT=0.
DUN=0.
RETURN
END IF
IF(IAT.GT.8) THEN
U=IGLE(IAT-IZI+1)
DUT=0.
DUN=0.
RETURN
END IF
CALL PFCNO(IAT,IZI,T,ANE,U)
RETURN
END IF
c
c Irwin partition functions by default
c
if(iirwin.gt.0.and.t.lt.16000.) then
if(izi.le.2) then
call mpartf(iat,izi,0,t,u0,du0)
u=u0
dut=0.
if(u0.gt.0..and.dut.gt.0.) dut=u0/t*du0
return
end if
else if(iat.gt.30.and.izi.le.3) then
go to 90
end if
c
IF(MODE.LT.0) GO TO 70
I0=INDEX0(IZI,IAT)
IF(I0.LE.0) GO TO 60
C
C Traving, Baschek, Holweger formula
C
QZ=IZI
THET=5.0404D3/T
A=31.321*QZ*QZ*THET
XMAX2=XMAX*XMAX
QQ=XMAX/4.*(XMAX2+XMAX+SIXTH+A+A*A*HALF/XMAX2)
QAS1=XMAX*THIRD*(XMAX2+TRHA*XMAX+HALF)
IS0=INDEXS(I0)
ISS=IS0+IS(I0)-1
SU1=0.
SU2=0.
SQA=0.
SQQ=0.
SQT=0.
SQ2=0.
DO K=IS0,ISS
XXL=XL(K)
GPR=IGPR(K)
X=CHION(K)*THET
EX=0.
IF(X.LT.30) EX=EXP(-X*2.30258029299405)
SQQ=SQQ+GPR*EX
QAS=(QAS1-XXL*THIRD*(XXL*XXL+TRHA*XXL+HALF)+(XMAX-XXL)*
* (UN+A*HALF/XXL/XMAX)*A)*GPR*EX
SQA=SQA+QAS
SQ2=SQ2+QAS*CHION(K)
SQT=SQT+GPR*(XMAX-XXL)*(UN+A/XMAX/XXL)*EX
M0=INDEXM(K)
M1=M0+IM(K)-1
AL1=0.
AL2=0.
DO M=M0,M1
XG=GAM(M)*THET
IF(XG.LE.20.) THEN
XM=EXP(-XG*2.30258029299405)*ALF(M)
AL1=AL1+XM
AL2=AL2+GAM(M)*XM
END IF
END DO
SU1=SU1+AL1
SU2=SU2+AL2
END DO
U=IG0(I0)
U=U+SU1+SQA
IF(U.LT.0.) U=IG0(I0)
DUT=(2.302580293*THET*(SU2+SQ2)+QQ*SQQ-A*SQT)/T
DUN=-QQ*SQQ/ANE
RETURN
C
C constant value of partition function for some ions (even if
C MODPF = 0)
C
60 U=-I0
DUT=0.
DUN=0.
RETURN
C
C non-standard, user supplied formula
C
70 CALL PFSPEC(IAT,IZI,T,ANE,U,DUT,DUN)
RETURN
C
C Partition functions for Iron (From Sparks and Fischel)
C
170 CALL PFFE(IZI,T,ANE,U,DUT,DUN)
RETURN
C
C Partition functions for Nickel (from Kurucz predicted levels)
C
171 CALL PFNI(IZI,T,U,DUT,DUN)
RETURN
C
C Opacity Project value
C
80 call opfrac(iat,izi,t,ane,u,opfra)
DUT=0.
DUN=0.
RETURN
C
C Modified Kurucz partition functions for IAT > 30
C
90 CALL PFHEAV(IAT,IZI,3,T,ANE,U)
DUT=0.
DUN=0.
RETURN
END