C-----------------------------------------------------------------------
C  Subroutine to calculate 2Theta,      chi,phi when Dpsi=0
C                      and 2Theta,omega,chi,phi otherwise
C  IVALID = 32 if 2theta .ge. 180.0
C           16 if low temp. and chi is not in +/- 90 range
C            8 if reflection is 0,0,0,      or
C            4 if not within 2Theta limits, or
C            2 if lattice or specific absence, or
C            1 if translation absence.
C  IROT=1   if rotation is not possible
C-----------------------------------------------------------------------
      SUBROUTINE ANGCAL
      INCLUDE 'COMDIF'
      DIMENSION Q(3,3),VEC(3)
      CHARACTER INTFLT*3
      RAD = 1.0/DEG
      SM4 = 2.0*SIN(THEMIN*RAD*0.5)
      SM4 = SM4*SM4
      SS4 = 2.0*SIN(THEMAX*RAD*0.5)
      SS4 = SS4*SS4
      IROT = 0
      IVALID = 0
C-----------------------------------------------------------------------
C  If called by RA allow for fractional h,k,l values
C-----------------------------------------------------------------------
      INTFLT = 'INT'
      IF ((KI .EQ. 'RA' .OR. KI .EQ. 'SR' .OR. KI .EQ. 'MS') .AND.
     $    (ABS(RFREE(1) - IH) .GT. 0.0001 .OR.
     $     ABS(RFREE(2) - IK) .GT. 0.0001 .OR.
     $     ABS(RFREE(3) - IL) .GT. 0.0001)) INTFLT = 'FLT'
      IF (INTFLT .EQ. 'INT') THEN
        RH = IH
        RK = IK
        RL = IL
      ELSE
        RH = RFREE(1)
        RK = RFREE(2)
        RL = RFREE(3)
      ENDIF
      IF (INTFLT .EQ. 'INT') THEN
C-----------------------------------------------------------------------
C  Test for the 0,0,0 reflection
C-----------------------------------------------------------------------
        IF (IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) THEN
          IVALID = 8
          IF (IPRVAL .NE. 0) THEN
            WRITE (COUT,10000)
            CALL GWRITE (ITP,' ')
          ENDIF
          RETURN
        ENDIF
C-----------------------------------------------------------------------
C  Test for translation and lattice absences
C-----------------------------------------------------------------------
        IF (KI .NE. 'IE') CALL DEQHKL (NHKL,0)
        IF (IVALID .NE. 0 .AND. IPRVAL .NE. 0) THEN
          WRITE (COUT,11000) IH,IK,IL
          CALL GWRITE (ITP,' ')
        ENDIF
C-----------------------------------------------------------------------
C  Tests for typed in specific absence conditions (NCOND .GT. 0)
C  If only the direction is of interest (NN), bypass these tests.
C-----------------------------------------------------------------------
        IF (NCOND .GT. 0 .AND. NN .NE. -1) THEN
          DO 100 J = 1,NCOND
            JCOND = ICOND(J)
            IF ((JCOND .EQ. 1 .AND. IH .EQ. 0 .AND. IK .EQ. 0) .OR.
     $          (JCOND .EQ. 2 .AND. IH .EQ. 0 .AND. IL .EQ. 0) .OR.
     $          (JCOND .EQ. 3 .AND. IK .EQ. 0 .AND. IL .EQ. 0) .OR.
     $          (JCOND .EQ. 4 .AND. IH .EQ. 0) .OR.
     $          (JCOND .EQ. 5 .AND. IK .EQ. 0) .OR.
     $          (JCOND .EQ. 6 .AND. IL .EQ. 0) .OR. 
     $           JCOND .EQ. 7) THEN
              LHS = IABS(IH*IHS(J) + IK*IKS(J) + IL*ILS(J))
              M = IR(J)
              IF (MOD(LHS,M) .NE. IS(J)) THEN
                IVALID = 2
                IF (IPRVAL .NE. 0) THEN
                  WRITE (COUT,12000) IH,IK,IL
                  CALL GWRITE (ITP,' ')
                ENDIF
              ENDIF
            ENDIF
  100     CONTINUE
        ENDIF
      ENDIF
      SUM = 0.0
      DO 110 I = 1,3
        VEC(I) = R(I,1)*RH + R(I,2)*RK + R(I,3)*RL
        SUM = SUM + VEC(I)*VEC(I)
  110 CONTINUE
C-----------------------------------------------------------------------
C  Calculate Theta from SINABS to avoid segment problems
C  Test for 2Theta limits, if not a reference reflection and print
C  error message if not the UM command.
C-----------------------------------------------------------------------
      SINMAX = RH*RH*SINABS(1) + RK*RK*SINABS(2) + RL*RL*SINABS(3) +
     $         RH*RK*SINABS(4) + RH*RL*SINABS(5) + RK*RL*SINABS(6)
      IF (ISTAN .EQ. 0 .AND. NN .NE. -1) THEN
        IF (IUMPTY .EQ. 0 .AND. SINMAX .GE. 4.0) THEN
          IF (INTFLT .EQ. 'INT') THEN
            WRITE (COUT,13000) IH,IK,IL
          ELSE
            WRITE (COUT,13100) RH,RK,RL
          ENDIF
          CALL GWRITE (ITP,' ')
          IVALID = 32
          RETURN
        ENDIF
        IF (SINMAX .LT. SM4 .OR. SINMAX .GT. SS4) THEN
          IVALID = 4
          IF (IPRVAL .NE. 0) THEN
            IF (INTFLT .EQ. 'INT') THEN
              WRITE (COUT,14000) IH,IK,IL
            ELSE
              WRITE (COUT,14100) RH,RK,RL
            ENDIF
            CALL GWRITE (ITP,' ')
          ENDIF
        ENDIF
      ENDIF
      CALL CALANG (VEC)
      CALL CHICOL
C-----------------------------------------------------------------------
C  Rotation about scattering vector.   Omega,Chi,Phi for a given Psi
C-----------------------------------------------------------------------
C Modified MK. Make PSI calculation all the time and add 180 to PSI
C This is because TRICS seems to have a PSI rotation by 180 degree
C hidden in its setup. This may be WRONG!
C      IF (ISTAN .EQ. 0 .AND. DPSI .NE. 0) THEN
C
       IF(.TRUE.) THEN
          PSIDUM = PSI + 180
          IF(PSIDUM .GT. 360) PSIDUM = PSIDUM - 360.
          CHO = CHI*RAD
          PHO = PHI*RAD
C          PSO = PSI*RAD
          PSO = PSIDUM*RAD
          Q(3,1) =  SIN(PSO)*SIN(PHO) - COS(PSO)*SIN(CHO)*COS(PHO)
          Q(3,2) = -SIN(PSO)*COS(PHO) - COS(PSO)*SIN(CHO)*SIN(PHO)
          Q(3,3) =  COS(PSO)*COS(CHO)
          Q(1,3) =  SIN(CHO)
          Q(2,3) =  SIN(PSO)*COS(CHO)
          OMEGA = DEG*ATAN2(-Q(2,3), Q(1,3))
          PHI   = DEG*ATAN2(-Q(3,2),-Q(3,1))
          CHI   = DEG*ATAN2(SQRT(Q(3,1)*Q(3,1) + Q(3,2)*Q(3,2)),Q(3,3))
          IF (OMEGA .LT. 0) OMEGA = OMEGA + 360.0
          IF (PHI   .LT. 0) PHI   = PHI   + 360.0
          IF (OMEGA .LT. 270.0 .AND. OMEGA .GT. 90.0) THEN
            PHI   = PHI + 180.0
            CHI   = 360.0 - CHI
            OMEGA = 180.0 + OMEGA
          ENDIF
          IF (PHI   .GE. 360.0) PHI   = PHI   - 360.0
          IF (OMEGA .GE. 360.0) OMEGA = OMEGA - 360.0
          CALL OMGCOL 
          IF (IROT .EQ. 0) CALL CHICOL
      ENDIF
      CALL MOD360 (OMEGA)
      CALL MOD360 (CHI)
      CALL ANGCHECK(THETA,OMEGA,CHI,PHI,IVALID)
      IF(IVALID .GE. 4) IROT = 1      
      RETURN
10000 FORMAT (' Reflection 0,0,0 is invalid.')
11000 FORMAT (' Reflection',3I4,' is a systematic absence')
12000 FORMAT (' Reflection',3I4,' is a specified absence')
13000 FORMAT (' Reflection',3I4,' has 2theta .ge. 180.  Impossible!')
13100 FORMAT (' Reflection',3F8.3,' has 2theta .ge. 180.  Impossible!')
14000 FORMAT (' Reflection',3I4,' is outside the 2theta limits ')
14100 FORMAT (' Reflection',3F8.3,' is outside the 2theta limits ')
      END
C-----------------------------------------------------------------------
C  Calculate 2Theta, Chi, Phi for the Omega=0 position
C  If chi .gt. 89.999 (cos**2(89.999) = 3.0E-10) chi is set to 90.0
C-----------------------------------------------------------------------
      SUBROUTINE CALANG (VEC)
      INCLUDE 'COMDIF'
      DIMENSION VEC(3)
      BOT = ABS(VEC(1))
      CEN = ABS(VEC(2))
      TOP = ABS(VEC(3))
      IF (BOT .EQ. 0.0) THEN
        PHI = 90.0
      ELSE
        PHI = ATAN2(CEN,BOT)*DEG
      ENDIF
      SUM = SUM - TOP*TOP
      IF (SUM .LT. 3.0E-10) THEN
        CHI = 90.0
      ELSE
        CHI = ATAN2(TOP,SQRT(SUM))*DEG
      ENDIF
      IF (VEC(3) .LT. 0.0) CHI = 360.0 - CHI
      IF (VEC(1) .LT. 0.0) THEN
        IF (VEC(2) .LT. 0.0) THEN
          PHI = 180.0 + PHI
        ELSE
          PHI = 180.0 - PHI
        ENDIF
      ELSE
        IF (VEC(2) .LT. 0.0) PHI = 360.0 - PHI
      ENDIF
      IF (CHI .EQ. 90.0 .OR. CHI .EQ. 270.0) PHI = 0.0
      SINSQ = 0.25*(SUM + TOP*TOP)
      IF (SINSQ .GE. 0.999999) THEN
        THETA = 180.0
      ELSE
        THETA = 2.0*DEG*ATAN(SQRT(SINSQ/(1.0 - SINSQ)))
      ENDIF
      OMEGA = 0.0
C-----------------------------------------------------------------------
C  Bisecting or parallel mode  IBSECT = 0/1 (forced 0)
C-----------------------------------------------------------------------
      IF (IBSECT .EQ. 1) THEN
        PHI = PHI + 90.0
        IF (PHI .GE. 360.0) PHI = PHI - 360.0
        OMEGA = CHI + 270.0
        IF (OMEGA .GE. 360.0) OMEGA = OMEGA - 360.0
        CHI = 90.0
        CALL OMGCOL
        IF (IROT .EQ. 0) CALL CHICOL
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
C  Test if rotation is possible without omega collisions.
C  Limits are set for 4 possible collisions as follows :--
C  a. Chi ring with front of tube housing;
C  b. Chi ring with rear of tube housing;
C  c. Chi ring with front of detector mount;
C  d. Chi ring with rear of detector mount attenuator housing.
C  For a. and d. omega is in the range 0 to 90, and
C  for b. and c. omega is in the range 270 to 360.
C  The chi ring has an angular half width DELCHI = 16degs.
C  The angular restrictions for a., b., c. and d. are
C  DELA = 13,  DELB = 31,  DELC = 5, DELD = 33,  each plus DELCHI.
C  If chi is in the range 53 to 117, i.e. in a position where the phi
C  base could be caught between the front of the tube housing and the
C  detector mount, DELCHI must be increased by 3 for a. and 6 for c. 
C  The limits are conservative, but will need to be changed for
C  different instruments.
C-----------------------------------------------------------------------
      SUBROUTINE OMGCOL
      INCLUDE 'COMDIF'
      DELCHI =  16.0
      DELA   =  13.0
      DELB   =  31.0
      DELC   =   5.0
      DELD   =  33.0
      CHIBOT =  53.0
      CHITOP = 117.0
      IROT = 0
      THET = 0.5*THETA
      IF (OMEGA .LT. 90.0) THEN
        OMEGAD = OMEGA
        T1 = 90.0 - DELA - DELCHI - THET
        IF (CHI .GT. CHIBOT .AND. CHI .LT. CHITOP) T1 = T1 - 3.0
        T2 = 90.0 - DELD - DELCHI + THET
      ELSE
        OMEGAD = 360.0 - OMEGA
        T1 = 90.0 - DELB - DELCHI + THET
        T2 = 90.0 - DELC - DELCHI - THET
        IF (CHI .GT. CHIBOT .AND. CHI .LT. CHITOP) T2 = T2 - 6.0
      ENDIF
      IF (OMEGAD .GE. T1 .OR. OMEGAD .GE. T2) IROT = 1
      RETURN
      END
C-----------------------------------------------------------------------
C  Sample routine to ensure that the range of CHI is restricted when 
C  there is a cryostat on the instrument.
C  It is assumed that 2thetamax is set realistically to ensure that 
C  there will be no OMEGA collisions with the cryostat. 
C  CHI is restricted to the range +/- 90
C-----------------------------------------------------------------------
      SUBROUTINE CHICOL
      INCLUDE 'COMDIF'
      IF (ILN .EQ. 1) THEN
        IF (CHI .GE. 270.0 .OR. CHI .LE. 90.0) THEN
          IVALID = 0
        ELSE
          IVALID = 16
        ENDIF
      ENDIF
      RETURN
      END
