Statistiques
| Révision :

root / src / Rotation_matrix.f90 @ 2

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