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             : !> \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, &
      38             :                                        use_bohr
      39             :       INTEGER                       :: shape_function_type
      40             :       INTEGER                       :: ref_charge, &
      41             :                                        radius_type
      42             :       TYPE(shape_fn), DIMENSION(:), &
      43             :          POINTER                    :: kind_shape_fn
      44             :       REAL(KIND=dp), DIMENSION(:), &
      45             :          POINTER                    :: charges
      46             :       TYPE(pw_r3d_rs_type), POINTER      :: fnorm
      47             :    END TYPE hirshfeld_type
      48             : 
      49             :    TYPE shape_fn
      50             :       INTEGER                       :: numexp
      51             :       REAL(KIND=dp), DIMENSION(:), &
      52             :          POINTER                    :: zet
      53             :       REAL(KIND=dp), DIMENSION(:), &
      54             :          POINTER                    :: coef
      55             :    END TYPE shape_fn
      56             : 
      57             : ! **************************************************************************************************
      58             : 
      59             : CONTAINS
      60             : 
      61             : ! **************************************************************************************************
      62             : !> \brief ...
      63             : !> \param hirshfeld_env ...
      64             : ! **************************************************************************************************
      65        4758 :    SUBROUTINE create_hirshfeld_type(hirshfeld_env)
      66             :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
      67             : 
      68        4758 :       IF (ASSOCIATED(hirshfeld_env)) THEN
      69           0 :          CALL release_hirshfeld_type(hirshfeld_env)
      70             :       END IF
      71             : 
      72        4758 :       ALLOCATE (hirshfeld_env)
      73             : 
      74        4758 :       hirshfeld_env%iterative = .FALSE.
      75        4758 :       hirshfeld_env%use_bohr = .FALSE.
      76        4758 :       hirshfeld_env%shape_function_type = shape_function_gaussian
      77        4758 :       hirshfeld_env%radius_type = radius_default
      78        4758 :       NULLIFY (hirshfeld_env%kind_shape_fn)
      79        4758 :       NULLIFY (hirshfeld_env%charges)
      80        4758 :       NULLIFY (hirshfeld_env%fnorm)
      81             : 
      82        4758 :    END SUBROUTINE create_hirshfeld_type
      83             : 
      84             : ! **************************************************************************************************
      85             : !> \brief ...
      86             : !> \param hirshfeld_env ...
      87             : ! **************************************************************************************************
      88       11364 :    SUBROUTINE release_hirshfeld_type(hirshfeld_env)
      89             :       TYPE(hirshfeld_type), POINTER                      :: hirshfeld_env
      90             : 
      91             :       INTEGER                                            :: ikind
      92       11364 :       TYPE(shape_fn), DIMENSION(:), POINTER              :: kind_shape
      93             : 
      94       11364 :       IF (ASSOCIATED(hirshfeld_env)) THEN
      95             : 
      96        4758 :          IF (ASSOCIATED(hirshfeld_env%kind_shape_fn)) THEN
      97        4668 :             kind_shape => hirshfeld_env%kind_shape_fn
      98       12772 :             DO ikind = 1, SIZE(kind_shape)
      99        8104 :                IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%zet)) THEN
     100        8104 :                   DEALLOCATE (kind_shape(ikind)%zet)
     101             :                END IF
     102       12772 :                IF (ASSOCIATED(hirshfeld_env%kind_shape_fn(ikind)%coef)) THEN
     103        8104 :                   DEALLOCATE (kind_shape(ikind)%coef)
     104             :                END IF
     105             :             END DO
     106        4668 :             DEALLOCATE (kind_shape)
     107             :          END IF
     108             : 
     109        4758 :          IF (ASSOCIATED(hirshfeld_env%charges)) THEN
     110        4508 :             DEALLOCATE (hirshfeld_env%charges)
     111             :          END IF
     112             : 
     113        4758 :          IF (ASSOCIATED(hirshfeld_env%fnorm)) THEN
     114        4486 :             CALL hirshfeld_env%fnorm%release()
     115        4486 :             DEALLOCATE (hirshfeld_env%fnorm)
     116             :          END IF
     117             : 
     118        4758 :          DEALLOCATE (hirshfeld_env)
     119             : 
     120             :       END IF
     121             : 
     122       11364 :    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        4594 :    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        4594 :       CPASSERT(ASSOCIATED(hirshfeld_env))
     146             : 
     147        4594 :       IF (PRESENT(shape_function_type)) THEN
     148           0 :          shape_function_type = hirshfeld_env%shape_function_type
     149             :       END IF
     150        4594 :       IF (PRESENT(iterative)) THEN
     151           0 :          iterative = hirshfeld_env%iterative
     152             :       END IF
     153        4594 :       IF (PRESENT(use_bohr)) THEN
     154           0 :          use_bohr = hirshfeld_env%use_bohr
     155             :       END IF
     156        4594 :       IF (PRESENT(radius_type)) THEN
     157           0 :          radius_type = hirshfeld_env%radius_type
     158             :       END IF
     159        4594 :       IF (PRESENT(ref_charge)) THEN
     160           0 :          ref_charge = hirshfeld_env%ref_charge
     161             :       END IF
     162        4594 :       IF (PRESENT(fnorm)) THEN
     163        4594 :          fnorm => hirshfeld_env%fnorm
     164             :       END IF
     165             : 
     166        4594 :    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        9352 :    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        9352 :       CPASSERT(ASSOCIATED(hirshfeld_env))
     190             : 
     191        9352 :       IF (PRESENT(shape_function_type)) THEN
     192        4758 :          hirshfeld_env%shape_function_type = shape_function_type
     193             :       END IF
     194        9352 :       IF (PRESENT(iterative)) THEN
     195        4758 :          hirshfeld_env%iterative = iterative
     196             :       END IF
     197        9352 :       IF (PRESENT(use_bohr)) THEN
     198         272 :          hirshfeld_env%use_bohr = use_bohr
     199             :       END IF
     200        9352 :       IF (PRESENT(radius_type)) THEN
     201        4758 :          hirshfeld_env%radius_type = radius_type
     202             :       END IF
     203        9352 :       IF (PRESENT(ref_charge)) THEN
     204        4486 :          hirshfeld_env%ref_charge = ref_charge
     205             :       END IF
     206        9352 :       IF (PRESENT(fnorm)) THEN
     207        4594 :          hirshfeld_env%fnorm => fnorm
     208             :       END IF
     209             : 
     210        9352 :    END SUBROUTINE set_hirshfeld_info
     211             : ! **************************************************************************************************
     212             : 
     213           0 : END MODULE hirshfeld_types