PROGRAM MOLDECK
c     revised 18jan93
C     THIS IS AN ALTERNATE MAIN PROGRAM FOR ATLAS7 THAT PUNCHES OUT
C     MOLECULAR NUMBER DENSITIES/PARTITION FUNCTIONS FOR A MODEL.
C     THE PUNCH IS THEN APPENDED TO THE INPUT MODEL FOR SUBSEQUENT
C     INPUT TO XNFPELSYN OR SPECTR
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (kw=99)
      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 /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,6),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 /BMG/BMG1(kw,11),AMG1(kw),SMG1(kw),XNFPMG(kw,2),BMG2(kw,6)
      COMMON /BNA/BNA1(kw,3),XNFPNA(kw,1)
      COMMON /BO/BO1(kw,13),XNFPO(kw,1)
      COMMON /BSI/BSI1(kw,11),ASI1(kw),SSI1(kw),XNFPSI(kw,2),BSI2(kw,6)
      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),XABUND(99),WTMOLE
      COMMON /FLUX/FLUX,FLXERR(kw),FLXDRV(kw),FLXRAD(kw)
      COMMON /FREQ/FREQ,FREQLG,EHVKT(kw),STIM(kw),BNU(kw),WAVENO
      COMMON /FRESET/FRQEDG(200),WLEDGE(200),CMEDGE(200),DUM(399),
     1             NEDGE,NULO,NUHI,NUMNU,IFWAVE,WBEGIN,DELTAW
C     COMMON /FRESET/FRESET(500),RCOSET(500),NULO,NUHI,NUMNU,IFWAVE,
C    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/TITLE(74),FREQID(6),WLTE,XSCALE
      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),ITEMP,HCKT(kw)
      COMMON /TURBPR/VTURB(kw),PTURB(kw),TRBFDG,TRBCON,TRBPOW,TRBSND,
     1               IFTURB
      COMMON /XNMOL/NUMMOL,CODE(160),XNMOL(kw,160)                                     
      DIMENSION XNFP(kw)
      CALL READIN(20)
      DO 17 J=1,NRHOX
      IF(T(J).LT.8000.)GO TO 18
   17 CONTINUE
   18 NSTART=J
      IFSCAT=NSTART
      IFPRES=0
      IFPRES=1
      ITEMP=1
      IFMOL=1
      ITER=1
      CALL POPS(1.00D0,11,XNFPH)
      IFMOL=0
      IFPRES=0
      NSAVE=NRHOX
      NRHOX=NSTART-1
      ITEMP=2
      DO 140 JMOL=1,NUMMOL
      DO 130 J=1,NRHOX
  130 XNFP(J)=0.
      C=CODE(JMOL)
      IF(C.LT.100.)CALL POPS(C,1,XNFP)
      DO 135 J=1,NRHOX
  135 XNMOL(J,JMOL)=XNFP(J)
  140 CONTINUE
      NRHOX=NSAVE
      WRITE(6,150)
  150 FORMAT(1H120X38HNUMBER DENSITIES / PARTITION FUNCTIONS)
      WRITE(6,151)NUMMOL
      WRITE(7,151)NUMMOL
  151 FORMAT(I5,10H MOLECULES)
      DO 155 JMOL=1,NUMMOL
      WRITE(6,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX)
      WRITE(7,152)CODE(JMOL),(XNMOL(J,JMOL),J=1,NRHOX)
  152 FORMAT(F20.2/(1P8E10.3))
C 152 FORMAT(F20.2/(0P8E10.3))
  155 CONTINUE
      WRITE(6,158)(XNATOM(J),RHO(J),J=1,NRHOX)
      WRITE(7,158)(XNATOM(J),RHO(J),J=1,NRHOX)
  158 FORMAT(11H XNATOM,RHO/(1P8E10.3))
C 158 FORMAT(11H XNATOM,RHO/(0P8E10.3))
      WRITE(6,159)(XNE(J),J=1,NRHOX)
      WRITE(7,159)(XNE(J),J=1,NRHOX)
  159 FORMAT(4H XNE/(1P8E10.3))
      CALL EXIT
      END
      SUBROUTINE ATLAS7
      END