module trgraf_elvis

  implicit NONE
  save

  !  data module to support trgraf transmission of graphs to ElVis
  !  data for a single graph or display
  !  dmc 24 Aug 2004

  !  data type for 1 x-y dataset

  type :: xydata
     real*8, dimension(:), pointer :: x
     real*8, dimension(:), pointer :: y
     integer :: n
     integer :: itype
     character*32 :: name
  end type xydata

  !  list of x-y datasets that will be in the graph or display...
  type (xydata), dimension(:), pointer :: xylist, xylist_tmp
  integer :: nxy = 0
  integer :: nxy_max = 0

  !  general labels
  character*100 etitle            ! title (below graph area)
  integer, parameter :: max_emnlab = 6
  character*80 emnlab(max_emnlab) ! main labels (above graph area)
  integer :: n_emnlab = 0
  character*32 exuns,eyuns        ! x and y axes labels (typically "units")

  !  key box labels
  integer, parameter :: max_ekylab = 5
  character*20 ekylab(max_ekylab)
  integer :: n_ekylab = 0

  !  side labels -- arbitrary text for display to right of graph
  integer, parameter :: max_sidelab = 30
  character*60 :: esidelab(max_sidelab)
  integer :: n_sidelab = 0
  integer :: sidelab_len

  !  graph and window names
  character*64 ewname
  character*40 egname
  character*40 esname  ! short name

  integer :: lunmsg_elvis = 6
  integer, parameter :: max_msgs = 20
  integer :: num_msgs = 0
  character*256 msgs(max_msgs)

  contains

    subroutine expand

      !  create a longer xylist...

      integer :: i,ix1

      if(nxy_max.eq.0) then
         nxy_max=10
         ix1=1
         allocate(xylist(nxy_max))
      else
         ix1=nxy_max
         nxy_max = nxy_max*2
         allocate(xylist_tmp(nxy_max))
         xylist_tmp(1:ix1)=xylist
         deallocate(xylist)
         xylist => xylist_tmp
         nullify(xylist_tmp)
         ix1=ix1+1
      endif

      do i=ix1,nxy_max
         nullify(xylist(i)%x)
         nullify(xylist(i)%y)
         xylist(i)%n=0
         xylist(i)%itype=-1
         xylist(i)%name=' '
      enddo
    end subroutine expand

    subroutine xyclean

      integer :: i

      !  cleanup entries in xylist
      do i=1,nxy
         deallocate(xylist(i)%x)
         deallocate(xylist(i)%y)
         xylist(i)%n=0
         xylist(i)%itype=-1
         xylist(i)%name=' '
      enddo
    end subroutine xyclean

    subroutine clean_label(str)

      character*(*), intent(inout) :: str

      integer i,ii,ilen,iblank,i0,i1,i2
      character*1 char

      !----------------------

      ilen=len(str)
      iblank=ichar(' ')
      i0=0
      i1=0

      !  convert unprintables to blank; find limits of non-blank characters...
      do i=1,ilen

         if(ichar(str(i:i)).lt.iblank) then
            str(i:i)=' '
         endif

         if(str(i:i).ne.' ') then
            if(i0.eq.0) i0=i
            i1=i
         endif

      enddo

      !  non-blank length
      ilen=0
      if(i0.gt.0) then
         ilen=i1-i0+1
      endif

      !  left justification.  Also, remove redundant blanks...
      ii=0
      do i=1,ilen
         i2=i0+i-1
         if(str(i2:i2).eq.' ') then
            char=str(i2+1:i2+1)
            if((char.ne.' ').and.(char.ne.')').and.(char.ne.',').and. &
                 (char.ne.';').and.(char.ne.':')) then
               ii=ii+1
               str(ii:ii)=str(i2:i2)
            endif
         else
            ii=ii+1
            str(ii:ii)=str(i2:i2)
         endif
      enddo
      if(ii.lt.i1) then
         str(ii+1:i1)=' '
      endif

    end subroutine clean_label

    subroutine elvis_check(istat,sr)

      ! store message in case of status code

      integer, intent(in) :: istat     ! returned status code
      character*(*), intent(in) :: sr  ! subroutine or function identification

      if(istat.ne.1) then
         if(num_msgs.lt.max_msgs) then
            num_msgs = num_msgs + 1
         else
            msgs(max_msgs-1) = ' ... ... '
            num_msgs = max_msgs
         endif

         msgs(num_msgs) = ' '
         write(msgs(num_msgs),*) ' %ElVis call '//trim(sr)// &
              ' error status: ',istat
      endif

    end subroutine elvis_check

    subroutine elvis_error_report

      ! write out previously stored messages (if any)

      integer :: ii

      if(num_msgs.gt.0) then
         write(lunmsg_elvis,*) ' '
         write(lunmsg_elvis,*) ' ElVis API reported errors: '
         do ii=1,num_msgs
            write(lunmsg_elvis,*) trim(msgs(ii))
            msgs(ii)=' '
         enddo
      endif

      num_msgs = 0

    end subroutine elvis_error_report

end module trgraf_elvis
