options /exte
	subroutine dix_search_init_search(control)
	implicit none
	include 'dix_search_def.inc'
c
	record /control/ control
	record /search_rec/ search
	call dix_util_init_table(control.search,sizeof(search))
	return
	end
c
c The library for file searches
c
	options /exte
	function dix_search_set_flags(control,idxb,idxe)
	implicit none
c
c This routines sets the search blocks according to the
c  input command
c
c  The fields
c  control.search (table) will be updated
c
	include 'dix_search_def.inc'
	record /control/ control	!:io: control block
	integer*4 idxb			!:i: start parameter number px
	integer*4 idxe                  !:i: end parameter number px
	integer*4 dix_search_set_flags    !:f: result
c
	integer*4 cli$present
	integer*4 cli$get_value
c
	character*(max_short_line_length) value1,value2
	character*(max_line_length) search_string
c
	record /search_rec/ search
	integer*4 istat,k,nk,ipos,idx,nk_nam,nk1,nk_s,flag
	logical*4 got_one,type_known,field_mode,field_ok,first

	character*2 nam

	external dix_msg_illwpos
	external dix_msg_illwsiz
	external dix_msg_invtyp
	external dix_msg_sizerr
	external dix_msg_typbitf
	external dix_msg_colnotf
	external dix_msg_illserecl
c
	integer*4 dix_search_con_nr
	integer*4 dix_con_check_field_size
	integer*4 dix_search_decent_search
c
	istat = 1
c
	got_one = .false.
c
	control.search_flags = 0
	if(cli$present('statistics')) control.search_flags = 
     1       control.search_flags .or. search_flag_statistics
c
	call cli$get_value('fast',value1,nk)
	if(nk .gt. 0) then
	  read(value1(1:nk),2000) control.search_block_size
2000	  format(i10)
	endif
c
	do idx=idxb,idxe
	  call sys$fao('P!UL',nk_nam,nam,%val(idx))
	  first = .true.
	  do while(cli$get_value(nam,search_string,nk_s))
c
c We have one, if we had a previous list, delete it now
c
	    if(.not. got_one) control.search.count = 0
c
	    call dix_search_init(search)
	    got_one = .true.
	    search.match_flag = match_flag_locate
	    if(cli$present('match.match'))  search.match_flag = match_flag_match
	    if(cli$present('match.eq'  ))   search.match_flag = match_flag_eq
	    if(cli$present('match.ne'  ))   search.match_flag = match_flag_ne
	    if(cli$present('match.lt'  ))   search.match_flag = match_flag_lt
	    if(cli$present('match.le'  ))   search.match_flag = match_flag_le
	    if(cli$present('match.ge'  ))   search.match_flag = match_flag_ge
	    if(cli$present('match.gt'  ))   search.match_flag = match_flag_gt
	    if(cli$present('match.valid'))  search.match_flag = match_flag_valid
	    if(cli$present('match.exists')) search.match_flag = match_flag_exists
	    if(cli$present('match.range'))  search.match_flag = match_flag_range
	    if(cli$present('match.never'))  search.match_flag = match_flag_never
	    if(cli$present('match.always')) search.match_flag = match_flag_always
c
	    search.location = search_location_data
	    if(cli$present('location.recl'))
     1            search.location = search_location_recl
	    if(cli$present('location.vfc'))
     1            search.location = search_location_vfc
	    if(cli$present('location.both'))
     1            search.location = search_location_both
c
	    if(search.location .eq. search_location_recl) then
	      if(search.match_flag .ne. match_flag_eq .and. 
     1           search.match_flag .ne. match_flag_ge .and.
     1           search.match_flag .ne. match_flag_gt .and.
     1           search.match_flag .ne. match_flag_le .and.
     1           search.match_flag .ne. match_flag_lt .and.
     1           search.match_flag .ne. match_flag_range) then
	        istat = %loc(dix_msg_illserecl)
	        goto 90
	      endif
	    endif
c
	    if(search.match_flag .eq. match_flag_range) then
c
c Two values, find the ':'
c
	      ipos = index(search_string(1:nk_s),':')
	      if(ipos .eq. 0) then
	        istat = %loc(dix_msg_colnotf)
	        goto 90
	      endif
c
c Split the string in two
c
	      search.name = search_string(1:ipos-1)
	      search.name2 = search_string(ipos+1:nk_s)
	      search.nkar  = ipos-1
	      search.nkar2 = nk_s-ipos
	    else
c
c Normal search, only one string
c
	      search.name   = search_string(1:nk_s)
	      search.nkar   = nk_s
	    endif
c
	    search.wild_flag = wildcard_flag_none
	    if(search.match_flag .eq. match_flag_locate .or.
     1         search.match_flag .eq. match_flag_match) then
	      if(cli$present('wildcard.standard') )
     1                     search.wild_flag = wildcard_flag_standard
	      if(cli$present('wildcard.extended') )
     1                     search.wild_flag = wildcard_flag_extended
	    endif
c
	    search.logic_flag = logic_flag_or
	    if(cli$present('logic.and')) search.logic_flag = logic_flag_and
c
	    search.not_flag    = cli$present('not')
	    if(first) then
c
c This is the start of a new parameter, for the first one 
c  set next_record to false, for other parameters to true
c
	      search.next_record = idx .ne. idxb
	      first = .false.
	    else
c
c The next value of all parameters, set the value according to the user's demand
c
	      search.next_record = cli$present('next_record')
	    endif
	    search.do_display  = cli$present('show')
c
	    search.case_sensitive = cli$present('case_sensitive')
c
	    if(.not. search.case_sensitive) 
     1         call str$upcase(search.name,search.name)
	    if(search.location .eq. search_Location_recl) then
	      search.datatype = enttyp_int
	      search.size = 4*bits_per_byte
	    else
c
c Set to no explicit datatype
c
	      search.datatype    = 0
	      search.nb_datatype = 0
c
	      call cli$get_value('type',value1,nk)
	      if(value1 .ne. ' ') then
c
c User set explicit type type[*size]
c Get the size of the explicit type (if present)
c
	        ipos = index(value1,'*')
	        if(ipos .ne. 0) then
	          istat = dix_search_con_nr(value1(ipos+1:nk),
     1             search.nb_datatype)
	          value1(ipos:) = ' '
	        endif
c
	        do k=1,enttyp_max_type
	          call dix_util_get_type_name(k,value2,nk,flag)
	          if(flag) then
	            if(value1 .eq. value2) search.datatype = k
	          endif
	        end do
c
c If no match, datatype is still zero, and that will be signalled
c  by con_check_field_size
c This will also take care of a default .nb_datatype
c
	        istat = dix_con_check_field_size(search.datatype,
     1                 search.nb_datatype,search.nb_reserved,
     1                 field_mode,field_ok,
     1                 search.is_variable,type_known)
	        if(.not. type_known) goto 11
	        if(.not. istat)      goto 111
	        if(.not. field_ok)   goto 112
	      endif
c
c Did the user specify the window
c
	      if(cli$present('window')) then
	        call cli$get_value('window.position',value1,nk)
	        if(nk .gt. 0) then
	          istat = dix_search_con_nr(value1(1:nk),search.position)
c                
                  if(.not. istat .or. search.position .lt. 0) then
	            call dix_message(control,dix_msg_illwpos,value1(1:nk))
                    istat = 0
	            goto 90
                  endif
	        else
	          search.position = 0
	        endif
c
c Get window size, if not present take the field size
c
	        search.size = search.nb_datatype	!default to datatype size	    
	        call cli$get_value('window.size',value2,nk1)
	        if(nk1 .gt. 0) then
	          istat = dix_search_con_nr(value2(1:nk1),search.size)
	        endif
c
c If no size found, take 1 byte
c
	        if(search.size .eq. 0) search.size = bits_per_byte
                if(.not. istat .or. search.size .le. 0) then
	          call dix_message(control,dix_msg_illwsiz,value2(1:nk1))
	          istat = 0
                  goto 90
	        endif
	      endif
	      call cli$get_value('field',search.fieldnam,search.nk_field)
	    endif
c
c Insert to a table
c
	    call dix_util_insert_table(control,
     1        control.search,search,
     1        5,control.zone_general,'SEARCH_ITEM')
	  end do
	end do
c
c Check for all validity
c
	istat = dix_search_decent_search(control)
	goto 90
11	call dix_message(control,dix_msg_invtyp,value1(1:nk))
	goto 90	 
111	call dix_message(control,dix_msg_sizerr,%val(search.size))   
	goto 90
112	call dix_message(control,dix_msg_typbitf,value1(1:nk))
	goto 90
90	dix_search_set_flags = istat
	return
	end
	function dix_search_decent_search(control)
	implicit none
c
	include 'dix_search_def.inc'
	record /control/ control
	integer*4 dix_search_decent_search
c
	record /search_rec/ search(*)
	pointer (p_search,search)
	integer*4 dix_search_convert_data
c
	external dix_msg_invcomb
	logical*4 dix_con_typ_is_text
	external dix_msg_ignlastand
	external dix_msg_ignwild
c
	integer*4 k,istat,datatype
c
	if(control.search.count .gt. 0) then
c
c Make it all some more decent
c  Check to see if at least one record has the .do_display
c
	  p_search = control.search.address
c
	  do k=1,control.search.count
	    if(search(k).do_display) goto 10
	  end do
c
c No display found, so set the first
c
	  search(1).do_display = .true.
10	  continue
c
	  do k=1,control.search.count
c
c try to convert the text to binary
c
	    datatype = search(k).datatype
	    if(datatype .eq. 0) datatype = enttyp_chr
	    
	    if(search(k).nb_datatype .eq. 0) then
	      search(k).nb_datatype  = search(k).nkar*bits_per_byte
	    endif
	    search(k).binary_type = datatype + 1	!force convert
	    search(k).is_text = dix_con_typ_is_text(datatype)
c
	    istat = dix_search_convert_data(control,search(k),
     1                  datatype,search(k).nb_datatype)
	    if(.not. istat) goto 90
c
c Sea for some not so bright ideas
c
	    if(search(k).match_flag .ne. match_flag_locate .and.
     1         search(k).match_flag .ne. match_flag_match  .and.
     1         search(k).match_flag .ne. match_flag_never  .and.
     1         search(k).match_flag .ne. match_flag_always) then
c
c locate/match mode
c If no window and no field, we can only do locate/match
c
	      if(search(k).size.eq.0 .and. search(k).fieldnam.eq.' ') then
	        call dix_message(control,dix_msg_invcomb,
     1            search(k).name(1:search(k).nkar))
	      endif
c
	      if(search(k).wild_flag .ne. wildcard_flag_none) then
	        call dix_message(control,dix_msg_ignwild,
     1            search(k).name(1:search(k).nkar))
	      endif
	    endif
c
	  end do
c
c If the last entry ahs the /and , tell the user 
c  this is being ignored
c
	  if(search(control.search.count).logic_flag .eq.logic_flag_and) then
	    call dix_message(control,dix_msg_ignlastand)
	  endif
c
	endif
90	dix_search_decent_search = istat
	return
	end
	function dix_search_search_file(control,file,quiet,
     1           max_rfas,rfas,n_rfas,reask_Wanted)
	implicit none
c
c Main entry for search file
c Return a list of rfas of the records that must be printer
c  rfas(1)       : the start record
c  rfas(2..nrfa) : the records to be printed
c
	include 'dix_search_def.inc'
c
c Search the file for a specific string in a record
c
	record /control/ control		!:i: control structure
	record /file_info/ file			!:i: the file to search
	logical*4 quiet				!:i: do not display progress
	integer*4 max_rfas			!:i: max rfs's displayed
	record /rfa/ rfas(*)			!:o: rhe rfa's
	integer*4 n_rfas			!:o: length of rfa's
	logical*4 reask_Wanted			!:i: force asking
	integer*4 dix_search_search_file
c
	character kar
	integer*4 nrec,istat,bpos,epos,k
	logical reask,found_it,do_display,fast
c
	include '($rmsdef)'
c
	external dix_msg_rewind
	external dix_msg_searrec
	external dix_msg_noseastr
	external dix_msg_seanotf
	external dix_msg_ctrlcseen
	integer*4 dix_rms_get
	logical*4 dix_search_found
	logical*4 dix_search_set_screen
	integer*4 dix_rms_get_rfa
c
	record /search_rec/ search(*)
	pointer (p_search,search)
c
	integer*4 dix_fastio_init
	integer*4 dix_fastio_get
	integer*4 dix_fastio_set_rfa
	integer*4 dix_fastio_set_rfa_rfa
c
	record /rfa/ rfa,rfa_start
	integer*4 n_extra_read,nk,recnr_start,term_chan,nrec_s
	integer*4 totnrec,totnbyt(2),totnfnd,nb(2)
	character*(max_line_length) line
c
c If mode = screen, and n_search=0  ask for parameters
c
	reask = reask_wanted
10	if(control.mode .eq. mode_screen) then
c
c Screen mode
c
	  if(reask .or. control.search.count .eq. 0) then
	    istat = dix_search_set_screen(control)
	    if(.not. istat) goto 90
	  endif
	endif
	reask = .true.
	if(control.search.count .eq. 0) then
	  istat = %loc(dix_msg_noseastr)
	  goto 90
	endif
c
	call dix_search_enable_ctrlt(term_chan,
     1            file.fnam(1:file.nk_fnam),file.filesize,fast)
c
c Try to enable fast search (if the user ask for it)
c
	fast = .false.
	if(control.search_block_size .ne. 0) then
	  istat = dix_fastio_init(control,file,control.search_block_size,4)
	  if(istat) then
c
c Fastion success, use fast normal io
c
	    file.search_block_size = control.search_block_size
	    fast = .true.
	  endif
	endif
c
c Now do the search
c
	if(control.rewind .or. .not. file.got_record) then
	  if(.not. quiet) call dix_message(control,dix_msg_rewind)
	  if(fast) then
	    call dix_fastio_rewind(control,file)
	  else
	    call dix_rms_rewind(control,file,-1)
	  endif
	  control.rewind = .false.
	else
	  if(fast) then
	    istat = dix_fastio_set_rfa(control,file)
	  endif
	end if
c
	control.control_c_seen = .false.
	nrec = file.rec_nr
	istat = %loc(dix_msg_seanotf)
	kar = ' '
	nrec_s = 0
	totnrec = 0
	totnbyt(1) = 0
	totnbyt(2) = 0
c
	p_search = control.search.address
c
c Restart for the next read of the first record
c
40	if(fast) then
	  istat = dix_fastio_get(control,file,
     1                           file.data.nb_data,
     1                           file.data.data_rec)
	  call dix_fastio_get_recnr(file)
	  call dix_fastio_return_rfa(file,rfa_start)		!remember this rec
	else
	  nrec_s = nrec_s + 1
	  istat = dix_rms_get(control,file)
	  call dix_rms_return_rfa(file,rfa_start)		!remember this rec
	  call dix_search_update(file.bucket_size,nrec_s,
     1                  rfa_start.bbnr,rfa_start)
	endif
c
c Update statistics
c
	if(istat) then
	  totnrec = totnrec + 1
	  nb(1) = file.data.nb_data
	  nb(2) = 0
	  call lib$addx(totnbyt,nb,totnbyt)
	endif
c
41	if(.not. istat) then
	  file.got_record = .false.
	  file.data.nb_data = 0
	  goto 90
	end if
	if(control.control_c_seen) then
	  call dix_message(control,dix_msg_ctrlcseen)
	  if(control.mode .eq. mode_screen) goto 10
	  goto 90
	end if
c
c Save the first rfa anyway
c
	if(max_rfas .gt. 0) then
          n_rfas = 1
          if(fast) then
            call dix_fastio_return_rfa(file,rfas(n_rfas))       
          else
            call dix_rms_return_rfa(file,rfas(n_rfas))  
          endif
	end if
c
c Now find the first "next_record" entry (or the last in the list)
c
42	bpos = 1
	n_extra_read = 0
        if(fast) then
          call dix_fastio_return_rfa(file,rfa_start)            !remember this rec
        else
          call dix_rms_return_rfa(file,rfa_start)               !remember this rec
        endif
	recnr_start = file.rec_nr
	if((control.debug .and. debug_find) .ne. 0) then
	  call sys$fao('Find in record !UL',nk,line,%val(file.rec_nr))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
c
c Now get the search block(s) to process for this record
c
50	do_display = search(bpos).do_display
	do k=bpos+1,control.search.count
	  if(search(k).next_record) goto 51
	  if(search(k).do_display) do_display = .true.
	end do
	k = control.search.count+1
51	epos = k-1
c
c Now search(bpos:epos) contain the search items for this record
c
	if((control.debug .and. debug_find) .ne. 0) then
	  call sys$fao(' Applying rules !UL-!UL of !UL',nk,line,
     1        %val(bpos),%val(epos),%val(control.search.count))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
c
c See if we need to remember this rfa (is do_display set?)
c
	if(do_display) then
	  if(n_rfas .lt. max_rfas) then
	    n_rfas = n_rfas + 1
	    if(fast) then
	      call dix_fastio_return_rfa(file,rfas(n_rfas))	
	    else
	      call dix_rms_return_rfa(file,rfas(n_rfas))	
	    end if
	  endif
	end if
c
c Now match
c
	found_it = dix_search_found(control,file,epos-bpos+1,search(bpos))
	if(found_it) then
	  bpos = epos + 1
c
c The first part matches, see if we want to search the next record also
c
	  if(bpos .le. control.search.count) then
c
c Yes there is more, read the next record, if error signal not found
c
	    call dix_main_print_debug(control,debug_find,
     1                 ' Reading next record')
	    if(n_extra_read .eq. 1) then
c
c Remember the rfa of the next record
c
	      if(fast) then
	        call dix_fastio_return_rfa(file,rfa)	
	      else
	        call dix_rms_return_rfa(file,rfa)	
	      endif
	    endif
c
c And read the next record
c
	    if(fast) then
	      if(.not. dix_fastio_get(control,file,
     1                 file.data.nb_data,
     1                file.data.data_rec)) goto 41
	    else
	      call dix_rms_return_rfa(file,rfa)	
	      if(.not. dix_rms_get(control,file)) goto 41
	    endif
	    n_extra_read = n_extra_read + 1
	    goto 50
	  endif
	end if	    
c
c  if we have read more then one record for this search
c  we need to skip back to the original record
c it depends on n_extra_read
c if 0 : no extra records read, display count and read next record    (40)
c if 1 : 1 extra record read, display count and continue without read (41)
c if >1, 2 or more records read, rfa contains the pointer to the
c        first extra record: reset to that rfa, and continue witout read(41)
c
	if(n_extra_read .gt. 1) then
	  call dix_main_print_debug(control,debug_find,'Restoring RFA')
	  if(fast) then
            istat = dix_fastio_set_rfa_rfa(control,file,rfa)
	    goto 40	!and read it
	  else
	    istat = dix_rms_get_rfa(control,file,file.cur_key,rfa)
	  endif
	  if(.not. istat) goto 90
	  file.rec_nr = recnr_start + 1
	endif
c
	nrec = nrec + 1
	if(.not. quiet) then
	  if(found_it .or. (mod(nrec,5) .eq. 1)) then
	    if(control.mode .eq. mode_interactive) then
	      write(*,1001) kar,nrec
1001	      format(a,'Reading record ',i6)
	      kar = '+'
	    else
	      call dix_message(control,dix_msg_searrec,%val(nrec))
	    end if
         end if
	endif
c
c If not found, go on reading
c
	if(.not. found_it) then
c
c If no extra records read, goto 40 (read next rec)
c  else goto 41 (process the record)
c
	  if(n_extra_read .eq. 0) goto 40
	  istat = 1
	  goto 41
	endif
c
c We found it. If the io was fast and the file is opened /modify
c  we need to reread the record in the normal way to be able
c to modify it. If the search took multiple records
c  we also need to reread the first again
c
	if(n_extra_read .ne. 0 .or. 
     1     (fast .and. file.modify)) then
	  file.got_record = .false.
c
c Read back the original record
c
	  istat = dix_rms_get_rfa(control,file,file.cur_key,rfa_start)
	  file.rec_nr = recnr_start 
	else
c
c We have the data in memory, we can use it
c
	  if(fast)  then
	    call dix_rms_put_rfa(file,rfa_start)
	  endif
	  istat = 1
	endif
c
90	if(istat .eq. rms$_eof) istat = %loc(dix_msg_seanotf)
c
	dix_search_search_file = istat
	call dix_search_disable_ctrlt(term_chan)
c
	if(istat) then
	  totnfnd = 1
	  nb(1) = file.data.nb_data
	else
	  nb(1) = 0
	  totnfnd = 0
	endif
	nb(2) = 0
	call dix_search_stats_add(control,totnrec,totnbyt,totnfnd,nb)
c
	return
	end
	options /exte
	function dix_search_set_screen(control)	
	implicit none
	include 'dix_search_def.inc'
c
c Search the file for a specific string in a record
c
	record /control/ control		!:i: control structure
	logical*4 dix_search_set_screen		!:f: true if exit with enter
c#
	integer*4 max_items
	parameter (max_items=13)
c
	integer*4 dis_ch,iterm,nkar,k,l,row,col,siz,override_size
	integer*4 flag,nk,ipos,i,istat,dis_hd,icol,offset
	integer*4 cols(max_items),sizs(max_items),mask,imask,nk1
	character*(max_search_length) str
	character*(max_short_line_length) value
	include '($smgdef)'
	logical reset_screen,field_ok,type_known,field_mode
c
	integer*4 dix_con_check_field_size
c
	character*(*) help_lines
	parameter (help_lines=
     1   'search items;'//
     1   'The user can specify a search string(s);'//
     1   'The program will search for the string for all records;'//
     1   'following the current one (or from the start of the file);'//
     1   'The following search options can be specified;'//
     1   ' NextRec: This string must be in the next record;'//
     1   ' CaseBl : The search string is case blind;'//
     1   ' Match  : The search technique:;'//
     1   '           Locate : The string must occur in the record /field;'//
     1   '           Match  : The string must match the whole record;'//
     1   '           Unix   : The string must match with Regexp chars;'//
     1   '           LT,LE,EQ,GE,GT : The string must match as defined;'//
     1   ' Wild   : None, no wildcards used;'//
     1   '          Standard  wildcards * and % used;'//
     1   '          Extended  a lot of extra wildcards;'//
     1   ' Loca   : Where to search;'//
     1   '           Data  : the normal record data;'//
     1   '           VFC   : the VFC record data;'//
     1   '           Data  : both the normaland the VFC  record data;'//
     1   '           Recl  : The recordlength;'//
     1   ' AndOr  : The next search string must match with AND or OR;'//
     1   ' NOT    : The result of the search is negated;'//
     1   ' Pos,Size: Use a substring of the record;'//
     1   ' Type   : Field type (not for field search);'//
     1   ' Field  : Or a fieldname (with VMS wildcarding)')

c
	external dix_msg_searabo
	integer*4 dix_search_con_nr
	integer*4 dix_search_decent_search
c
	record /search_rec/ search(*),searchw
	pointer (p_search,search)
c
c Search is not restricted, but the screen length is
c  so set a reasonable limit here
c
	integer*4 max_sear_str
	parameter (max_sear_str=255)
c
	integer*4 scroll_size
	parameter (scroll_size=10)
c
	p_search = control.search.address
	offset   = 1
c
c  If the user entered pf1-find, ask anyway
c  if no strings defined, ask
c See for the old search strings
c  We need at a 132 col screen
c
	if(control.ncols .lt. 132) then
	   call smg$change_pbd_characteristics(control.paste_id,132)
	   reset_screen = .true.
	else
	   reset_screen = .false.
	endif
	call smg$create_virtual_display(2,128,dis_hd)
	call smg$create_virtual_display(max_sear_str,128,dis_ch)
	call smg$create_viewport(dis_ch,1,1,scroll_size,128)
c
	call smg$label_border(dis_hd,'Record find input')
	call smg$paste_virtual_display(dis_ch,control.paste_id,8,3)
	call smg$label_border(dis_ch,'Record find input')
c
	call smg$paste_virtual_display(dis_hd,control.paste_id,5,3)
c
	call smg$put_chars(dis_hd,
     1     'Starting from current record or BOF ([C]/B):  '//
     1     ' (toggle with Select)',1,1)
	str = 'C'
	if(control.rewind) str = 'B'
	call smg$put_chars(dis_hd,str(1:1),1,45)
c
c Build up header
c
	l   = 1
c
	cols(l) = 1
	sizs(l) = 7
	call smg$put_chars(dis_hd,'Nextrec',2,cols(l))
	l= l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = max_search_length
	call smg$put_chars(dis_hd,'Search string',2,cols(l))
	l= l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Show',2,cols(l)-1)
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'CaseBl',2,cols(l)-1)
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Match'  ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Wild'  ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Loca'  ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Andor' ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Not'   ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Pos'   ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 5
	call smg$put_chars(dis_hd,'Size'  ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = 15
	call smg$put_chars(dis_hd,'Type' ,2,cols(l))
	l = l + 1
c
	cols(l) = cols(l-1) + sizs(l-1)+1
	sizs(l) = max_search_length
	call smg$put_chars(dis_hd,'Field'  ,2,cols(l))
c
c Now display the data
c
	do k=1,control.search.count
	  call dix_search_display_line(dis_ch,search(k),k,-1,cols,sizs)
	end do
c
10	iterm = 0
c
	row = 1
	icol = 1
	call dix_smg_stack_help(control,help_lines)
c
c Restart point for editing
c
12	row = min(max_sear_str,max(1,row))
	if(row .gt. control.search.count) then
c
c Beyond the end, force to string field, on last line + 1
c
	  icol = 2
	  row = control.search.count+1
	endif
	icol = min(max_items,max(1,icol))
c
c Make sure row is on screen
c
	do while(row .lt. offset)
	  call smg$scroll_viewport(dis_ch,smg$m_down)
	  offset = offset - 1
	end do
c
	do while(row .ge. offset+scroll_size)
	  call smg$scroll_viewport(dis_ch,smg$m_up)
	  offset = offset + 1
	end do
c
c For the first search item, no next_record flag
c 
	if(row .eq. 1 .and. icol .eq. 1) icol = 2
c
	col = cols(icol)
	siz = sizs(icol)
	mask = 2**(icol-1)
c                     
14	iterm = 0
	call dix_smg_get_string_1(control,dis_ch,row,col,siz,str,
     1             0,iterm,nkar,.false.)
	istat = %loc(dix_msg_searabo)
	if(iterm .eq. key_exit) goto 90
c
	if(iterm .eq. key_select) then
c
c Toggle c/b
c
	  control.rewind = .not. control.rewind
	  str = 'C'
	  if(control.rewind) str = 'B'
	  call smg$put_chars(dis_hd,str(1:1),1,45)
	  goto 14
	endif
c
	if(row .gt. control.search.count) then
c
c Beyond the end, if the value is not empty, insert a new line
c New search item, take all defaults
c
	  if(nkar .gt. 0) then
	    call dix_search_init(searchw)
            call dix_util_insert_table(control,control.search,searchw,
     1             5,control.zone_general,
     1             'SEARCH_ITEM')
            p_search = control.search.address
            call dix_search_display_line(dis_ch,search(row),row,-1,cols,sizs)
	  else
c
c Still empty, only interpret the terminator
c
	    goto 19
	  endif
	endif

c
c  Delete empty search records
c
	if(iterm .eq. key_remove) then
	  if(row .lt. control.search.count) then
	    do l=row+1,control.search.count
	      search(l-1) = search(l)
              call dix_search_display_line(dis_ch,search(l-1),
     1               l-1,-1,cols,sizs)
	    end do
	    control.search.count = control.search.count - 1
	  endif
c
c Clear bottom line
c
	  call smg$erase_line(dis_ch,control.search.count+1,1)
	  call dix_search_init(search(control.search.count+1))
c
c And interpreted the terminator
c
	  goto 19
	endif
c
	if(iterm .eq. key_put) then
	  searchw = search(control.search.count)
c
c Move all one down (upto .search.count-1)
c
	  do l=control.search.count-1,row,-1
	    search(l+1) = search(l)
            call dix_search_display_line(dis_ch,search(l+1),l+1,-1,cols,sizs)
	  end do
c
c And insert the last one again
c
          call dix_util_insert_table(control,control.search,searchw,
     1             5,control.zone_general,
     1             'SEARCH_ITEM')
          p_search = control.search.address
	  l = control.search.count
          call dix_search_display_line(dis_ch,search(l),l,-1,cols,sizs)
c
c Now clear the index row
c
	  call dix_search_init(search(row))
          call dix_search_display_line(dis_ch,search(row),row,-1,cols,sizs)
	  icol = 1
	  goto 14
	endif
c
c See if room
c
c
c Now validate the current field
c
	imask = mask
c 
	if(icol .eq. 1) then	!nextrec
	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'Y' .or. str(1:1) .eq. 'N') then
c
c The display is casebl (ind), so a NO as answer means case_sens
c
	    search(row).next_record = str(1:1) .eq. 'Y'
	  endif
	elseif(icol .eq. 2) then
	  search(row).name = str
	  search(row).nkar = nkar
	elseif(icol .eq. 3) then	!case
	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'Y' .or. str(1:1) .eq. 'N') then
c
c The display is casebl (ind), so a NO as answer means case_sens
c
	    search(row).do_display = str(1:1) .eq. 'Y'
	  endif
c
	elseif(icol .eq. 4) then	!case
	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'Y' .or. str(1:1) .eq. 'N') then
c
c The display is casebl (ind), so a NO as answer means case_sens
c
	    search(row).case_sensitive = str(1:1) .eq. 'N'
	  endif
c
	elseif(icol .eq. 5) then	!match
	  call str$upcase(str,str)
	  if(str(1:2) .eq. 'LO') search(row).match_flag = match_flag_locate
	  if(str(1:1) .eq. 'M' ) search(row).match_flag = match_flag_match
	  if(str(1:2) .eq. 'LT') search(row).match_flag = match_flag_lt
	  if(str(1:2) .eq. 'LE') search(row).match_flag = match_flag_le
	  if(str(1:2) .eq. 'EQ') search(row).match_flag = match_flag_eq
	  if(str(1:3) .eq. 'NE ')search(row).match_flag = match_flag_ne
	  if(str(1:2) .eq. 'GE') search(row).match_flag = match_flag_ge
	  if(str(1:2) .eq. 'GT') search(row).match_flag = match_flag_gt
	  if(str(1:1) .eq. 'V' ) search(row).match_flag = match_flag_valid
	  if(str(1:2) .eq. 'EX') search(row).match_flag = match_flag_exists
	  if(str(1:1) .eq. 'R' ) search(row).match_flag = match_flag_range
	  if(str(1:3) .eq. 'NEV') search(row).match_flag = match_flag_never
	  if(str(1:1) .eq. 'A' ) search(row).match_flag = match_flag_always
	elseif(icol .eq. 6) then	!wild
	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'N') search(row).wild_flag = wildcard_flag_none
	  if(str(1:1) .eq. 'S') search(row).wild_flag = wildcard_flag_standard
	  if(str(1:1) .eq. 'E') search(row).wild_flag = wildcard_flag_extended
	elseif(icol .eq. 7) then	!location
	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'D') search(row).location = search_location_data
	  if(str(1:1) .eq. 'V') search(row).location = search_location_vfc
	  if(str(1:1) .eq. 'B') search(row).location = search_location_both
	  if(str(1:1) .eq. 'R') search(row).location = search_location_recl
	elseif(icol .eq. 8) then	!andor
 	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'O') search(row).logic_flag = logic_flag_or
	  if(str(1:1) .eq. 'A') search(row).logic_flag = logic_flag_and
	elseif(icol .eq. 9) then	!not

	  call str$upcase(str,str)
	  if(str(1:1) .eq. 'Y' .or. str(1:1) .eq. 'N') then
	    search(row).not_flag = str(1:1) .eq. 'Y'
	  endif
	elseif(icol .eq. 10) then  !pos
c
c Position field
c
	  istat = dix_search_con_nr(str(1:nkar),i)
	  if(istat .and. i .ge. 0) search(row).position = i
	elseif(icol .eq. 11) then  !size
c
c Size field
c
	  istat = dix_search_con_nr(str(1:nkar),i)
	  if(istat .and. i .ge. 0) search(row).size = i
	elseif(icol .eq. 12) then	!not
c
c Datatype
c
	  call str$upcase(str,str)
	  ipos = index(str(1:nkar),'*')
	  override_size = search(row).size
	  if(ipos .ne. 0) then
	    istat = dix_search_con_nr(str(ipos+1:nkar),override_size)
	    if(.not. istat) goto 11
	    str(ipos:) = ' '
	  endif
	  do i=1,enttyp_max_type
	    call dix_util_get_type_name(i,value,nk,flag)
	    if(flag) then
	      if(str .eq. value) then
	        field_mode=mod(search(row).position,bits_per_byte).ne.0 .or.
     1                     mod(override_size,bits_per_byte) .ne. 0
	        istat = dix_con_check_field_size(i,override_size,
     1                    nk1,field_mode,field_ok,nk1,type_known)
	        if(.not. type_known) goto 11
	        if(.not. istat)      goto 11
	        if(.not. field_ok)   goto 11
	        search(row).datatype    = i
	        search(row).nb_datatype = override_size
	      endif
	    endif
	  end do
c
c If this changed, redisplay the size field also
c
11	  imask = imask .or. mask/2
	elseif(l .eq. 13) then
c
c fieldname
c
	  call str$upcase(search(row).fieldnam,str)
	  search(row).nk_field = nkar
	endif
c
c And update the line again
c
	call dix_search_display_line(dis_ch,search(row),row,imask,cols,sizs)
c
19	if(iterm .eq. key_down) then
	  row = row + 1
	elseif(iterm .eq. key_up) then
	  row = row - 1
	elseif(iterm .eq. key_prev) then
	  icol = icol - 1
	  if(icol .eq. 0) then
	    if(row .eq. 1) then
	      icol = icol + 1
	    else
	      row = row - 1
	      icol = max_items
	    endif
	  endif
	elseif(iterm .eq. key_next .or.
     1         iterm .eq. key_next_window .or. 
     1         iterm .eq. key_enter) then
	  icol = icol + 1
	  if(icol .gt. max_items) then
	    row = row + 1
	    icol = 1
	  endif
	elseif(iterm .eq. key_do) then
	  istat = 1
	  goto 30
	endif
	goto 12
c
30	call dix_smg_unstack_help(control)
c
90	call smg$delete_virtual_display(dis_ch)
	call smg$delete_virtual_display(dis_hd)
	if(reset_screen) then
	  call smg$change_pbd_characteristics(control.paste_id,
     1            control.ncols)
	endif
c
c Decent the search items
c
	istat = dix_search_decent_search(control)
	dix_search_set_screen = istat
	return
	end
	subroutine dix_search_init(search)
	implicit none
c
c Init a new empty search-item
c
	include 'dix_search_def.inc'
	record /search_rec/ search
c
	search.name     = ' '
        search.nkar     = 0
        search.fieldnam = ' '
        search.nk_field = 0
        search.logic_flag = .false.
        search.logic_flag = logic_flag_or
        search.match_flag = match_flag_locate 
        search.wild_flag  = wildcard_flag_none
	search.location   = search_location_data
        search.case_sensitive = .false.
        search.not_flag = .false.
        search.position = 0
        search.size     = 0	  
        search.datatype = 0
	search.binary_size = 0
	search.binary_type = 0
        search.nb_datatype= 0	  
	search.do_display =  .false.
	search.nb_binary  = 0
	search.nb_binary2 = 0
	return
	end
c
       	subroutine dix_search_display_line(dis_ch,search,row,mask,
     1                                   cols,sizs)
	implicit none
c
c Display (part of) a line
c
	include 'dix_search_def.inc'
	integer*4 dis_ch		!:i: display id
	record /search_rec/ search		!:i: data
	integer*4 row 			!:i: the row
	integer*4 mask			!:i: the mask
	integer*4 cols(*)		!:i: cols for fiels
	integer*4 sizs(*)               !:i: sizes for fields
c
	character*(max_search_length) str
	integer*4 k,flag,nk
	str = ' '
c
c We knwo we have 10 fields
c
	do k=1,13
	  if(btest(mask,k-1)) then
	    str = ' '
	    if(k .eq. 1) then	!next record flag
	      str = 'No'
	      if(search.next_record) str = 'Yes'
	    elseif(k .eq. 2) then	!search item
	      str = search.name(1:search.nkar)
	    elseif(k .eq. 3) then	!case sensitive
	      str = 'No'
	      if(search.do_display) str = 'Yes'
	    elseif(k .eq. 4) then	!case sensitive
	      str = 'Yes'
	      if(search.case_sensitive) str = 'No'
	    elseif(k .eq. 5) then	!match mode
	      call dix_search_con_match(search.match_flag,str,nk)
	    elseif(k .eq. 6) then	!wild mode
	      call dix_search_con_wild(search.wild_flag,str,nk)
	    elseif(k .eq. 7) then	!wild mode
	      call dix_search_con_loca(search.location,str,nk)
	    elseif(k .eq. 8) then	!and/or flag
	      str = 'OR'
	      if(search.logic_flag .eq. logic_flag_and) str = 'AND'
	    elseif(k .eq. 9) then	!not flag
	      str = 'No'
	      if(search.not_flag) str = 'Yes'
	    elseif(k .eq. 10) then	!position
	      call dix_search_con_nra(search.position,nk,str)
	    elseif(k .eq. 11) then	!size
	      call dix_search_con_nra(search.size,nk,str)
	    elseif(k .eq. 12) then	!override datatype
	      call dix_util_get_type_name(search.datatype,str,nk,flag)
	    elseif(k .eq. 13) then !fieldname
	      str= search.fieldnam(1:search.nk_field)
	    else
	      nk = 0
	    endif
	    call smg$put_chars(dis_ch,str(1:sizs(k)),row,cols(k))
	  endif
	end do

c
	return
	end
	function dix_search_found(control,file,n_Search,search)
	implicit none
	include 'dix_search_def.inc'
c
c Search the file for a specific string
c
	record /control/ control
	record /file_info/ file			!:i: the data
	integer*4 n_search               	!:i: nsearch 
	record /search_rec/ search(*)	        !:i: the sarch items
	logical*4 dix_search_found
c#
	logical*4 result,match
	integer*4 k,and_start,nk,ipos,jpos
	character*(max_line_length) line
c
	logical*4 dix_search_string_found
	integer*4 dix_dump_inter_match_file
c
	k = 1
	match = .false.
	and_start = 0
c
	do while(k .le. n_search)
c
c See if this one matches
c
	  if((control.debug .and. debug_find) .ne. 0) then
	    call dix_search_print_debug(control,search(k),k,k .le. n_search)
	  endif
c
c See if the fieldnam(1:search(k).nkar) contains two \
c  if so, the first part is a file pattern
c
	  ipos = index(search(k).fieldnam(1:search(k).nk_field),'\')
	  if(ipos .ne. 0) then
	    jpos = index(search(k).fieldnam(ipos+1:search(k).nk_field),'\')
	    if(jpos .ne. 0) then
	      jpos = jpos + ipos
c
c Now      1:ipos-1 contains the filemask
c     ipos+1:jpos-1 the description mask
c     jpos+1:       the fieldname mask
c
	      if(.not. dix_dump_inter_match_file(file,
     1           search(k).fieldnam(1:ipos-1),
     1           wildcard_flag_standard)) then
	        call dix_main_print_debug(control,debug_find,
     1                 'Item skipped on filename mask')
	        goto 25
	      endif
	    endif
c
	  endif	   
c
c In alle cases the fieldnam(ipos+1:) contains the
c    (possible) descriptionmask + fieldmask  
c  Let search_string_found handle the descriptionmask
c
	  result = dix_search_string_found(control,file,search(k))
c
	  if((control.debug .and. debug_find) .ne. 0) then
	    call sys$fao('   Result !1UL',nk,line,%val(result .and. 1))
	    call dix_main_print_debug(control,debug_find,line(1:nk))
	  endif
c
	  if(search(k).not_flag) result = .not. result
c
c See if new start of and_string
c
	  if(search(k).logic_flag .eq. logic_flag_and) then
	    if(and_start .eq. 0) and_start = k
	  endif
c
	  if(result) then
c
c We have a match, see if we were in an and_string 
c
	    if(and_start .eq. 0) then
c
c No, so match
c 
	      goto 70
	    else
c
c We are/were in an and_string, and it still matches
c  see if this one stil has the and flag set (or is the last)
c
	      if(.not. search(k).logic_flag .eq. logic_flag_and .or. 
     1           k .eq. n_search) then
c
c Either no more and or the last, exit with the last
c
	        k = and_start
	        goto 70
	      endif
c
c Still in and, and not the last, continue search
c
	    endif
	  else
c
c No match, see if we are in an and_sting
c
	    if(and_start .ne. 0) then
c
c We are in an and string. clear the and flag and skip to
c  the first one with no /and. That is he last of the and chain
c
	      and_start = 0
20	      if(k .gt. n_search) goto 50
	      k = k + 1
	      if(search(k).logic_flag .eq. logic_flag_and) goto 20
c
c Now (k) is the first entry that no longer has the /and flag
c  so the next one starts a new search
c
	    endif
	  endif
25	  k = k + 1
	enddo
c
50	k = 0
c
70	dix_search_found = k .gt. 0
	if((control.debug .and. debug_find) .ne. 0) then
	  k = iand(dix_search_found,1)
	  call sys$fao('  Total result !1UL',nk,line,%val(k))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
	return
	end
	function dix_search_string_found(control,file,search)
	implicit none
c
c Try to locate a sub string in a (part of a) string
c
	include 'dix_search_def.inc'
	record /control/ control
	record /file_info/ file		!:i: the file record
	record /search_rec/ search		!:i: the search data
	logical*4 dix_search_string_found	!:f: the result
c#
	integer*4 istat,k,n_des,nk,ipos,data_des(2),phase
	character*(max_line_length) line
	logical*4 do_vfc
c
	record /des_rec/ des_recs(*)
	pointer (p_des_recs,des_recs)
	record /des_rec/ des_rec
c
	record /des_expanded/ des_expanded
	pointer (p_des_expanded,des_expanded)
c
	logical*4 dix_util_match_string_wild
	integer*4 dix_search_compare
	integer*4 dix_des_expand
	logical*4 dix_dump_inter_match_des
	integer*4 dix_search_convert_data
	logical*4 dix_con_typ_is_text
	integer*4 dix_search_check_field
c
	external dix_msg_nodescr
c
c Sourc for upcase is the data record
c
	if(search.match_flag .eq. match_flag_never) then
	  istat = 0
	  goto 90
	elseif(search.match_flag .eq. match_flag_always) then
	  istat = 1
	  goto 90
	endif	  
c
	istat = 0
c
	if(search.location .eq. search_location_recl) then
	  if(search.match_flag .eq. match_flag_eq) then 
	     istat = file.data.nb_data .eq. search.value1
	  elseif(search.match_flag .eq. match_flag_ge) then 
	     istat = file.data.nb_data .ge. search.value1
	  elseif(search.match_flag .eq. match_flag_gt) then 
	     istat = file.data.nb_data .gt. search.value1
	  elseif(search.match_flag .eq. match_flag_le) then 
	     istat = file.data.nb_data .le. search.value1
	  elseif(search.match_flag .eq. match_flag_lt) then 
	     istat = file.data.nb_data .lt. search.value1
	  elseif(search.match_flag .eq. match_flag_range) then 
	    istat = file.data.nb_data .ge. search.value1 .and.
     1              file.data.nb_data .le. search.value2
	  else
	    istat = 0
	  endif	  
	  if((control.debug.and. debug_find) .ne. 0) then
	    call sys$fao('    Comparing recl !UL to !UL, '//
     1             'result = !1UL',nk,line,
     1               %val(file.data.nb_data),
     1               %val(search.value1),
     1               %val(istat .and. 1))
	    call dix_main_print_debug(control,debug_find,line(1:nk))
	  endif	
	  
	  goto 90
	endif
c
	do phase=1,2
c
c Check for record location, phase 1 : do the record data
c
	  do_vfc = phase .eq. 2
	  if(.not. do_vfc) then
c
c phase 1 : do the record data, so skip if only vfc data wanted
c
	    if(search.location .eq. search_location_vfc) goto 67
	    data_des(1) = file.data.nb_data
	    data_des(2) = %loc(file.data.data_rec)
	  else
c
c phase 2 : do the vfc data, so skip if only record data wanted
c
	    if(file.data.nb_vfc .eq. 0) goto 67	!no vfc data present
	    if(search.location .eq. search_location_data) goto 67
	    data_des(1) = file.data.nb_vfc
	    data_des(2) = %loc(file.data.vfc_data)
	  endif
c
	  if(search.fieldnam .ne. ' ') then
	    if(file.top_des .eq. 0) then
	      call dix_message(control,dix_msg_nodescr)
	      istat = 0
	    endif
c
c Go through all descriptions, start with the first
c
	    p_des_expanded = file.top_des
	    goto 14
c
c Take the next
c
12	    p_des_expanded = des_expanded.link.forw
c
c Restart for next description
c
14	    if(p_des_expanded .eq. 0) goto 19	!we had all descriptions
c
c User wants to find data in field
c
c The fieldname layout is [desmask\]fieldmask
c See if the des mask is present
c  if so see if if matches the current description
c
	    ipos = index(search.fieldnam,'\')
	    if(ipos .gt. 0) then
	      if(.not. dix_dump_inter_match_des(des_expanded,
     1             search.fieldnam(1:ipos-1),
     1             wildcard_flag_standard)) then
	        call dix_main_print_debug(control,debug_find,
     1                 'Desciption skipped on description mask')
	        goto 12		!ignore this description, try the next
	      endif
	    endif
c
c  Now fieldnam(ipos+1:) contains the field mask
c Expand the description
c
	    istat = dix_des_expand(control,des_expanded,file,.true.)
	    if(.not. istat) goto 90
c
c Now check all fields, first the normal ones, and than the VFC fields
c 
16	    if(do_vfc) then
	      p_des_recs = des_expanded.table_vfc.address
	      n_des = des_expanded.table_vfc.count
	    else
	      p_des_recs = des_expanded.table_nor.address
	      n_des = des_expanded.table_nor.count
	    endif
c
	    do k=1,n_des
c
c Now get a matching field field (all uppercase) and no unix compare
c
	      if(dix_util_match_string_wild(des_recs(k).nam,
     1                 search.fieldnam(ipos+1:search.nk_field),
     1                 .false.,
     1                 wildcard_flag_standard)) then
c
c Now we have a valid field, if exists wanted, all done
c
	        if(search.match_flag .eq. match_flag_exists) goto 90
c
c The fieldname matches, see if data matches
c
	        des_rec = des_recs(k)
c
	        if((control.debug .and. debug_find) .ne. 0) then
	          call sys$fao('   Checking field !AS , size !UL',nk,line,
     1                des_rec.nam,%val(des_rec.size))
	          call dix_main_print_debug(control,debug_find,line(1:nk))
	        endif
c
c Check if type/override type/window all combine together
c
	        istat = dix_search_check_field(control,des_rec,search)
	        if(.not. istat) goto 18	!not valid, try next
c
	        search.is_text = dix_con_typ_is_text(des_rec.ent_type)
c
c Convert data if type has changed
c
	        istat = dix_search_convert_data(control,search,
     1                     des_rec.ent_type,des_rec.size)
	        if(.not. istat) goto 18	!not convertable, skip for now
c
c If conversion success and type=valid, all done
c
	        if(search.match_flag .eq. match_flag_valid) goto 90
c
	        istat = dix_search_compare(control,des_rec,data_des,
     1                search.datatype,
     1                search.nb_binary,
     1                search.nb_binary2,
     1                search.binary_data,
     1                search.binary_data2,
     1                search.name(1:search.nkar),
     1                search.name2(1:search.nkar2),
     1                search.match_flag,search.wild_flag,
     1                search.case_sensitive,
     1                search.is_text)
c
c If compare success, all done
c
	        if(istat) goto 90
	      endif	!fieldname matches
18	    end do	!loop over fieldnames
c
c Not found in this decsiption, check for the next one
c
	    goto 12
c
c Field not found or no field matched, so return no match
c
19	    istat = 0
	    goto 90
c
	  else
c
c No fieldname, take the whole record, or a subset (pos,size)
c  Make a des_rec
c
	    call dix_util_clear_descr(des_rec.nam,.false.)
	    call dix_util_clear_descr(des_rec.fldnam,.false.)
c
c Take the whole record as character type
c
	    des_rec.ent_type   = enttyp_chr
c	    is_text            = search.is_text
	    des_rec.size       = data_des(1)*bits_per_byte
	    des_rec.bit_offset = 0
	    des_rec.flags      = 0
	    des_rec.link_back  = 0
	    des_rec.min_val    = 0
	    des_rec.max_val    = 0
	    des_rec.p_link_rec = 0
	    des_rec.lun_translate= 0
c
c See if the overrrides match together /window
c
	    istat = dix_search_check_field(control,des_rec,search)
	    if(.not. istat) goto 90	!not valid, so exit
c
c If only exists, all done now (istat is true)
c
	    if(search.match_flag .eq. match_flag_exists) goto 90
c
c Now do the compare
c
	    istat = dix_search_compare(control,des_rec,data_des,
     1                 search.datatype,
     1                 search.nb_binary,
     1                 search.nb_binary2,
     1                 search.binary_data,
     1                 search.binary_data2,
     1                 search.name(1:search.nkar),
     1                 search.name2(1:search.nkar2),
     1                 search.match_flag,
     1                 search.wild_flag,
     1                 search.case_sensitive,
     1                 search.is_text)
	    if(istat) goto 90
	  endif
67	end do
c
c Return exit status
c
90	dix_search_string_found = istat
c
	return
	end
	function dix_search_check_field(control,des_rec,search)
	implicit none
c
c Now des_rec contains the description of the record or field
c  search.(nb_)datatype the override type
c  window.position/size the subset of the field/record
c
	include 'dix_search_def.inc'
c
	record /control/ control		!:i: control block
	record /des_rec/ des_rec		!:io: desciption
	record /search_rec/ search			!:i: search block
	integer*4 dix_search_check_field	!:f: return true/false
c
	character*255 line
	integer*4 nk,org_size
c
	dix_search_check_field = .false.	!assume error
c
	if((control.debug .and. debug_find) .ne. 0) then
	  call sys$fao('     Check field org offs !UL.!UL,size =!UL.!UL',
     1                  nk,line,
     1                 %val(des_rec.bit_offset/bits_per_byte),
     1                 %val(mod(des_rec.bit_offset,bits_per_byte)),
     1                 %val(des_rec.size/bits_per_byte),
     1                 %val(mod(des_rec.size,bits_per_byte)))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	  call sys$fao('              Window offs !UL.!UL,size =!UL.!UL',
     1                 nk,line,
     1                 %val(search.position/bits_per_byte),
     1                 %val(mod(search.position,bits_per_byte)),
     1                 %val(search.size/bits_per_byte),
     1                 %val(mod(search.size,bits_per_byte)))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
c
	org_size = des_rec.size
c
	if(search.size .ne. 0) then
c
c First check 2 inputs
c  des_rec               : the original field/record
c  search.posiiton/size  : the /window=(pos=m,siz=m)
c
c No override, check if the window still in the field
c Des_rec.bit_offset is either 0(whole record) or the offset of the field
c
	  if(search.position .ge. des_rec.size) goto 70	!completely out of field
	  des_rec.bit_offset = des_rec.bit_offset + search.position
c
c See if the whole field fits
c
	  if(search.position + search.size .gt. des_rec.size) then
c
c THe whole field does not fit, it variable length all oke
c  else not
c
	    if(.not. search.is_variable) goto 90
	    des_rec.size = des_rec.size - des_rec.bit_offset
	  else
c
c Clip size to explicit size
c
	    if(search.size .ne. des_rec.size) then
	      if(.not. search.is_variable) goto 60
	    endif	
	    des_rec.size = search.size
	  endif
c
	endif
c
c All checks oke, des_rec has been updated
c
	dix_search_check_field = .true.
	goto 90
c
c Partial fit, but not var field
c
60	if((control.debug .and. debug_find) .ne. 0) then
	  call sys$fao('   Partial fit, but not variable type = !UL',
     1          nk,line,%val(des_rec.ent_type))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
c
c completely out of range
c
70	if((control.debug .and. debug_find) .ne. 0) then
	  call sys$fao('   Out of field pos=!UL.!UL, field=!UL.!UL',
     1                nk,line,%val(search.position/bits_per_byte),
     1                nk,line,%val(mod(search.position,bits_per_byte)),
     1                %val(des_rec.size/bits_per_byte),
     1                %val(mod(des_rec.size,bits_per_byte)))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
	goto 99
c
c Requested pos/size fits (partially) in field
c
90	if(org_size .ne. des_rec.size) then
	  if((control.debug .and. debug_find) .ne. 0) then
	    call sys$fao('   Part out of field pos=!UL.!UL, size=!UL.!UL'//
     1                ' size clipped to !UL.!UL',
     1                nk,line,
     1                 %val(search.position/bits_per_byte),
     1                 %val(mod(search.position,bits_per_byte)),
     1                %val(org_size/bits_per_byte),
     1                %val(mod(org_size,bits_per_byte)),
     1                %val(des_rec.size/bits_per_byte),
     1                %val(mod(des_rec.size,bits_per_byte)))
	    call dix_main_print_debug(control,debug_find,line(1:nk))
	  endif
	endif
99	return
	end

	function dix_search_compare(control,des_rec,data_rec,datatype,
     1                       nb_binary,nb_binary2,
     1                       binary_data,binary_data2,
     1                       seastr,seastr2,
     1                       match_flag,wild_flag,case_sensitive,
     1                       is_text)
	implicit none
c
c  See if the "sear" string matches the source described by des_rec
c  depending on compare mode and case_sensitivity
c 
	include 'dix_search_def.inc'
	record /control/ control
	character*(*) data_rec		!:i: the record/vfcdata
	record /des_rec/ des_rec	!:i: the description
	integer*4 datatype		!:i: explicit data type
	character*(*) seastr		!:i: the search string
	character*(*) seastr2		!:i: the 2ndsearch string for range
	integer*4 nb_binary		!:i: #bits in binaty data
	integer*4 nb_binary2		!:i: #bits in binaty data
	byte binary_data(*)		!:i: the binary data
	byte binary_data2(*)		!:i: the binary data for range data
	integer*4 match_flag		!:i: match loc/match/eq/ge/..
	integer*4 wild_flag		!:i: the wild flag none/stand/ext
	logical*4 case_sensitive	!:i: case_sensitive?
	logical*4 is_text		!;i: text type
	logical*4 dix_search_compare	!:f: t/f match
c#
	integer*4 pos,istat,nb_rem,result,nk,flag
	integer*4 descr1(2),descr2(2)
	logical*4 case_sens
	character*(max_line_length) line,str
c
	integer*4 dix_util_match_string_wild
	integer*4 dix_util_find_string_wild
	integer*4 dix_con_compare
c
	istat = 0
	if(is_text) then
	  case_sens = case_sensitive
	else
	  case_sens = .false.
	endif
c
c The compare <,<=,=,>=,> should be done in the con_library
c  since that is the only module with knowledge about the data contents
c dix_con_commpare delivers the following result
c -1 if sear<datarec
c  0 if sear=datarec
c +1 if sear>datarec
c +2 if error
c
	if((control.debug .and. debug_find) .ne. 0) then
	  call dix_util_get_type_name(des_rec.ent_type,str,nk,flag)
	  call sys$fao('    Record Pos !UL.!UL, size !UL.!UL datatype !AS',
     1           nk,line,
     1           %val(des_rec.bit_offset/bits_per_byte),
     1           %val(mod(des_rec.bit_offset,bits_per_byte)),
     1           %val(des_rec.size/bits_per_byte),
     1           %val(mod(des_rec.size,bits_per_byte)),
     1           str(1:nk))
	  call dix_main_print_debug(control,debug_find,line(1:nk))
	endif
c
c Now des_rec describes the (part of the-)field/record/type
c
c datatype,nb_binary the explicit datatype/size
c is_text tells us if explicit data is a text field
c
	if(match_flag .eq. match_flag_locate .or.
     1     match_flag .eq. match_flag_match) then
c
c Either locate or match
c Get the ascii data
c
c
	  nb_rem = len(data_rec) - des_rec.bit_offset/bits_per_byte
	  descr1(1) = min(nb_rem,des_rec.size/bits_per_byte)
	  descr1(2) = %loc(data_rec) + 
     1                  des_rec.bit_offset/bits_per_byte
c
	  descr2(1) = nb_binary/bits_per_byte
	  descr2(2) = %loc(binary_data)
	  if(match_flag .eq. match_flag_locate) then
c
c Just locate mode, it should be anywhere in the string
c
	    istat = dix_util_find_string_wild(descr1,
     1                   descr2,case_sens,wild_flag,pos)
	    istat = istat .ne. 0
c
	  else
c
c Match, must match whole record
c
	    istat = dix_util_match_string_wild(descr1,
     1                   descr2,case_sens,wild_flag)
	  endif
	  goto 90
	endif
c
c Now the compare functions
c des_rec contains the whole field, or the whole record
c the size must now be clipped to the nb_binary, and
c  the type set to datatype
c
	if(datatype .ne. 0) then
	  des_rec.ent_type = datatype
	  des_rec.size     = nb_binary
	endif
c
	if(match_flag .eq. match_flag_range) then
	  istat = .false.		!assume error
c
c It must be >= the first part
c
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2 .and. result .ge. 0) then
c
c And <= the second part
c 
	    des_rec.size     = nb_binary2
	    result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary2,binary_data2,
     1                             seastr2,case_sens)
	    istat = result .le. 0
	  endif	!first part oke
	elseif(match_flag .eq. match_flag_lt) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .lt. 0
	elseif(match_flag .eq. match_flag_le) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2)istat = result .le. 0
	elseif(match_flag .eq. match_flag_eq) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .eq. 0
	elseif(match_flag .eq. match_flag_ne) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .ne. 0
	elseif(match_flag .eq. match_flag_ne) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .ne. 0
	elseif(match_flag .eq. match_flag_ge) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .ge. 0
	elseif(match_flag .eq. match_flag_gt) then
	  result = dix_con_compare(control,des_rec,len(data_rec),
     1                             %ref(data_rec),
     1                             nb_binary,binary_data,
     1                             seastr,case_sens)
	  if(result .ne. 2) istat = result .gt. 0
	endif
90	dix_search_compare = istat
	return
	end
	function dix_search_con_nr(text,value)
	implicit none
c
c Read a number as
c  as nn
c  or nn.n 
c
	character*(*) text
	integer*4 value
	integer*4 dix_search_con_nr
	include 'dix_search_def.inc'
c
	integer*4 ipos,bit,byt,istat
c
c Assume error
c
	istat = 0
c
	ipos = index(text,'.') 
	if(ipos .eq. 0) then
	  read(text,2000,err=90) byt
	  bit = 0
2000	  format(i10)
	else
	  read(text(1:ipos-1),2000,err=90) byt
	  read(text(ipos+1:),2000,err=90) bit
	  if(bit .lt. 0 .or. bit .ge. bits_per_byte) goto 90
	endif
	value = byt*bits_per_byte+bit
	istat = 1
c		
90	dix_search_con_nr = istat
	return
	end
	options /exten
	subroutine dix_search_show(control)
	implicit none
c
	include 'dix_search_def.inc'
	record /control/ control
c
	record /search_rec/ search(*)
	pointer (p_search,search)
c
	integer*4 k,nk,nk1,flag
	character*(max_line_length) line
c
	if(control.search.count .eq. 0) then
	  call dix_dump_print_line(control,0,
     1             'No search strings specified')
	else
	  call sys$fao('Default fast search size = !UL',nk,line,
     1         %val(control.search_block_size))
	  call dix_dump_print_line(control,0,line(1:nk))
c
	  p_search = control.search.address	  
	  do k=1,control.search.count
	    line = search(k).name
	    nk = search(k).nkar
	    if(search(k).do_display) call dix_append(nk,line,'/SHOW')
	    flag = search(k).match_flag
	    if(flag .ne. match_flag_locate) then
	      call dix_append(nk,line,'/MATCH=')
	      call dix_search_con_match(flag,line(nk+1:),nk1)
	      nk = nk + nk1
	    endif
	    flag = search(k).wild_flag
	    if(flag .ne. wildcard_flag_none) then
	      call dix_append(nk,line,'/WILD=')
	      call dix_search_con_wild(flag,line(nk+1:),nk1)
	      nk = nk + nk1
	    endif
	    flag = search(k).location
	    if(flag .ne. search_location_data) then
	      call dix_append(nk,line,'/SEARCH=')
	      call dix_search_con_loca(flag,line(nk+1:),nk1)
	      nk = nk + nk1
	    endif
c
	    if(search(k).logic_flag .eq. logic_flag_and) then
	      call dix_append(nk,line,'/LOGIC=AND')
	    endif
	    if(search(k).not_flag) call dix_append(nk,line,'/NOT')
	    if(k .ne. 1) then
	      if(search(k).next_record) call dix_append(nk,line,'/NEXT_RECORD')
	    endif
	    if(search(k).case_sensitive) call dix_append(nk,line,'/CASE_SENS')
c
	    if(search(k).datatype .ne. 0) then
	      call dix_append(nk,line,'/TYPE=')
	      call dix_util_get_type_name(search(k).datatype,line(nk+1:),
     1                                    nk1,flag)
	      nk = nk + nk1
	      call dix_append(nk,line,'*')
	      call dix_search_con_nra(search(k).size,nk1,line(nk+1:))
	      nk = nk + nk1
	    endif	     
c
	    if(search(k).nk_field .gt. 0) then
	      call dix_append(nk,line,'/FIELD='//
     1            search(k).fieldnam(1:search(k).nk_field))
	    endif
c
c If binary mode,
c
	    if(search(k).size .ne. 0) then
	      call dix_append(nk,line,'/WINDOW=(POS=')
	      call dix_search_con_nra(search(k).position,nk1,line(nk+1:))
	      nk = nk + nk1
	      call dix_append(nk,line,',SIZ=')
	      call dix_search_con_nra(search(k).size,nk1,line(nk+1:))
	      nk = nk + nk1
	      call dix_append(nk,line,')')
	    endif
	    call dix_dump_print_line(control,0,line(1:nk))
	  end do
	endif
	return
	end
	subroutine dix_search_con_nra(nr,nk,line)
	implicit none
c
	include 'dix_size_def.inc'
c
	integer*4 nr
	integer*4 nk
	character*(*) line
c
	if(mod(nr,bits_per_byte) .eq. 0) then
	  call sys$fao('!UL',nk,line,%val(nr/bits_per_byte))
	else
	  call sys$fao('!UL.!UL',nk,line,
     1            %val(nr/bits_per_byte),
     1            %val(mod(nr,bits_per_byte)))
	endif
	return
	end	
	subroutine dix_search_con_match(match_flag,str,nk)
	implicit none
c
c Translate the match flag to ascii
c
	include 'dix_search_def.inc'
c
	integer*4 match_flag	!:i: the match flag
	character*(*) str	!:o: the text
 	integer*4 nk		!:o: length of srtring
c#
	integer*4 dix_util_get_len
c
	str = 'Loca'
	if(match_flag .eq. match_flag_match) str = 'Match'
	if(match_flag .eq. match_flag_eq  ) str = 'EQ'
	if(match_flag .eq. match_flag_ne  ) str = 'NE'
	if(match_flag .eq. match_flag_lt  ) str = 'LT'
	if(match_flag .eq. match_flag_le  ) str = 'LE'
	if(match_flag .eq. match_flag_ge  ) str = 'GE'
	if(match_flag .eq. match_flag_gt  ) str = 'GT'
	if(match_flag .eq. match_flag_valid) str = 'Valid'
	if(match_flag .eq. match_flag_exists) str = 'Exists'
	if(match_flag .eq. match_flag_range) str = 'Range'
	if(match_flag .eq. match_flag_never) str = 'Never'
	if(match_flag .eq. match_flag_always) str = 'Always'
	nk = dix_util_get_len(str)
	return
	end
	subroutine dix_search_con_wild(wild_flag,str,nk)
	implicit none
c
c Convert a wildcard flag to ascii
c
	include 'dix_search_def.inc'
c	
	integer*4 wild_flag	!:i: the flag
 	character*(*) str	!:o: the text
	integer*4 nk		!:o: the lenght
c#
	integer*4 dix_util_get_len
c
	str = 'None'
	if(wild_flag .eq. wildcard_flag_standard) str = 'Standard'
	if(wild_flag .eq. wildcard_flag_extended) str = 'Extended'
	nk = dix_util_get_len(str)
	return
	end
	subroutine dix_search_con_loca(loca_flag,str,nk)
	implicit none
c
c Convert a wildcard flag to ascii
c
	include 'dix_search_def.inc'
c	
	integer*4 loca_flag	!:i: the flag
 	character*(*) str	!:o: the text
	integer*4 nk		!:o: the lenght
c#
	integer*4 dix_util_get_len
c
	str = 'None'
	if(loca_flag .eq. search_location_data) str = 'Data'
	if(loca_flag .eq. search_location_vfc ) str = 'VFC'
	if(loca_flag .eq. search_location_both) str = 'Both'
	if(loca_flag .eq. search_location_recl) str = 'Recl'
	nk = dix_util_get_len(str)
	return
	end
	function dix_search_convert_data(control,search,datatype,size)
	implicit none
c
c Convertt the asciii search string to binary
c
	include 'dix_search_def.inc'
	record /control/ control	!:i: control block
	record /search_rec/ search		!:io: search structure
	integer*4 datatype              !:i: data type to convert to
	integer*4 size                  !:I: explicit data size
	integer*4 dix_search_convert_data !:f: function result
c#
	logical*4 check_size
	integer*4 istat,loc_size
	integer*4 dix_con_type_ascint
c
c Convert the ascii spec to binary
c  do this only once
c
	check_size = .not. search.is_text
c
c Convert the ascii string to "binary"
c
c First check if the binary data type <> current datatype
c
	loc_size = size
	if(loc_size .eq. 0) size = search.nkar*bits_per_byte
c
	if(search.binary_type .ne. datatype) goto 10
c
c If saerch=match or locate do not check explicit type
c
	if(check_size) then
c
c Not locate/match, check for the size
c
	  if(search.nb_binary .ne. loc_size) goto 10
	endif
c
c Type and size are ok, check for second part (in the range case)
c
	goto 20
c
10	istat = dix_con_type_ascint(
     1            search.name(1:search.nkar),
     1            loc_size,search.binary_data,
     1            datatype,control,
     1            search.nb_binary)
c
	if(.not. istat) goto 90
c
	if(check_size) search.nb_binary = loc_size
c
c Now see if range type
c
20	if(search.match_flag .ne. match_flag_range) goto 50
c
c If data type <> 
c
	loc_size = size
	if(loc_size .eq. 0) loc_size = search.nkar2
c
	if(search.binary_type .ne. datatype)goto 30
c
	if(check_size) then
	  if(search.nb_binary2 .ne. loc_size) goto 30
	endif
c
c Size and range are ok, all done
c
	goto 50
c
c Check second part
c
30	istat = dix_con_type_ascint(
     1            search.name2(1:search.nkar2),
     1            loc_size,search.binary_data2,
     1            datatype,control,
     1            search.nb_binary2)
c
	if(check_size) search.nb_binary2 = loc_size
c
50	search.binary_type = datatype
c
90	dix_search_convert_data = istat
	return
	end
	subroutine dix_search_print_debug(control,search,idx,last)
	implicit none
c
	include 'dix_search_def.inc'
c
	record /control/ control
	record /search_rec/ search
	integer*4 idx
	logical*4 last
c
	integer*4 nk,flag,nk_l
	character*(max_line_length) line
	character*(max_short_line_length) str,str1,loca
c
	if(search.location .eq. search_location_recl) then
	  call sys$fao('  Search item !UL, searchtext !AS,'//
     1                   ' in recordlength',
     1                    nk,line,%val(idx),
     1           search.name(1:search.nkar))
	else
	  if(search.location .eq. search_location_data) then
	    loca = 'Data'
	    nk_l = 4
	  elseif(search.location .eq. search_location_vfc) then
	    loca = 'VFC'
	    nk_l = 3
	  elseif(search.location .eq. search_location_both) then
	    loca = 'Data,VFC'
	    nk_l = 8
	  endif
	  call sys$fao('  Search item !UL, searchtext !AS,'//
     1                   ' fieldnam !AS in !AS',
     1                   nk,line,%val(idx),
     1           search.name(1:search.nkar),
     1           search.fieldnam(1:search.nk_field),
     1           loca(1:nk_l))
	endif
	call dix_main_print_debug(control,debug_find,line(1:nk))
	if(search.datatype .eq. 0) then
	  nk = 0
	  call sys$fao('%None',nk,str)
	else
	  call dix_util_get_type_name(search.datatype,str,nk,flag)
	endif
c
	if(search.case_sensitive) then
	  str1(1:3) = '   '
	else
	  str1(1:3) = 'Not'
	endif
c
	call dix_search_con_match(search.match_flag,str1(5:10),nk)
c
	call dix_search_con_wild(search.wild_flag,str1(11:14),nk)
c
c
	str1(15:16) = ' '
	if(.not. last) then
	  str1(15:17) = 'OR'
	  if(search.logic_flag .eq. logic_flag_and)str1(15:17) = 'AND'
	endif
	str1(18:20) = ' '
	if(search.not_flag ) str(18:20) = 'NOT'
c
	call dix_search_con_loca(search.location,str1(21:24),nk)
c
	call sys$fao('    Pos !UL.!UL, size !UL.!UL datatype !AS'//
     1               ' !AS Casesens, !AS !AS !AS !AS !AS',
     1           nk,line,
     1           %val(search.position/bits_per_byte),
     1           %val(mod(search.position,bits_per_byte)),
     1           %val(search.size/bits_per_byte),
     1           %val(mod(search.size,bits_per_byte)),
     1           str(1:nk),str1(1:3),str1(18:20),
     1           str1(5:10),str1(11:14),str1(15:17),str(21:24))
c
	call dix_main_print_debug(control,debug_find,line(1:nk))
	return
	end
        subroutine dix_search_enable_ctrlt(chan_term,filename,size,fast)
        implicit none
c
c Enable control-t trap, will be called from file copy routines to display
c  progress in copy
c
        integer*2 chan_term
	character*(*) filename
	integer*4 size
	logical*4 fast
c
        integer*4 mask(2),opcode
        include '($iodef)'
        include '($efndef)'
c
	include 'dix_search_def.inc'
	record /search_control_t/ search_control_t
	common /search_control_t/ search_control_t
c
        external dix_search__control_t_routine
c
c assign channel
c
        call sys$assign('SYS$COMMAND',chan_term,,,)
c
c Create mask for ^t
c
        mask(1) = 0
        mask(2) = 2**20         !control_t
c
c Reserve and clear ef
c
c Set ast to control_routine
c
        opcode = io$_setmode .or. io$m_outband
        call  sys$qiow(%val(EFN$C_ENF),%val(chan_term),
     1         %val(opcode),,,,
     1        dix_search__control_t_routine,mask,,,,)
c
	search_control_t.filename = filename
	search_control_t.nkar     = len(filename)
	search_control_t.fast     = fast
c
	call dix_search_set_file_size(size)
c
        return
        end
        subroutine dix_search_set_file_size(size)
        implicit none
c
c Enable control-t trap, will be called from file copy routines to display
c  progress in copy
c
	integer*4 size
c
	include 'dix_search_def.inc'
	record /search_control_t/ search_control_t
	common /search_control_t/ search_control_t
c
	search_control_t.totblock = size
	return
	end

        subroutine dix_search_disable_ctrlt(chan_term)
        implicit none
c
        integer*2 chan_term
c
        call sys$dassgn(%val(chan_term))
        return
        end
c
        function dix_search__control_t_routine()
        implicit none
c
	include 'dix_search_def.inc'
	integer*4 dix_search__control_t_routine
c
	record /search_control_t/ search_control_t
	common /search_control_t/ search_control_t
c
c
        character*(max_line_length) line
        character*(max_short_line_length) name
        integer*4 nk,nk1,perc
c
	nk = 0
	if(search_control_t.fast) then
	  call sys$fao('Fast',nk,line)
	else
	  call sys$fao('Normal',nk,line)
	endif
        call lib$put_output(line(1:nk)//' searching file '//
     1    search_control_t.filename(1:search_control_t.nkar))
c
        nk  = 0
        nk1 = 0
        if(search_control_t.bucket_size .gt. 0) then
          call sys$fao('bucket',nk1,name)
        else
          call sys$fao('record',nk1,name)
        endif
c
	if(search_control_t.totblock .eq. 0) then
	  perc = 100
	elseif(search_control_t.curblock .gt. 10000000) then
	  perc = (100*search_control_t.curblock)/search_control_t.totblock
	else
	  perc = search_control_t.curblock/(search_control_t.totblock/100)
	endif
c
        call sys$fao('Processing record !UL, RFA (!UL,!UW)'//
     1         ', !AS !UL of !UL (!UL%)',nk,line,
     1         %val(search_control_t.recnr),
     1         %val(search_control_t.rfa.bbnr),
     1         %val(search_control_t.rfa.offset),
     1         name(1:nk1),
     1         %val(search_control_t.curblock),
     1         %val(search_control_t.totblock),%val(perc))
        call lib$put_output(line(1:nk))
        dix_search__control_t_routine = 1
        return
        end
	subroutine dix_search_update(bucket_size,recnr,curblock,rfa)
	implicit none
	include 'dix_search_def.inc'
c
c Update the info in the control_t block
c
	integer*4 bucket_size
	integer*4 recnr
	integer*4 curblock
	record /rfa/ rfa
c
	record /search_control_t/ search_control_t
	common /search_control_t/ search_control_t
c
	search_control_t.bucket_size = bucket_size
	search_control_t.recnr       = recnr
	search_control_t.rfa         = rfa
	search_control_t.curblock    = curblock
c
	return
	end	      
        subroutine dix_search_stats_init(control)
        implicit none
c
        include 'dix_search_def.inc'
c
	record /control/ control
c
        record /search_stats/ search_stats
	common /search_stats/ search_stats
c
	if((control.search_flags .and. search_flag_statistics).ne.0) then
	  call lib$init_timer(search_stats.handle)
	  search_stats.nrec_read    = 0
	  search_stats.nbyt_read(1) = 0
	  search_stats.nbyt_read(2) = 0
	  search_stats.nrec_fnd     = 0
	endif
	return
	end
        subroutine dix_search_stats_add(control,nrec_read,nbyt_read,
     1                                  nrec_fnd,nbyt_fnd)
	implicit none
        include 'dix_search_def.inc'
c
	record /control/ control
	integer*4 nrec_read
	integer*4 nbyt_read(2)
	integer*4 nrec_fnd
	integer*4 nbyt_fnd(2)
c
        record /search_stats/ search_stats
	common /search_stats/ search_stats
c
c
	if((control.search_flags .and. search_flag_statistics).ne.0) then
	  search_stats.nrec_read = search_stats.nrec_read + nrec_read
	  search_stats.nrec_fnd  = search_stats.nrec_fnd  + nrec_fnd
	  call lib$addx(search_stats.nbyt_read,nbyt_read,
     1                    search_stats.nbyt_read)
	  call lib$addx(search_stats.nbyt_fnd,nbyt_fnd,
     1                    search_stats.nbyt_fnd)
	endif
	return
	end
        subroutine dix_search_stats_show(control)
	implicit none
        include 'dix_search_def.inc'
	record /control/ control
c
        record /search_stats/ search_stats
	common /search_stats/ search_stats
c
	integer*4 cputim,elaps(2),bufio,dirio,pgfl,cputime(2),nk
	character*(max_line_length) line
c
	if((control.search_flags.and.search_flag_statistics).eq.0) goto 90
c
	call lib$stat_timer(1,elaps,search_stats.handle)
	call lib$stat_timer(2,cputim,search_stats.handle)
	call lib$stat_timer(3,bufio,search_stats.handle)
	call lib$stat_timer(4,dirio,search_stats.handle)
	call lib$stat_timer(5,pgfl,search_stats.handle)
c
	call dix_dump_print_line(control,0,'Search statistics')
c
	call lib$emul(cputim,-10*1000*10,-1,cputime)
	call sys$fao('  Elaps time !%D, CPUtime !%D',nk,line,elaps,cputime)
	call dix_dump_print_line(control,1,line(1:nk))
c
	call sys$fao('  DirIO !UL BufIO !UL Pageflts !UL',nk,line,
     1               %val(dirio),%val(bufio),%val(pgfl))
	call dix_dump_print_line(control,1,line(1:nk))
c
	call sys$fao('  nrecs read  !UL, nbytes read !@UQ',nk,line,
     1            %val(search_stats.nrec_read),
     1                 search_stats.nbyt_read)
	call dix_dump_print_line(control,1,line(1:nk))
	call sys$fao('  nrecs found !UL, nbytes found !@UQ',nk,line,
     1            %val(search_stats.nrec_fnd),
     1                 search_stats.nbyt_fnd)
	call dix_dump_print_line(control,1,line(1:nk))
c
	call lib$free_timer(search_stats.handle)
c
90	return
	end