	options /extend
	subroutine terminal(difno)
c
c Program to interconnect between VAX and PDP-11/23 operating the
c	X-ray diffractometers at Geophysical Laboratory.
c
c	implicit none
	include 'trmprg.inc'
	include 'newdif.inc'
	include 'single.inc'
	integer*4 difno,status,sys$assign,n,sys$setprn
	character difname*8,diffile*24,response*1
	byte alph(80)
c
	type 2
2	format('$Type Diffractometer Number (0-3)?')
100	read(5,4,err=105)difno
4	format(i10)
	if (difno.lt.0.or.difno.gt.3)then
105	  type 6
6	  format(' Incorrect Diffractometer NUmber!'
	1//'$Type Diffractometer Number (0-3)?')
	  go to 100
	endif
	if(difno.eq.0)then
c
c Output message about using dummy diffractometer and exit
c
	  type 7
7	  format(' Using VIRTUAL Diffractometer.  No operations on'
     1	  ,' actual machine hardware will be permitted.')
	  do i=1,4
	    parity(i)=1.0
	  enddo
	  return
	endif
c
c Form Logical Name for Diffractometer and assign LUN's for QIO's
c
	write(difname,8)difno
8	format('DIFRAC$',i1)
	status = sys$assign(difname,lun2,,)
	if (.not. status)call lib$signal(%val(status))
	status = sys$assign('sys$output',lun1,,)
	if (.not. status)call lib$signal(%val(status))
c
c change process name
c
	status = sys$setprn(difname)
	if (.not. status) then
	    write(*,*)
	    write(*,'(a)')' An ERROR has occurred in changing the process'
	    write(*,'(a,a8,a)')' name to ',difname,'.  Is another job using'
	    write(*,'(a)')' this diffractometer?'
	    write(*,*)
c	    call lib$signal(%val(status))
	endif
c
c set diffractometer interface speed at 9600
c
	call set_speed(15)
c
c check if computer alive
c
	alph(1)=7
	alph(2)='@'
	alph(3)=13
	n=3
	call instring(alph,n)
	if(n.eq.0.or.alph(1).ne.'@')then
	  type 9
9	  format(' Diffractometer Computer is not running Correctly'
	1	/' Use SUPERVISOR to load code.')
	  call exit
	endif
	dif_lock=0
c
c send ctrl/p to reset diffractometer
c
	call stpall
c
c Generate name of Personality File for Diffractometer and load data
c
	write(diffile,10)difno
10	format('single$base:difprof',i1,'.dat')
	open(unit=11,name=diffile,type='old',readonly)
	read(11,12)stpdg,itmin,n_step,n_stpsz,n_spcchi,ndcp,parity,shtdly
12	format(4f10.0,8i10,4f10.0,i10)
	close(unit=11)
c
	write(*,'(a)')'$Do you want Motor Display Update(<Y>,N)?'
	read(*,'(a)')response
	motor_display = .false.
	if (( response .eq. 'N') .or. (response .eq. 'n')) return
c
c Start Motor Update AST routines running
c
	motor_display = .true.
	call scrnint
	return
	end
	options /extend
	subroutine break
	implicit none
	include 'trmprg.inc'
	integer*2 null(5)
	data null/5*0/
c
c routine to generate a "BREAK" on the PDP-11/23
c
	call sys$cancel(%val(lun2))
	call set_speed(1)	!set baud rate = 50
	call sys$qiow(,%val(lun2),%val("460),,,,null,%val(5),,,,)
	call delay(500)
	call set_speed(15)	!reset baud rate to 9600
	return
	end
	options /extend
	subroutine delay(msec)
c
c delay for msec milliseconds...uses system services
c sys$setimr,sys$waitfr   see system services reference manual
c chapter 8, for example and definition of delta time
c
	integer*2 msec
	integer*4 qtim(2)
	qtim(2)=-1
	qtim(1)=msec
	qtim(1)= -10000*qtim(1)
c in 100 nanosecond units, use event flag 15
	call sys$setimr(%val(15),qtim,,)
	call sys$waitfr(%val(15))
	return
	end
	options /extend
	subroutine outstring(alph,n)
c
c output the string of 'n' characters in 'alph'
c
	implicit none
	include 'trmprg.inc'
	byte alph(*)
	integer*4 n
c
	call sys$qioW(%val(15),%val(lun2),%val("460),,,,alph,%val(n),,,,)
	return
	end
	options /extend
	subroutine instring(alph,n)
c
c output the string of 'n' characters in 'alph' as a prompt and read response
c return number of chars in 'alph' - if timeout, return 0 in 'n'
c
	include '($iodef)'
	include 'trmprg.inc'
	dimension iterm(2)
	byte alph(*)
	integer*4 n,sys$qioW,status
	data iterm/0,'2000'X/
c
	status = sys$qioW(%val(15),%val(lun2),%val(io$_readprompt
     1	  .or.io$m_noecho.or.io$m_purge.or.io$m_timed),iosb2,,,alph
     2	  ,%val(80),%val(2),iterm,alph,%val(n))
	if(status.ne.1)call lib$signal(%val(status))
	if(iosb2(1).ne.1)then
c timeout
	  n=0
	else
c Strip non-printing characters
	  n=0
	  do i=1,iosb2(3)
	    if(alph(i).ge.32)then
	      n=n+1
	      if (n.gt.80)n = 80
	      alph(n)=alph(i)
	    endif
	  enddo
	endif
	return
	end
	options /extend
	subroutine set_speed(speed)
	implicit none
	integer*4 speed,Charbuf(2),sys$qiow,status
	include 'trmprg.inc'
c
c set speed of line by sensing characteristics and writing back with speed set
c
	call sys$qiow(,%val(lun2),%val('27'X),,,,Charbuf,,,,,)
	status = sys$qiow(%val(1),%val(lun2),%val('23'X),,,,Charbuf,,%val(speed),,,)
	if(.not.status)call lib$signal(%val(status))
	return
	end
