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 : ! **************************************************************************************************
9 : !> \brief Utility functions that are needed for RTP/EMD in combination with
10 : !> HF or hybrid functionals (needs to deal with imaginary KS and P
11 : !> \par History
12 : !> 2014 created [fschiff]
13 : !> \author Florina Schiffmann
14 : ! **************************************************************************************************
15 : MODULE rt_hfx_utils
16 : USE admm_types, ONLY: get_admm_env,&
17 : set_admm_env
18 : USE cp_control_types, ONLY: dft_control_type
19 : USE cp_dbcsr_api, ONLY: dbcsr_create,&
20 : dbcsr_p_type,&
21 : dbcsr_set,&
22 : dbcsr_type_antisymmetric
23 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
24 : USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
25 : dbcsr_deallocate_matrix_set
26 : USE kinds, ONLY: dp
27 : USE qs_environment_types, ONLY: get_qs_env,&
28 : qs_environment_type
29 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
30 : USE qs_rho_types, ONLY: qs_rho_get,&
31 : qs_rho_set,&
32 : qs_rho_type
33 : #include "../base/base_uses.f90"
34 :
35 : IMPLICIT NONE
36 : PRIVATE
37 :
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rt_hfx_utils'
39 :
40 : PUBLIC :: rtp_hfx_rebuild
41 :
42 : !***
43 : CONTAINS
44 : ! **************************************************************************************************
45 : !> \brief rebuilds the structures of P and KS (imaginary) in case S changed
46 : !> \param qs_env ...
47 : !> \author Florian Schiffmann
48 : ! **************************************************************************************************
49 32 : SUBROUTINE rtp_hfx_rebuild(qs_env)
50 : TYPE(qs_environment_type), POINTER :: qs_env
51 :
52 32 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks_aux_im, matrix_s_aux, &
53 32 : rho_aux_ao_im
54 : TYPE(dft_control_type), POINTER :: dft_control
55 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
56 32 : POINTER :: sab_aux
57 : TYPE(qs_rho_type), POINTER :: rho_aux
58 :
59 32 : NULLIFY (dft_control)
60 32 : NULLIFY (sab_aux, rho_aux, rho_aux_ao_im, matrix_ks_aux_im, matrix_s_aux)
61 :
62 : CALL get_qs_env(qs_env, &
63 32 : dft_control=dft_control)
64 :
65 32 : IF (dft_control%do_admm) THEN
66 : CALL get_admm_env(qs_env%admm_env, &
67 : matrix_s_aux_fit=matrix_s_aux, &
68 : sab_aux_fit=sab_aux, &
69 : rho_aux_fit=rho_aux, &
70 8 : matrix_ks_aux_fit_im=matrix_ks_aux_im)
71 8 : CALL qs_rho_get(rho_aux, rho_ao_im=rho_aux_ao_im)
72 : CALL rebuild_matrices(rho_aux_ao_im, matrix_ks_aux_im, sab_aux, matrix_s_aux, &
73 8 : dft_control%nspins)
74 8 : CALL set_admm_env(qs_env%admm_env, matrix_ks_aux_fit_im=matrix_ks_aux_im)
75 8 : CALL qs_rho_set(rho_aux, rho_ao_im=rho_aux_ao_im)
76 : END IF
77 :
78 32 : END SUBROUTINE rtp_hfx_rebuild
79 :
80 : ! **************************************************************************************************
81 : !> \brief does the actual rebuilding of P and KS (imaginary) in case S changed
82 : !> \param matrix_p ...
83 : !> \param matrix_ks ...
84 : !> \param sab_orb ...
85 : !> \param matrix_s ...
86 : !> \param nspins ...
87 : !> \author Florian Schiffmann
88 : ! **************************************************************************************************
89 :
90 8 : SUBROUTINE rebuild_matrices(matrix_p, matrix_ks, sab_orb, matrix_s, nspins)
91 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_p, matrix_ks
92 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
93 : POINTER :: sab_orb
94 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
95 : INTEGER, INTENT(in) :: nspins
96 :
97 : INTEGER :: i
98 :
99 8 : IF (ASSOCIATED(matrix_p)) THEN
100 0 : CALL dbcsr_deallocate_matrix_set(matrix_p)
101 : END IF
102 : ! Create a new density matrix set
103 8 : CALL dbcsr_allocate_matrix_set(matrix_p, nspins)
104 16 : DO i = 1, nspins
105 8 : ALLOCATE (matrix_p(i)%matrix)
106 : CALL dbcsr_create(matrix=matrix_p(i)%matrix, template=matrix_s(1)%matrix, &
107 8 : name="Imaginary density matrix", matrix_type=dbcsr_type_antisymmetric)
108 8 : CALL cp_dbcsr_alloc_block_from_nbl(matrix_p(i)%matrix, sab_orb)
109 16 : CALL dbcsr_set(matrix_p(i)%matrix, 0.0_dp)
110 : END DO
111 :
112 8 : IF (ASSOCIATED(matrix_ks)) THEN
113 0 : CALL dbcsr_deallocate_matrix_set(matrix_ks)
114 : END IF
115 : ! Create a new density matrix set
116 8 : CALL dbcsr_allocate_matrix_set(matrix_ks, nspins)
117 16 : DO i = 1, nspins
118 8 : ALLOCATE (matrix_ks(i)%matrix)
119 : CALL dbcsr_create(matrix=matrix_ks(i)%matrix, template=matrix_s(1)%matrix, &
120 8 : name="Imaginary Kohn-Sham matrix", matrix_type=dbcsr_type_antisymmetric)
121 8 : CALL cp_dbcsr_alloc_block_from_nbl(matrix_ks(i)%matrix, sab_orb)
122 16 : CALL dbcsr_set(matrix_ks(i)%matrix, 0.0_dp)
123 : END DO
124 :
125 8 : END SUBROUTINE rebuild_matrices
126 :
127 : END MODULE rt_hfx_utils
|
