C-----------------------------------------------------------------------
C
C                    Reflection Alignment routine
C
C  The routine has 5 entry points :--
C
C    CR aligns the reflection which is already in the detector, or
C       a single reflection which is set before alignment.
C    AL firstly reads in h,k,l values and generates symmetry equivalent 
C       reflections if wanted;
C       secondly aligns both + and - h,k,l values for use by MM.
C    AR resumes alignment after AL has been interrupted.
C    RO reads in reflections as for the first part of AL.
C    IORNT .EQ. 1 does re-orientation during data collection via the 
C                 second part of AL.
C-----------------------------------------------------------------------
      SUBROUTINE ALIGN
      INCLUDE 'COMDIF'
      DIMENSION IBH(10),IBK(10),IBL(10),BTHETA(10),BOMEGA(10),BCHI(10),
     $          BPHI(10),T4(4),O4(4),C4(4),P4(4)
      CHARACTER CPM*1
  100 IF (KI .EQ. 'CR') WRITE (COUT,10000)
      IF (KI .EQ. 'AL') WRITE (COUT,11000)
      IF (KI .EQ. 'AR') WRITE (COUT,12000)
      CALL GWRITE (ITP,' ')
      DT = IDTDEF
      DO = IDODEF
      DC = IDCDEF
      AFRAC = 0.5
      PRESET = 1000.
C-----------------------------------------------------------------------
C  Read the angle steps DT, DO and DC, counting TIME and AFRAC
C-----------------------------------------------------------------------
      IF (KI .EQ. 'AL' .OR. KI .EQ. 'CR' .OR. KI. EQ. 'RO') THEN
        IF (DFMODL .EQ. 'CAD4') THEN
          WRITE (COUT,12900)
          CALL FREEFM (ITR)
          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,13000) IDTDEF,IDODEF,IDCDEF,IFRDEF
          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
          DT = DT/IFRDEF
          DO = DO/IFRDEF
          DC = DC/IFRDEF
          WRITE (COUT,14000)
          CALL FREEFM (ITR)
          PRESET = RFREE(1)
          IF (PRESET .EQ. 0.0) PRESET = 1000.
          WRITE (COUT,15000)
          CALL FREEFM (ITR)
          AFRAC = RFREE(1)
          IF (AFRAC .EQ. 0.) AFRAC = 0.5
          WRITE (COUT,16000)
          CALL YESNO ('Y',ANS)
          IF (ANS .EQ. 'N') GO TO 100
        ENDIF
      ENDIF
C-----------------------------------------------------------------------
C  For CR, set the reflection if necessary
C-----------------------------------------------------------------------
      IF (KI .EQ. 'CR') THEN
        ITRY = 1
        IHSET = 0
        WRITE (COUT,17000)
        CALL YESNO ('Y',ANS)
        IF (ANS .EQ. 'N') THEN
  110     WRITE (COUT,18000)
          CALL FREEFM (ITR)
          IH = IFREE(1)
          IK = IFREE(2)
          IL = IFREE(3)
          IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) THEN
            KI = ' '
            RETURN
          ENDIF
          IHSET = 1
          MREF = MREF + 1
          CALL HKLN (IH,IK,IL,MREF)
          IPRVAL = 1
          CALL ANGCAL
          IF (IVALID .NE. 0) GO TO 110
          CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICC)
          IF (ICC .NE. 0) THEN
            WRITE (COUT,19000)
            CALL GWRITE (ITP,' ')
            GO TO 110
          ENDIF
        ENDIF
        IF (IHSET .EQ. 0) THEN
          WRITE (COUT,20000)
          CALL FREEFM (ITR)
          IHNEW = IFREE(1)
          IKNEW = IFREE(2)
          ILNEW = IFREE(3)
          IF (IHNEW .NE. 0 .OR. IKNEW .NE. 0 .OR. ILNEW .NE. 0) THEN
            IH = IHNEW
            IK = IKNEW
            IL = ILNEW
          ENDIF
        ENDIF
        CALL ANGET (RTHETA,ROMEGA,RCHI,RPHI)
        WRITE (COUT,21000) IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI
        CALL GWRITE (ITP,' ')
        IF (LPT .NE. ITP) WRITE (LPT,21000) 
     $                    IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI
  115   CALL HKLN (IH,IK,IL,MREF)
        CALL WXW2T (DT,DO,DC,ISLIT)
        IF (KI .EQ. 'FF') THEN
          IF (ITRY .EQ. 1) THEN
            WRITE (COUT,22000) IH,IK,IL
            CALL GWRITE (ITP,' ')
            ITRY = 2
            IPRVAL = 1
            CALL ANGCAL
            CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICC)
            GO TO 115
          ELSE
            WRITE (COUT,22100) IH,IK,IL
            CALL GWRITE (ITP,' ')
            KI = ' '
            RETURN
          ENDIF
        ENDIF
        CALL SHUTTR (1)
        CALL CCTIME (PRESET,CT1)
        CALL SHUTTR (-1)
        WRITE (COUT,23000) IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI,CT1
        CALL GWRITE (ITP,' ')
        IF (LPT .NE. ITP) WRITE (LPT,23000) 
     $                    IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI,CT1
        WRITE (COUT,24000)
        CALL YESNO ('Y',ANS)
        IF (ANS .EQ. 'Y') THEN
          WRITE (COUT,25000)
          CALL FREEFM (ITR)
          I = IFREE(1)
          IHK(I)    = IH
          NREFB(I)  = IK
          ILA(I)    = IL
          BCOUNT(I) = RTHETA
          BBGR1(I)  = ROMEGA
          BBGR2(I)  = RCHI
          BTIME(I)  = RPHI
        ENDIF
        KI = ' '
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  AR -- Resume AL-type alignment from where it was interrupted.
C-----------------------------------------------------------------------
      IF (KI .EQ. 'AR') THEN
        READ (IID,REC=16) (IOH(J),J = 1,80),DT,DO,DC,TIME,AFRAC
        READ (IID,REC=17) (IOK(J),J = 1,80),NTOT
        READ (IID,REC=18) (IOL(J),J = 1,80)
        READ (IID,REC=19) (IOH(J),IOK(J),IOL(J),J = 81,100)
        IF (DFMODL .EQ. 'CAD4') THEN
          ISLIT = 10.0*DT + 0.5
          IF (ISLIT .EQ. 0) ISLIT = 40
        ENDIF
        NBLOKO = 250
        NDONE = 0
  120   READ (ISD,REC=NBLOKO) 
     $       (JUNK,I = 1,80),NINBLK,NLIST,IPLUS,NTOT,NBLOKO
        IF (NINBLK .NE. 0) THEN
          NBLOKO = NBLOKO + 1
          NDONE = NDONE + NINBLK
          GO TO 120
        ENDIF
        NBLOKO = NBLOKO - 1
        READ (ISD,REC=NBLOKO) IBH,IBK,IBL,BTHETA,BOMEGA,BCHI,BPHI,
     $                        BPSI,NINBLK,NLIST,IPLUS,NTOT,NBLOKO
        IF (IPLUS .EQ. -1) NLIST = NLIST + 1
        IPLUS = -IPLUS
        IH = IPLUS*IOH(NLIST)
        IK = IPLUS*IOK(NLIST)
        IL = IPLUS*IOL(NLIST)
        WRITE (COUT,26000) NDONE,IH,IK,IL
        CALL GWRITE (ITP,' ')
        NSTART = NLIST
      ENDIF
C-----------------------------------------------------------------------
C   AL -- First Part  -- Read in a list of h,k,l values & generate 
C                        symmetry equivs if wanted; 
C         Second Part -- Align the + and - Friedel reflections
C   RO -- First part of AL
C         Second part of AL, when IORNT = 1
C-----------------------------------------------------------------------
      IF (KI .EQ. 'AL' .OR. KI .EQ. 'RO') THEN
        CALL ALEDIT (NTOT)
        IF (NTOT .EQ. 0) THEN
          KI = ' '
          RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Write the h,k,l values to file for use with AR and RO
C-----------------------------------------------------------------------
        WRITE (IID,REC=16) (IOH(J),J = 1,80),DT,DO,DC,TIME,AFRAC
        WRITE (IID,REC=17) (IOK(J),J = 1,80),NTOT
        WRITE (IID,REC=18) (IOL(J),J = 1,80)
        WRITE (IID,REC=19) (IOH(J),IOK(J),IOL(J),J = 81,100)
      ENDIF
      IF (KI .EQ. 'RO') RETURN
C-----------------------------------------------------------------------
C  Read in data if IORNT = 1 (RO)
C-----------------------------------------------------------------------
      IF (IORNT .EQ. 1) THEN  
        READ (IID,REC=16) (IOH(J),J = 1,80),DT,DO,DC,TIME,AFRAC
        READ (IID,REC=17) (IOK(J),J = 1,80),NTOT
        READ (IID,REC=18) (IOL(J),J = 1,80)
        READ (IID,REC=19) (IOH(J),IOK(J),IOL(J),J = 81,100)
        WRITE (LPT,27000) NREF
      ENDIF
C-----------------------------------------------------------------------
C  Get ready for the second part of AL or OR
C-----------------------------------------------------------------------
      IF (KI .EQ. 'AL' .OR. IORNT .EQ. 1) THEN
        NBLOKO = 250
        NINBLK = 0
        MREF = 0
        NSTART = 1
        IPLUS = 1
        IHSV = IH
        IKSV = IK
        ILSV = IL
      ENDIF
C-----------------------------------------------------------------------
C  Do alignment on these reflections (+ and -)
C-----------------------------------------------------------------------
      DO 150 NLIST = NSTART,NTOT
  130   IH = IPLUS*IOH(NLIST)
        IK = IPLUS*IOK(NLIST)
        IL = IPLUS*IOL(NLIST)
        ISTAN = 0
        DPSI = 0.0
        ITRY = 1
        MREF = MREF + 1
        NTRUE = 0
        IPRVAL = 0
        CALL ANGCAL
        IF (IVALID .NE. 0 .AND. IVALID .NE. 4) GO TO 140
        IF (DFMODL .EQ. 'CAD4' .AND. THETA .GT. 110.0 .AND.
     $     (CHI .GT. 270.0 .AND. CHI .LT. 300)) THEN
          WRITE (LPT,28000) IH,IK,IL
          GO TO 140
        ENDIF
        IF (ITRUE .EQ. 1) THEN
          T4(1) = THETA
          T4(2) = 360.0 - THETA
          T4(3) = THETA
          T4(4) = 360.0 - THETA
          O4(1) = OMEGA
          O4(2) = OMEGA
          O4(3) = OMEGA
          O4(4) = OMEGA
          C4(1) = CHI
          C4(2) = CHI
          C4(3) = 360.0 - CHI
          C4(4) = 360.0 - CHI
          P34 = 180.0 + PHI
          IF (P34 .GE. 360.0) P34 = P34 - 360.0
          P4(1) = PHI
          P4(2) = PHI
          P4(3) = P34
          P4(4) = P34
        ENDIF
  135   CALL HKLN (IH,IK,IL,MREF)
        IF (ITRUE .EQ. 1 .AND. ITRY .EQ. 1) THEN
          NTRUE = NTRUE + 1
          THETA = T4(NTRUE)
          OMEGA = O4(NTRUE)
          CHI   = C4(NTRUE)
          PHI   = P4(NTRUE)
        ENDIF
        CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICC)
        IF (ICC .NE. 0) GO TO 140
        CPM = '+'
        IF (IPLUS .EQ. -1) CPM = '-'
        WRITE (LPT,29000) NLIST,CPM,IH,IK,IL,THETA,OMEGA,CHI,PHI
        CALL WXW2T (DT,DO,DC,ISLIT)
        IF (KI .EQ. 'FF') THEN
          IF (ITRY .EQ. 1) THEN
            WRITE  (LPT,22000) IH,IK,IL
            WRITE (COUT,22000) IH,IK,IL
            CALL GWRITE (ITP,' ')
            ITRY = 2
            GO TO 135
          ELSE
            WRITE  (LPT,22100) IH,IK,IL
            WRITE (COUT,22100) IH,IK,IL
            CALL GWRITE (ITP,' ')
            GO TO 140
          ENDIF
        ENDIF
        CALL SHUTTR (1)
        CALL CCTIME (PRESET,CT1)
        CALL SHUTTR (-1)
        WRITE (LPT,30000) IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI,CT1
        IF (ITRUE .EQ. 1) THEN
          T4(NTRUE) = RTHETA
          O4(NTRUE) = ROMEGA
          C4(NTRUE) = RCHI
          P4(NTRUE) = RPHI
          IF (NTRUE .LT. 4) THEN
            ITRY = 1
            GO TO 135
          ELSE
            DO 136 I4 = 1,4
              IF (T4(I4) .GT. 180.0) T4(I4) = T4(I4) - 360.0
              IF (O4(I4) .GT. 180.0) O4(I4) = O4(I4) - 360.0
              IF (C4(I4) .GT. 180.0) C4(I4) = C4(I4) - 360.0
  136       CONTINUE
            RTHETA = (T4(1) - T4(2) + T4(3) - T4(4))/4.0
            ROMEGA = (O4(1) + O4(2) + O4(3) + O4(4))/4.0
            IF (ROMEGA .LT. 0.0) ROMEGA = ROMEGA + 360.0
            RCHI   = (C4(1) + C4(2) - C4(3) - C4(4))/4.0
            IF (RCHI .LT. 0.0) RCHI = RCHI + 360.0
            RPHI   = P4(1)
            WRITE ( LPT,22200) RTHETA,ROMEGA,RCHI,RPHI
            WRITE (COUT,22200) RTHETA,ROMEGA,RCHI,RPHI
            CALL GWRITE (ITP,' ')
          ENDIF
        ENDIF
        NINBLK = NINBLK + 1
        IBH(NINBLK)    = IH
        IBK(NINBLK)    = IK
        IBL(NINBLK)    = IL
        BTHETA(NINBLK) = RTHETA
        BOMEGA(NINBLK) = ROMEGA
        BCHI(NINBLK)   = RCHI
        BPHI(NINBLK)   = RPHI
        BPSI(NINBLK)   = 0.0
C-----------------------------------------------------------------------
C  Write the block of alignment data so far
C-----------------------------------------------------------------------
        WRITE (ISD,REC=NBLOKO) IBH,IBK,IBL,BTHETA,BOMEGA,BCHI,BPHI,
     $                         BPSI,NINBLK,NLIST,IPLUS,NTOT,NBLOKO
        IF (NINBLK .EQ. 10) THEN
          NBLOKO = NBLOKO + 1
          NINBLK = 0
        ENDIF
  140   CALL KORQ (KQFLAG)
        IF (KQFLAG .NE. 1) GO TO 160
        IF (IPLUS .EQ. 1) THEN
          IPLUS = -1
          GO TO 130
        ELSE
          IPLUS = 1
        ENDIF
  150 CONTINUE
C-----------------------------------------------------------------------
C  Write guard block on the end
C-----------------------------------------------------------------------
  160 IF (NINBLK .GT. 0) NBLOKO = NBLOKO + 1
      NINBLK = 0
      WRITE (ISD,REC=NBLOKO) (IOH(I),I = 1,80),NINBLK,NINBLK,NINBLK,
     $                        NTOT,NBLOKO
      IF (IORNT .EQ. 1) THEN
        IH = IHSV
        IK = IKSV
        IL = ILSV
      ENDIF
      CALL ZERODF
      KI = ' '
      RETURN
10000 FORMAT (10X,' Centre the reflection already in the detector ')
11000 FORMAT (/10X,' Alignment of Symmetry and Friedel Equivalent',
     $        ' Reflections'/,'%')
12000 FORMAT (10X,' Resume alignment from the AL command')
12900 FORMAT (' Type the horizontal slit width in mms (4.0) ',$)
13000 FORMAT (' Type the size of steps in 2T,Om,Chi,',
     $        ' (',I2,',',I2,',',I2,') 1/',I3,'deg ',$)
14000 FORMAT (' Type the count preset for each step (1000.0) ',$)
15000 FORMAT (' Fraction of max. count for half-height cutoff (0.5) ',$)
16000 FORMAT (' All OK (Y) ? ',$)
17000 FORMAT (' Is the reflection already set (Y) ? ',$)
18000 FORMAT (' Type h,k,l for the reflection (Exit) ',$)
19000 FORMAT (3I3,' setting collision.  Try again.')
20000 FORMAT (' Type h,k,l for use in M2/M3 ',$)
21000 FORMAT (' Starting Values ',3I4,4F10.3)
22000 FORMAT (3I4,' ailignment failed on first attempt'/)
22100 FORMAT (3I4,' ailignment failed on both attempts'/)
22200 FORMAT ('     Mean Values ',12X,4F10.3/)
23000 FORMAT ('    Final Values ',3I4,4F10.3,F7.0/)
24000 FORMAT (' Do you wish to save the angles for M2 or M3 (Y) ? ',$)
25000 FORMAT (' What is the sequence number of this reflection ? ',$)
26000 FORMAT (I4,' reflections have been aligned. Resuming at ',3I3/)
27000 FORMAT (/' Reorientation before Reflection ',I5)
28000 FORMAT (3I4,' is probably inaccessible on a CAD-4.'/)
29000 FORMAT (I4,A,' Starting Values ',3I4,4F10.3)
30000 FORMAT ('         Final Values ',3I4,4F10.3,F7.0/)
      END
C-----------------------------------------------------------------------
C  Routine to generate equivalent reflections (Not Friedel)
C-----------------------------------------------------------------------
      SUBROUTINE DEQHKL (NHKL,ILIST)
      INCLUDE 'COMDIF'
C-----------------------------------------------------------------------
C  Work out the reflection details and the unique equivalents
C-----------------------------------------------------------------------
      NHKL  = 0
      NRCEN = 0
      IEXCL = 0
      DO 110 K = 1,NSYM
        IM = 0
        JS = 0
        JH     = IH*JRT(1,1,K) + IK*JRT(2,1,K) + IL*JRT(3,1,K)
        JK     = IH*JRT(1,2,K) + IK*JRT(2,2,K) + IL*JRT(3,2,K)
        JL     = IH*JRT(1,3,K) + IK*JRT(2,3,K) + IL*JRT(3,3,K)
        IPHASE = IH*JRT(1,4,K) + IK*JRT(2,4,K) + IL*JRT(3,4,K)
        IF (MOD(IPHASE,12) .EQ. 0) IPHASE = 0
        IF (IH .EQ.  JH .AND. IK .EQ.  JK .AND. IL .EQ.  JL) IM = 1
        IF (IH .EQ. -JH .AND. IK .EQ. -JK .AND. IL .EQ. -JL) JS = 1
        IF (JS .EQ. 1) NRCEN = 1
        IF (IM .EQ. 1 .AND. IPHASE .NE. 0) IEXCL = 1
        IF (ICENT .EQ. 0) JS = 0
        IF (JS .EQ. 1 .AND. IPHASE .NE. 0) IEXCL = 1
        IF (NHKL .NE. 0) THEN
          DO 100 I = 1,NHKL
            IF (JHKL(1,I) .EQ.  JH .AND.
     $          JHKL(2,I) .EQ.  JK .AND.
     $          JHKL(3,I) .EQ.  JL) GO TO 110
            IF (JHKL(1,I) .EQ. -JH .AND.
     $          JHKL(2,I) .EQ. -JK .AND.
     $          JHKL(3,I) .EQ. -JL) GO TO 110
  100     CONTINUE
        ENDIF
        NHKL = NHKL + 1
        JHKL(1,NHKL) = JH
        JHKL(2,NHKL) = JK
        JHKL(3,NHKL) = JL
  110 CONTINUE
      IVALID = IEXCL
      IEXCL = 0
      IF (LATCEN .NE. 1) THEN
        IF (LATCEN .EQ. 2) IREM = MOD((IK + IL),2)
        IF (LATCEN .EQ. 3) IREM = MOD((IH + IL),2)
        IF (LATCEN .EQ. 4) IREM = MOD((IH + IK),2)
        IF (LATCEN .EQ. 5) IREM = MOD((IH + IK + IL),2)
        IF (LATCEN .EQ. 6) THEN
          IREM = MOD((IH + IK),2)
          IF (IREM .EQ. 0) IREM = MOD((IH + IL),2)
        ENDIF
        IF (LATCEN .EQ. 7) IREM = MOD((-IH + IK + IL),3)
        IF (IEXCL .EQ. 0) IEXCL = IREM
      ENDIF
      IF (IEXCL .NE. 0) THEN
        IVALID = IVALID + 2
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Print the equivalent indices
C-----------------------------------------------------------------------
      IF (ILIST .EQ. 1) THEN
        WRITE (COUT,10000) ((JHKL(J,K),J = 1,3),K = 1,NHKL)
        CALL GWRITE (ITP,' ')
      ENDIF
      RETURN
10000 FORMAT (4(5X,3I4))
      END
C-----------------------------------------------------------------------
C  Edit the h,k,l list for the AL or RO commands
C-----------------------------------------------------------------------
      SUBROUTINE ALEDIT (NTOT)
      INCLUDE 'COMDIF'
      DIMENSION NDEL(100)
      CHARACTER IOPT*1
C-----------------------------------------------------------------------
C  Read in the existing list of h,k,l values and write it to terminal
C-----------------------------------------------------------------------
      READ (IID,REC=16) (IOH(J),J = 1,80),DT,DO,DC,TIME,AFRAC
      READ (IID,REC=17) (IOK(J),J = 1,80),NTOT
      READ (IID,REC=18) (IOL(J),J = 1,80)
      READ (IID,REC=19) (IOH(J),IOK(J),IOL(J),J = 81,100)
  100 IF (NTOT .LE. 0) THEN
        WRITE (COUT,10000)
        CALL GWRITE (ITP,' ')
      ELSE
        WRITE (COUT,11000) NTOT
        CALL GWRITE (ITP,' ')
        NLINE = NTOT/4
        IF (NTOT - 4*NLINE .NE. 0) NLINE = NLINE + 1
        I1 = 1
        I2 = 4
        DO 110 N = 1,NLINE
          IF (N .EQ. NLINE) I2 = NTOT
          WRITE (COUT,12000) (I,IOH(I),IOK(I),IOL(I),I = I1,I2)
          CALL GWRITE (ITP,' ')
          I1 = I1 + 4
          I2 = I2 + 4
  110   CONTINUE
      ENDIF
C-----------------------------------------------------------------------
C  Get the edit option IOPT
C-----------------------------------------------------------------------
      WRITE (COUT,13000)
      CALL ALFNUM (IOPT)
      IF (IOPT .EQ. ' ') IOPT = 'U'
C-----------------------------------------------------------------------
C  Option E. Exit from AL with 0 reflns
C-----------------------------------------------------------------------
      IF (IOPT .EQ. 'E') THEN
        NTOT = 0
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Option U.  Use the present list and get the TRUANG flag.
C-----------------------------------------------------------------------
      IF (IOPT .EQ. 'U') THEN
        ITRUE = 0
        WRITE (COUT,14100)
        CALL YESNO ('N',ANS)
        IF (ANS .EQ. 'Y') ITRUE = 1
        RETURN
      ENDIF
C-----------------------------------------------------------------------
C  Options A and N.  Add reflns or use new ones.
C-----------------------------------------------------------------------
      IF (IOPT .EQ. 'A' .OR. IOPT .EQ. 'N') THEN
        IF (IOPT .EQ. 'N') NTOT = 0
        ISYMOR = 0
        WRITE (COUT,14000)
        CALL YESNO ('Y',ANS)
        IF (ANS .EQ. 'Y') THEN
          ISYMOR = 1
          IOUT = -1
          CALL SPACEG (IOUT,0)
        ENDIF
        NPOSS = 100 - NTOT
        WRITE (COUT,15000) NPOSS
        CALL GWRITE (ITP,' ')
  120   WRITE (COUT,16000)
        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
          IPRVAL = 1
          CALL ANGCAL
          IF (IVALID .EQ. 0) THEN
            IF (ISYMOR .EQ. 1) THEN
              ILIST = 1
              CALL DEQHKL (NHKL,ILIST)
              DO 130 I = 1,NHKL
                NTOT = NTOT + 1
                IOH(NTOT) = JHKL(1,I)
                IOK(NTOT) = JHKL(2,I)
                IOL(NTOT) = JHKL(3,I)
                IF (NTOT .EQ. NSIZE/2) THEN
                  WRITE (COUT,17000)
                  CALL GWRITE (ITP,' ')
                  GO TO 100
                ENDIF
  130         CONTINUE
            ELSE
              NTOT = NTOT + 1
              IOH(NTOT) = IH
              IOK(NTOT) = IK
              IOL(NTOT) = IL
            ENDIF
          ENDIF 
          GO TO 120
        ENDIF
      ENDIF
C-----------------------------------------------------------------------
C  Option D.  Delete reflections from the list
C-----------------------------------------------------------------------
      IF (IOPT .EQ. 'D') THEN
        DO 140 I = 1,100
          NDEL(I) = 0
  140   CONTINUE
  150   WRITE (COUT,18000)
        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
          DO 160 N = 1,NTOT
            IF (IH .EQ. IOH(N) .AND. IK .EQ. IOK(N) .AND. 
     $          IL .EQ. IOL(N)) THEN
              NDEL(N) = 1
              GO TO 150
            ENDIF
  160     CONTINUE
          WRITE (COUT,19000) IH,IK,IL
          CALL GWRITE (ITP,' ')
          GO TO 150
        ELSE
C-----------------------------------------------------------------------
C  Form the new list 
C-----------------------------------------------------------------------
          NEW = 0
          DO 170 N = 1,NTOT
            IF (NDEL(N) .EQ. 0) THEN
              NEW = NEW + 1
              IOH(NEW) = IOH(N)
              IOK(NEW) = IOK(N)
              IOL(NEW) = IOL(N)
            ENDIF
  170     CONTINUE
          NTOT = NEW
        ENDIF
      ENDIF
C-----------------------------------------------------------------------
C  List the existing list and get new option
C-----------------------------------------------------------------------
      GO TO 100
10000 FORMAT (' There are no reflections in the AL/RO list.')
11000 FORMAT (' The following',I4,' reflections are in the AL/RO list')
12000 FORMAT (4(I3,'.',3I4,3X))
13000 FORMAT (' The following options are available :--'/
     $        '  U. Use the existing AL/RO list;'/
     $        '  A. Add reflections to the existing AL/RO list;'/
     $        '  D. Delete reflections from the existing AL/RO list;'/
     $        '  N. New AL/RO list.'/
     $        '  L. List the reflections in the existing AL/RO list;'/
     $        '  E. Exit from AL/RO.'/
     $        ' Which option do you want (U) ? ',$)
14000 FORMAT (' Friedel equivalents are always used.'/
     $        ' Do you want symmetry equivalents as well (Y) ? ',$)
14100 FORMAT (' Align 4 equivalent settings for each refln (N) ? ',$)
15000 FORMAT (' Type h,k,l for up to',I4,' reflections ')
16000 FORMAT (' h,k,l (End) ',$)
17000 FORMAT (' No more reflections allowed.')
18000 FORMAT (' Type h,k,l for the reflection to be deleted (End) ',$)
19000 FORMAT (3I4,' not found. Try again please.')
      END
