c
c     Copyright (c) 1999,2000, Compaq Computer Corporation
c
c     See the file "license.terms" for information on usage and redistribution
c     of this file, and for a DISCLAIMER OF ALL WARRANTIES.
c
c   2d comparison plot routines
c
      subroutine compare_2d
      implicit none
c
      include 'sysdep.cmn'
      include 'io.cmn'
c
c     local variables
c
      logical invalid
      integer string_len, mode
      character*10 answer
c
c     Reset color names back to x-y plot values
      call pm_set_xy_colornames
c
400   call clear_screen
      write(luttyo,300)
300   format(' ','Comparison contour plot:'//
     1    ' ','Add       - Add data to plot'/
     1    ' ','Clear     - Delete all data entries'/
     1    ' ','Delete    - Delete a data entry'/
     1    ' ','Exit      - Return to main menu'/
     1    ' ','List      - List all current data entries'/
     1    ' ','Plot      - Plot all current data entries'/
     1    ' ','Modify    - Change the plot attributes for an entry'/
     1    ' ','            or apply offsets and scale factors to data'/
     1    ' ','Quit      - Return to main menu (same as exit)'/
     1    ' ','Read      - Read new data file'/
     1    ' ','Show      - Print information about entry')
410   write(luttyo,305)
305   format(/' ','Request? ',$)
      read(luttyi,310) answer
310   format(a)
      call upcase(answer)
c
c     switch on answer
c
      invalid = .FALSE.
      if( answer(1:1) .eq. 'A' ) then
          call compare_add_2d
      else if( answer(1:1) .eq. 'C' ) then
          call compare_clear_2d
      else if( answer(1:1) .eq. 'D' ) then
          call compare_delete_2d
      else if( answer(1:1) .eq. 'E' ) then
          goto 10100
      else if( answer(1:1) .eq. 'L' ) then
          call compare_list_2d
      else if( answer(1:1) .eq. 'M' ) then
          call compare_modify_2d
      else if( answer(1:1) .eq. 'P' ) then
          call compare_plot_2d(.FALSE.,.FALSE.)
      else if( answer(1:1) .eq. 'Q' ) then
         goto 10100
      else if( answer(1:1) .eq. 'R' ) then
         call readbinfile
      else if( answer(1:1) .eq. 'S' ) then
          call compare_show_2d
      else if( string_len(answer) .eq. 0 ) then
          goto 10100
      else
         invalid = .TRUE.
      endif
c
      if( invalid ) then
         write(luttyo,390) answer
390      format(' ','Invaid request: ''',a,'''')
         goto 410
      else
         goto 400
      endif
c
c
c     the end of the road...
c
10100 continue
      return
      end
c*******************************************************************
c
      subroutine compare_2d_clear
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      include 'io.cmn'
c
c     locals
c
      character*1 answer
      integer i
c
      write(luttyo,100)
100   format(//' ','Warning: all data will be deleted.')
      call get_char(answer,'Type y to confirm: ',0)
      call upcase(answer)
      if( answer .ne. 'Y' ) return
c
c     Mark all data as erased
      do 10 i=1,MULTI_SIZE
         in_use_2d(i) = .FALSE.
         slot_index_2d(i) = -1
10       continue
      n_data_2d = 0
c
c     Tell compare menu routines that things have been reset
**      twod_lfirst = .TRUE.
c
      return
      end
c
c*******************************************************************
c
      subroutine compare_delete_2d
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      include 'io.cmn'
c
c     locals
c
      character*1 answer
      integer i, len, string_len, slot, entry, int_vec(2)
      integer delete_entry_2d, rcode
c
1000  call clear_screen
      write(luttyo,100)
100   format(' ','Data entries:'/
     1       ' ','Entry          Label'/)
      do 10 i=1,n_data_2d
         slot = slot_index_2d(i)
         len = string_len(multi_2d(slot)%label)
         write(luttyo,200) i, multi_2d(slot)%label(1:len)
200      format(' ',2x,i2,': ',a)
10       continue
      write(luttyo,201)
201   format(/)
c
      call get_ints(int_vec,1,'Which entry number to delete? ',0)
      entry = int_vec(1)
      call get_char(answer,'Type y to confirm: ',0)
      call upcase(answer)
      if( answer .eq. 'Y' ) then
         rcode = delete_entry_2d(entry)
         if( rcode .lt. 0 ) then
            write(luttyo,300) entry
300         format(' ','Error: ',i2,' is an illegal entry'/)
         endif
      endif
      call get_char(answer,'More entries to delete? (Y/N) ',0)
      call upcase(answer)
      if( answer .eq. 'Y' ) goto 1000
c
c     Reset menu/axis items if we've deleted all data
!!! Fix this later
!!!      if( n_data_2d .eq. 0 ) twod_lfirst = .TRUE.
c
      return
      end
c
c*******************************************************************
c
      subroutine compare_modify_2d
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
c
c     locals
c
      integer i, len, string_len, slot
c
c     Menu code items
      character*80 string
      character*3  yn
      integer      item_number
      logical      eof
c
100   call clear_screen
      call display_string(2 ,1 ,'Data entries:',13,0)
      call display_string(3, 1 ,'Entry   Selected  Label',23,0)
c
      do 10 i=1,n_data_2d
         slot = slot_index_2d(i)
         len = string_len(multi_2d(slot)%label)
         call pm_logical_to_str(multi_2d(slot)%selected, yn)
c        Avoid over-running 'string' (magic number depends on contents
c        of format statement 2000)
         len = MIN(62,len)
         write(string,2000) i, yn, multi_2d(slot)%label(1:len)
2000     format(1x,i2,7x,a3,5x,a)
         call display_string(i+3, 1 ,string,79,1)
10    continue
c
200   call display_prompt(
     1 'Enter number of entry to modify, or Repaint, Accept/Exit/Quit:')
      call read_from_input_area(string, eof)
      if( eof ) goto 200
      call upcase(string)
      if( string(1:1) .eq. 'A' .or. string(1:1) .eq. 'E' .or.
     1    string(1:1) .eq. 'Q' ) then
         goto 300
      elseif (string(1:1) .eq. 'R' ) then
         goto 100
      else
         read(string,*,err=1000) item_number
         if( item_number .lt. 1 .or. item_number .gt. n_data_2d ) then
            call display_message('Item number out of range')
            goto 200
         else
c           Bring up menu for that data slice
            call compare_modify_menu_2d(item_number)
            goto 100
         endif
      endif
      goto 200
c
1000  call display_message('Illegal input')
      goto 200
c
300   continue
c
      return
      end
c
      subroutine compare_modify_menu_2d(entry_id)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'units.cmn'
      include 'compare_2d.cmn'
      include 'defaults.cmn'
      include 'evaluate.cmn'
c
      integer entry_id
c
c     locals
      real ax, ay, az, mx, my, mz
      integer i, j, ierr, ind, ilen, string_len, nvar, npts
      real dummy_in(1,MAXCOLS), dummy_out
      real, allocatable :: tmp(:)
      logical have_x_expr, have_y_expr, have_z_expr, lcontour_error
      character*8  var_names(MAXCOLS)
c
c     Menu code items
      character*80 string, buf, msg
      character*32 temp_str
      character*3  str
      integer      item_number, int_vec(2), slot, istat, nvars
      real         real_vec(MAX_CONTOURS)
      logical      eof, reuse_last_input
c
c     Initialize
c
      slot = slot_index_2d(entry_id)
c
      if( string_len(multi_2d(slot)%x_expression) .ne. 0 ) then
         have_x_expr = .TRUE.
      else
         have_x_expr = .FALSE.
      endif
      if( string_len(multi_2d(slot)%y_expression) .ne. 0 ) then
         have_y_expr = .TRUE.
      else
         have_y_expr = .FALSE.
      endif
      if( string_len(multi_2d(slot)%z_expression) .ne. 0 ) then
         have_z_expr = .TRUE.
      else
         have_z_expr = .FALSE.
      endif
c
100   call clear_screen
      call display_string(1, 1,'   Plot attributes for entry ',29,0)
      call display_int   (1,30,entry_id,3)
      call display_string(3 ,1 ,' 1) Plot label          :',25,0)
      call display_string(4 ,1 ,' 2) Color contours      :',25,0)
      call display_string(5 ,1 ,' 3) Junctions           :',25,0)
      call display_string(6 ,1 ,' 4) Grid                :',25,0)
      call display_string(7 ,1 ,' 5) Label contours      :',25,0)
      call display_string(8 ,1 ,' 6) Black contour lines :',25,0)
      call display_string(9 ,1 ,' 7) Color materials     :',25,0)
      call display_string(10,1 ,' 8) X coord offset (AX) :',25,0)
      call display_string(11,1 ,' 9) X coord scale  (MX) :',25,0)
      call display_string(12,1 ,'10) Y coord offset (AY) :',25,0)
      call display_string(13,1 ,'11) Y coord scale  (MY) :',25,0)
      call display_string(14,1 ,'12) Z coord offset (AZ) :',25,0)
      call display_string(15,1 ,'13) Z coord scale  (MZ) :',25,0)
      call display_string(16,1 ,'14) X coord expression  :',25,0)
      call display_string(17,1 ,'15) Y coord expression  :',25,0)
      call display_string(18,1 ,'16) Z coord expression  :',25,0)
      call display_string(19,1 ,'17) Selected :',14,0)
c
      call display_string(4,45,'18) Contours',12,0)
c
      call display_string(3,26,multi_2d(slot)%label,50,1)
c
      call pm_logical_to_str(multi_2d(slot)%color, str)
      call display_string(4,27,str,3,1)
c
      call pm_logical_to_str(multi_2d(slot)%junctions, str)
      call display_string(5,27,str,3,1)
c
      call pm_logical_to_str(multi_2d(slot)%grid, str)
      call display_string(6,27,str,3,1)
c
      call pm_logical_to_str2(multi_2d(slot)%clabel, str,
     1                        multi_2d(slot)%color)
      call display_string(7,27,str,3,1)
c
      call pm_logical_to_str2(multi_2d(slot)%solid, str,
     1                        multi_2d(slot)%color)
      call display_string(8,27,str,3,1)
c
      call pm_logical_to_str2(multi_2d(slot)%colormat, str,
     1                        multi_2d(slot)%color)
      call display_string(9 ,27,str,3,1)
c
      if( have_x_expr ) then
         call display_string(10,26,'       NA',9,1)
         call display_string(11,26,'       NA',9,1)
         call display_string(16,27,multi_2d(slot)%x_expression,52,1)
      else
         call display_real(10,26,multi_2d(slot)%ax,1)
         call display_real(11,26,multi_2d(slot)%mx,1)
         call display_string(16,27,'(none)',6,1)
      endif
      if( have_y_expr ) then
         call display_string(12,26,'       NA',9,1)
         call display_string(13,26,'       NA',9,1)
         call display_string(17,27,multi_2d(slot)%y_expression,52,1)
      else
         call display_real(12,26,multi_2d(slot)%ay,1)
         call display_real(13,26,multi_2d(slot)%my,1)
         call display_string(17,27,'(none)',6,1)
      endif
c
      if( have_z_expr ) then
         call display_string(14,26,'       NA',9,1)
         call display_string(15,26,'       NA',9,1)
         call display_string(18,27,multi_2d(slot)%z_expression,52,1)
      else
         call display_real(14,26,multi_2d(slot)%az,1)
         call display_real(15,26,multi_2d(slot)%mz,1)
         call display_string(18,27,'(none)',6,1)
      endif
c
      call pm_logical_to_str(multi_2d(slot)%selected, str)
      call display_string(19,27,str,3,1)
c
      do i=1,multi_2d(slot)%num_contours
         call display_real(4+i, 45, multi_2d(slot)%contours(i), 1)
      end do
      do i=multi_2d(slot)%num_contours+1,MAX_CONTOURS
         call display_string(4+i, 45,'         ', 9, 0)
      end do
c
200   call display_prompt(
     1 'Enter number of item to modify, or Repaint, Accept/Exit/Quit:')
      if( reuse_last_input ) then
         reuse_last_input = .FALSE.
      else
         call read_from_input_area(string, eof)
      endif
      if( eof ) goto 200
      call upcase(string)
      if( string(1:1) .eq. 'A' .or. string(1:1) .eq. 'E' .or.
     1    string(1:1) .eq. 'Q' ) then
         goto 300
      elseif (string(1:1) .eq. 'R' ) then
         goto 100
      else
         read(string,*,err=1000) item_number
         if ( item_number .eq. 1 ) then
c           Label
            call get_string_with_prompt(multi_2d(slot)%label,
     1           'Enter label for curve')
            call display_string(3,21,multi_2d(slot)%label,50,1)
         else if ( item_number .eq. 2 ) then
c           Color contours
            multi_2d(slot)%color = .NOT. multi_2d(slot)%color
            call pm_logical_to_str(multi_2d(slot)%color, str)
            call display_string(4,27,str,3,1)
         else if ( item_number .eq. 3 ) then
c           Junctions
            multi_2d(slot)%junctions = .NOT. multi_2d(slot)%junctions
            call pm_logical_to_str(multi_2d(slot)%junctions, str)
            call display_string(5,27,str,3,1)
         else if ( item_number .eq. 4 ) then
c           Grid
            multi_2d(slot)%grid = .NOT. multi_2d(slot)%grid
            call pm_logical_to_str(multi_2d(slot)%grid, str)
            call display_string(6,27,str,3,1)
         else if ( item_number .eq. 5 ) then
c           Label contours
            if( multi_2d(slot)%color ) then
               call display_message(
     1            'Not applicable when using color contours')
            else
               multi_2d(slot)%clabel = .NOT. multi_2d(slot)%clabel
               call pm_logical_to_str(multi_2d(slot)%clabel, str)
               call display_string(7,27,str,3,1)
            endif
         else if ( item_number .eq. 6 ) then
c           Black contour lines
            if( multi_2d(slot)%color ) then
               call display_message(
     1            'Not applicable when using color contours')
            else
               multi_2d(slot)%solid = .NOT. multi_2d(slot)%solid
               call pm_logical_to_str(multi_2d(slot)%solid, str)
               call display_string(8,27,str,3,1)
            endif
         else if ( item_number .eq. 7 ) then
c           Color materials
            if( .NOT. multi_2d(slot)%color ) then
               call display_message(
     1            'Only applicable when using color contours')
            else
               multi_2d(slot)%colormat = .NOT. multi_2d(slot)%colormat
               call pm_logical_to_str2(multi_2d(slot)%colormat, str,
     1                                 multi_2d(slot)%color)
               call display_string(9,27,str,3,1)
            endif
         else if ( item_number .eq. 8 ) then
            if( have_x_expr ) then
               call display_message(
     1         'Both AX and X expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%ax
               call get_reals_with_prompt(real_vec,1,
     1           'Enter X coordinate offset (AX in formula: MX*x + AX)')
               multi_2d(slot)%ax = real_vec(1)
               call display_real(10,26,multi_2d(slot)%ax,1)
            endif
         else if ( item_number .eq. 9 ) then
            if( have_x_expr ) then
               call display_message(
     1         'Both AX and X expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%mx
               call get_reals_with_prompt(real_vec,1,
     1           'Enter X coordinate scale (MX in formula: MX*x + AX)')
               if( real_vec(1) .eq. 0.0 ) then
                  call display_message('MX must not be set to zero')
               else
                  multi_2d(slot)%mx = real_vec(1)
                  call display_real(11,26,multi_2d(slot)%mx,1)
               endif
            endif
         else if ( item_number .eq. 10 ) then
            if( have_y_expr ) then
               call display_message(
     1         'Both AY and Y expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%ay
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Y coordinate offset (AY in formula: MY*y + AY)')
               multi_2d(slot)%ay = real_vec(1)
               call display_real(12,26,multi_2d(slot)%ay,1)
            endif
         else if ( item_number .eq. 11 ) then
            if( have_y_expr ) then
               call display_message(
     1         'Both MY and Y expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%my
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Y coordinate scale (MY in formula: MY*y + AY)')
               if( real_vec(1) .eq. 0.0 ) then
                  call display_message('MY must not be set to zero')
               else
                  multi_2d(slot)%my = real_vec(1)
                  call display_real(13,26,multi_2d(slot)%my,1)
               endif
            endif
         else if ( item_number .eq. 12 ) then
            if( have_z_expr ) then
               call display_message(
     1         'Both AZ and Z expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%az
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Z data offset (AZ in formula: MZ*z + AZ)')
               multi_2d(slot)%az = real_vec(1)
               call display_real(14,26,multi_2d(slot)%az,1)
            endif
         else if ( item_number .eq. 13 ) then
            if( have_z_expr ) then
               call display_message(
     1         'Both MZ and Z expression cannot be specified')
            else
               real_vec(1) = multi_2d(slot)%mz
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Z data scale (MZ in formula: MZ*z + AZ)')
               if( real_vec(1) .eq. 0.0 ) then
                  call display_message('MZ must not be set to zero')
               else
                  multi_2d(slot)%mz = real_vec(1)
                  call display_real(15,26,multi_2d(slot)%mz,1)
               endif
            endif
         else if ( item_number .eq. 14 ) then
c           X axis expression
            call get_string_with_prompt(multi_2d(slot)%x_expression,
     1           'Enter expression to apply to x axis data '//
     2           '(e.g. 3.0*x**2 + sqrt(sin(x)) )')
            ilen = string_len(multi_2d(slot)%x_expression)
            if( ilen .eq. 0 ) then
               call display_string(16,27,'(none)',52,1)
               have_x_expr = .FALSE.
               call display_real(10,26,multi_2d(slot)%ax,1)
               call display_real(11,26,multi_2d(slot)%mx,1)
            else
c              Make a dummy evaluation to see if function is suitable
               dummy_in(1,1) = 1.0
               var_names(1) = 'x'
               call ev_expression_f(multi_2d(slot)%x_expression,
     1                        var_names,1,1,
     1                        dummy_in,1,
     1                        dummy_out,ierr,ind)
               if( ierr .ne. EVAL_SUCCESS ) then
                  call ev_lookup_error_message(ierr,buf)
                  msg = 'Error evaluating x axis expression: ' // buf
                  call display_message(msg)
               else
                  call display_string(16,27,
     1                                multi_2d(slot)%x_expression,52,1)
                  call display_string(10,26,'       NA',9,1)
                  call display_string(11,26,'       NA',9,1)
                  have_x_expr = .TRUE.
               endif
            endif
         else if ( item_number .eq. 15 ) then
c           Y axis expression
            call get_string_with_prompt(multi_2d(slot)%y_expression,
     1           'Enter expression to apply to y axis data '//
     2           '(e.g. 3.0*y**2 + sqrt(sin(y)) )')
            ilen = string_len(multi_2d(slot)%y_expression)
            if( ilen .eq. 0 ) then
               call display_string(17,27,'(none)',52,1)
               have_y_expr = .FALSE.
               call display_real(12,26,multi_2d(slot)%ay,1)
               call display_real(13,26,multi_2d(slot)%my,1)
            else
c              Make a dummy evaluation to see if function is suitable
               dummy_in(1,1) = 1.0
               var_names(1) = 'y'
               nvars = 1
               call ev_expression_f(multi_2d(slot)%y_expression,
     1                        var_names,nvars,1,
     1                        dummy_in,1,
     1                        dummy_out,ierr,ind)
               if( ierr .ne. EVAL_SUCCESS ) then
                  call ev_lookup_error_message(ierr,buf)
                  msg = 'Error evaluating y axis expression: ' // buf
                  call display_message(msg)
               else
                  call display_string(17,27,
     1                                multi_2d(slot)%y_expression,52,1)
                  call display_string(12,26,'       NA',9,1)
                  call display_string(13,26,'       NA',9,1)
                  have_y_expr = .TRUE.
               endif
            endif
         else if ( item_number .eq. 16 ) then
c           Z axis expression
            call get_string_with_prompt(multi_2d(slot)%z_expression,
     1           'Enter expression to apply to z axis data '//
     2           '(e.g. 3.0*z**2 + sqrt(sin(z)) )')
            ilen = string_len(multi_2d(slot)%z_expression)
            if( ilen .eq. 0 ) then
               call display_string(18,27,'(none)',52,1)
               have_z_expr = .FALSE.
               call display_real(14,26,multi_2d(slot)%az,1)
               call display_real(15,26,multi_2d(slot)%mz,1)
            else
c              Make a dummy evaluation to see if function is suitable
               nvars = 1 
               var_names(1) = 'z'
               dummy_in(1,1) = 1.0
               call ev_expression_f(multi_2d(slot)%z_expression,
     1                        var_names,nvars,1,
     1                        dummy_in,1,
     1                        dummy_out,ierr,ind)
               if( ierr .ne. EVAL_SUCCESS ) then
                  call ev_lookup_error_message(ierr,buf)
                  msg = 'Error evaluating z axis expression: ' // buf
                  call display_message(msg)
               else
                  call display_string(18,27,
     1                                multi_2d(slot)%z_expression,52,1)
                  call display_string(14,26,'       NA',9,1)
                  call display_string(15,26,'       NA',9,1)
                  have_y_expr = .TRUE.
               endif
            endif
         else if ( item_number .eq. 17 ) then
            multi_2d(slot)%selected = .NOT. multi_2d(slot)%selected
            call pm_logical_to_str(multi_2d(slot)%selected, str)
            call display_string(19,27,str,3,1)
         else if ( item_number .eq. 18 ) then
c           Set contours
            call display_prompt('Enter up to 9 contour values')
            call read_from_input_area(string, eof)
            if( .NOT. eof ) then
               call upcase(string)
               call parse_contours(string, MAX_CONTOURS,
     1              int_vec(1), real_vec, lcontour_error)
               if( lcontour_error ) then
                  call display_message(
     1            'Invalid contour specification')
               else
                  multi_2d(slot)%num_contours = int_vec(1)
                  do i=1,multi_2d(slot)%num_contours
                     multi_2d(slot)%contours(i) = real_vec(i)
                  end do
c                 Sort in ascending order (MUST BE DONE!!!)
                  call sort_contours(multi_2d(slot)%contours,
     1                               multi_2d(slot)%num_contours)
                  do i=1,multi_2d(slot)%num_contours
                     call display_real(4+i, 45,
     1                                 multi_2d(slot)%contours(i), 1)
                  end do
                  do i=multi_2d(slot)%num_contours+1,MAX_CONTOURS
                    call display_string(4+i, 45,'         ', 9, 0)
                  end do
               endif
            endif
         else
            call display_message('Item number out of range')
         endif
      endif
      goto 200
c
1000  call display_message('Illegal input')
      goto 200
c
300   continue
c
c     Re-scale data from raw information
c        Scale factors have to be converted to appropriate internal
c        units. mx is not converted, as it is unitless.
      ax = pm_scale_plot2cm*multi_2d(slot)%ax
      mx = multi_2d(slot)%mx
      ay = pm_scale_plot2cm*multi_2d(slot)%ay
      my = multi_2d(slot)%my
      az = multi_2d(slot)%az
      mz = multi_2d(slot)%mz
      if( multi_2d(slot)%data_is_trigrid ) then
         npts = multi_2d(slot)%tri_npts
      else
         npts = multi_2d(slot)%nx*multi_2d(slot)%ny
      endif
c
      if( string_len(multi_2d(slot)%x_expression) .ne. 0 .or.
     1    string_len(multi_2d(slot)%y_expression) .ne. 0 .or.
     1    string_len(multi_2d(slot)%z_expression) .ne. 0 ) then
c        Dynamically allocate temporary storage
c        Could we use work_vec() and avoid creating tmp? 12-21-98 jvf
         if( allocated(tmp) ) then
            deallocate(tmp)
         endif
         allocate(tmp(1:npts),stat=istat)
      endif
c
      if( string_len(multi_2d(slot)%x_expression) .ne. 0 ) then
         if( multi_2d(slot)%data_is_trigrid ) then
            do i=1,multi_2d(slot)%tri_npts
               tmp(i) = multi_2d(slot)%cord_raw(1,i)*pm_scale_cm2plot
            end do
            var_names(1) = 'x'
            call ev_expression_f(multi_2d(slot)%x_expression,var_names,
     1                           1,multi_2d(slot)%tri_npts,
     2                           tmp,multi_2d(slot)%tri_npts,
     3                           multi_2d(slot)%cord(1,1),ierr,ind)
         else
            do i=1,multi_2d(slot)%nx
               tmp(i) = multi_2d(slot)%raw_x(i)*pm_scale_cm2plot
            end do
            var_names(1) = 'x'
            call ev_expression_f(multi_2d(slot)%x_expression,var_names,
     1                           1,multi_2d(slot)%nx,
     2                           tmp,multi_2d(slot)%nx,
     3                           multi_2d(slot)%x,ierr,ind)
         endif
         if( ierr .ne. EVAL_SUCCESS ) then
            call ev_lookup_error_message(ierr,buf)
            msg = 'Error evaluating x axis expression: ' // buf
            call display_message(msg)
            goto 200
         endif
         if( multi_2d(slot)%data_is_trigrid ) then
            do i=1,multi_2d(slot)%tri_npts
               multi_2d(slot)%cord(1,i) = multi_2d(slot)%cord(1,i)*
     1                                    pm_scale_plot2cm
            end do
         else
            do i=1,multi_2d(slot)%nx
               multi_2d(slot)%x(i) = multi_2d(slot)%x(i)*
     1                                   pm_scale_plot2cm
            end do
         endif
      else
         if( multi_2d(slot)%data_is_trigrid ) then
            do i=1,npts
               multi_2d(slot)%cord(1,i) = 
     1            mx*multi_2d(slot)%cord_raw(1,i) + ax
            end do
         else
            do i=1,multi_2d(slot)%nx
               multi_2d(slot)%x(i)=mx*multi_2d(slot)%raw_x(i) + ax
            end do
         endif
      endif
c
      if( string_len(multi_2d(slot)%y_expression) .ne. 0 ) then
         if( multi_2d(slot)%data_is_trigrid ) then
           do i=1,multi_2d(slot)%tri_npts
              tmp(i) = multi_2d(slot)%cord_raw(2,i)*pm_scale_cm2plot
           end do
           var_names(1) = 'y'
           nvars = 1
           call ev_expression_f(multi_2d(slot)%y_expression,var_names,
     1                          nvars,multi_2d(slot)%tri_npts,
     2                          tmp,multi_2d(slot)%tri_npts,
     3                          multi_2d(slot)%cord(2,1),ierr,ind)
         else
           do i=1,multi_2d(slot)%ny
              tmp(i) = multi_2d(slot)%raw_y(i)*pm_scale_cm2plot
           end do
           var_names(1) = 'y'
           nvars = 1
           call ev_expression_f(multi_2d(slot)%y_expression,var_names,
     1                          nvars,multi_2d(slot)%ny,
     2                          tmp,multi_2d(slot)%ny,
     3                          multi_2d(slot)%y,ierr,ind)
         endif
         if( ierr .ne. EVAL_SUCCESS ) then
            call ev_lookup_error_message(ierr,buf)
            msg = 'Error evaluating y expression: ' // buf
            call display_message(msg)
            goto 200
         endif
         if( multi_2d(slot)%data_is_trigrid ) then
            do i=1,multi_2d(slot)%tri_npts
               multi_2d(slot)%cord(2,i) = multi_2d(slot)%cord(2,i)*
     1                                    pm_scale_plot2cm
            end do
         else
            do i=1,multi_2d(slot)%ny
               multi_2d(slot)%y(i) = multi_2d(slot)%y(i)*
     1                                   pm_scale_plot2cm
            end do
         endif
      else
         if( multi_2d(slot)%data_is_trigrid ) then
           do i=1,multi_2d(slot)%tri_npts
              multi_2d(slot)%cord(2,i) =
     1           my*multi_2d(slot)%cord_raw(2,i) + ay
           end do
         else
           do i=1,multi_2d(slot)%ny
              multi_2d(slot)%y(i) = my*multi_2d(slot)%raw_y(i) + ay
           end do
         endif
      endif
c
      if( string_len(multi_2d(slot)%z_expression) .ne. 0 ) then
         var_names(1) = 'z'
         nvars = 1
         call ev_expression_f(multi_2d(slot)%z_expression,var_names,
     1                        nvars,npts,
     2                        multi_2d(slot)%raw_data,npts,
     3                        multi_2d(slot)%data,ierr,ind)
         if( ierr .ne. EVAL_SUCCESS ) then
            call ev_lookup_error_message(ierr,buf)
            msg = 'Error evaluating z expression: ' // buf
            call display_message(msg)
            goto 200
         endif
       else
          do i=1,npts
             multi_2d(slot)%data(i) = mz*multi_2d(slot)%raw_data(i) + az
          end do
      endif
c
      if( allocated(tmp) ) then
         deallocate(tmp)
      endif
c
      return
      end
c
c*******************************************************************
c
      subroutine compare_list_2d
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      include 'io.cmn'
c
c     locals
c
      character*1 answer, mark
      integer i, len, string_len, slot
c
      call clear_screen
      write(luttyo,100)
100   format(' ','Data entries:'/
     1       ' ','Selected  Entry          Label'/)
c
      if( n_data_2d .eq. 0 ) then
         write(luttyo,150)
150      format(' ','No data has been selected')
      endif
c
      do 10 i=1,n_data_2d
         slot = slot_index_2d(i)
         len = string_len(multi_2d(slot)%label)
         if( multi_2d(slot)%selected ) then
c           Show as selected to plot
            mark = '*'
         else
            mark = ' '
         endif
         write(luttyo,200) mark, i, multi_2d(slot)%label(1:len)
200      format(' ',3x,a1,8x,i2,':  ',a)
10       continue
c
      write(luttyo,201)
201   format(/)
c
      call get_char(answer,'Hit return to continue...',0)
      return
      end
c
c*******************************************************************
c
      subroutine compare_show_2d
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      include 'data.cmn'
      include 'units.cmn'
      include 'defaults.cmn'
      include 'io.cmn'
c
c     locals
c
      character*1 answer, mark
      character*3 str
      integer i, len, ulen, string_len, slot, entry, int_vec(2)
c
      ulen = string_len(pm_length_unit)
c
1000  call clear_screen
      write(luttyo,100)
100   format(' ','Data entries:'/
     1       ' ','Selected  Entry          Label'/)
      do 10 i=1,n_data_2d
         slot = slot_index_2d(i)
         len = string_len(multi_2d(slot)%label)
         if( multi_2d(slot)%selected ) then
c           Show as selected to plot
            mark = '*'
         else
            mark = ' '
         endif
         write(luttyo,200) mark,i, multi_2d(slot)%label(1:len)
200      format(' ',3x,a1,8x,i2,':  ',a)
10       continue
      write(luttyo,101)
101   format(/)
c
      call get_ints(int_vec,1,'Which entry number to display? ',0)
      entry = int_vec(1)
      if( entry .lt. 1 .or. entry .gt. n_data_2d ) then
         write(luttyo,300) entry
300      format(' ','Error: ',i2,' is an illegal entry'/)
      else
         slot = slot_index_2d(entry)
         len = string_len(multi_2d(slot)%label)
         write(luttyo,400) multi_2d(slot)%label(1:len),
     1                multi_2d(slot)%quantity,
     1                multi_2d(slot)%units
         if( multi_2d(slot)%datatype .eq. DT_MINIMOS ) then
            write(luttyo,420) multi_2d(slot)%binfilename,
     1                multi_2d(slot)%cut_plane_coord*pm_scale_cm2plot,
     1                pm_length_unit(1:ulen),
     1                   multi_2d(slot)%misc_real(1),  ! vs
     1                   multi_2d(slot)%misc_real(2),  ! vg
     1                   multi_2d(slot)%misc_real(3),  ! vd
     1                   multi_2d(slot)%misc_real(4),  ! vb
     1                   multi_2d(slot)%misc_real(5),  ! id
     1                   multi_2d(slot)%misc_real(6),  ! is
     1                   multi_2d(slot)%misc_real(7),  ! ib
     1                   multi_2d(slot)%cut_plane_axis
         else
            write(luttyo,425) multi_2d(slot)%binfilename
         endif
         call pm_logical_to_str(multi_2d(slot)%color,str)
         write(luttyo,430) str
         call pm_logical_to_str(multi_2d(slot)%junctions,str)
         write(luttyo,431) str
         call pm_logical_to_str(multi_2d(slot)%grid,str)
         write(luttyo,432) str
         call pm_logical_to_str(multi_2d(slot)%clabel,str)
         write(luttyo,433) str
         call pm_logical_to_str(multi_2d(slot)%solid,str)
         write(luttyo,435) str
         call pm_logical_to_str(multi_2d(slot)%colormat,str)
         write(luttyo,436) str
         write(luttyo,450)
c
400      format(/' ','----------'/
     1           ' ','Label:'/
     1           ' ',a//
     1           ' ','Quantity: ',a/
     1           ' ','Units: ',a)
420      format( ' ','Taken from binary file:'/
     1           ' ',a//
     1           ' ','Cut plane at ',a1,' = ',1pg12.5,' ',a/
     1           ' ','Source voltage = ',f8.3/
     1           ' ','Gate   voltage = ',f8.3/
     1           ' ','Drain  voltage = ',f8.3/
     1           ' ','Bulk   voltage = ',f8.3//
     1           ' ','Drain  current  = ',1pe12.3/
     1           ' ','Source current  = ',1pe12.3/
     1           ' ','Bulk   current  = ',1pe12.3/
     1           ' ','----------')
425      format( ' ','Taken from data file:'/
     1           ' ',a//
     1           ' ','----------')
430      format( ' ','Color contours      : ',a)
431      format( ' ','Junctions           : ',a)
432      format( ' ','Grid                : ',a)
433      format( ' ','Label contours      : ',a)
435      format( ' ','Black contour lines : ',a)
436      format( ' ','Color materials     : ',a)
450      format( ' ','----------'//)
c
      endif
      call get_char(answer,'More entries to display? (Y/N) ',0)
      call upcase(answer)
      if( answer .eq. 'Y' ) goto 1000
c
      return
      end
c
c*******************************************************************
c
      subroutine compare_clear_2d
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      include 'io.cmn'
c
c     locals
c
      character*1 answer
      integer i
c
      write(luttyo,100)
100   format(//' ','Warning: all data will be deleted.')
      call get_char(answer,'Type y to confirm: ',0)
      call upcase(answer)
      if( answer .ne. 'Y' ) return
c
c     Mark all data as erased
      do while( n_data_2d .gt. 0 )
         call delete_entry_2d(1)
      end do
c
c     Tell 2d menu routines that things have been reset
!!! Fix this later
!!!      twod_lfirst = .TRUE.
c
      return
      end
c*******************************************************************
c
      integer function find_new_entry_2d()
      implicit none
c
c     Find empty slot in multi_2d to store data.c
c     Returns next entry number if there is room.
c     Returns -1 if no room.
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
c
c     locals
c
      integer i, slot, ierr
c
      slot = -1
      do 10 i=1, MULTI_SIZE
         if( .not. in_use_2d(i) ) then
            slot = i
            goto 20
         endif
10       continue
20    continue
      if( slot .ne. -1 ) then
c        Initialize record entries
c        Real data
c        Arrays are dynamically allocated, so they are not cleared here
         multi_2d(slot)%cut_plane_coord = 0.0
         multi_2d(slot)%ax    = 0.0
         multi_2d(slot)%mx    = 1.0
         multi_2d(slot)%ay    = 0.0
         multi_2d(slot)%my    = 1.0
         multi_2d(slot)%az    = 0.0
         multi_2d(slot)%mz    = 1.0
         do i=1,MAX_MISC_DATA
            multi_2d(slot)%misc_real(i) = 0.0
            multi_2d(slot)%misc_int(i)  = 0
         end do
         multi_2d(slot)%nx = 0
         multi_2d(slot)%ny = 0
         multi_2d(slot)%tri_npts = 0
         multi_2d(slot)%tri_ne   = 0
         multi_2d(slot)%tri_nreg = 0
         multi_2d(slot)%num_contours = 0
         multi_2d(slot)%datatype = 0
         do i=1,10
            multi_2d(slot)%contours(i) = 0.0
         end do
c        Integer data
         multi_2d(slot)%col_x    = 0
         multi_2d(slot)%col_y(1) = 0
         multi_2d(slot)%col_z    = 0
         multi_2d(slot)%record   = 0
         multi_2d(slot)%dimension = 0
         multi_2d(slot)%cut_plane_index = 0
         multi_2d(slot)%skip          = 0
         multi_2d(slot)%lines_to_read = 0
         multi_2d(slot)%n_ycols = 1
         multi_2d(slot)%bin_datatype = 1
c        Logical data
         multi_2d(slot)%selected  = .TRUE.
         multi_2d(slot)%color     = .TRUE.
         multi_2d(slot)%junctions = .FALSE.
         multi_2d(slot)%grid      = .FALSE.
         multi_2d(slot)%clabel    = .FALSE.
         multi_2d(slot)%solid     = .FALSE.
         multi_2d(slot)%log       = .FALSE.
         multi_2d(slot)%colormat  = .FALSE.
         multi_2d(slot)%data_is_trigrid = .FALSE.
c        Character data
         multi_2d(slot)%binfilename    = ' '
         do i=1,MAX_MISC_CH_DATA
            multi_2d(slot)%misc_ch(i)  = ' '
         end do
         multi_2d(slot)%x_expression   = ' '
         multi_2d(slot)%y_expression   = ' '
         multi_2d(slot)%z_expression   = ' '
         multi_2d(slot)%label          = ' '
         multi_2d(slot)%quantity       = ' '
         multi_2d(slot)%nickname       = ' '
         multi_2d(slot)%units          = ' '
         multi_2d(slot)%cut_plane_axis = 'Z'
c        mark new entry
         in_use_2d(slot) = .TRUE.
         n_data_2d = n_data_2d + 1
         multi_2d(slot)%selected = .TRUE.
         slot_index_2d(n_data_2d) = slot
         find_new_entry_2d = n_data_2d
      else
         find_new_entry_2d = -1
      endif
c
      return
      end
c
c*******************************************************************
c
      integer function delete_entry_2d(index)
      implicit none
c
c     Deletes slot in multi_2d array
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare_2d.cmn'
      integer index
c
c     locals
c
      integer i, slot
c
      if( index .lt. 1 .or. index .gt. n_data_2d ) then
c        Illegal index number...
         delete_entry_2d = -1
         return
      endif
c
c     Find slot number given plot index number
      slot = slot_index_2d(index)
      if ( .not. in_use_2d(slot) ) then
c        Already free
         delete_entry_2d = -2
         return
      else
c        Deallocate dynamic arrays
c        Note: during plot restore, we can allocate an entry and then
c        delete it without ever allocating the dynamic arrays
c        Data common to both meshes
         if( associated(multi_2d(slot)%data) ) then
            deallocate(multi_2d(slot)%data)
            deallocate(multi_2d(slot)%raw_data)
            deallocate(multi_2d(slot)%net_doping)
         endif
c        Rectangular mesh data
         if( associated(multi_2d(slot)%x) ) then
            deallocate(multi_2d(slot)%x)
            deallocate(multi_2d(slot)%y)
            deallocate(multi_2d(slot)%raw_x)
            deallocate(multi_2d(slot)%raw_y)
         endif
c        Triangular mesh data
         if( associated(multi_2d(slot)%cord) ) then
            deallocate(multi_2d(slot)%cord)
            deallocate(multi_2d(slot)%cord_raw)
            deallocate(multi_2d(slot)%imat)
            deallocate(multi_2d(slot)%tri2reg)
            deallocate(multi_2d(slot)%nop)
            deallocate(multi_2d(slot)%tri_nextel)
         endif
c        Move everyone up a notch.
         do 10 i=index, n_data_2d-1
            slot_index_2d(i) = slot_index_2d(i+1)
10       continue
         in_use_2d(slot) = .FALSE.  ! mark as empty
         slot_index_2d(n_data_2d) = -1
         n_data_2d = n_data_2d - 1
      endif
      delete_entry_2d = 0
      return
      end
c
      subroutine pm_logical_to_str(lvar, string)
      implicit none
c
      logical lvar
      character*(*) string
c
      if( lvar ) then
         string = 'yes'
      else
         string = 'no'
      endif
c
      end
c
      subroutine pm_logical_to_str2(lvar, string, na)
      implicit none
c
      logical lvar, na
      character*(*) string
c
      if( na ) then
         string = 'NA'
      else
         if( lvar ) then
            string = 'yes'
        else
            string = 'no'
         endif
      endif
c
      end
