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 qs_rho_atom_types
       9             : 
      10             :    USE kinds,                           ONLY: dp
      11             : #include "./base/base_uses.f90"
      12             : 
      13             :    IMPLICIT NONE
      14             : 
      15             :    PRIVATE
      16             : 
      17             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_atom_types'
      18             : 
      19             :    TYPE rho_atom_coeff
      20             :       REAL(dp), DIMENSION(:, :), POINTER :: r_coef => NULL()
      21             :    END TYPE rho_atom_coeff
      22             : 
      23             :    TYPE rho_atom_type
      24             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: cpc_h => NULL()
      25             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: cpc_s => NULL()
      26             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: rho_rad_h => NULL()
      27             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: rho_rad_s => NULL()
      28             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: vrho_rad_h => NULL()
      29             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: vrho_rad_s => NULL()
      30             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: drho_rad_h => NULL()
      31             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: drho_rad_s => NULL()
      32             :       TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER  :: rho_rad_h_d => NULL()
      33             :       TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER  :: rho_rad_s_d => NULL()
      34             :       INTEGER                                         :: rhoa_of_atom = -1
      35             :       REAL(dp)                                        :: exc_h = 0.0_dp
      36             :       REAL(dp)                                        :: exc_s = 0.0_dp
      37             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: ga_Vlocal_gb_h => NULL()
      38             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: ga_Vlocal_gb_s => NULL()
      39             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: int_scr_h => NULL()
      40             :       TYPE(rho_atom_coeff), DIMENSION(:), POINTER     :: int_scr_s => NULL()
      41             :    END TYPE rho_atom_type
      42             : 
      43             :    TYPE rho_atom_p_type
      44             :       TYPE(rho_atom_type), POINTER :: rho_atom => NULL()
      45             :    END TYPE rho_atom_p_type
      46             : 
      47             :    PUBLIC :: deallocate_rho_atom_set, get_rho_atom, rho_atom_coeff, rho_atom_type, &
      48             :              zero_rho_atom_integrals
      49             : 
      50             : CONTAINS
      51             : 
      52             : ! **************************************************************************************************
      53             : !> \brief ...
      54             : !> \param rho_atom_set ...
      55             : ! **************************************************************************************************
      56        2616 :    SUBROUTINE deallocate_rho_atom_set(rho_atom_set)
      57             : 
      58             :       TYPE(rho_atom_type), DIMENSION(:), POINTER         :: rho_atom_set
      59             : 
      60             :       INTEGER                                            :: i, iat, j, n, natom
      61             : 
      62        2616 :       IF (ASSOCIATED(rho_atom_set)) THEN
      63             : 
      64        2616 :          natom = SIZE(rho_atom_set)
      65             : 
      66       11326 :          DO iat = 1, natom
      67        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%cpc_h)) THEN
      68        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%cpc_h(1)%r_coef)) THEN
      69        7504 :                   n = SIZE(rho_atom_set(iat)%cpc_h, 1)
      70       16102 :                   DO i = 1, n
      71        8598 :                      DEALLOCATE (rho_atom_set(iat)%cpc_h(i)%r_coef)
      72       16102 :                      DEALLOCATE (rho_atom_set(iat)%cpc_s(i)%r_coef)
      73             :                   END DO
      74             :                END IF
      75        8710 :                DEALLOCATE (rho_atom_set(iat)%cpc_h)
      76        8710 :                DEALLOCATE (rho_atom_set(iat)%cpc_s)
      77             :             END IF
      78        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
      79        4355 :                IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
      80        3752 :                   n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
      81        8051 :                   DO i = 1, n
      82        4299 :                      DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef)
      83        8051 :                      DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef)
      84             :                   END DO
      85             :                END IF
      86        4355 :                DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h)
      87        4355 :                DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s)
      88             :             END IF
      89        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h)) THEN
      90        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h(1)%r_coef)) THEN
      91        7504 :                   n = SIZE(rho_atom_set(iat)%int_scr_h, 1)
      92       16102 :                   DO i = 1, n
      93        8598 :                      DEALLOCATE (rho_atom_set(iat)%int_scr_h(i)%r_coef)
      94       16102 :                      DEALLOCATE (rho_atom_set(iat)%int_scr_s(i)%r_coef)
      95             :                   END DO
      96             :                END IF
      97        8710 :                DEALLOCATE (rho_atom_set(iat)%int_scr_h)
      98        8710 :                DEALLOCATE (rho_atom_set(iat)%int_scr_s)
      99             :             END IF
     100             : 
     101        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h)) THEN
     102        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h(1)%r_coef)) THEN
     103        3622 :                   n = SIZE(rho_atom_set(iat)%drho_rad_h, 1)
     104        7736 :                   DO i = 1, n
     105        4114 :                      DEALLOCATE (rho_atom_set(iat)%drho_rad_h(i)%r_coef)
     106        4114 :                      DEALLOCATE (rho_atom_set(iat)%drho_rad_s(i)%r_coef)
     107       20078 :                      DO j = 1, 3
     108       12342 :                         DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d(j, i)%r_coef)
     109       16456 :                         DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d(j, i)%r_coef)
     110             :                      END DO
     111             :                   END DO
     112             :                END IF
     113        8710 :                DEALLOCATE (rho_atom_set(iat)%drho_rad_h)
     114        8710 :                DEALLOCATE (rho_atom_set(iat)%drho_rad_s)
     115        8710 :                DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d)
     116        8710 :                DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d)
     117             :             END IF
     118             : 
     119        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h)) THEN
     120        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h(1)%r_coef)) THEN
     121        3622 :                   n = SIZE(rho_atom_set(iat)%rho_rad_h)
     122        7736 :                   DO i = 1, n
     123        7736 :                      DEALLOCATE (rho_atom_set(iat)%rho_rad_h(i)%r_coef)
     124             :                   END DO
     125             :                END IF
     126        8710 :                DEALLOCATE (rho_atom_set(iat)%rho_rad_h)
     127             :             END IF
     128             : 
     129        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s)) THEN
     130        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s(1)%r_coef)) THEN
     131        3622 :                   n = SIZE(rho_atom_set(iat)%rho_rad_s)
     132        7736 :                   DO i = 1, n
     133        7736 :                      DEALLOCATE (rho_atom_set(iat)%rho_rad_s(i)%r_coef)
     134             :                   END DO
     135             :                END IF
     136        8710 :                DEALLOCATE (rho_atom_set(iat)%rho_rad_s)
     137             :             END IF
     138             : 
     139        8710 :             IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h)) THEN
     140        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h(1)%r_coef)) THEN
     141        3622 :                   n = SIZE(rho_atom_set(iat)%vrho_rad_h)
     142        7736 :                   DO i = 1, n
     143        7736 :                      DEALLOCATE (rho_atom_set(iat)%vrho_rad_h(i)%r_coef)
     144             :                   END DO
     145             :                END IF
     146        8710 :                DEALLOCATE (rho_atom_set(iat)%vrho_rad_h)
     147             :             END IF
     148             : 
     149       11326 :             IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s)) THEN
     150        8710 :                IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s(1)%r_coef)) THEN
     151        3622 :                   n = SIZE(rho_atom_set(iat)%vrho_rad_s)
     152        7736 :                   DO i = 1, n
     153        7736 :                      DEALLOCATE (rho_atom_set(iat)%vrho_rad_s(i)%r_coef)
     154             :                   END DO
     155             :                END IF
     156        8710 :                DEALLOCATE (rho_atom_set(iat)%vrho_rad_s)
     157             :             END IF
     158             : 
     159             :          END DO
     160             : 
     161        2616 :          DEALLOCATE (rho_atom_set)
     162             : 
     163             :       ELSE
     164             : 
     165             :          CALL cp_abort(__LOCATION__, &
     166             :                        "The pointer rho_atom_set is not associated and "// &
     167           0 :                        "cannot be deallocated")
     168             : 
     169             :       END IF
     170             : 
     171        2616 :    END SUBROUTINE deallocate_rho_atom_set
     172             : 
     173             : ! **************************************************************************************************
     174             : !> \brief ...
     175             : !> \param rho_atom ...
     176             : !> \param cpc_h ...
     177             : !> \param cpc_s ...
     178             : !> \param rho_rad_h ...
     179             : !> \param rho_rad_s ...
     180             : !> \param drho_rad_h ...
     181             : !> \param drho_rad_s ...
     182             : !> \param vrho_rad_h ...
     183             : !> \param vrho_rad_s ...
     184             : !> \param rho_rad_h_d ...
     185             : !> \param rho_rad_s_d ...
     186             : !> \param ga_Vlocal_gb_h ...
     187             : !> \param ga_Vlocal_gb_s ...
     188             : !> \param int_scr_h ...
     189             : !> \param int_scr_s ...
     190             : ! **************************************************************************************************
     191     4822840 :    SUBROUTINE get_rho_atom(rho_atom, cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
     192             :                            drho_rad_h, drho_rad_s, vrho_rad_h, vrho_rad_s, &
     193             :                            rho_rad_h_d, rho_rad_s_d, ga_Vlocal_gb_h, ga_Vlocal_gb_s, &
     194             :                            int_scr_h, int_scr_s)
     195             : 
     196             :       TYPE(rho_atom_type), INTENT(IN), POINTER           :: rho_atom
     197             :       TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
     198             :          POINTER                                         :: cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
     199             :                                                             drho_rad_h, drho_rad_s, vrho_rad_h, &
     200             :                                                             vrho_rad_s
     201             :       TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
     202             :          POINTER                                         :: rho_rad_h_d, rho_rad_s_d
     203             :       TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
     204             :          POINTER                                         :: ga_Vlocal_gb_h, ga_Vlocal_gb_s, &
     205             :                                                             int_scr_h, int_scr_s
     206             : 
     207     4822840 :       IF (ASSOCIATED(rho_atom)) THEN
     208     4822840 :          IF (PRESENT(cpc_h)) cpc_h => rho_atom%cpc_h
     209     4822840 :          IF (PRESENT(cpc_s)) cpc_s => rho_atom%cpc_s
     210     4822840 :          IF (PRESENT(rho_rad_h)) rho_rad_h => rho_atom%rho_rad_h
     211     4822840 :          IF (PRESENT(rho_rad_s)) rho_rad_s => rho_atom%rho_rad_s
     212     4822840 :          IF (PRESENT(drho_rad_h)) drho_rad_h => rho_atom%drho_rad_h
     213     4822840 :          IF (PRESENT(drho_rad_s)) drho_rad_s => rho_atom%drho_rad_s
     214     4822840 :          IF (PRESENT(rho_rad_h_d)) rho_rad_h_d => rho_atom%rho_rad_h_d
     215     4822840 :          IF (PRESENT(rho_rad_s_d)) rho_rad_s_d => rho_atom%rho_rad_s_d
     216     4822840 :          IF (PRESENT(vrho_rad_h)) vrho_rad_h => rho_atom%vrho_rad_h
     217     4822840 :          IF (PRESENT(vrho_rad_s)) vrho_rad_s => rho_atom%vrho_rad_s
     218     4822840 :          IF (PRESENT(ga_Vlocal_gb_h)) ga_Vlocal_gb_h => rho_atom%ga_Vlocal_gb_h
     219     4822840 :          IF (PRESENT(ga_Vlocal_gb_s)) ga_Vlocal_gb_s => rho_atom%ga_Vlocal_gb_s
     220     4822840 :          IF (PRESENT(int_scr_h)) int_scr_h => rho_atom%int_scr_h
     221     4822840 :          IF (PRESENT(int_scr_s)) int_scr_s => rho_atom%int_scr_s
     222             :       ELSE
     223           0 :          CPABORT("The pointer rho_atom is not associated")
     224             :       END IF
     225             : 
     226     4822840 :    END SUBROUTINE get_rho_atom
     227             : 
     228             : ! **************************************************************************************************
     229             : !> \brief ...
     230             : !> \param rho_atom_set ...
     231             : ! **************************************************************************************************
     232          20 :    SUBROUTINE zero_rho_atom_integrals(rho_atom_set)
     233             :       TYPE(rho_atom_type), DIMENSION(:), POINTER         :: rho_atom_set
     234             : 
     235             :       INTEGER                                            :: i, iat, n, natom
     236             : 
     237          20 :       IF (ASSOCIATED(rho_atom_set)) THEN
     238          20 :          natom = SIZE(rho_atom_set)
     239          80 :          DO iat = 1, natom
     240          60 :             IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
     241          30 :                IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
     242          30 :                   n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
     243          60 :                   DO i = 1, n
     244       28700 :                      rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef = 0.0_dp
     245             :                   END DO
     246             :                END IF
     247             :             END IF
     248          80 :             IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s)) THEN
     249          30 :                IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s(1)%r_coef)) THEN
     250          30 :                   n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_s, 1)
     251          60 :                   DO i = 1, n
     252       28700 :                      rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef = 0.0_dp
     253             :                   END DO
     254             :                END IF
     255             :             END IF
     256             :          END DO
     257             :       END IF
     258          20 :    END SUBROUTINE zero_rho_atom_integrals
     259             : 
     260           0 : END MODULE qs_rho_atom_types