options/extend SUBROUTINE DRIVEP(iflg,ierr) C DRIVE TO PEAK POSITION c on entry iflg=1 for printing c on return ierr=returned value from drive implicit none include 'single.inc' include 'newdif.inc' integer*4 iflg,ierr,i,hubflg real*4 rdmtr C if(iflg.ne.0)type 2,cangl 2 format(' Driving to ',4f8.3) ierr=0 hubflg = 0 c c Special section for Huber c if (ndcp .ne. 0) then if (((cangl(3)+90.0)*(rdmtr(3)+90.0)) .lt. 0.0 )hubflg = 1 if (hubflg .ne. 0) then call drive(1,min(rdmtr(1),cangl(1)),0,0,ierr) call drive(2,0.0,0,0,ierr) call wtmtr(2) endif endif do i=4,1,-1 call drive(i,cangl(i),0,0,ierr) if(ierr.ne.0)return if(hubflg .ne. 0)call wtmtr(3) enddo return end subroutine getidx c c Calculate indices corresponding to angles c implicit none include 'single.inc' real*4 temp(3,3),angl(4),th(3),phi(3) integer*4 i c 100 if(stringin.eq.' ')then c Get angles from keyboard 1 type 2 2 format('$Enter Angles (Blank to Exit): ') read(5,4,end=9999,err=1)i,angl 4 format(q,4f10.0) else c angles in stringin read(stringin,4,err=9999)i,angl endif if(i.le.0)return call HCALC(angl,TH) type 6,th 6 format(' Indices: ',3f8.3/) if(stringin.eq.' ')go to 100 9999 return end subroutine HCALC(ANGL,TH) c c Calculate indices corresponding to angles c implicit none include 'single.inc' real*4 temp(3,3),angl(4),th(3),phi(3),det integer*4 i,j c call minv(ub,temp,det) !get (UB)-1 call calch(angl,phi) do 120 i=1,3 th(i)=0.0 do 110 j=1,3 th(i)=th(i)+temp(i,j)*phi(j) 110 continue 120 continue end SUBROUTINE MTINIT c implicit none include 'single.inc' include 'newdif.inc' integer*4 nc,no real*4 pos,rdmtr C C ROUTINE TO LOAD MOTOR POSITIONS C C MODIFIED BY RJA 2-9-92 to handle decoupled diffractometers C if(stringin .eq. ' ')then TYPE 2 2 FORMAT(' MOTOR INITIALIZATION: TYPE NO.,POS.