C----------------------------------------------------------------------- C This subroutine controls the automatic alignment of reflections C----------------------------------------------------------------------- SUBROUTINE TCENTR (NSTORE) INCLUDE 'COMDIF' DIMENSION THETAS(NSIZE), OMEGS(NSIZE), CHIS(NSIZE),PHIS(NSIZE), $ ITIMS(NSIZE),THETAP(NSIZE),OMEGP(NSIZE),CHIP(NSIZE), $ PHIP(NSIZE) CHARACTER WHICH*6 EQUIVALENCE (ACOUNT( 1),THETAS(1)), $ (ACOUNT( NSIZE+1),OMEGS(1)), $ (ACOUNT(2*NSIZE+1),CHIS(1)), $ (ACOUNT(3*NSIZE+1),PHIS(1)), $ (ACOUNT(4*NSIZE+1),ITIMS(1)), $ (ACOUNT(5*NSIZE+1),THETAP(1)), $ (ACOUNT(6*NSIZE+1),OMEGP(1)), $ (ACOUNT(7*NSIZE+1),CHIP(1)), $ (ACOUNT(8*NSIZE+1),PHIP(1)) REAL CURCTS,MAXCTS WIDTH = 1.25 C----------------------------------------------------------------------- C Read the peaks from disk C----------------------------------------------------------------------- CALL ANGRW (0,4,NMAX,160,0) C----------------------------------------------------------------------- C Save the current angles for later C----------------------------------------------------------------------- DO 100 J = 1,NMAX THETAP(J) = THETAS(J) OMEGP(J) = OMEGS(J) PHIP(J) = PHIS(J) CHIP(J) = CHIS(J) 100 CONTINUE C----------------------------------------------------------------------- C Centre the NSTORE to NMAX positions C----------------------------------------------------------------------- NGOOD = NSTORE - 1 DO 210 J = NSTORE,NMAX C----------------------------------------------------------------------- C Check if a K or a Q was typed on the terminal C----------------------------------------------------------------------- CALL KORQ (IFLAG1) IF (IFLAG1 .NE. 1) THEN KI = 'O4' RETURN ENDIF RTHETA = THETAS(J) ROMEGA = OMEGS(J) RCHI = CHIS(J) RPHI = PHIS(J) WRITE (COUT,10000) J,RTHETA,ROMEGA,RCHI,RPHI CALL GWRITE (ITP,' ') WRITE (LPT,10000) J,RTHETA,ROMEGA,RCHI,RPHI CALL ANGSET (RTHETA,ROMEGA,RCHI,RPHI,NATT,ICOL) THETA = RTHETA OMEGA = ROMEGA CHI = RCHI PHI = RPHI C----------------------------------------------------------------------- C Set the angles at the approximate position of the peak and adjust C Phi, Chi and 2Theta to get maximum intensity in the detector. C Sietronics interface works via MAXPOINT; CAD4 via CADCEN C----------------------------------------------------------------------- C CAD-4 and Sietronics deleted for clarity: Mark Koennecke CALL SHUTTR (99) C----------------------------------------------------------------------- C All other machines for the moment C Modified: Mark Koennecke for TRICS C Do initial search. But use the results of the searches C only if they improved the countrate. C----------------------------------------------------------------------- CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CALL CCTIME (PRESET,CURCTS) C----- first two theta RTIM = PRESET CALL TFIND(RTIM,MAXCTS) IF(MAXCTS .LT. CURCTS) THEN THETA = RTHETA OMEGA = ROMEGA ELSE CURCTS = MAXCTS ENDIF CALL KORQ (IFLAG1) IF (IFLAG1 .NE. 1) THEN KI = 'O4' RETURN ENDIF C----- now phi RTIM = PRESET CALL PFIND(RTIM,MAXCTS) IF(MAXCTS .LT. CURCTS) THEN PHI = RPHI ELSE CURCTS = MAXCTS ENDIF CALL KORQ (IFLAG1) IF (IFLAG1 .NE. 1) THEN KI = 'O4' RETURN ENDIF C------ finally phi RTIM = PRESET CALL CFIND(RTIM,MAXCTS) IF(MAXCTS .LT. CURCTS) THEN CHI = RCHI ELSE CURCTS = MAXCTS ENDIF CALL KORQ (IFLAG1) IF (IFLAG1 .NE. 1) THEN KI = 'O4' RETURN ENDIF C------- end of pre centering WRITE (COUT,11000) THETA,OMEGA,CHI,PHI CALL GWRITE (ITP,' ') WRITE (LPT,11000) THETA,OMEGA,CHI,PHI CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) C----------------------------------------------------------------------- C Save the tweaked positions to make life a little easier later C----------------------------------------------------------------------- THETAP(J) = THETA OMEGP(J) = OMEGA CHIP(J) = CHI PHIP(J) = PHI CALL ANGRW (1,4,NMAX,160,1) C----------------------------------------------------------------------- C Now proceed with the conventional alignment with defaults appropriate C to fully open windows C The steps are adapted to the 2-Theta angle. C----------------------------------------------------------------------- AFRAC = 0.5 CON = IFRDEF CON = 10.0/(IFRDEF*THETA) DT = 10.0*CON DO = 5.0*CON DC = 50.0*CON IF(PRESET .LT. 1000) PRESET = 1000.0 C IF (TIME .LT. 0.10) TIME = 0.10 C IF (TIME .GT. 3.0) GO TO 200 NATT = 0 IF (CHI .LT. 0.0) CHI = CHI + 360.0 IF (CHI .GT. 360.0) CHI = CHI - 360.0 IF (PHI .LT. 0.0) PHI = PHI + 360.0 IF (PHI .GT. 360.0) PHI = PHI - 360.0 CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) ISLIT = 0 IF (DFMODL .EQ. 'CAD4') ISLIT = 40 CALL WXW2T (DT,DO,DC,ISLIT) COUNT = 0 ITIMS(J) = 0 IF (KI .EQ. 'FF') GO TO 200 C----------------------------------------------------------------------- C Position on the peak and count for standard preset C----------------------------------------------------------------------- CALL ANGSET (RTHETA,ROMEGA,RCHI,RPHI,NATT,ICOL) CALL SHUTTR (99) CALL CCTIME (PRESET,COUNT) ICOUNT = COUNT C----------------------------------------------------------------------- C Do not save a weak count C----------------------------------------------------------------------- IF (ICOUNT .LT. 100) GO TO 200 WRITE (COUT,12000) RTHETA,ROMEGA,RCHI,RPHI,ICOUNT CALL GWRITE (ITP,' ') WRITE (LPT,12000) RTHETA,ROMEGA,RCHI,RPHI,ICOUNT C----------------------------------------------------------------------- C If the alignment was successful, remember it C----------------------------------------------------------------------- THETAP(J) = RTHETA OMEGP(J) = ROMEGA CHIP(J) = RCHI PHIP(J) = RPHI CALL ANGRW (1,4,NMAX,160,1) NGOOD = NGOOD + 1 THETAS(NGOOD) = RTHETA OMEGS(NGOOD) = ROMEGA CHIS(NGOOD) = RCHI PHIS(NGOOD) = RPHI ITIMS(NGOOD) = COUNT CALL ANGRW (1,5,NGOOD,140,0) 200 CALL SHUTTR (-99) 210 CONTINUE KI = 'O4' RETURN 10000 FORMAT (/' Peak',I4,' Coarse Setting ',4F10.3) 11000 FORMAT ( ' Approximate ',4F10.3) 12000 FORMAT ( ' Final Values ',4F10.3,I10) 13000 FORMAT (' Coarse centering failure in ',A) END