root / src / Rotation_matrix.f90 @ 4
Historique | Voir | Annoter | Télécharger (2,45 ko)
1 | 1 | equemene | |
---|---|---|---|
2 | 1 | equemene | !----------------------------------------------------------------------- |
3 | 1 | equemene | subroutine rotation_matrix(q, U) |
4 | 1 | equemene | !----------------------------------------------------------------------- |
5 | 1 | equemene | ! This subroutine constructs rotation matrix U from quaternion q. |
6 | 1 | equemene | !----------------------------------------------------------------------- |
7 | 1 | equemene | ! This subroutine calculates RMSD using quaternions. |
8 | 1 | equemene | ! It is based on the F90 routine bu E. Coutsias |
9 | 1 | equemene | ! http://www.math.unm.edu/~vageli/homepage.html |
10 | 1 | equemene | ! I (PFL) have just translated it, and I have changed the diagonalization |
11 | 1 | equemene | ! subroutine. |
12 | 1 | equemene | ! I also made some changes to make it suitable for Cart package. |
13 | 1 | equemene | !---------------------------------------------------------------------- |
14 | 1 | equemene | !---------------------------------------------------------------------- |
15 | 1 | equemene | ! Copyright (C) 2004, 2005 Chaok Seok, Evangelos Coutsias and Ken Dill |
16 | 1 | equemene | ! UCSF, Univeristy of New Mexico, Seoul National University |
17 | 1 | equemene | ! Witten by Chaok Seok and Evangelos Coutsias 2004. |
18 | 1 | equemene | |
19 | 1 | equemene | ! This library is free software; you can redistribute it and/or |
20 | 1 | equemene | ! modify it under the terms of the GNU Lesser General Public |
21 | 1 | equemene | ! License as published by the Free Software Foundation; either |
22 | 1 | equemene | ! version 2.1 of the License, or (at your option) any later version. |
23 | 1 | equemene | ! |
24 | 1 | equemene | |
25 | 1 | equemene | ! This library is distributed in the hope that it will be useful, |
26 | 1 | equemene | ! but WITHOUT ANY WARRANTY; without even the implied warranty of |
27 | 1 | equemene | ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
28 | 1 | equemene | ! Lesser General Public License for more details. |
29 | 1 | equemene | ! |
30 | 1 | equemene | |
31 | 1 | equemene | ! You should have received a copy of the GNU Lesser General Public |
32 | 1 | equemene | ! License along with this library; if not, write to the Free Software |
33 | 1 | equemene | ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
34 | 1 | equemene | !---------------------------------------------------------------------------- |
35 | 1 | equemene | |
36 | 1 | equemene | Use VarTypes |
37 | 1 | equemene | |
38 | 1 | equemene | real(KREAL) :: q(4) |
39 | 1 | equemene | real(KREAL) :: U(3,3) |
40 | 1 | equemene | real(KREAL) :: q0,q1,q2,q3,b0,b1,b2,b3,q00,q01,q02,q03 |
41 | 1 | equemene | REAL(KREAL) :: q11,q12,q13,q22,q23,q33 |
42 | 1 | equemene | |
43 | 1 | equemene | q0 = q(1) |
44 | 1 | equemene | q1 = q(2) |
45 | 1 | equemene | q2 = q(3) |
46 | 1 | equemene | q3 = q(4) |
47 | 1 | equemene | |
48 | 1 | equemene | b0 = 2.0d0*q0 |
49 | 1 | equemene | b1 = 2.0d0*q1 |
50 | 1 | equemene | b2 = 2.0d0*q2 |
51 | 1 | equemene | b3 = 2.0d0*q3 |
52 | 1 | equemene | |
53 | 1 | equemene | q00 = b0*q0-1.0d0 |
54 | 1 | equemene | q01 = b0*q1 |
55 | 1 | equemene | q02 = b0*q2 |
56 | 1 | equemene | q03 = b0*q3 |
57 | 1 | equemene | |
58 | 1 | equemene | q11 = b1*q1 |
59 | 1 | equemene | q12 = b1*q2 |
60 | 1 | equemene | q13 = b1*q3 |
61 | 1 | equemene | |
62 | 1 | equemene | q22 = b2*q2 |
63 | 1 | equemene | q23 = b2*q3 |
64 | 1 | equemene | |
65 | 1 | equemene | q33 = b3*q3 |
66 | 1 | equemene | |
67 | 1 | equemene | U(1,1) = q00+q11 |
68 | 1 | equemene | U(1,2) = q12-q03 |
69 | 1 | equemene | U(1,3) = q13+q02 |
70 | 1 | equemene | |
71 | 1 | equemene | U(2,1) = q12+q03 |
72 | 1 | equemene | U(2,2) = q00+q22 |
73 | 1 | equemene | U(2,3) = q23-q01 |
74 | 1 | equemene | |
75 | 1 | equemene | U(3,1) = q13-q02 |
76 | 1 | equemene | U(3,2) = q23+q01 |
77 | 1 | equemene | U(3,3) = q00+q33 |
78 | 1 | equemene | |
79 | 1 | equemene | end |