      subroutine writbl( ierr,
     &                        iounit, title, units, ndim, ncod,
     &                            icode, codtit, npol, polnam, array )
c
c----------------------------------------------------------------------
c
c    writes a table of emissions by any integer 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        icode(1)    array(1,1)    array(1,2)   ...
c        icode(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       icode    I   array of integer 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     icode(ncod)
      character*11  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 variables:
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 = 50 )
      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   strfmt  C    array of character strings for formatting the codes
c   idxfmt  I    index of array of format strings
c   imax    I    maximum integer code
c
      character*(pagwid) string, blank
      character*8        strfmt(11)
      integer*4          nper, ispcln(MXSPEC), ititln, iunln, ilencd
      integer*4          ibegpl, iendpl, idxfmt, imax
      integer*4          jlen, ibegcd, iendcd, ipos, jpos, i, j
      real*4             total(MXSPEC)
c
c----------------------------------------------------------------------
c   Data statements:
c----------------------------------------------------------------------
c
      data strfmt /'(1X,I1) ','(1X,I2) ','(1X,I3) ','(1X,I4) ',
     &             '(1X,I5) ','(1X,I6) ','(1X,I7) ','(1X,I8) ',
     &             '(1X,I9) ','(1X,I10)','(1X,I11)'/
      data blank /' '/
c
c----------------------------------------------------------------------
c   Entry point:
c----------------------------------------------------------------------
c
c   --- set error flag ----
c
      ierr = IFAIL
c
c   --- find maximum code for formatting ---
c
      imax = -9999999
      do 10 i=1,ncod
         if( icode(i) .GT. imax ) imax = icode(i)
   10 continue
c
c   --- determine which format strong will be used ---
c
      idxfmt = 11
      do 20 i=1,10
         if( imax/10**i .LT. 1 ) then
            idxfmt = i
            goto 111
         endif
   20 continue
c
c   --- compute length of strings ---
c
  111 continue
      ititln = strlen ( title, 80 )
      iunln = strlen ( units, 20 )
      ilencd = strlen ( codtit, 11)
      do 30 i=1,npol
         ispcln(i) = strlen ( polnam(i), 10 )
         total(i) = 0.
   30 continue
c
c   --- loop through pollutants, setting number per page ---
c
      nper = (pagwid - ilencd - 3)/12
  222 continue
      if( mod(npol,nper) .LE. 2 .AND. mod(npol,nper) .GT. 0) then
          nper = nper - 1
          goto 222
      endif
      do 40 ibegpl = 1,npol,nper
         iendpl = min(ibegpl+nper-1,npol)
c
c   ---- loop through codes, paglen number per page ---
c
         do 50 ibegcd=1,ncod,paglen
            iendcd = min(ibegcd+paglen-1,ncod)
c
c   ---- print title and headings ---
c
            write(iounit,9001,ERR=7000) blank(1:(pagwid-ititln)/2),
     &         title(1:ititln),blank(1:(pagwid-iunln)/2), units(1:iunln)
            ipos = (max(idxfmt,ilencd)-ilencd)/2+1
            write(iounit,9002,ERR=7000)blank(1:ipos),codtit(1:ilencd),
     &                       blank(1:ipos+1),(blank(1:(10-ispcln(i))/2),
     &                                          polnam(i)(1:ispcln(i)),
     &        blank(1:10-(10-ispcln(i))/2-ispcln(i)+2),i=ibegpl,iendpl)
            ipos = max(idxfmt,ilencd)
            write(iounit,9003,ERR=7000)
     &                          ('-',i=1,(iendpl-ibegpl+1)*12+ipos+1)
c
c   ---- print emissions table ----
c
           do 60 i=ibegcd,iendcd
              string = blank
              ipos = (max(ilencd,idxfmt)-idxfmt)/2+1
              write(string(ipos:ipos+idxfmt),strfmt(idxfmt),ERR=7000)
     &                                                         icode(i)
              do 70 j=ibegpl,iendpl
                  jpos = (j-ibegpl)*12+max(idxfmt,ilencd)+4
                  if( array(i,j) .EQ. 0. ) then
                    write(string(jpos:jpos+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(jpos:jpos+11),9006,ERR=7000)
     &                                                      array(i,j)
                    else
                        write(string(jpos:jpos+11),9007,ERR=7000)
     &                                                      array(i,j)
                    endif
                    total(j) = total(j) + array(i,j)
                  endif
   70         continue
              jlen = strlen ( string, pagwid )
              write(iounit,9008,ERR=7000) string(1:jlen)
   60      continue
   50    continue
c
c   --- write totals for each species ---
c
         string = blank
         ipos = max(idxfmt,ilencd)
         write(iounit,9003,ERR=7000)
     &                          ('-',i=1,(iendpl-ibegpl+1)*12+ipos+1)
         string(1:ipos+1) = ' Total'
         do 80 j=ibegpl,iendpl
            jpos = (j-ibegpl)*12+max(idxfmt,ilencd)+4
            if( total(j) .EQ. 0. ) then
              write(string(jpos:jpos+11),9005,ERR=7000) total(j)
            else
              if( total(j) .GT. 10000.0 .OR. total(j) .LT. 0.0001 ) then
                  write(string(jpos:jpos+11),9006,ERR=7000) total(j)
              else
                  write(string(jpos:jpos+11),9007,ERR=7000) total(j)
              endif
            endif
   80   continue
        jlen = strlen ( string, pagwid )
        write(iounit,9008,ERR=7000) string(1:jlen)
c
   40 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(/,a,a,a,30(:,a,a,a))
 9003 format(1x,250(:,a))
 9004 format(1x,a,2x)
 9005 format(4x,f3.0,5x)
 9006 format(1e10.4,2x)
 9007 format(f10.4,2x)
 9008 format(a)
c
c----------------------------------------------------------------------
c   Return point:
c----------------------------------------------------------------------
c
 9999 continue
      return
      end
