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     Find function
c
      subroutine find_value
      implicit none
c
c     Asks user what array to look at, determine 1D cut, ask user for
c     data value, then find where value is located along that cut.
c
c     Programmer: John Faricelli
c     Date: 7-Oct-85
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
      logical error
      character*10 buffer
      character*80 errfmt
c
      errfmt = '('' '')'
c
c     Short circuit this menu if there is only one data item to select from
c
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( is_data_1d(1) ) then
            call find_loc(arr2d(1,menu_to_arr(1)), 1, ni,
     1                    xyz(1,idisti), charh)
         else if( data_is_trigrid ) then
            call clear_screen
            call beep_terminal
            write(luttyo,101)
101         format(' ','Sorry, data on triangular grid not supported ',
     1       'yet'/' ','Hit return to continue...')
            read(luttyi,106,end=300,err=300) buffer
         else
            call find_line(arrdat(arrind(menu_to_arr(1))),
     1                  ni, nj,
     2                  does_data_jump_at_oxide(1),
     3                  is_data_in_oxide(1))
         endif
         return
      endif
c
200   call clear_screen
      write(luttyo,errfmt)
      errfmt = '('' '')'
      call write_data_menu('Find data values:')
      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
         call find_loc(arr2d(1,menu_to_arr(answer)), 1, ni,
     1                 xyz(1,idisti), charh)
      else
         call find_line(arrdat(arrind(menu_to_arr(answer))),
     1                  ni, nj,
     2                  does_data_jump_at_oxide(answer),
     3                  is_data_in_oxide(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 find_line(data_array, max_h, max_v,
     1                     discontinuity, value_in_oxide)
      implicit none
c
      include 'const.h'
      include 'sysdep.cmn'
      include 'mesh.cmn'
      include 'data.cmn'
      include 'io.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, value_in_oxide
      real data_array(max_h, max_v)
c
c     locals
c
      real cut_line_coord, real_vec(10)
      real line1(COMP_ARRAYSIZE), line2(COMP_ARRAYSIZE),
     1     result(COMP_ARRAYSIZE)
      integer ulen, string_len
      integer type, index, discont_type
      integer i, j
      character*10 answer
      logical novalue_in_oxide
c
      integer getindex  ! function
c
      ulen = string_len(pm_length_unit)
      novalue_in_oxide = .NOT. value_in_oxide
c
c     Ask user for x or y line
99    call get_char(answer,
     1     'Search along vertical or horizontal line (V or H)? ',0)
      call upcase(answer)
      if ( answer(1:1) .eq. 'V' ) then
         type = V_CUT
      else if ( answer(1:1) .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 cut line coordinate value in ' //
     2     pm_length_unit(1:ulen) // ': ',0)
      cut_line_coord = 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...
      discont_type = 999
      if( type .eq. H_CUT .and. plane_type .eq. XY_PLANE .and.
     1    .NOT. nonplanar_boundary .and. cut_line_coord .eq. 0.0
     2    .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 (-1),'/
     1   ' ','   semiconductor (1), or average (0)? ',$)
         read(luttyi,*) discont_type
         if( discont_type .lt. -1 .or. discont_type .gt. 1 ) then
            write(luttyo,137) discont_type
137         format(' ','Illegal response: ',i5)
            goto 135
            endif
      endif
c
c     get equivalent index in array
      if( type .eq. V_CUT ) then     ! vertical cut
         index = getindex(cut_line_coord, xyz(1,idisti), ni)
      else
         index = getindex(cut_line_coord, xyz(1,idistj), nj) ! horizontal cut
      endif
      if( index .eq. 0 ) then
         write(luttyo,140) cut_line_coord
140      format(' ','Value ',1pe10.3,' not in device 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), cut_line_coord)
         if( novalue_in_oxide .and. plane_type .eq. XY_PLANE .and.
     1       .NOT. nonplanar_boundary ) then
            call find_loc(result, nyoxm+1, nj, xyz(1,idistj), charv)
         else
            call find_loc(result, 1, nj, xyz(1,idistj), charv)
         endif
      else
         if( discont_type .ne. 999 ) then
c           special handling of interface...
c           choose either oxide, interface or semiconductor
            if( discont_type .eq. -1 ) then
c              take one step up into oxide
               index = index - 1
               cut_line_coord = xyz(index,idistj)
            else if( discont_type .eq. 1 ) then
c              take one step down into semiconductor
               index = index + 1
               cut_line_coord = xyz(index,idistj)
            endif
         endif
         if( (cut_line_coord .lt. 0.0) .and. novalue_in_oxide
     1       .and. plane_type .eq. XY_PLANE .and.
     2       .NOT. nonplanar_boundary) then
            write(luttyo,300)
300         format(' ','This variable has no value in oxide!'/
     1             ' ','Hit return to continue...',$)
            read(luttyi,301) answer
301         format(' ',a1)
         else
            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), cut_line_coord)
            call find_loc(result, 1, ni, xyz(1,idisti), charh)
         endif
      endif
c
      return
      end
c
      subroutine find_loc(data_array, start, n, x, cut_axis)
      implicit none
c
      include 'const.h'
      include 'units.cmn'
      include 'sysdep.cmn'
      include 'io.cmn'
c
c     Finds location of data value in data_array
c
      character*1 cut_axis
      integer n, start
      real data_array(n), x(n)
c
c     locals
c
      logical found_it, lin_interp
      character*1 answer, ch
      integer i, ulen, string_len
      real value, real_vec(2), slope, position
c
      ulen = string_len(pm_length_unit)
      found_it = .FALSE.
c
      call get_reals(real_vec,1,'Data value to look for? ',0)
      value = real_vec(1)
c
      call get_char(ch,
     1 'Linear (L) or loGarithmic (G) interpolation? (L/G) [L] ',
     1              0)
      call upcase(ch)
      if( ch .ne. 'G' ) then
         lin_interp = .TRUE.
      else
         lin_interp = .FALSE.
      endif
c
      do 100 i=start, n-1
c
c        Is value between data_array(i) and (i+1)?
c        We make sure that data values are distinct, to avoid
c        multiple reports. This way, we only find transitions.
         if( (data_array(i) .ne. data_array(i+1)) .and.
     1       ( (value .ge. data_array(i) .and. 
     1          value .le. data_array(i+1)) .or.
     1         (value .le. data_array(i) .and. 
     1          value .ge. data_array(i+1)) ) ) then
c           Interpolate position
            found_it = .TRUE.
            if( lin_interp ) then
               slope = ( x(i+1) - x(i) ) /
     1                 ( data_array(i+1) - data_array(i) )
               position = slope*(value - data_array(i)) + x(i)
            else
               slope = ( x(i+1) - x(i) ) /
     1                 ( ALOG10(ABS(data_array(i+1)/data_array(i))) )
               position = slope*(ALOG10(ABS((value/data_array(i)))))
     1                    + x(i)
            endif
            write(luttyo,200) value,
     1                   cut_axis, position*pm_scale_cm2plot,
     1                   pm_length_unit(1:ulen)
200         format(' ','Data value ',1pe12.3,' found at ',
     1             a1, ' = ', 1pg12.5, ' ',a)
         endif
100   continue
c
      if( .not. found_it) then
         write(luttyo,1000)
1000     format(' ','Didn''t find value along this cut line')
      endif
      write(luttyo,1001)
1001  format(' ','Hit return to continue...',$)
      read(luttyi,1002) answer
1002  format(' ',a1)
      return
      end
