C----------------------------------------------------------------------- C Subroutine to set a specified direct lattice row:-- C Along the Omega rotation axis (PR) or C Along the x-ray beam (PL). C----------------------------------------------------------------------- SUBROUTINE SETROW INCLUDE 'COMDIF' DIMENSION HKL(3),DICOS(3),RM1(3,3),VEC(3) IF (KI .EQ. 'PL') THEN WRITE (COUT,10000) ELSE WRITE (COUT,11000) ENDIF CALL YESNO ('Y',ANS) IF (ANS .EQ. 'N') THEN KI = ' ' RETURN ENDIF WRITE (COUT,12000) CALL FREEFM (ITR) IH = IFREE(1) IK = IFREE(2) IL = IFREE(3) HKL(1) = IH HKL(2) = IK HKL(3) = IL C----------------------------------------------------------------------- C The inverse transpose of the UB matrix of Busing and Levy (here R) C allows Direct rather than Reciprocal rows to be set. C----------------------------------------------------------------------- 100 CALL MATRIX (R,RM1,CRAP,CRAP,'INVERT') CALL MATRIX (HKL,RM1,DICOS,CRAP,'VECMAT') PHI = ATAN(DICOS(2)/DICOS(1))*DEG IF (DICOS(1) .LT. 0) PHI = PHI + 180.0 CALL MOD360 (PHI) CHI = ASIN(DICOS(3))*DEG C----------------------------------------------------------------------- C Bring the positive end of the row up (CHI = CHI + 90) C----------------------------------------------------------------------- IF (KI .EQ. 'PR') THEN CALL MATRIX (HKL,RM1,VEC,CRAP,'VMMULT') PER = WAVE*SQRT(VEC(1)*VEC(1) + VEC(2)*VEC(2)+ VEC(3)*VEC(3)) WRITE (COUT,13000) PER CALL FREEFM (ITR) DIST = RFREE(1) IF (DIST .NE. 0.) THEN WRITE (COUT,14000) CALL GWRITE (ITP,' ') DO 110 N = 1,10 DSIN = N*WAVE/PER IF (DSIN .LE. 0.71) THEN VEL = DIST*TAN(ASIN(DSIN)) VEL = VEL*2 WRITE (COUT,15000) N,VEL CALL GWRITE (ITP,' ') ENDIF 110 CONTINUE ENDIF THETA = 0.0 OMEGA = 0.0 CHI = CHI + 90.0 CALL MOD360(CHI) ICC = 0 WRITE (COUT,16000) THETA,OMEGA,CHI,PHI CALL GWRITE (ITP,' ') CALL ANGSET (THETA,OMEGA,CHI,PHI,0,ICOL) IF (ICOL .NE. 0) THEN WRITE (COUT,17000) CALL GWRITE (ITP,' ') ENDIF KI = ' ' RETURN ENDIF C----------------------------------------------------------------------- C Set up for Laue photos PL C A direct lattice row is set along the direct beam by :-- C setting CHI = 90, PHI = PHI + 90 and OMEGA = CHI, but because of C restrictions on the OMEGA motion, OMEGA may not be greater than OLIM. C This means that the original CHI must be within OLIM degrees of the C OMEGA axis C----------------------------------------------------------------------- CALL MOD360 (CHI) OLIM = 47.0 IF (CHI .GE. 180-OLIM .AND. CHI .LE. 180+OLIM) THEN WRITE (COUT,18000) CALL YESNO ('Y',ANS) IF (ANS .EQ. 'Y') THEN IH = -IH IK = -IK IL = -IL GO TO 100 ENDIF KI = ' ' RETURN ENDIF IF (CHI .GT. OLIM .AND. CHI .LT. 360-OLIM) THEN WRITE (COUT,19000) CALL GWRITE (ITP,' ') KI = ' ' RETURN ENDIF OMEGA = CHI CHI = 90.0 PHI = PHI + 90.0 CALL MOD360 (PHI) THETA = 0.0 WRITE (COUT,20000) IH,IK,IL,THETA,OMEGA,CHI,PHI CALL YESNO ('Y',ANS) IF (ANS .EQ. 'N') THEN KI = ' ' RETURN ENDIF C----------------------------------------------------------------------- C Find the azimuths of given reciprocal vectors C----------------------------------------------------------------------- ICC = 0 CALL ANGSET (THETA,OMEGA,CHI,PHI,0,ICOL) IF (ICOL .EQ. 0) THEN WRITE (COUT,17000) CALL GWRITE (ITP,' ') KI = ' ' RETURN ENDIF C----------------------------------------------------------------------- C Direction cosines of the line along the vertical C----------------------------------------------------------------------- XU = COS((PHI)/DEG) YU = SIN((PHI)/DEG) ZU = 0. C----------------------------------------------------------------------- C Direction cosines of the line along the diffraction vector C----------------------------------------------------------------------- XD = COS((90.0 - OMEGA)/DEG)*COS((90.0 + PHI)/DEG) YD = COS((90.0 - OMEGA)/DEG)*SIN((90.0 + PHI)/DEG) ZD = SIN((90.0 - OMEGA)/DEG) WRITE (COUT,21000) CALL YESNO ('Y',ANS) IF (ANS .EQ. 'N') THEN KI = ' ' RETURN ENDIF WRITE (COUT,22000) CALL GWRITE (ITP,' ') 120 WRITE (COUT,23000) CALL FREEFM (ITR) IH = IFREE(1) IK = IFREE(2) IL = IFREE(3) HKL(1) = IH HKL(2) = IK HKL(3) = IL CALL MATRIX (R,HKL,DICOS,CRAP,'MATVEC') SU = XU*DICOS(1) + YU*DICOS(2) + ZU*DICOS(3) SD = XD*DICOS(1) + YD*DICOS(2) + ZD*DICOS(3) SN = SQRT(SU*SU + SD*SD) ANG = ACOS(SU/SN)*DEG IF (SD .LT. 0) ANG = -ANG WRITE (COUT,24000) ANG CALL YESNO ('Y',ANS) IF (ANS .EQ. 'Y') GO TO 120 KI = ' ' RETURN 10000 FORMAT (' Set for a Laue Pattern along a given row (Y) ? ',$) 11000 FORMAT (' Set a Direct Lattice Row upwards along the Omega', $ ' Rotation Axis',/, $ ' Confirm (Y) ',$) 12000 FORMAT (' Type the indices of the row ',$) 13000 FORMAT (' The Periodicity for a Primitive Lattice is ',F10.3, $ ' Angstroms',/, $ ' Type the Crystal-to-Film Distance in mms ',$) 14000 FORMAT (' Separation in mm between the + and - nth levels') 15000 FORMAT (5X,I2,F10.1) 16000 FORMAT (' Setting angles ',4F10.3) 17000 FORMAT (' Setting Collisions. The row cannot be set') 18000 FORMAT (' hkl CANNOT be set, but -h-k-l can. OK (Y) ? ',$) 19000 FORMAT (' The setting is NOT feasible') 20000 FORMAT (' Setting angles for row',3I4,4F10.3,/, $ ' Set it (Y) ? ',$) 21000 FORMAT (' Are you interested in the azimuth for given reciprocal', $ ' vectors. (Y) ? ',$) 22000 FORMAT (' Origin of azimuths UP, + toward diffraction vector.') 23000 FORMAT (' Type the h k l ',$) 24000 FORMAT (20X,'Azimuth ',F10.1,' degrees. More vectors (Y) ? ',$) END