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_2d
      implicit none
c
c     Store in an entry in multi_2d
c
c     Programmer: John Faricelli
c     Date: 1-Apr-99
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'bincodes.cmn'
      include 'compare_2d.cmn'
      include 'user.cmn'
c
c     locals
c
      real dummy(2)
      integer answer, entry, npts, string_len
      logical error
      character*1  cut_char
      character*10 buffer
      character*80 errfmt
c
      errfmt = '('' '')'
c
      if( max_menu_num .eq. 1 ) then
         if( is_data_1d(1) ) then
            call clear_screen
            call beep_terminal
            write(luttyo,100)
100         format(' ','Cannot plot contours of 1-D data'/
     1             ' ','Hit return to continue...')
            read(luttyi,106,end=300,err=300) buffer
         else
            if( data_is_trigrid ) then
               npts = tri_npts
            else
               npts = ni*nj
            endif
            call store_2d_in_slot(arrdat(arrind(menu_to_arr(1))),
     1                   npts,
     2                   data_name(1), data_nickname(1),
     3                   data_units(1), is_data_log(1),
     4                   is_data_in_oxide(1), entry)
            if( entry .eq. -1 ) then
               write(luttyo,101)
101            format(' ','All slots used up, delete some datasets'/
     1                ' ','Hit return to continue...')
               read(luttyi,106,end=300,err=300) buffer
            endif
         endif
         return
      endif
c
200   call clear_screen
      write(luttyo,errfmt)
      errfmt = '('' '')'
      call write_data_menu('Select 2D data for contour plot:')
      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( is_data_1d(answer) ) then
         errfmt = '('' '',''Cannot plot contours of 1D data'')'
         call beep_terminal
      else if( .NOT. in_binary_file(answer) ) then
         errfmt = '('' '',''Data not available from binary file'')'
         call beep_terminal
      else
         if( data_is_trigrid ) then
            npts = tri_npts
         else
            npts = ni*nj
         endif
         call store_2d_in_slot(arrdat(arrind(menu_to_arr(answer))),
     1                   npts,
     1                   data_name(answer), data_nickname(answer),
     1                   data_units(answer), is_data_log(answer),
     1                   is_data_in_oxide(answer),
     1                   entry)
         if( entry .eq. -1 ) then
            write(luttyo,101)
            read(luttyi,106,end=300,err=300) buffer
         endif
      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_2d_in_slot(data, n,
     1           quantity, nickname, units, log_data, val_in_oxide,
     1           entry)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'mesh.cmn'
      include 'compare_2d.cmn'
      include 'user.cmn'
      include 'defaults.cmn'
      include 'evaluate.cmn'
c
      integer entry, n
      real data(n)
      logical log_data, val_in_oxide
      character*(*) quantity, nickname
      character*(*) units
c
c     locals
c
      real ax, ay, az, mx, my, mz, contours(MAX_CONTOURS)
      integer i, j, num_contours
      character*80 label
      character*3  str
      character*8  var_names(MAXCOLS)
c
c
c     Menu code items
      character*32 temp_str
      character*80 string, msg, buf
      character*(PM_MAX_EXPRLEN) x_expression, y_expression,
     1                           z_expression
      integer      item_number, int_vec(2), slot, ilen,
     1             ierr, ind, nvars
      integer      string_len, find_new_entry_2d
      real         real_vec(MAX_CONTOURS), dummy_in(1,MAXCOLS),
     1             dummy_out
      logical      eof, reuse_last_input, have_x_expr, have_y_expr,
     1             have_z_expr
      logical      color, junctions, grid, clabel, solid,
     1             colormat, do_negate, init_contours, lcontour_error,
     1             do_log
c
c     Initialize
c
      reuse_last_input = .FALSE.
c
      entry     = find_new_entry_2d()
      if( entry .eq. -1 ) return
c
      slot      = slot_index_2d(entry)
      label     = quantity
      color     = .TRUE.
      if( net_dop_array_index .ne. 0 ) then
         junctions = .TRUE.
      else
         junctions = .FALSE.
      endif
      grid      = .FALSE.
      clabel    = .FALSE.
      solid     = .FALSE.
      colormat  = .FALSE.
      do_log    = log_data
c
      if( binfiletype .eq. DT_ASCII ) then
         ax = user_1d_ax
         ay = user_1d_ay
         az = user_1d_az
         mx = user_1d_mx
         my = user_1d_my
         mz = user_1d_mz
         x_expression = user_1d_x_expression
         y_expression = user_1d_y_expression
         z_expression = user_1d_z_expression
      else
         ax = 0.0
         ay = 0.0
         az = 0.0
         mx = 1.0
         my = 1.0
         mz = 1.0
         x_expression = ' '
         y_expression = ' '
         z_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
      if( string_len(z_expression) .ne. 0 ) then
         have_z_expr = .TRUE.
      else
         have_z_expr = .FALSE.
      endif
c
c     Compute a default set of contours
      num_contours = MAX_CONTOURS
      do_negate = .FALSE.
      if( data_is_trigrid ) then
         call get_default_contours_tri(xyzlimits(1,1), xyzlimits(2,1),
     1           xyzlimits(1,2),xyzlimits(2,2),
     2           data, tri_npts, do_log, do_negate,
     3           num_contours, contours)
      else
         call get_default_contours(
     1           xyzlimits(1,idisti),xyzlimits(2,idisti),
     1           xyzlimits(1,idistj),xyzlimits(2,idistj),
     2           data, ni, nj, do_log, do_negate,
     3           num_contours, contours)
      endif
c     Sort in ascending order (MUST BE DONE!!!)
      call sort_contours(contours,num_contours)
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 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)
c
      call display_string(4,40,'17) Contours',12,0)
c
      call display_string(4,53,'18) Recompute contours',22,0)
      call display_string(5,53,'19) Use log contours',20,0)
c
      call display_string(3,26,label,50,1)
c
      call pm_logical_to_str(color, str)
      call display_string(4,27,str,3,1)
c
      call pm_logical_to_str(junctions, str)
      call display_string(5,27,str,3,1)
c
      call pm_logical_to_str(grid, str)
      call display_string(6,27,str,3,1)
c
      call pm_logical_to_str2(clabel, str, color)
      call display_string(7,27,str,3,1)
c
      call pm_logical_to_str2(solid, str, color)
      call display_string(8,27,str,3,1)
c
      call pm_logical_to_str2(colormat, str, color)
      call display_string(9,27,str,3,1)
c
      call pm_logical_to_str(do_log, str)
      call display_string(5,77,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,x_expression,52,1)
      else
         call display_real(10,26,ax,1)
         call display_real(11,26,mx,1)
         call display_string(16,27,'(none)',6,1)
      endif
c
      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,y_expression,52,1)
      else
         call display_real(12,26,ay,1)
         call display_real(13,26,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,z_expression,52,1)
      else
         call display_real(14,26,az,1)
         call display_real(15,26,mz,1)
         call display_string(18,27,'(none)',6,1)
      endif
c
      do i=1,num_contours
         call display_real(4+i, 40, contours(i), 1)
      end do
      do i=num_contours+1,MAX_CONTOURS
         call display_string(4+i, 40,'         ', 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. '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,26,label,50,1)
         else if ( item_number .eq. 2 ) then
c           Color contours
            color = .NOT. color
            call pm_logical_to_str(color, str)
            call display_string(4,27,str,3,1)
            call pm_logical_to_str2(clabel, str, color)
            call display_string(7,27,str,3,1)
            call pm_logical_to_str2(solid, str, color)
            call display_string(8,27,str,3,1)
            call pm_logical_to_str2(colormat, str, color)
            call display_string(9,27,str,3,1)
         else if ( item_number .eq. 3 ) then
c           Junctions
            junctions = .NOT. junctions
            call pm_logical_to_str(junctions, str)
            call display_string(5,27,str,3,1)
         else if ( item_number .eq. 4 ) then
c           Grid
            grid = .NOT. grid
            call pm_logical_to_str(grid, str)
            call display_string(6,27,str,3,1)
         else if ( item_number .eq. 5 ) then
c           Label contours
            if( color ) then
               call display_message(
     1            'Not applicable when using color contours')
            else
               clabel = .NOT. clabel
               call pm_logical_to_str2(clabel, str, color)
               call display_string(7,27,str,3,1)
            endif
         else if ( item_number .eq. 6 ) then
c           Black contour lines
            if( color ) then
               call display_message(
     1            'Not applicable when using color contours')
            else
               solid = .NOT. solid
               call pm_logical_to_str2(solid, str, color)
               call display_string(8,27,str,3,1)
            endif
         else if ( item_number .eq. 7 ) then
c           Color materials
            if( .NOT. color ) then
               call display_message(
     1            'Only applicable when using color contours')
            else
               colormat = .NOT. colormat
               call pm_logical_to_str(colormat, str)
               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) = 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(10,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 ) then
                  call display_message('MX must not be set to zero')
               else
                  mx = real_vec(1)
                  call display_real(11,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(12,26,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) = 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 ) then
                  call display_message('MY must not be set to zero')
               else
                  my = real_vec(1)
                  call display_real(13,26,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) = az
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Z data offset (AZ in formula: MZ*z + AZ)')
               az = real_vec(1)
               call display_real(14,26,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) = mz
               call get_reals_with_prompt(real_vec,1,
     1           'Enter Z data scale (MZ in formula: MZ*z + AZ)')
               mz = real_vec(1)
               call display_real(15,26,mz,1)
            endif
         else if ( item_number .eq. 14 ) 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(16,27,'(none)',52,1)
               have_x_expr = .FALSE.
               call display_real(10,26,ax,1)
               call display_real(11,26,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(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                                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(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(17,27,'(none)',52,1)
               have_y_expr = .FALSE.
               call display_real(12,26,ay,1)
               call display_real(13,26,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(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                                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(z_expression,
     1           'Enter expression to apply to z axis data '//
     2           '(e.g. 3.0*z**2 + sqrt(sin(z)) )')
            ilen = string_len(z_expression)
            if( ilen .eq. 0 ) then
               call display_string(18,27,'(none)',52,1)
               have_z_expr = .FALSE.
               call display_real(14,26,az,1)
               call display_real(15,26,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(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                                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
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
                  num_contours = int_vec(1)
                  do i=1,num_contours
                     contours(i) = real_vec(i)
                  end do
c                 Sort in ascending order (MUST BE DONE!!!)
                  call sort_contours(contours,num_contours)
                  do i=1,num_contours
                     call display_real(4+i, 40, contours(i), 1)
                  end do
                  do i=num_contours+1,MAX_CONTOURS
                    call display_string(4+i, 40,'         ', 9, 0)
                  end do
               endif
            endif
         else if ( item_number .eq. 18 .or. item_number .eq. 19) then
            if( item_number .eq. 19 ) then
               do_log = .NOT. do_log
               call pm_logical_to_str(do_log,str)
               call display_string(5,77,str, 3,1)
            endif
            num_contours = MAX_CONTOURS
            do_negate = .FALSE.
            if( data_is_trigrid ) then
               call get_default_contours_tri(
     1                 xyzlimits(1,1), xyzlimits(2,1),
     1                 xyzlimits(1,2),xyzlimits(2,2),
     1                 data, tri_npts, do_log, do_negate,
     1                 num_contours, contours)
            else
               call get_default_contours(
     1                 xyzlimits(1,idisti),xyzlimits(2,idisti),
     1                 xyzlimits(1,idistj),xyzlimits(2,idistj),
     1                 data, ni, nj, do_log, do_negate,
     1                 num_contours, contours)
            endif
c           Sort in ascending order (MUST BE DONE!!!)
            call sort_contours(contours,num_contours)
            do i=1,num_contours
               call display_real(4+i, 40, contours(i), 1)
            end do
         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
      init_contours = .FALSE.
c
      call copy_2d_data_to_slot(entry, data, n,
     1     quantity, nickname, units,
     1     contours, num_contours, init_contours,
     1     label, color, junctions, grid, clabel,
     1     solid, colormat, do_log, val_in_oxide,
     1     ax, mx, ay, my, az, mz,
     1     x_expression, y_expression, z_expression)
c
      return
      end
c
      subroutine copy_2d_data_to_slot(entry, data, n,
     1           quantity, nickname, units,
     1           contours, num_contours, init_contours,
     1           label, color, junctions, grid, clabel,
     1           solid, colormat, do_log, val_in_oxide,
     1           ax, mx, ay, my, az, mz,
     1           x_expression, y_expression, z_expression)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'compare_2d.cmn'
      include 'user.cmn'
      include 'units.cmn'
c
      integer entry, n, num_contours
      real data(n), contours(num_contours), ax, mx, ay, my, az, mz
      character*(*) quantity, nickname, units, label,
     1              x_expression, y_expression, z_expression
      logical color, junctions, grid, clabel, solid, colormat,
     1        init_contours, do_log, val_in_oxide
c
      integer i, j, slot, ierr, ind, string_len, nvars
      real    pax, pay, pmx, pmy
      character*8 var_names(MAXCOLS)
      character*80 msg
      logical do_negate
c
      slot = slot_index_2d(entry)
c
c     Allocate arrays
      allocate(multi_2d(slot)%data(1:n),stat=ierr)
      allocate(multi_2d(slot)%raw_data(1:n),stat=ierr)
      allocate(multi_2d(slot)%net_doping(1:n),stat=ierr)
      if( data_is_trigrid ) then
         allocate(multi_2d(slot)%cord(2,1:n),stat=ierr)
         allocate(multi_2d(slot)%cord_raw(2,1:n),stat=ierr)
         allocate(multi_2d(slot)%imat(1:tri_nreg),stat=ierr)
         allocate(multi_2d(slot)%tri2reg(1:tri_ne),stat=ierr)
         allocate(multi_2d(slot)%nop(3,1:tri_ne),stat=ierr)
         allocate(multi_2d(slot)%tri_nextel(3,1:tri_ne),stat=ierr)
      else
         allocate(multi_2d(slot)%x(1:ni),stat=ierr)
         allocate(multi_2d(slot)%raw_x(1:ni),stat=ierr)
         allocate(multi_2d(slot)%y(1:nj),stat=ierr)
         allocate(multi_2d(slot)%raw_y(1:nj),stat=ierr)
      endif
c
      if( ierr .ne. 0 ) then
         msg = 'copy_2d_data_to_slot: error allocating memory'
         call display_message(msg)
         return
      endif
c
      pax = ax*pm_scale_plot2cm
      pay = ay*pm_scale_plot2cm
c
      if( data_is_trigrid ) then
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.
         if( binfiletype .eq. DT_ASCII ) then
c           AX/MX/AY/MY have already been applied.
c           Work backwards to get back raw data
            pmx = user_1d_mx*CM2MU
            pmy = user_1d_my*CM2MU
            do i=1,n
               multi_2d(slot)%cord_raw(1,i) =
     1                        (cord(1,i)/MU2CM - user_1d_ax)/pmx
               multi_2d(slot)%cord(1,i)     =
     1                        mx*multi_2d(slot)%cord_raw(1,i) + pax
               multi_2d(slot)%cord_raw(2,i) =
     1                        (cord(2,i)/MU2CM - user_1d_ay)/pmy
               multi_2d(slot)%cord(2,i)     =
     1                        my*multi_2d(slot)%cord_raw(2,i) + pay
            end do
         else
            do i=1,n
               multi_2d(slot)%cord_raw(1,i) = cord(1,i)
               multi_2d(slot)%cord(1,i)     = mx*cord(1,i) + pax
               multi_2d(slot)%cord_raw(2,i) = cord(2,i)
               multi_2d(slot)%cord(2,i)     = my*cord(2,i) + pay
            end do
         endif
         do i=1,tri_ne
            multi_2d(slot)%tri2reg(i)    = tri2reg(i)
            do j=1,3
               multi_2d(slot)%nop(j,i)        = nop(j,i)
               multi_2d(slot)%tri_nextel(j,i) = tri_nextel(j,i)
            end do
         end do
         do i=1,tri_nreg
            multi_2d(slot)%imat(i)       = imat(i)
         end do
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 work array as a temporary
            do i=1,n
               work(i) = multi_2d(slot)%cord_raw(i,1)*pm_scale_cm2plot
            end do
            var_names(1) = 'x'
            call ev_expression_f(x_expression,var_names,1,n,
     1                           work,n,
     1                           multi_2d(slot)%cord(1,1),ierr,ind)
            do i=1,n
               multi_2d(slot)%cord(i,1) = multi_2d(slot)%cord(i,1)*
     1                                    pm_scale_plot2cm
            end do
         endif
         if( string_len(y_expression) .ne. 0 ) then
            do i=1,n
               work(i) = multi_2d(slot)%cord_raw(i,2)*pm_scale_cm2plot
            end do
            var_names(1) = 'y'
            call ev_expression_f(y_expression,var_names,1,n,
     1                           work,n,
     2                           multi_2d(slot)%cord(1,2),ierr,ind)
            do i=1,n
               multi_2d(slot)%cord(i,2) = multi_2d(slot)%cord(i,2)*
     1                                    pm_scale_plot2cm
            end do
         endif
      else
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.
         if( binfiletype .eq. DT_ASCII ) then
c           AX/MX/AY/MY have already been applied.
c           Work backwards to get back raw data
            pmx = user_1d_mx*CM2MU
            pmy = user_1d_my*CM2MU
            do i=1,ni
               multi_2d(slot)%raw_x(i)=(xyz(i,1)/MU2CM - user_1d_ax)/pmx
               multi_2d(slot)%x(i) = mx*multi_2d(slot)%raw_x(i) + pax
            end do
            do i=1,nj
               multi_2d(slot)%raw_y(i)=(xyz(i,2)/MU2CM - user_1d_ay)/pmy
               multi_2d(slot)%y(i) = my*multi_2d(slot)%raw_y(i) + pay
            end do
         else
            do i=1,ni
               multi_2d(slot)%raw_x(i) = xyz(i,1)
               multi_2d(slot)%x(i)     = mx*xyz(i,1) + pax
            end do
            do i=1,nj
               multi_2d(slot)%raw_y(i) = xyz(i,2)
               multi_2d(slot)%y(i)     = my*xyz(i,2) + pay
            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,ni
               work_vec(i,1) = multi_2d(slot)%raw_x(i)*pm_scale_cm2plot
            end do
            var_names(1) = 'x'
            call ev_expression_f(x_expression,var_names,1,ni,
     1                           work_vec,COMP_ARRAYSIZE,
     1                           multi_2d(slot)%x,ierr,ind)
            do i=1,ni
               multi_2d(slot)%x(i) = multi_2d(slot)%x(i)*
     1                               pm_scale_plot2cm
            end do
         endif
         if( string_len(y_expression) .ne. 0 ) then
            do i=1,nj
               work_vec(i,1) = multi_2d(slot)%raw_y(i)*pm_scale_cm2plot
            end do
            var_names(1) = 'y'
            call ev_expression_f(y_expression,var_names,1,nj,
     1                           work_vec,COMP_ARRAYSIZE,
     2                           multi_2d(slot)%y,ierr,ind)
            do i=1,nj
               multi_2d(slot)%y(i) = multi_2d(slot)%y(i)*
     1                               pm_scale_plot2cm
            end do
         endif
      endif
c
c     Code common to rectangular and triangular grids
c     Assumption is that 2D rectangular grid arrays are allocated
c     in exact size of (ni,nj) = n
      if( binfiletype .eq. DT_ASCII ) then
c       AZ/MZ have already been applied.
c       Work backwards to get back raw data
        do i=1,n
            multi_2d(slot)%raw_data(i) =
     1                     (data(i) - user_1d_az)/user_1d_mz
            multi_2d(slot)%data(i)     =
     1                     mz*multi_2d(slot)%raw_data(i) + az
        end do
      else
        do i=1,n
            multi_2d(slot)%raw_data(i) = data(i)
            multi_2d(slot)%data(i)     = mz*data(i) + az
        end do
      endif
c     Apply Z expression
      if( string_len(z_expression) .ne. 0 ) then
         var_names(1) = 'z'
         call ev_expression_f(z_expression,var_names,1,n,
     1                        multi_2d(slot)%raw_data,n,
     2                        multi_2d(slot)%data,ierr,ind)
      endif
c     Store net doping, if available, for plotting junctions
      if( net_dop_array_index .ne. 0 ) then
         do i=1,n
            multi_2d(slot)%net_doping(i) =
     1         arrdat(arrind(net_dop_array_index) + i - 1)
         end do
      else
         do i=1,n
            multi_2d(slot)%net_doping(i) = 0.0
         end do
      endif
c
c     Compute an initial set of contours, if requested
      if( init_contours ) then
         num_contours = MAX_CONTOURS
         do_negate = .FALSE.
         if( data_is_trigrid ) then
         call get_default_contours_tri(xyzlimits(1,1), xyzlimits(2,1),
     1           xyzlimits(1,2),xyzlimits(2,2),
     2           multi_2d(slot)%data, tri_npts, do_log, do_negate,
     3           num_contours, contours)
         else
         call get_default_contours(
     1           xyzlimits(1,idisti),xyzlimits(2,idisti),
     1           xyzlimits(1,idistj),xyzlimits(2,idistj),
     2           multi_2d(slot)%data, ni, nj, do_log, do_negate,
     3           num_contours, contours)
         endif
c        Sort in ascending order (MUST BE DONE!!!)
         call sort_contours(contours,num_contours)
      endif
c
c     Mesh size counters for triangular and rectangular grids
      if( data_is_trigrid ) then
         multi_2d(slot)%tri_npts = tri_npts
         multi_2d(slot)%tri_ne   = tri_ne
         multi_2d(slot)%tri_nreg = tri_npts
      else
         multi_2d(slot)%nx = ni
         multi_2d(slot)%ny = nj
      endif
c
      multi_2d(slot)%label     = label
      multi_2d(slot)%quantity  = quantity
      multi_2d(slot)%nickname  = nickname
      multi_2d(slot)%units     = units
      multi_2d(slot)%color     = color
      multi_2d(slot)%junctions = junctions
      multi_2d(slot)%grid      = grid
      multi_2d(slot)%clabel    = clabel
      multi_2d(slot)%solid     = solid
      multi_2d(slot)%colormat  = colormat
      multi_2d(slot)%log       = do_log
      multi_2d(slot)%val_in_oxide = val_in_oxide
c
      multi_2d(slot)%cut_plane_coord = plane_actual_value
      multi_2d(slot)%cut_plane_axis = cut_plane_axis
      multi_2d(slot)%num_contours = num_contours
      do i=1,num_contours
         multi_2d(slot)%contours(i) = contours(i)
      end do
      multi_2d(slot)%datatype = binfiletype
      multi_2d(slot)%bin_datatype = binfile_convert_type
      multi_2d(slot)%data_is_trigrid = data_is_trigrid
      multi_2d(slot)%ax = ax
      multi_2d(slot)%mx = mx
      multi_2d(slot)%ay = ay
      multi_2d(slot)%my = my
      multi_2d(slot)%az = az
      multi_2d(slot)%mz = mz
      multi_2d(slot)%x_expression = x_expression
      multi_2d(slot)%y_expression = y_expression
      multi_2d(slot)%z_expression = z_expression
c
c     Compute default set of contours

c
c     Datafile specific stuff...
c
      if( binfiletype .eq. DT_ASCII ) then
         multi_2d(slot)%binfilename   = user_1d_asciifile
         multi_2d(slot)%col_x         = user_1d_col_x
         do j=1,user_1d_n_ycols
           multi_2d(slot)%col_y(j)    = user_1d_col_y(j)
         end do
         multi_2d(slot)%n_ycols       = user_1d_n_ycols
         multi_2d(slot)%col_z         = user_1d_col_z
         multi_2d(slot)%skip          = user_1d_skip
         multi_2d(slot)%lines_to_read = user_1d_nlines
         multi_2d(slot)%dimension     = user_1d_dim
         multi_2d(slot)%record        = datafile_record
      else
         multi_2d(slot)%binfilename = binfilename
         multi_2d(slot)%record      = datafile_record
         if( three_d ) then
            multi_2d(slot)%dimension = 3
         else
            multi_2d(slot)%dimension = 2
         endif
         if( binfiletype .eq. DT_MINIMOS ) then
            multi_2d(slot)%misc_real(1) = vd
            multi_2d(slot)%misc_real(2) = vs
            multi_2d(slot)%misc_real(3) = vg
            multi_2d(slot)%misc_real(4) = vb
            multi_2d(slot)%misc_real(5) = id
            multi_2d(slot)%misc_real(6) = is
            multi_2d(slot)%misc_real(7) = ib
            multi_2d(slot)%misc_real(8) = xl
            multi_2d(slot)%misc_real(9) = tox
c
            multi_2d(slot)%misc_int(1)  = nxsp
            multi_2d(slot)%misc_int(2)  = nxsoxm
            multi_2d(slot)%misc_int(3)  = ny
            multi_2d(slot)%misc_int(4)  = nyoxm
            multi_2d(slot)%misc_int(5)  = nytop
            multi_2d(slot)%misc_int(6)  = nonplanar_boundary
            multi_2d(slot)%misc_int(7)  = three_d
         endif
         if( binfiletype .eq. DT_2DOP ) then
            multi_2d(slot)%misc_real(1) = tdop_gate_length
            multi_2d(slot)%misc_ch(1)   = tdop_interface_file
         endif
         if( binfiletype .eq. DT_VLSICAP ) then
            multi_2d(slot)%misc_real(1) = vlsi_edge
            multi_2d(slot)%misc_real(2) = vlsi_yint
         endif
         if( binfiletype .eq. DT_MEDICI .or.
     1       binfiletype .eq. DT_PISCES ) then
            multi_2d(slot)%misc_ch(1) = medici_solution_file
         endif
      endif
c
      return
      end
