Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : !--------------------------------------------------------------------------------------------------!
9 : ! IMPORTANT: Update libcp2k.h when you add, remove or change a function in this file. !
10 : !--------------------------------------------------------------------------------------------------!
11 :
12 : ! **************************************************************************************************
13 : !> \brief CP2K C/C++ interface
14 : !> \par History
15 : !> 12.2012 created [Hossein Bani-Hashemian]
16 : !> 04.2016 restructured [Hossein Bani-Hashemian, Ole Schuett]
17 : !> 03.2018 added Active Space functions [Tiziano Mueller]
18 : !> \author Mohammad Hossein Bani-Hashemian
19 : ! **************************************************************************************************
20 : MODULE libcp2k
21 : USE ISO_C_BINDING, ONLY: C_CHAR,&
22 : C_DOUBLE,&
23 : C_FUNPTR,&
24 : C_INT,&
25 : C_LONG,&
26 : C_NULL_CHAR
27 : USE cp2k_info, ONLY: cp2k_version
28 : USE cp2k_runs, ONLY: run_input
29 : USE cp_fm_types, ONLY: cp_fm_get_element
30 : USE f77_interface, ONLY: &
31 : calc_energy_force, create_force_env, destroy_force_env, f_env_add_defaults, &
32 : f_env_rm_defaults, f_env_type, finalize_cp2k, get_cell, get_energy, get_force, get_natom, &
33 : get_nparticle, get_pos, get_qmmm_cell, get_result_r1, init_cp2k, set_cell, set_pos, set_vel
34 : USE force_env_types, ONLY: force_env_get,&
35 : use_qs_force
36 : USE input_cp2k, ONLY: create_cp2k_root_section
37 : USE input_cp2k_read, ONLY: empty_initial_variables
38 : USE input_section_types, ONLY: section_release,&
39 : section_type
40 : USE kinds, ONLY: default_path_length,&
41 : default_string_length,&
42 : dp
43 : USE message_passing, ONLY: mp_comm_type
44 : USE qs_active_space_types, ONLY: eri_type_eri_element_func
45 : USE string_utilities, ONLY: strlcpy_c2f
46 : #include "../base/base_uses.f90"
47 :
48 : IMPLICIT NONE
49 :
50 : PRIVATE
51 :
52 : PUBLIC :: cp2k_get_version, cp2k_init, cp2k_init_without_mpi, cp2k_init_without_mpi_comm, &
53 : cp2k_finalize, cp2k_finalize_without_mpi, cp2k_create_force_env, &
54 : cp2k_create_force_env_comm, cp2k_destroy_force_env, cp2k_set_positions, &
55 : cp2k_set_velocities, cp2k_set_cell, cp2k_get_result, cp2k_get_natom, &
56 : cp2k_get_nparticle, cp2k_get_positions, cp2k_get_forces, &
57 : cp2k_get_potential_energy, cp2k_get_cell, cp2k_get_qmmm_cell, &
58 : cp2k_calc_energy_force, cp2k_calc_energy, cp2k_run_input, cp2k_run_input_comm, &
59 : cp2k_transport_set_callback, cp2k_active_space_get_mo_count, &
60 : cp2k_active_space_get_fock_sub, cp2k_active_space_get_eri_nze_count, &
61 : cp2k_active_space_get_eri
62 :
63 : TYPE, EXTENDS(eri_type_eri_element_func) :: eri2array
64 : INTEGER(C_INT), POINTER :: coords(:) => NULL()
65 : REAL(C_DOUBLE), POINTER :: values(:) => NULL()
66 : INTEGER :: idx = 1
67 : CONTAINS
68 : PROCEDURE :: func => eri2array_func
69 : END TYPE eri2array
70 :
71 : CONTAINS
72 :
73 : ! **************************************************************************************************
74 : !> \brief ...
75 : !> \param version_str ...
76 : !> \param str_length ...
77 : ! **************************************************************************************************
78 2 : SUBROUTINE cp2k_get_version(version_str, str_length) BIND(C)
79 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(OUT) :: version_str(*)
80 : INTEGER(C_INT), VALUE :: str_length
81 :
82 : INTEGER :: i, n
83 :
84 2 : n = LEN_TRIM(cp2k_version)
85 2 : CPASSERT(str_length >= n + 1)
86 : MARK_USED(str_length)
87 :
88 : ! copy string
89 84 : DO i = 1, n
90 84 : version_str(i) = cp2k_version(i:i)
91 : END DO
92 2 : version_str(n + 1) = C_NULL_CHAR
93 2 : END SUBROUTINE cp2k_get_version
94 :
95 : ! **************************************************************************************************
96 : !> \brief ...
97 : ! **************************************************************************************************
98 2 : SUBROUTINE cp2k_init() BIND(C)
99 : INTEGER :: ierr
100 :
101 2 : CALL init_cp2k(.TRUE., ierr)
102 2 : CPASSERT(ierr == 0)
103 2 : END SUBROUTINE cp2k_init
104 :
105 : ! **************************************************************************************************
106 : !> \brief ...
107 : ! **************************************************************************************************
108 0 : SUBROUTINE cp2k_init_without_mpi() BIND(C)
109 : INTEGER :: ierr
110 :
111 0 : CALL init_cp2k(.FALSE., ierr)
112 0 : CPASSERT(ierr == 0)
113 0 : END SUBROUTINE cp2k_init_without_mpi
114 :
115 : ! **************************************************************************************************
116 : !> \brief ...
117 : !> \param mpi_comm ...
118 : ! **************************************************************************************************
119 0 : SUBROUTINE cp2k_init_without_mpi_comm(mpi_comm) BIND(C)
120 : INTEGER(C_INT), VALUE :: mpi_comm
121 :
122 : INTEGER :: ierr
123 : TYPE(mp_comm_type) :: my_mpi_comm
124 :
125 0 : CALL my_mpi_comm%set_handle(INT(mpi_comm))
126 0 : CALL init_cp2k(.FALSE., ierr, my_mpi_comm)
127 0 : CPASSERT(ierr == 0)
128 0 : END SUBROUTINE cp2k_init_without_mpi_comm
129 :
130 : ! **************************************************************************************************
131 : !> \brief ...
132 : ! **************************************************************************************************
133 2 : SUBROUTINE cp2k_finalize() BIND(C)
134 : INTEGER :: ierr
135 :
136 2 : CALL finalize_cp2k(.TRUE., ierr)
137 2 : CPASSERT(ierr == 0)
138 2 : END SUBROUTINE cp2k_finalize
139 :
140 : ! **************************************************************************************************
141 : !> \brief ...
142 : ! **************************************************************************************************
143 0 : SUBROUTINE cp2k_finalize_without_mpi() BIND(C)
144 : INTEGER :: ierr
145 :
146 0 : CALL finalize_cp2k(.FALSE., ierr)
147 0 : CPASSERT(ierr == 0)
148 0 : END SUBROUTINE cp2k_finalize_without_mpi
149 :
150 : ! **************************************************************************************************
151 : !> \brief ...
152 : !> \param new_env_id ...
153 : !> \param input_file_path ...
154 : !> \param output_file_path ...
155 : ! **************************************************************************************************
156 4 : SUBROUTINE cp2k_create_force_env(new_env_id, input_file_path, output_file_path) BIND(C)
157 : INTEGER(C_INT), INTENT(OUT) :: new_env_id
158 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: input_file_path(*), output_file_path(*)
159 :
160 : CHARACTER(LEN=default_path_length) :: ifp, ofp
161 : INTEGER :: ierr, ncopied
162 : TYPE(section_type), POINTER :: input_declaration
163 :
164 2 : ifp = " "; ofp = " "
165 2 : ncopied = strlcpy_c2f(ifp, input_file_path)
166 2 : ncopied = strlcpy_c2f(ofp, output_file_path)
167 :
168 2 : NULLIFY (input_declaration)
169 2 : CALL create_cp2k_root_section(input_declaration)
170 2 : CALL create_force_env(new_env_id, input_declaration, ifp, ofp, ierr=ierr)
171 2 : CALL section_release(input_declaration)
172 2 : CPASSERT(ierr == 0)
173 2 : END SUBROUTINE cp2k_create_force_env
174 :
175 : ! **************************************************************************************************
176 : !> \brief ...
177 : !> \param new_env_id ...
178 : !> \param input_file_path ...
179 : !> \param output_file_path ...
180 : !> \param mpi_comm ...
181 : ! **************************************************************************************************
182 0 : SUBROUTINE cp2k_create_force_env_comm(new_env_id, input_file_path, output_file_path, mpi_comm) BIND(C)
183 : INTEGER(C_INT), INTENT(OUT) :: new_env_id
184 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: input_file_path(*), output_file_path(*)
185 : INTEGER(C_INT), VALUE :: mpi_comm
186 :
187 : CHARACTER(LEN=default_path_length) :: ifp, ofp
188 : INTEGER :: ierr, ncopied
189 : TYPE(mp_comm_type) :: my_mpi_comm
190 : TYPE(section_type), POINTER :: input_declaration
191 :
192 0 : ifp = " "; ofp = " "
193 0 : ncopied = strlcpy_c2f(ifp, input_file_path)
194 0 : ncopied = strlcpy_c2f(ofp, output_file_path)
195 :
196 0 : NULLIFY (input_declaration)
197 0 : CALL create_cp2k_root_section(input_declaration)
198 0 : CALL my_mpi_comm%set_handle(INT(mpi_comm))
199 0 : CALL create_force_env(new_env_id, input_declaration, ifp, ofp, my_mpi_comm, ierr=ierr)
200 0 : CALL section_release(input_declaration)
201 0 : CPASSERT(ierr == 0)
202 0 : END SUBROUTINE cp2k_create_force_env_comm
203 :
204 : ! **************************************************************************************************
205 : !> \brief ...
206 : !> \param env_id ...
207 : ! **************************************************************************************************
208 0 : SUBROUTINE cp2k_destroy_force_env(env_id) BIND(C)
209 : INTEGER(C_INT), VALUE :: env_id
210 :
211 : INTEGER :: ierr
212 :
213 0 : CALL destroy_force_env(env_id, ierr)
214 0 : CPASSERT(ierr == 0)
215 0 : END SUBROUTINE cp2k_destroy_force_env
216 :
217 : ! **************************************************************************************************
218 : !> \brief ...
219 : !> \param env_id ...
220 : !> \param new_pos ...
221 : !> \param n_el ...
222 : ! **************************************************************************************************
223 0 : SUBROUTINE cp2k_set_positions(env_id, new_pos, n_el) BIND(C)
224 : INTEGER(C_INT), VALUE :: env_id, n_el
225 : REAL(C_DOUBLE), DIMENSION(1:n_el), INTENT(IN) :: new_pos
226 :
227 : INTEGER :: ierr
228 :
229 0 : CALL set_pos(env_id, new_pos, n_el, ierr)
230 0 : CPASSERT(ierr == 0)
231 0 : END SUBROUTINE cp2k_set_positions
232 :
233 : ! **************************************************************************************************
234 : !> \brief ...
235 : !> \param env_id ...
236 : !> \param new_vel ...
237 : !> \param n_el ...
238 : ! **************************************************************************************************
239 0 : SUBROUTINE cp2k_set_velocities(env_id, new_vel, n_el) BIND(C)
240 : INTEGER(C_INT), VALUE :: env_id, n_el
241 : REAL(C_DOUBLE), DIMENSION(1:n_el), INTENT(IN) :: new_vel
242 :
243 : INTEGER :: ierr
244 :
245 0 : CALL set_vel(env_id, new_vel, n_el, ierr)
246 0 : CPASSERT(ierr == 0)
247 0 : END SUBROUTINE cp2k_set_velocities
248 :
249 : ! **************************************************************************************************
250 : !> \brief ...
251 : !> \param env_id ...
252 : !> \param new_cell ...
253 : ! **************************************************************************************************
254 0 : SUBROUTINE cp2k_set_cell(env_id, new_cell) BIND(C)
255 : INTEGER(C_INT), VALUE :: env_id
256 : REAL(C_DOUBLE), DIMENSION(3, 3), INTENT(IN) :: new_cell
257 :
258 : INTEGER :: ierr
259 :
260 0 : CALL set_cell(env_id, new_cell, ierr)
261 0 : CPASSERT(ierr == 0)
262 0 : END SUBROUTINE cp2k_set_cell
263 :
264 : ! **************************************************************************************************
265 : !> \brief ...
266 : !> \param env_id ...
267 : !> \param description ...
268 : !> \param RESULT ...
269 : !> \param n_el ...
270 : ! **************************************************************************************************
271 0 : SUBROUTINE cp2k_get_result(env_id, description, RESULT, n_el) BIND(C)
272 : INTEGER(C_INT), VALUE :: env_id
273 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: description(*)
274 : INTEGER(C_INT), VALUE :: n_el
275 : REAL(C_DOUBLE), DIMENSION(1:n_el), INTENT(OUT) :: RESULT
276 :
277 : CHARACTER(LEN=default_string_length) :: desc_low
278 : INTEGER :: ierr, ncopied
279 :
280 0 : desc_low = " "
281 0 : ncopied = strlcpy_c2f(desc_low, description)
282 :
283 0 : CALL get_result_r1(env_id, desc_low, n_el, RESULT, ierr=ierr)
284 0 : CPASSERT(ierr == 0)
285 0 : END SUBROUTINE cp2k_get_result
286 :
287 : ! **************************************************************************************************
288 : !> \brief ...
289 : !> \param env_id ...
290 : !> \param natom ...
291 : ! **************************************************************************************************
292 0 : SUBROUTINE cp2k_get_natom(env_id, natom) BIND(C)
293 : INTEGER(C_INT), VALUE :: env_id
294 : INTEGER(C_INT), INTENT(OUT) :: natom
295 :
296 : INTEGER :: ierr
297 :
298 0 : CALL get_natom(env_id, natom, ierr)
299 0 : CPASSERT(ierr == 0)
300 0 : END SUBROUTINE cp2k_get_natom
301 :
302 : ! **************************************************************************************************
303 : !> \brief ...
304 : !> \param env_id ...
305 : !> \param nparticle ...
306 : ! **************************************************************************************************
307 0 : SUBROUTINE cp2k_get_nparticle(env_id, nparticle) BIND(C)
308 : INTEGER(C_INT), VALUE :: env_id
309 : INTEGER(C_INT), INTENT(OUT) :: nparticle
310 :
311 : INTEGER :: ierr
312 :
313 0 : CALL get_nparticle(env_id, nparticle, ierr)
314 0 : CPASSERT(ierr == 0)
315 0 : END SUBROUTINE cp2k_get_nparticle
316 :
317 : ! **************************************************************************************************
318 : !> \brief ...
319 : !> \param env_id ...
320 : !> \param pos ...
321 : !> \param n_el ...
322 : ! **************************************************************************************************
323 0 : SUBROUTINE cp2k_get_positions(env_id, pos, n_el) BIND(C)
324 : INTEGER(C_INT), VALUE :: env_id, n_el
325 : REAL(C_DOUBLE), DIMENSION(1:n_el), INTENT(OUT) :: pos
326 :
327 : INTEGER :: ierr
328 :
329 0 : CALL get_pos(env_id, pos, n_el, ierr)
330 0 : CPASSERT(ierr == 0)
331 0 : END SUBROUTINE cp2k_get_positions
332 :
333 : ! **************************************************************************************************
334 : !> \brief ...
335 : !> \param env_id ...
336 : !> \param force ...
337 : !> \param n_el ...
338 : ! **************************************************************************************************
339 0 : SUBROUTINE cp2k_get_forces(env_id, force, n_el) BIND(C)
340 : INTEGER(C_INT), VALUE :: env_id, n_el
341 : REAL(C_DOUBLE), DIMENSION(1:n_el), INTENT(OUT) :: force
342 :
343 : INTEGER :: ierr
344 :
345 0 : CALL get_force(env_id, force, n_el, ierr)
346 0 : CPASSERT(ierr == 0)
347 0 : END SUBROUTINE cp2k_get_forces
348 :
349 : ! **************************************************************************************************
350 : !> \brief ...
351 : !> \param env_id ...
352 : !> \param e_pot ...
353 : ! **************************************************************************************************
354 2 : SUBROUTINE cp2k_get_potential_energy(env_id, e_pot) BIND(C)
355 : INTEGER(C_INT), VALUE :: env_id
356 : REAL(C_DOUBLE), INTENT(OUT) :: e_pot
357 :
358 : INTEGER :: ierr
359 :
360 2 : CALL get_energy(env_id, e_pot, ierr)
361 2 : CPASSERT(ierr == 0)
362 2 : END SUBROUTINE cp2k_get_potential_energy
363 :
364 : ! **************************************************************************************************
365 : !> \brief ...
366 : !> \param env_id ...
367 : !> \param cell ...
368 : ! **************************************************************************************************
369 0 : SUBROUTINE cp2k_get_cell(env_id, cell) BIND(C)
370 : INTEGER(C_INT), VALUE :: env_id
371 : REAL(C_DOUBLE), DIMENSION(3, 3), INTENT(OUT) :: cell
372 :
373 : INTEGER :: ierr
374 :
375 0 : CALL get_cell(env_id, cell=cell, ierr=ierr)
376 0 : CPASSERT(ierr == 0)
377 0 : END SUBROUTINE cp2k_get_cell
378 :
379 : ! **************************************************************************************************
380 : !> \brief ...
381 : !> \param env_id ...
382 : !> \param cell ...
383 : ! **************************************************************************************************
384 0 : SUBROUTINE cp2k_get_qmmm_cell(env_id, cell) BIND(C)
385 : INTEGER(C_INT), VALUE :: env_id
386 : REAL(C_DOUBLE), DIMENSION(3, 3), INTENT(OUT) :: cell
387 :
388 : INTEGER :: ierr
389 :
390 0 : CALL get_qmmm_cell(env_id, cell=cell, ierr=ierr)
391 0 : CPASSERT(ierr == 0)
392 0 : END SUBROUTINE cp2k_get_qmmm_cell
393 :
394 : ! **************************************************************************************************
395 : !> \brief ...
396 : !> \param env_id ...
397 : ! **************************************************************************************************
398 2 : SUBROUTINE cp2k_calc_energy_force(env_id) BIND(C)
399 : INTEGER(C_INT), VALUE :: env_id
400 :
401 : INTEGER :: ierr
402 :
403 2 : CALL calc_energy_force(env_id, .TRUE., ierr)
404 2 : CPASSERT(ierr == 0)
405 2 : END SUBROUTINE cp2k_calc_energy_force
406 :
407 : ! **************************************************************************************************
408 : !> \brief ...
409 : !> \param env_id ...
410 : ! **************************************************************************************************
411 0 : SUBROUTINE cp2k_calc_energy(env_id) BIND(C)
412 : INTEGER(C_INT), VALUE :: env_id
413 :
414 : INTEGER :: ierr
415 :
416 0 : CALL calc_energy_force(env_id, .FALSE., ierr)
417 0 : CPASSERT(ierr == 0)
418 0 : END SUBROUTINE cp2k_calc_energy
419 :
420 : ! **************************************************************************************************
421 : !> \brief ...
422 : !> \param input_file_path ...
423 : !> \param output_file_path ...
424 : ! **************************************************************************************************
425 0 : SUBROUTINE cp2k_run_input(input_file_path, output_file_path) BIND(C)
426 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: input_file_path(*), output_file_path(*)
427 :
428 : CHARACTER(LEN=default_path_length) :: ifp, ofp
429 : INTEGER :: ncopied
430 : TYPE(section_type), POINTER :: input_declaration
431 :
432 0 : ifp = " "; ofp = " "
433 0 : ncopied = strlcpy_c2f(ifp, input_file_path)
434 0 : ncopied = strlcpy_c2f(ofp, output_file_path)
435 :
436 0 : NULLIFY (input_declaration)
437 0 : CALL create_cp2k_root_section(input_declaration)
438 0 : CALL run_input(input_declaration, ifp, ofp, empty_initial_variables)
439 0 : CALL section_release(input_declaration)
440 0 : END SUBROUTINE cp2k_run_input
441 :
442 : ! **************************************************************************************************
443 : !> \brief ...
444 : !> \param input_file_path ...
445 : !> \param output_file_path ...
446 : !> \param mpi_comm ...
447 : ! **************************************************************************************************
448 0 : SUBROUTINE cp2k_run_input_comm(input_file_path, output_file_path, mpi_comm) BIND(C)
449 : CHARACTER(LEN=1, KIND=C_CHAR), INTENT(IN) :: input_file_path(*), output_file_path(*)
450 : INTEGER(C_INT), VALUE :: mpi_comm
451 :
452 : CHARACTER(LEN=default_path_length) :: ifp, ofp
453 : INTEGER :: ncopied
454 : TYPE(mp_comm_type) :: my_mpi_comm
455 : TYPE(section_type), POINTER :: input_declaration
456 :
457 0 : ifp = " "; ofp = " "
458 0 : ncopied = strlcpy_c2f(ifp, input_file_path)
459 0 : ncopied = strlcpy_c2f(ofp, output_file_path)
460 :
461 0 : NULLIFY (input_declaration)
462 0 : CALL create_cp2k_root_section(input_declaration)
463 0 : CALL my_mpi_comm%set_handle(INT(mpi_comm))
464 0 : CALL run_input(input_declaration, ifp, ofp, empty_initial_variables, my_mpi_comm)
465 0 : CALL section_release(input_declaration)
466 0 : END SUBROUTINE cp2k_run_input_comm
467 :
468 : ! **************************************************************************************************
469 : !> \brief Gets a function pointer pointing to a routine defined in C/C++ and
470 : !> passes it to the transport environment in force environment
471 : !> \param f_env_id the force env id
472 : !> \param func_ptr the function pointer
473 : !> \par History
474 : !> 12.2012 created [Hossein Bani-Hashemian]
475 : !> \author Mohammad Hossein Bani-Hashemian
476 : ! **************************************************************************************************
477 0 : SUBROUTINE cp2k_transport_set_callback(f_env_id, func_ptr) BIND(C)
478 : INTEGER(C_INT), VALUE :: f_env_id
479 : TYPE(C_FUNPTR), VALUE :: func_ptr
480 :
481 : INTEGER :: ierr, in_use
482 : TYPE(f_env_type), POINTER :: f_env
483 :
484 0 : NULLIFY (f_env)
485 0 : CALL f_env_add_defaults(f_env_id, f_env)
486 0 : CALL force_env_get(f_env%force_env, in_use=in_use)
487 0 : IF (in_use == use_qs_force) THEN
488 0 : f_env%force_env%qs_env%transport_env%ext_c_method_ptr = func_ptr
489 : END IF
490 0 : CALL f_env_rm_defaults(f_env, ierr)
491 0 : CPASSERT(ierr == 0)
492 0 : END SUBROUTINE cp2k_transport_set_callback
493 :
494 : ! **************************************************************************************************
495 : !> \brief Get the number of molecular orbitals
496 : !> \param f_env_id the force env id
497 : !> \return The number of elements or -1 if unavailable
498 : !> \author Tiziano Mueller
499 : ! **************************************************************************************************
500 0 : INTEGER(C_INT) FUNCTION cp2k_active_space_get_mo_count(f_env_id) RESULT(nmo) BIND(C)
501 : USE qs_active_space_types, ONLY: active_space_type
502 : USE qs_mo_types, ONLY: get_mo_set
503 : USE qs_environment_types, ONLY: get_qs_env
504 : INTEGER(C_INT), VALUE :: f_env_id
505 :
506 : INTEGER :: ierr
507 : TYPE(active_space_type), POINTER :: active_space_env
508 : TYPE(f_env_type), POINTER :: f_env
509 :
510 0 : nmo = -1
511 0 : NULLIFY (f_env)
512 :
513 0 : CALL f_env_add_defaults(f_env_id, f_env)
514 :
515 : try: BLOCK
516 0 : CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
517 :
518 0 : IF (.NOT. ASSOCIATED(active_space_env)) THEN
519 : EXIT try
520 : END IF
521 :
522 0 : CALL get_mo_set(active_space_env%mos_active(1), nmo=nmo)
523 : END BLOCK try
524 :
525 0 : CALL f_env_rm_defaults(f_env, ierr)
526 0 : CPASSERT(ierr == 0)
527 0 : END FUNCTION cp2k_active_space_get_mo_count
528 :
529 : ! **************************************************************************************************
530 : !> \brief Get the active space Fock sub-matrix (as a full matrix)
531 : !> \param f_env_id the force env id
532 : !> \param buf C array to write the data to
533 : !> \param buf_len The length of the C array to write the data to (must be at least mo_count^2)
534 : !> \return The number of elements written or -1 if unavailable or buffer too small
535 : !> \author Tiziano Mueller
536 : ! **************************************************************************************************
537 0 : INTEGER(C_LONG) FUNCTION cp2k_active_space_get_fock_sub(f_env_id, buf, buf_len) RESULT(nelem) BIND(C)
538 0 : USE qs_active_space_types, ONLY: active_space_type
539 : USE qs_mo_types, ONLY: get_mo_set
540 : USE qs_environment_types, ONLY: get_qs_env
541 : INTEGER(C_INT), VALUE :: f_env_id
542 : INTEGER(C_LONG), VALUE :: buf_len
543 : REAL(C_DOUBLE), DIMENSION(0:buf_len-1), &
544 : INTENT(OUT) :: buf
545 :
546 : INTEGER :: i, ierr, j, norb
547 : REAL(C_DOUBLE) :: mval
548 : TYPE(active_space_type), POINTER :: active_space_env
549 : TYPE(f_env_type), POINTER :: f_env
550 :
551 0 : nelem = -1
552 0 : NULLIFY (f_env)
553 :
554 0 : CALL f_env_add_defaults(f_env_id, f_env)
555 :
556 : try: BLOCK
557 0 : CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
558 :
559 0 : IF (.NOT. ASSOCIATED(active_space_env)) THEN
560 : EXIT try
561 : END IF
562 :
563 0 : CALL get_mo_set(active_space_env%mos_active(1), nmo=norb)
564 :
565 0 : IF (buf_len < norb*norb) THEN
566 : EXIT try
567 : END IF
568 :
569 0 : DO i = 0, norb - 1
570 0 : DO j = 0, norb - 1
571 0 : CALL cp_fm_get_element(active_space_env%fock_sub(1), i + 1, j + 1, mval)
572 0 : buf(norb*i + j) = mval
573 0 : buf(norb*j + i) = mval
574 : END DO
575 : END DO
576 :
577 : ! finished successfully, set number of written elements
578 0 : nelem = norb**norb
579 : END BLOCK try
580 :
581 0 : CALL f_env_rm_defaults(f_env, ierr)
582 0 : CPASSERT(ierr == 0)
583 0 : END FUNCTION cp2k_active_space_get_fock_sub
584 :
585 : ! **************************************************************************************************
586 : !> \brief Get the number of non-zero elements of the ERI
587 : !> \param f_env_id the force env id
588 : !> \return The number of elements or -1 if unavailable
589 : !> \author Tiziano Mueller
590 : ! **************************************************************************************************
591 0 : INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri_nze_count(f_env_id) RESULT(nze_count) BIND(C)
592 0 : USE qs_active_space_types, ONLY: active_space_type
593 : USE qs_environment_types, ONLY: get_qs_env
594 : INTEGER(C_INT), VALUE :: f_env_id
595 :
596 : INTEGER :: ierr
597 : TYPE(active_space_type), POINTER :: active_space_env
598 : TYPE(f_env_type), POINTER :: f_env
599 :
600 0 : nze_count = -1
601 0 : NULLIFY (f_env)
602 :
603 0 : CALL f_env_add_defaults(f_env_id, f_env)
604 :
605 : try: BLOCK
606 0 : CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
607 :
608 0 : IF (.NOT. ASSOCIATED(active_space_env)) THEN
609 : EXIT try
610 : END IF
611 :
612 0 : nze_count = INT(active_space_env%eri%eri(1)%csr_mat%nze_total, KIND(nze_count))
613 : END BLOCK try
614 :
615 0 : CALL f_env_rm_defaults(f_env, ierr)
616 0 : CPASSERT(ierr == 0)
617 0 : END FUNCTION cp2k_active_space_get_eri_nze_count
618 :
619 : ! **************************************************************************************************
620 : !> \brief Get the electron repulsion integrals (as a sparse tensor)
621 : !> \param f_env_id the force env id
622 : !> \param buf_coords C array to write the indizes (i,j,k,l) to
623 : !> \param buf_coords_len size of the buffer, must be at least 4*nze_count
624 : !> \param buf_values C array to write the values to
625 : !> \param buf_values_len size of the buffer, must be at least nze_count
626 : !> \return The number of elements written or -1 if unavailable or buffer too small
627 : !> \author Tiziano Mueller
628 : ! **************************************************************************************************
629 0 : INTEGER(C_LONG) FUNCTION cp2k_active_space_get_eri(f_env_id, &
630 0 : buf_coords, buf_coords_len, &
631 0 : buf_values, buf_values_len) RESULT(nelem) BIND(C)
632 0 : USE qs_active_space_types, ONLY: active_space_type
633 : USE qs_mo_types, ONLY: get_mo_set
634 : USE qs_environment_types, ONLY: get_qs_env
635 : INTEGER(C_INT), INTENT(IN), VALUE :: f_env_id
636 : INTEGER(C_LONG), INTENT(IN), VALUE :: buf_coords_len
637 : INTEGER(C_INT), INTENT(OUT), TARGET :: buf_coords(1:buf_coords_len)
638 : INTEGER(C_LONG), INTENT(IN), VALUE :: buf_values_len
639 : REAL(C_DOUBLE), INTENT(OUT), TARGET :: buf_values(1:buf_values_len)
640 :
641 : INTEGER :: ierr
642 : TYPE(active_space_type), POINTER :: active_space_env
643 : TYPE(f_env_type), POINTER :: f_env
644 :
645 0 : nelem = -1
646 0 : NULLIFY (f_env)
647 :
648 0 : CALL f_env_add_defaults(f_env_id, f_env)
649 :
650 : try: BLOCK
651 0 : CALL get_qs_env(f_env%force_env%qs_env, active_space=active_space_env)
652 :
653 0 : IF (.NOT. ASSOCIATED(active_space_env)) THEN
654 : EXIT try
655 : END IF
656 :
657 : ASSOCIATE (nze => active_space_env%eri%eri(1)%csr_mat%nze_total)
658 0 : IF (buf_coords_len < 4*nze .OR. buf_values_len < nze) THEN
659 : EXIT try
660 : END IF
661 :
662 0 : CALL active_space_env%eri%eri_foreach(1, active_space_env%active_orbitals, eri2array(buf_coords, buf_values))
663 :
664 0 : nelem = INT(nze, KIND(nelem))
665 : END ASSOCIATE
666 : END BLOCK try
667 :
668 0 : CALL f_env_rm_defaults(f_env, ierr)
669 0 : CPASSERT(ierr == 0)
670 0 : END FUNCTION cp2k_active_space_get_eri
671 :
672 : ! **************************************************************************************************
673 : !> \brief Copy the active space ERI to C buffers
674 : !> \param this Class pointer
675 : !> \param i The i index of the value `val`
676 : !> \param j The j index of the value `val`
677 : !> \param k The k index of the value `val`
678 : !> \param l The l index of the value `val`
679 : !> \param val The value at the given index
680 : !> \return Always true to continue with the loop
681 : !> \author Tiziano Mueller
682 : ! **************************************************************************************************
683 0 : LOGICAL FUNCTION eri2array_func(this, i, j, k, l, val) RESULT(cont)
684 : CLASS(eri2array), INTENT(inout) :: this
685 : INTEGER, INTENT(in) :: i, j, k, l
686 : REAL(KIND=dp), INTENT(in) :: val
687 :
688 0 : this%coords(4*(this%idx - 1) + 1) = i
689 0 : this%coords(4*(this%idx - 1) + 2) = j
690 0 : this%coords(4*(this%idx - 1) + 3) = k
691 0 : this%coords(4*(this%idx - 1) + 4) = l
692 0 : this%values(this%idx) = val
693 :
694 0 : this%idx = this%idx + 1
695 :
696 0 : cont = .TRUE.
697 0 : END FUNCTION eri2array_func
698 :
699 0 : END MODULE libcp2k
|
