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
