(git:58e3e09)
qs_p_env_types.F
Go to the documentation of this file.
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 basis types for the calculation of the perturbation of density theory.
10 !> \par History
11 !> 4.2002 created [fawzi]
12 !> \author Fawzi Mohamed
13 ! **************************************************************************************************
16  USE cp_fm_types, ONLY: cp_fm_release,&
17  cp_fm_type
18  USE dbcsr_api, ONLY: dbcsr_p_type
20  hartree_local_type
22  preconditioner_type
23  USE qs_kpp1_env_types, ONLY: kpp1_release,&
24  qs_kpp1_env_type
26  local_rho_type
27  USE qs_rho_types, ONLY: qs_rho_release,&
28  qs_rho_type
29 #include "./base/base_uses.f90"
30 
31  IMPLICIT NONE
32  PRIVATE
33  PUBLIC :: qs_p_env_type
34  PUBLIC :: p_env_release
35 
36  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
37  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_p_env_types'
38 
39 ! **************************************************************************************************
40 !> \brief Represent a qs system that is perturbed.
41 !> Can calculate the linear operator and the rhs of the system
42 !> of equations that needs to be solved for the perturbation.
43 !> \param orthogonal_orbitals if the orbitals are orthogonal
44 !> \param kpp 1: the kpp1 matrix (make it temporary?)
45 !> \param kpp1_admm: collects the parts in auxiliary basis, they have to be added to kpp1 later
46 !> \param m_epsilon minus epsilon: -<psi0d|H_rho|psi0d>
47 !> \param psi 0d: the dual basis of psi0: psi0 (psi0^T S psi0)^-1
48 !> \param S_psi 0: S times psi0, cached for performance reasons
49 !> \param Smo_inv inverse of the mo overlap: (psi0^T S psi0)^-1
50 !> \param rho 1: the density rho1
51 !> \param rho 1: the soft density rho1 for gapw_xc
52 !> \param rho 1_admm: density rho1 in auxiliary basis (for ADMM)
53 !> \param n_mo cached number of mo: n_mo(i)=qs_env%c(i)%nmo
54 !> \param n_ao cached number of ao: n_ao(i)=qs_env%c(i)%nao
55 !> \note
56 !> for the moment no smearing of the orbitals.
57 ! **************************************************************************************************
58  TYPE qs_p_env_type
59  LOGICAL :: orthogonal_orbitals
60  TYPE(qs_kpp1_env_type), POINTER :: kpp1_env => null()
61  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: kpp1 => null()
62  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: kpp1_admm => null()
63  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p1 => null()
64  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p1_admm => null()
65  TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: w1 => null()
66  TYPE(cp_fm_type), DIMENSION(:), POINTER :: m_epsilon => null()
67  TYPE(cp_fm_type), DIMENSION(:), POINTER :: psi0d => null()
68  TYPE(cp_fm_type), DIMENSION(:), POINTER :: S_psi0 => null()
69  TYPE(cp_fm_type), DIMENSION(:), POINTER :: Smo_inv => null()
70  TYPE(qs_rho_type), POINTER :: rho1 => null()
71  TYPE(qs_rho_type), POINTER :: rho1_xc => null()
72  TYPE(qs_rho_type), POINTER :: rho1_admm => null()
73  INTEGER, DIMENSION(2) :: n_mo, & ! no of molecular orbitals
74  n_ao ! no of basis functions
75  ! GAPW stuff
76  TYPE(hartree_local_type), POINTER :: hartree_local => null()
77  TYPE(local_rho_type), POINTER :: local_rho_set => null()
78  TYPE(local_rho_type), POINTER :: local_rho_set_admm => null()
79 
80  ! Linear Response Modules
81  TYPE(cp_fm_type), DIMENSION(:), POINTER :: PS_psi0 => null()
82 
83  ! preconditioner matrix should be symmetric and positive definite
84  LOGICAL :: new_preconditioner
85  TYPE(preconditioner_type), DIMENSION(:), POINTER :: preconditioner => null()
86 
87  END TYPE qs_p_env_type
88 
89 CONTAINS
90 
91 ! **************************************************************************************************
92 !> \brief relases the given p_env (see doc/ReferenceCounting.html)
93 !> \param p_env the environment to release
94 !> \par History
95 !> 07.2002 created [fawzi]
96 !> \author Fawzi Mohamed
97 ! **************************************************************************************************
98  SUBROUTINE p_env_release(p_env)
99 
100  TYPE(qs_p_env_type) :: p_env
101 
102  INTEGER :: ip
103 
104  IF (ASSOCIATED(p_env%kpp1_env)) THEN
105  CALL kpp1_release(p_env%kpp1_env)
106  DEALLOCATE (p_env%kpp1_env)
107  NULLIFY (p_env%kpp1_env)
108  END IF
109  CALL cp_fm_release(p_env%S_psi0)
110  CALL cp_fm_release(p_env%m_epsilon)
111  CALL cp_fm_release(p_env%psi0d)
112  CALL cp_fm_release(p_env%Smo_inv)
113  IF (ASSOCIATED(p_env%rho1_xc)) THEN
114  CALL qs_rho_release(p_env%rho1_xc)
115  DEALLOCATE (p_env%rho1_xc)
116  END IF
117  IF (ASSOCIATED(p_env%rho1)) THEN
118  CALL qs_rho_release(p_env%rho1)
119  DEALLOCATE (p_env%rho1)
120  END IF
121  IF (ASSOCIATED(p_env%rho1_admm)) THEN
122  CALL qs_rho_release(p_env%rho1_admm)
123  DEALLOCATE (p_env%rho1_admm)
124  END IF
125  IF (ASSOCIATED(p_env%kpp1)) CALL dbcsr_deallocate_matrix_set(p_env%kpp1)
126  IF (ASSOCIATED(p_env%kpp1_admm)) CALL dbcsr_deallocate_matrix_set(p_env%kpp1_admm)
127  IF (ASSOCIATED(p_env%p1)) CALL dbcsr_deallocate_matrix_set(p_env%p1)
128  IF (ASSOCIATED(p_env%w1)) CALL dbcsr_deallocate_matrix_set(p_env%w1)
129  IF (ASSOCIATED(p_env%p1_admm)) CALL dbcsr_deallocate_matrix_set(p_env%p1_admm)
130  IF (ASSOCIATED(p_env%local_rho_set)) THEN
131  CALL local_rho_set_release(p_env%local_rho_set)
132  END IF
133  IF (ASSOCIATED(p_env%hartree_local)) THEN
134  CALL hartree_local_release(p_env%hartree_local)
135  END IF
136  IF (ASSOCIATED(p_env%local_rho_set_admm)) THEN
137  CALL local_rho_set_release(p_env%local_rho_set_admm)
138  END IF
139  IF (ASSOCIATED(p_env%PS_psi0)) THEN
140  CALL cp_fm_release(p_env%PS_psi0)
141  END IF
142  IF (ASSOCIATED(p_env%preconditioner)) THEN
143  DO ip = 1, SIZE(p_env%preconditioner, 1)
144  CALL destroy_preconditioner(p_env%preconditioner(ip))
145  END DO
146  DEALLOCATE (p_env%preconditioner)
147  END IF
148  END SUBROUTINE p_env_release
149 
150 END MODULE qs_p_env_types
DBCSR operations in CP2K.
represent a full matrix distributed on many processors
Definition: cp_fm_types.F:15
subroutine, public hartree_local_release(hartree_local)
...
types of preconditioners
subroutine, public destroy_preconditioner(preconditioner_env)
...
basis types for the calculation of the perturbation of density theory.
subroutine, public kpp1_release(kpp1_env)
releases a kpp1_env (see doc/ReferenceCounting.html)
subroutine, public local_rho_set_release(local_rho_set)
...
basis types for the calculation of the perturbation of density theory.
subroutine, public p_env_release(p_env)
relases the given p_env (see doc/ReferenceCounting.html)
superstucture that hold various representations of the density and keeps track of which ones are vali...
Definition: qs_rho_types.F:18
subroutine, public qs_rho_release(rho_struct)
releases a rho_struct by decreasing the reference count by one and deallocating if it reaches 0 (to b...
Definition: qs_rho_types.F:113