subroutine tr_elvis_r4_table(row_label_hdr,nrows,row_labels, &
     ncols,col_hdr,precis,col_data, &
     ntop,top_text,nbottom,bottom_text,ierr)

  !  receive REAL*4 column data & encode for an ElVis table

  implicit NONE

  character*(*), intent(in) :: row_label_hdr  ! header of column of row labels
  integer, intent(in) :: nrows  ! number of rows
  character*(*), intent(in) :: row_labels(nrows)  ! row labels

  integer, intent(in) :: ncols  ! #columns (not counting column of row labels)
  character*(*), intent(in) :: col_hdr(ncols)     ! column header labels

  integer :: precis   ! encoding precision (#digits after decimal pt)
  real :: col_data(ncols,nrows) ! the data

  integer :: ntop     ! number of lines of text above table
  character*(*) top_text(ntop)

  integer :: nbottom  ! number of lines of text below tabloe
  character*(*) bottom_text(nbottom)

  integer, intent(out) :: ierr
  !--------------------------------------
  integer :: iprec,icol,irow
  character*15 col_data_ch(ncols,nrows)
  !--------------------------------------

  iprec = max(2,min(6,precis))

  col_data_ch = ' '

  do irow=1,nrows
     do icol=1,ncols
        if(iprec.eq.2) then
           write(col_data_ch(icol,irow),'(1pe9.2)') col_data(icol,irow)
        else if(iprec.eq.3) then
           write(col_data_ch(icol,irow),'(1pe10.3)') col_data(icol,irow)
        else if(iprec.eq.4) then
           write(col_data_ch(icol,irow),'(1pe11.4)') col_data(icol,irow)
        else if(iprec.eq.5) then
           write(col_data_ch(icol,irow),'(1pe12.5)') col_data(icol,irow)
        else if(iprec.eq.6) then
           write(col_data_ch(icol,irow),'(1pe13.6)') col_data(icol,irow)
        endif
     enddo
  enddo

  call tr_elvis_table(row_label_hdr,nrows,row_labels, &
     ncols,col_hdr,col_data_ch, &
     ntop,top_text,nbottom,bottom_text, &
     ierr)

end subroutine tr_elvis_r4_table

!========================================================================
subroutine tr_elvis_table(row_label_hdr,nrows,row_labels, &
     ncols,col_hdr,col_data, &
     ntop,top_text,nbottom,bottom_text,ierr)

  implicit NONE

  !  receive column data (character format); produce ElVis table
  !  NOTE: ncols > 26 not allowed!

  include 'ELVIS_H'

  character*(*), intent(in) :: row_label_hdr  ! header of column of row labels
  integer, intent(in) :: nrows  ! number of rows
  character*(*), intent(in) :: row_labels(nrows)  ! row labels

  integer, intent(in) :: ncols  ! #columns (not counting column of row labels)
  character*(*), intent(in) :: col_hdr(ncols)     ! column header labels

  character*(*) :: col_data(ncols,nrows) ! the data

  integer :: ntop     ! number of lines of text above table
  character*(*) top_text(ntop)

  integer :: nbottom  ! number of lines of text below tabloe
  character*(*) bottom_text(nbottom)

  integer, intent(out) :: ierr

  !--------------------------------------
  logical :: do_elvis
  integer :: icol,irow,istat,iline,ierloc
  character*64 wname
  character*40 tname,cname,cnama
  character*26 alphab
  data alphab/'abcdefghijklmnopqrstuvwxyz'/
  character*80 :: tline
  !--------------------------------------

  call trgraf_elvis_flag(do_elvis)
  if(.not.do_elvis) return

  if(nrows.lt.1) then
     write(6,*) ' ?tr_elvis_table: nrows = ',nrows
     ierr=1
     return
  endif

  if((ncols.lt.1).or.(ncols.gt.26)) then
     write(6,*) ' ?tr_elvis_table: ncols = ',ncols,' not in range 1:26.'
     ierr=1
     return
  endif

  call trgraf_tname_get(tname)  ! table name
  call trgraf_cname_get(cname)  ! prefix for column names

  ! be sure graph window is ready...
  call trgraf_wname_get(wname)
  istat = ef_graphwindowcreate(trim(wname), 1, 1)

  ! create table
  istat=ef_tableCreate(tname)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_tableCreate error.'
     ierr=1
     return
  endif

  istat = ef_graphwindowAddTable(wname, tname, 0, 0)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_graphwindowAddTable error.'
     ierr=1
     return
  endif

  ! add top and bottom text (to be displayed above & below table)

  ierr=0
  do iline=1,ntop
     if(top_text(iline).ne.' ') then
        call clean(top_text(iline),tline)
        if(iline.eq.1) then
           istat=ef_tableAddTopText(tname, trim(tline), &
                'SansSerif','Bold',12,'name: blue','name: white')
           if(istat.ne.E_SUCCESS) ierr=ierr+1
        else
           istat=ef_tableAddTopText(tname, trim(tline), &
                'SansSerif','Plain',12,'name: black','name: white')
           if(istat.ne.E_SUCCESS) ierr=ierr+1
        endif
     endif
  enddo

  if(ierr.ne.0) then
     write(6,*) ' ?tr_elvis_table: error in ef_tableAddTopText call.'
     return
  endif

  ierr=0
  do iline=1,nbottom
     if(bottom_text(iline).ne.' ') then
        call clean(bottom_text(iline),tline)
        if(iline.eq.1) then
           istat=ef_tableAddBottomText(tname, trim(tline), &
                'Serif','Bold',16,'name: blue','name: yellow')
           if(istat.ne.E_SUCCESS) ierr=ierr+1
        else
           istat=ef_tableAddBottomText(tname, trim(tline), &
                'SansSerif','Plain',12,'name: black','name: white')
           if(istat.ne.E_SUCCESS) ierr=ierr+1
        endif
     endif
  enddo

  if(ierr.ne.0) then
     write(6,*) ' ?tr_elvis_table: error in ef_tableAddBottomText call.'
     return
  endif


  ! add column of row labels

  cnama = trim(cname)//'_0'

  istat = ef_columnCreate(cnama,nrows,row_labels)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_columnCreate (row labels) failed.'
     ierr=1
     return
  endif

  istat = ef_columnSetHeader(cnama,row_label_hdr)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_columnSetHeader (row labels) failed.'
     ierr=1
     return
  endif

  istat = ef_columnsetFontName(cnama, "Serif")

  istat = ef_columnSetRowLabels(cnama,E_TRUE)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_columnSetRowLabels (T) failed.'
     ierr=1
     return
  endif

  istat = ef_columnsetbgcolor(cnama,'rgb: 1.0 0.925 0.925')

  istat = ef_tableAddColumn(tname,cnama)
  if(istat.ne.E_SUCCESS) then
     write(6,*) ' ?tr_elvis_table: ef_tableAddColumn (row labels) failed.'
     ierr=1
     return
  endif

  ! add columns

  do icol=1,ncols

     cnama = trim(cname)//'_'//alphab(icol:icol)

     istat = ef_columnCreate(cnama,nrows,col_data(icol,1:nrows))
     if(istat.ne.E_SUCCESS) then
        write(6,*) ' ?tr_elvis_table: ef_columnCreate failed: col_data #',icol
        ierr=1
        return
     endif

     istat = ef_columnSetHeader(cnama,col_hdr(icol))
     if(istat.ne.E_SUCCESS) then
        write(6,*) ' ?tr_elvis_table: ef_columnSetHeader failed: col_data #', &
             icol
        ierr=1
        return
     endif

     istat = ef_columnSetRowLabels(cnama,E_FALSE)
     if(istat.ne.E_SUCCESS) then
        write(6,*) ' ?tr_elvis_table: ef_columnSetRowLabels (F) failed.'
        ierr=1
        return
     endif

     istat = ef_columnsetFontName(cnama, "Monospaced")
     istat = ef_columnsetFontSize(cnama, 14)

     istat = ef_tableAddColumn(tname,cnama)
     if(istat.ne.E_SUCCESS) then
        write(6,*) ' ?tr_elvis_table: ef_tableAddColumn failed: col_data #', &
             icol
        ierr=1
        return
     endif

  enddo

  ierr = 0

  istat = ef_graphwindowdisplay(trim(wname))
  if(istat.ne.E_SUCCESS) then
     ierr = 1
     write(6,*) ' ?tr_elvis_table: graphWindowDisplay error.'
  endif

contains
  subroutine clean(iline,tline)

    character*(*), intent(in) :: iline
    character*(*), intent(out) :: tline

    ! remove leading blanks; replace consecutive whitespace characters with
    ! one single blank

    integer :: ia,ic,iblank,ilent
    character*1 :: ctab,blank

    ctab = char(9)
    blank = ' '

    ilent = len(tline)
    tline = ' '
    ia = 0

    do ic=1,len(iline)
       if(ia.eq.ilent) exit
       if((iline(ic:ic).eq.blank).or.(iline(ic:ic).eq.ctab)) then
          if(iblank.eq.0) then
             ia=ia+1
             tline(ia:ia)=blank
             iblank=1
          endif
       else
          iblank=0
          ia=ia+1
          tline(ia:ia)=iline(ic:ic)
       endif
    enddo

  end subroutine clean

end subroutine tr_elvis_table
