      subroutine wrctbl( ierr,
     &                        iounit, title, units, ndim, ncod, icdlen,
     &                            codnam, codtit, npol, polnam, array )
c
c----------------------------------------------------------------------
c
c    writes a table of emissions by any character string code.  an array
c    of emissions by code and emissions species is printed. the argument
c    variables appear in the table as shown:
c
c                               title
c                               units
c
c        codtit       polnam(1)    polnam(2)    ...
c        --------------------------------------------------------------
c        codnam(1)    array(1,1)    array(1,2)  ...
c        codnam(2)    array(2,1)    array(2,2)  ...
c           .             .             .
c           .             .             .
c           .             .             .
c
c    Argument declaration.
c     Outputs:
c       ierr     I   error flag
c     Inputs:
c       iounit   I   logical unit number of file to write
c       title    C   title appearing above each table
c       units    C   character string for identifying units
c       ndim     I   declared first dimension of the array
c       ncod     I   actual number of codes
c       icdlen   I   length of character strings containing code names
c       codnam   C   character string of names of codes
c       codtit   C   character string for identifying the codes
c       npol     I   number of pollutants
c       polnam   C   array of pollutant names (can be criteria of cbiv)
c       array    R   two dimensional array of emissions values
c
c----------------------------------------------------------------------
c    LOG:
c----------------------------------------------------------------------
c
c      11/10/91  --gmw--  original development
c
c----------------------------------------------------------------------
c    Include files:
c----------------------------------------------------------------------
c
      include 'param.inc'
c
c----------------------------------------------------------------------
c    Argument declarations:
c----------------------------------------------------------------------
c
      integer*4     ierr
      integer*4     iounit
      character*80  title
      character*20  units
      integer*4     ndim
      integer*4     ncod
      integer*4     icdlen
      character*(*) codnam(ncod)
      character*(*) codtit
      integer*4     npol
      character*10  polnam(npol)
      real*4        array(ndim,npol)
c
c----------------------------------------------------------------------
c    External functions:
c----------------------------------------------------------------------
c
c   strlen    I     returns actual length of string
c
      integer*4 strlen
c
c----------------------------------------------------------------------
c    local parameters:
c----------------------------------------------------------------------
c
c   paglen  I  number of lines per page
c   pagwid  I  number of columns per page
c
      integer*4 paglen
      integer*4 pagwid
c
      parameter( paglen = 70 )
      parameter( pagwid = 132 )
c
c----------------------------------------------------------------------
c    Local variables:
c----------------------------------------------------------------------
c
c   string  C    trmporary character string for each line
c   blank   C    string for printing blanks
c   nper    I    number of pollutants per line (used to avoid the havin
c                just one pollutant on a line
c   ispcln  I    array for length of species names
c   ititln  I    length of title string
c   iunln   I    length of units string
c   ilencd  I    length of code title
c   ltot    L    flag for determining if the totals shuld be printed
c
      character*(pagwid) string, blank
      integer*4          nper, ispcln(MXSPEC), ititln, iunln, ilencd
      integer*4          ibegpl, iendpl, iwide
      integer*4          jlen, ibegcd, iendcd, ipos, i, j
      real*4             total(MXSPEC)
      logical            ltot
c
c----------------------------------------------------------------------
c   Data statements:
c----------------------------------------------------------------------
c
      data blank /' '/
c
c----------------------------------------------------------------------
c   Entry point:
c----------------------------------------------------------------------
c
c   --- set error flag ---
c
      ierr = IFAIL
c
c   --- compute length of strings ---
c
      ititln = strlen ( title, 80 )
      ititln = MAX(1,ititln)
      iunln = strlen ( units, 20 )
      ilencd = strlen ( codtit, icdlen)
      ltot = .true.
      if( ilencd .EQ. 0 ) ltot = .false.
      do 10 i=1,npol
         ispcln(i) = strlen ( polnam(i), 10 )
         total(i) = 0.
   10 continue
c
c   --- loop through pollutants, setting number per page ---
c
      nper = (pagwid - icdlen - 6)/12
  111 continue
      if( mod(npol,nper) .LE. 2 .AND. mod(npol,nper) .GT. 0) then
          nper = nper - 1
          goto 111
      endif
      do 20 ibegpl = 1,npol,nper
         iendpl = min(ibegpl+nper-1,npol)
c
c   ---- loop through codes, paglen number per page ---
c
         do 30 ibegcd=1,ncod,paglen
            iendcd = min(ibegcd+paglen-1,ncod)
            iwide = (iendpl-ibegpl+1)*12+icdlen+1
            iwide = MAX(iwide,ititln+1)
            iwide = MAX(iwide,iunln+1)
c
c   ---- print title and headings ---
c
            write(iounit,9001,ERR=7000) blank(1:(iwide-ititln)/2),
     &         title(1:ititln),blank(1:(iwide-iunln)/2), units(1:iunln)
            write(iounit,9002,ERR=7000) blank(1:(icdlen-ilencd)/2),
     &        codtit(1:ilencd),blank(1:icdlen-(icdlen-ilencd)/2-ilencd),
     &                (blank(1:(10-ispcln(i))/2),polnam(i)(1:ispcln(i)),
     &         blank(1:10-(10-ispcln(i))/2-ispcln(i)+2),i=ibegpl,iendpl)
            write(iounit,9003,ERR=7000) ('-',i=1,iwide)
c
c   ---- print emissions table ----
c
           do 40 i=ibegcd,iendcd
              string = blank
c
c   ---- if this code string is just a "$", then just print a blank line ---
c
              jlen = strlen(codnam(i),icdlen)
              if( jlen .EQ. 1 .AND. codnam(i)(1:1) .EQ. '$' ) then
                  write(iounit,9003,ERR=7000)
                  goto 40
              endif
c
              write(string(1:icdlen+3),9004,ERR=7000) codnam(i)
              do 50 j=ibegpl,iendpl
                  ipos = (j-ibegpl)*12+icdlen+4
                  if( array(i,j) .EQ. 0. ) then
                    write(string(ipos:ipos+11),9005,ERR=7000) array(i,j)
                  else
                    if( array(i,j) .GT. 10000.0 .OR.
     &                                 array(i,j) .LT. 0.0001 ) then
                       write(string(ipos:ipos+11),9006,ERR=7000)
     &                                                    array(i,j)
                    else
                       write(string(ipos:ipos+11),9007,ERR=7000)
     &                                                    array(i,j)
                    endif
                    total(j) = total(j) + array(i,j)
                  endif
   50         continue
              jlen = strlen ( string, pagwid )
              write(iounit,9008,ERR=7000) string(1:jlen)
   40      continue
   30    continue
c
c   --- write totals for each species ---
c
         write(iounit,9003,ERR=7000) ('-',i=1,iwide)
         if( .NOT. ltot ) goto 20
         string = blank
         string(1:icdlen+3) = ' Total  '
         do 60 j=ibegpl,iendpl
            ipos = (j-ibegpl)*12+icdlen+4
            if( total(j) .EQ. 0. ) then
              write(string(ipos:ipos+11),9005,ERR=7000) total(j)
            else
              if( total(j) .GT. 10000.0 .OR. total(j) .LT. 0.0001 ) then
                  write(string(ipos:ipos+11),9006,ERR=7000) total(j)
              else
                  write(string(ipos:ipos+11),9007,ERR=7000) total(j)
              endif
            endif
   60   continue
        jlen = strlen ( string, pagwid )
        write(iounit,9008,ERR=7000) string(1:jlen)
c
   20 continue
c
c  --- set error flag to success ---
c
      ierr = ISUCES
      goto 9999
c
c----------------------------------------------------------------------
c   Error messages:
c----------------------------------------------------------------------
c
 7000 continue
      write(IOWSTD,9000,ERR=9999) 'ERROR: Writing emissions ',
     &                                          'table to message file.'
      goto 9999
c
c----------------------------------------------------------------------
c   Format statements:
c----------------------------------------------------------------------
c
 9000 format(/,1x,a,a,a,/)
 9001 format('1',/,a,a,/,a,a)
 9002 format(/,1x,a,a,a,2x,30(:,a,a,a))
 9003 format(1x,250(:,a))
 9004 format(1x,a,2x)
 9005 format(4x,f3.0,5x)
 9006 format(1e10.3,2x)
 9007 format(f10.4,2x)
 9008 format(a)
c
c----------------------------------------------------------------------
c   Return point:
c----------------------------------------------------------------------
c
 9999 continue
      return
      end
