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