C-----------------------------------------------------------------------
C               8-Reflection Centring Routine   July.80
C  The treatment follows INT TAB V.4. pp. 282
C  For the CAD-4 the treatment is the same as described in the CAD-4
C  Manual as corrected in the note by Y. Le Page
C-----------------------------------------------------------------------
      SUBROUTINE CENT8
      INCLUDE 'COMDIF'
      DIMENSION T8(8),D8(8),A8(8),P8(8)
      DATA RA/57.2958/
      INTEGER INTERRUPT
      REAL MPRESET
  100 WRITE (COUT,10000)
      CALL YESNO ('Y',ANS)
      IF (ANS .EQ. 'N') THEN
        KI = ' '
        RETURN
      ENDIF
      IF (DFMODL .EQ. 'CAD4') THEN
        WRITE (COUT,14900)
        DT = RFREE(1)
        ISLIT = 10.0*DT + 0.5
        IF (ISLIT .EQ. 0) ISLIT = 40
        IF (ISLIT .LT. 10) ISLIT = 10
        IF (ISLIT .GT. 60) ISLIT = 60
      ELSE
        ISLIT = 0
        WRITE (COUT,15000) IFRDEF,IDTDEF,IDODEF,IDCDEF
        CALL FREEFM (ITR)
        DT = RFREE(1)
        DO = RFREE(2)
        DC = RFREE(3)
        IF (DT .EQ. 0) DT = IDTDEF
        IF (DO .EQ. 0) DO = IDODEF
        IF (DC .EQ. 0) DC = IDCDEF
  110   DT = DT/IFRDEF
        DO = DO/IFRDEF
        DC = DC/IFRDEF
        WRITE (COUT,16000)
        CALL FREEFM (ITR)
        MPRESET = RFREE(1)
        IF (MPRESET .EQ. 0) MPRESET = 1000.0
        WRITE (COUT,18000)
        CALL FREEFM (ITR)
        AFRAC = RFREE(1)
        IF (AFRAC .EQ. 0) AFRAC = 0.5
      ENDIF
      DO 115 I = 1,10
        IHK(I)   = 0
        NREFB(I) = 0
        ILA(I)   = 0
  115 CONTINUE
C-----------------------------------------------------------------------
C  Get the reflections to be used
C-----------------------------------------------------------------------
      WRITE (COUT,19000)
      CALL GWRITE (ITP,' ')
      I = 0
      IREFS = 0
  120 WRITE (COUT,34000)
      CALL FREEFM (ITR)
      IH = IFREE(1)
      IK = IFREE(2)
      IL = IFREE(3)
      IF (IH .NE. 0 .OR. IK .NE. 0 .OR. IL .NE. 0) THEN
        ISTAN = 0
        DPSI = 0
        MREF = 0
        IPRVAL = 1
        CALL ANGCAL
        IF (IVALID .EQ. 0) THEN
          I = I + 1
          IHK(I)   = IH
          NREFB(I) = IK
          ILA(I)   = IL
          IREFS = I
        ENDIF
        GO TO 120
      ENDIF
      IF (I .EQ. 0) THEN
        KI = ' '
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Set the first reflection as a check.  (Probably unnecessary now)
C-----------------------------------------------------------------------
      IH = IHK(1)
      IK = NREFB(1)
      IL = ILA(1)
      IPRVAL = 0
      CALL ANGCAL
      CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICC)
      CALL SHUTTR (1)
C      WRITE (COUT,22000)
C      CALL YESNO ('Y',ANS)
C      IF (ANS .EQ. 'N') GO TO 100
C-----------------------------------------------------------------------
C  Make and store the 8 angular combinations in T8,D8,A8,P8
C-----------------------------------------------------------------------
      DO 200 J = 1,IREFS
        IH = IHK(J)
        IK = NREFB(J)
        IL = ILA(J)
        IPRVAL = 0
        IF (DFMODL .NE. 'CAD4') THEN
          CALL ANGCAL
          TNEG = -THETA
          CALL MOD360 (TNEG)
          CNEG = -CHI
          CALL MOD360 (CNEG)
          PNEG = 180.0 + PHI
          CALL MOD360 (PNEG)
          T8(1) = THETA
          T8(2) = THETA
          T8(3) = TNEG
          T8(4) = TNEG
          T8(5) = THETA
          T8(6) = THETA
          T8(7) = TNEG
          T8(8) = TNEG
          DO 130 I = 1,8
            D8(I) = OMEGA
  130     CONTINUE
          OMNEG = -OMEGA
          CALL MOD360(OMNEG)
          DO 140 I = 3,6
            D8(I) = OMNEG
  140     CONTINUE
          A8(1) = CHI
          A8(2) = CNEG
          A8(7) = CNEG
          A8(8) = CHI
          CNEG = 180.0 + CNEG
          CALL MOD360 (CNEG)
          A8(4) = CNEG
          A8(5) = CNEG
          CNEG = 180 + CHI
          CALL MOD360 (CNEG)
          A8(3) = CNEG
          A8(6) = CNEG
          P8(1) = PHI
          P8(2) = PNEG
          P8(3) = PHI
          P8(4) = PNEG
          P8(5) = PNEG
          P8(6) = PHI
          P8(7) = PNEG
          P8(8) = PHI
C-----------------------------------------------------------------------
C  For CAD-4 :--
C  Work out the 8 settings, as in CAD-4 manual, with the arcs of the
C  goniometer head are horizontal and vertical - heaven knows why!!
C-----------------------------------------------------------------------
        ELSE
          DPSI = 0
          ISTAN = 0
          CALL ANGCAL
          PSI = 360.0 - PHI
C-----------------------------------------------------------------------
C  Rotate psi by -phi to get required position.  This is approximate
C  but good enough for alignment to start
C-----------------------------------------------------------------------
          DPSI = 10.0
          CALL ANGCAL
C-----------------------------------------------------------------------
C  Generate positions 1, 2, 3 and 4 from this
C-----------------------------------------------------------------------
          TNEG = -THETA
          CALL MOD360 (TNEG)
          T8(1) =  THETA
          T8(2) =  TNEG
          T8(3) =  THETA
          T8(4) =  TNEG
          D8(1) =  OMEGA
          D8(2) =  OMEGA
          OMEGA = -OMEGA
          CALL MOD360 (OMEGA)
          D8(3) =  OMEGA
          D8(4) =  OMEGA
          A8(1) =  CHI
          A8(2) =  CHI
          A8(3) =  180.0 - CHI
          CALL MOD360 (A8(3))
          A8(4) =  A8(3)
          P8(1) =  PHI
          P8(2) =  PHI
          PHI = 180.0 + PHI
          CALL MOD360(PHI)
          P8(3) =  PHI
          P8(4) =  PHI
C-----------------------------------------------------------------------
C  Calculate the position at Phi = 90 and take the settings at 
C  180 + Phi and -Chi from there to generate settings 5, 6, 7 and 8
C-----------------------------------------------------------------------
          PSI = PSI - 90.0
          CALL MOD360 (PSI)
          CALL ANGCAL
          T8(5) =  THETA
          T8(6) =  TNEG
          T8(7) =  THETA
          T8(8) =  TNEG
          D8(5) =  OMEGA
          D8(6) =  OMEGA
          OMEGA = -OMEGA
          CALL MOD360 (OMEGA)
          D8(7) =  OMEGA
          D8(8) =  OMEGA
          CHI = -CHI
          CALL MOD360 (CHI)
          A8(5) = CHI
          A8(6) = CHI
          CHI = 180.0 - CHI
          CALL MOD360 (CHI)
          A8(7) = CHI
          A8(8) = CHI
          PHI = 180.0 + PHI
          CALl MOD360 (PHI)
          P8(5) = PHI
          P8(6) = PHI
          PHI = - PHI
          CALl MOD360 (PHI)
          P8(7) = PHI
          P8(8) = PHI
C        write (cout,99999) (i,t8(i),d8(i),a8(i),p8(i), i=1,8)
C99999 format (i3,4f10.3)
C        call gwrite (itp,' ')
        ENDIF
C-----------------------------------------------------------------------
C  Set the 8 different settings, align them and store the results
C  in T8,D8,A8 AND P8.
C-----------------------------------------------------------------------
        TT0 = 0
        OM0 = 0
        CH0 = 0
        MREF = 0
        CALL SHUTTR (1)
        DO 150 I = 1,8
  145     ITRY = 1
          THETA = T8(I)
          OMEGA = D8(I)
          CHI   = A8(I)
          PHI   = P8(I)
          MREF  = MREF + 1
          CALL HKLN (IH,IK,IL,MREF)
          CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICC)
          IF (ICC .NE. 0) THEN
            WRITE (COUT,23000) MREF,IH,IK,IL
            CALL GWRITE (ITP,' ')
            GO TO 200
          ENDIF
          WRITE (COUT,24000) IH,IK,IL,THETA,OMEGA,CHI,PHI
          CALL GWRITE (ITP,' ')
          WRITE (LPT,24000) IH,IK,IL,THETA,OMEGA,CHI,PHI
          CALL WXW2T (DT,DO,DC,ISLIT)
          CALL SHUTTR (1)
          CALL CCTIME (MPRESET,COUNT)
          CALL KORQ(INTERRUPT)
          IF(INTERRUPT .NE. 1) THEN
             WRITE(COUT,37000)
             RETURN
          ENDIF
          CALL SHUTTR (-1)
          IF (KI .EQ. 'FF') THEN
            IF (ITRY .EQ. 1) THEN
              WRITE  (LPT,25000) MREF,IH,IK,IL
              WRITE (COUT,25000) MREF,IH,IK,IL
              CALL GWRITE (ITP,' ')
              ITRY = 2
              GO TO 145
            ELSE IF (ITRY .EQ. 2) THEN
              WRITE  (LPT,25100) MREF,IH,IK,IL
              WRITE (COUT,25100) MREF,IH,IK,IL
              CALL GWRITE (ITP,' ')
              GO TO 200
            ENDIF
          ENDIF
          WRITE (COUT,26000) RTHETA,ROMEGA,RCHI,RPHI,COUNT
          CALL GWRITE (ITP,' ')
          WRITE (LPT,26000) RTHETA,ROMEGA,RCHI,RPHI,COUNT
          T8(I) = RTHETA
          D8(I) = ROMEGA
          A8(I) = RCHI
          P8(I) = RPHI
  150   CONTINUE
        CALL SHUTTR (-1)
C-----------------------------------------------------------------------
C  Analyse the results for CAD4 or all others
C-----------------------------------------------------------------------
        DO 160 I = 1,8
          IF (T8(I) .GE. 180.0) T8(I) = T8(I) - 360.0
          TT0 = TT0 + T8(I)
          IF (D8(I) .GE. 180.0) D8(I) = D8(I) - 360.0
          OM0 = OM0 + D8(I)
          CH0 = CH0 + A8(I)
  160   CONTINUE
        EXPCT = 0.
        CALL ANG360(TT0,EXPCT)
        TT0 = TT0/8.0
        CALL ANG360(OM0,EXPCT)
        OM0 = OM0/8.0
        CALL ANG360(CH0,EXPCT)
        CH0 = CH0/8.0
        WRITE (COUT,28000) TT0,OM0,CH0
        CALL GWRITE (ITP,' ')
        WRITE (LPT,28000) TT0,OM0,CH0
C-----------------------------------------------------------------------
C  Get the true values of the angles
C-----------------------------------------------------------------------
        IF (DFMODL .NE. 'CAD4') THEN
          TT0 = T8(1)+T8(2)+T8(5)+T8(6)-T8(3)-T8(4)-T8(7)-T8(8)
          EXPCT = 8*T8(1)
          CALL ANG360(TT0,EXPCT)
          OM0 = D8(1)+D8(2)+D8(7)+D8(8)-D8(3)-D8(4)-D8(5)-D8(6)
          EXPCT = 8*D8(1)
          CALL ANG360(OM0,EXPCT)
          CH0 = A8(1)+A8(3)+A8(6)+A8(8)-A8(2)-A8(4)-A8(5)-A8(7)
          EXPCT = 8*A8(1)
          CALL ANG360(CH0,EXPCT)
          TT0 = TT0/8.0
          OM0 = OM0/8.0
          CALL MOD360 (OM0)
          CH0 = CH0/8.0
C          BCOUNT(J-1) = TT0
C          BBGR1(J-1)  = OM0
C          BBGR2(J-1)  = CH0
C          BTIME(J-1)  = PHI
          WRITE (COUT,29000) TT0,OM0,CH0,PHI
          CALL GWRITE (ITP,' ')
          WRITE (LPT,29000) TT0,OM0,CH0,PHI
          CHXL = A8(1)+A8(2)+A8(3)+A8(4)-A8(5)-A8(6)-A8(7)-A8(8)
          EXPCT = 0.
          CALL ANG360(CHXL,EXPCT)
          CHC = A8(1)+A8(2)+A8(5)+A8(6)-A8(3)-A8(4)-A8(7)-A8(8)
          CALL ANG360(CHC,EXPCT)
          CHXL = CHXL/8.0
          CHC = CHC/8.0
          WRITE (COUT,30000) CHXL,CHC
          CALL GWRITE (ITP,' ')
          WRITE (LPT,30000) CHXL,CHC
        ELSE
          OM0 = (D8(1)-D8(2)+D8(3)-D8(4)+D8(5)-D8(6)+D8(7)-D8(8))/8.0
          CH0 = (A8(1)-A8(2)+A8(3)-A8(4)+A8(5)-A8(6)+A8(7)-A8(8))/8.0
          DMON  = 5.4*CH0*SIN(0.5*T8(1)/RA)
          VER   = 216.5*TAN(DMON/RA)
          HOR   = 3.78*OM0
          DETEC = 3.02*(TT0 - OM0)
          WRITE (COUT,35000) DETEC,HOR,VER,DMON
          CALL GWRITE (ITP,' ')
          WRITE (LPT,35000) DETEC,HOR,VER,DMON
          TT0  = (T8(1)-T8(2)+T8(3)-T8(4)+T8(5)-T8(6)+T8(7)-T8(8))/8.0
          OMET = (D8(1)+D8(2)-D8(3)-D8(4)-A8(5)-A8(6)+A8(7)+A8(8))/8.0
          CHIT = (A8(1)+A8(2)-A8(3)-A8(4)-D8(5)-D8(6)+D8(7)+D8(8))/8.0
          CHSIGN = 1.0
          IF (A8(1) .GT. 180.0) CHSIGN = -1.0
          CHIT = CHSIGN*(90.0 + CHIT)
          CALL MOD360 (CHIT)
          PHIT = 0.0
          WRITE (COUT,36000) TT0,OMET,CHIT,PHIT
          CALL GWRITE (ITP,'%')
          WRITE (LPT,36000) TT0,OMET,CHIT,PHIT
        ENDIF
  200 CONTINUE
      KI =  ' '
      RETURN
10000 FORMAT (' 8 Reflection Centring (Y) ? ',$)
C12000 FORMAT (' *** WARNING --- Remove the low temp. arm *** ',/,
C     $        ' Type the Source-to-Crystal distance (',I3,'mm) ',$)
C14000 FORMAT (' Type the Crystal-to-Detector distance (',I3,'mm) ',$)
14900 FORMAT (' Type the horizontal slit width in mms (4.0) ',$)
15000 FORMAT (' Type the  2T,Om,Ch step size in 1/',I3,'th',
     $        ' (',I2,',',I2,',',I2,') ',$)
16000 FORMAT (' Type the count preset per step (1000.0) ',$)
18000 FORMAT (' Type the max count cutoff fraction (0.5) ',$)
19000 FORMAT (' Type h,k,l for reflections to be used (End) ')
C22000 FORMAT (' The 1st reflection is set.  Is everything OK (Y) ? ',$)
23000 FORMAT (' Setting',I2,', Collision.  Cannot complete',3I4)
24000 FORMAT (' Starting values ',3I4,4F10.3)
25000 FORMAT (' Setting',I2,' of',3I4,' failed on first attempt.')
25100 FORMAT (' Setting',I2,' of',3I4,' failed.  Cannot complete')
26000 FORMAT ('    Final values ',12X,4F10.3,F8.0)
28000 FORMAT (' Zero Values of TT,OM,CH ',3F8.3)
29000 FORMAT (' True values of TT,OM,CH ',3F8.3,' (at Phi',F8.3,')')
30000 FORMAT (' Delta-chi Crystal ',F8.3,5X,'Delta-chi Counter ',
     $         F8.3//)
C31000 FORMAT (' SXT ',F10.3,' SXO',F10.3,' CXT',F10.3)
C32000 FORMAT (' SYT ',F10.3,' SYO',F10.3,' CYT',F10.3//)
34000 FORMAT (' Next h,k,l (End) ',$)
35000 FORMAT (' Offsets: Det',F7.3,'mm, Hor',F7.3,'mm, ',
     $                  'Ver',F7.3,'mm, Mon',F7.3,'deg.')
36000 FORMAT (' True 2Theta     Omega     Chi       Phi'/2X,4F10.3/)
37000 FORMAT (' Operation interrupted by user')
      END
C-----------------------------------------------------------------------
C  Routine to make the difference between ANG and EXPCT small
C-----------------------------------------------------------------------
      SUBROUTINE ANG360 (ANG,EXPCT)
  100 D = EXPCT - ANG
      ISIGN = 1
      IF (D .LT. 0.) ISIGN = -1
      IF (ABS(D) .GE. 180.0) THEN
        ANG = ANG + ISIGN*360.0
        GO TO 100
      ENDIF
      RETURN
      END