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)) 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----------------------------------------------------------------------- CALL SHUTTR (99) ITIMS(J) = 0 IF (DFMODL .EQ. 'CAD4') THEN KI = 'SP' CALL CADCEN (0) IF (KI .EQ. 'FF') THEN WHICH = 'Phi' WRITE (COUT,13000) WHICH CALL GWRITE (ITP,' ') WRITE (LPT,13000) WHICH GO TO 200 ENDIF 110 CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) KI = 'ST' IGOOD = 0 CALL CADCEN (IGOOD) C write (lpt,99993) ki,igood C99993 format (' KI,igood ',a,i4) IF (KI .EQ. 'FF' .OR. KI .EQ. 'TO' .OR. KI .EQ. 'BO') THEN CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,IERR) KI = 'SC' RTIM = PRESET CALL CFIND (RTIM) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) IF (RTIM .GT. 3.0) THEN WHICH = 'Chi' WRITE (COUT,13000) WHICH CALL GWRITE (ITP,' ') WRITE (LPT,13000) WHICH GO TO 200 ENDIF KI = 'SO' IGOOD = 0 CALL CADCEN (IGOOD) IF (KI .EQ. 'FF') THEN WHICH = 'Omega' WRITE (COUT,13000) WHICH CALL GWRITE (ITP,' ') WRITE (LPT,13000) WHICH GO TO 200 ENDIF GO TO 110 ENDIF IF (IGOOD .NE. 0) GO TO 110 C----------------------------------------------------------------------- C Sietronics 145D centring C----------------------------------------------------------------------- ELSE IF (DFMODL .EQ. '145D') THEN PWIDTH = 2*WIDTH CALL MAXPOINT (3,PWIDTH,0.1,RMAXPT) PHI = RMAXPT CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CWIDTH = 4*WIDTH CALL MAXPOINT (2,CWIDTH,0.1,RMAXPT) CHI = RMAXPT OMEGA = OMEGA - 0.5*TWIDTH CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) TWIDTH = WIDTH CALL MAXPOINT (4,TWIDTH,0.1,RMAXPT) THETA = RMAXPT C----------------------------------------------------------------------- C All other machines for the moment C----------------------------------------------------------------------- ELSE RTIM = 1000. CALL PFIND (RTIM) THETA = RTHETA OMEGA = ROMEGA IF (RTIM .GT. 10000.0) GO TO 200 C IF (RTIM .GT. 1.0) RTIM = 1.0 CHI = RCHI + 1.25 CALL CFIND (RTIM) THETA = RTHETA + 1.25 OMEGA = OMEGA - 0.625 IF (RTIM .GT. 10000.0) GO TO 200 C IF (RTIM .GT. 1.0) RTIM = 1.0 CALL TFIND (RTIM) IF (RTIM .GT. 10000.0) GO TO 200 ENDIF 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