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