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_interface
      implicit none
c
c     Select cut along oxide interface, store in an entry in multi_1d
c
c     Programmer: John Faricelli
c     Date: 23-Sep-91
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'bincodes.cmn'
c
c     locals
c
      integer answer, string_len
      character*10 buffer
      character*80 errfmt
c
      errfmt = '('' '')'
c
200   call clear_screen
      write(luttyo,errfmt)
      errfmt = '('' '')'
      call write_data_menu('Select cut along oxide interface:')
      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( data_is_trigrid ) then
         errfmt =
     1   '('' '',''Sorry, data on triangular grid not supported yet'')'
         call beep_terminal
      else if( is_data_1d(answer) ) then
         errfmt = '('' '',''Not applicable to 1D data'')'
         call beep_terminal
      else if( three_d .AND. cut_plane_axis .eq. 'Y' ) then
         errfmt = '('' '',''Not applicable to XZ plane'')'
         call beep_terminal
      else
         call cut_along_oxide_and_store(
     1            arrdat(arrind(menu_to_arr(answer))), ni, nj,
     2            does_data_jump_at_oxide(answer),
     3            is_data_log(answer), is_data_in_oxide(answer),
     4            data_name(answer), data_nickname(answer),
     5            data_units(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 cut_along_oxide_and_store(data_array, isize, jsize,
     1           discontinuity, data_is_log, value_in_oxide,
     2           quantity, nickname, units)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'units.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.cmn'
      include 'compare.cmn'
c
      integer isize, jsize
      logical discontinuity, data_is_log, value_in_oxide
      real data_array(isize, jsize)
      character*(*) quantity, units, nickname
c
c     locals
c
      real real_vec(1)
      real result(COMP_ARRAYSIZE), dummy(2)
      integer entry, find_new_entry
      character*1 answer
      character*20 format_string(1)
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 depth of cut
99    real_vec(1) = 0.0
      format_string(1) = 'f8.4'
      call get_reals_with_default(real_vec,1,
     1     'Depth of cut from oxide (microns)? ',format_string,0)
      call upcase(answer)
      if ( real_vec(1) .lt. 0.0 ) then
         write(luttyo,102)
102      format(' ','Depth must be >= 0 ')
         goto 99
      endif
      real_vec(1) = real_vec(1)*pm_scale_plot2cm
c
      call find_values_along_oxide(data_array, isize, jsize,
     1     real_vec(1), discontinuity, data_is_log, value_in_oxide,
     2     result, COMP_ARRAYSIZE)
      call store_in_slot(entry, result, ni, xyz(1,idisti),
     1                   0.0, charv,
     2                   quantity, nickname, units, COMP_INTERFACE_TYPE,
     3                   dummy, data_is_log)
      return
      end
c
      subroutine find_values_along_oxide(data_array, isize, jsize,
     1   depth, discontinuity, data_is_log, value_in_oxide, result,
     2   iresult_size)
      implicit none
c
      include 'const.h'
      include 'mesh.cmn'
c
      integer isize, jsize, iresult_size
      logical discontinuity, data_is_log, value_in_oxide
      real data_array(isize,jsize), depth, result(iresult_size)
c
      integer i,j, iox, idepth
      real oxi, cut_depth
c
c     It is convenient that for 3D applications idistj is always in
c     the Y direction, which is where the oxide interface varies.
c
      do 100 i=1,ni
         call find_oxide_interface(i,oxi)
         cut_depth = oxi + depth
         idepth = nj
         do 200 j=1,nj-1
            if( xyz(j,idistj) .le. cut_depth .and.
     1          cut_depth     .lt. xyz(j+1,idistj) ) then
                idepth = j
                goto 210
            endif
200      continue
210      continue
         iox = nj
         do 220 j=1,nj-1
            if( xyz(j,idistj) .le. oxi .and.
     1          oxi           .lt. xyz(j+1,idistj) ) then
                iox = j
                goto 230
            endif
220      continue
230      continue
c        Limit cut depth if we reached end of the array
         if( iox .eq. nj ) cut_depth = xyz(nj,idistj)
c
c        Intepolate to cut_depth; in the future we may wish to
c        use LOG interpolation for quantities that vary logarithmically
c        We are careful here.
c        Data values in oxide may have unpredictable values.
c        Unless the cut depth falls between two points in silicon
c        (or the cut depth falls exactly on the Si/Oxide boundary)
c        use exact value at first point in silicon, rather than
c        interpolate using nonsense values in the oxide.
         if( value_in_oxide .or.
     1       idepth .gt. iox .or.
     2       xyz(iox,idistj) .eq. oxi ) then
           result(i) = data_array(i,idepth) +
     1            (data_array(i,idepth+1) - data_array(i,idepth))*
     2            (cut_depth - xyz(idepth,idistj))/
     3            (xyz(idepth+1,idistj) + xyz(idepth,idistj))
         else
            result(i) = data_array(i,idepth+1)
         endif
100   continue
c
      return
      end
c
      subroutine find_oxide_interface(hindex,oxi_depth)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'units.cmn'
      include 'mesh.cmn'
      include 'io.cmn'
      include 'data.cmn'
c
      integer hindex
      real oxi_depth
c
      integer i
      logical do_oxide
c
      if( binfiletype .eq. DT_MINIMOS ) then
         if( nonplanar_boundary ) then
            oxi_depth = foxu(hindex)
         else
            oxi_depth = 0.0
         endif
      else if( binfiletype .eq. DT_2DOP ) then
c        Check for interface file (which loads upper/lower oxide surfaces)
         if( max_menu_num .eq. 5 ) then
c           Remember, shape was negated (for better plotting)
c           and scaled to microns
            oxi_depth = -arr2d(hindex,2)*pm_scale_plot2cm
         else
            oxi_depth = 0.0
         endif
      else if( binfiletype .eq. DT_PROMIS ) then
c        Is oxide defined?
         do_oxide = .FALSE.
         do i=1,promis_nequ
            if( nelem(i) .eq. 101 ) then
              do_oxide = .TRUE.
            endif
         end do
c        Oxide shape is given in microns (convert to cm)
         if( do_oxide ) then
            oxi_depth = arr2d(hindex,1)*1.0E-4
         else
            oxi_depth = 0.0
         endif
      else
         oxi_depth = 0.0
      endif
c
      return
      end


