      PROGRAM XNFPELSYN
c     revised 13jul2015 to allow more molecules, parameter mm
c     revised 27may2015  BeO and BO replaced by NaH and KH
c     revised 04nov2014  constants given D exponents
C     revised 26jul2004  correction from Fiorella Castelli xnfpch and xnfpoh
c     revised 13jun00
C     PRODUCES XNFPEL AND DOPPLE FOR SYNTHE
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99,mw=139,mm=mw-39)
      PARAMETER (MAXMOL=200,MAX1=MAXMOL+1,MAXEQ=30,MAXLOC=3*MAXMOL)
      COMMON /ABROSS/ABROSS(kw),TAUROS(kw)
      COMMON /ABTOT/ABTOT(kw),ALPHA(kw)
      COMMON /BAL/BAL1(kw,9),AAL1(kw),SAL1(kw),XNFPAL(kw,2),BAL2(kw,1)
      COMMON /BB/BB1(kw,7),XNFPB(kw,1)
      COMMON /BC/BC1(kw,14),AC1(kw),SC1(kw),XNFPC(kw,2),BC2(kw,6)
      COMMON /BCA/BCA1(kw,8),BCA2(kw,5),XNFPCA(kw,2)
      COMMON /BFE/BFE1(kw,15),AFE1(kw),SFE1(kw),XNFPFE(kw,1)
      COMMON /BHE/BHE1(kw,29),AHE1(kw),SHE1(kw),BHE2(kw,6),AHE2(kw),
     1            SHE2(kw),AHEMIN(kw),SIGHE(kw),XNFPHE(kw,3),XNFHE(kw,2)
      COMMON /BHYD/BHYD(kw,8),AHYD(kw),SHYD(kw),AH2P(kw),BMIN(kw),
     1             AHMIN(kw),SHMIN(kw),SIGH(kw),SIGH2(kw),AHLINE(kw),
     2             SHLINE(kw),XNFPH(kw,2),XNFH(kw)
      COMMON /BK/BK1(kw,8),XNFPK(kw,1)
      COMMON /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6)
      COMMON /BNA/BNA1(kw,8),XNFPNA(kw,1)
      COMMON /BO/BO1(kw,13),XNFPO(kw,1),BO2(kw,4)
      COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,10)
      COMMON /CHOH/XNFPCH(kw),XNFPOH(kw)
      COMMON /CONV/DLTDLP(kw),HEATCP(kw),DLRDLT(kw),VELSND(kw),
     1             GRDADB(kw),HSCALE(kw),FLXCNV(kw),VCONV(kw),MIXLTH,
     2             IFCONV
      REAL*8 MIXLTH
      COMMON /ELEM/ABUND(99),ATMASS(99),ELEM(99)
      COMMON /XABUND/XABUND(99),WTMOLE
      character*2 elem
      COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO
      COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE,
     1               WBEGIN,DELTAW
      COMMON /HEIGHT/HEIGHT(kw)
      COMMON /IF/IFCORR,IFPRES,IFSURF,IFSCAT,IFMOL,NLTEON,IFOP(20)
      COMMON /ITER/ITER,IFPRNT(15),IFPNCH(15),NUMITS
      COMMON /JUNK/XSCALE,TITLE(74),FREQID(6),WLTE
      CHARACTER*1 title,FREQID
      CHARACTER*4 wlte
      COMMON /MUS/ANGLE(20),SURFI(20),NMU
      COMMON /OPS/ACOOL(kw),ALUKE(kw),AHOT(kw),SIGEL(kw),ALINES(kw),
     1            SIGLIN(kw),AXLINE(kw),SIGXL(kw),AXCONT(kw),SIGX(kw),
     2            SXLINE(kw),SXCONT(kw)
      COMMON /OPTOT/ACONT(kw),SCONT(kw),ALINE(kw),SLINE(kw),SIGMAC(kw),
     1              SIGMAL(kw)
      COMMON /PUT/PUT,IPUT
      COMMON /PZERO/PZERO,PCON,PRADK0,PTURB0,KNU(kw),PRADK(kw),EDENS(kw)
      REAL*8 KNU
      COMMON /RAD/ACCRAD(kw),PRAD(kw)
      COMMON /RHOX/RHOX(kw),NRHOX
      COMMON /STATE/P(kw),XNE(kw),XNATOM(kw),RHO(kw),PTOTAL(kw)
      COMMON /TAUSHJ/TAUNU(kw),SNU(kw),HNU(kw),JNU(kw),JMINS(kw)
      REAL*8 JNU,JMINS
      COMMON /TEFF/TEFF,GRAV,GLOG
      COMMON /TEMP/T(kw),TKEV(kw),TK(kw),HKT(kw),TLOG(kw),HCKT(kw),ITEMP
      COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND,
     1               IFTURB
      REAL*8 IDMOL(mm),MOMASS(mm)
      DIMENSION                    XNFH2(kw),XNFPH2(kw),XNFPCO(kw)
C     DIMENSION XNFH(kw),XNFHE(kw),XNFH2(kw),IFOUT(kw)
      DIMENSION XNFP(kw,10,mw),XNFPEL(6,mw),DOPPLE(6,mw)
      DIMENSION ABLOG(kw)
      DIMENSION WLEDGE(377),CMEDGE(377),FRQEDG(377)
      DIMENSION A(377),CONTINALL(1131,kw),FREQSET(1131),CONTABS(1131,kw)
      DIMENSION CONTSCAT(1131,KW)
      COMMON /FREE/NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW,WORD(6)
      COMMON /XNMOL/CODEMOL(MAXMOL),XNMOL(kw,MAXMOL),
     1              XNFPMOL(kw,MAXMOL),NUMMOL
      DIMENSION CARD(81)
      character*1 card,word
      DATA CARD/81*' '/
C     CHANGE PO TO H3+
C     MOLECULE INDICES
C         H2     CH     NH     OH     C2     CN     CO     N2     NO
C    1    240,   246,   252,   258,   264,   270,   276,   282,   288,
C
C         O2     MgH    AlH    SiH    MgO    AlO    SiO    SH     CaH
C    2    294,   300,   306,   312,   318,   324,   330,   336,   342,
C
C         SO     CaO    ScO    TiO    VO     LiH    BeH    BH     HF
C    3    348,   354,   360,   366,   372,   378,   384,   390,   396,
C
C         PH     HCl    ScH    TiH    VH     CrH    MnH    FeH    CH+   
C    4    402,   408,   414,   420,   426,   432,   438,   444,   450,  
C
C         NH+    OH+    MgH+   AlH+   SiH+   CaH+   NaH    KH     H3+      
C    5    456,   462,   468,   474,   480,   486,   492,   498,   504,
C
C         ClO    CrO    MnO    FeO    H2O    CO2    CH2    C3     CoH
C    6    510,   516,   522,   528,   534,   540,   546,   552,   558,
C
C         NiH    CuH    CoO    NiO    CuO    CO+    BeO    BO     PO
C    7    564,   570,   576,   582,   588,   594,   600,   606,   612,    
C
C         HO2   NaOH   MgOH   CaOH    CH2    NH2    SH2    C2H    HCN
C    8    618,   624,   630,   636,   642,   648,   654,   660,   666,    
C
C         HCO    HNO    COS    CS2    N2O    NO2   SiO2    SO2    CH3
C    9    672,   678,   684,   690,   696,   702,   708,   714,   720,
C
C         NH3   C2H2    CH4   SiH4    SiC   SiC2    C2N    C2N2   C3N       
C    A    726,   732,   738,   744,   750,   756,   762,   768,   774,
C
C         YO     ZrO    LaO
C    B    780,   786,   792,   798,   804,   810,   816,   822,   828,
C
C
C    C    834/
      DATA IDMOL/
     1   101.,  106.,  107.,  108.,  606.,  607.,  608.,  707.,  708.,
     2   808.,  112.,  113.,  114.,  812.,  813.,  814.,  116.,  120.,
     3   816.,  820.,  821.,  822.,  823.,  103.,  104.,  105.,  109.,
     4   115.,  117.,  121.,  122.,  123.,  124.,  125.,  126.,106.01,
C    5 107.01,108.01,112.01,113.01,114.01,120.01,  408.,  508.,  815.,
C    5 107.01,108.01,112.01,113.01,114.01,120.01,  408.,  508.,10101.01,
     5 107.01,108.01,112.01,113.01,114.01,120.01,  111.,  119.,10101.01,
     6   817.,  824.,  825.,  826.,10108.,60808.,10106.,60606.,  127.,
     7   128.,  129.,  827.,  828.,  829.,608.01,  408.,  508.,  815.,
     8 10808.,10811.,10812.,10820.,10106.,10107.,10116.,10606.,10607.,
     9 10608.,10708.,60816.,61616.,70708.,70808.,80814.,80816.,1010106.,
     A 1010107.,1010606.,101010106.,101010114., 614.,60614.,60607.,
     A 6060707.,6060607.,
     B   839.,  840.,  857.,    0.,    0.,    0.,    0.,    0.,    0.,
     C 0./
      DATA MOMASS/
     1     2.,   13.,   15.,   17.,   24.,   26.,   28.,   28.,   30.,
     2    32.,   25.,   28.,   29.,   40.,   43.,   44.,   33.,   41.,
     3    48.,   56.,   61.,   64.,   67.,    8.,   10.,   12.,   20.,
     4    32.,   36.,   46.,   49.,   52.,   53.,   56.,   57.,   13.,
c    5    15.,   17.,   25.,   28.,   29.,   41.,   25.,   27.,   47.,
c    5    15.,   17.,   25.,   28.,   29.,   41.,   25.,   27.,    3.,
     5    15.,   17.,   25.,   28.,   29.,   41.,   24.,   40.,    3.,
     6    51.,   68.,   71.,   72.,   18.,   44.,   14.,   36.,   60.,
     7    59.,   64.,   75.,   74.,   79.,   28.,   25.,   27.,   47.,
     8    33.,   30.,   31.,   57.,   14.,   16.,   34.,   25.,   27.,
     9    29.,   31.,   60.,   74.,   44.,   46.,   60.,   64.,   15.,
     A    17.,   26.,   16.,   32.,   40.,   52.,   38.,   52.,   50.,
     B   104.,  107.,  155.,  999.,  999.,  999.,  999.,  999.,  999.,
     C   999./
c      OPEN(UNIT=17,TYPE='OLD',READONLY,SHARED)
   10 CALL READIN(20)
      IFOP(14)=0
      IFOP(15)=0
      IFOP(16)=0
      IFOP(17)=0
      MORE=1
      MAXPOW=99
      LAST=81
      NUMCOL=1
      ITEMP=0
      IFPRES=0
      IFPRES=1
      ITER=1
      NUMITS=1
      NT=NRHOX
      REWIND 10
      WRITE(10)NT,TEFF,GLOG,TITLE
      IN=0
   11 EDGE=XFREEF(CARD)
      IF(EDGE.EQ.0.)GO TO 14
      IN=IN+1
      PRINT 15,IN,EDGE
      IF(ABS(EDGE).LT.1.D6)GO TO 12
      IF(ABS(EDGE).LT.1.D25)GO TO 13
C     WAVENUMBERS MUST BE MULTIPLIED BY 1.E25
      CMEDGE(IN)=EDGE/1.D25
      WLEDGE(IN)=1.D7/CMEDGE(IN)
      FRQEDG(IN)=2.99792458D17/WLEDGE(IN)
      A(IN)=ABS(WLEDGE(IN))
      GO TO 1111
   12 WLEDGE(IN)=EDGE
      CMEDGE(IN)=1.D7/EDGE
      FRQEDG(IN)=2.99792458D17/WLEDGE(IN)
      A(IN)=ABS(WLEDGE(IN))
      GO TO 1111
   13 FRQEDG(IN)=EDGE
      WLEDGE(IN)=2.99792458D17/EDGE
      CMEDGE(IN)=1.D7/WLEDGE(IN)
      A(IN)=ABS(WLEDGE(IN))
 1111 WRITE(6,15)IN,FRQEDG(IN),WLEDGE(IN),CMEDGE(IN)
   15 FORMAT(I5,1PE25.15,0PF20.7,F20.7)
      GO TO 11
   14 DO 17 LAST=2,IN
      LAST1=IN-LAST+2
      DO 16 I=2,LAST1
      IF(A(I).GE.A(I-1))GO TO 16
      SAVE=A(I-1)
      A(I-1)=A(I)
      A(I)=SAVE
      SAVE=FRQEDG(I-1)
      FRQEDG(I-1)=FRQEDG(I)
      FRQEDG(I)=SAVE
      SAVE=WLEDGE(I-1)
      WLEDGE(I-1)=WLEDGE(I)
      WLEDGE(I)=SAVE
      SAVE=CMEDGE(I-1)
      CMEDGE(I-1)=CMEDGE(I)
      CMEDGE(I)=SAVE
   16 CONTINUE
   17 CONTINUE
      WRITE(6,15)(I,FRQEDG(I),WLEDGE(I),CMEDGE(I),I=1,IN)
      WRITE(10)IN,(FRQEDG(I),WLEDGE(I),CMEDGE(I),I=1,IN),IDMOL,MOMASS
      NUMNU=0
      DO 18 I=1,IN-1
      NUMNU=NUMNU+1
      FREQSET(NUMNU)=ABS(FRQEDG(I))/1.0000001
      NUMNU=NUMNU+1
      FREQSET(NUMNU)=2.99792458D17/(ABS(WLEDGE(I))+ABS(WLEDGE(I+1)))*2.
      NUMNU=NUMNU+1
   18 FREQSET(NUMNU)=ABS(FRQEDG(I+1))*1.0000001
      WRITE(6,15)NUMNU
      WRITE(10)NUMNU,(FREQSET(NU),NU=1,NUMNU)
      ITEMP=ITEMP+1
      CALL POPS(1.00D0,12,XNFH)
      CALL POPS(2.01D0,12,XNFHE)
      CALL POPS(1.01D0,11,XNFPH)
      CALL POPS(2.02D0,11,XNFPHE)
      CALL POPS(5.00D0,11,XNFPB)
      CALL POPS(6.01D0,11,XNFPC)
      CALL POPS(8.00D0,11,XNFPO)
      CALL POPS(11.00D0,11,XNFPNA)
      CALL POPS(12.01D0,11,XNFPMG)
      CALL POPS(13.01D0,11,XNFPAL)
      CALL POPS(14.01D0,11,XNFPSI)
      CALL POPS(19.00D0,11,XNFPK)
      CALL POPS(20.01D0,11,XNFPCA)
      CALL POPS(26.00D0,11,XNFPFE)
C     26jul2004  correction from Fiorella Castelli
c      IF(IFMOL.EQ.1)CALL POPS(106.00D0,11,XNFPCH)
c      IF(IFMOL.EQ.1)CALL POPS(108.00D0,11,XNFPOH)
      IF(IFMOL.EQ.1)CALL POPS(106.00D0,1,XNFPCH)
      IF(IFMOL.EQ.1)CALL POPS(108.00D0,1,XNFPOH)
      DO 444 J=1,NRHOX
      XNFH2(J)=0.
      XNFPH2(J)=0.
      XNFPCO(J)=0.
C     IF(T(J).LT.10000.)XNFH2(J)=XNFH(J)**2*EXP(4.477/TKEV(J)-4.6628E1+
C    1(1.8031E-3+(-5.0239E-7+(8.1424E-11-5.0501E-15*T(J))*T(J))*T(J))*
C    2T(J)-1.5*TLOG(J))
C     IF(T(J).LT.9000.)XNFH2(J)=XNFH(J)**2*EXP(4.478/TKEV(J)-4.64584E1+
C    1(1.63660E-3+(-4.93992E-7+(1.11822E-10+(-1.49567E-14+
C    2(1.06206E-18-3.08720E-23*T(J))*T(J))*T(J))*T(J))*T(J))*T(J)-
C    3 1.5*TLOG(J))
      IF(T(J).GT.9000.)GO TO 444
      EQ=EXP(4.478D0/TKEV(J)-4.64584D1+
     1(1.63660D-3+(-4.93992D-7+(1.11822D-10+(-1.49567D-14+
     2(1.06206D-18-3.08720D-23*T(J))*T(J))*T(J))*T(J))*T(J))*T(J)-
     3 1.5*TLOG(J))
      XNFH2(J)=XNFH(J)**2*EQ
      XNFPH2(J)=XNFPH(J,1)**2*EQ
      EQ=EXP(4.478D0/TKEV(J)-4.64584D1+
     1(1.63660D-3+(-4.93992D-7+(1.11822D-10+(-1.49567D-14+
     2(1.06206D-18-3.08720D-23*T(J))*T(J))*T(J))*T(J))*T(J))*T(J)-
     3 1.5*TLOG(J))
      XNFPCO(J)=XNFPC(J,1)*XNFPO(J,1)*EXP(11.091E0/TKEV(J)-49.0414E0+
     1 14.0306D-4*T(J)-26.6341D-8*T(J)**2+35.382D-12*T(J)**3-
     2 26.5424D-16*T(J)**4+8.32385D-20*T(J)**5-1.5*TLOG(J))
  444 CONTINUE
  445 CONTINUE
      DO 125 NU=1,NUMNU
      FREQ=FREQSET(NU)
      FREQ15=FREQ/1.E15
      RCO=0.
      FREQLG= LOG(FREQ)
      DO 120 J=1,NRHOX
      EHVKT(J)=EXP(-FREQ*HKT(J))
      STIM(J)=1.-EHVKT(J)
  120 BNU(J)=1.47439D-02*FREQ15**3*EHVKT(J)/STIM(J)
      N=1
      WAVE=2.99792458D17/FREQ
      WAVENO=1.E7/WAVE
      CALL KAPP(N,NSTEPS,STEPWT)
      WRITE(6,15)NU,FREQ,WAVE,WAVENO
      DO 129 J=1,NRHOX
      ABTOT(J)=ACONT(J)+SIGMAC(J)
      CONTINALL(NU,J)=LOG10(ABTOT(J))
      CONTABS(NU,J)=LOG10(ACONT(J))
      CONTSCAT(NU,J)=LOG10(SIGMAC(J))
  129 ABLOG(J)= LOG10(ABTOT(J))
      WRITE(6,105)(ABLOG(J),J=1,NRHOX)
  105 FORMAT(1X,20F5.2)
C      WRITE(10)ABLOG
  125 CONTINUE
C
      WRITE(10)T,TKEV,TK,HKT,TLOG,HCKT,P,XNE,XNATOM,RHO,RHOX,VTURB,
     1XNFH,XNFHE,XNFH2
      DO 30 NELEM=1,99
      DO 30 ION=1,10
      DO 30 J=1,NRHOX
   30 XNFP(J,ION,NELEM)=0.
      CALL POPS(1.01D0,11,XNFP(1,1,1))
      CALL POPS(2.02D0,11,XNFP(1,1,2))
      CALL POPS(3.03D0,11,XNFP(1,1,3))
      CALL POPS(4.03D0,11,XNFP(1,1,4))
      CALL POPS(5.03D0,11,XNFP(1,1,5))
      CALL POPS(6.05D0,11,XNFP(1,1,6))
      CALL POPS(7.05D0,11,XNFP(1,1,7))
      CALL POPS(8.05D0,11,XNFP(1,1,8))
      CALL POPS(9.05D0,11,XNFP(1,1,9))
      CALL POPS(10.05D0,11,XNFP(1,1,10))
      CALL POPS(11.05D0,11,XNFP(1,1,11))
      CALL POPS(12.05D0,11,XNFP(1,1,12))
      CALL POPS(13.05D0,11,XNFP(1,1,13))
      CALL POPS(14.05D0,11,XNFP(1,1,14))
      CALL POPS(15.05D0,11,XNFP(1,1,15))
      CALL POPS(16.05D0,11,XNFP(1,1,16))
      CALL POPS(17.04D0,11,XNFP(1,1,17))
      CALL POPS(18.04D0,11,XNFP(1,1,18))
      CALL POPS(19.04D0,11,XNFP(1,1,19))
      CALL POPS(20.09D0,11,XNFP(1,1,20))
      CALL POPS(21.09D0,11,XNFP(1,1,21))
      CALL POPS(22.09D0,11,XNFP(1,1,22))
      CALL POPS(23.09D0,11,XNFP(1,1,23))
      CALL POPS(24.09D0,11,XNFP(1,1,24))
      CALL POPS(25.09D0,11,XNFP(1,1,25))
      CALL POPS(26.09D0,11,XNFP(1,1,26))
      CALL POPS(27.09D0,11,XNFP(1,1,27))
      CALL POPS(28.09D0,11,XNFP(1,1,28))
      DO 28 NELEM=29,99
   28 CALL POPS(FLOAT(NELEM)+.02D0,11,XNFP(1,1,NELEM))
      DO 2828 J=1,NRHOX
      XNFP(J,6,40)=XNFPH2(J)
 2828 XNFP(J,6,46)=XNFPCO(J)
      IF(IFMOL.EQ.0)GO TO 210
      IF(IFMOL.EQ.0)GO TO 210
      DO 201 NELEM=40,mw
  201 CALL POPS(IDMOL(NELEM-39),1,XNFP(1,6,NELEM))
  210 DO 250 J=1,NRHOX
      DO 250 NELEM=20,28
      XNFP(J,5,30+NELEM)=XNFP(J,7,NELEM)
      XNFP(J,5,40+NELEM)=XNFP(J,8,NELEM)
      XNFP(J,5,50+NELEM)=XNFP(J,9,NELEM)
  250 XNFP(J,5,60+NELEM)=XNFP(J,10,NELEM)
      DO 300 J=1,NRHOX
      DO 260 NELEM=1,mw
      DO 260 ION=1,6
  260 XNFPEL(ION,NELEM)=XNFP(J,ION,NELEM)
      DO 20 NELEM=1,99
      DOPPLE(1,NELEM)=SQRT(2.*TK(J)/ATMASS(NELEM)/1.660D-24+
     1VTURB(J)**2)/2.99792458D10
      DOPPLE(2,NELEM)=DOPPLE(1,NELEM)
      DOPPLE(3,NELEM)=DOPPLE(1,NELEM)
      DOPPLE(4,NELEM)=DOPPLE(1,NELEM)
      DOPPLE(5,NELEM)=DOPPLE(1,NELEM)
   20 DOPPLE(6,NELEM)=DOPPLE(1,NELEM)
      DO 21 NELEM=20,28
      DOPPLE(5,30+NELEM)=DOPPLE(1,NELEM)
      DOPPLE(5,40+NELEM)=DOPPLE(1,NELEM)
      DOPPLE(5,50+NELEM)=DOPPLE(1,NELEM)
   21 DOPPLE(5,60+NELEM)=DOPPLE(1,NELEM)
C      IF(IFMOL.EQ.0)GO TO 270
      DO 265 NELEM=40,99
  265 DOPPLE(6,NELEM)=SQRT(2.*TK(J)/MOMASS(NELEM-39)/1.660D-24+
     1VTURB(J)**2)/2.99792458D10
  270 CONTINUE
C
      IT=ITEMP
      IP=J
C
      WRITE(10)(CONTINALL(NU,J),NU=1,1131)
      WRITE(10)(CONTABS(NU,J),NU=1,1131)
      WRITE(10)(CONTSCAT(NU,J),NU=1,1131)
      WRITE(10)XNFPEL,DOPPLE
      WRITE(6,280)J
  280 FORMAT(18H0XNFPEL.....DOPPLE,I10)
      DO 29 NELEM=1,39
   29 WRITE(6,290)NELEM,(XNFPEL(ION,NELEM),ION=1,6),DOPPLE(1,NELEM)
  290 FORMAT(I5,1P6E12.4,5X,2E12.4,0PF14.2,I5)
      DO 33 NELEM=40,mw
      NELEM6=NELEM*6
   33 WRITE(6,290)NELEM,(XNFPEL(ION,NELEM),ION=1,6),DOPPLE(1,NELEM),
     1DOPPLE(6,NELEM),IDMOL(NELEM-39),NELEM6
      WRITE(6,333)T(J),TK(J),HKT(J),TKEV(J),TLOG(J),RHOX(J),P(J),
     1XNE(J),RHO(J),XNFH(J),XNFHE(J,1),XNFH2(J)
  333 FORMAT(10H0   T     ,1PE12.4,10H    TK    ,E12.4,10H    HKT   ,
     1E12.4,10H    TKEV  ,E12.4,10H    TLOG  ,E12.4/10H0   RHOX  ,
     2E12.4,10H    P     ,E12.4,10H    XNE   ,E12.4,10H    RHO   ,E12.4/
     3 10H0   XNFH  ,E12.4,10H    XNFHE ,E12.4,10H    XNFH2 ,E12.4)
  300 CONTINUE
      CALL EXIT
      END
      FUNCTION XFREEF(CARD)
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /FREE/NUMCOL,LETCOL,LAST,MORE,IFFAIL,MAXPOW,WORD(6)
      DIMENSION CARD(81)
      character*1 card,word
      MORE=1
      XFREEF=FREEFF(CARD)
c      write(6,66)xfreef,numcol,last
 66   format (1x,1pE12.4,2i10)
      IF(IFFAIL.EQ.0)RETURN
      L=LAST-1
      READ(17,1)(CARD(I),I=1,L)
    1 FORMAT(80A1)
      NUMCOL=1
      XFREEF=FREEFF(CARD)
c      write(6,666)xfreef
 666  format(10x,1pE10.3)
      RETURN
      END
