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