Statistiques
| Révision :

root / src / ConvertZmat_cart_3.f90 @ 12

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

1 1 pfleura2
!C================================================================
2 1 pfleura2
!C       Converti les positions Zmat en coordonnes cartesiennes
3 1 pfleura2
!C This version deals with the third atoms in A B C
4 1 pfleura2
!C  Used in Mix to Cart.
5 1 pfleura2
!C================================================================
6 1 pfleura2
7 1 pfleura2
        SUBROUTINE ConvertZmat_cart_3(iat,ind_zmat,d,a_val,x,y,z)
8 1 pfleura2
9 12 pfleura2
!----------------------------------------------------------------------
10 12 pfleura2
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,
11 12 pfleura2
!  Centre National de la Recherche Scientifique,
12 12 pfleura2
!  Université Claude Bernard Lyon 1. All rights reserved.
13 12 pfleura2
!
14 12 pfleura2
!  This work is registered with the Agency for the Protection of Programs
15 12 pfleura2
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
16 12 pfleura2
!
17 12 pfleura2
!  Authors: P. Fleurat-Lessard, P. Dayal
18 12 pfleura2
!  Contact: optnpath@gmail.com
19 12 pfleura2
!
20 12 pfleura2
! This file is part of "Opt'n Path".
21 12 pfleura2
!
22 12 pfleura2
!  "Opt'n Path" is free software: you can redistribute it and/or modify
23 12 pfleura2
!  it under the terms of the GNU Affero General Public License as
24 12 pfleura2
!  published by the Free Software Foundation, either version 3 of the License,
25 12 pfleura2
!  or (at your option) any later version.
26 12 pfleura2
!
27 12 pfleura2
!  "Opt'n Path" is distributed in the hope that it will be useful,
28 12 pfleura2
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
29 12 pfleura2
!
30 12 pfleura2
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
31 12 pfleura2
!  GNU Affero General Public License for more details.
32 12 pfleura2
!
33 12 pfleura2
!  You should have received a copy of the GNU Affero General Public License
34 12 pfleura2
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
35 12 pfleura2
!
36 12 pfleura2
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
37 12 pfleura2
! for commercial licensing opportunities.
38 12 pfleura2
!----------------------------------------------------------------------
39 12 pfleura2
40 1 pfleura2
        use Path_module, only : Nat, KINT, KREAL
41 1 pfleura2
42 1 pfleura2
        IMPLICIT NONE
43 1 pfleura2
44 2 pfleura2
        integer(KINT) :: iat, n1, n2
45 1 pfleura2
        real(KREAL)    :: x(nat),y(nat),z(nat)
46 1 pfleura2
        real(KREAL) ::  d,a_val
47 1 pfleura2
        integer(KINT) :: ind_zmat(Nat,5)
48 1 pfleura2
49 1 pfleura2
        real(KREAL) ::  vx1,vy1,vz1,norm1
50 1 pfleura2
        real(KREAL) ::  vvx1,vvy1,vvz1,normv1
51 2 pfleura2
        real(KREAL) ::  vx4, vy4, vz4
52 1 pfleura2
        real(KREAL) ::  a11_z1,a12_z1
53 1 pfleura2
        real(KREAL) ::  a11_y,a12_y
54 1 pfleura2
55 1 pfleura2
56 1 pfleura2
57 1 pfleura2
!C ind_zmat(1) contient le numero de l'atome, (2) celui par rapport auquel on definit la distance...
58 1 pfleura2
59 1 pfleura2
          n1=ind_zmat(iat,2)
60 1 pfleura2
          n2=ind_zmat(iat,3)
61 1 pfleura2
62 1 pfleura2
!          WRITE(*,*) iat,n1,n2
63 1 pfleura2
64 1 pfleura2
!          WRITE(*,*) "d,val,di",d,a_val,a_dih,a_val*180./3.141592654
65 1 pfleura2
66 1 pfleura2
          CALL vecteur(n1,n2,x,y,z,vx1,vy1,vz1,norm1)
67 1 pfleura2
68 1 pfleura2
          vvx1=vx1
69 1 pfleura2
          vvy1=vy1
70 1 pfleura2
          vvz1=vz1
71 1 pfleura2
72 1 pfleura2
!c rotation autour de z de v1 de phi (a11_z1=cos(phi) et a12_z1=sin(phi) ) tq
73 1 pfleura2
!C  v1 soit dans le plan xOz
74 1 pfleura2
75 1 pfleura2
          normv1=dsqrt(vvx1*vvx1+vvy1*vvy1)
76 1 pfleura2
77 1 pfleura2
          IF (normv1 .GE. 1.D-6) THEN
78 1 pfleura2
             a11_z1 = vvx1/normv1
79 1 pfleura2
             a12_z1 = vvy1/normv1
80 1 pfleura2
           ELSE
81 1 pfleura2
             a11_z1 = 1
82 1 pfleura2
             a12_z1 = 0
83 1 pfleura2
          END IF
84 1 pfleura2
85 1 pfleura2
             CALL rota_z(vx1,vy1,vz1,a11_z1,-a12_z1)
86 1 pfleura2
87 1 pfleura2
!c rotation autour de y de v1 de theta (a11_y=cos(theta) et a12_y=sin(theta) ) tq
88 1 pfleura2
!C  v1 soit sur l'axe Ox
89 1 pfleura2
90 1 pfleura2
91 1 pfleura2
          IF (norm1 .GE. 1.D-8) THEN
92 1 pfleura2
             a11_y = vz1/norm1
93 1 pfleura2
             a12_y = vx1/norm1
94 1 pfleura2
          ELSE
95 1 pfleura2
             a11_y = 1
96 1 pfleura2
             a12_y = 0
97 1 pfleura2
          END IF
98 1 pfleura2
99 1 pfleura2
             CALL rota_y(vx1,vy1,vz1,a11_y,a12_y)
100 1 pfleura2
101 1 pfleura2
102 1 pfleura2
!c calcul le vecteur de l atome dans la nouvelle orientation
103 1 pfleura2
104 1 pfleura2
          vx4=d*sin(a_val)
105 1 pfleura2
          vy4=0.
106 1 pfleura2
           vz4=d*cos(a_val)
107 1 pfleura2
108 1 pfleura2
!c calcul le vecteur de l atome
109 1 pfleura2
!c on tourne en sens invers
110 1 pfleura2
          CALL rota_y(vx4,vy4,vz4,a11_y ,-a12_y )
111 1 pfleura2
          CALL rota_z(vx4,vy4,vz4,a11_z1, a12_z1)
112 1 pfleura2
113 1 pfleura2
!c calcul l atome a partir de v4
114 1 pfleura2
          x(iat)=vx4+x(n1)
115 1 pfleura2
          y(iat)=vy4+y(n1)
116 1 pfleura2
          z(iat)=vz4+z(n1)
117 1 pfleura2
118 1 pfleura2
        END
119 1 pfleura2