Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 : ! **************************************************************************************************
18 : MODULE graph_utils
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 0 : 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 0 : INTEGER, ALLOCATABLE, DIMENSION(:) :: pos
65 :
66 0 : ALLOCATE (pos(ndim))
67 0 : pos(:) = pos0
68 0 : DO i = 1, ndim
69 0 : der(i) = 0.0_dp
70 0 : DO j = 1, -1, -2
71 0 : pos(i) = pos0(i) + j
72 0 : pnt = point_pbc(pos, iperd, ngrid, ndim)
73 0 : der(i) = der(i) + REAL(j, KIND=dp)*(-fes(pnt))
74 : END DO
75 0 : pos(i) = pos0(i)
76 0 : der(i) = der(i)/(2.0_dp*dp_grid(i))
77 : END DO
78 0 : DEALLOCATE (pos)
79 :
80 0 : 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 0 : 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 0 : idim = 1
103 0 : pnt = pos(idim)
104 0 : IF (iperd(idim) == 1) THEN
105 0 : lpnt = pos(idim)
106 0 : lpnt = 1000*ngrid(idim) + lpnt
107 0 : lpnt = MOD(lpnt, ngrid(idim))
108 0 : IF (lpnt == 0) lpnt = ngrid(idim)
109 : pnt = lpnt
110 : END IF
111 0 : DO idim = 2, ndim
112 0 : lpnt = pos(idim)
113 0 : IF (iperd(idim) == 1) THEN
114 0 : lpnt = 1000*ngrid(idim) + lpnt
115 0 : lpnt = MOD(lpnt, ngrid(idim))
116 0 : IF (lpnt == 0) lpnt = ngrid(idim)
117 : END IF
118 0 : pnt = pnt + (lpnt - 1)*PRODUCT(ngrid(1:idim - 1))
119 : END DO
120 :
121 0 : 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 0 : 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 0 : DO idim = 1, ndim
143 0 : IF (iperd(idim) == 1) THEN
144 0 : lpnt = pos(idim)
145 0 : lpnt = 1000*ngrid(idim) + lpnt
146 0 : lpnt = MOD(lpnt, ngrid(idim))
147 0 : IF (lpnt == 0) lpnt = ngrid(idim)
148 0 : pos(idim) = lpnt
149 : END IF
150 : END DO
151 0 : 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 0 : 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 0 : pnt = pos(1)
173 0 : DO i = 2, ndim
174 0 : pnt = pnt + (pos(i) - 1)*PRODUCT(ngrid(1:i - 1))
175 : END DO
176 :
177 0 : 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 0 : 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 0 : REWIND (unit)
203 0 : CALL search(unit, TRIM(section), line, stat=stat)
204 :
205 0 : IF (stat /= 0) THEN
206 0 : WRITE (*, *) "Pattern: "//TRIM(section)//" not found in input file!"
207 0 : CPABORT("Search failed!")
208 : END IF
209 :
210 0 : IF (PRESENT(keyword)) THEN
211 0 : CALL search(unit, TRIM(keyword), line, stat)
212 0 : IF (stat /= 0) THEN
213 : ! if the keyword is not found, let's give back values that will trigger a problem..
214 0 : IF (PRESENT(i_val)) i_val = -HUGE(1)
215 0 : IF (PRESENT(r_val)) r_val = -HUGE(0.0_dp)
216 : ELSE
217 : ! Otherwise read the value
218 0 : my_ind = INDEX(line, TRIM(keyword)) + LEN_TRIM(keyword) + 1
219 0 : IF (PRESENT(i_val)) READ (line(my_ind:), *) i_val
220 0 : IF (PRESENT(r_val)) READ (line(my_ind:), *) r_val
221 : END IF
222 : END IF
223 :
224 0 : IF (PRESENT(subsection)) THEN
225 0 : CALL search(unit, TRIM(subsection), line, stat)
226 : END IF
227 :
228 0 : END SUBROUTINE get_val_res
229 :
230 : ! **************************************************************************************************
231 : ! **************************************************************************************************
232 : !> \brief ...
233 : !> \param unit ...
234 : !> \param key ...
235 : !> \param line ...
236 : !> \param stat ...
237 : ! **************************************************************************************************
238 0 : 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 0 : stat = 99
245 : DO WHILE (.TRUE.)
246 0 : READ (unit, '(A)', ERR=100, END=100) line
247 0 : IF (INDEX(line, TRIM(key)) /= 0) THEN
248 0 : stat = 0
249 0 : EXIT
250 : END IF
251 : END DO
252 : 100 CONTINUE
253 0 : END SUBROUTINE search
254 :
255 0 : END MODULE graph_utils
|
