LCOV - code coverage report
Current view: top level - src - hartree_local_types.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 84.1 % 44 37
Test Date: 2025-07-25 12:55:17 Functions: 66.7 % 9 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              : 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 => NULL(), Vh1_s => NULL()
      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 => NULL()
      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         1664 :    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         1664 :       IF (ASSOCIATED(ecoul_1c)) THEN
      65            0 :          CALL deallocate_ecoul_1center(ecoul_1c)
      66              :       END IF
      67              : 
      68        10668 :       ALLOCATE (ecoul_1c(natom))
      69              : 
      70         7340 :       DO iat = 1, natom
      71         5676 :          ALLOCATE (ecoul_1c(iat)%Vh1_h)
      72         5676 :          NULLIFY (ecoul_1c(iat)%Vh1_h%r_coef)
      73         5676 :          ALLOCATE (ecoul_1c(iat)%Vh1_s)
      74         7340 :          NULLIFY (ecoul_1c(iat)%Vh1_s%r_coef)
      75              :       END DO
      76              : 
      77         1664 :    END SUBROUTINE allocate_ecoul_1center
      78              : 
      79              : ! **************************************************************************************************
      80              : !> \brief ...
      81              : !> \param ecoul_1c ...
      82              : ! **************************************************************************************************
      83         1664 :    SUBROUTINE deallocate_ecoul_1center(ecoul_1c)
      84              : 
      85              :       TYPE(ecoul_1center_type), DIMENSION(:), POINTER    :: ecoul_1c
      86              : 
      87              :       INTEGER                                            :: iat, natom
      88              : 
      89         1664 :       natom = SIZE(ecoul_1c, 1)
      90              : 
      91         7340 :       DO iat = 1, natom
      92         5676 :          IF (ASSOCIATED(ecoul_1c(iat)%Vh1_h%r_coef)) THEN
      93            0 :             DEALLOCATE (ecoul_1c(iat)%Vh1_h%r_coef)
      94              :          END IF
      95         5676 :          DEALLOCATE (ecoul_1c(iat)%Vh1_h)
      96              : 
      97         5676 :          IF (ASSOCIATED(ecoul_1c(iat)%Vh1_s%r_coef)) THEN
      98            0 :             DEALLOCATE (ecoul_1c(iat)%Vh1_s%r_coef)
      99              :          END IF
     100         7340 :          DEALLOCATE (ecoul_1c(iat)%Vh1_s)
     101              : 
     102              :       END DO
     103              : 
     104         1664 :       DEALLOCATE (ecoul_1c)
     105              : 
     106         1664 :    END SUBROUTINE deallocate_ecoul_1center
     107              : 
     108              : ! **************************************************************************************************
     109              : !> \brief ...
     110              : !> \param hartree_local ...
     111              : !> \param ecoul_1c ...
     112              : ! **************************************************************************************************
     113        13746 :    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        13746 :       IF (PRESENT(ecoul_1c)) ecoul_1c => hartree_local%ecoul_1c
     120              : 
     121        13746 :    END SUBROUTINE get_hartree_local
     122              : 
     123              : ! **************************************************************************************************
     124              : !> \brief ...
     125              : !> \param hartree_local ...
     126              : ! **************************************************************************************************
     127         8240 :    SUBROUTINE hartree_local_create(hartree_local)
     128              : 
     129              :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     130              : 
     131         8240 :       ALLOCATE (hartree_local)
     132              : 
     133              :       NULLIFY (hartree_local%ecoul_1c)
     134              : 
     135         8240 :    END SUBROUTINE hartree_local_create
     136              : 
     137              : ! **************************************************************************************************
     138              : !> \brief ...
     139              : !> \param hartree_local ...
     140              : ! **************************************************************************************************
     141         8254 :    SUBROUTINE hartree_local_release(hartree_local)
     142              : 
     143              :       TYPE(hartree_local_type), POINTER                  :: hartree_local
     144              : 
     145         8254 :       IF (ASSOCIATED(hartree_local)) THEN
     146         8240 :          IF (ASSOCIATED(hartree_local%ecoul_1c)) THEN
     147         1664 :             CALL deallocate_ecoul_1center(hartree_local%ecoul_1c)
     148              :          END IF
     149              : 
     150         8240 :          DEALLOCATE (hartree_local)
     151              :       END IF
     152              : 
     153         8254 :    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        48170 :    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        48170 :       IF (PRESENT(iatom)) THEN
     172        48170 :          IF (PRESENT(ecoul_1_h)) ecoul_1c(iatom)%ecoul_1_h = ecoul_1_h
     173        48170 :          IF (PRESENT(ecoul_1_s)) ecoul_1c(iatom)%ecoul_1_s = ecoul_1_s
     174        48170 :          IF (PRESENT(ecoul_1_0)) ecoul_1c(iatom)%ecoul_1_0 = ecoul_1_0
     175        48170 :          IF (PRESENT(ecoul_1_z)) ecoul_1c(iatom)%ecoul_1_z = ecoul_1_z
     176              :       END IF
     177              : 
     178        48170 :    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              : 
        

Generated by: LCOV version 2.0-1