Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Driver for the localization that should be general
10 : !> for all the methods available and all the definition of the
11 : !> spread functional
12 : !> Write centers, spread and cubes only if required and for the
13 : !> selected states
14 : !> The localized functions are copied in the standard mos array
15 : !> for the next use
16 : !> \par History
17 : !> 01.2008 Teodoro Laino [tlaino] - University of Zurich
18 : !> - Merging the two localization codes and updating to new structures
19 : !> 04.2023 JGH Code isolation and refactoring
20 : !> \author MI (04.2005)
21 : ! **************************************************************************************************
22 : MODULE qs_loc_main
23 : USE atomic_kind_types, ONLY: atomic_kind_type
24 : USE cell_types, ONLY: cell_type
25 : USE cp_control_types, ONLY: dft_control_type
26 : USE cp_dbcsr_cp2k_link, ONLY: cp_dbcsr_alloc_block_from_nbl
27 : USE cp_dbcsr_operations, ONLY: cp_dbcsr_sm_fm_multiply,&
28 : dbcsr_allocate_matrix_set,&
29 : dbcsr_deallocate_matrix_set
30 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
31 : cp_fm_struct_release,&
32 : cp_fm_struct_type
33 : USE cp_fm_types, ONLY: &
34 : cp_fm_create, cp_fm_get_info, cp_fm_get_submatrix, cp_fm_init_random, cp_fm_release, &
35 : cp_fm_set_all, cp_fm_set_submatrix, cp_fm_to_fm, cp_fm_type
36 : USE dbcsr_api, ONLY: dbcsr_create,&
37 : dbcsr_p_type,&
38 : dbcsr_set,&
39 : dbcsr_type,&
40 : dbcsr_type_symmetric
41 : USE input_constants, ONLY: &
42 : do_loc_cpo_atomic, do_loc_cpo_random, do_loc_cpo_restart, do_loc_cpo_space_nmo, &
43 : do_loc_cpo_space_wan, op_loc_berry, op_loc_boys, op_loc_pipek, state_loc_list
44 : USE input_section_types, ONLY: section_get_lval,&
45 : section_vals_get_subs_vals,&
46 : section_vals_type,&
47 : section_vals_val_get
48 : USE kinds, ONLY: default_string_length,&
49 : dp
50 : USE memory_utilities, ONLY: reallocate
51 : USE message_passing, ONLY: mp_para_env_type
52 : USE particle_types, ONLY: particle_type
53 : USE qs_atomic_block, ONLY: calculate_atomic_block_dm
54 : USE qs_environment_types, ONLY: get_qs_env,&
55 : qs_environment_type
56 : USE qs_kind_types, ONLY: qs_kind_type
57 : USE qs_loc_methods, ONLY: optimize_loc_berry,&
58 : optimize_loc_pipek,&
59 : qs_print_cubes
60 : USE qs_loc_types, ONLY: get_qs_loc_env,&
61 : localized_wfn_control_type,&
62 : qs_loc_env_type
63 : USE qs_mo_methods, ONLY: make_basis_simple,&
64 : make_basis_sm
65 : USE qs_mo_types, ONLY: get_mo_set,&
66 : mo_set_type
67 : USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type
68 : #include "./base/base_uses.f90"
69 :
70 : IMPLICIT NONE
71 :
72 : PRIVATE
73 :
74 : ! *** Global parameters ***
75 :
76 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_loc_main'
77 :
78 : ! *** Public ***
79 : PUBLIC :: qs_loc_driver
80 :
81 : CONTAINS
82 :
83 : ! **************************************************************************************************
84 : !> \brief set up the calculation of localized orbitals
85 : !> \param qs_env ...
86 : !> \param qs_loc_env ...
87 : !> \param print_loc_section ...
88 : !> \param myspin ...
89 : !> \param ext_mo_coeff ...
90 : !> \par History
91 : !> 04.2005 created [MI]
92 : !> 04.2023 refactored [JGH]
93 : !> \author MI
94 : ! **************************************************************************************************
95 912 : SUBROUTINE qs_loc_driver(qs_env, qs_loc_env, print_loc_section, myspin, ext_mo_coeff)
96 :
97 : TYPE(qs_environment_type), POINTER :: qs_env
98 : TYPE(qs_loc_env_type), POINTER :: qs_loc_env
99 : TYPE(section_vals_type), POINTER :: print_loc_section
100 : INTEGER, INTENT(IN) :: myspin
101 : TYPE(cp_fm_type), INTENT(IN), OPTIONAL, TARGET :: ext_mo_coeff
102 :
103 : CHARACTER(len=*), PARAMETER :: routineN = 'qs_loc_driver'
104 :
105 : INTEGER :: dim_op, handle, i, imo, imoloc, j, lb, &
106 : loc_method, nao, nmosub, restricted, ub
107 456 : INTEGER, DIMENSION(:), POINTER :: ivec
108 : LOGICAL, SAVE :: first_time = .TRUE.
109 : REAL(dp), DIMENSION(6) :: weights
110 456 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: vecbuffer
111 : TYPE(cell_type), POINTER :: cell
112 : TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
113 456 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: moloc_coeff
114 456 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: op_fm_set
115 : TYPE(cp_fm_type), POINTER :: locorb
116 456 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: op_sm_set
117 : TYPE(dft_control_type), POINTER :: dft_control
118 : TYPE(localized_wfn_control_type), POINTER :: localized_wfn_control
119 456 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
120 : TYPE(mp_para_env_type), POINTER :: para_env
121 : TYPE(section_vals_type), POINTER :: input, low_spin_roks_section
122 :
123 456 : CALL timeset(routineN, handle)
124 456 : NULLIFY (para_env, mos, dft_control)
125 456 : NULLIFY (cell, localized_wfn_control, moloc_coeff, op_sm_set, op_fm_set)
126 456 : qs_loc_env%first_time = first_time
127 456 : qs_loc_env%target_time = qs_env%target_time
128 456 : qs_loc_env%start_time = qs_env%start_time
129 :
130 : CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
131 : localized_wfn_control=localized_wfn_control, &
132 : moloc_coeff=moloc_coeff, op_sm_set=op_sm_set, op_fm_set=op_fm_set, cell=cell, &
133 456 : weights=weights, dim_op=dim_op)
134 :
135 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, &
136 456 : para_env=para_env, mos=mos, input=input)
137 :
138 : !calculation of single occupied states to which unitary transformations should not be applied in LOW SPIN ROKS
139 456 : IF (dft_control%restricted) THEN
140 0 : low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
141 0 : CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
142 0 : restricted = SIZE(ivec)
143 : ELSE
144 456 : restricted = 0
145 : END IF
146 :
147 456 : NULLIFY (locorb)
148 456 : IF (PRESENT(ext_mo_coeff)) THEN
149 380 : locorb => ext_mo_coeff
150 : ELSE
151 76 : CALL get_mo_set(mo_set=mos(myspin), mo_coeff=locorb)
152 : END IF
153 :
154 456 : loc_method = localized_wfn_control%localization_method
155 :
156 456 : nmosub = localized_wfn_control%nloc_states(myspin)
157 456 : IF (localized_wfn_control%operator_type == op_loc_berry) THEN
158 : ! Here we allocate op_fm_set with the RIGHT size for uks
159 456 : NULLIFY (tmp_fm_struct)
160 : CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nmosub, &
161 : ncol_global=nmosub, para_env=para_env, &
162 456 : context=locorb%matrix_struct%context)
163 : !
164 5580 : ALLOCATE (op_fm_set(2, dim_op))
165 1860 : DO i = 1, dim_op
166 4668 : DO j = 1, SIZE(op_fm_set, 1)
167 2808 : CALL cp_fm_create(op_fm_set(j, i), tmp_fm_struct)
168 2808 : CALL cp_fm_get_info(op_fm_set(j, i), nrow_global=nmosub)
169 4212 : CALL cp_fm_set_all(op_fm_set(j, i), 0.0_dp)
170 : END DO
171 : END DO
172 456 : CALL cp_fm_struct_release(tmp_fm_struct)
173 : END IF
174 :
175 456 : IF (localized_wfn_control%do_mixed) THEN
176 2 : CALL loc_mixed_method(qs_env, qs_loc_env, print_loc_section, myspin, op_fm_set)
177 : ELSE
178 908 : SELECT CASE (localized_wfn_control%operator_type)
179 : CASE (op_loc_berry)
180 : CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
181 : op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
182 454 : restricted=restricted)
183 : CASE (op_loc_boys)
184 0 : CPABORT("Boys localization not implemented")
185 : CASE (op_loc_pipek)
186 : CALL optimize_loc_pipek(qs_env, loc_method, qs_loc_env, moloc_coeff(myspin), &
187 454 : op_fm_set, myspin, print_loc_section)
188 : END SELECT
189 : END IF
190 :
191 : ! Here we dealloctate op_fm_set
192 456 : IF (localized_wfn_control%operator_type == op_loc_berry) THEN
193 456 : IF (ASSOCIATED(op_fm_set)) THEN
194 1860 : DO i = 1, dim_op
195 4668 : DO j = 1, SIZE(op_fm_set, 1)
196 4212 : CALL cp_fm_release(op_fm_set(j, i))
197 : END DO
198 : END DO
199 456 : DEALLOCATE (op_fm_set)
200 : END IF
201 : END IF
202 :
203 : ! give back the localized orbitals
204 456 : CALL get_mo_set(mo_set=mos(myspin), nao=nao)
205 456 : lb = localized_wfn_control%lu_bound_states(1, myspin)
206 456 : ub = localized_wfn_control%lu_bound_states(2, myspin)
207 :
208 456 : IF (localized_wfn_control%set_of_states == state_loc_list) THEN
209 102 : ALLOCATE (vecbuffer(1, nao))
210 34 : nmosub = SIZE(localized_wfn_control%loc_states, 1)
211 34 : imoloc = 0
212 208 : DO i = lb, ub
213 : ! Get the index in the subset
214 174 : imoloc = imoloc + 1
215 : ! Get the index in the full set
216 174 : imo = localized_wfn_control%loc_states(i, myspin)
217 :
218 : CALL cp_fm_get_submatrix(moloc_coeff(myspin), vecbuffer, 1, imoloc, &
219 174 : nao, 1, transpose=.TRUE.)
220 208 : CALL cp_fm_set_submatrix(locorb, vecbuffer, 1, imo, nao, 1, transpose=.TRUE.)
221 : END DO
222 34 : DEALLOCATE (vecbuffer)
223 : ELSE
224 422 : nmosub = localized_wfn_control%nloc_states(myspin)
225 422 : CALL cp_fm_to_fm(moloc_coeff(myspin), locorb, nmosub, 1, lb)
226 : END IF
227 :
228 : ! Write cube files if required
229 456 : IF (localized_wfn_control%print_cubes) THEN
230 6 : CALL loc_print(qs_env, qs_loc_env, moloc_coeff, myspin, print_loc_section)
231 : END IF
232 456 : first_time = .FALSE.
233 :
234 456 : CALL timestop(handle)
235 :
236 456 : END SUBROUTINE qs_loc_driver
237 :
238 : ! **************************************************************************************************
239 : !> \brief set up the calculation of localized orbitals
240 : !> \param qs_env ...
241 : !> \param qs_loc_env ...
242 : !> \param print_loc_section ...
243 : !> \param myspin ...
244 : !> \param op_fm_set ...
245 : !> \par History
246 : !> 04.2023 refactored [JGH]
247 : !> \author MI
248 : ! **************************************************************************************************
249 4 : SUBROUTINE loc_mixed_method(qs_env, qs_loc_env, print_loc_section, myspin, op_fm_set)
250 :
251 : TYPE(qs_environment_type), POINTER :: qs_env
252 : TYPE(qs_loc_env_type), POINTER :: qs_loc_env
253 : TYPE(section_vals_type), POINTER :: print_loc_section
254 : INTEGER, INTENT(IN) :: myspin
255 : TYPE(cp_fm_type), DIMENSION(:, :), POINTER :: op_fm_set
256 :
257 : CHARACTER(len=*), PARAMETER :: routineN = 'loc_mixed_method'
258 :
259 : INTEGER :: dim_op, handle, jspin, loc_method, nao, &
260 : ndummy, nextra, ngextra, nguess, nmo, &
261 : nmosub, norextra, restricted
262 : INTEGER, DIMENSION(2) :: nelectron_spin
263 2 : INTEGER, DIMENSION(:), POINTER :: ivec
264 : LOGICAL :: do_ortho, has_unit_metric, &
265 : my_guess_atomic, my_guess_wan
266 : REAL(dp), DIMENSION(6) :: weights
267 2 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: tmp_mat
268 2 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
269 : TYPE(cell_type), POINTER :: cell
270 : TYPE(cp_fm_struct_type), POINTER :: tmp_fm_struct
271 : TYPE(cp_fm_type) :: mos_guess, tmp_fm, tmp_fm_1, vectors_2
272 2 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: moloc_coeff
273 : TYPE(cp_fm_type), POINTER :: mo_coeff
274 2 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: p_rmpv
275 2 : TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_s_kp, op_sm_set
276 : TYPE(dbcsr_type), POINTER :: refmatrix, tmatrix
277 : TYPE(dft_control_type), POINTER :: dft_control
278 : TYPE(localized_wfn_control_type), POINTER :: localized_wfn_control
279 2 : TYPE(mo_set_type), DIMENSION(:), POINTER :: mos
280 : TYPE(mp_para_env_type), POINTER :: para_env
281 : TYPE(neighbor_list_set_p_type), DIMENSION(:), &
282 2 : POINTER :: sab_orb
283 2 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
284 2 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
285 : TYPE(section_vals_type), POINTER :: input, low_spin_roks_section
286 :
287 2 : CALL timeset(routineN, handle)
288 :
289 2 : NULLIFY (moloc_coeff, op_sm_set)
290 2 : CALL get_qs_env(qs_env=qs_env, dft_control=dft_control, para_env=para_env, mos=mos, input=input)
291 :
292 : !calculation of single occupied states to which unitary transformations should not be applied in LOW SPIN ROKS
293 2 : IF (dft_control%restricted) THEN
294 0 : low_spin_roks_section => section_vals_get_subs_vals(input, "DFT%LOW_SPIN_ROKS")
295 0 : CALL section_vals_val_get(low_spin_roks_section, "SPIN_CONFIGURATION", i_rep_val=1, i_vals=ivec)
296 0 : restricted = SIZE(ivec)
297 : ELSE
298 2 : restricted = 0
299 : END IF
300 :
301 : CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
302 : localized_wfn_control=localized_wfn_control, &
303 : moloc_coeff=moloc_coeff, op_sm_set=op_sm_set, cell=cell, &
304 2 : weights=weights, dim_op=dim_op)
305 :
306 2 : CALL get_mo_set(mo_set=mos(myspin), nao=nao, nmo=nmo)
307 2 : loc_method = localized_wfn_control%localization_method
308 2 : nmosub = localized_wfn_control%nloc_states(myspin)
309 :
310 2 : CPASSERT(localized_wfn_control%operator_type == op_loc_berry)
311 2 : CPASSERT(localized_wfn_control%do_mixed)
312 :
313 2 : my_guess_atomic = .FALSE.
314 : ! SGh-wan: if atomic guess and do_mixed and nextra > 0
315 : ! read CPO_GUESS; CASE ATOMIC / RESTART / RANDOM (0/1/2)
316 : ! read CPO_GUESS_SPACE if CASE ATOMIC; CASE ALL / WAN
317 2 : nextra = localized_wfn_control%nextra
318 2 : IF (nextra > 0) THEN
319 2 : my_guess_atomic = .TRUE.
320 2 : my_guess_wan = .FALSE.
321 2 : do_ortho = .TRUE.
322 4 : SELECT CASE (localized_wfn_control%coeff_po_guess)
323 :
324 : CASE (do_loc_cpo_atomic)
325 2 : my_guess_atomic = .TRUE.
326 2 : NULLIFY (atomic_kind_set, qs_kind_set, particle_set, matrix_s_kp, sab_orb, p_rmpv, &
327 2 : refmatrix, tmatrix)
328 : CALL get_qs_env(qs_env=qs_env, &
329 : atomic_kind_set=atomic_kind_set, &
330 : qs_kind_set=qs_kind_set, &
331 : particle_set=particle_set, &
332 : matrix_s_kp=matrix_s_kp, &
333 : has_unit_metric=has_unit_metric, &
334 : nelectron_spin=nelectron_spin, &
335 2 : sab_orb=sab_orb)
336 :
337 2 : refmatrix => matrix_s_kp(1, 1)%matrix
338 : ! create p_rmpv
339 2 : CALL dbcsr_allocate_matrix_set(p_rmpv, dft_control%nspins)
340 4 : DO jspin = 1, dft_control%nspins
341 2 : ALLOCATE (p_rmpv(jspin)%matrix)
342 2 : tmatrix => p_rmpv(jspin)%matrix
343 : CALL dbcsr_create(matrix=tmatrix, template=refmatrix, &
344 2 : matrix_type=dbcsr_type_symmetric, nze=0)
345 2 : CALL cp_dbcsr_alloc_block_from_nbl(tmatrix, sab_orb)
346 4 : CALL dbcsr_set(tmatrix, 0.0_dp)
347 : END DO
348 : CALL calculate_atomic_block_dm(p_rmpv, refmatrix, atomic_kind_set, qs_kind_set, &
349 2 : dft_control%nspins, nelectron_spin, 0, para_env)
350 : CASE (do_loc_cpo_restart)
351 0 : my_guess_atomic = .FALSE.
352 0 : my_guess_wan = .TRUE.
353 : CASE (do_loc_cpo_random)
354 2 : my_guess_atomic = .FALSE.
355 : END SELECT
356 :
357 2 : norextra = nmo - nmosub
358 2 : CALL get_mo_set(mo_set=mos(myspin), mo_coeff=mo_coeff)
359 : CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
360 2 : ncol_global=norextra, para_env=para_env, context=mo_coeff%matrix_struct%context)
361 2 : CALL cp_fm_create(vectors_2, tmp_fm_struct)
362 2 : CALL cp_fm_struct_release(tmp_fm_struct)
363 8 : ALLOCATE (tmp_mat(nao, norextra))
364 2 : CALL cp_fm_get_submatrix(mo_coeff, tmp_mat, 1, nmosub + 1)
365 2 : CALL cp_fm_set_submatrix(vectors_2, tmp_mat)
366 2 : DEALLOCATE (tmp_mat)
367 :
368 : ! if guess "atomic" generate MOs based on atomic densities and
369 : ! pass on to optimize_loc_berry
370 2 : IF (my_guess_atomic .OR. my_guess_wan) THEN
371 :
372 4 : SELECT CASE (localized_wfn_control%coeff_po_guess_mo_space)
373 :
374 : CASE (do_loc_cpo_space_wan)
375 2 : ndummy = nmosub
376 : CASE (do_loc_cpo_space_nmo)
377 0 : ndummy = nmo
378 2 : do_ortho = .FALSE.
379 :
380 : END SELECT
381 :
382 : CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
383 : ncol_global=ndummy, para_env=para_env, &
384 2 : context=mo_coeff%matrix_struct%context)
385 2 : CALL cp_fm_create(mos_guess, tmp_fm_struct)
386 2 : CALL cp_fm_set_all(mos_guess, 0.0_dp)
387 :
388 2 : IF (my_guess_atomic) THEN
389 2 : CALL cp_fm_create(tmp_fm, tmp_fm_struct)
390 2 : CALL cp_fm_create(tmp_fm_1, tmp_fm_struct)
391 2 : CALL cp_fm_set_all(tmp_fm, 0.0_dp)
392 2 : CALL cp_fm_set_all(tmp_fm_1, 0.0_dp)
393 2 : CALL cp_fm_init_random(tmp_fm, ndummy)
394 2 : IF (has_unit_metric) THEN
395 0 : CALL cp_fm_to_fm(tmp_fm, tmp_fm_1)
396 : ELSE
397 : ! PS*C(:,1:nomo)+C(:,nomo+1:nmo) (nomo=NINT(nelectron/maxocc))
398 2 : CALL cp_dbcsr_sm_fm_multiply(refmatrix, tmp_fm, tmp_fm_1, ndummy)
399 : END IF
400 2 : CALL cp_dbcsr_sm_fm_multiply(p_rmpv(myspin)%matrix, tmp_fm_1, mos_guess, ndummy)
401 2 : CALL cp_fm_release(tmp_fm)
402 2 : CALL cp_fm_release(tmp_fm_1)
403 2 : CALL cp_fm_struct_release(tmp_fm_struct)
404 0 : ELSEIF (my_guess_wan) THEN
405 0 : nguess = localized_wfn_control%nguess(myspin)
406 0 : ALLOCATE (tmp_mat(nao, nguess))
407 0 : CALL cp_fm_get_submatrix(moloc_coeff(myspin), tmp_mat, 1, 1, nao, nguess)
408 0 : CALL cp_fm_set_submatrix(mos_guess, tmp_mat, 1, 1, nao, nguess)
409 0 : DEALLOCATE (tmp_mat)
410 0 : ngextra = nmosub - nguess
411 : !WRITE(*,*) 'nguess, ngextra = ', nguess, ngextra
412 0 : CALL cp_fm_struct_release(tmp_fm_struct)
413 0 : IF (ngextra > 0) THEN
414 : CALL cp_fm_struct_create(tmp_fm_struct, nrow_global=nao, &
415 : ncol_global=ngextra, para_env=para_env, &
416 0 : context=mo_coeff%matrix_struct%context)
417 0 : CALL cp_fm_create(tmp_fm, tmp_fm_struct)
418 0 : CALL cp_fm_init_random(tmp_fm, ngextra)
419 0 : ALLOCATE (tmp_mat(nao, ngextra))
420 0 : CALL cp_fm_get_submatrix(tmp_fm, tmp_mat, 1, 1, nao, ngextra)
421 0 : CALL cp_fm_set_submatrix(mos_guess, tmp_mat, 1, nguess + 1, nao, ngextra)
422 0 : DEALLOCATE (tmp_mat)
423 0 : CALL cp_fm_release(tmp_fm)
424 0 : CALL cp_fm_struct_release(tmp_fm_struct)
425 : ELSE
426 : do_ortho = .FALSE.
427 : END IF
428 0 : ALLOCATE (tmp_mat(nao, nmosub))
429 0 : CALL cp_fm_get_submatrix(mo_coeff, tmp_mat, 1, 1, nao, nmosub)
430 0 : CALL cp_fm_set_submatrix(moloc_coeff(myspin), tmp_mat)
431 0 : DEALLOCATE (tmp_mat)
432 : END IF
433 :
434 2 : IF (do_ortho) THEN
435 : IF ((my_guess_atomic) .OR. (my_guess_wan)) THEN
436 : !! and ortho the result
437 2 : IF (has_unit_metric) THEN
438 0 : CALL make_basis_simple(mos_guess, ndummy)
439 : ELSE
440 2 : CALL make_basis_sm(mos_guess, ndummy, refmatrix)
441 : END IF
442 : END IF
443 : END IF
444 :
445 : CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
446 : op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
447 : restricted=restricted, &
448 2 : nextra=nextra, nmo=nmo, vectors_2=vectors_2, guess_mos=mos_guess)
449 2 : CALL cp_fm_release(mos_guess)
450 : ELSE
451 : CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
452 : op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
453 : restricted=restricted, &
454 0 : nextra=nextra, nmo=nmo, vectors_2=vectors_2)
455 : END IF
456 2 : CALL cp_fm_release(vectors_2)
457 4 : IF (my_guess_atomic) CALL dbcsr_deallocate_matrix_set(p_rmpv)
458 : ELSE
459 : CALL optimize_loc_berry(loc_method, qs_loc_env, moloc_coeff(myspin), op_sm_set, &
460 : op_fm_set, para_env, cell, weights, myspin, print_loc_section, &
461 0 : restricted=restricted, nextra=0)
462 : END IF
463 :
464 2 : CALL timestop(handle)
465 :
466 2 : END SUBROUTINE loc_mixed_method
467 :
468 : ! **************************************************************************************************
469 : !> \brief printing of Cube files of localized orbitals
470 : !> \param qs_env ...
471 : !> \param qs_loc_env ...
472 : !> \param moloc_coeff ...
473 : !> \param ispin ...
474 : !> \param print_loc_section ...
475 : ! **************************************************************************************************
476 6 : SUBROUTINE loc_print(qs_env, qs_loc_env, moloc_coeff, ispin, print_loc_section)
477 :
478 : TYPE(qs_environment_type), POINTER :: qs_env
479 : TYPE(qs_loc_env_type), POINTER :: qs_loc_env
480 : TYPE(cp_fm_type), DIMENSION(:), POINTER :: moloc_coeff
481 : INTEGER, INTENT(IN), OPTIONAL :: ispin
482 : TYPE(section_vals_type), POINTER :: print_loc_section
483 :
484 : CHARACTER(LEN=default_string_length) :: my_pos
485 : INTEGER :: i, ir, istate, j, jstate, n_rep, ncubes, &
486 : nmo
487 6 : INTEGER, DIMENSION(:), POINTER :: bounds, list, list_cubes
488 : LOGICAL :: append_cube, list_cubes_setup
489 6 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: centers
490 : TYPE(localized_wfn_control_type), POINTER :: localized_wfn_control
491 : TYPE(section_vals_type), POINTER :: print_key
492 :
493 6 : list_cubes_setup = .FALSE.
494 6 : NULLIFY (bounds, list, list_cubes)
495 :
496 : CALL get_qs_loc_env(qs_loc_env=qs_loc_env, &
497 6 : localized_wfn_control=localized_wfn_control)
498 :
499 : ! Provides boundaries of MOs
500 : CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LU_BOUNDS", &
501 6 : i_vals=bounds)
502 6 : ncubes = bounds(2) - bounds(1) + 1
503 6 : IF (ncubes > 0) THEN
504 0 : list_cubes_setup = .TRUE.
505 0 : ALLOCATE (list_cubes(ncubes))
506 0 : DO ir = 1, ncubes
507 0 : list_cubes(ir) = bounds(1) + (ir - 1)
508 : END DO
509 : END IF
510 :
511 : ! Provides the list of MOs
512 : CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LIST", &
513 6 : n_rep_val=n_rep)
514 6 : IF (.NOT. list_cubes_setup) THEN
515 6 : ncubes = 0
516 6 : DO ir = 1, n_rep
517 : CALL section_vals_val_get(print_loc_section, "WANNIER_CUBES%CUBES_LIST", &
518 0 : i_rep_val=ir, i_vals=list)
519 6 : IF (ASSOCIATED(list)) THEN
520 0 : CALL reallocate(list_cubes, 1, ncubes + SIZE(list))
521 0 : DO i = 1, SIZE(list)
522 0 : list_cubes(i + ncubes) = list(i)
523 : END DO
524 0 : ncubes = ncubes + SIZE(list)
525 : END IF
526 : END DO
527 6 : IF (ncubes > 0) list_cubes_setup = .TRUE.
528 : END IF
529 :
530 : ! Full list of Mos
531 : IF (.NOT. list_cubes_setup) THEN
532 6 : list_cubes_setup = .TRUE.
533 6 : ncubes = localized_wfn_control%nloc_states(1)
534 6 : IF (ncubes > 0) THEN
535 18 : ALLOCATE (list_cubes(ncubes))
536 : END IF
537 42 : DO i = 1, ncubes
538 42 : list_cubes(i) = i
539 : END DO
540 : END IF
541 :
542 6 : ncubes = SIZE(list_cubes)
543 6 : ncubes = MIN(ncubes, nmo)
544 12 : ALLOCATE (centers(6, ncubes))
545 6 : DO i = 1, ncubes
546 0 : istate = list_cubes(i)
547 6 : DO j = 1, localized_wfn_control%nloc_states(ispin)
548 0 : jstate = localized_wfn_control%loc_states(j, ispin)
549 0 : IF (istate == jstate) THEN
550 0 : centers(1:6, i) = localized_wfn_control%centers_set(ispin)%array(1:6, j)
551 : EXIT
552 : END IF
553 : END DO
554 : END DO ! ncubes
555 :
556 : ! Real call for dumping the cube files
557 6 : print_key => section_vals_get_subs_vals(print_loc_section, "WANNIER_CUBES")
558 6 : append_cube = section_get_lval(print_loc_section, "WANNIER_CUBES%APPEND")
559 6 : my_pos = "REWIND"
560 6 : IF (append_cube) THEN
561 0 : my_pos = "APPEND"
562 : END IF
563 :
564 : CALL qs_print_cubes(qs_env, moloc_coeff(ispin), ncubes, list_cubes, centers, &
565 : print_key, "loc"//TRIM(ADJUSTL(qs_loc_env%tag_mo)), &
566 6 : ispin=ispin, file_position=my_pos)
567 :
568 6 : DEALLOCATE (centers)
569 6 : DEALLOCATE (list_cubes)
570 :
571 12 : END SUBROUTINE loc_print
572 :
573 : END MODULE qs_loc_main
|
