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             : MODULE hartree_local_types
       9             : 
      10             :    USE kinds,                           ONLY: dp
      11             :    USE qs_rho_atom_types,               ONLY: rho_atom_coeff
      12             : #include "./base/base_uses.f90"
      13             : 
      14             :    IMPLICIT NONE
      15             : 
      16             :    PRIVATE
      17             : 
      18             : ! *** Global parameters (only in this module)
      19             : 
      20             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hartree_local_types'
      21             : 
      22             : ! *** Define the ecoul_1center_type ***
      23             : 
      24             : ! **************************************************************************************************
      25             :    TYPE ecoul_1center_type
      26             :       TYPE(rho_atom_coeff), POINTER   :: Vh1_h, Vh1_s
      27             :       REAL(dp)                        :: ecoul_1_h = 0.0_dp, &
      28             :                                          ecoul_1_s = 0.0_dp, &
      29             :                                          ecoul_1_z = 0.0_dp, &
      30             :                                          ecoul_1_0 = 0.0_dp
      31             :    END TYPE ecoul_1center_type
      32             : 
      33             : ! **************************************************************************************************
      34             :    TYPE hartree_local_type
      35             :       TYPE(ecoul_1center_type), &
      36             :          DIMENSION(:), POINTER   :: ecoul_1c
      37             :    END TYPE hartree_local_type
      38             : 
      39             : ! *** Public subroutines ***
      40             : 
      41             :    PUBLIC :: allocate_ecoul_1center, &
      42             :              get_hartree_local, hartree_local_create, &
      43             :              hartree_local_release, set_ecoul_1c, &
      44             :              set_hartree_local
      45             : 
      46             : ! *** Public data types ***
      47             : 
      48             :    PUBLIC :: ecoul_1center_type, hartree_local_type
      49             : 
      50             : CONTAINS
      51             : 
      52             : ! **************************************************************************************************
      53             : !> \brief ...
      54             : !> \param ecoul_1c ...
      55             : !> \param natom ...
      56             : ! **************************************************************************************************
      57        1602 :    SUBROUTINE allocate_ecoul_1center(ecoul_1c, natom)
      58             : 
      59             :       TYPE(ecoul_1center_type), DIMENSION(:), POINTER    :: ecoul_1c
      60             :       INTEGER, INTENT(IN)                                :: natom
      61             : 
      62             :       INTEGER                                            :: iat
      63             : 
      64        1602 :       IF (ASSOCIATED(ecoul_1c)) THEN
      65           0 :          CALL deallocate_ecoul_1center(ecoul_1c)
      66             :       END IF
      67             : 
      68       10324 :       ALLOCATE (ecoul_1c(natom))
      69             : 
      70        7120 :       DO iat = 1, natom
      71        5518 :          ALLOCATE (ecoul_1c(iat)%Vh1_h)
      72        5518 :          NULLIFY (ecoul_1c(iat)%Vh1_h%r_coef)
      73        5518 :          ALLOCATE (ecoul_1c(iat)%Vh1_s)
      74        7120 :          NULLIFY (ecoul_1c(iat)%Vh1_s%r_coef)
      75             :       END DO
      76             : 
      77        1602 :    END SUBROUTINE allocate_ecoul_1center
      78             : 
      79             : ! **************************************************************************************************
      80             : !> \brief ...
      81             : !> \param ecoul_1c ...
      82             : ! **************************************************************************************************
      83        1602 :    SUBROUTINE deallocate_ecoul_1center(ecoul_1c)
      84             : 
      85             :       TYPE(ecoul_1center_type), DIMENSION(:), POINTER    :: ecoul_1c
      86             : 
      87             :       INTEGER                                            :: iat, natom
      88             : 
      89        1602 :       natom = SIZE(ecoul_1c, 1)
      90             : 
      91        7120 :       DO iat = 1, natom
      92        5518 :          IF (ASSOCIATED(ecoul_1c(iat)%Vh1_h%r_coef)) THEN
      93           0 :             DEALLOCATE (ecoul_1c(iat)%Vh1_h%r_coef)
      94             :          END IF
      95        5518 :          DEALLOCATE (ecoul_1c(iat)%Vh1_h)
      96             : 
      97        5518 :          IF (ASSOCIATED(ecoul_1c(iat)%Vh1_s%r_coef)) THEN
      98           0 :             DEALLOCATE (ecoul_1c(iat)%Vh1_s%r_coef)
      99             :          END IF
     100        7120 :          DEALLOCATE (ecoul_1c(iat)%Vh1_s)
     101             : 
     102             :       END DO
     103             : 
     104        1602 :       DEALLOCATE (ecoul_1c)
     105             : 
     106        1602 :    END SUBROUTINE deallocate_ecoul_1center
     107             : 
     108             : ! **************************************************************************************************
     109             : !> \brief ...
     110             : !> \param hartree_local ...
     111             : !> \param ecoul_1c ...
     112             : ! **************************************************************************************************
     113       12998 :    SUBROUTINE get_hartree_local(hartree_local, ecoul_1c)
     114             : 
     115             :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     116             :       TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, &
     117             :          POINTER                                         :: ecoul_1c
     118             : 
     119       12998 :       IF (PRESENT(ecoul_1c)) ecoul_1c => hartree_local%ecoul_1c
     120             : 
     121       12998 :    END SUBROUTINE get_hartree_local
     122             : 
     123             : ! **************************************************************************************************
     124             : !> \brief ...
     125             : !> \param hartree_local ...
     126             : ! **************************************************************************************************
     127        7346 :    SUBROUTINE hartree_local_create(hartree_local)
     128             : 
     129             :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     130             : 
     131        7346 :       ALLOCATE (hartree_local)
     132             : 
     133        7346 :       NULLIFY (hartree_local%ecoul_1c)
     134             : 
     135        7346 :    END SUBROUTINE hartree_local_create
     136             : 
     137             : ! **************************************************************************************************
     138             : !> \brief ...
     139             : !> \param hartree_local ...
     140             : ! **************************************************************************************************
     141        7360 :    SUBROUTINE hartree_local_release(hartree_local)
     142             : 
     143             :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     144             : 
     145        7360 :       IF (ASSOCIATED(hartree_local)) THEN
     146        7346 :          IF (ASSOCIATED(hartree_local%ecoul_1c)) THEN
     147        1602 :             CALL deallocate_ecoul_1center(hartree_local%ecoul_1c)
     148             :          END IF
     149             : 
     150        7346 :          DEALLOCATE (hartree_local)
     151             :       END IF
     152             : 
     153        7360 :    END SUBROUTINE hartree_local_release
     154             : 
     155             : ! **************************************************************************************************
     156             : !> \brief ...
     157             : !> \param ecoul_1c ...
     158             : !> \param iatom ...
     159             : !> \param ecoul_1_h ...
     160             : !> \param ecoul_1_s ...
     161             : !> \param ecoul_1_z ...
     162             : !> \param ecoul_1_0 ...
     163             : ! **************************************************************************************************
     164       45846 :    SUBROUTINE set_ecoul_1c(ecoul_1c, iatom, ecoul_1_h, ecoul_1_s, ecoul_1_z, ecoul_1_0)
     165             : 
     166             :       TYPE(ecoul_1center_type), DIMENSION(:), POINTER    :: ecoul_1c
     167             :       INTEGER, INTENT(IN), OPTIONAL                      :: iatom
     168             :       REAL(dp), INTENT(IN), OPTIONAL                     :: ecoul_1_h, ecoul_1_s, ecoul_1_z, &
     169             :                                                             ecoul_1_0
     170             : 
     171       45846 :       IF (PRESENT(iatom)) THEN
     172       45846 :          IF (PRESENT(ecoul_1_h)) ecoul_1c(iatom)%ecoul_1_h = ecoul_1_h
     173       45846 :          IF (PRESENT(ecoul_1_s)) ecoul_1c(iatom)%ecoul_1_s = ecoul_1_s
     174       45846 :          IF (PRESENT(ecoul_1_0)) ecoul_1c(iatom)%ecoul_1_0 = ecoul_1_0
     175       45846 :          IF (PRESENT(ecoul_1_z)) ecoul_1c(iatom)%ecoul_1_z = ecoul_1_z
     176             :       END IF
     177             : 
     178       45846 :    END SUBROUTINE set_ecoul_1c
     179             : 
     180             : ! **************************************************************************************************
     181             : !> \brief ...
     182             : !> \param hartree_local ...
     183             : !> \param ecoul_1c ...
     184             : ! **************************************************************************************************
     185           0 :    SUBROUTINE set_hartree_local(hartree_local, ecoul_1c)
     186             : 
     187             :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     188             :       TYPE(ecoul_1center_type), DIMENSION(:), OPTIONAL, &
     189             :          POINTER                                         :: ecoul_1c
     190             : 
     191           0 :       IF (PRESENT(ecoul_1c)) hartree_local%ecoul_1c => ecoul_1c
     192             : 
     193           0 :    END SUBROUTINE set_hartree_local
     194             : 
     195           0 : END MODULE hartree_local_types
     196             :