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