Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Utility subroutine for qs energy calculation
10 : !> \par History
11 : !> none
12 : !> \author MK (29.10.2002)
13 : ! **************************************************************************************************
14 : MODULE qs_matrix_w
15 : USE cp_control_types, ONLY: dft_control_type
16 : USE cp_dbcsr_api, ONLY: dbcsr_p_type,&
17 : dbcsr_set
18 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
19 : cp_fm_struct_release,&
20 : cp_fm_struct_type
21 : USE cp_fm_types, ONLY: cp_fm_create,&
22 : cp_fm_release,&
23 : cp_fm_type
24 : USE kinds, ONLY: dp
25 : USE kpoint_methods, ONLY: kpoint_density_matrices,&
26 : kpoint_density_transform,&
27 : kpoint_ot_energy_weighted_matrices
28 : USE kpoint_types, ONLY: kpoint_type
29 : USE qs_density_matrices, ONLY: calculate_w_matrix,&
30 : calculate_w_matrix_ot
31 : USE qs_environment_types, ONLY: get_qs_env,&
32 : qs_environment_type
33 : USE qs_mo_types, ONLY: get_mo_set,&
34 : mo_set_type
35 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
36 : USE qs_rho_types, ONLY: qs_rho_get,&
37 : qs_rho_type
38 : USE scf_control_types, ONLY: scf_control_type
39 : #include "./base/base_uses.f90"
40 :
41 : IMPLICIT NONE
42 :
43 : PRIVATE
44 :
45 : ! *** Global parameters ***
46 :
47 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_matrix_w'
48 :
49 : PUBLIC :: compute_matrix_w
50 :
51 : CONTAINS
52 :
53 : ! **************************************************************************************************
54 : !> \brief Refactoring of qs_energies_scf. Moves computation of matrix_w
55 : !> into separate subroutine
56 : !> \param qs_env ...
57 : !> \param calc_forces ...
58 : !> \par History
59 : !> 05.2013 created [Florian Schiffmann]
60 : ! **************************************************************************************************
61 :
62 26627 : SUBROUTINE compute_matrix_w(qs_env, calc_forces)
63 : TYPE(qs_environment_type), POINTER :: qs_env
64 : LOGICAL, INTENT(IN) :: calc_forces
65 :
66 : CHARACTER(len=*), PARAMETER :: routineN = 'compute_matrix_w'
67 :
68 : INTEGER :: handle, is, ispin, nao, nspin
69 : LOGICAL :: do_kpoints, has_unit_metric
70 26627 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_s, matrix_w, &
71 26627 : mo_derivs, rho_ao
72 : TYPE(dft_control_type), POINTER :: dft_control
73 26627 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
74 : TYPE(mo_set_type), POINTER :: mo_set
75 : TYPE(qs_rho_type), POINTER :: rho
76 : TYPE(scf_control_type), POINTER :: scf_control
77 :
78 26627 : CALL timeset(routineN, handle)
79 :
80 : ! if calculate forces, time to compute the w matrix
81 26627 : CALL get_qs_env(qs_env, has_unit_metric=has_unit_metric)
82 :
83 26627 : IF (calc_forces .AND. .NOT. has_unit_metric) THEN
84 6665 : CALL get_qs_env(qs_env, do_kpoints=do_kpoints)
85 :
86 6665 : IF (do_kpoints) THEN
87 450 : BLOCK
88 1350 : TYPE(cp_fm_type), DIMENSION(2) :: fmwork
89 : TYPE(cp_fm_struct_type), POINTER :: ao_ao_fmstruct
90 : TYPE(cp_fm_type), POINTER :: mo_coeff
91 450 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_kp, matrix_s_kp, &
92 450 : matrix_w_kp
93 : TYPE(kpoint_type), POINTER :: kpoints
94 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
95 450 : POINTER :: sab_nl
96 :
97 : CALL get_qs_env(qs_env, &
98 : matrix_w_kp=matrix_w_kp, &
99 : matrix_ks_kp=matrix_ks_kp, &
100 : matrix_s_kp=matrix_s_kp, &
101 : sab_orb=sab_nl, &
102 : mos=mos, &
103 : kpoints=kpoints, &
104 450 : scf_control=scf_control)
105 :
106 450 : CALL get_mo_set(mos(1), mo_coeff=mo_coeff, nao=nao)
107 : CALL cp_fm_struct_create(fmstruct=ao_ao_fmstruct, nrow_global=nao, ncol_global=nao, &
108 450 : template_fmstruct=mo_coeff%matrix_struct)
109 :
110 1350 : DO is = 1, SIZE(fmwork)
111 1350 : CALL cp_fm_create(fmwork(is), matrix_struct=ao_ao_fmstruct)
112 : END DO
113 450 : CALL cp_fm_struct_release(ao_ao_fmstruct)
114 :
115 : ! energy weighted density matrices in k-space
116 450 : IF (scf_control%use_ot) THEN
117 18 : CALL kpoint_ot_energy_weighted_matrices(kpoints, matrix_ks_kp)
118 : ELSE
119 432 : CALL kpoint_density_matrices(kpoints, energy_weighted=.TRUE.)
120 : END IF
121 : ! energy weighted density matrices in real space
122 : CALL kpoint_density_transform(kpoints, matrix_w_kp, .TRUE., &
123 450 : matrix_s_kp(1, 1)%matrix, sab_nl, fmwork)
124 :
125 1800 : DO is = 1, SIZE(fmwork)
126 1350 : CALL cp_fm_release(fmwork(is))
127 : END DO
128 :
129 : END BLOCK
130 : ELSE
131 :
132 6215 : NULLIFY (dft_control, rho_ao)
133 : CALL get_qs_env(qs_env, &
134 : matrix_w=matrix_w, &
135 : matrix_ks=matrix_ks, &
136 : matrix_s=matrix_s, &
137 : mo_derivs=mo_derivs, &
138 : scf_control=scf_control, &
139 : mos=mos, &
140 : rho=rho, &
141 6215 : dft_control=dft_control)
142 :
143 6215 : CALL qs_rho_get(rho, rho_ao=rho_ao)
144 :
145 6215 : nspin = SIZE(mos)
146 13154 : DO ispin = 1, nspin
147 6939 : mo_set => mos(ispin)
148 13154 : IF (dft_control%roks) THEN
149 168 : IF (scf_control%use_ot) THEN
150 116 : IF (ispin > 1) THEN
151 : ! not very elegant, indeed ...
152 58 : CALL dbcsr_set(matrix_w(ispin)%matrix, 0.0_dp)
153 : ELSE
154 : CALL calculate_w_matrix_ot(mo_set, mo_derivs(ispin)%matrix, &
155 58 : matrix_w(ispin)%matrix, matrix_s(1)%matrix)
156 : END IF
157 : ELSE
158 : CALL calculate_w_matrix(mo_set=mo_set, &
159 : matrix_ks=matrix_ks(ispin)%matrix, &
160 : matrix_p=rho_ao(ispin)%matrix, &
161 52 : matrix_w=matrix_w(ispin)%matrix)
162 : END IF
163 : ELSE
164 6771 : IF (scf_control%use_ot) THEN
165 : CALL calculate_w_matrix_ot(mo_set, mo_derivs(ispin)%matrix, &
166 2715 : matrix_w(ispin)%matrix, matrix_s(1)%matrix)
167 : ELSE
168 4056 : CALL calculate_w_matrix(mo_set, matrix_w(ispin)%matrix)
169 : END IF
170 : END IF
171 : END DO
172 :
173 : END IF
174 :
175 : END IF
176 :
177 26627 : CALL timestop(handle)
178 :
179 26627 : END SUBROUTINE compute_matrix_w
180 :
181 : END MODULE qs_matrix_w
|
