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
10 : ! **************************************************************************************************
11 : MODULE qs_loc_states
12 : USE cp_array_utils, ONLY: cp_1d_r_p_type
13 : USE cp_control_types, ONLY: dft_control_type
14 : USE cp_dbcsr_api, ONLY: dbcsr_p_type
15 : USE cp_fm_types, ONLY: cp_fm_type
16 : USE cp_log_handling, ONLY: cp_get_default_logger,&
17 : cp_logger_get_default_io_unit,&
18 : cp_logger_type
19 : USE cp_output_handling, ONLY: cp_p_file,&
20 : cp_print_key_should_output
21 : USE input_section_types, ONLY: section_get_ival,&
22 : section_get_lval,&
23 : section_vals_get_subs_vals,&
24 : section_vals_type
25 : USE kinds, ONLY: dp
26 : USE localized_moments, ONLY: calculate_localized_moments
27 : USE molecular_dipoles, ONLY: calculate_molecular_dipole
28 : USE molecular_moments, ONLY: calculate_molecular_moments
29 : USE molecular_states, ONLY: construct_molecular_states
30 : USE molecule_types, ONLY: molecule_type
31 : USE particle_list_types, ONLY: particle_list_type
32 : USE pw_types, ONLY: pw_c1d_gs_type,&
33 : pw_r3d_rs_type
34 : USE qs_environment_types, ONLY: get_qs_env,&
35 : qs_environment_type,&
36 : set_qs_env
37 : USE qs_loc_main, ONLY: qs_loc_driver
38 : USE qs_loc_methods, ONLY: centers_second_moments_berry,&
39 : centers_second_moments_loc
40 : USE qs_loc_molecules, ONLY: wfc_to_molecule
41 : USE qs_loc_types, ONLY: qs_loc_env_type
42 : USE qs_mo_types, ONLY: mo_set_type
43 : USE wannier_states, ONLY: construct_wannier_states
44 : USE wannier_states_types, ONLY: wannier_centres_type
45 : #include "./base/base_uses.f90"
46 :
47 : IMPLICIT NONE
48 : PRIVATE
49 :
50 : ! Global parameters
51 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_states'
52 : PUBLIC :: get_localization_info
53 :
54 : ! **************************************************************************************************
55 :
56 : CONTAINS
57 :
58 : ! **************************************************************************************************
59 : !> \brief Performs localization of the orbitals
60 : !> \param qs_env ...
61 : !> \param qs_loc_env ...
62 : !> \param loc_section ...
63 : !> \param mo_local ...
64 : !> \param wf_r ...
65 : !> \param wf_g ...
66 : !> \param particles ...
67 : !> \param coeff ...
68 : !> \param evals ...
69 : !> \param marked_states ...
70 : ! **************************************************************************************************
71 134 : SUBROUTINE get_localization_info(qs_env, qs_loc_env, loc_section, mo_local, &
72 134 : wf_r, wf_g, particles, coeff, evals, marked_states)
73 :
74 : TYPE(qs_environment_type), POINTER :: qs_env
75 : TYPE(qs_loc_env_type), POINTER :: qs_loc_env
76 : TYPE(section_vals_type), POINTER :: loc_section
77 : TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: mo_local
78 : TYPE(pw_r3d_rs_type), INTENT(INOUT) :: wf_r
79 : TYPE(pw_c1d_gs_type), INTENT(INOUT) :: wf_g
80 : TYPE(particle_list_type), POINTER :: particles
81 : TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: coeff
82 : TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: evals
83 : INTEGER, DIMENSION(:, :, :), POINTER :: marked_states
84 :
85 : CHARACTER(len=*), PARAMETER :: routineN = 'get_localization_info'
86 :
87 : INTEGER :: handle, ispin, max_moment, mystate, ns, &
88 : nspins, output_unit
89 134 : INTEGER, DIMENSION(:), POINTER :: lstates, marked_states_spin
90 : LOGICAL :: com_nl, do_homo, do_mixed, magnetic, &
91 : vel_reprs
92 134 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: scenter
93 : TYPE(cp_logger_type), POINTER :: logger
94 134 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ks_rmpv, matrix_s
95 : TYPE(dft_control_type), POINTER :: dft_control
96 134 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
97 134 : TYPE(molecule_type), DIMENSION(:), POINTER :: molecule_set
98 : TYPE(section_vals_type), POINTER :: loc_print_section
99 134 : TYPE(wannier_centres_type), DIMENSION(:), POINTER :: wc
100 :
101 134 : CALL timeset(routineN, handle)
102 134 : NULLIFY (mos, ks_rmpv, dft_control, loc_print_section, marked_states_spin, &
103 134 : matrix_s, scenter, wc)
104 : CALL get_qs_env(qs_env, mos=mos, matrix_ks=ks_rmpv, molecule_set=molecule_set, &
105 134 : dft_control=dft_control, matrix_s=matrix_s)
106 134 : logger => cp_get_default_logger()
107 134 : output_unit = cp_logger_get_default_io_unit(logger)
108 134 : loc_print_section => section_vals_get_subs_vals(loc_section, "PRINT")
109 134 : do_homo = qs_loc_env%localized_wfn_control%do_homo
110 134 : do_mixed = qs_loc_env%localized_wfn_control%do_mixed
111 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
112 : "WANNIER_STATES"), cp_p_file)) THEN
113 44 : CALL get_qs_env(qs_env=qs_env, WannierCentres=wc)
114 44 : IF (.NOT. ASSOCIATED(wc)) THEN
115 40 : ALLOCATE (wc(dft_control%nspins))
116 : END IF
117 : END IF
118 :
119 134 : IF (dft_control%restricted) THEN
120 : !For ROKS usefull only first term
121 : nspins = 1
122 : ELSE
123 134 : nspins = dft_control%nspins
124 : END IF
125 : !
126 310 : DO ispin = 1, nspins
127 : !
128 176 : IF (do_homo) THEN
129 162 : qs_loc_env%tag_mo = "HOMO"
130 : ELSE
131 14 : qs_loc_env%tag_mo = "LUMO"
132 : END IF
133 :
134 176 : IF (qs_loc_env%do_localize) THEN
135 : ! Do the Real localization..
136 160 : IF (output_unit > 0 .AND. do_homo) THEN
137 : WRITE (output_unit, "(/,T2,A,I3)") &
138 : "LOCALIZATION| Computing localization properties "// &
139 73 : "for OCCUPIED ORBITALS. Spin:", ispin
140 : END IF
141 160 : IF (output_unit > 0 .AND. do_mixed) THEN
142 : WRITE (output_unit, "(/,T2,A,/,T16,A,I3)") &
143 1 : "LOCALIZATION| Computing localization properties for OCCUPIED, ", &
144 2 : "PARTIALLY OCCUPIED and UNOCCUPIED ORBITALS. Spin:", ispin
145 : END IF
146 160 : IF (output_unit > 0 .AND. (.NOT. do_homo) .AND. (.NOT. do_mixed)) THEN
147 : WRITE (output_unit, "(/,T2,A,I3)") &
148 : "LOCALIZATION| Computing localization properties "// &
149 6 : "for UNOCCUPIED ORBITALS. Spin:", ispin
150 : END IF
151 :
152 160 : scenter => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
153 :
154 : CALL qs_loc_driver(qs_env, qs_loc_env, loc_print_section, &
155 160 : myspin=ispin, ext_mo_coeff=mo_local(ispin))
156 :
157 : ! maps wfc to molecules, and compute the molecular dipoles if required
158 160 : IF ((BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
159 : "MOLECULAR_DIPOLES"), cp_p_file) .OR. &
160 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
161 : "MOLECULAR_MOMENTS"), cp_p_file) .OR. &
162 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
163 : "MOLECULAR_STATES"), cp_p_file) .OR. &
164 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
165 : "LOCALIZED_MOMENTS"), cp_p_file))) THEN
166 90 : CALL wfc_to_molecule(qs_loc_env, scenter, molecule_set, ispin, dft_control%nspins)
167 : END IF
168 :
169 : ! Compute the wannier states
170 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
171 160 : "WANNIER_STATES"), cp_p_file) .OR. &
172 : (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
173 : "LOCALIZED_MOMENTS"), cp_p_file))) THEN
174 28 : ns = SIZE(qs_loc_env%localized_wfn_control%loc_states, 1)
175 28 : IF (.NOT. ASSOCIATED(wc(ispin)%centres)) THEN
176 30 : ALLOCATE (wc(ispin)%WannierHamDiag(ns))
177 30 : ALLOCATE (wc(ispin)%centres(3, ns))
178 : END IF
179 :
180 4220 : wc(ispin)%centres(:, :) = scenter(1 + (ispin - 1)*3:ispin*3, :)
181 28 : lstates => qs_loc_env%localized_wfn_control%loc_states(:, ispin)
182 : CALL construct_wannier_states(mo_local(ispin), &
183 : ks_rmpv(ispin)%matrix, qs_env, loc_print_section=loc_print_section, &
184 28 : WannierCentres=wc(ispin), ns=ns, states=lstates)
185 : END IF
186 : ! Compute the molecular states
187 160 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
188 : "MOLECULAR_STATES"), cp_p_file)) THEN
189 : CALL construct_molecular_states( &
190 : molecule_set, mo_local(ispin), coeff(ispin), &
191 : evals(ispin)%array, ks_rmpv(ispin)%matrix, matrix_s(1)%matrix, qs_env, wf_r, wf_g, &
192 : loc_print_section=loc_print_section, particles=particles, tag=TRIM(qs_loc_env%tag_mo), &
193 64 : marked_states=marked_states_spin, ispin=ispin)
194 64 : IF (ASSOCIATED(marked_states_spin)) THEN
195 64 : IF (.NOT. ASSOCIATED(marked_states)) THEN
196 180 : ALLOCATE (marked_states(SIZE(marked_states_spin), dft_control%nspins, 2))
197 : END IF
198 64 : mystate = 1
199 64 : IF (qs_loc_env%tag_mo == "LUMO") mystate = 2
200 208 : marked_states(:, ispin, mystate) = marked_states_spin(:)
201 64 : DEALLOCATE (marked_states_spin)
202 : END IF
203 : END IF
204 : END IF
205 :
206 : ! Compute all the second moments of the Wannier states
207 310 : IF (section_get_lval(loc_print_section, "WANNIER_SPREADS%SECOND_MOMENTS")) THEN
208 0 : IF (section_get_lval(loc_print_section, "WANNIER_SPREADS%PERIODIC")) THEN
209 0 : IF (dft_control%qs_control%gapw_control%lmax_sphere < 6) THEN
210 0 : CPABORT("Periodic second moments require LMAXN1>=6 In QS section")
211 : END IF
212 0 : CALL centers_second_moments_berry(qs_env, qs_loc_env, loc_print_section, ispin)
213 : ELSE
214 0 : CALL centers_second_moments_loc(qs_env, qs_loc_env, loc_print_section, ispin)
215 : END IF
216 : END IF
217 : END DO
218 :
219 : ! Compute molecular dipoles
220 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
221 : "MOLECULAR_DIPOLES"), cp_p_file)) THEN
222 16 : CALL calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_section, molecule_set)
223 : END IF
224 :
225 : ! Compute molecular multipole moments
226 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
227 : "MOLECULAR_MOMENTS"), cp_p_file)) THEN
228 2 : CALL calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_section, molecule_set)
229 : END IF
230 : !
231 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
232 : "WANNIER_STATES"), cp_p_file)) THEN
233 44 : CALL set_qs_env(qs_env=qs_env, WannierCentres=wc)
234 : END IF
235 : !
236 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
237 : "LOCALIZED_MOMENTS"), cp_p_file)) THEN
238 12 : max_moment = section_get_ival(loc_print_section, "LOCALIZED_MOMENTS%MAX_MOMENT")
239 12 : magnetic = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%MAGNETIC")
240 12 : vel_reprs = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%VEL_REPRS")
241 12 : com_nl = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%COM_NL")
242 : CALL calculate_localized_moments(qs_env, qs_loc_env, mo_local, max_moment, magnetic, &
243 12 : vel_reprs, com_nl, loc_print_section)
244 : END IF
245 :
246 134 : CALL timestop(handle)
247 :
248 134 : END SUBROUTINE get_localization_info
249 :
250 : END MODULE qs_loc_states
|