1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6MODULE pint_transformations
7   USE input_constants,                 ONLY: transformation_stage
8   USE kinds,                           ONLY: dp
9   USE pint_normalmode,                 ONLY: normalmode_f2uf,&
10                                              normalmode_u2x,&
11                                              normalmode_x2u
12   USE pint_staging,                    ONLY: staging_f2uf,&
13                                              staging_u2x,&
14                                              staging_x2u
15   USE pint_types,                      ONLY: pint_env_type
16#include "../base/base_uses.f90"
17
18   IMPLICIT NONE
19
20   PRIVATE
21   LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
22   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'pint_transformations'
23
24   PUBLIC :: pint_x2u, &
25             pint_u2x, &
26             pint_f2uf
27
28CONTAINS
29
30! ***************************************************************************
31!> \brief Transforms from the x into the u variables
32!>      (at the moment a staging transformation for the positions)
33!> \param pint_env the path integral environment
34!> \param ux will contain the u variable (defaults to pint_env%ux)
35!> \param x the positions to transform (defaults to pint_env%x)
36!> \par History
37!>      Added normal mode transformation [hforbert]
38!> \author fawzi
39! **************************************************************************************************
40   SUBROUTINE pint_x2u(pint_env, ux, x)
41      TYPE(pint_env_type), POINTER                       :: pint_env
42      REAL(kind=dp), DIMENSION(:, :), INTENT(out), &
43         OPTIONAL, TARGET                                :: ux
44      REAL(kind=dp), DIMENSION(:, :), INTENT(in), &
45         OPTIONAL, TARGET                                :: x
46
47      CHARACTER(len=*), PARAMETER :: routineN = 'pint_x2u', routineP = moduleN//':'//routineN
48
49      REAL(kind=dp), DIMENSION(:, :), POINTER            :: my_ux, my_x
50
51      CPASSERT(ASSOCIATED(pint_env))
52      CPASSERT(pint_env%ref_count > 0)
53      my_x => pint_env%x
54      my_ux => pint_env%ux
55      IF (PRESENT(x)) my_x => x
56      IF (PRESENT(ux)) my_ux => ux
57      CPASSERT(ASSOCIATED(my_ux))
58      CPASSERT(ASSOCIATED(my_x))
59
60      IF (pint_env%transform == transformation_stage) THEN
61         CALL staging_x2u(pint_env%staging_env, ux=my_ux, x=my_x)
62      ELSE
63         CALL normalmode_x2u(pint_env%normalmode_env, ux=my_ux, x=my_x)
64      END IF
65      RETURN
66   END SUBROUTINE pint_x2u
67
68! ***************************************************************************
69!> \brief transform from the u variable to the x (inverse of x2u)
70!> \param pint_env path integral environment
71!> \param ux the u variable (positions to be backtransformed)
72!> \param x will contain the positions
73!> \par History
74!>      Added normal mode transformation by hforbert
75!> \author fawzi
76! **************************************************************************************************
77   SUBROUTINE pint_u2x(pint_env, ux, x)
78      TYPE(pint_env_type), POINTER                       :: pint_env
79      REAL(kind=dp), DIMENSION(:, :), INTENT(in), &
80         OPTIONAL, TARGET                                :: ux
81      REAL(kind=dp), DIMENSION(:, :), INTENT(out), &
82         OPTIONAL, TARGET                                :: x
83
84      CHARACTER(len=*), PARAMETER :: routineN = 'pint_u2x', routineP = moduleN//':'//routineN
85
86      REAL(kind=dp), DIMENSION(:, :), POINTER            :: my_ux, my_x
87
88      CPASSERT(ASSOCIATED(pint_env))
89      CPASSERT(pint_env%ref_count > 0)
90      my_x => pint_env%x
91      my_ux => pint_env%ux
92      IF (PRESENT(x)) my_x => x
93      IF (PRESENT(ux)) my_ux => ux
94      CPASSERT(ASSOCIATED(my_ux))
95      CPASSERT(ASSOCIATED(my_x))
96
97      IF (pint_env%transform == transformation_stage) THEN
98         CALL staging_u2x(pint_env%staging_env, ux=my_ux, x=my_x)
99      ELSE
100         CALL normalmode_u2x(pint_env%normalmode_env, ux=my_ux, x=my_x)
101      END IF
102      RETURN
103   END SUBROUTINE pint_u2x
104
105! ***************************************************************************
106!> \brief transformation x to u for the forces
107!> \param pint_env the path integral environment
108!> \param uf will contain the accelerations for the transformed variables
109!>        afterwards
110!> \param f the forces to transform
111!> \par History
112!>      Added normal mode transformation [hforbert]
113!>      Divide forces by the number of beads, since the replication
114!>        environment (should) give raw forces [hforbert]
115!> \author fawzi
116! **************************************************************************************************
117   SUBROUTINE pint_f2uf(pint_env, uf, f)
118      TYPE(pint_env_type), POINTER                       :: pint_env
119      REAL(kind=dp), DIMENSION(:, :), INTENT(out), &
120         OPTIONAL, TARGET                                :: uf
121      REAL(kind=dp), DIMENSION(:, :), INTENT(in), &
122         OPTIONAL, TARGET                                :: f
123
124      CHARACTER(len=*), PARAMETER :: routineN = 'pint_f2uf', routineP = moduleN//':'//routineN
125
126      REAL(kind=dp), DIMENSION(:, :), POINTER            :: my_f, my_uf
127
128      CPASSERT(ASSOCIATED(pint_env))
129      CPASSERT(pint_env%ref_count > 0)
130      my_f => pint_env%f
131      my_uf => pint_env%uf
132      IF (PRESENT(f)) my_f => f
133      IF (PRESENT(uf)) my_uf => uf
134      CPASSERT(ASSOCIATED(my_uf))
135      CPASSERT(ASSOCIATED(my_f))
136
137      IF (pint_env%transform == transformation_stage) THEN
138         CALL staging_f2uf(pint_env%staging_env, uf=my_uf, f=my_f)
139      ELSE
140         CALL normalmode_f2uf(pint_env%normalmode_env, uf=my_uf, f=my_f)
141      END IF
142
143      my_uf = my_uf/pint_env%mass_fict*pint_env%propagator%physpotscale
144      RETURN
145   END SUBROUTINE pint_f2uf
146
147END MODULE pint_transformations
148