      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
