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) WRITE (output_unit, "(/,T2,A,I3)") &
137 : "LOCALIZATION| Computing localization properties "// &
138 73 : "for OCCUPIED ORBITALS. Spin:", ispin
139 160 : IF (output_unit > 0 .AND. do_mixed) WRITE (output_unit, "(/,T2,A,/,T16,A,I3)") &
140 1 : "LOCALIZATION| Computing localization properties for OCCUPIED, ", &
141 2 : "PARTIALLY OCCUPIED and UNOCCUPIED ORBITALS. Spin:", ispin
142 160 : IF (output_unit > 0 .AND. (.NOT. do_homo) .AND. (.NOT. do_mixed)) &
143 : WRITE (output_unit, "(/,T2,A,I3)") &
144 : "LOCALIZATION| Computing localization properties "// &
145 6 : "for UNOCCUPIED ORBITALS. Spin:", ispin
146 :
147 160 : scenter => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
148 :
149 : CALL qs_loc_driver(qs_env, qs_loc_env, loc_print_section, &
150 160 : myspin=ispin, ext_mo_coeff=mo_local(ispin))
151 :
152 : ! maps wfc to molecules, and compute the molecular dipoles if required
153 160 : IF ((BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
154 : "MOLECULAR_DIPOLES"), cp_p_file) .OR. &
155 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
156 : "MOLECULAR_MOMENTS"), cp_p_file) .OR. &
157 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
158 : "MOLECULAR_STATES"), cp_p_file) .OR. &
159 : BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
160 : "LOCALIZED_MOMENTS"), cp_p_file))) THEN
161 90 : CALL wfc_to_molecule(qs_loc_env, scenter, molecule_set, ispin, dft_control%nspins)
162 : END IF
163 :
164 : ! Compute the wannier states
165 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
166 160 : "WANNIER_STATES"), cp_p_file) .OR. &
167 : (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
168 : "LOCALIZED_MOMENTS"), cp_p_file))) THEN
169 28 : ns = SIZE(qs_loc_env%localized_wfn_control%loc_states, 1)
170 28 : IF (.NOT. ASSOCIATED(wc(ispin)%centres)) THEN
171 30 : ALLOCATE (wc(ispin)%WannierHamDiag(ns))
172 30 : ALLOCATE (wc(ispin)%centres(3, ns))
173 : END IF
174 :
175 4220 : wc(ispin)%centres(:, :) = scenter(1 + (ispin - 1)*3:ispin*3, :)
176 28 : lstates => qs_loc_env%localized_wfn_control%loc_states(:, ispin)
177 : CALL construct_wannier_states(mo_local(ispin), &
178 : ks_rmpv(ispin)%matrix, qs_env, loc_print_section=loc_print_section, &
179 28 : WannierCentres=wc(ispin), ns=ns, states=lstates)
180 : END IF
181 : ! Compute the molecular states
182 160 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
183 : "MOLECULAR_STATES"), cp_p_file)) THEN
184 : CALL construct_molecular_states( &
185 : molecule_set, mo_local(ispin), coeff(ispin), &
186 : evals(ispin)%array, ks_rmpv(ispin)%matrix, matrix_s(1)%matrix, qs_env, wf_r, wf_g, &
187 : loc_print_section=loc_print_section, particles=particles, tag=TRIM(qs_loc_env%tag_mo), &
188 64 : marked_states=marked_states_spin, ispin=ispin)
189 64 : IF (ASSOCIATED(marked_states_spin)) THEN
190 64 : IF (.NOT. ASSOCIATED(marked_states)) THEN
191 180 : ALLOCATE (marked_states(SIZE(marked_states_spin), dft_control%nspins, 2))
192 : END IF
193 64 : mystate = 1
194 64 : IF (qs_loc_env%tag_mo == "LUMO") mystate = 2
195 208 : marked_states(:, ispin, mystate) = marked_states_spin(:)
196 64 : DEALLOCATE (marked_states_spin)
197 : END IF
198 : END IF
199 : END IF
200 :
201 : ! Compute all the second moments of the Wannier states
202 310 : IF (section_get_lval(loc_print_section, "WANNIER_SPREADS%SECOND_MOMENTS")) THEN
203 0 : IF (section_get_lval(loc_print_section, "WANNIER_SPREADS%PERIODIC")) THEN
204 0 : IF (dft_control%qs_control%gapw_control%lmax_sphere < 6) THEN
205 0 : CPABORT("Periodic second moments require LMAXN1>=6 In QS section")
206 : END IF
207 0 : CALL centers_second_moments_berry(qs_env, qs_loc_env, loc_print_section, ispin)
208 : ELSE
209 0 : CALL centers_second_moments_loc(qs_env, qs_loc_env, loc_print_section, ispin)
210 : END IF
211 : END IF
212 : END DO
213 :
214 : ! Compute molecular dipoles
215 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
216 : "MOLECULAR_DIPOLES"), cp_p_file)) THEN
217 16 : CALL calculate_molecular_dipole(qs_env, qs_loc_env, loc_print_section, molecule_set)
218 : END IF
219 :
220 : ! Compute molecular multipole moments
221 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
222 : "MOLECULAR_MOMENTS"), cp_p_file)) THEN
223 2 : CALL calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_section, molecule_set)
224 : END IF
225 : !
226 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
227 : "WANNIER_STATES"), cp_p_file)) THEN
228 44 : CALL set_qs_env(qs_env=qs_env, WannierCentres=wc)
229 : END IF
230 : !
231 134 : IF (BTEST(cp_print_key_should_output(logger%iter_info, loc_print_section, &
232 : "LOCALIZED_MOMENTS"), cp_p_file)) THEN
233 12 : max_moment = section_get_ival(loc_print_section, "LOCALIZED_MOMENTS%MAX_MOMENT")
234 12 : magnetic = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%MAGNETIC")
235 12 : vel_reprs = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%VEL_REPRS")
236 12 : com_nl = section_get_lval(loc_print_section, "LOCALIZED_MOMENTS%COM_NL")
237 : CALL calculate_localized_moments(qs_env, qs_loc_env, mo_local, max_moment, magnetic, &
238 12 : vel_reprs, com_nl, loc_print_section)
239 : END IF
240 :
241 134 : CALL timestop(handle)
242 :
243 134 : END SUBROUTINE get_localization_info
244 :
245 : END MODULE qs_loc_states
|