SUBROUTINE POPS(CODE,MODE,NUMBER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION NUMBER(kw,1) REAL*8 NUMBER COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,TAUSCAT,IFMOL COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP COMMON /XABUND/XABUND(99),WTMOLE DATA ITEMP1/0/ IF(IFMOL.EQ.1)GO TO 200 IF(IFPRES.EQ.1.AND.ITEMP.NE.ITEMP1)CALL NELECT ITEMP1=ITEMP IF(CODE.EQ.0.)RETURN IF(CODE.LT.100.)GO TO 110 CALL EXIT(3) 110 IZ=CODE NION=(CODE-DFLOAT(IZ))*100.+1.5 DO 115 J=1,NRHOX CALL PFSAHA(J,IZ,NION,MODE,NUMBER) C PFSAHA RETURNS IONIZATION FRACTIONS OR IONIZATION FRACTIONS/ C PARTITION FUNCTIONS SO CONVERT TO NUMBER DENSITIES NNNN=NION IF(MODE.LT.10)NNNN=1 DO 115 ION=1,NNNN 115 NUMBER(J,ION)=NUMBER(J,ION)*XNATOM(J)*XABUND(IZ) RETURN 200 IF(IFPRES.EQ.1.AND.ITEMP.NE.ITEMP1)CALL NMOLEC(MODE) ITEMP1=ITEMP IF(CODE.EQ.0.)RETURN CALL MOLEC(CODE,MODE,NUMBER) RETURN END SUBROUTINE NELECT IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /EDENS/EDENS(kw),IFEDNS COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99) COMMON /ITER/ ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP COMMON /XABUND/XABUND(99),WTMOLE DIMENSION ELEC(kw),E(10),X(10),MASK(10),NELEMZ(10),NIONZ(10) DIMENSION XNUMB(kw,3),PFPLUS(13),PFMIN(13),EION(7) EQUIVALENCE (ELEC(1),XNUMB(1,1)),(PFPLUS(7),EION(1)) DATA NELEMZ/1,2,6,11,12,13,14,19,20,26/ DATA NIONZ/2,3,2,2,2,2,2,2,2,2/,NZ/10/ IF(ITER.LT.NUMITS)GO TO 406 IF(IFEDNS.EQ.1)GO TO 407 DO 401 I=1,NZ NELEM=NELEMZ(I) 401 E(I)=ELEM(NELEM) c WRITE(6,402)(E(I),I=1,NZ),(E(I),I=1,NZ) c 402 FORMAT(1H1////50X,22HELECTRON CONTRIBUTIONS/3X,20(4X,A2)) 406 XNE(1)=P(1)/TK(1)/2. 407 DO 500 J=1,NRHOX IF(J.GT.1.AND.IFEDNS.EQ.0)XNE(J)=XNE(J-1)*P(J)/P(J-1) XNTOT=P(J)/TK(J) XNATOM(J)=XNTOT-XNE(J) DO 1 I=1,NZ 1 MASK(I)=1 DO 20 L=1,200 XNENEW=0. DO 11 I=1,NZ IF(MASK(I).EQ.0)GO TO 11 IZ=NELEMZ(I) NION=NIONZ(I) CALL PFSAHA(J,IZ,NION,4,ELEC) E(I)=ELEC(J) X(I)=ELEC(J)*XNATOM(J)*XABUND(IZ) XNENEW=XNENEW+X(I) 11 CONTINUE XNENEW=(XNENEW+XNE(J))/2. ERROR=ABS((XNE(J)-XNENEW)/XNENEW) XNE(J)=XNENEW XNATOM(J)=XNTOT-XNE(J) IF(ERROR.LT..0005)GO TO 400 IF(J.EQ.1)GO TO 20 X1=.00001*XNE(J) IF(ERROR.LT..05)X1=X1*10. DO 12 I=1,NZ IF(X(I).LT.X1)MASK(I)=0 12 CONTINUE 20 CONTINUE CALL EXIT(3) 400 RHO(J)=XNATOM(J)*WTMOLE*1.660E-24 IF(IFEDNS.EQ.0)GO TO 33 EDENS(J)=1.5*XNTOT*TK(J) DO 411 I=1,NZ IZ=NELEMZ(I) NION=NIONZ(I) T(J)=T(J)*1.001 TK(J)=TK(J)*1.001 TKEV(J)=TKEV(J)*1.001 CALL PFSAHA(J,IZ,NION,5,PFPLUS) T(J)=T(J)/1.001*.999 TK(J)=TK(J)/1.001*.999 TKEV(J)=TKEV(J)/1.001*.999 CALL PFSAHA(J,IZ,NION,5,PFMIN) T(J)=T(J)/.999 TK(J)=TK(J)/.999 TKEV(J)=TKEV(J)/.999 CALL PFSAHA(J,IZ,NION,12,XNUMB) DO 410 ION=1,NION XNUMB(J,ION)=XNUMB(J,ION)*XNATOM(J)*XABUND(IZ) 410 EDENS(J)=EDENS(J)+XNUMB(J,ION)*TK(J)*(EION(ION)/TKEV(J)+ 1(PFPLUS(ION)-PFMIN(ION))/(PFPLUS(ION)+PFMIN(ION))*2.*500.) 411 CONTINUE EDENS(J)=EDENS(J)/RHO(J) GO TO 500 33 IF(ITER.LT.NUMITS)GO TO 500 DO 403 I=1,NZ 403 X(I)=X(I)/XNE(J) c WRITE(6,404)J,(X(I),I=1,NZ),(E(I),I=1,NZ) c 404 FORMAT(I4,20F6.3) 500 CONTINUE RETURN END SUBROUTINE PFSAHA(J,IZ,NION,MODE,ANSWER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) C MODE 1 RETURNS IONIZATION FRACTION /PARTITION FUNCTION C MODE 2 RETURNS IONIZATION FRACTION C MODE 3 RETURNS PARTITION FUNCTION C MODE 4 RETURNS NUMBER OF ELECTRONS PRODUCED C MODE 5 RETURNS ANSWER(ION)=PF ANSWER(ION+7)=IP C MODE + 10 RETURN ALL IONS TO NION. MODE ALONE RETURN NION ONLY. COMMON /DEPART/BHYD(kw,6),BMIN(kw),NLTEON COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP DIMENSION ANSWER(kw,6),F(6),IP(6),PART(6),POTLO(6),LOCZ(29) REAL*8 IP DIMENSION SCALE(4) DIMENSION NNN(6,365) DIMENSION NNN01(54),NNN02(54),NNN03(54),NNN04(54),NNN05(54) DIMENSION NNN06(54),NNN07(54),NNN08(54),NNN09(54),NNN10(54) DIMENSION NNN11(54),NNN12(54),NNN13(54),NNN14(54),NNN15(54) DIMENSION NNN16(54),NNN17(54),NNN18(54),NNN19(54),NNN20(54) DIMENSION NNN21(54),NNN22(54),NNN23(54),NNN24(54),NNN25(54) DIMENSION NNN26(54),NNN27(54),NNN28(54),NNN29(54),NNN30(54) DIMENSION NNN31(54),NNN32(54),NNN33(54),NNN34(54),NNN35(54) DIMENSION NNN36(54),NNN37(54),NNN38(54),NNN39(54),NNN40(12) EQUIVALENCE (NNN(1, 1),NNN01(1)),(NNN(1, 10),NNN02(1)) EQUIVALENCE (NNN(1, 19),NNN03(1)),(NNN(1, 28),NNN04(1)) EQUIVALENCE (NNN(1, 37),NNN05(1)),(NNN(1, 46),NNN06(1)) EQUIVALENCE (NNN(1, 55),NNN07(1)),(NNN(1, 64),NNN08(1)) EQUIVALENCE (NNN(1, 73),NNN09(1)),(NNN(1, 82),NNN10(1)) EQUIVALENCE (NNN(1, 91),NNN11(1)),(NNN(1,100),NNN12(1)) EQUIVALENCE (NNN(1,109),NNN13(1)),(NNN(1,118),NNN14(1)) EQUIVALENCE (NNN(1,127),NNN15(1)),(NNN(1,136),NNN16(1)) EQUIVALENCE (NNN(1,145),NNN17(1)),(NNN(1,154),NNN18(1)) EQUIVALENCE (NNN(1,163),NNN19(1)),(NNN(1,172),NNN20(1)) EQUIVALENCE (NNN(1,181),NNN21(1)),(NNN(1,190),NNN22(1)) EQUIVALENCE (NNN(1,199),NNN23(1)),(NNN(1,208),NNN24(1)) EQUIVALENCE (NNN(1,217),NNN25(1)),(NNN(1,226),NNN26(1)) EQUIVALENCE (NNN(1,235),NNN27(1)),(NNN(1,244),NNN28(1)) EQUIVALENCE (NNN(1,253),NNN29(1)),(NNN(1,262),NNN30(1)) EQUIVALENCE (NNN(1,271),NNN31(1)),(NNN(1,280),NNN32(1)) EQUIVALENCE (NNN(1,289),NNN33(1)),(NNN(1,298),NNN34(1)) EQUIVALENCE (NNN(1,307),NNN35(1)),(NNN(1,316),NNN36(1)) EQUIVALENCE (NNN(1,325),NNN37(1)),(NNN(1,334),NNN38(1)) EQUIVALENCE (NNN(1,343),NNN39(1)),(NNN(1,352),NNN40(1)) DIMENSION NNN67(72) EQUIVALENCE (NNN(1,354),NNN67(1)) C ( 1)( 2) ( 3)( 4) ( 5)( 6) ( 7)( 8) ( 9)(10) ( IP ) G REF DATA NNN01/ 1 200020001, 200020011, 201620881, 231228281, 378953411, 1359502, D+F 1.00 2 100010001, 100010001, 100010001, 100010001, 100010001, 1359500, G 1.01 3 100010001, 100010011, 102111241, 145022061, 363059451, 2458104, D+F 2.00 4 200020001, 200020071, 208524971, 382669341, 128222452, 5440302, D+F 2.01 5 100010001, 100010001, 100010001, 100010001, 100010001, 5440300, G 2.02 6 200020011, 201220481, 212922881, 258731081, 394251691, 538901, D+F 3.00 7 100010001, 100010201, 126225521, 67216512, 351165562, 7561907, D+F 3.01 8 200020001, 200020211, 227936571, 69610342, 137217102, 12241800, D+F 3.02 9 100010001, 100010001, 100010001, 100010001, 100010001, 12241800/ G 3.03 DATA NNN02/ 1 100010051, 104311441, 131615641, 190623681, 298037691, 931900, AEL 4.00 2 200120231, 211422771, 249627631, 309034911, 398545051, 1820600, AEL 4.01 3 100010001, 100010201, 126225521, 67216512, 351165562, 15385000, AEL 4.02 4 200020001, 200020011, 201220661, 223426161, 332644691, 21765700, AEL 4.03 5 600060001, 600560281, 608761991, 637466191, 693973361, 829500, AEL 5.00 6 100310831, 132016901, 214226411, 315736741, 419147071, 2514900, AEL 5.01 7 200721061, 233526401, 297533311, 369040481, 440747651, 3792000, AEL 5.02 8 100010001, 100010001, 100010001, 100010001, 100010001, 25929800, G 5.03 9 893292271, 96110042, 105311262, 126315202, 196126432, 1125508/ D+F 6.00 DATA NNN03/ 1 595060251, 620865751, 713280191, 95712292, 167623542, 2437501, D+F 6.01 2 105513201, 180324851, 341851341, 88416332, 296550722, 4787101, D+F 6.02 3 204922771, 262630421, 350941931, 494556971, 644872001, 6447600, D+F 6.03 4 403141851, 457051681, 594071181, 92913362, 203331152, 1452915, D+F 7.00 5 919899541, 107211512, 124914302, 182526232, 403762662, 2959202, D+F 7.01 6 596862721, 684177081, 88110342, 128317062, 239334312, 4742501, D+F 7.02 7 112816481, 240733751, 462068491, 116419932, 283736822, 7744900, D+F 7.03 8 210124681, 293634211, 391145791, 539862151, 703178471, 9786200, D+F 7.04 9 874789691, 924795711, 99410492, 115213492, 169022242, 1361307/ D+F 8.00 DATA NNN04/ 1 424151091, 622874781, 91312832, 221842502, 79914013, 3510711, D+F 8.01 2 95610702, 118113032, 149619922, 329761642, 101914173, 5488500, D+F 8.02 3 603567171, 775391141, 106612482, 143716252, 181420032, 7739300, D+F 8.03 4 124420321, 306943181, 606281181, 101712232, 142916342, 11387300, D+F 8.04 5 215026541, 323137551, 421546491, 508255151, 594863811, 13807900, AEL 8.05 6 575958511, 589859231, 595860671, 636470031, 815199581, 1741802, D+F 9.00 7 900296401, 102610802, 113912542, 152921152, 318348952, 3498003, D+F 9.01 8 469162651, 791295541, 121419552, 402686872, 154822203, 6264500, D+F 9.02 9 99511422, 129214572, 170523002, 320140922, 498458762, 8713900/ D+F 9.03 DATA NNN05/ 1 615472711, 87710602, 127215002, 172919582, 218624152, 11421300, D+F 9.04 2 135324181, 377252001, 661580261, 94410852, 122613672, 15711700, AEL 9.05 3 100010001, 100010051, 105313051, 210239461, 74013022, 2155808, D+F10.00 4 580158751, 591759741, 642687101, 159332652, 64111533, 4106907, D+F10.01 5 93510272, 110411662, 127116062, 257647882, 75110223, 6350000, D+F10.02 6 529774371, 94611322, 135816202, 188221442, 240626682, 9701900, D+F10.03 7 103312152, 140616092, 181320182, 222224262, 263128352, 12630000, AEL10.04 8 629178711, 98311802, 136715512, 173619202, 210422892, 15790900, AEL10.05 9 200020001, 200320211, 207322131, 253031421, 417657451, 513802/ D+F11.00 DATA NNN06/ 1 100010001, 100010161, 119621261, 50711872, 246445382, 4728901, D+F11.01 2 580158751, 591860351, 71813142, 321968812, 106014333, 7165000, D+F11.02 3 96910772, 116012242, 130714232, 153916552, 177118872, 9888000, D+F11.03 4 601386081, 108812932, 148916832, 187820722, 226624612, 13836900, AEL11.04 5 105712442, 144616652, 189221182, 234425702, 279630222, 17209000, AEL11.05 6 100010011, 101410621, 118414581, 204831781, 509479731, 764404, D+F12.00 7 200120051, 202921001, 226926901, 368457091, 92814872, 1503101, D+F12.01 8 100010001, 100110611, 177455431, 176546012, 99718753, 8011905, D+F12.02 9 579758751, 591459501, 600560591, 611461681, 622362781, 10928900/ AEL12.03 DATA NNN07/ 1 100611232, 120612752, 134214102, 147815462, 161416822, 14122900, AEL12.04 2 674896701, 121814462, 167018942, 211723412, 256527892, 18648900, AEL12.05 3 558857701, 583558761, 593260591, 635969541, 796790971, 598400, D+F13.00 4 100310211, 110313021, 172828201, 55311252, 215637942, 1882203, D+F13.01 5 200320201, 208622331, 250530971, 410251081, 611571211, 2844000, D+F13.02 6 100010001, 100210881, 207436531, 523168101, 838999681, 11996000, D+F13.03 7 577758651, 591259631, 604461351, 622563161, 640764981, 15377000, AEL13.04 8 103511582, 124713242, 140014772, 155316292, 170517812, 19042000, AEL13.05 9 825189211, 95210052, 106211532, 134317202, 237934082, 814913/ D+F14.00 DATA NNN08/ 1 563057761, 588160311, 631768671, 791097651, 127817282, 1634000, D+F14.01 2 101110771, 126716471, 232438081, 71914052, 262045302, 3346001, D+F14.02 3 200720521, 217224081, 284439171, 551370951, 86810262, 4513000, D+F14.03 4 100010001, 100210881, 207436531, 523168101, 838999681, 16672900, FAK14.04 5 575458521, 591459851, 610063201, 672674071, 843698661, 20510900, AEL14.05 6 402643441, 496757481, 658274401, 833492941, 103511532, 1048300, AEL15.00 7 874497931, 106011282, 119812802, 138415142, 164717802, 1972000, AEL15.01 8 564058061, 604164611, 709579551, 90410172, 112912422, 3015500, AEL15.02 9 100811411, 149720221, 280936121, 441552181, 602168241, 5135400/ AEL15.03 DATA NNN09/ 1 200420781, 227025361, 281430911, 336936471, 392542021, 6500700, AEL15.04 2 100010001, 100010001, 100010001, 100010001, 100010001, 22041300, G 15.05 3 822887891, 930697831, 102610932, 121614492, 185124742, 1035708, D+F16.00 4 443056011, 694982961, 96911522, 144218572, 227326892, 2339900, D+F16.01 5 91610392, 113512242, 136416942, 233429882, 364242962, 3500000, D+F16.02 6 560058861, 633871081, 82410062, 123314602, 168619132, 4728900, D+F16.03 7 104512901, 177025421, 375163021, 122420462, 286036742, 7250000, D+F16.04 8 202321571, 241428261, 358355061, 78310152, 124814802, 8802800, D+F16.05 9 538155931, 571657911, 598067191, 89013782, 227737172, 1300916/ D+F17.00 DATA NNN10/ 1 873396771, 104411072, 118513532, 175525872, 406763932, 2379903, D+F17.01 2 506569571, 87610522, 134421682, 439092662, 182132573, 3990006, D+F17.02 3 95110872, 120013232, 154921252, 345149322, 641378942, 5350000, D+F17.03 4 558960371, 677779341, 95311692, 138816082, 182720472, 6780000, D+F17.04 5 100010001, 100010051, 106913911, 240147261, 90716112, 1575411, D+F18.00 6 550256831, 578158781, 636585461, 151530162, 58010303, 2762007, D+F18.01 7 92110362, 112412002, 133216772, 254443722, 76512833, 4090003, D+F18.02 8 582082081, 103112292, 149920212, 309750502, 720793642, 5978900, D+F18.03 9 97111072, 123213982, 172625622, 463976582, 106413633, 7500000/ D+F18.04 DATA NNN11/ 1 200020011, 200720361, 211923291, 280137141, 525575741, 433803, D+F19.00 2 100010001, 100110341, 135929551, 79119282, 405274892, 3180905, D+F19.01 3 554657081, 581260301, 73012702, 285363872, 129023363, 4600005, D+F19.02 4 96010862, 118413212, 180836632, 90321023, 416863253, 6090000, D+F19.03 5 657793361, 119515082, 195826322, 352944302, 533162332, 8259900, D+F19.04 6 100110061, 104311741, 145919971, 294345051, 69010322, 611003, D+F20.00 7 205822781, 279234761, 427553061, 688994901, 136319772, 1186701, D+F20.01 8 100010001, 100510821, 168744821, 130232522, 69012813, 5121003, D+F20.02 9 555157161, 585662471, 82816862, 42510013, 168423663, 6700000/ D+F20.03 DATA NNN12/ 1 99411262, 123814062, 182930402, 484766392, 84310223, 8438900, D+F20.04 2 924696691, 105212282, 151219062, 240530032, 368944512, 653900, AEL21.00 3 190424662, 297634542, 391743752, 482952832, 573761912, 1280000, AEL21.01 4 976799291, 101110322, 105810882, 111911502, 118112122, 2475000, AEL21.02 5 100010001, 100510821, 168744821, 130232522, 69012813, 7390000, FAK21.03 6 555157161, 585662471, 82816862, 42510013, 168423663, 9200000, FAK21.04 7 181021172, 260333222, 430155582, 710089242, 110213293, 681900, D+F22.00 8 474659872, 721284672, 98211413, 134515623, 177919963, 1356900, D+F22.01 9 228327012, 308134272, 381143862, 534563472, 734983512, 2747000/ D+F22.02 DATA NNN13/ 1 971498311, 99210032, 102610572, 108711172, 114711782, 4324000, D+F22.03 2 100010001, 100510821, 168744821, 130232522, 69012813, 9980000, FAK22.04 3 272835172, 425851532, 632278322, 97212013, 146817723, 674000, AEL23.00 4 373954132, 743597002, 121414713, 173920143, 229225713, 1464900, AEL23.01 5 323142642, 519660272, 679975352, 824789522, 96610363, 2930900, AEL23.02 6 248329302, 324234952, 373439752, 421744582, 469949412, 4800000, AEL23.03 7 970698231, 990699881, 100710152, 102410322, 104010482, 6500000, AEL23.04 8 717277611, 92911652, 152620872, 295141952, 550468122, 676400, D+F24.00 9 71611552, 205635512, 558281952, 115315823, 205625293, 1649000/ D+F24.01 DATA NNN14/ 1 280639822, 538369722, 87610823, 129115003, 170919183, 3095000, D+F24.02 2 377150952, 616070292, 791788382, 97610683, 116012523, 5000000, D+F24.03 3 264730962, 341436462, 394042872, 463549832, 533056782, 7300000, D+F24.04 4 600060321, 629270891, 86911302, 151020222, 267534752, 743100, AEL25.00 5 739594821, 139921212, 309342852, 567372412, 97112553, 1563600, AEL25.01 6 98417472, 265535782, 454754842, 641973532, 828792212, 3369000, AEL25.02 7 328847052, 586668342, 771785912, 94710343, 112112093, 5300000, AEL25.03 8 422055132, 636770792, 779285062, 921999322, 106411363, 7600000, AEL25.04 9 197023222, 274433302, 416753952, 723799822, 139419053, 787038/ D+F26.00 DATA NNN15/ 1 409453722, 686687452, 110213823, 174322233, 286437043, 1617902, D+F26.01 2 262136422, 501167232, 87911303, 138916483, 190721673, 3064300, D+F26.02 3 98723522, 420363072, 87011423, 145117913, 215925463, 5700000, AEL26.03 4 388854482, 666275742, 846693572, 102511143, 120312923, 7900000, D+F26.04 5 199427202, 335740022, 474957182, 708090462, 118315403, 786000, D+F27.00 6 279739202, 490858232, 684582472, 104713233, 159818733, 1704900, D+F27.01 7 279836622, 461857562, 720693022, 124915873, 192522633, 3349000, D+F27.02 8 262136422, 501167232, 87911303, 138916483, 190821673, 5300000, FAK27.03 9 98723522, 420363072, 87011423, 145117913, 215925463, 8300000/ FAK27.04 DATA NNN16/ 1 227027622, 306233052, 356839222, 446052912, 652382292, 763314, D+F28.00 2 108416342, 222428472, 353944332, 577378932, 110314303, 1814900, D+F28.01 3 198724282, 293236452, 468362702, 86511123, 136016073, 3516000, D+F28.02 4 279836622, 461857562, 720693022, 124915873, 192522633, 5600000, FAK28.03 5 262136422, 501167232, 87911303, 138916483, 190721673, 7900000, FAK28.04 6 201620781, 231026761, 314737361, 450555381, 692386911, 772301, D+F29.00 7 109415761, 247938311, 58910042, 190937022, 68311693, 2028903, D+F29.01 8 897195961, 107212972, 165021182, 260230862, 356940532, 3682900, D+F29.02 9 100010001, 100410231, 108712611, 167124841, 388460411, 939102/ D+F30.00 DATA NNN17/ 1 200020021, 201620761, 223726341, 351352061, 80812472, 1796001, D+F30.01 2 100610471, 122617301, 300566361, 149924112, 332342352, 3970000, D+F30.02 3 403245601, 493151431, 529654331, 559358091, 611065171, 600000, AEL31.00 4 99710051, 104511541, 135016501, 208226431, 321837921, 2050900, AEL31.01 5 199820071, 204521391, 229124761, 266028451, 302932131, 3070000, AEL31.02 6 502665261, 755183501, 901496201, 102410942, 117912812, 787900, AEL32.00 7 422848161, 512153401, 557458941, 636270361, 794489061, 1593000, AEL32.01 8 100010261, 114613921, 175221251, 249828711, 324436181, 3421000, AEL32.02 9 403143241, 491856701, 649173781, 840396751, 113013392, 981000/ AEL33.00 DATA NNN18/ 1 593676641, 884697521, 105911572, 129515012, 180322212, 1858700, AEL33.01 2 484470541, 91510972, 125614082, 157017612, 199722912, 2829900, AEL33.02 3 630172361, 799686381, 919797221, 102810942, 117712832, 975000, AEL34.00 4 438055511, 691582151, 94510732, 121413672, 152016732, 2150000, AEL34.01 5 651982921, 94610382, 113212492, 139515462, 169718482, 3200000, AEL34.02 6 437347431, 498951671, 538559501, 74710812, 169126672, 1183910, D+F35.00 7 705183611, 93510092, 111614162, 222932532, 427652992, 2160000, D+F35.01 8 510869921, 87410312, 123116552, 236530712, 377744832, 3590000, D+F35.02 9 100010001, 100010051, 105012781, 198535971, 65911422, 1399507/ D+F36.00 DATA NNN19/ 1 461049811, 522254261, 609088131, 168935052, 68612253, 2455908, D+F36.01 2 759990901, 101911142, 129017782, 302856642, 99414333, 3690000, D+F36.02 3 200020011, 200720361, 211523021, 269434141, 459163351, 417502, D+F37.00 4 100010001, 100110321, 129524961, 61014202, 291753192, 2750004, D+F37.01 5 473650891, 533156051, 66810932, 232950852, 99915303, 4000000, D+F37.02 6 100110041, 104111741, 146019721, 281941411, 607785251, 569202, D+F38.00 7 202621931, 255331271, 384347931, 624085761, 122417632, 1102600, D+F38.01 8 100010001, 100110321, 129524961, 61014202, 291753192, 4300000, FAK38.02 9 791587851, 100012192, 155119942, 254031782, 389946932, 637900/ AEL39.00 DATA NNN20/ 1 118217102, 220827002, 319036792, 416646512, 513256072, 1223000, AEL39.01 2 92510012, 104710862, 112311612, 120212472, 132814282, 2050000, AEL39.02 3 141320802, 291439702, 531170262, 92712273, 162521053, 684000, D+F40.00 4 354454352, 724689652, 107212643, 148517093, 193321573, 1312900, D+F40.01 5 209727032, 324537052, 415446282, 510255752, 604965222, 2298000, D+F40.02 6 256636022, 465759302, 749693962, 116514243, 171520333, 687900, AEL41.00 7 335157222, 84511463, 147718363, 221826083, 299933893, 1431900, AEL41.01 8 223725352, 280830972, 340937362, 406844002, 473150632, 2503900, AEL41.02 9 703972941, 82610822, 154822682, 327244912, 571469372, 709900/ D+F42.00 DATA NNN21/ 1 75714552, 274347322, 718897632, 123414913, 174920063, 1614900, D+F42.01 2 267645462, 669890262, 115514323, 173620673, 242528083, 2714900, AEL42.02 3 90613732, 184823562, 291735332, 419949102, 565764332, 728000, AEL43.00 4 131318312, 227126932, 311735452, 397644072, 483852692, 1525900, AEL43.01 5 204721673, 234725733, 284031463, 348738613, 426546943, 3000000, AEL43.02 6 176824122, 318941082, 515263202, 761790472, 106112303, 736400, AEL44.00 7 221934642, 501968372, 88911173, 136316243, 189221613, 1675900, AEL44.01 8 210622722, 241025422, 267928262, 297731272, 327834282, 2846000, AEL44.02 9 148520202, 255230902, 364942462, 489656082, 638872352, 746000/ AEL45.00 DATA NNN22/ 1 153421292, 288137912, 484660322, 720187062, 101011483, 1807000, AEL45.01 2 254537212, 492362292, 770592182, 107312243, 137615273, 3104900, AEL45.02 3 115919651, 320746011, 607576761, 95011642, 141817172, 832900, AEL46.00 4 755087211, 105913442, 173122222, 282034722, 412247732, 1941900, AEL46.01 5 180223462, 289735212, 414247632, 538460052, 662672472, 3292000, AEL46.02 6 200020001, 200220141, 206422141, 257633021, 455164681, 757403, D+F47.00 7 100810581, 125817401, 260641031, 66210072, 135316982, 2148000, D+F47.01 8 795887491, 97711762, 156620252, 248329422, 340038582, 3481900, D+F47.02 9 100010001, 100410241, 109212891, 176827421, 444268771, 899003/ D+F48.00 DATA NNN23/ 1 200020021, 201720921, 233329881, 451475371, 127520782, 1690301, D+F48.01 2 100310281, 114815371, 246138311, 519265531, 791492761, 3747000, D+F48.02 3 252431921, 368440461, 433746521, 512259221, 723389021, 578400, D+F49.00 4 100110071, 104611651, 146118581, 225426511, 304734431, 1886000, D+F49.01 5 200120111, 205021611, 243628031, 317035371, 390442701, 2802900, D+F49.02 6 232637101, 488058571, 669074381, 816189091, 97210632, 734200, AEL50.00 7 286335941, 408144471, 479351961, 571862901, 686274341, 1462700, AEL50.01 8 100010251, 114013811, 175321601, 256829751, 338337901, 3049000, AEL50.02 9 404043481, 494656811, 646772781, 813490751, 101411372, 863900/ AEL51.00 DATA NNN24/ 1 303147981, 618472951, 827392621, 103711702, 131214532, 1650000, AEL51.01 2 313037601, 429347901, 536260591, 689477591, 862494881, 2529900, AEL51.02 3 526258801, 657372351, 784284071, 897095741, 102711082, 900900, AEL52.00 4 440855541, 686481251, 93810792, 125414792, 176321132, 1860000, AEL52.01 5 349054751, 699883081, 96611302, 134216202, 197724212, 2800000, AEL52.02 6 405342041, 438645621, 475751071, 587974491, 102214572, 1045404, D+F53.00 7 568567471, 773485861, 94510362, 112712182, 130914002, 1909000, D+F53.01 8 514269581, 86910562, 130716652, 215327742, 351843662, 3200000, AEL53.02 9 100010001, 100010091, 109515351, 291060661, 119621482, 1212716/ D+F54.00 DATA NNN25/ 1 414844131, 465649111, 538464651, 87112232, 158019362, 2120000, D+F54.01 2 615475101, 867797531, 112213462, 157618062, 203622662, 3209900, D+F54.02 3 200020001, 201020501, 215623871, 283536181, 462756261, 389300, D+F55.00 4 100010001, 100310371, 119016501, 269146361, 77912412, 2510000, D+F55.01 5 424445601, 481750061, 516953311, 549356551, 581759791, 3500000, D+F55.02 6 101210791, 135119351, 282340571, 574580391, 111015062, 521002, D+F56.00 7 262638611, 504160621, 698579371, 91010692, 129115952, 1000000, D+F56.01 8 100010001, 100310351, 118416321, 264945521, 76512182, 3700000, FAK56.02 9 71111992, 172323592, 312540402, 510763182, 765791012, 558000/ AEL57.00 DATA NNN26/ 1 204529582, 383647882, 582469262, 807992692, 104911723, 1106000, AEL57.01 2 94712552, 148416582, 179819212, 203621522, 227424042, 1916900, AEL57.02 3 295959132, 103515693, 215527593, 335939413, 449650223, 565000, AEL58.00 4 80118633, 304342383, 541765723, 769387773, 98210814, 1085000, MZH58.01 5 506183092, 108612923, 146416133, 174418603, 196520603, 2020000, CCB58.02 6 460693672, 158523823, 327242303, 519661563, 709379783, 541900, FAK59.00 7 455480232, 114014653, 178521013, 240927073, 299232633, 1055000, AEL59.01 8 46410533, 183826893, 354443773, 518459633, 674375243, 2320000, AEL59.02 9 139623042, 364860002, 96114603, 209828633, 373446973, 549000/ AEL60.00 DATA NNN27/ 1 460493692, 158523823, 327142303, 519661563, 709279783, 1073000, AEL60.01 2 455480232, 114014653, 178521013, 240927073, 299232633, 2000000, FAK60.02 3 131720482, 280535692, 441254492, 676583972, 103412583, 555000, AEL61.00 4 139623042, 364860002, 96114603, 209828633, 373446973, 1089900, FAK61.01 5 460493682, 158523823, 327142303, 519661563, 709279783, 2000000, FAK61.02 6 92915672, 222431062, 444763802, 89612173, 159520253, 562900, AEL62.00 7 315059662, 97114563, 204627093, 342541693, 490556383, 1106900, AEL62.01 8 269037812, 520270372, 91111273, 133915483, 172719093, 2000000, AEL62.02 9 800080571, 851699301, 127617362, 240433032, 444958442, 568000/ AEL63.00 DATA NNN28/ 1 125416052, 211828182, 375549622, 644381732, 101112213, 1125000, AEL63.01 2 800080571, 851699301, 127617362, 240433032, 444958442, 2000000, FAK63.02 3 240432982, 427555202, 708489962, 112613853, 167319843, 615900, AEL64.00 4 534793262, 139219123, 247730843, 371043333, 495055893, 1210000, AEL64.01 5 364145232, 514756362, 604864112, 673870372, 732276072, 2000000, AEL64.02 6 480767202, 89011393, 144118243, 230028753, 354142883, 584900, AEL65.00 7 480767192, 89011393, 144118243, 230028753, 354142883, 1151900, FAK65.01 8 480767202, 89011393, 144118243, 230028753, 354142883, 2000000, FAK65.02 9 343147532, 645887152, 115314793, 183322063, 257729373, 593000/ FAK66.00 DATA NNN29/ 1 343147532, 645887142, 115314793, 183322063, 257729373, 1167000, AEL66.01 2 343147532, 645887142, 115314793, 183322063, 257729373, 2000000, FAK66.02 3 222635002, 542276772, 100312353, 145716713, 187020703, 602000, FAK67.00 4 222635002, 542276772, 100312353, 145716713, 187020703, 1180000, FAK67.01 5 222635002, 542276772, 100312353, 145716713, 187020703, 2000000, AEL67.02 6 133715382, 209130152, 429859382, 79410293, 129815983, 609900, AEL68.00 7 265934782, 497877532, 120517733, 245032063, 400448073, 1193000, AEL68.01 8 265934782, 497877532, 120517733, 245032063, 400448073, 2000000, FAK68.02 9 800381111, 87510702, 147621462, 310343462, 585475982, 618000/ AEL69.00 DATA NNN30/ 1 156718872, 279244452, 678196342, 128316243, 197823443, 1205000, AEL69.01 2 93517192, 364666132, 103414613, 192624193, 293334613, 2370000, AEL69.02 3 100010011, 101310651, 118613951, 169120661, 250629971, 625000, AEL70.00 4 200120901, 270345231, 81714042, 223533112, 461959862, 1217000, AEL70.01 5 100312561, 250851931, 91914182, 198626022, 323638692, 2000000, AEL70.02 6 514664441, 759086851, 99211442, 133315612, 182721252, 609900, AEL71.00 7 125924831, 438667801, 98714112, 199727872, 380850742, 1389900, AEL71.01 8 323948621, 661297271, 158626482, 426865032, 93712843, 1900000, AEL71.02 9 659294081, 128016962, 222528952, 372047062, 585171462, 700000/ AEL72.00 DATA NNN31/ 1 99117882, 274638812, 520867322, 84410313, 123314453, 1489900, AEL72.01 2 187427702, 343739872, 448049452, 539358282, 625266642, 2329900, AEL72.02 3 65210892, 171325762, 373552252, 705192012, 116414343, 787900, AEL73.00 4 192837842, 600784802, 111113823, 165419233, 218524383, 1620000, AEL73.01 5 99117872, 274638812, 520867312, 84410313, 123314453, 2400000, FAK73.02 6 398981651, 130019172, 273438022, 516168382, 88411163, 797900, AEL74.00 7 131429482, 523279952, 111414623, 183422233, 262130233, 1770000, AEL74.01 8 192837842, 600784792, 111113823, 165419233, 218524383, 2500000, FAK74.02 9 600963001, 75910412, 150121572, 301940972, 539168952, 787000/ AEL75.00 DATA NNN32/ 1 73710852, 190731262, 464964142, 83810503, 127315053, 1660000, AEL75.01 2 131429482, 523279952, 111414623, 183422233, 262130233, 2600000, FAK75.02 3 110815502, 216829732, 398752322, 672484682, 104612673, 850000, AEL76.00 4 168225972, 362046562, 566766422, 757484612, 93010103, 1700000, AEL76.01 5 73710852, 190731262, 464964142, 83810503, 127315053, 2700000, FAK76.02 6 129117892, 239430882, 388748292, 596173252, 89510843, 910000, AEL77.00 7 110815502, 216829732, 398752322, 672484682, 104612673, 2000000, FAK77.01 8 168225972, 362046562, 566766422, 757484612, 93010103, 2800000, FAK77.02 9 158918512, 207523002, 254328242, 316335762, 407246582, 900000/ AEL78.00 DATA NNN33/ 1 98115462, 224930742, 401150612, 623475412, 89910583, 1855900, AEL78.01 2 110815502, 216829732, 398752322, 672484682, 104612673, 2900000, FAK78.02 3 203222611, 265731251, 364042301, 494958601, 702084731, 922000, AEL79.00 4 120521331, 357753801, 75310062, 130516572, 206925452, 2050000, AEL79.01 5 651780821, 108814772, 195925252, 316338622, 460853882, 3000000, AEL79.02 6 100010001, 100110111, 105211851, 152122101, 341552811, 1043002, D+F80.00 7 200320211, 210023021, 268834231, 480472341, 111416912, 1875000, D+F80.01 8 104012871, 186129471, 458664151, 82410072, 119013732, 3420000, D+F80.02 9 200420711, 222424271, 265429161, 325637371, 442853911, 610500/ AEL81.00 DATA NNN34/ 1 100010021, 101910801, 121414641, 189525811, 358949721, 2041900, AEL81.01 2 200020311, 216624611, 296337451, 489064791, 85711212, 2979900, AEL81.02 3 103411711, 147819101, 244331781, 434862751, 93113762, 741404, D+F82.00 4 204122231, 248227841, 311535621, 429153941, 651976431, 1502800, D+F82.01 5 100210131, 106812201, 154522671, 381665951, 95512512, 3192900, D+F82.02 6 400140351, 416944121, 474851591, 564362181, 690477231, 728700, AEL83.00 7 106814451, 204427341, 350744811, 586879131, 108314772, 1667900, AEL83.01 8 205523051, 264830231, 345439921, 469156001, 675281671, 2555900, AEL83.02 9 500950661, 518153561, 559058941, 628968071, 748483501, 843000/ AEL84.00 DATA NNN35/ 1 443756241, 696282451, 95411012, 128615262, 182922012, 1900000, FAK84.01 2 336953201, 682481011, 93810882, 127915272, 184622442, 2700000, FAK84.02 3 402841621, 431544771, 463148311, 520059491, 734896851, 930000, FAK85.00 4 576168741, 788387631, 96910642, 116012552, 135014462, 2000000, FAK85.01 5 490265341, 812797201, 116614322, 179622692, 285035302, 2900000, FAK85.02 6 100010001, 100010031, 102311051, 133018071, 264539391, 1074500, AEL86.00 7 402841621, 431544771, 463148311, 520059491, 734996851, 2000000, FAK86.01 8 576168741, 788387631, 96910642, 116012552, 135014462, 3000000, FAK86.02 9 200020011, 201220591, 218124481, 296538611, 488859141, 400000/ FAK87.00 DATA NNN36/ 1 100010001, 100010031, 102311051, 133018071, 264539401, 2200000, FAK87.01 2 421645151, 477449611, 511852711, 542455761, 572958821, 3300000, FAK87.02 3 100010041, 105212131, 153220271, 270435641, 460258111, 527600, AEL88.00 4 201221791, 258131471, 381645781, 546365131, 777592781, 1014400, AEL88.01 5 100010001, 100010031, 102311051, 133018071, 264539391, 3400000, FAK88.02 6 510064491, 82710872, 142718412, 232328712, 348341572, 690000, AEL89.00 7 228951571, 88513232, 183324132, 305537492, 448152402, 1210000, AEL89.01 8 723989131, 103511752, 130814352, 155416652, 177018682, 2000000, AEL89.02 9 620099241, 162725772, 391457072, 80110833, 141818023, 600000/ AEL90.00 DATA NNN37/ 1 620099241, 162725772, 391457072, 80110833, 141818023, 1200000, FAK90.01 2 620099251, 162725772, 391457072, 80110833, 141818023, 2000000, FAK90.02 3 347877992, 129318323, 240730533, 380546863, 570368573, 600000, AEL91.00 4 347877992, 129318323, 240730533, 380546863, 570368573, 1200000, FAK91.01 5 347777992, 129318323, 240730533, 380546863, 570368573, 2000000, FAK91.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, AEL92.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK92.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK92.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK93.00 DATA NNN38/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK93.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK93.02 3 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK94.00 4 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK94.01 5 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK94.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK95.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK95.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK95.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK96.00 DATA NNN39/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK96.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK96.02 3 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK97.00 4 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK97.01 5 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK97.02 6 209530092, 450866762, 96613623, 186524763, 318839893, 600000, FAK98.00 7 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK98.01 8 209530092, 450866762, 96613623, 186524763, 318839893, 2000000, FAK98.02 9 209530092, 450866762, 96613623, 186524763, 318839893, 600000/ FAK99.00 DATA NNN40/ 1 209530092, 450866762, 96613623, 186524763, 318839893, 1200000, FAK99.01 2 209530092, 450866762, 96613623, 186524763, 318839893, 2000000/ FAK99.02 DATA NNN67/ 1 893292271, 96110042, 105311262, 126315202, 196126432, 1125508, D+F 6.00 2 595060251, 620865751, 713280191, 95712292, 167623542, 2437501, D+F 6.01 3 105513201, 180324851, 341851341, 88416332, 296550722, 4787101, D+F 6.02 4 204922771, 262630421, 350941931, 494556971, 644872001, 6447600, D+F 6.03 5 100010001, 100010001, 100010001, 100010001, 100010001, 39207700, G 6.04 6 200020001, 200020001, 200020001, 200020001, 200020001, 48998100, G 6.05 7 403141851, 457051681, 594071181, 92913362, 203331152, 1452915, D+F 7.00 8 919899541, 107211512, 124914302, 182526232, 403762662, 2959202, D+F 7.01 9 596862721, 684177081, 88110342, 128317062, 239334312, 4742501, D+F 7.02 T 112816481, 240733751, 462068491, 116419932, 283736822, 7744900, D+F 7.03 1 210124681, 293634211, 391145791, 539862151, 703178471, 9786200, D+F 7.04 2 100010001, 100010001, 100010001, 100010001, 100010001, 55205700/ G 7.05 DATA LOCZ/1,3,6,10,14,18,22,27,33,39,45,51,57,63,69,75,81,86,91, 196,101,106,111,116,121,126,131,136,141/ DATA SCALE/.001,.01,.1,1./ C MODE1=MODE IF(MODE1.GT.10)MODE1=MODE1-10 C LOWERING OF THE IONIZATION POTENTIAL IN VOLTS FOR UNIT ZEFF CHARGE=XNE(J)*2. EXCESS=2.*XNE(J)-P(J)/TK(J) C ALLOWANCE FOR DOUBLY IONIZED HELIUM IF(EXCESS.GT.0.)CHARGE=CHARGE+2.*EXCESS DEBYE=SQRT(TK(J)/2.8965E-18/CHARGE) C DEBYE=SQRT(TK(J)/12.5664/4.801E-10**2/CHARGE) POTLOW=DMIN1(1.D0,1.44E-7/DEBYE) TV=TKEV(J) IF(IZ.LE.28)N=LOCZ(IZ) IF(IZ.GT.28)N=3*IZ+54 IF(IZ.LE.28)NIONS=LOCZ(IZ+1)-N IF(IZ.GT.28)NIONS=3 IF(IZ.EQ.6)N=354 IF(IZ.EQ.6)NIONS=6 IF(IZ.EQ.7)N=360 IF(IZ.EQ.7)NIONS=6 NION2=MIN0(NION+2,NIONS) N=N-1 C DO 18 ION=1,NION2 Z=ION POTLO(ION)=POTLOW*Z N=N+1 NNN100=NNN(6,N)/100 IP(ION)=DFLOAT(NNN100)/1000. G=NNN(6,N)-NNN100*100 IF(N.EQ.1)GO TO 16 T2000=IP(ION)*2000./11. IT=MAX0(1,MIN0(9, INT(T(J)/T2000-.5))) DT=T(J)/T2000-DFLOAT(IT)-.5 PMIN=1. I=(IT+1)/2 K1=NNN(I,N)/100000 K2=NNN(I,N)-K1*100000 K3=K2/10 KSCALE=K2-K3*10 IF(MOD(IT,2).EQ.0)GO TO 12 P1=DFLOAT(K1)*SCALE(KSCALE) P2=DFLOAT(K3)*SCALE(KSCALE) IF(DT.GE.0.)GO TO 13 IF(KSCALE.GT.1)GO TO 13 KP1=P1 IF(KP1.NE. INT(P2+.5))GO TO 13 PMIN=KP1 GO TO 13 12 P1=DFLOAT(K3)*SCALE(KSCALE) K1=NNN(I+1,N)/100000 KSCALE=MOD(NNN(I+1,N),10) P2=DFLOAT(K1)*SCALE(KSCALE) 13 PART(ION)=DMAX1(PMIN,P1+(P2-P1)*DT) IF(G.EQ.0..OR.POTLO(ION).LT..1.OR.T(J).LT.T2000*4.)GO TO 18 IF(T(J).GT.(T2000*11.))TV=(T2000*11.)*8.6171E-5 D1=.1/TV 14 D2=POTLO(ION)/TV PART(ION)=PART(ION)+G*EXP(-IP(ION)/TV)*(SQRT(13.595*Z*Z/TV/D2)**3* 1(1./3.+(1.-(.5+(1./18.+D2/120.)*D2)*D2)*D2)- 2SQRT(13.595*Z*Z/TV/D1)**3* 3(1./3.+(1.-(.5+(1./18.+D1/120.)*D1)*D1)*D1)) TV=TKEV(J) GO TO 18 16 PART(1)=2.*BHYD(J,1) C IF(T(J).LT.9000.)GO TO 18 PART(1)=PART(1)+8.*BHYD(J,2)*EXP(-10.196/TV)+18.*BHYD(J,3)* 1EXP(-12.084/TV)+32.*BHYD(J,4)*EXP(-12.745/TV)+50.*BHYD(J,5)* 2EXP(-13.051/TV)+72.*BHYD(J,6)*EXP(-13.217/TV) D1=13.595/6.5/6.5/TV D2=POTLO(1)/TV GO TO 14 18 CONTINUE C 19 IF(MODE1.EQ.3)GO TO 35 IF(MODE1.EQ.5)GO TO 50 C N=N-NION2 CF=2.*2.4148E15*T(J)*SQRT(T(J))/XNE(J) DO 20 ION=2,NION2 N=N+1 C THE AMIN IS FOR ANY UNFORTUNATE WHO HAS A 360 20 F(ION)=CF*PART(ION)/PART(ION-1)* 1EXP(-DMIN1((IP(ION-1)-POTLO(ION-1))/TV,100.D0)) F(1)=1. L=NION2+1 DO 21 ION=2,NION2 L=L-1 21 F(1)=1.+F(L)*F(1) F(1)=1./F(1) DO 22 ION=2,NION2 22 F(ION)=F(ION-1)*F(ION) C 35 IF(MODE.LT.10)GO TO 40 GO TO(23,25,27,29),MODE1 23 DO 24 ION=1,NION 24 ANSWER(J,ION)=F(ION)/PART(ION) RETURN 25 DO 26 ION=1,NION 26 ANSWER(J,ION)=F(ION) RETURN 27 DO 28 ION=1,NION 28 ANSWER(J,ION)=PART(ION) RETURN 29 ANSWER(J,1)=0. DO 30 ION=2,NION2 30 ANSWER(J,1)=ANSWER(J,1)+F(ION)*DFLOAT(ION-1) RETURN 40 GO TO(41,42,43,29),MODE1 41 ANSWER(J,1)=F(NION)/PART(NION) RETURN 42 ANSWER(J,1)=F(NION) RETURN 43 ANSWER(J,1)=PART(NION) RETURN 50 ANSWER(7,1)=0. DO 51 ION=1,NION ANSWER(ION,1)=PART(ION) 51 ANSWER(ION+7,1)=IP(ION)+ANSWER(ION+6,1) RETURN END SUBROUTINE MOLEC(CODOUT,MODE,NUMBER) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) DIMENSION NUMBER(kw,1) REAL*8 NUMBER COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99) COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,TAUSCAT,IFMOL COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP COMMON /XABUND/XABUND(99),WTMOLE COMMON /XNMOL/XNMOL(kw,160) COMMON /IFEQUA/IFEQUA(101),KCOMPS(450),LOCJ(161),CODE(160), 1 EQUIL(6,160),IDEQUA(25),NEQUA,NUMMOL,NLOC COMMON /IFPOP/IFPOP DATA IREAD/0/ IF(IFPOP.EQ.2)GO TO 200 IF(IREAD.EQ.1)GO TO 200 IF(IFPRES.EQ.1)GO TO 200 c READ(5,151)NUMMOL c 151 FORMAT(I5) c DO 155 JMOL=1,NUMMOL c READ(5,152)CODE(JMOL) c 152 FORMAT(F20.2) c READ(5,153)(XNMOL(J,JMOL),J=1,NRHOX) c 153 FORMAT(1P8E10.3) c WRITE(6,154)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) c 154 FORMAT(F20.2/(1P8E10.3)) c 155 CONTINUE c READ(5,158) c READ(5,158)(XNATOM(J),RHO(J),J=1,NRHOX) c WRITE(6,158)(XNATOM(J),RHO(J),J=1,NRHOX) c 158 FORMAT(1P8E10.3) c READ(5,158) c READ(5,158)(XNE(J),J=1,NRHOX) c WRITE(6,158)(XNE(J),J=1,NRHOX) c IREAD=1 200 IF(CODOUT.LT.100.)GO TO 300 DO 201 JMOL=1,NUMMOL IF(CODE(JMOL).EQ.CODOUT)GO TO 203 201 CONTINUE CALL EXIT(3) 203 DO 204 J=1,NRHOX C 204 NUMBER(J,ION)=XNMOL(J,JMOL) 204 NUMBER(J,1)=XNMOL(J,JMOL) RETURN 300 C=CODOUT NN=1 IF(MODE.EQ.11)NN=(C-DFLOAT( INT(C)))*100.+1.5 DO 321 I=1,NN DO 301 JMOL=1,NUMMOL ION=NN-I+1 IF(CODE(JMOL)+.001.GT.C.AND.CODE(JMOL)-.001.LT.C)GO TO 303 301 CONTINUE GO TO 305 303 DO 304 J=1,NRHOX 304 NUMBER(J,ION)=XNMOL(J,JMOL) GO TO 321 305 ID=CODOUT DO 311 JMOL=1,NUMMOL IF( INT(CODE(JMOL)).EQ.ID)GO TO 313 311 CONTINUE GO TO 400 313 DO 314 J=1,NRHOX 314 NUMBER(J,ION)=0. 321 C=C-.01 RETURN 400 ION=(CODOUT-DFLOAT(ID))*100.+1.5 NN=ION IF(MODE.EQ.1)NN=1 DO 401 J=1,NRHOX CALL PFSAHA(J,ID,ION,MODE,NUMBER) DO 401 I=1,NN 401 NUMBER(J,I)=NUMBER(J,I)*XNATOM(J)*XABUND(ID) RETURN END SUBROUTINE NMOLEC(MODE) IMPLICIT REAL*8 (A-H,O-Z) PARAMETER (kw=99) COMMON /EDENS/EDENS(kw),IFEDNS COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99) COMMON /ITER/ ITER,IFPRNT(15),IFPNCH(15),NUMITS COMMON /RHOX/RHOX(kw),NRHOX COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw) COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),ITEMP COMMON /XABUND/XABUND(99),WTMOLE COMMON /XNSAVE/XNSAVE(kw,25) DIMENSION PFP(13),PFM(13),EION(7),PFPLUS(kw),PFMIN(kw) EQUIVALENCE (PFP(7),EION(1)) DIMENSION EQUILJ(160) DIMENSION XNZ(kw,25) DIMENSION EQ(25),XN(25),XAB(25),DTERM(25),DEQ(625) DIMENSION FRAC(kw,6) EQUIVALENCE (FRAC(1,1),DEQ(1)) DIMENSION EQOLD(25) COMMON /XNMOL/XNMOL(kw,160) COMMON /IFEQUA/IFEQUA(101),KCOMPS(450),LOCJ(161),CODE(160), 1 EQUIL(6,160),IDEQUA(25),NEQUA,NUMMOL,NLOC NEQUA1=NEQUA+1 NEQNEQ=NEQUA**2 C 30 DO 31 K=2,NEQUA ID=IDEQUA(K) IF(ID.LT.100)XAB(K)=DMAX1(XABUND(ID),1.D-20) 31 CONTINUE IF(ID.EQ.100)XAB(NEQUA)=0. XNTOT=P(1)/TK(1) XN(1)=XNTOT/2. IF(T(1).LT.4000.)XN(1)=XNTOT X=XN(1)/10. DO 32 K=2,NEQUA 32 XN(K)=X*XAB(K) IF(ID.EQ.100)XN(NEQUA)=X XNE(1)=X DO 110 J=1,NRHOX XNTOT=P(J)/TK(J) IF(J.EQ.1)GO TO 34 RATIO=P(J)/P(J-1) XNE(J)=XNE(J-1)*RATIO DO 33 K=1,NEQUA 33 XN(K)=XN(K)*RATIO 34 IF(IFEDNS.EQ.0)GO TO 3334 DO 3333 K=1,NEQUA 3333 XN(K)=XNSAVE(J,K) 3334 CONTINUE DO 37 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(EQUIL(1,JMOL).EQ.0.)GO TO 35 ION=(CODE(JMOL)-DFLOAT( INT(CODE(JMOL))))*100.+.5 EQUILJ(JMOL)=0. IF(T(J).GT.10000.)GO TO 37 EQUILJ(JMOL)=EXP(EQUIL(1,JMOL)/TKEV(J)-EQUIL(2,JMOL)+ 1(EQUIL(3,JMOL)+(-EQUIL(4,JMOL)+(EQUIL(5,JMOL)-EQUIL(6,JMOL)* 2T(J))*T(J))*T(J))*T(J)-1.5*(DFLOAT(NCOMP-ION-ION-1))*TLOG(J)) GO TO 37 35 IF(NCOMP.GT.1)GO TO 36 EQUILJ(JMOL)=1. GO TO 37 36 ID=CODE(JMOL) ION=NCOMP-1 CALL PFSAHA(J,ID,NCOMP,12,FRAC) EQUILJ(JMOL)=FRAC(J,NCOMP)/FRAC(J,1)*XNE(J)**ION 37 CONTINUE DO 48 K=1,NEQUA 48 EQOLD(K)=0. C C SET UP 1ST ORDER EQUATIONS FOR THE CHANGE IN NUMBER DENSITY OF C EACH ELEMENT. 50 DO 60 KL=1,NEQNEQ 60 DEQ(KL)=0. EQ(1)=-XNTOT K1=1 KK=1 DO 61 K=2,NEQUA EQ(1)=EQ(1)+XN(K) K1=K1+NEQUA C K1 IS ACTUALLY 1K DEQ(K1)=1. EQ(K)=XN(K)-XAB(K)*XN(1) KK=KK+NEQUA1 DEQ(KK)=1. 61 DEQ(K)=-XAB(K) IF(IDEQUA(NEQUA).LT.100)GO TO 62 EQ(NEQUA)=-XN(NEQUA) DEQ(NEQNEQ)=-1. 62 CONTINUE DO 99 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(NCOMP.EQ.1)GO TO 99 TERM=EQUILJ(JMOL) LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 80 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 79 TERM=TERM*XN(K) GO TO 80 79 TERM=TERM/XN(NEQUA) 80 CONTINUE EQ(1)=EQ(1)+TERM DO 85 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.LT.NEQUA1)GO TO 81 K=NEQUA D=-TERM/XN(K) GO TO 82 81 D=TERM/XN(K) 82 EQ(K)=EQ(K)+TERM NEQUAK=NEQUA*K-NEQUA K1=NEQUAK+1 DEQ(K1)=DEQ(K1)+D DO 83 LOCM=LOCJ1,LOCJ2 M=KCOMPS(LOCM) IF(M.EQ.NEQUA1)M=NEQUA MK=M+NEQUAK 83 DEQ(MK)=DEQ(MK)+D 85 CONTINUE C C CORRECTION TO CHARGE EQUATION FOR NEGATIVE IONS K=KCOMPS(LOCJ2) IF(IDEQUA(K).NE.100)GO TO 99 DO 95 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) D=TERM/XN(K) IF(K.EQ.NEQUA)EQ(K)=EQ(K)-TERM-TERM NEQUAK=NEQUA*K-NEQUA DO 93 LOCM=LOCJ1,LOCJ2 M=KCOMPS(LOCM) IF(M.NE.NEQUA)GO TO 93 MK=M+NEQUAK DEQ(MK)=DEQ(MK)-D-D 93 CONTINUE 95 CONTINUE C 99 CONTINUE C CALL SOLVIT(DEQ,NEQUA,EQ,DTERM) IFERR=0 SCALE=100. DO 105 K=1,NEQUA RATIO=ABS(EQ(K)/XN(K)) IF(RATIO.GT..001)IFERR=1 IF(EQOLD(K)*EQ(K).LT.0.)EQ(K)=EQ(K)*.69 XNEQ=XN(K)-EQ(K) XN100=XN(K)/100. IF(XNEQ.LT.XN100)GO TO 101 XN100=XN(K)*100. C IF(XNEQ.GT.XN100)GO TO 102 XN(K)=XNEQ GO TO 105 101 XN(K)=XN(K)/SCALE IF(EQOLD(K)*EQ(K).LT.0.)SCALE=SQRT(SCALE) GO TO 105 C 102 XN(K)=XN100 105 EQOLD(K)=EQ(K) IF(IFERR.EQ.1)GO TO 50 C DO 107 K=1,NEQUA 107 XNZ(J,K)=XN(K) XNATOM(J)=XN(1) RHO(J)=XNATOM(J)*WTMOLE*1.660E-24 IF(IDEQUA(NEQUA).EQ.100)XNE(J)=XN(NEQUA) DO 109 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) XNMOL(J,JMOL)=EQUILJ(JMOL) LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 109 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 108 XNMOL(J,JMOL)=XNMOL(J,JMOL)*XN(K) GO TO 109 108 XNMOL(J,JMOL)=XNMOL(J,JMOL)/XN(NEQUA) 109 CONTINUE 110 CONTINUE IF(IFEDNS.EQ.1)GO TO 160 DO 1111 K=1,NEQUA DO 1111 J=1,NRHOX 1111 XNSAVE(J,K)=XNZ(J,K) IF(ITER.LT.NUMITS)GO TO 120 c WRITE(6,112)(J,RHOX(J),T(J),P(J),XNE(J),XNATOM(J),RHO(J), c 1J=1,NRHOX) 112 FORMAT(1H1,10X,4HRHOX,9X,1HT,11X,1HP,10X,3HXNE,8X,6HXNATOM, 1 8X,3HRHO/(I5,1P6E12.3)) NN=(NUMMOL/10)*10 IF(NN.LT.NUMMOL)NN=NN+10 DO 111 JMOL1=1,NN,10 JMOL10=JMOL1+9 111 continue c 111 WRITE(6,113)(CODE(JMOL),JMOL=JMOL1,JMOL10),(J,(XNMOL(J,JMOL), c 1JMOL=JMOL1,JMOL10),J=1,NRHOX) 113 FORMAT(1H1,49X,26HMOLECULAR NUMBER DENSITIES/5X,10F12.2/ 1(I5,1P10E12.3)) 120 IF(MODE.EQ.2.OR.MODE.EQ.12)GO TO 149 DO 125 K=2,NEQUA ID=IDEQUA(K) IF(ID.EQ.100)GO TO 122 DO 121 J=1,NRHOX C CALCULATE PARTITION FUNCTIONS CALL PFSAHA(J,ID,1,3,FRAC) 121 XNZ(J,K)=XNZ(J,K)/FRAC(J,1)/1.8786E20/SQRT((ATMASS(ID)*T(J))**3) GO TO 125 122 DO 123 J=1,NRHOX 123 XNZ(J,K)=XNZ(J,K)/2./2.4148E15/T(J)/SQRT(T(J)) 125 CONTINUE DO 140 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(EQUIL(1,JMOL).EQ.0.)GO TO 135 DO 126 J=1,NRHOX C 126 XNMOL(J,JMOL)=EXP(EQUIL(1,JMOL)/T(J)) 126 XNMOL(J,JMOL)=EXP(EQUIL(1,JMOL)/TKEV(J)) AMASS=0. LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 130 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA1)GO TO 128 ID=IDEQUA(K) IF(ID.LT.100)AMASS=AMASS+ATMASS(ID) DO 127 J=1,NRHOX 127 XNMOL(J,JMOL)=XNMOL(J,JMOL)*XNZ(J,K) GO TO 130 128 DO 129 J=1,NRHOX 129 XNMOL(J,JMOL)=XNMOL(J,JMOL)/XNZ(J,NEQUA) 130 CONTINUE DO 131 J=1,NRHOX 131 XNMOL(J,JMOL)=XNMOL(J,JMOL)*1.8786E20*SQRT((AMASS*T(J))**3) GO TO 140 135 ID=CODE(JMOL) DO 136 J=1,NRHOX CALL PFSAHA(J,ID,NCOMP,3,FRAC) 136 XNMOL(J,JMOL)=XNMOL(J,JMOL)/FRAC(J,1) 140 CONTINUE 149 IF(IFPNCH(ITER).NE.5)RETURN c WRITE(6,150) c 150 FORMAT(1H1,20X,38HNUMBER DENSITIES / PARTITION FUNCTIONS) c WRITE(6,151)NUMMOL c WRITE(7,151)NUMMOL c 151 FORMAT(I5,10H MOLECULES) c DO 155 JMOL=1,NUMMOL c WRITE(6,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) c WRITE(7,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX) c 152 FORMAT(F20.2/(1P8E10.3)) c 155 CONTINUE c WRITE(6,158)(XNATOM(J),RHO(J),J=1,NRHOX) c WRITE(7,158)(XNATOM(J),RHO(J),J=1,NRHOX) c 158 FORMAT(11H XNATOM,RHO/(1P8E10.3)) RETURN 160 DO 161 J=1,NRHOX XNTOT=P(J)/TK(J) 161 EDENS(J)=1.5*XNTOT*TK(J) DO 180 JMOL=1,NUMMOL NCOMP=LOCJ(JMOL+1)-LOCJ(JMOL) IF(EQUIL(1,JMOL).EQ.0.)GO TO 175 DO 166 J=1,NRHOX TPLUS=T(J)*1.001 TMINUS=T(J)*.999 PFPLUS(J)=EXP(-EQUIL(2,JMOL)+ 1(EQUIL(3,JMOL)+(-EQUIL(4,JMOL)+(EQUIL(5,JMOL)-EQUIL(6,JMOL)* 2TPLUS)*TPLUS)*TPLUS)*TPLUS)+1.E-30 166 PFMIN(J)=EXP(-EQUIL(2,JMOL)+ 1(EQUIL(3,JMOL)+(-EQUIL(4,JMOL)+(EQUIL(5,JMOL)-EQUIL(6,JMOL)* 2TMINUS)*TMINUS)*TMINUS)*TMINUS)+1.E-30 LOCJ1=LOCJ(JMOL) LOCJ2=LOCJ(JMOL+1)-1 DO 170 LOCK=LOCJ1,LOCJ2 K=KCOMPS(LOCK) IF(K.EQ.NEQUA)GO TO 168 IF(K.GT.NEQUA)GO TO 180 ID=IDEQUA(K) DO 167 J=1,NRHOX T(J)=T(J)*1.001 TK(J)=TK(J)*1.001 TKEV(J)=TKEV(J)*1.001 CALL PFSAHA(J,ID,1,3,FRAC) PFPLUS(J)=PFPLUS(J)*FRAC(J,1) T(J)=T(J)/1.001*.999 TK(J)=TK(J)/1.001*.999 TKEV(J)=TKEV(J)/1.001*.999 CALL PFSAHA(J,ID,1,3,FRAC) PFMIN(J)=PFMIN(J)*FRAC(J,1) T(J)=T(J)/.999 TK(J)=TK(J)/.999 167 TKEV(J)=TKEV(J)/.999 GO TO 170 168 CONTINUE 170 CONTINUE DO 171 J=1,NRHOX 171 EDENS(J)=EDENS(J)+XNMOL(J,JMOL)*TK(J)* 1(-EQUIL(1,JMOL)/TKEV(J)+(PFPLUS(J)-PFMIN(J))/(PFPLUS(J)+ 2PFMIN(J))*2.*500.) GO TO 180 175 ID=CODE(JMOL) DO 177 J=1,NRHOX T(J)=T(J)*1.001 TK(J)=TK(J)*1.001 TKEV(J)=TKEV(J)*1.001 CALL PFSAHA(J,ID,NCOMP,5,PFP) T(J)=T(J)/1.001*.999 TK(J)=TK(J)/1.001*.999 TKEV(J)=TKEV(J)/1.001*.999 CALL PFSAHA(J,ID,NCOMP,5,PFM) T(J)=T(J)/.999 TK(J)=TK(J)/.999 TKEV(J)=TKEV(J)/.999 ION=NCOMP EDENS(J)=EDENS(J)+XNMOL(J,JMOL)*TK(J)* 1(EION(ION)/TKEV(J)+(PFP(ION)-PFM(ION))/(PFP(ION)+PFP(ION))* 22.*500.) 177 CONTINUE 180 CONTINUE DO 181 J=1,NRHOX 181 EDENS(J)=EDENS(J)/RHO(J) RETURN END