(git:1f285aa)
graph_utils.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Module containing utils for mapping FESs
10 !> \author Teodoro Laino [tlaino] - 06.2009
11 !> \par History
12 !> 06.2009 created [tlaino]
13 !> teodoro.laino .at. gmail.com
14 !>
15 !> \par Note
16 !> Please report any bug to the author
17 ! **************************************************************************************************
19  USE kinds, ONLY: dp
20 #include "../base/base_uses.f90"
21 
22  IMPLICIT NONE
23  PRIVATE
24 
25  TYPE mep_input_data_type
26  REAL(KIND=dp), DIMENSION(:, :), POINTER :: minima => null()
27  INTEGER :: max_iter = 0
28  INTEGER :: nreplica = 0
29  REAL(KIND=dp) :: kb = 0.0_dp
30  END TYPE mep_input_data_type
31 
32  PUBLIC :: get_val_res, &
33  mep_input_data_type, &
34  point_pbc, &
35  point_no_pbc, &
36  derivative, &
37  pbc
38 
39 CONTAINS
40 
41 ! **************************************************************************************************
42 !> \brief computes the derivative of the FES w.r.t CVs
43 !> \param fes ...
44 !> \param pos0 ...
45 !> \param iperd ...
46 !> \param ndim ...
47 !> \param ngrid ...
48 !> \param dp_grid ...
49 !> \return ...
50 !> \par History
51 !> 06.2009 created [tlaino]
52 !> teodoro.laino .at. gmail.com
53 !> \author Teodoro Laino
54 ! **************************************************************************************************
55  FUNCTION derivative(fes, pos0, iperd, ndim, ngrid, dp_grid) RESULT(der)
56  REAL(kind=dp), DIMENSION(:), INTENT(IN) :: fes
57  INTEGER, DIMENSION(:), INTENT(IN) :: pos0, iperd
58  INTEGER, INTENT(IN) :: ndim
59  INTEGER, DIMENSION(:), INTENT(IN) :: ngrid
60  REAL(kind=dp), DIMENSION(:), INTENT(IN) :: dp_grid
61  REAL(kind=dp), DIMENSION(ndim) :: der
62 
63  INTEGER :: i, j, pnt
64  INTEGER, ALLOCATABLE, DIMENSION(:) :: pos
65 
66  ALLOCATE (pos(ndim))
67  pos(:) = pos0
68  DO i = 1, ndim
69  der(i) = 0.0_dp
70  DO j = 1, -1, -2
71  pos(i) = pos0(i) + j
72  pnt = point_pbc(pos, iperd, ngrid, ndim)
73  der(i) = der(i) + real(j, kind=dp)*(-fes(pnt))
74  END DO
75  pos(i) = pos0(i)
76  der(i) = der(i)/(2.0_dp*dp_grid(i))
77  END DO
78  DEALLOCATE (pos)
79 
80  END FUNCTION derivative
81 
82 ! **************************************************************************************************
83 !> \brief Computes the pointer to the 1D array given the n-dimensional position
84 !> PBC version
85 !> \param pos ...
86 !> \param iperd ...
87 !> \param ngrid ...
88 !> \param ndim ...
89 !> \return ...
90 !> \par History
91 !> 03.2006 created [tlaino]
92 !> teodoro.laino .at. gmail.com
93 !> \author Teodoro Laino
94 ! **************************************************************************************************
95  FUNCTION point_pbc(pos, iperd, ngrid, ndim) RESULT(pnt)
96  INTEGER, DIMENSION(:), INTENT(IN) :: pos, iperd, ngrid
97  INTEGER, INTENT(IN) :: ndim
98  INTEGER :: pnt
99 
100  INTEGER :: idim, lpnt
101 
102  idim = 1
103  pnt = pos(idim)
104  IF (iperd(idim) == 1) THEN
105  lpnt = pos(idim)
106  lpnt = 1000*ngrid(idim) + lpnt
107  lpnt = mod(lpnt, ngrid(idim))
108  IF (lpnt == 0) lpnt = ngrid(idim)
109  pnt = lpnt
110  END IF
111  DO idim = 2, ndim
112  lpnt = pos(idim)
113  IF (iperd(idim) == 1) THEN
114  lpnt = 1000*ngrid(idim) + lpnt
115  lpnt = mod(lpnt, ngrid(idim))
116  IF (lpnt == 0) lpnt = ngrid(idim)
117  END IF
118  pnt = pnt + (lpnt - 1)*product(ngrid(1:idim - 1))
119  END DO
120 
121  END FUNCTION point_pbc
122 
123 ! **************************************************************************************************
124 !> \brief Computes the pointer to the 1D array given the n-dimensional position
125 !> PBC version
126 !> \param pos ...
127 !> \param iperd ...
128 !> \param ngrid ...
129 !> \param ndim ...
130 !> \par History
131 !> 03.2006 created [tlaino]
132 !> teodoro.laino .at. gmail.com
133 !> \author Teodoro Laino
134 ! **************************************************************************************************
135  SUBROUTINE pbc(pos, iperd, ngrid, ndim)
136  INTEGER, DIMENSION(:), INTENT(INOUT) :: pos
137  INTEGER, DIMENSION(:), INTENT(IN) :: iperd, ngrid
138  INTEGER, INTENT(IN) :: ndim
139 
140  INTEGER :: idim, lpnt
141 
142  DO idim = 1, ndim
143  IF (iperd(idim) == 1) THEN
144  lpnt = pos(idim)
145  lpnt = 1000*ngrid(idim) + lpnt
146  lpnt = mod(lpnt, ngrid(idim))
147  IF (lpnt == 0) lpnt = ngrid(idim)
148  pos(idim) = lpnt
149  END IF
150  END DO
151  END SUBROUTINE pbc
152 
153 ! **************************************************************************************************
154 !> \brief Computes the pointer to the 1D array given the n-dimensional position
155 !> non-PBC version
156 !> \param pos ...
157 !> \param ngrid ...
158 !> \param ndim ...
159 !> \return ...
160 !> \par History
161 !> 03.2006 created [tlaino]
162 !> teodoro.laino .at. gmail.com
163 !> \author Teodoro Laino
164 ! **************************************************************************************************
165  FUNCTION point_no_pbc(pos, ngrid, ndim) RESULT(pnt)
166  INTEGER, DIMENSION(:), INTENT(IN) :: pos, ngrid
167  INTEGER, INTENT(IN) :: ndim
168  INTEGER :: pnt
169 
170  INTEGER :: i
171 
172  pnt = pos(1)
173  DO i = 2, ndim
174  pnt = pnt + (pos(i) - 1)*product(ngrid(1:i - 1))
175  END DO
176 
177  END FUNCTION point_no_pbc
178 
179 ! **************************************************************************************************
180 !> \brief Parser informations from the cp2k input/restart
181 !> \param unit ...
182 !> \param section ...
183 !> \param keyword ...
184 !> \param subsection ...
185 !> \param i_val ...
186 !> \param r_val ...
187 !> \par History
188 !> 03.2006 created [tlaino]
189 !> teodoro.laino .at. gmail.com
190 !> \author Teodoro Laino
191 ! **************************************************************************************************
192  SUBROUTINE get_val_res(unit, section, keyword, subsection, i_val, r_val)
193  INTEGER, INTENT(IN) :: unit
194  CHARACTER(len=*) :: section
195  CHARACTER(len=*), OPTIONAL :: keyword, subsection
196  INTEGER, INTENT(OUT), OPTIONAL :: i_val
197  REAL(kind=dp), INTENT(OUT), OPTIONAL :: r_val
198 
199  CHARACTER(len=512) :: line
200  INTEGER :: my_ind, stat
201 
202  rewind(unit)
203  CALL search(unit, trim(section), line, stat=stat)
204 
205  IF (stat /= 0) THEN
206  WRITE (*, *) "Pattern: "//trim(section)//" not found in input file!"
207  cpabort("Search failed!")
208  END IF
209 
210  IF (PRESENT(keyword)) THEN
211  CALL search(unit, trim(keyword), line, stat)
212  IF (stat /= 0) THEN
213  ! if the keyword is not found, let's give back values that will trigger a problem..
214  IF (PRESENT(i_val)) i_val = -huge(1)
215  IF (PRESENT(r_val)) r_val = -huge(0.0_dp)
216  ELSE
217  ! Otherwise read the value
218  my_ind = index(line, trim(keyword)) + len_trim(keyword) + 1
219  IF (PRESENT(i_val)) READ (line(my_ind:), *) i_val
220  IF (PRESENT(r_val)) READ (line(my_ind:), *) r_val
221  END IF
222  END IF
223 
224  IF (PRESENT(subsection)) THEN
225  CALL search(unit, trim(subsection), line, stat)
226  END IF
227 
228  END SUBROUTINE get_val_res
229 
230  ! **************************************************************************************************
231 ! **************************************************************************************************
232 !> \brief ...
233 !> \param unit ...
234 !> \param key ...
235 !> \param line ...
236 !> \param stat ...
237 ! **************************************************************************************************
238  SUBROUTINE search(unit, key, line, stat)
239  INTEGER, INTENT(in) :: unit
240  CHARACTER(LEN=*), INTENT(IN) :: key
241  CHARACTER(LEN=512), INTENT(OUT) :: line
242  INTEGER, INTENT(out) :: stat
243 
244  stat = 99
245  DO WHILE (.true.)
246  READ (unit, '(A)', err=100, END=100) line
247  IF (index(line, trim(key)) /= 0) THEN
248  stat = 0
249  EXIT
250  END IF
251  END DO
252 100 CONTINUE
253  END SUBROUTINE search
254 
255 END MODULE graph_utils
Module containing utils for mapping FESs.
Definition: graph_utils.F:18
real(kind=dp) function, dimension(ndim), public derivative(fes, pos0, iperd, ndim, ngrid, dp_grid)
computes the derivative of the FES w.r.t CVs
Definition: graph_utils.F:56
subroutine, public get_val_res(unit, section, keyword, subsection, i_val, r_val)
Parser informations from the cp2k input/restart.
Definition: graph_utils.F:193
integer function, public point_no_pbc(pos, ngrid, ndim)
Computes the pointer to the 1D array given the n-dimensional position non-PBC version.
Definition: graph_utils.F:166
subroutine, public pbc(pos, iperd, ngrid, ndim)
Computes the pointer to the 1D array given the n-dimensional position PBC version.
Definition: graph_utils.F:136
integer function, public point_pbc(pos, iperd, ngrid, ndim)
Computes the pointer to the 1D array given the n-dimensional position PBC version.
Definition: graph_utils.F:96
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34