      subroutine TABD
      include 'SIZE.INC'
      include 'GLOBAL.INC'
      include 'LOCAL.INC'
      include 'UNITS.INC'
      include 'INPAR.INC'
      include 'LOCAL1.INC'
      include 'LOCAL2.INC'
      real OUT1(NCON), OUT2(NCON), OUT3(NCON), OUT4(6)
      integer LOC1(NCON),LOC2(NCON),NFIRST,NLAST,IMBED
      logical MEAN
      character KOUT*2, NMON*4, TAG*2
      common/TABLES/ OUT1, OUT2, OUT3, OUT4
     &, LOC1, LOC2, NFIRST, NLAST, MEAN
      common /TABLE2/ KOUT, NMON, TAG
      integer I, I1, IPAGE, IPASS, ITEST, J, K, KNT, NBLOCL, NUMBLK
      integer EOF, INUNIT, III, IV, VRAIL
      character CCHAR(2)*1
      character REQFMT*34
      data REQFMT/'(1X,''Enter Yes, No, or Quit-> ''  )'/
      data CCHAR/'1','0'/
5000  format (A1,'Exposure Analysis Modeling System -- EXAMS Version ', 
     &   F4.2,', Mode',I2/' Ecosystem: ',50A1)
5010  format (1X,63('-'))
5020  format (1X,A1,' Average of 12 monthly mean values.')
      if (BATCH.eq.0) then
         if (PRSWG.eq.1.and.MODEG.eq.3) then
            TAG(1:1) = ' '
            MEAN = .false.
         endif
      else
         NFIRST = MONTHG
         NLAST = MONTHG
         NBLOCL = MONTHG
         MEAN = .false.
         TAG(1:1) = ' '
         if (MONTHG.eq.13) TAG(1:1) = '*'
         NMON = NAMONG(MONTHG)
      endif
      III = VRAIL(ECONAM)
      do 200 NBLOCL = NFIRST, NLAST
         write (RPTLUN(MACHNO),5000) CCHAR(BATCH+1),VERSN,MODEG,(ECONAM(
     &      IV),IV=1,III)
         write (RPTLUN(MACHNO),5010)
         if (MODEG.ne.3.or.PRSWG.ne.1.or.BATCH.gt.0) go to 100
         NMON = NAMONG(NBLOCL)
         if (NBLOCL.eq.13) then
            MEAN = .true.
            TAG(1:1) = '*'
         endif
100      continue
         write (KOUT,5030) NBLOCL
5030     format (I2)
         if (KOUT(1:1).eq.' ') KOUT(1:1) = '0'
         write (RPTLUN(MACHNO),5040) KOUT,NMON
5040     format (' Table 10.',A2,'.  ',A4,' dispersive transport field.'
     &      )
         write (RPTLUN(MACHNO),5010)
         do 110 I = 1, NCON
            LOC1(I) = 0
            LOC2(I) = 0
            OUT1(I) = 0.0
            OUT2(I) = 0.0
            OUT3(I) = 0.0
110      continue
         KNT = 0
         do 140 I = 1, NCON
            if (JTURBG(I).eq.0.and.ITURBG(I).eq.0) go to 140
            KNT = KNT+1
            LOC1(KNT) = JTURBG(I)
            LOC2(KNT) = ITURBG(I)
            OUT1(KNT) = XSTURG(I)
            OUT2(KNT) = CHARLG(I)
            if (.not.MEAN) go to 130
            OUT3(KNT) = 0.0
            do 120 I1 = 1, 12
               OUT3(KNT) = OUT3(KNT)+DSPG(I,I1)
120         continue
            OUT3(KNT) = OUT3(KNT)/12.
            DSPG(I,13) = OUT3(KNT)
130         continue
            OUT3(KNT) = DSPG(I,NBLOCL)
140      continue
         do 150 I = 1, NCON
            JTURBG(I) = LOC1(I)
            ITURBG(I) = LOC2(I)
            XSTURG(I) = OUT1(I)
            CHARLG(I) = OUT2(I)
            DSPG(I,NBLOCL) = OUT3(I)
150      continue
         if (KNT.le.0) go to 210
         if (BATCH.gt.0) then
            NUMBLK = 2
         else
            NUMBLK = 3
         endif
         J = KNT
         K = 1
         IPASS = 1
         IPAGE = 0
         if (KNT.gt.5) J = 5
160      continue
         write (RPTLUN(MACHNO),5080) (LOC1(I),I=K,J)
         write (RPTLUN(MACHNO),5090) (LOC2(I),I=K,J)
         write (RPTLUN(MACHNO),5100) (OUT1(I),I=K,J)
         write (RPTLUN(MACHNO),5110) (OUT2(I),I=K,J)
         write (RPTLUN(MACHNO),5120) TAG(1:1),(OUT3(I),I=K,J)
         if (BATCH.gt.0) write (RPTLUN(MACHNO),5070) (I,I=K,J)
         KNT = KNT-5
         if (KNT.le.0) go to 200
         IPASS = IPASS+1
         IPAGE = IPAGE+1
         if (IPAGE.ne.NUMBLK) go to 190
         if (BATCH.eq.0) go to 180
         write (RPTLUN(MACHNO),5010)
         if (TAG(1:1).eq.'*') write (RPTLUN(MACHNO),5020) TAG(1:1)
170      continue
         write (TTYOUT(MACHNO),5050)
5050     format (/1X,'Do you want to see additional specifications?')
         REQFMT(32:33) = CRSTOP(MACHNO)
         write (TTYOUT(MACHNO),REQFMT)
         INUNIT = TTYIN(MACHNO)
         call INREC (EOF,INUNIT,INPUT)
         if (EOF.eq.1) go to 220
         START = IMBED(INPUT,0)
         if (START.eq.-999) go to 180
         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 220
         if (INPUT(START:START).eq.'Y'.or.INPUT(START:START).eq.'y') go
     &      to 180
         write (TTYOUT(MACHNO),5060)
5060     format (/1X,'Response was not understood; please try again.')
         go to 170
180      continue
         write (RPTLUN(MACHNO),5000) CCHAR(BATCH+1),VERSN,MODEG,(ECONAM(
     &      IV),IV=1,III)
         write (RPTLUN(MACHNO),5010)
         write (RPTLUN(MACHNO),5040) KOUT,NMON
         IPAGE = 0
190      continue
         K = 5*IPASS-4
         J = J+KNT
         ITEST = IPASS*5
         if (J.gt.ITEST) J = ITEST
         go to 160
200   continue
5070  format ('  Path No.:',3X,5(3X,I3,4X))
5080  format (/' J TURB    ',3X,5(3X,I3,4X))
5090  format (' I TURB    ',3X,5(3X,I3,4X))
5100  format (' XS TUR m2 ',3X,1PG10.3,4G10.3)
5110  format (' CHARL m   ',3X,1PG10.3,4G10.3)
5120  format (' DSP m2/hr',A1,3X,1PG10.3,4G10.3)
      write (RPTLUN(MACHNO),5010)
      if (TAG(1:1).eq.'*') write (RPTLUN(MACHNO),5020) TAG(1:1)
      go to 220
210   continue
      if (BATCH.eq.0) then
         write (RPTLUN(MACHNO),5130)
5130     format (' No dispersive transport field specified.')
      else
         write (RPTLUN(MACHNO),5080)
         write (RPTLUN(MACHNO),5090)
         write (RPTLUN(MACHNO),5100)
         write (RPTLUN(MACHNO),5110)
         write (RPTLUN(MACHNO),5120)
         write (RPTLUN(MACHNO),5070)
      endif
220   continue
      return
      end
