	SUBROUTINE DRIVE(I,X,DEGPM,ichk,ierr)
C
C ROUTINE TO SET-UP A MOTOR DRIVE
C
C on entry ichk=0 implies that the target angles
c have already been checked for accessibility -
c no further checking will be done here.
c
	implicit none
	include 'device.inc'
	include 'newdif.inc'
	include 'single.inc'
	real*4 angl(4),x,degpm,rdmtr,curpos,offset,sgn,xp,thetaf
	integer*4 ierr,i,ichk,j
c
	ierr=0
	call wtmtr(i)
c
c check against software limits
c
	if(ichk .ne. 0)then
	  do j=1,4
		if(j .eq. i)then
			angl(j)=x
		else
			angl(j)=0.
		endif
	  enddo
	  call softlimits(angl,i,ierr)
	  if(ierr .eq. 1)return
	endif
c
	if(i.lt.3)goto200
c
c check for chi and phi flags set
	if(i .eq. 3 .and. chi_flag .eq. 1)goto200
	if(i .eq. 4 .and. phi_flag .eq. 1)goto200
c Handle 360 Degree Wrap-around for Chi and Phi
	  curpos=rdmtr(i)
100	  offset=x-curpos
	  if(abs(offset).gt.180.0)then
c reset current position
	    curpos=curpos+360.0*sgn(offset)
	    call ldmtr(i,curpos)
	    go to 100
	  endif
c
200	if(i.eq.2.and.ndcp.ne.0)then
c Motor 2 and a Decoupled Diffractometer - Make Adjustment to Motor Target
	  call RdAllMTR(angl)
c calculate new target for theta
	  xp=x+0.5*angl(1)
	else
	  xp=x
	  if(i.eq.1.and.ndcp.ne.0)then
c Decoupled diffractometer - a Drive on motor 1 requires change on #2
	    call wtmtr(2)
	    call RdAllMTR(angl)
c calculate final value for theta
	    thetaf=angl(2)+0.5*xp
c initiate the drive
	    call do_drive(2,thetaf,degpm)
	  endif
	endif
c
c check for driving 2theta close to or through zero
c
	if(i .eq. 1)then
	    curpos=rdmtr(1)
	    if(abs(xp) .lt. 1.0)call ofbeam
	    if(curpos*xp .lt. 0.)call ofbeam
	endif
	call do_drive(i,xp,degpm)
	return
	end
	options/extend
	subroutine softlimits(angl,ichk,ierr)
c
c routine to check a set of motor positions for violations of software
c  limit conditions
c
c  'ANGL(4)' are the set of angles to be tested.
c  'ICHK' indicates which angle to be checked
c         =0 if all angles available in ANGL
c         =i when only one angle available (call from DRIVE)
c   Nb: when i=1,2 psi is NOT checked against dc_psimax
c
c  'IERR' is set to 1 if these positions cannot be reached
c
	implicit none
	real*4 angl(4),rad,rdmtr,omgmax,omgmin,rnu,rmu,chi,phi,cospsid,cospsip
	integer*4 ichk,ierr
	include 'single.inc'
	include 'device.inc'
	include 'newdif.inc'
	data rad/57.29578/
c
	ierr=0
	if(ichk .eq. 0)goto100
	goto(100,200,300,400),ichk
c
c check 2theta for reasonablness: -tth expanded to -80 by rja 10-feb-92
c
100	if(angl(1).gt.90.0.or.angl(1).lt.-80.0)then
	  ierr=1
	  return
	endif
c carry on to check omega/tth collision even if ichk=1
	if(ichk .eq. 1)then
		call wtmtr(2)
		angl(2)=rdmtr(2)
	endif
c	
c check omega:
c 
200     if(ichk  .eq. 2)then
		call wtmtr(1)
		angl(1)=rdmtr(1)
	endif
	omgmax=40.-0.5*angl(1)
	omgmin=-omgmax
c
c Extra section for Huber
c
	if (ndcp .ne. 0) then
c
c Detect when phi carrier hits collimators
c
	  if ((angl(3) .gt. -126.0) .and. (angl(3) .lt. -54.0)
     1		.or. (angl(3) .gt. 234.0) .and. (angl(3) .lt. 306.0))then
	    omgmax = 38.0 - 0.5 * angl(1)
	    omgmin = -omgmax
	  endif
	  if ((angl(3) .gt. -115.0) .and. (angl(3) .lt. -65.0)
     1		.or. (angl(3) .gt. 245.0) .and. (angl(3) .lt. 295.0))then
	    omgmax = 34.0 - 0.5 * angl(1)
	    omgmin = -omgmax
	  endif
	endif
	if(angl(2).lt.omgmin.or.angl(2).gt.omgmax)then
	  ierr=1
	  return
	endif
	if(ichk .eq. 2 .or. ichk .eq. 1)return
c
c now check chi limits
c
300	if(chi_flag .ne. 0)then
		if(angl(3) .lt. chimn .or. angl(3) .gt. chimx)then
			ierr=1
			return
		endif
	endif
	if(ichk .eq. 3)return	
c
c now phi limits
400	if(phi_flag .ne. 0)then
		if(angl(4) .lt. phimn .or. angl(4) .gt. phimx)then
			ierr=1
		endif
	endif
   	if(ichk .eq. 4)return
c
c check psi angle
c
	if(fixed_phi.ne.0)then
c
c Fixed phi mode - check if PSI-d within bounds
c Get some angles in radians
c
	  rnu=(angl(2)*parity(2)+0.5*angl(1))/rad
	  rmu=(angl(2)*parity(2)-0.5*angl(1))/rad
	  chi=angl(3)*parity(3)/rad
	  phi=angl(4)*parity(4)/rad
c
c calculate dot product of cell centerline with diffracted beam and
c	with primary beam
c
  	  cospsid=-sin(rnu)*cos(chi)*sin(phi)+cos(rnu)*cos(phi)
	  cospsip=-sin(rmu)*cos(chi)*sin(phi)+cos(rmu)*cos(phi)
c
c Check if angles less than 'dc_psimax', i.e. cosines greater
c abs function used because phi -ve gives cospsi -ve
c
	  if(amin1(abs(cospsid),abs(cospsip)).lt.cos(dc_psimax/rad))then
c
c Reflection out of bounds
c
	    ierr=1
	  endif
	endif
	return
	end
c
	SUBROUTINE DEVICE_UPDATE
c
c used to change device and set appropriate soft limits
c and associated flags
c
	include 'device.inc'
	real chiphi(4,nodev)
	integer devflags(3,nodev)
	character*10 string(nodev)
	character*1 ans
	common/devicenames/string
c
c load defaults
c devflags holds flags (fixed_phi, chi_flag, phi_flag) for
c each device
c
	data devflags/1,0,0,1,1,1,0,1,0,0,1,1,0,1,1/
c
c chiphi holds chimn,chimx,phimn,phimx for each device
c (limit set to zero for flag=0)
c
	data chiphi/0.,0.,0.,0.,-180.,180.,-180.,90.,
     1  -90.,90.,0.,0.,-180.,180.,-180.,180.,
     2  -45.,45.,-180.,90./
c
c string holds device names
	data string/'DAC       ',
     1              'HEATED DAC',
     2              'COOLER    ',
     3              'FURNACE   ',
     4              'JT COOLER '/
c
c load psimax limit
1	rpsi=50.
c
c clear flags before reseting
	fixed_phi=0
	chi_flag=0
	phi_flag=0
	chimn=0.
	chimx=0.
	phimn=0.
	phimx=0.
	device_no=0
c
c print table of device constraints
c
	type 10
10	format(/'  AVAILABLE DEVICES:'/
     1  '  DEVICE      NO.  CHIMIN  CHIMAX  PHIMIN  PHIMAX'/)
c
c
	type 15
15	format('  AIR',10x,'0',34x,'   BISECTING MODE')
	do i=1,nodev
	if(devflags(1,i) .eq. 0)then
	  type 20,string(i),i,(chiphi(j,i),j=1,4) 
20	  format(2x,a10,i4,2x,4f8.0,'   BISECTING MODE')
	else
	  type 25,string(i),i,(chiphi(j,i),j=1,4) 
25	  format(2x,a10,i4,2x,4f8.0,'   FIXED PHI MODE')
	endif
	enddo
	type 30
30	format('          (Zero pairs indicate no limits)')
c
c 
49	type 50
50	format(//'$ Input device number: ')
55	read(5,60,end=9999,err=49)i
60	format(i5)
	if(i .ne. 0)goto66
		type 65
65		format('$ Crystal in Air selected; ')
		goto370
66	if(i .gt. 0 .and. i .le. nodev)goto100
	type 70
70	format('$ Invalid device number, retype:')
        goto55
c
c set psi max
c
100	device_no=i
	if(devflags(1,i) .eq. 0)goto150
	   fixed_phi=1
109	   type 110
110	   format('$ Input max psi angle: ')
115	   read(5,120,end=9999,err=109)k,temp
120	   format(q,f10.0)
	   if(k .eq. 0)then
		dc_psimax=rpsi
	   else 
	        if(temp .gt. rpsi)then
		  type 130
130		  format('$ Invalid value, retype: ')
		  goto115
	   	else
		   dc_psimax=temp
	        endif
	   endif
c
c set chi 
c
150	if(devflags(2,i) .eq. 0)goto200
	  chi_flag=1
159	  type 160
160	  format('$ Input minchi, maxchi <return for defaults>: ')
165	  read(5,166,err=159,end=9999)k,temp1,temp2
166	  format(q,2f10.0)
	  if(k .eq. 0)then
		  chimn=chiphi(1,i)
		  chimx=chiphi(2,i)
	  else
	   if(temp1 .lt. chiphi(1,i) .or. temp2.gt.chiphi(2,i))then
	        type 170
170		format('$ Invalid values, retype:')
		goto165
	   else
		chimn=temp1
		chimx=temp2
	   endif
	 endif
c
c set phi min,max
200	if(devflags(3,i) .eq. 0)goto999
	  phi_flag=1
259	  type 260
260	  format('$ Input minphi, maxphi <return for defaults>: ')
265	  read(5,166,end=9999,err=259)k,temp1,temp2
	  if(k .eq. 0)then
		  phimn=chiphi(3,i)
		  phimx=chiphi(4,i)
	  else
	   if(temp1 .lt. chiphi(3,i) .or. temp2.gt.chiphi(4,i))then
	        type 270
270		format('$ Invalid values, retype:')
		goto265
	   else
		phimn=temp1
		phimx=temp2
	   endif
	 endif
c
c print out set values
c
999	call printdevice
370  	type 380
380	format('$ Is This OK (Y/N)?')
	read(5,390,end=9999,err=370)ans
390	format(a1)
	if(ans .ne. 'y' .and. ans .ne. 'Y')goto1
9999    return
	end
c
c
	SUBROUTINE PRINTDEVICE
c
c subroutine to print device characteristics
	include 'device.inc'
	character*10 string(nodev)
	common/devicenames/string
c
c
c
	if(device_no.eq.0)then
	  type 250
250	  format(/'  Selected Device is NONE - Bisecting Mode')
	  return
	endif
	type 300,string(device_no)
300	format(/'  Selected Device is ',a10,' with following constraints:'/)
	if(fixed_phi .eq. 1)then
		type 310,dc_psimax
310		format('  Fixed Phi Mode, Psi(max) =',f5.1)
	else
		type 320
320		format('  Bisecting Mode')
	endif
c
	if(chi_flag .eq. 1)then
	    if(chimx-chimn .gt. 359.9)then
		type 330
330		format('  Chi Non-circular')
	    else
		type 340,chimn,chimx
340		format('  Chi Restricted, Range: ',f6.1,' to ',f6.1)
	    endif
	endif
	if(abs(chimx)-abs(chimn) .gt. 0.1)then
		type 345
345		format('   Assymetric Chi Limits May Cause Problems in Zref')
	endif
c
	if(phi_flag .eq. 1)then
	    if(phimx-phimn .gt. 359.9)then
		type 350
350		format('  Phi is Non-circular')
	    else
		type 360,phimn,phimx
360		format('  Phi Restricted, Range: ',f6.1,' to ',f6.1)
	    endif
	endif
	return
	end
