        subroutine PRPROD
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'INPAR.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      real OUT1(NTRAN),OUT2(NTRAN),TEST
      integer KNT,I,J,K,IPAGE,ITEST,IPASS, NUMBLK, EOF
     &, III, IV, VRAIL, IPOS, INUNIT, IMBED
      integer LOC1(NTRAN),LOC2(NTRAN),LOC3(NTRAN),LOC4(NTRAN)
      character CCHAR(2)*1, OUTLIN*64
      character REQFMT*41
      data REQFMT /'(1X,''Please enter Yes, No, or Quit-> ''  )'/
      data CCHAR/'1','0'/
      write (RPTLUN(MACHNO),5000) CCHAR(BATCH+1),VERSN,MODEG
      do 100 K = 1, KCHEM
         III = VRAIL(CHEMNA(1,K))
         write (RPTLUN(MACHNO),5010) K,(CHEMNA(IV,K),IV=1,III)
100   continue
      write (RPTLUN(MACHNO),5020)
5000  format (A1,'Exposure Analysis Modeling System -- EXAMS Version ', 
     &   F4.2,', Mode',I2)
5010  format (' Chemical:',I2,') ',50A1)
5020  format (1X,63('-'))
      write (RPTLUN(MACHNO),5030)
5030  format (' Table 2.  Chemical input data: product chemistry.'/1X,63
     &   ('-'))
      if (BATCH.gt.0) then
         III = VRAIL(PRODNM)
         write (RPTLUN(MACHNO),5040) (PRODNM(IV),IV=1,III)
5040     format (' Product Cat--',50A1)
      endif
      if (KCHEM.lt.2) go to 200
      do 110 I = 1, NTRAN
         LOC1(I) = 0
         LOC2(I) = 0
         LOC3(I) = 0
         LOC4(I) = 0
         OUT1(I) = 0.0
         OUT2(I) = 0.0
110   continue
      KNT = 0
      do 120 I = 1, NTRAN
         TEST = float(CHPARG(I)+TPRODG(I)+NPROCG(I)+RFORMG(I))+YIELDG(I)
     &      +EAYLDG(I)
         if (TEST.eq.0.0) go to 120
         KNT = KNT+1
         LOC1(KNT) = CHPARG(I)
         LOC2(KNT) = TPRODG(I)
         LOC3(KNT) = NPROCG(I)
         LOC4(KNT) = RFORMG(I)
         OUT1(KNT) = YIELDG(I)
         OUT2(KNT) = EAYLDG(I)
120   continue
      if (KNT.le.0) go to 200
      do 130 I = 1, NTRAN
         CHPARG(I) = LOC1(I)
         TPRODG(I) = LOC2(I)
         NPROCG(I) = LOC3(I)
         RFORMG(I) = LOC4(I)
         YIELDG(I) = OUT1(I)
         EAYLDG(I) = OUT2(I)
130   continue
      NUMBLK = 3
      if (BATCH.gt.0) NUMBLK = 2
      J = KNT
      K = 1
      IPASS = 1
      IPAGE = 0
      if (KNT.gt.5) J = 5
140   continue
      write (RPTLUN(MACHNO),5090) (LOC1(I),I=K,J)
      write (RPTLUN(MACHNO),5100) (LOC2(I),I=K,J)
      write (RPTLUN(MACHNO),5110) (LOC3(I),I=K,J)
      write (RPTLUN(MACHNO),5120) (LOC4(I),I=K,J)
      write (RPTLUN(MACHNO),5130) (OUT1(I),I=K,J)
      write (OUTLIN,5140) (OUT2(I),I=K,J)
      IPOS = 12
      do 150 I = K, J
         if (OUT2(I).eq.0.0) OUTLIN(IPOS:IPOS+9) = '         '
         IPOS = IPOS+10
150   continue
      write (RPTLUN(MACHNO),5050) OUTLIN
5050  format (A64)
      if (BATCH.gt.0) write (RPTLUN(MACHNO),5080) (I,I=K,J)
      KNT = KNT-5
      if (KNT.le.0) go to 210
      IPASS = IPASS+1
      IPAGE = IPAGE+1
      if (IPAGE.ne.NUMBLK) go to 190
      if (BATCH.eq.0) go to 170
160   continue
      write (TTYOUT(MACHNO),5060)
5060  format (/1X,'There are more; do you want to see them?')
      REQFMT(39:40) = CRSTOP(MACHNO)
      write (TTYOUT(MACHNO),REQFMT)
      INUNIT = TTYIN(MACHNO)
      call INREC (EOF,INUNIT,INPUT)
      if (EOF.eq.1) go to 210
      START = IMBED(INPUT,0)
      if (START.eq.-999) goto 170
      if (INPUT(START:START).eq.'Q'.or.INPUT(START:START).eq.'q'.or.
     &   INPUT(START:START).eq.'N'.or.INPUT(START:START).eq.'n')
     &    go to 210
      if (INPUT(START:START).eq.'Y'.or.INPUT(START:START).eq.'y') go to
     &   170
      write (TTYOUT(MACHNO),5070)
5070  format (/1X,'Response was not understood; Please try again.')
      go to 160
170   continue
      write (RPTLUN(MACHNO),5000) CCHAR(BATCH+1),VERSN,MODEG
      do 180 K = 1, KCHEM
         III = VRAIL(CHEMNA(1,K))
         write (RPTLUN(MACHNO),5010) K,(CHEMNA(IV,K),IV=1,III)
180   continue
      write (RPTLUN(MACHNO),5020)
      write (RPTLUN(MACHNO),5030)
      if (BATCH.gt.0) then
         III = VRAIL(PRODNM)
         write (RPTLUN(MACHNO),5040) (PRODNM(IV),IV=1,III)
      endif
      IPAGE = 0
190   continue
      K = 5*IPASS-4
      J = J+KNT
      ITEST = IPASS*5
      if (J.gt.ITEST) J = ITEST
      go to 140
5080  format ('  Pathway--',5(3X,I3,4X))
5090  format (/' CH PAR    ',5(3X,I3,4X))
5100  format (' T PROD    ',5(3X,I3,4X))
5110  format (' N PROC    ',5(3X,I3,4X))
5120  format (' R FORM    ',5(3X,I3,4X))
5130  format (' YIELD M/M ',1PG10.3,4G10.3)
5140  format (' EaYLD Kcal',1PG10.3,4G10.3)
200   continue
      if (BATCH.eq.0) then
         write (RPTLUN(MACHNO),5150)
5150     format (' No product chemistry specified.')
      else
         write (RPTLUN(MACHNO),5090)
         write (RPTLUN(MACHNO),5100)
         write (RPTLUN(MACHNO),5110)
         write (RPTLUN(MACHNO),5120)
         write (RPTLUN(MACHNO),5130)
         write (RPTLUN(MACHNO),5140)
         write (RPTLUN(MACHNO),5080)
      endif
      write (RPTLUN(MACHNO),5020)
210   continue
      return
      end
