LCOV - code coverage report
Current view: top level - src - hirshfeld_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 87.5 % 56 49
Test Date: 2025-07-25 12:55:17 Functions: 66.7 % 6 4

            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              : !> \brief The types needed for the calculation of Hirshfeld charges and
      10              : !>        related functions
      11              : !> \par History
      12              : !>      11.2014 created [JGH]
      13              : !> \author JGH
      14              : ! **************************************************************************************************
      15              : MODULE hirshfeld_types
      16              : 
      17              :    USE input_constants,                 ONLY: radius_default,&
      18              :                                               shape_function_gaussian
      19              :    USE kinds,                           ONLY: dp
      20              :    USE pw_types,                        ONLY: pw_r3d_rs_type
      21              : #include "./base/base_uses.f90"
      22              : 
      23              :    IMPLICIT NONE
      24              :    PRIVATE
      25              : 
      26              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hirshfeld_types'
      27              : 
      28              :    PUBLIC :: hirshfeld_type
      29              :    PUBLIC :: create_hirshfeld_type, release_hirshfeld_type
      30              :    PUBLIC :: get_hirshfeld_info, set_hirshfeld_info
      31              : 
      32              : ! **************************************************************************************************
      33              : !> \brief quantities needed for a Hirshfeld based partitioning of real space
      34              : !> \author JGH
      35              : ! **************************************************************************************************
      36              :    TYPE hirshfeld_type
      37              :       LOGICAL                       :: iterative = .FALSE., &
      38              :                                        use_bohr = .FALSE.
      39              :       INTEGER                       :: shape_function_type = -1
      40              :       INTEGER                       :: ref_charge = -1, &
      41              :                                        radius_type = -1
      42              :       TYPE(shape_fn), DIMENSION(:), &
      43              :          POINTER                    :: kind_shape_fn => NULL()
      44              :       REAL(KIND=dp), DIMENSION(:), &
      45              :          POINTER                    :: charges => NULL()
      46              :       TYPE(pw_r3d_rs_type), POINTER      :: fnorm => NULL()
      47              :    END TYPE hirshfeld_type
      48              : 
      49              :    TYPE shape_fn
      50              :       INTEGER                       :: numexp = -1
      51              :       REAL(KIND=dp), DIMENSION(:), &
      52              :          POINTER                    :: zet => NULL()
      53              :       REAL(KIND=dp), DIMENSION(:), &
      54              :          POINTER                    :: coef => NULL()
      55              :    END TYPE shape_fn
      56              : 
      57              : ! **************************************************************************************************
      58              : 
      59              : CONTAINS
      60              : 
      61              : ! **************************************************************************************************
      62              : !> \brief ...
      63              : !> \param hirshfeld_env ...
      64              : ! **************************************************************************************************
      65         5050 :    SUBROUTINE create_hirshfeld_type(hirshfeld_env)
      66              :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
      67              : 
      68         5050 :       IF (ASSOCIATED(hirshfeld_env)) THEN
      69            0 :          CALL release_hirshfeld_type(hirshfeld_env)
      70              :       END IF
      71              : 
      72         5050 :       ALLOCATE (hirshfeld_env)
      73              : 
      74              :       hirshfeld_env%iterative = .FALSE.
      75              :       hirshfeld_env%use_bohr = .FALSE.
      76         5050 :       hirshfeld_env%shape_function_type = shape_function_gaussian
      77         5050 :       hirshfeld_env%radius_type = radius_default
      78              :       NULLIFY (hirshfeld_env%kind_shape_fn)
      79              :       NULLIFY (hirshfeld_env%charges)
      80              :       NULLIFY (hirshfeld_env%fnorm)
      81              : 
      82         5050 :    END SUBROUTINE create_hirshfeld_type
      83              : 
      84              : ! **************************************************************************************************
      85              : !> \brief ...
      86              : !> \param hirshfeld_env ...
      87              : ! **************************************************************************************************
      88        12510 :    SUBROUTINE release_hirshfeld_type(hirshfeld_env)
      89              :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
      90              : 
      91              :       INTEGER                                            :: ikind
      92        12510 :       TYPE(shape_fn), DIMENSION(:), POINTER              :: kind_shape
      93              : 
      94        12510 :       IF (ASSOCIATED(hirshfeld_env)) THEN
      95              : 
      96         5050 :          IF (ASSOCIATED(hirshfeld_env%kind_shape_fn)) THEN
      97         4960 :             kind_shape => hirshfeld_env%kind_shape_fn
      98        13602 :             DO ikind = 1, SIZE(kind_shape)
      99         8642 :                IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%zet)) THEN
     100         8642 :                   DEALLOCATE (kind_shape(ikind)%zet)
     101              :                END IF
     102        13602 :                IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%coef)) THEN
     103         8642 :                   DEALLOCATE (kind_shape(ikind)%coef)
     104              :                END IF
     105              :             END DO
     106         4960 :             DEALLOCATE (kind_shape)
     107              :          END IF
     108              : 
     109         5050 :          IF (ASSOCIATED(hirshfeld_env%charges)) THEN
     110         4800 :             DEALLOCATE (hirshfeld_env%charges)
     111              :          END IF
     112              : 
     113         5050 :          IF (ASSOCIATED(hirshfeld_env%fnorm)) THEN
     114         4778 :             CALL hirshfeld_env%fnorm%release()
     115         4778 :             DEALLOCATE (hirshfeld_env%fnorm)
     116              :          END IF
     117              : 
     118         5050 :          DEALLOCATE (hirshfeld_env)
     119              : 
     120              :       END IF
     121              : 
     122        12510 :    END SUBROUTINE release_hirshfeld_type
     123              : 
     124              : ! **************************************************************************************************
     125              : !> \brief Get information from a Hirshfeld env
     126              : !> \param hirshfeld_env the env that holds the information
     127              : !> \param shape_function_type the type of shape function used
     128              : !> \param iterative logical which determines if iterative Hirshfeld charges should be computed
     129              : !> \param ref_charge the reference charge type (core charge or mulliken)
     130              : !> \param fnorm normalization of the shape function
     131              : !> \param radius_type the type of radius used for building the shape functions
     132              : !> \param use_bohr logical which determines if angstrom or bohr units are used to build the
     133              : !>                 shape functions
     134              : ! **************************************************************************************************
     135         4886 :    SUBROUTINE get_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, &
     136              :                                  ref_charge, fnorm, radius_type, use_bohr)
     137              :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
     138              :       INTEGER, INTENT(OUT), OPTIONAL                     :: shape_function_type
     139              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: iterative
     140              :       INTEGER, INTENT(OUT), OPTIONAL                     :: ref_charge
     141              :       TYPE(pw_r3d_rs_type), OPTIONAL, POINTER            :: fnorm
     142              :       INTEGER, INTENT(OUT), OPTIONAL                     :: radius_type
     143              :       LOGICAL, INTENT(OUT), OPTIONAL                     :: use_bohr
     144              : 
     145         4886 :       CPASSERT(ASSOCIATED(hirshfeld_env))
     146              : 
     147         4886 :       IF (PRESENT(shape_function_type)) THEN
     148            0 :          shape_function_type = hirshfeld_env%shape_function_type
     149              :       END IF
     150         4886 :       IF (PRESENT(iterative)) THEN
     151            0 :          iterative = hirshfeld_env%iterative
     152              :       END IF
     153         4886 :       IF (PRESENT(use_bohr)) THEN
     154            0 :          use_bohr = hirshfeld_env%use_bohr
     155              :       END IF
     156         4886 :       IF (PRESENT(radius_type)) THEN
     157            0 :          radius_type = hirshfeld_env%radius_type
     158              :       END IF
     159         4886 :       IF (PRESENT(ref_charge)) THEN
     160            0 :          ref_charge = hirshfeld_env%ref_charge
     161              :       END IF
     162         4886 :       IF (PRESENT(fnorm)) THEN
     163         4886 :          fnorm => hirshfeld_env%fnorm
     164              :       END IF
     165              : 
     166         4886 :    END SUBROUTINE get_hirshfeld_info
     167              : 
     168              : ! **************************************************************************************************
     169              : !> \brief Set values of a Hirshfeld env
     170              : !> \param hirshfeld_env the env that holds the information
     171              : !> \param shape_function_type the type of shape function used
     172              : !> \param iterative logical which determines if iterative Hirshfeld charges should be computed
     173              : !> \param ref_charge the reference charge type (core charge or mulliken)
     174              : !> \param fnorm normalization of the shape function
     175              : !> \param radius_type the type of radius used for building the shape functions
     176              : !> \param use_bohr logical which determines if angstrom or bohr units are used to build the
     177              : !>                 shape functions
     178              : ! **************************************************************************************************
     179         9936 :    SUBROUTINE set_hirshfeld_info(hirshfeld_env, shape_function_type, iterative, &
     180              :                                  ref_charge, fnorm, radius_type, use_bohr)
     181              :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
     182              :       INTEGER, INTENT(IN), OPTIONAL                      :: shape_function_type
     183              :       LOGICAL, INTENT(IN), OPTIONAL                      :: iterative
     184              :       INTEGER, INTENT(IN), OPTIONAL                      :: ref_charge
     185              :       TYPE(pw_r3d_rs_type), OPTIONAL, POINTER            :: fnorm
     186              :       INTEGER, INTENT(IN), OPTIONAL                      :: radius_type
     187              :       LOGICAL, INTENT(IN), OPTIONAL                      :: use_bohr
     188              : 
     189         9936 :       CPASSERT(ASSOCIATED(hirshfeld_env))
     190              : 
     191         9936 :       IF (PRESENT(shape_function_type)) THEN
     192         5050 :          hirshfeld_env%shape_function_type = shape_function_type
     193              :       END IF
     194         9936 :       IF (PRESENT(iterative)) THEN
     195         5050 :          hirshfeld_env%iterative = iterative
     196              :       END IF
     197         9936 :       IF (PRESENT(use_bohr)) THEN
     198          272 :          hirshfeld_env%use_bohr = use_bohr
     199              :       END IF
     200         9936 :       IF (PRESENT(radius_type)) THEN
     201         5050 :          hirshfeld_env%radius_type = radius_type
     202              :       END IF
     203         9936 :       IF (PRESENT(ref_charge)) THEN
     204         4778 :          hirshfeld_env%ref_charge = ref_charge
     205              :       END IF
     206         9936 :       IF (PRESENT(fnorm)) THEN
     207         4886 :          hirshfeld_env%fnorm => fnorm
     208              :       END IF
     209              : 
     210         9936 :    END SUBROUTINE set_hirshfeld_info
     211              : ! **************************************************************************************************
     212              : 
     213            0 : END MODULE hirshfeld_types
        

Generated by: LCOV version 2.0-1