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
      subroutine compare_add
      implicit none
c
c     Select a 1D cut of data, store in an entry in multi_1d
c
c     Programmer: John Faricelli
c     Date: 9-Oct-85
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'bincodes.cmn'
      include 'compare.cmn'
      include 'user.cmn'
c
c     locals
c
      real dummy(2)
      integer answer, entry, find_new_entry, string_len, icut
      logical error
      character*1  cut_char
      character*10 buffer
      character*80 errfmt
c
      errfmt = '('' '')'
c
      if( max_menu_num .eq. 1 ) then
c        Load Grapes data, if needed...
         if( binfiletype .eq. DT_GRAPES ) then
            call pm_select_grapes_data(error)
            if( error ) return
         endif
c        Load SPICE3 data, if needed...
         if( binfiletype .eq. DT_SPICE3 ) then
            call pm_select_spice3_data(error)
            if( error ) return
         endif
         if( data_is_trigrid ) then
            call store_line_tri(arrdat(arrind(menu_to_arr(1))),
     1                   ARR2DSIZE, does_data_jump_at_oxide(1),
     2                   data_name(1), data_nickname(1),
     3                   data_units(1), is_data_log(1))
         else if( is_data_1d(1) ) then
c           Route directly to routine which stores cut line data
            entry = find_new_entry()
            if( entry .eq. -1 ) then
               call clear_screen
               call beep_terminal
               write(luttyo,100)
100            format(' ','Error: all data slots used up'/
     1                ' ','Delete some curves to free up space'/
     2                ' ','Hit return to continue...')
               read(luttyo,105,end=300,err=300) buffer
            else
               if( data_nickname(1) .eq. 'ASCII' ) then
                  icut = COMP_USER_TYPE
                  cut_char = '?'
c                 Remember, unscaled data is stored in positions 2 and 3
                  call store_in_slot(entry, arr2d(1,3),
     1              ni, arr2d(1,2), 0.0, cut_char,
     2              data_name(1), data_nickname(1),
     3              data_units(1), icut, dummy, is_data_log(1))
               else
                  icut = COMP_CUT_TYPE
                  cut_char = charv
                  call store_in_slot(entry, arr2d(1,menu_to_arr(1)),
     1              ni, xyz(1,idisti), 0.0, cut_char,
     2              data_name(1), data_nickname(1),
     3              data_units(1), icut, dummy, is_data_log(1))
               endif
            endif
         else
            call store_line(arrdat(arrind(menu_to_arr(1))),
     1                   ni, nj, does_data_jump_at_oxide(1),
     2                   data_name(1), data_nickname(1),
     3                   data_units(1), is_data_log(1))
         endif
         return
      endif
c
200   call clear_screen
      write(luttyo,errfmt)
      errfmt = '('' '')'
      call write_data_menu('Select and store 1D cross section:')
      write(luttyo,105)
105   format(/' ','Request? ',$)
      read(luttyi,106,err=300,end=300) buffer
106   format(a)
      call upcase(buffer)
      if( string_len(buffer) .eq. 0 ) then
         answer = EXIT_MENU
      else if( buffer(1:1) .eq. 'Q' .or.  buffer(1:1) .eq. 'E' ) then
         answer = EXIT_MENU
      else
         read(buffer,*,err=300) answer
      endif
c
c    Error check:
c       1) Exit menu
c       2) Answer in range
c       3) Is requested data in binary file?
c
      if( answer .eq. EXIT_MENU ) then
         goto 1000
      else if( answer .lt. 1 .or. answer .gt. max_menu_num ) then
         errfmt = '('' '',''Invalid input: Please try again...'')'
         call beep_terminal
      else if( .NOT. in_binary_file(answer) ) then
         errfmt = '('' '',''Data not available from binary file'')'
         call beep_terminal
      else if( is_data_1d(answer) ) then
c        Route directly to routine which stores cut line data
         entry = find_new_entry()
         if( entry .eq. -1 ) then
            errfmt = '('' '',''Error: all data slots used up'')'
            call beep_terminal
         else
            if( data_nickname(answer) .eq. 'ASCII' ) then
               icut = COMP_USER_TYPE
               cut_char = '?'
            else
               icut = COMP_CUT_TYPE
               cut_char = charv
            endif
            call store_in_slot(entry, arr2d(1,menu_to_arr(answer)),
     1           ni, xyz(1,idisti), 0.0, cut_char,
     2           data_name(answer), data_nickname(answer),
     3           data_units(answer), icut, dummy,
     4           is_data_log(answer))
         endif
      else if( data_is_trigrid ) then
         call store_line_tri(arrdat(arrind(menu_to_arr(answer))),
     1                   ARR2DSIZE,
     1                   does_data_jump_at_oxide(answer),
     2                   data_name(answer), data_nickname(answer),
     3                   data_units(answer), is_data_log(answer))
      else
         call store_line(arrdat(arrind(menu_to_arr(answer))),
     1                   ni, nj, does_data_jump_at_oxide(answer),
     2                   data_name(answer), data_nickname(answer),
     3                   data_units(answer), is_data_log(answer))
      endif
      goto 200
c
c     illegal input
300   errfmt = '('' '',''Invalid input: Please try again...'')'
      call beep_terminal
      goto 200
c
1000  continue
      return
      end
c
      subroutine store_line(data_array, max_h, max_v,
     1                      discontinuity, quantity, nickname, units,
     2                      do_log)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'compare.cmn'
      include 'units.cmn'
c
      integer V_CUT, H_CUT
      parameter (V_CUT = 1, H_CUT = 2)
c
      integer max_h, max_v
      logical discontinuity, do_log
      real data_array(max_h, max_v)
      character*(*) quantity, nickname, units
c
c     locals
c
      real value, real_vec(10), dummy(2)
      real line1(COMP_ARRAYSIZE), line2(COMP_ARRAYSIZE),
     1     result(COMP_ARRAYSIZE)
      integer entry, find_new_entry, ulen, string_len
      integer type, index
      integer i, j
      logical ldum
      character*1 answer, discont_type
c
      integer getindex  ! function
c
      ldum = .FALSE.
      ulen = string_len(pm_length_unit)
c
c     check for available entry in multi-1d
      entry = find_new_entry()
      if( entry .eq. -1 ) then
         write(luttyo,10)
10       format(' ','Error: all data slots used up'/
     1          ' ','Use Clear or Delete to free up space')
         call get_char(answer,'Hit return to continue...',0)
         return
      endif
c
c     Ask user for H or V line
99    call get_char(answer,
     1   'Plot along a vertical or horizontal line (V or H)? ',0)
      call upcase(answer)
      if ( answer .eq. 'V' ) then
         type = V_CUT
      else if ( answer .eq. 'H' ) then
         type = H_CUT
      else
         write(luttyo,102) answer
102      format(' ','Invalid response: ', a)
         goto 99
      endif
c
c     Ask user for line value to print
c
200   if( type .eq. V_CUT ) then
         write(luttyo,110) charh, pm_scale_cm2plot*xyz(1,idisti),
     1                charh, pm_scale_cm2plot*xyz(ni,idisti)
110      format(' ','Minimum ',a1,' = ',1pg12.5,
     1              '; Maximum ',a1,' = ',1pg12.5)
      else
         write(luttyo,110) charv, pm_scale_cm2plot*xyz(1,idistj),
     1                charv, pm_scale_cm2plot*xyz(nj,idistj)
       endif
c
      call get_reals(real_vec,1,
     1   'Enter coordinate of cut line in '// pm_length_unit(1:ulen)
     1   // ': ',0)
      value = real_vec(1)*pm_scale_plot2cm
c
c     warn user if he selects a quantity that has a discontinuity
c     at the oxide and semiconductor interface...
      if( type .eq. H_CUT .and. value .eq. 0.0 .and.
     1   (plane_type .eq. XY_PLANE .or. plane_type .eq. YZ_PLANE)
     1                    .and. discontinuity ) then
135      write(luttyo,136)
136      format(' ','Warning: field is discontinuous at y=0.0'/
     1   ' ','Do you want field at closest line in oxide (O) ',
     1       'or semiconductor (S) ? ',$)
         read(luttyi,138) discont_type
138      format(a1)
         call upcase(discont_type)
         if( discont_type .ne. 'O' .and. discont_type .ne. 'S') then
            write(luttyo,137) discont_type
137         format(' ','Illegal response: ',a)
            goto 135
         endif
      endif
c
c     get equivalent index in array
      if( type .eq. V_CUT ) then     ! vertical cut
         index = getindex(value, xyz(1,idisti), ni)
      else
         index = getindex(value, xyz(1,idistj), nj) ! horizontal cut
      endif
      if( index .eq. 0 ) then
         write(luttyo,140) value
140      format(' ','Value ',1pe10.3,' not in array bounds')
         goto 200
      endif
c
      if( type .eq. V_CUT ) then
         do 210 j=1,nj
            line1(j) = data_array(index,j)
            line2(j) = data_array(index+1,j)
210         continue
         call interp_line(line1, line2, result, nj,
     1      xyz(index,idisti), xyz(index+1,idisti), value)
            call store_in_slot(entry, result, nj, xyz(1,idistj),
     1           value, charh,
     2           quantity, nickname, units, COMP_CUT_TYPE, dummy,
     3           do_log)
      else
         if( discont_type .eq. 'O' ) then
c           special handling of interface...
c           User wants oxide value, take one step up into oxide
            index = index - 1
            value = xyz(index,idistj)
         endif
         do 220 i=1,ni
            line1(i) = data_array(i,index)
            line2(i) = data_array(i,index+1)
220         continue
         call interp_line( line1, line2, result, ni,
     1      xyz(index,idistj), xyz(index+1,idistj), value)
         call store_in_slot(entry, result, ni, xyz(1,idisti),
     1        value, charv,
     2        quantity, nickname, units, COMP_CUT_TYPE, dummy,
     3        do_log)
      endif
      return
      end
c
      subroutine store_line_tri(data_array, array_size,
     1                     discontinuity, quantity, nickname, units,
     2                     do_log)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'io.cmn'
      include 'compare.cmn'
      include 'units.cmn'
c
      integer V_CUT, H_CUT
      parameter (V_CUT = 1, H_CUT = 2)
c
      integer array_size
      logical discontinuity, do_log
      real data_array(array_size)
      character*(*) quantity, nickname, units
c
c     locals
c
      real cut_line_coord, real_vec(2), dummy(2), dmin, dmax
      real tmp(4*COMP_ARRAYSIZE,2)
      integer entry, find_new_entry, ulen, string_len, np
      integer type
      logical ldum, lerr, along_oxide, value_in_oxide
      character*1 answer, cutchar
c
      ldum = .FALSE.
      ulen = string_len(pm_length_unit)
c
c     check for available entry in multi-1d
      entry = find_new_entry()
      if( entry .eq. -1 ) then
         write(luttyo,10)
10       format(' ','Error: all data slots used up'/
     1          ' ','Use Clear or Delete to free up space')
         call get_char(answer,'Hit return to continue...',0)
         return
      endif
c
c     Ask user for x or y line
99    call get_char(answer,
     1   'Plot along a vertical or horizontal line (V or H)? ',0)
      call upcase(answer)
      if ( answer .eq. 'V' ) then
         type = V_CUT
         cutchar = charh
         dmin = xyzlimits(1,idisti)
         dmax = xyzlimits(2,idisti)
      else if ( answer .eq. 'H' ) then
         type = H_CUT
         cutchar = charv
         dmin = xyzlimits(1,idistj)
         dmax = xyzlimits(2,idistj)
      else
         write(luttyo,102) answer
102      format(' ','Invalid response: ', a)
         goto 99
      endif
c
c     Ask user for line value to print
c
200   write(luttyo,110)
     1                cutchar, pm_scale_cm2plot*dmin,
     1                pm_length_unit(1:ulen),
     1                cutchar, pm_scale_cm2plot*dmax,
     1                pm_length_unit(1:ulen)
110   format(' ','The minimum ',a1,' coordinate in the device is ',
     1          1pg12.5, ' ',a/
     1          ' ','The maximum ',a1,' coordinate in the device is ',
     1          1pg12.5, ' ',a)
c
      call get_reals(real_vec,1,
     1     'Enter coordinate value of the cut line in ' // 
     1     pm_length_unit(1:ulen) // ': ',0)
      cut_line_coord = real_vec(1)*pm_scale_plot2cm
      if( cut_line_coord .lt. dmin .or. cut_line_coord .gt. dmax ) then
         write(luttyo,120) cut_line_coord*pm_scale_cm2plot
120      format(' ','Error: Cut line value ',1pe10.3,
     1          ' is outside device')
         goto 200
      endif
c
c     Ignore discontinuities for now...
c
      value_in_oxide = .TRUE.
      along_oxide = .FALSE.
      call extract_cut_line_tri(data_array, array_size,
     1                     discontinuity,
     2                     do_log, value_in_oxide,
     3                     cut_line_coord, cutchar,
     4                     along_oxide,
     5                     tmp, 4*COMP_ARRAYSIZE, 2, np, lerr)
      if( lerr ) then
         write(luttyo,130)
130      format(' ','Error occured during cut line select')
         if( np .eq. 0 ) then
            write(luttyo,140)
140         format(' ','No points selected')
         else
            write(luttyo,150)
150         format(' ','Internal storage limit exceeded during select')
         endif
         call get_char(answer,'Hit return to continue...',0)
         return
      endif
c
      if( np .gt. COMP_ARRAYSIZE ) then
         write(luttyo,160)
160      format(' ','Internal storage limit exceeded during select')
         call get_char(answer,'Hit return to continue',0)
      endif
c
      call store_in_slot(entry, tmp(1,1), np, tmp(1,2),
     1           cut_line_coord, cutchar,
     2           quantity, nickname, units, COMP_CUT_TYPE, dummy,
     3           do_log)
      return
c
      end
c
      subroutine store_in_slot(entry, data, n, coord,
     1           cut_line_coord, cut_line_axis,
     2           quantity, nickname, units, type, int_limits,
     3           do_log)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'compare.cmn'
      include 'user.cmn'
      include 'defaults.cmn'
      include 'evaluate.cmn'
c
      integer entry, n, type
      real data(COMP_ARRAYSIZE), coord(COMP_ARRAYSIZE),
     1     cut_line_coord, int_limits(2)
      logical do_log
      character*1 cut_line_axis
      character*(*) quantity, nickname
      character*(*) units
c
c     locals
c
      real markerscale, ax, ay, mx, my, linewidth
      integer i, color, linestyle,
     1        markertype, markercolor, xtag, ytag, pm_color_to_index,
     2        pm_symbol_to_index, pm_linetype_to_index
      logical lsuppress, xabs, yabs
      character*80 label
      character*8  var_names(MAXCOLS)
c
c
c     Menu code items
      character*22 line_colors(0:MAX_RGB_VALUES)
      character*6 xtag_name(2), ytag_name(2)
      data xtag_name/'bottom','top   '/
      data ytag_name/'left  ','right '/
      character*32 temp_str
      character*80 string, msg, buf
      character*(PM_MAX_EXPRLEN) x_expression, y_expression
      integer      item_number, int_vec(2), slot, ilen, string_len,
     1             ierr, ind, nvars
      real         real_vec(2), dummy_in(1,MAXCOLS), dummy_out
      logical      eof, reuse_last_input, color0_invisible, have_x_expr,
     1             have_y_expr
c
c     Initialize
      do i=1,MAX_RGB_VALUES
         line_colors(i) = color_names(i)
      end do
      line_colors(0) = 'invisible'
c
      reuse_last_input = .FALSE.
c
      slot = slot_index(entry)
      label = quantity
      color = multi_1d(slot)%color
      linestyle = multi_1d(slot)%linestyle
      linewidth = multi_1d(slot)%linewidth
      markercolor = multi_1d(slot)%marker_color
      markertype = multi_1d(slot)%marker_type
      markerscale = multi_1d(slot)%marker_scale
      lsuppress = .FALSE.
      xtag = 1
      ytag = 1
      if( binfiletype .eq. DT_ASCII ) then
         ax = user_1d_ax
         ay = user_1d_ay
         mx = user_1d_mx
         my = user_1d_my
         x_expression = user_1d_x_expression
         y_expression = user_1d_y_expression
      else
         ax = 0.0
         ay = 0.0
         mx = 1.0
         my = 1.0
         x_expression = ' '
         y_expression = ' '
      endif
c
      if( string_len(x_expression) .ne. 0 ) then
         have_x_expr = .TRUE.
      else
         have_x_expr = .FALSE.
      endif
      if( string_len(y_expression) .ne. 0 ) then
         have_y_expr = .TRUE.
      else
         have_y_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,3)
      call display_string(3 ,1 ,' 1) Plot label    :',19,0)
      call display_string(4 ,1 ,' 2) Color         :',19,0)
      call display_string(5 ,1 ,' 3) Linetype      :',19,0)
      call display_string(6 ,1 ,' 4) Linewidth     :',19,0)
      call display_string(7 ,1 ,' 5) Symbol color  :',19,0)
      call display_string(8 ,1 ,' 6) Symbol type   :',19,0)
      call display_string(9 ,1 ,' 7) Symbol size   :',19,0)
      call display_string(11,1 ,' 8) X coord offset (AX) :',25,0)
      call display_string(12,1 ,' 9) X coord scale  (MX) :',25,0)
      call display_string(13,1 ,'10) Y coord offset (AY) :',25,0)
      call display_string(14,1 ,'11) Y coord scale  (MY) :',25,0)
      call display_string(15,1 ,'12) X coord expression  :',25,0)
      call display_string(16,1 ,'13) Y coord expression  :',25,0)
      call display_string(17,1 ,'14) X axis tag    :',19,0)
      call display_string(18,1 ,'15) Y axis tag    :',19,0)
c
      call display_string(3,21,label,50,1)
c
      i = color
      if( i .lt. 0 .or. i .gt. MAX_RGB_VALUES ) i = MAX_RGB_VALUES
      call display_string(4,21,line_colors(i),15,1)
      call display_intp  (4,37,i,3)
c
      i = linestyle
      if( i .lt. 0 .or. i .gt. MAX_LINETYPE_VALUES )
     1    i = MAX_LINETYPE_VALUES
      call display_string(5,21,line_names(i),15,1)
      call display_intp  (5,37,i,3)
c
      call display_real(6,21,linewidth,1)
c
      i = markercolor
      if( i .lt. 0 .or. i .gt. MAX_RGB_VALUES ) i = MAX_RGB_VALUES
      call display_string(7,21,line_colors(i),15,1)
      call display_intp  (7,37,i,3)
c
      i = markertype
      if( i .lt. 0 .or. i .gt. MAX_SYMBOL_VALUES ) i = MAX_SYMBOL_VALUES
      call display_string(8,21,symbol_names(i),15,1)
      call display_intp  (8,37,i,3)
c
      call display_real(9,21,markerscale,1)
c
      if( have_x_expr ) then
         call display_string(11,26,'       NA',9,1)
         call display_string(12,26,'       NA',9,1)
      else
         call display_real(11,26,ax,1)
         call display_real(12,26,mx,1)
      endif
      if( have_y_expr ) then
         call display_string(13,26,'       NA',9,1)
         call display_string(14,26,'       NA',9,1)
      else
         call display_real(13,26,ay,1)
         call display_real(14,26,my,1)
      endif
      if( have_x_expr ) then
         call display_string(15,27,x_expression,52,1)
      else
         call display_string(15,27,'(none)',6,1)
      endif
      if( have_y_expr ) then
         call display_string(16,27,y_expression,52,1)
      else
         call display_string(16,27,'(none)',6,1)
      endif
      call display_string(17,21,xtag_name(xtag),6,1)
      call display_string(18,21,ytag_name(ytag),6,1)
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. 'E' .or. string(1:1) .eq. 'Q' .or.
     1    string(1:1) .eq. 'A' ) 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(label,'Enter label for curve')
            call display_string(3,21,label,50,1)
         else if ( item_number .eq. 2 ) then
c           Curve color
            call get_string_with_prompt(temp_str,
     1      'Enter color name (enter ? for list of colors)')
            if( temp_str .eq. '?' ) then
c              Display color names and then repaint screen
               color0_invisible = .TRUE.
               call pm_display_color_list(color0_invisible)
               reuse_last_input = .TRUE.
               goto 100
            endif
            int_vec(1) = pm_color_to_index(temp_str)
            if( int_vec(1) .lt. 0 ) then
               call display_message('Illegal value')
            else
               color = int_vec(1)
               call display_string(4,21,line_colors(color),15,1)
               call display_intp  (4,37,color,3)
            endif
         else if ( item_number .eq. 3 ) then
c           Curve linestyle
            call get_string_with_prompt(temp_str,
     1      'Enter line type (enter ? for list of types)')
            if( temp_str .eq. '?' ) then
c              Display linetypes and then repaint screen
               call pm_display_linetype_list
               reuse_last_input = .TRUE.
               goto 100
            endif
            int_vec(1) = pm_linetype_to_index(temp_str)
            if( int_vec(1) .lt. 0 ) then
               call display_message('Illegal value')
            else
               linestyle = int_vec(1)
               call display_string(5,21,line_names(linestyle),15,1)
               call display_intp  (5,37,linestyle,3)
            endif
         else if ( item_number .eq. 4 ) then
            real_vec(1) = linewidth
            call get_reals_with_prompt(real_vec,1,
     1        'Enter line width scale (> 0.0)')
            linewidth = MIN(MAX(0.01,real_vec(1)),10.0)
            call display_real(6,21,linewidth,1)
         else if ( item_number .eq. 5 ) then
c           Symbol color
            call get_string_with_prompt(temp_str,
     1      'Enter color name (enter ? for list of colors)')
            call upcase(temp_str)
            if( temp_str .eq. '?' ) then
c              Display color names and then repaint screen
               color0_invisible = .TRUE.
               call pm_display_color_list(color0_invisible)
               reuse_last_input = .TRUE.
               goto 100
            endif
            int_vec(1) = pm_color_to_index(temp_str)
            if( int_vec(1) .lt. 0 ) then
               call display_message('Illegal value')
            else
               markercolor = int_vec(1)
               call display_string(7,21,line_colors(markercolor),15,1)
               call display_intp  (7,37,markercolor, 3)
            endif
         else if ( item_number .eq. 6 ) then
c           Symbol type
            call get_string_with_prompt(temp_str,
     1      'Enter symbol type (enter ? for list of types)')
            if( temp_str .eq. '?' ) then
c              Display linetypes and then repaint screen
               call pm_display_symbol_list
               reuse_last_input = .TRUE.
               goto 100
            endif
            int_vec(1) = pm_symbol_to_index(temp_str)
            if( int_vec(1) .lt. 0 ) then
               call display_message('Illegal value')
            else
               markertype = int_vec(1)
               call display_string(8,21,symbol_names(markertype),15,1)
               call display_intp  (8,37,markertype, 3)
            endif
         else if ( item_number .eq. 7 ) then
            real_vec(1) = markerscale
            call get_reals_with_prompt(real_vec,1,
     1        'Enter symbol size')
            markerscale = real_vec(1)
            call display_real(9,21,markerscale,1)
         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) = ax
               call get_reals_with_prompt(real_vec,1,
     1           'Enter X coordinate offset (AX in formula: MX*x + AX)')
               ax = real_vec(1)
               call display_real(11,26,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) = 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
                  mx = real_vec(1)
                  call display_real(12,26,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) = ay
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Y coordinate offset (AY in formula: MY*y + AY)')
               ay = real_vec(1)
               call display_real(13,26,ay,1)
            endif
         else if ( item_number .eq. 11 ) then
            if( have_y_expr ) then
               call display_message(
     1         'Both AY and Y expression cannot be specified')
            else
               real_vec(1) = 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
                  my = real_vec(1)
                  call display_real(14,26,my,1)
               endif
            endif
         else if ( item_number .eq. 12 ) then
c           X axis expression
            call get_string_with_prompt(x_expression,
     1           'Enter expression to apply to x axis data '//
     2           '(e.g. 3.0*x**2 + sqrt(sin(x)) )')
            ilen = string_len(x_expression)
            if( ilen .eq. 0 ) then
               call display_string(15,27,'(none)',52,1)
               have_x_expr = .FALSE.
               call display_real(11,26,ax,1)
               call display_real(12,26,mx,1)
            else
c              Make a dummy evaluation to see if function is suitable
               dummy_in(1,1) = 1.0
               call ev_expression_f(x_expression,'x',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(15,27,x_expression,52,1)
                  call display_string(11,26,'       NA',9,1)
                  call display_string(12,26,'       NA',9,1)
                  have_x_expr = .TRUE.
               endif
            endif
         else if ( item_number .eq. 13 ) then
c           Y axis expression
            call get_string_with_prompt(y_expression,
     1           'Enter expression to apply to y axis data '//
     2           '(e.g. 3.0*y**2 + sqrt(sin(y)) )')
            ilen = string_len(y_expression)
            if( ilen .eq. 0 ) then
               call display_string(16,27,'(none)',52,1)
               have_y_expr = .FALSE.
               call display_real(13,26,ay,1)
               call display_real(14,26,my,1)
            else
c              Make a dummy evaluation to see if function is suitable
               call pm_set_expression_var_names(type, user_1d_n_ycols,
     1              user_1d_col_y, user_1d_merge_ycols,
     2              var_names, nvars, MAXCOLS)
               do i=1,nvars
                  dummy_in(1,i) = 1.0
               end do
               call ev_expression_f(y_expression,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(16,27,y_expression,52,1)
                  call display_string(13,26,'       NA',9,1)
                  call display_string(14,26,'       NA',9,1)
                  have_y_expr = .TRUE.
               endif
            endif
         else if ( item_number .eq. 14 ) then
            if( xtag .eq. 1 ) then
               xtag = 2
            else
               xtag = 1
            endif
            call display_string(17,21,xtag_name(xtag),6,1)
         else if ( item_number .eq. 15 ) then
            if( ytag .eq. 1 ) then
               ytag = 2
            else
               ytag = 1
            endif
            call display_string(18,21,ytag_name(ytag),6,1)
         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
      xabs = .FALSE.
      yabs = .FALSE.
c
      call copy_data_to_slot(entry, data, n,
     1     coord, cut_line_coord, cut_line_axis,
     3     quantity, nickname, units, type, int_limits,
     4     label, color, linestyle, linewidth,
     5     markertype, markercolor, markerscale,
     6     xtag, ytag, lsuppress, mx, ax, my, ay, xabs, yabs, do_log,
     7     x_expression, y_expression)
c
      return
      end
c
      subroutine copy_data_to_slot(entry, data, n, coord,
     1           cut_line_coord, cut_line_axis,
     2           quantity, nickname, units, type, int_limits,
     3           label, color, linestyle, linewidth,
     4           markertype, markercolor, markerscale,
     5           xtag, ytag, suppress, mx, ax, my, ay, xabs, yabs,
     6           do_log, x_expression, y_expression)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'compare.cmn'
      include 'user.cmn'
      include 'analytical.cmn'
      include 'units.cmn'
c
      integer entry, n, type, color, linestyle,
     1        markercolor, markertype, xtag, ytag
      real data(COMP_ARRAYSIZE), coord(COMP_ARRAYSIZE),
     1     cut_line_coord, markerscale, int_limits(2),
     2     mx, ax, my, ay, linewidth
      logical suppress, xabs, yabs, do_log
c
      character*1 cut_line_axis
      character*(*) quantity, units, label, nickname,
     1              x_expression, y_expression
c
      integer i, j, slot, ierr, ind, string_len, nvars
      real    pax
      character*8 var_names(MAXCOLS)
      character*80 msg
c
      slot = slot_index(entry)
c
c     Allocate arrays
      allocate(multi_1d(slot)%coord(1:n),stat=ierr)
      allocate(multi_1d(slot)%data(1:n),stat=ierr)
      allocate(multi_1d(slot)%raw_coord(1:n),stat=ierr)
      if( type .eq. COMP_USER_TYPE ) then
         allocate(multi_1d(slot)%raw_data(1:n*user_1d_n_ycols),
     1            stat=ierr)
      else
         allocate(multi_1d(slot)%raw_data(1:n),stat=ierr)
      endif
      if( ierr .ne. 0 ) then
         msg = 'copy_data_to_slot: error allocating memory'
         call display_message(msg)
         return
      endif
c
      pax = ax*pm_scale_plot2cm
      do i=1,n
         multi_1d(slot)%raw_coord(i) = coord(i)
         multi_1d(slot)%raw_data(i)  = data(i)
c        We now apply scaling when we store data
c        Note: coordinates of ASCII data are now scaled when read
c              to internal units.
c        Scale factors have to be converted to appropriate internal
c        units (use pax). mx is not converted, as it is unitless.
         multi_1d(slot)%coord(i) = mx*coord(i) + pax
         if(xabs) multi_1d(slot)%coord(i) = ABS(multi_1d(slot)%coord(i))
         multi_1d(slot)%data(i)  = my*data(i) + ay
         if( yabs ) multi_1d(slot)%data(i) = ABS(multi_1d(slot)%data(i))
      end do
c
      if( type .eq. COMP_USER_TYPE .and. .not. user_1d_merge_ycols) then
         do j=2,user_1d_n_ycols
            do i=1,n
c              Extra Y columns were stored at slots 6 and higher
               multi_1d(slot)%raw_data((j-1)*n+i) =
     1            arr2d(i,j+4)
            end do
         end do
      endif
c
      if( string_len(x_expression) .ne. 0 ) then
c        This very odd code must be done since the coordinates were
c        converted to internal plot units on read in...
c        Use raw_coord array as a temporary
         do i=1,n
            work_vec(i,1) = multi_1d(slot)%raw_coord(i)*pm_scale_cm2plot
         end do
         var_names(1) = 'x'
         call ev_expression_f(x_expression,var_names,1,n,
     1                        work_vec,COMP_ARRAYSIZE,
     1                        multi_1d(slot)%coord,ierr,ind)
         do i=1,n
            multi_1d(slot)%coord(i) = multi_1d(slot)%coord(i)*
     1                                pm_scale_plot2cm
         end do
      endif
      if( string_len(y_expression) .ne. 0 ) then
         call pm_set_expression_var_names(type, user_1d_n_ycols,
     1        user_1d_col_y, user_1d_merge_ycols,
     2        var_names, nvars, MAXCOLS)
         do i=1,n
            work_vec(i,1) = multi_1d(slot)%raw_coord(i)*pm_scale_cm2plot
            work_vec(i,2) = multi_1d(slot)%raw_data(i)
         end do
         if ( type .eq. COMP_USER_TYPE .and.
     1        user_1d_n_ycols .gt. 1 .and.
     2        .not. user_1d_merge_ycols) then
            do j=2,user_1d_n_ycols
               do i=1,n
                  work_vec(i,j+1) =
     1               multi_1d(slot)%raw_data((j-1)*n + i)
               end do
            end do
         endif
         call ev_expression_f(y_expression,var_names,nvars,n,
     1                        work_vec,COMP_ARRAYSIZE,
     2                        multi_1d(slot)%data,ierr,ind)
cc       ??? Why did we do this ???
cc         do i=1,n
cc            multi_1d(slot)%raw_data(i) = data(i)
cc         end do
      endif
c
      multi_1d(slot)%np = n
c
      multi_1d(slot)%vd = vd
      multi_1d(slot)%vs = vs
      multi_1d(slot)%vg = vg
      multi_1d(slot)%vb = vb
      multi_1d(slot)%id = id
      multi_1d(slot)%is = is
      multi_1d(slot)%ib = ib
      multi_1d(slot)%cut_line_coord = cut_line_coord
      multi_1d(slot)%cut_line_axis  = cut_line_axis
      multi_1d(slot)%cut_plane_coord = plane_actual_value
      multi_1d(slot)%cut_plane_axis = cut_plane_axis
      multi_1d(slot)%type = type
      multi_1d(slot)%datatype = binfiletype
      multi_1d(slot)%bin_datatype = binfile_convert_type
      multi_1d(slot)%ax = ax
      multi_1d(slot)%mx = mx
      multi_1d(slot)%ay = ay
      multi_1d(slot)%my = my
      multi_1d(slot)%xabs = xabs
      multi_1d(slot)%yabs = yabs
      multi_1d(slot)%log = do_log
      multi_1d(slot)%x_expression = x_expression
      multi_1d(slot)%y_expression = y_expression
      multi_1d(slot)%suppress = suppress
      if( type .eq. COMP_USER_TYPE ) then
         if( user_1d_contour .or.user_1d_errorbars ) then
c           Allocate arrays
            allocate(multi_1d(slot)%zval(1:n),stat=ierr)
            allocate(multi_1d(slot)%raw_zval(1:n),stat=ierr)
            if( ierr .ne. 0 ) then
               msg = 'copy_data_to_slot: error allocating memory'
               call display_message(msg)
               return
            endif
            do 20 i=1,n
               multi_1d(slot)%raw_zval(i) = arr2d(i,4)
               multi_1d(slot)%zval(i) = arr2d(i,5)
20         continue
         endif
         if( user_1d_x_char_data ) then
            multi_1d(slot)%x_char_data = user_1d_x_char_data
            do i=1,n
               multi_1d(slot)%char_data(i) = user_1d_char_data(i)
            end do
         endif
         multi_1d(slot)%binfilename = user_1d_asciifile
         multi_1d(slot)%col_x = user_1d_col_x
         do j=1,user_1d_n_ycols
           multi_1d(slot)%col_y(j) = user_1d_col_y(j)
         end do
         multi_1d(slot)%n_ycols = user_1d_n_ycols
         multi_1d(slot)%col_z = user_1d_col_z
         multi_1d(slot)%az = user_1d_az
         multi_1d(slot)%mz = user_1d_mz
         multi_1d(slot)%zabs = user_1d_zabs
         multi_1d(slot)%skip = user_1d_skip
         multi_1d(slot)%lines_to_read = user_1d_nlines
         multi_1d(slot)%sweep = user_1d_sweep
         multi_1d(slot)%contour = user_1d_contour
         multi_1d(slot)%errorbars = user_1d_errorbars
         multi_1d(slot)%sort = user_1d_sort
         multi_1d(slot)%x_char_data = user_1d_x_char_data
         multi_1d(slot)%dimension = 1
         multi_1d(slot)%sample_freq = user_1d_sample_freq
         multi_1d(slot)%record      = datafile_record
         multi_1d(slot)%merge_ycols = user_1d_merge_ycols
      else
         multi_1d(slot)%binfilename = binfilename
         multi_1d(slot)%record      = datafile_record
         if( three_d ) then
            multi_1d(slot)%dimension = 3
         else if( binfiletype .eq. DT_SUPREM3S .or.
     1            binfiletype .eq. DT_SUPREM3P .or.
     1            binfiletype .eq. DT_GRAPES   .or.
     1            binfiletype .eq. DT_SPICE3   .or.
     1            (binfiletype .eq. DT_TIF .and. tif_1d_data) ) then
            multi_1d(slot)%dimension = 1
         else if( binfiletype .eq. DT_ANALYTICAL ) then
            multi_1d(slot)%dimension = analytical_dim
         else
            multi_1d(slot)%dimension = 2
         endif
         if( binfiletype .eq. DT_2DOP ) then
            multi_1d(slot)%misc(1) = tdop_gate_length
            multi_1d(slot)%misc_ch(1) = tdop_interface_file
         endif
         if( binfiletype .eq. DT_VLSICAP ) then
            multi_1d(slot)%misc(1) = vlsi_edge
            multi_1d(slot)%misc(2) = vlsi_yint
         endif
         if( binfiletype .eq. DT_MEDICI .or.
     1       binfiletype .eq. DT_PISCES ) then
            multi_1d(slot)%misc_ch(1) = medici_solution_file
         endif
         if( binfiletype .eq. DT_GRAPES ) then
            multi_1d(slot)%misc_ch(1)      = grapes_x_quantity
            multi_1d(slot)%use_grapes_dict = grapes_use_dictionary
         endif
         if( binfiletype .eq. DT_SPICE3 ) then
            multi_1d(slot)%misc_ch(1)      = spice3_x_quantity
         endif
         if( binfiletype .eq. DT_TIF .and. tif_1d_data ) then
            multi_1d(slot)%col_x = tif_ixcol
            multi_1d(slot)%col_y(1) = tif_iycol
            multi_1d(slot)%n_ycols = 1
         endif
         if( binfiletype .eq. DT_ANALYTICAL ) then
            multi_1d(slot)%sweep = analytical_sweep
            multi_1d(slot)%analytical_expression = analytical_expression
            multi_1d(slot)%analytical_xstart = analytical_xstart
            multi_1d(slot)%analytical_xend   = analytical_xend
            multi_1d(slot)%analytical_xstep  = analytical_xstep
            multi_1d(slot)%analytical_pstart = analytical_pstart
            multi_1d(slot)%analytical_pend   = analytical_pend
            multi_1d(slot)%analytical_pstep  = analytical_pstep
            multi_1d(slot)%analytical_ystart = analytical_ystart
            multi_1d(slot)%analytical_yend   = analytical_yend
            multi_1d(slot)%analytical_ystep  = analytical_ystep
            multi_1d(slot)%analytical_type   = analytical_type
         endif
         if( binfiletype .eq. DT_ASCII ) then
            multi_1d(slot)%binfilename = user_1d_asciifile
            multi_1d(slot)%col_x = user_1d_col_x
            multi_1d(slot)%col_y(1) = user_1d_col_y(1)
            multi_1d(slot)%n_ycols = 1
            multi_1d(slot)%col_z = user_1d_col_z
            multi_1d(slot)%az = user_1d_az
            multi_1d(slot)%mz = user_1d_mz
            multi_1d(slot)%zabs = user_1d_zabs
            multi_1d(slot)%skip = user_1d_skip
            multi_1d(slot)%lines_to_read = user_1d_nlines
            multi_1d(slot)%sample_freq = user_1d_sample_freq
         endif
      endif
      multi_1d(slot)%label = label
      multi_1d(slot)%quantity = quantity
      multi_1d(slot)%nickname = nickname
      if( type .eq. COMP_CUT_TYPE .or.
     1    type .eq. COMP_INTERFACE_TYPE .or.
     2    type .eq. COMP_USER_TYPE ) then
         multi_1d(slot)%units = units
      elseif( type .eq. COMP_INT_TYPE ) then
         multi_1d(slot)%int_units = units
         multi_1d(slot)%int_limits(1) = int_limits(1)
         multi_1d(slot)%int_limits(2) = int_limits(2)
      endif
c
      multi_1d(slot)%color        = color
      multi_1d(slot)%linestyle    = linestyle
      multi_1d(slot)%linewidth    = linewidth
      multi_1d(slot)%marker_color = markercolor
      multi_1d(slot)%marker_type  = markertype
      multi_1d(slot)%marker_scale = markerscale
c
      multi_1d(slot)%xaxis_tag = xtag
      multi_1d(slot)%yaxis_tag = ytag
c
      return
      end
c
      subroutine pm_display_color_list(color0_invisible)
      implicit none
c
      include 'const.h'
      include 'defaults.cmn'
c
      logical color0_invisible
c
      integer i
      character*1 ch
      character*80 temp_str
c
      call clear_screen
      call display_string(1 ,1 , 'Current colors are:',20,0)
c
      if( color0_invisible ) then
         temp_str = '(  0)  invisible'
      else
         write(temp_str,100) 0, color_names(0)
100      format('(',i3,')',2x,a32)
      endif
      call display_string(3 ,1 , temp_str, 48,0)
c
      do i=1,MAX_RGB_VALUES
         write(temp_str,100) i, color_names(i)
         call display_string(i+3 ,1 , temp_str,48,0)
      end do
c
      call get_string_with_prompt(ch,'Press return to continue...')
c
      return
      end
c
      subroutine pm_display_linetype_list
      implicit none
c
      include 'const.h'
      include 'defaults.cmn'
c
      integer i
      character*1 ch
      character*80 temp_str
c
      call clear_screen
      call display_string(1 ,1 , 'Available linetypes are:',20,0)
c
      do i=0,MAX_LINETYPE_VALUES
         write(temp_str,100) i, line_names(i)
100      format('(',i3,')', 2x, a32)
         call display_string(i+3 ,1 , temp_str,48,0)
      end do
c
      call get_string_with_prompt(ch,'Press return to continue...')
c
      return
      end
c
      subroutine pm_display_symbol_list
      implicit none
c
      include 'const.h'
      include 'defaults.cmn'
c
      integer i
      character*1 ch
      character*80 temp_str
c
      call clear_screen
      call display_string(1 ,1 , 'Available symbols are:',22,0)
c
      do i=0,MAX_SYMBOL_VALUES
         write(temp_str,100) i, symbol_names(i)
100      format('(',i3,')',2x,a32)
         call display_string(i+3 ,1 , temp_str,48,0)
      end do
c
      call get_string_with_prompt(ch,'Press return to continue...')
c
      return
      end
c
      subroutine pm_set_expression_var_names(type, num_ycols,
     1           ycols, merge_ycols, var_names, nvars, maxnames)
      implicit none
c
      integer type, num_ycols, ycols(num_ycols), nvars, maxnames
      logical merge_ycols
      character*(*) var_names(maxnames)
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'compare.cmn'
c
      integer i
c
      var_names(1) = 'x'
      if( (type .ne. COMP_USER_TYPE) .or.
     1    (type .eq. COMP_USER_TYPE .and.
     2     (num_ycols .eq. 1 .or. merge_ycols)) ) then
         var_names(2) = 'y'
         nvars = 2
      else
         nvars = 1
         do i=1,num_ycols
            nvars = nvars + 1
            if( ycols(i) .lt. 10 ) then
               write(var_names(nvars),100) ycols(i)
100            format('y',i1)
            else
               write(var_names(nvars),101) ycols(i)
101            format('y',i2)
            endif
         end do
      endif
c
      return
      end
