C----------------------------------------------------------------------- C Buerger reduction C----------------------------------------------------------------------- SUBROUTINE BURGER (IOUT,A,ANG,IND) CHARACTER COUT*132 COMMON /IOUASC/ COUT(20) REAL IND(3,3) DIMENSION AA(3,3),A(3),ANG(3) DATA INUM/0/ RAD = 3.14159/180.0 C----------------------------------------------------------------------- C Form the matrix of dot products C----------------------------------------------------------------------- DO 100 I = 1,3 DO 100 J = 1,3 IF (I .EQ. J) AA(I,J) = A(I)*A(I) IF (I .NE. J) AA(I,J) = A(I)*A(J)*COS(ANG(6 - I - J)*RAD) 100 CONTINUE C----------------------------------------------------------------------- C Look for shorter translations in cell faces C----------------------------------------------------------------------- 110 NUM = 0 DO 170 I = 1,3 DO 160 J = 1,3 IF (J .NE. I) THEN IS = 1 IF (AA(I,J) .GT. 0) IS = -1 IS1 = IS VMIN = 0 120 V = AA(I,J)*2*IS1 + AA(J,J)*IS1**2 IF (V .LT. VMIN) THEN VMIN = V IS1 = IS1 + IS GO TO 120 ENDIF C----------------------------------------------------------------------- C Did we find a shorter translation? C----------------------------------------------------------------------- IS1 = IS1 - IS IF (IS1 .NE. 0) THEN C----------------------------------------------------------------------- C Yes, we did. Accept it as a cell edge C----------------------------------------------------------------------- NUM = NUM + 1 INUM = INUM + 1 C----------------------------------------------------------------------- C Transform the old-new indices C----------------------------------------------------------------------- DO 140 K = 1,3 IND(I,K) = IND(I,K) + IS1*IND(J,K) 140 CONTINUE C----------------------------------------------------------------------- C Modify the matrix of dot products C----------------------------------------------------------------------- AA(I,I) = AA(I,I) + AA(I,J)*2*IS1 + AA(J,J)*IS1**2 AA(I,J) = AA(I,J) + IS1*AA(J,J) AA(J,I) = AA(I,J) K = 6 - I - J AA(I,K) = AA(I,K) + IS1*AA(J,K) AA(K,I) = AA(I,K) ENDIF ENDIF 160 CONTINUE 170 CONTINUE C----------------------------------------------------------------------- C Look for more transformations C----------------------------------------------------------------------- IF (NUM .GE. 1) GO TO 110 C----------------------------------------------------------------------- C Are the cross-terms of a same sign? C----------------------------------------------------------------------- 180 VAR = ABS(AA(1,2)) + ABS(AA(1,3)) + ABS(AA(2,3)) IF (ABS(ABS(AA(1,2)+AA(1,3)+AA(2,3))-VAR) .GT. 0.0001*VAR) THEN C----------------------------------------------------------------------- C No, find the odd sign C----------------------------------------------------------------------- ISIGN = 1 IF (AA(1,2)*AA(1,3)*AA(2,3) .LT. 0) ISIGN = -1 C----------------------------------------------------------------------- C Reverse two vectors to make the cell triacute or triobtuse C----------------------------------------------------------------------- DO 200 I = 1,2 K = I + 1 DO 190 J = K,3 IF (AA(I,J)*ISIGN .GT. 0.0) GO TO 210 190 CONTINUE 200 CONTINUE 210 K = 6 - I - J C----------------------------------------------------------------------- C Modify the indices and the dot products C----------------------------------------------------------------------- DO 220 II = 1,3 IND(I,II) = -IND(I,II) IND(J,II) = -IND(J,II) 220 CONTINUE AA(K,J) = -AA(K,J) AA(J,K) = -AA(J,K) AA(K,I) = -AA(K,I) AA(I,K) = -AA(I,K) ENDIF C----------------------------------------------------------------------- C Order the diagonal terms in increasing values C----------------------------------------------------------------------- INUM = 0 240 NUM = 0 DO 280 I = 1,2 IF ((AA(I,I) - AA(I+1,I+1)) .GT. 0.0) THEN NUM = NUM + 1 INUM = INUM + 1 DO 250 J = 1,3 SAVE = AA(I,J) AA(I,J) = AA(I + 1,J) AA(I + 1,J) = SAVE 250 CONTINUE DO 260 J = 1,3 SAVE = AA(J,I) AA(J,I) = AA(J,I + 1) AA(J,I + 1) = SAVE 260 CONTINUE DO 270 K = 1,3 SAVE = IND(I,K) IND(I,K) = IND(I + 1,K) IND(I + 1,K) = SAVE 270 CONTINUE ENDIF 280 CONTINUE IF (NUM .NE. 0) GO TO 240 C----------------------------------------------------------------------- C If the cell is left-handed, reverse all axes C----------------------------------------------------------------------- IF (MOD(INUM,2) .NE. 0) THEN DO 290 I = 1,3 DO 290 J = 1,3 C----------------------------------------------------------------------- C If 111 is shorter than c, call it c and re-reduce the cell C----------------------------------------------------------------------- IND(I,J) = -IND(I,J) 290 CONTINUE ENDIF IF (AA(1,1)+AA(2,2) .LT. -2*(AA(1,2)+AA(1,3)+AA(2,3))) THEN AA(3,3) = AA(3,3) + 2*AA(3,1) + AA(1,1) AA(3,1) = AA(3,1) + AA(1,1) AA(1,3) = AA(3,1) AA(3,2) = AA(3,2) + AA(1,2) AA(2,3) = AA(3,2) AA(3,3) = AA(3,3) + 2*AA(3,2) + AA(2,2) AA(3,2) = AA(3,2) + AA(2,2) AA(2,3) = AA(3,2) AA(3,1) = AA(3,1) + AA(1,2) AA(1,3) = AA(3,1) DO 310 J = 1,3 IND(3,J) = IND(1,J) + IND(2,J) + IND(3,J) 310 CONTINUE GO TO 180 ENDIF C----------------------------------------------------------------------- C Get the Niggli cell parameters C----------------------------------------------------------------------- DO 330 I = 1,3 A(I) = SQRT(AA(I,I)) 330 CONTINUE DO 340 I = 1,3 J = MOD(I,3) + 1 K = MOD(J,3) + 1 ANG(I) = ACOS(AA(J,K)/(A(J)*A(K)))/RAD 340 CONTINUE WRITE (COUT,10000) A,ANG CALL GWRITE (IOUT,' ') WRITE (COUT,11000) ((IND(I,J),J = 1,3),I = 1,3) CALL GWRITE (IOUT,' ') RETURN 10000 FORMAT (/' The Shortest Non-coplanar Translations '/10X,6F10.3) 11000 FORMAT (' The Old-to-New Cell Matrix'/(10X,3F6.1)) END