Statistiques
| Révision :

root / src / Rotation_matrix.f90

Historique | Voir | Annoter | Télécharger (3,68 ko)

1 1 pfleura2
      subroutine rotation_matrix(q, U)
2 1 pfleura2
!-----------------------------------------------------------------------
3 1 pfleura2
! This subroutine constructs rotation matrix U from quaternion q.
4 1 pfleura2
!-----------------------------------------------------------------------
5 1 pfleura2
! This subroutine calculates RMSD using quaternions.
6 1 pfleura2
! It is based on the F90 routine bu E. Coutsias
7 1 pfleura2
! http://www.math.unm.edu/~vageli/homepage.html
8 1 pfleura2
! I (PFL) have just translated it, and I have changed the diagonalization
9 1 pfleura2
! subroutine.
10 1 pfleura2
! I also made some changes to make it suitable for Cart package.
11 1 pfleura2
!----------------------------------------------------------------------
12 1 pfleura2
!----------------------------------------------------------------------
13 1 pfleura2
! Copyright (C) 2004, 2005 Chaok Seok, Evangelos Coutsias and Ken Dill
14 1 pfleura2
!      UCSF, Univeristy of New Mexico, Seoul National University
15 1 pfleura2
! Witten by Chaok Seok and Evangelos Coutsias 2004.
16 1 pfleura2
17 1 pfleura2
! This library is free software; you can redistribute it and/or
18 1 pfleura2
! modify it under the terms of the GNU Lesser General Public
19 1 pfleura2
! License as published by the Free Software Foundation; either
20 1 pfleura2
! version 2.1 of the License, or (at your option) any later version.
21 1 pfleura2
!
22 1 pfleura2
! This library is distributed in the hope that it will be useful,
23 1 pfleura2
! but WITHOUT ANY WARRANTY; without even the implied warranty of
24 1 pfleura2
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
25 1 pfleura2
! Lesser General Public License for more details.
26 1 pfleura2
!
27 1 pfleura2
! You should have received a copy of the GNU Lesser General Public
28 1 pfleura2
! License along with this library; if not, write to the Free Software
29 1 pfleura2
! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
30 1 pfleura2
!----------------------------------------------------------------------------
31 12 pfleura2
!----------------------------------------------------------------------
32 12 pfleura2
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,
33 12 pfleura2
!  Centre National de la Recherche Scientifique,
34 12 pfleura2
!  Université Claude Bernard Lyon 1. All rights reserved.
35 12 pfleura2
!
36 12 pfleura2
!  This work is registered with the Agency for the Protection of Programs
37 12 pfleura2
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
38 12 pfleura2
!
39 12 pfleura2
!  Authors: P. Fleurat-Lessard, P. Dayal
40 12 pfleura2
!  Contact: optnpath@gmail.com
41 12 pfleura2
!
42 12 pfleura2
! This file is part of "Opt'n Path".
43 12 pfleura2
!
44 12 pfleura2
!  "Opt'n Path" is free software: you can redistribute it and/or modify
45 12 pfleura2
!  it under the terms of the GNU Affero General Public License as
46 12 pfleura2
!  published by the Free Software Foundation, either version 3 of the License,
47 12 pfleura2
!  or (at your option) any later version.
48 12 pfleura2
!
49 12 pfleura2
!  "Opt'n Path" is distributed in the hope that it will be useful,
50 12 pfleura2
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
51 12 pfleura2
!
52 12 pfleura2
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
53 12 pfleura2
!  GNU Affero General Public License for more details.
54 12 pfleura2
!
55 12 pfleura2
!  You should have received a copy of the GNU Affero General Public License
56 12 pfleura2
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
57 12 pfleura2
!
58 12 pfleura2
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
59 12 pfleura2
! for commercial licensing opportunities.
60 12 pfleura2
!----------------------------------------------------------------------
61 1 pfleura2
62 1 pfleura2
        Use VarTypes
63 1 pfleura2
64 1 pfleura2
      real(KREAL) :: q(4)
65 1 pfleura2
      real(KREAL) :: U(3,3)
66 1 pfleura2
      real(KREAL) :: q0,q1,q2,q3,b0,b1,b2,b3,q00,q01,q02,q03
67 1 pfleura2
      REAL(KREAL) :: q11,q12,q13,q22,q23,q33
68 1 pfleura2
69 1 pfleura2
      q0 = q(1)
70 1 pfleura2
      q1 = q(2)
71 1 pfleura2
      q2 = q(3)
72 1 pfleura2
      q3 = q(4)
73 1 pfleura2
74 1 pfleura2
      b0 = 2.0d0*q0
75 1 pfleura2
      b1 = 2.0d0*q1
76 1 pfleura2
      b2 = 2.0d0*q2
77 1 pfleura2
      b3 = 2.0d0*q3
78 1 pfleura2
79 1 pfleura2
      q00 = b0*q0-1.0d0
80 1 pfleura2
      q01 = b0*q1
81 1 pfleura2
      q02 = b0*q2
82 1 pfleura2
      q03 = b0*q3
83 1 pfleura2
84 1 pfleura2
      q11 = b1*q1
85 1 pfleura2
      q12 = b1*q2
86 1 pfleura2
      q13 = b1*q3
87 1 pfleura2
88 1 pfleura2
      q22 = b2*q2
89 1 pfleura2
      q23 = b2*q3
90 1 pfleura2
91 1 pfleura2
      q33 = b3*q3
92 1 pfleura2
93 1 pfleura2
      U(1,1) = q00+q11
94 1 pfleura2
      U(1,2) = q12-q03
95 1 pfleura2
      U(1,3) = q13+q02
96 1 pfleura2
97 1 pfleura2
      U(2,1) = q12+q03
98 1 pfleura2
      U(2,2) = q00+q22
99 1 pfleura2
      U(2,3) = q23-q01
100 1 pfleura2
101 1 pfleura2
      U(3,1) = q13-q02
102 1 pfleura2
      U(3,2) = q23+q01
103 1 pfleura2
      U(3,3) = q00+q33
104 1 pfleura2
105 1 pfleura2
      end