LCOV - code coverage report
Current view: top level - src/start - libcp2k.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 17.0 % 194 33
Test Date: 2025-07-25 12:55:17 Functions: 20.0 % 30 6

            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
      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            0 :       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            0 :       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            0 :       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
        

Generated by: LCOV version 2.0-1