1 SUBROUTINE FRAME(FMAT,NUMAT,MODE,SHIFT) 2 IMPLICIT DOUBLE PRECISION (A-H,O-Z) 3 DIMENSION FMAT(*), SHIFT(6) 4 INCLUDE 'SIZES' 5 COMMON /COORD /COORD(3,NUMATM) 6 COMMON /ATMASS/ ATMASS(NUMATM) 7 DIMENSION VIB(6,MAXPAR), ROT(3,3), COORD1(3,NUMATM) 8*********************************************************************** 9* 10* FRAME APPLIES AN RIGID ORIENTATION TO THE MOLECULE IN A FORCE 11* CALCULATION. THE TRANSLATIONS ARE GIVEN A 'FORCE CONSTANT' 12* OF T(X)=500 MILLIDYNES/ANGSTROM 13* T(Y)=600 MILLIDYNES/ANGSTROM 14* T(Z)=700 MILLIDYNES/ANGSTROM 15* AND THE ROTATIONS ARE GIVEN A 'FORCE CONSTANT' OF 16* R(X)=800 MILLIDYNES/ANGSTROM 17* R(Y)=900 MILLIDYNES/ANGSTROM 18* R(Z)=1000 MILLIDYNES/ANGSTROM, 19* THE ROTATIONS ARE MADE ABOUT AXES DETERMINED BY THE MOMENTS 20* OF INERTIA, WHICH IN TURN DEPEND ON THE ISOTOPIC MASSES. FOR 21* THE NORMAL FREQUENCY CALCULATION THESE ARE THE REAL MASSES, 22* FOR THE FORCE CALCULATION THEY ARE ALL UNITY. 23*********************************************************************** 24 COMMON /EULER / TVEC(3,3), ID 25 CALL AXIS(COORD,NUMAT,A,B,C,SUMW, MODE,ROT ) 26 DO 20 I=1,NUMAT 27 DO 20 J=1,3 28 SUM=0.D0 29 DO 10 K=1,3 30 10 SUM=SUM+COORD(K,I)*ROT(K,J) 31 20 COORD1(J,I)=SUM 32 N3=NUMAT*3 33 J=0 34 WTMASS=1.D0 35 DO 30 I=1,NUMAT 36 IF(MODE.EQ.1) WTMASS=SQRT(ATMASS(I)) 37 J=J+1 38 VIB(1,J)=WTMASS 39 VIB(2,J)=0.D0 40 VIB(3,J)=0.D0 41 VIB(4,J)=0.D0 42 VIB(5,J)=COORD1(3,I)*WTMASS 43 VIB(6,J)=COORD1(2,I)*WTMASS 44 J=J+1 45 VIB(1,J)=0.D0 46 VIB(2,J)=WTMASS 47 VIB(3,J)=0.D0 48 VIB(4,J)=COORD1(3,I)*WTMASS 49 VIB(5,J)=0.D0 50 VIB(6,J)=-COORD1(1,I)*WTMASS 51 J=J+1 52 VIB(1,J)=0.D0 53 VIB(2,J)=0.D0 54 VIB(3,J)=WTMASS 55 VIB(4,J)=-COORD1(2,I)*WTMASS 56 VIB(5,J)=-COORD1(1,I)*WTMASS 57 VIB(6,J)=0.D0 58 30 CONTINUE 59 J=1 60 DO 50 I=1,NUMAT 61 DO 40 K=4,6 62 X=VIB(K,J) 63 Y=VIB(K,J+1) 64 Z=VIB(K,J+2) 65 VIB(K,J )=X*ROT(1,1)+Y*ROT(1,2)+Z*ROT(1,3) 66 VIB(K,J+1)=X*ROT(2,1)+Y*ROT(2,2)+Z*ROT(2,3) 67 VIB(K,J+2)=X*ROT(3,1)+Y*ROT(3,2)+Z*ROT(3,3) 68 40 CONTINUE 69 J=J+3 70 50 CONTINUE 71 SUM1=0.D0 72 SUM2=0.D0 73 SUM3=0.D0 74 SUM4=0.D0 75 SUM5=0.D0 76 SUM6=0.D0 77 DO 60 I=1,N3 78 SUM1=SUM1+VIB(1,I)**2 79 SUM2=SUM2+VIB(2,I)**2 80 SUM3=SUM3+VIB(3,I)**2 81 SUM4=SUM4+VIB(4,I)**2 82 SUM5=SUM5+VIB(5,I)**2 83 60 SUM6=SUM6+VIB(6,I)**2 84 IF(SUM1.GT.1.D-5)SUM1=SQRT(1.D0/SUM1) 85 IF(SUM2.GT.1.D-5)SUM2=SQRT(1.D0/SUM2) 86 IF(SUM3.GT.1.D-5)SUM3=SQRT(1.D0/SUM3) 87 IF(SUM4.GT.1.D-5)SUM4=SQRT(1.D0/SUM4) 88 IF(SUM5.GT.1.D-5)SUM5=SQRT(1.D0/SUM5) 89 IF(SUM6.GT.1.D-5)SUM6=SQRT(1.D0/SUM6) 90 IF(ID.NE.0)THEN 91 SUM4=0.D0 92 SUM5=0.D0 93 SUM6=0.D0 94 ENDIF 95 DO 70 I=1,N3 96 VIB(1,I)=VIB(1,I)*SUM1 97 VIB(2,I)=VIB(2,I)*SUM2 98 VIB(3,I)=VIB(3,I)*SUM3 99 VIB(4,I)=VIB(4,I)*SUM4 100 VIB(5,I)=VIB(5,I)*SUM5 101 70 VIB(6,I)=VIB(6,I)*SUM6 102 DO 80 I=1,6 103 80 SHIFT(I)=400.D0+I*100.D0 104 L=0 105 DO 100 I=1,N3 106 DO 100 J=1,I 107 L=L+1 108 SUM1=0.D0 109 DO 90 K=1,6 110 90 SUM1=SUM1+VIB(K,I)*SHIFT(K)*VIB(K,J) 111 100 FMAT(L)=FMAT(L)+SUM1 112 END 113