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