Statistiques
| Révision :

root / src / Rotation_matrix.f90 @ 10

Historique | Voir | Annoter | Télécharger (2,45 ko)

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