1!--------------------------------------------------------------------------------------------------! 2! CP2K: A general program to perform molecular dynamics simulations ! 3! Copyright (C) 2000 - 2019 CP2K developers group ! 4!--------------------------------------------------------------------------------------------------! 5 6! ************************************************************************************************** 7!> \brief basis types for the calculation of the perturbation of density theory. 8!> \par History 9!> 4.2002 created [fawzi] 10!> \author Fawzi Mohamed 11! ************************************************************************************************** 12MODULE qs_p_env_types 13 USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set 14 USE cp_fm_types, ONLY: cp_fm_p_type 15 USE cp_fm_vect, ONLY: cp_fm_vect_dealloc 16 USE dbcsr_api, ONLY: dbcsr_p_type 17 USE hartree_local_types, ONLY: hartree_local_release,& 18 hartree_local_type 19 USE kinds, ONLY: dp 20 USE preconditioner_types, ONLY: destroy_preconditioner,& 21 preconditioner_type 22 USE qs_kpp1_env_types, ONLY: kpp1_release,& 23 qs_kpp1_env_type 24 USE qs_local_rho_types, ONLY: local_rho_set_release,& 25 local_rho_type 26 USE qs_rho_types, ONLY: qs_rho_release,& 27 qs_rho_type 28#include "./base/base_uses.f90" 29 30 IMPLICIT NONE 31 PRIVATE 32 PUBLIC :: qs_p_env_type 33 PUBLIC :: p_env_release 34 35 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE. 36 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_p_env_types' 37 38! ************************************************************************************************** 39!> \brief Represent a qs system that is perturbed. 40!> Can calculate the linear operator and the rhs of the system 41!> of equations that needs to be solved for the perturbation. 42!> \param orthogonal_orbitals if the orbitals are orthogonal 43!> \param id_nr identification number (unique between p_env_types) 44!> \param ref_count reference count (see doc/ReferenceCounting.html) 45!> \param iter number of iterations 46!> \param kpp 1: the kpp1 matrix (make it temporary?) 47!> \param m_epsilon minus epsilon: -<psi0d|H_rho|psi0d> 48!> \param psi 0d: the dual basis of psi0: psi0 (psi0^T S psi0)^-1 49!> \param S_psi 0: S times psi0, cached for performace reasons 50!> \param Smo_inv inverse of the mo overlap: (psi0^T S psi0)^-1 51!> \param kpp 1_env: environment for the calculation of kpp1 52!> \param rho 1: the density rho1 53!> \param rho 1: the soft density rho1 for gapw_xc 54!> \param n_mo cached number of mo: n_mo(i)=qs_env%c(i)%nmo 55!> \param n_ao cached number of ao: n_ao(i)=qs_env%c(i)%nao 56!> \note 57!> for the moment no smearing of the orbitals. 58! ************************************************************************************************** 59 TYPE qs_p_env_type 60 61 LOGICAL :: orthogonal_orbitals 62 INTEGER :: id_nr, ref_count, iter 63 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: kpp1, p1 64 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: m_epsilon, & 65 psi0d, S_psi0, Smo_inv 66 TYPE(qs_kpp1_env_type), POINTER :: kpp1_env 67 TYPE(qs_rho_type), POINTER :: rho1 68 TYPE(qs_rho_type), POINTER :: rho1_xc 69 INTEGER, DIMENSION(2) :: n_mo, & ! no of molecular orbitals 70 n_ao ! no of basis functions 71 ! GAPW stuff 72 TYPE(hartree_local_type), POINTER :: hartree_local 73 TYPE(local_rho_type), POINTER :: local_rho_set 74 75 ! Linear Response Modules 76 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: PS_psi0 77 TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: ev_h0 78 79 ! preconditioner matrix should be symmetric and positive definite 80 TYPE(preconditioner_type), DIMENSION(:), POINTER :: preconditioner 81 LOGICAL :: new_preconditioner 82 83 !factors 84 REAL(KIND=dp) :: delta, gnorm, gnorm_cross, gnorm_old, etotal, gradient 85 !line search 86 INTEGER :: ls_count 87 REAL(KIND=dp) :: ls_pos(53), ls_energy(53), ls_grad(53) 88 LOGICAL :: only_energy, os_valid 89 90 END TYPE qs_p_env_type 91 92! ************************************************************************************************** 93!> \brief to have arrays of pointers 94!> \param p_env the pointer to the p_env 95!> \par History 96!> 12.2002 created [fawzi] 97!> \author Fawzi Mohamed 98! ************************************************************************************************** 99 TYPE qs_p_env_p_type 100 TYPE(qs_p_env_type), POINTER :: p_env 101 END TYPE qs_p_env_p_type 102 103CONTAINS 104 105! ************************************************************************************************** 106!> \brief retains the given p_env (see doc/ReferenceCounting.html) 107!> \param p_env the p_env to retain 108!> \par History 109!> 12.2002 created [fawzi] 110!> \author Fawzi Mohamed 111! ************************************************************************************************** 112 SUBROUTINE p_env_retain(p_env) 113 TYPE(qs_p_env_type), POINTER :: p_env 114 115 CHARACTER(len=*), PARAMETER :: routineN = 'p_env_retain', routineP = moduleN//':'//routineN 116 117 CPASSERT(ASSOCIATED(p_env)) 118 CPASSERT(p_env%ref_count > 0) 119 p_env%ref_count = p_env%ref_count + 1 120 END SUBROUTINE p_env_retain 121 122! ************************************************************************************************** 123!> \brief relases the given p_env (see doc/ReferenceCounting.html) 124!> \param p_env the environment to release 125!> \par History 126!> 07.2002 created [fawzi] 127!> \author Fawzi Mohamed 128! ************************************************************************************************** 129 SUBROUTINE p_env_release(p_env) 130 131 TYPE(qs_p_env_type), POINTER :: p_env 132 133 CHARACTER(len=*), PARAMETER :: routineN = 'p_env_release', routineP = moduleN//':'//routineN 134 135 INTEGER :: ip 136 137 IF (ASSOCIATED(p_env)) THEN 138 CPASSERT(p_env%ref_count > 0) 139 p_env%ref_count = p_env%ref_count - 1 140 IF (p_env%ref_count < 1) THEN 141 CALL kpp1_release(p_env%kpp1_env) 142 CALL cp_fm_vect_dealloc(p_env%S_psi0) 143 CALL cp_fm_vect_dealloc(p_env%m_epsilon) 144 CALL cp_fm_vect_dealloc(p_env%psi0d) 145 CALL cp_fm_vect_dealloc(p_env%Smo_inv) 146 IF (ASSOCIATED(p_env%rho1_xc)) THEN 147 CALL qs_rho_release(p_env%rho1_xc) 148 ENDIF 149 CALL qs_rho_release(p_env%rho1) 150 IF (ASSOCIATED(p_env%kpp1)) CALL dbcsr_deallocate_matrix_set(p_env%kpp1) 151 IF (ASSOCIATED(p_env%p1)) CALL dbcsr_deallocate_matrix_set(p_env%p1) 152 IF (ASSOCIATED(p_env%local_rho_set)) THEN 153 CALL local_rho_set_release(p_env%local_rho_set) 154 END IF 155 IF (ASSOCIATED(p_env%hartree_local)) THEN 156 CALL hartree_local_release(p_env%hartree_local) 157 END IF 158 IF (ASSOCIATED(p_env%PS_psi0)) THEN 159 CALL cp_fm_vect_dealloc(p_env%PS_psi0) 160 END IF 161 IF (ASSOCIATED(p_env%ev_h0)) THEN 162 DO ip = 1, SIZE(p_env%ev_h0, 1) 163 NULLIFY (p_env%ev_h0(ip)%matrix) 164 END DO 165 DEALLOCATE (p_env%ev_h0) 166 END IF 167 IF (ASSOCIATED(p_env%preconditioner)) THEN 168 DO ip = 1, SIZE(p_env%preconditioner, 1) 169 CALL destroy_preconditioner(p_env%preconditioner(ip)) 170 END DO 171 DEALLOCATE (p_env%preconditioner) 172 END IF 173 END IF 174 DEALLOCATE (p_env) 175 END IF 176 NULLIFY (p_env) 177 END SUBROUTINE p_env_release 178 179END MODULE qs_p_env_types 180