110#include "./base/base_uses.f90"
118 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_loc_methods'
159 zij_fm_set, para_env, cell, weights, ispin, print_loc_section, &
160 restricted, nextra, nmo, vectors_2, guess_mos)
162 INTEGER,
INTENT(IN) :: method
165 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: op_sm_set
166 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij_fm_set
169 REAL(
dp),
DIMENSION(:) :: weights
170 INTEGER,
INTENT(IN) :: ispin
172 INTEGER :: restricted
173 INTEGER,
INTENT(IN),
OPTIONAL :: nextra, nmo
174 TYPE(
cp_fm_type),
INTENT(IN),
OPTIONAL :: vectors_2, guess_mos
176 CHARACTER(len=*),
PARAMETER :: routinen =
'optimize_loc_berry'
178 INTEGER :: handle, max_iter, nao, nmoloc, out_each, &
180 LOGICAL :: converged, crazy_use_diag, &
181 do_jacobi_refinement, my_do_mixed
182 REAL(
dp) :: crazy_scale, eps_localization, &
183 max_crazy_angle, start_time, &
187 CALL timeset(routinen, handle)
190 extension=
".locInfo")
195 CALL zij_matrix(vectors, op_sm_set, zij_fm_set)
197 max_iter = qs_loc_env%localized_wfn_control%max_iter
198 max_crazy_angle = qs_loc_env%localized_wfn_control%max_crazy_angle
199 crazy_use_diag = qs_loc_env%localized_wfn_control%crazy_use_diag
200 crazy_scale = qs_loc_env%localized_wfn_control%crazy_scale
201 eps_localization = qs_loc_env%localized_wfn_control%eps_localization
202 out_each = qs_loc_env%localized_wfn_control%out_each
203 target_time = qs_loc_env%target_time
204 start_time = qs_loc_env%start_time
205 do_jacobi_refinement = qs_loc_env%localized_wfn_control%jacobi_refinement
206 my_do_mixed = qs_loc_env%localized_wfn_control%do_mixed
209 ispin, print_loc_section, only_initial_out=.true.)
215 CALL jacobi_rotations(weights, zij_fm_set, vectors, para_env, max_iter=max_iter, &
216 eps_localization=eps_localization, sweeps=sweeps, &
217 out_each=out_each, target_time=target_time, start_time=start_time, &
218 restricted=restricted)
220 IF (my_do_mixed)
THEN
222 IF (
PRESENT(guess_mos))
THEN
224 eps_localization, sweeps, out_each, nextra, &
225 qs_loc_env%localized_wfn_control%do_cg_po, &
226 nmo=nmo, vectors_2=vectors_2, mos_guess=guess_mos)
229 eps_localization, sweeps, out_each, nextra, &
230 qs_loc_env%localized_wfn_control%do_cg_po, &
231 nmo=nmo, vectors_2=vectors_2)
235 eps_localization, sweeps, out_each, 0, &
236 qs_loc_env%localized_wfn_control%do_cg_po)
239 cpabort(
"GAPO works only with STATES MIXED")
245 CALL zij_matrix(vectors, op_sm_set, zij_fm_set)
246 IF (do_jacobi_refinement)
THEN
249 ispin, print_loc_section, only_initial_out=.true.)
250 CALL jacobi_rotations(weights, zij_fm_set, vectors, para_env, max_iter=max_iter, &
251 eps_localization=eps_localization, sweeps=sweeps, &
252 out_each=out_each, target_time=target_time, start_time=start_time, &
253 restricted=restricted)
256 CALL crazy_rotations(weights, zij_fm_set, vectors, max_iter=max_iter, max_crazy_angle=max_crazy_angle, &
257 crazy_scale=crazy_scale, crazy_use_diag=crazy_use_diag, &
258 eps_localization=eps_localization, iterations=sweeps, converged=converged)
260 IF (.NOT. converged)
THEN
261 IF (qs_loc_env%localized_wfn_control%jacobi_fallback)
THEN
262 IF (output_unit > 0)
WRITE (output_unit,
"(T4,A,I6,/,T4,A)") &
263 " Crazy Wannier localization not converged after ", sweeps, &
264 " iterations, switching to jacobi rotations"
265 CALL jacobi_rotations(weights, zij_fm_set, vectors, para_env, max_iter=max_iter, &
266 eps_localization=eps_localization, sweeps=sweeps, &
267 out_each=out_each, target_time=target_time, start_time=start_time, &
268 restricted=restricted)
270 IF (output_unit > 0)
WRITE (output_unit,
"(T4,A,I6,/,T4,A)") &
271 " Crazy Wannier localization not converged after ", sweeps, &
272 " iterations, and jacobi_fallback switched off "
276 CALL direct_mini(weights, zij_fm_set, vectors, max_iter=max_iter, &
277 eps_localization=eps_localization, iterations=sweeps)
279 IF (.NOT. cell%orthorhombic)
THEN
280 cpabort(
"Non-orthorhombic cell with the selected method NYI")
284 CALL zij_matrix(vectors, op_sm_set, zij_fm_set)
287 IF (output_unit > 0)
THEN
288 WRITE (output_unit,
'(T4,A,I6,A)')
" No MOS localization applied "
291 cpabort(
"Unknown localization method")
293 IF (output_unit > 0)
THEN
294 IF (sweeps <= max_iter)
WRITE (output_unit,
'(T4,A,I3,A,I6,A)')
" Localization for spin ", ispin, &
295 " converged in ", sweeps,
" iterations"
299 ispin, print_loc_section)
303 CALL timestop(handle)
321 ispin, print_loc_section)
323 INTEGER,
INTENT(IN) :: method
326 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij_fm_set
327 INTEGER,
INTENT(IN) :: ispin
330 CHARACTER(len=*),
PARAMETER :: routinen =
'optimize_loc_pipek'
332 INTEGER :: handle, iatom, isgf, ldz, nao, natom, &
333 ncol, nmoloc, output_unit, sweeps
334 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: first_sgf, last_sgf, nsgf
341 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
343 CALL timeset(routinen, handle)
346 extension=
".locInfo")
348 NULLIFY (particle_set)
356 CALL get_qs_env(qs_env=qs_env, matrix_s=matrix_s, &
357 particle_set=particle_set, qs_kind_set=qs_kind_set)
359 natom =
SIZE(particle_set, 1)
360 ALLOCATE (first_sgf(natom))
361 ALLOCATE (last_sgf(natom))
362 ALLOCATE (nsgf(natom))
366 first_sgf=first_sgf, last_sgf=last_sgf, nsgf=nsgf)
369 CALL mpools_get(qs_env%mpools, ao_ao_fm_pools=ao_ao_fm_pools)
378 isgf = first_sgf(iatom)
382 CALL parallel_gemm(
'N',
'N', nao, nmoloc, nao, 1.0_dp, ov_fm, vectors, 0.0_dp, opvec, &
383 a_first_col=1, a_first_row=1, b_first_col=1, b_first_row=1)
385 CALL parallel_gemm(
'T',
'N', nmoloc, nmoloc, ncol, 0.5_dp, vectors, opvec, &
386 0.0_dp, zij_fm_set(iatom, 1), &
387 a_first_col=1, a_first_row=isgf, b_first_col=1, b_first_row=isgf)
389 CALL parallel_gemm(
'N',
'N', nao, nmoloc, ncol, 1.0_dp, ov_fm, vectors, 0.0_dp, opvec, &
390 a_first_col=isgf, a_first_row=1, b_first_col=1, b_first_row=isgf)
392 CALL parallel_gemm(
'T',
'N', nmoloc, nmoloc, nao, 0.5_dp, vectors, opvec, &
393 1.0_dp, zij_fm_set(iatom, 1), &
394 a_first_col=1, a_first_row=1, b_first_col=1, b_first_row=1)
403 cpabort(
"GAPO and Pipek not implemented.")
405 cpabort(
"Crazy and Pipek not implemented.")
407 cpabort(
"L1 norm and Pipek not implemented.")
409 cpabort(
"Direct and Pipek not implemented.")
411 IF (output_unit > 0)
WRITE (output_unit,
'(A,I6,A)')
" No MOS localization applied "
413 cpabort(
"Unknown localization method")
416 IF (output_unit > 0)
WRITE (output_unit,
'(A,I3,A,I6,A)')
" Localization for spin ", ispin, &
417 " converged in ", sweeps,
" iterations"
419 CALL centers_spreads_pipek(qs_loc_env, zij_fm_set, particle_set, ispin, &
422 DEALLOCATE (first_sgf, last_sgf, nsgf)
427 CALL timestop(handle)
443 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij_fm_set
447 INTEGER :: iatom, istate, jstate, natom, nstate
448 REAL(kind=
dp) :: aij, bij, ct, mii, mij, mjj, ratio, st, &
456 tolerance = 1.0e10_dp
458 natom =
SIZE(zij_fm_set, 1)
460 DO WHILE (tolerance >= 1.0e-4_dp)
462 DO istate = 1, nstate
463 DO jstate = istate + 1, nstate
470 aij = aij + mij*(mii - mjj)
471 bij = bij + mij*mij - 0.25_dp*(mii - mjj)*(mii - mjj)
473 IF (abs(bij) > 1.e-10_dp)
THEN
475 theta = 0.25_dp*atan(ratio)
482 IF (theta >
pi*0.5_dp)
THEN
483 theta = theta -
pi*0.25_dp
484 ELSE IF (theta < -
pi*0.5_dp)
THEN
485 theta = theta +
pi*0.25_dp
499 CALL check_tolerance_real(zij_fm_set, tolerance)
515 SUBROUTINE check_tolerance_real(zij_fm_set, tolerance)
517 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij_fm_set
518 REAL(
dp),
INTENT(OUT) :: tolerance
520 INTEGER :: iatom, istate, jstate, natom, &
521 ncol_local, nrow_global, nrow_local
522 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
523 REAL(
dp) :: grad_ij, zii, zij, zjj
524 REAL(
dp),
DIMENSION(:, :),
POINTER :: diag
527 CALL cp_fm_create(force, zij_fm_set(1, 1)%matrix_struct)
530 NULLIFY (diag, col_indices, row_indices)
531 natom =
SIZE(zij_fm_set, 1)
533 ncol_local=ncol_local, nrow_global=nrow_global, &
534 row_indices=row_indices, col_indices=col_indices)
535 ALLOCATE (diag(nrow_global, natom))
538 DO istate = 1, nrow_global
539 CALL cp_fm_get_element(zij_fm_set(iatom, 1), istate, istate, diag(istate, iatom))
543 DO istate = 1, nrow_local
544 DO jstate = 1, ncol_local
547 zii = diag(row_indices(istate), iatom)
548 zjj = diag(col_indices(jstate), iatom)
549 zij = zij_fm_set(iatom, 1)%local_data(istate, jstate)
550 grad_ij = grad_ij + 4.0_dp*zij*(zjj - zii)
552 force%local_data(istate, jstate) = grad_ij
561 END SUBROUTINE check_tolerance_real
577 print_loc_section, only_initial_out)
579 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij
580 INTEGER,
INTENT(IN) :: nmoloc
582 REAL(
dp),
DIMENSION(:) :: weights
583 INTEGER,
INTENT(IN) :: ispin
585 LOGICAL,
INTENT(IN),
OPTIONAL :: only_initial_out
587 CHARACTER(len=default_path_length) :: file_tmp, iter
588 COMPLEX(KIND=dp) :: z
589 INTEGER :: idir, istate, jdir, nstates, &
590 output_unit, unit_out_s
591 LOGICAL :: my_only_init
592 REAL(
dp) :: avg_spread_ii, spread_i, spread_ii, &
593 sum_spread_i, sum_spread_ii
594 REAL(
dp),
DIMENSION(3) :: c, c2, cpbc
595 REAL(
dp),
DIMENSION(:, :),
POINTER :: centers
596 REAL(kind=
dp) :: imagpart, realpart
600 NULLIFY (centers, logger, print_key)
602 my_only_init = .false.
603 IF (
PRESENT(only_initial_out)) my_only_init = only_initial_out
605 file_tmp = trim(qs_loc_env%tag_mo)//
"_spreads_s"//trim(adjustl(
cp_to_string(ispin)))
607 extension=
".locInfo")
609 middle_name=file_tmp, extension=
".data")
611 IF (unit_out_s > 0 .AND. .NOT. my_only_init)
WRITE (unit_out_s,
'(i6,/,A)') nmoloc, trim(iter)
614 cpassert(nstates >= nmoloc)
616 centers => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
617 cpassert(
ASSOCIATED(centers))
618 cpassert(
SIZE(centers, 2) == nmoloc)
619 sum_spread_i = 0.0_dp
620 sum_spread_ii = 0.0_dp
621 avg_spread_ii = 0.0_dp
622 DO istate = 1, nmoloc
627 DO jdir = 1,
SIZE(zij, 2)
630 z = cmplx(realpart, imagpart,
dp)
631 spread_i = spread_i - weights(jdir)* &
632 log(realpart*realpart + imagpart*imagpart)/
twopi/
twopi
633 spread_ii = spread_ii + weights(jdir)* &
634 (1.0_dp - (realpart*realpart + imagpart*imagpart))/
twopi/
twopi
637 c(idir) = c(idir) + &
638 (cell%hmat(idir, jdir)/
twopi)*aimag(log(z))
643 centers(1:3, istate) = cpbc(1:3)
644 centers(4, istate) = spread_i
645 centers(5, istate) = spread_ii
646 sum_spread_i = sum_spread_i + centers(4, istate)
647 sum_spread_ii = sum_spread_ii + centers(5, istate)
648 IF (unit_out_s > 0 .AND. .NOT. my_only_init)
WRITE (unit_out_s,
'(I6,2F16.8)') istate, centers(4:5, istate)
650 avg_spread_ii = sum_spread_ii/real(nmoloc, kind=
dp)
654 IF (.NOT. my_only_init)
CALL print_wannier_centers(qs_loc_env, print_key, centers, logger, ispin)
656 IF (output_unit > 0)
THEN
657 WRITE (output_unit,
'(T4, A, 2x, 2A26,/,T23, A28)')
" Spread Functional ",
"sum_in -w_i ln(|z_in|^2)", &
658 "sum_in w_i(1-|z_in|^2)",
"sum_in w_i(1-|z_in|^2)/n"
659 IF (my_only_init)
THEN
660 WRITE (output_unit,
'(T4,A,T38,2F20.10,/,T38,F20.10)')
" Initial Spread (Berry) : ", &
661 sum_spread_i, sum_spread_ii, avg_spread_ii
663 WRITE (output_unit,
'(T4,A,T38,2F20.10,/,T38,F20.10)')
" Total Spread (Berry) : ", &
664 sum_spread_i, sum_spread_ii, avg_spread_ii
668 IF (unit_out_s > 0 .AND. .NOT. my_only_init)
WRITE (unit_out_s,
'(A,2F16.10)')
" Total ", sum_spread_i, sum_spread_ii
686 SUBROUTINE centers_spreads_pipek(qs_loc_env, zij_fm_set, particle_set, ispin, &
690 TYPE(
cp_fm_type),
DIMENSION(:, :),
INTENT(IN) :: zij_fm_set
692 INTEGER,
INTENT(IN) :: ispin
695 CHARACTER(len=default_path_length) :: file_tmp, iter
696 INTEGER :: iatom, istate, natom, nstate, unit_out_s
697 INTEGER,
DIMENSION(:),
POINTER :: atom_of_state
699 REAL(
dp),
ALLOCATABLE,
DIMENSION(:) :: qii, ziimax
700 REAL(
dp),
ALLOCATABLE,
DIMENSION(:, :) :: diag
701 REAL(
dp),
DIMENSION(:, :),
POINTER :: centers
705 NULLIFY (centers, logger, print_key)
709 natom =
SIZE(zij_fm_set, 1)
711 centers => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
712 cpassert(
ASSOCIATED(centers))
713 cpassert(
SIZE(centers, 2) == nstate)
715 file_tmp = trim(qs_loc_env%tag_mo)//
"_spreads_s"//trim(adjustl(
cp_to_string(ispin)))
717 middle_name=file_tmp, extension=
".data", log_filename=.false.)
719 IF (unit_out_s > 0)
WRITE (unit_out_s,
'(i6,/,A)') trim(iter)
721 ALLOCATE (atom_of_state(nstate))
724 ALLOCATE (diag(nstate, natom))
728 DO istate = 1, nstate
729 CALL cp_fm_get_element(zij_fm_set(iatom, 1), istate, istate, diag(istate, iatom))
733 ALLOCATE (qii(nstate), ziimax(nstate))
738 DO istate = 1, nstate
739 qii(istate) = qii(istate) + diag(istate, iatom)*diag(istate, iatom)
740 IF (abs(diag(istate, iatom)) > ziimax(istate))
THEN
741 ziimax(istate) = abs(diag(istate, iatom))
742 atom_of_state(istate) = iatom
747 DO istate = 1, nstate
748 iatom = atom_of_state(istate)
749 r(1:3) = particle_set(iatom)%r(1:3)
750 centers(1:3, istate) = r(1:3)
751 centers(4, istate) = 1.0_dp/qii(istate)
752 IF (unit_out_s > 0)
WRITE (unit_out_s,
'(I6,F16.8)') istate,
angstrom*centers(4, istate)
757 CALL print_wannier_centers(qs_loc_env, print_key, centers, logger, ispin)
761 DEALLOCATE (qii, ziimax, atom_of_state, diag)
763 END SUBROUTINE centers_spreads_pipek
785 print_key, root, ispin, idir, state0, file_position)
789 INTEGER,
INTENT(IN) :: nstates
790 INTEGER,
DIMENSION(:),
POINTER :: state_list
791 REAL(
dp),
DIMENSION(:, :),
POINTER :: centers
793 CHARACTER(LEN=*) :: root
794 INTEGER,
INTENT(IN),
OPTIONAL :: ispin, idir
795 INTEGER,
OPTIONAL :: state0
796 CHARACTER(LEN=default_string_length),
OPTIONAL :: file_position
798 CHARACTER(len=*),
PARAMETER :: routinen =
'qs_print_cubes'
799 CHARACTER,
DIMENSION(3),
PARAMETER :: labels = (/
'x',
'y',
'z'/)
802 CHARACTER(LEN=default_path_length) :: file_tmp, filename, my_pos
803 CHARACTER(LEN=default_string_length) :: title
804 INTEGER :: handle, ia, ie, istate, ivector, &
805 my_ispin, my_state0, unit_out_c
806 LOGICAL :: add_idir, add_spin, mpi_io
817 TYPE(
qs_kind_type),
DIMENSION(:),
POINTER :: qs_kind_set
820 CALL timeset(routinen, handle)
821 NULLIFY (auxbas_pw_pool, pw_env, logger)
824 CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, subsys=subsys)
827 CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool)
829 CALL auxbas_pw_pool%create_pw(wf_r)
830 CALL auxbas_pw_pool%create_pw(wf_g)
833 IF (
PRESENT(state0)) my_state0 = state0
837 IF (
PRESENT(ispin))
THEN
842 IF (
PRESENT(idir))
THEN
848 IF (
PRESENT(file_position))
THEN
849 my_pos = file_position
852 DO istate = 1, nstates
853 ivector = state_list(istate) - my_state0
854 CALL get_qs_env(qs_env=qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, cell=cell, &
855 dft_control=dft_control, particle_set=particle_set, pw_env=pw_env)
858 qs_kind_set, cell, dft_control, particle_set, pw_env)
861 ivector = state_list(istate)
864 filename = root(ia:ie)//
"_"//label//
"_w"//trim(adjustl(
cp_to_string(ivector)))
866 filename = root(ia:ie)//
"_w"//trim(adjustl(
cp_to_string(ivector)))
871 filename = file_tmp(ia:ie)//
"_s"//trim(adjustl(
cp_to_string(ispin)))
877 extension=
".cube", file_position=my_pos, log_filename=.false., &
879 IF (
SIZE(centers, 1) == 6)
THEN
880 WRITE (title,
'(A7,I5.5,A2,I1.1,A1,6F10.4)')
"WFN ", ivector,
"_s", my_ispin,
" ", &
883 WRITE (title,
'(A7,I5.5,A2,I1.1,A1,3F10.4)')
"WFN ", ivector,
"_s", my_ispin,
" ", &
887 particles=particles, &
892 CALL auxbas_pw_pool%give_back_pw(wf_r)
893 CALL auxbas_pw_pool%give_back_pw(wf_g)
894 CALL timestop(handle)
905 SUBROUTINE print_wannier_centers(qs_loc_env, print_key, center, logger, ispin)
908 REAL(kind=
dp),
INTENT(IN) :: center(:, :)
910 INTEGER,
INTENT(IN) :: ispin
912 CHARACTER(default_string_length) :: iter, unit_str
913 CHARACTER(LEN=default_string_length) :: my_ext, my_form
914 INTEGER :: iunit, l, nstates
915 LOGICAL :: first_time, init_traj
916 REAL(kind=
dp) :: unit_conv
918 nstates =
SIZE(center, 2)
919 my_form =
"formatted"
928 IF (first_time .OR. (.NOT. qs_loc_env%first_time))
THEN
930 middle_name=trim(qs_loc_env%tag_mo)//
"_centers_s"//trim(adjustl(
cp_to_string(ispin))), &
931 log_filename=.false., on_file=.true., is_new_file=init_traj)
939 CALL print_wannier_traj(qs_loc_env, print_key, center, iunit, init_traj, unit_conv)
943 WRITE (iunit,
'(i6,/,a)') nstates, trim(iter)
945 WRITE (iunit,
'(A,4F16.8)')
"X", unit_conv*center(1:4, l)
952 END SUBROUTINE print_wannier_centers
963 SUBROUTINE print_wannier_traj(qs_loc_env, print_key, center, iunit, init_traj, unit_conv)
966 REAL(kind=
dp),
INTENT(IN) :: center(:, :)
967 INTEGER,
INTENT(IN) :: iunit
968 LOGICAL,
INTENT(IN) :: init_traj
969 REAL(kind=
dp),
INTENT(IN) :: unit_conv
971 CHARACTER(len=default_string_length) :: iter, remark1, remark2, title
972 INTEGER :: i, iskip, natom, ntot, outformat
978 NULLIFY (particle_set, atomic_kind_set, atomic_kind, logger)
980 natom =
SIZE(qs_loc_env%particle_set)
981 ntot = natom +
SIZE(center, 2)
983 ALLOCATE (atomic_kind_set(1))
984 atomic_kind => atomic_kind_set(1)
986 name=
"X", element_symbol=
"X", mass=0.0_dp)
989 particle_set(i)%atomic_kind => qs_loc_env%particle_set(i)%atomic_kind
990 particle_set(i)%r =
pbc(qs_loc_env%particle_set(i)%r, qs_loc_env%cell)
993 DO i = natom + 1, ntot
994 particle_set(i)%atomic_kind => atomic_kind
995 particle_set(i)%r =
pbc(center(1:3, i - natom), qs_loc_env%cell)
1001 SELECT CASE (outformat)
1012 WRITE (iunit)
"CORD", 0, -1, iskip, &
1013 0, 0, 0, 0, 0, 0, real(0, kind=
sp), 1, 0, 0, 0, 0, 0, 0, 0, 0, 24
1014 remark1 =
"REMARK FILETYPE CORD DCD GENERATED BY CP2K"
1015 remark2 =
"REMARK Support new DCD format with cell information"
1016 WRITE (iunit) 2, remark1, remark2
1022 WRITE (unit=title, fmt=
"(A)")
" Particles+Wannier centers. Iteration:"//trim(iter)
1027 unit_conv=unit_conv)
1031 END SUBROUTINE print_wannier_traj
1049 INTEGER,
INTENT(IN) :: ispin
1051 INTEGER,
PARAMETER :: norder = 2
1052 LOGICAL,
PARAMETER :: debug_this_subroutine = .false.
1054 CHARACTER(len=default_path_length) :: file_tmp
1055 INTEGER :: imoment, istate, ncol_global, nm, &
1056 nmoloc, nrow_global, output_unit, &
1058 REAL(
dp),
DIMENSION(:, :),
POINTER :: centers
1059 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: moment_set
1060 REAL(kind=
dp),
DIMENSION(3) :: rcc
1061 REAL(kind=
dp),
DIMENSION(6) :: cov
1064 TYPE(
cp_fm_type),
DIMENSION(:),
POINTER :: moloc_coeff
1067 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_s, moments
1073 extension=
".locInfo")
1075 IF (output_unit > 0)
THEN
1076 WRITE (output_unit,
'(/,T2,A)') &
1077 '!-----------------------------------------------------------------------------!'
1078 WRITE (output_unit,
'(T12,A)')
"Computing second moments of Wannier functions..."
1079 WRITE (output_unit,
'(T2,A)') &
1080 '!-----------------------------------------------------------------------------!'
1083 file_tmp =
"_r_loc_cov_matrix_"//trim(adjustl(
cp_to_string(ispin)))
1085 middle_name=file_tmp, extension=
".data")
1087 CALL get_qs_loc_env(qs_loc_env=qs_loc_env, moloc_coeff=moloc_coeff)
1088 centers => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
1096 para_env => qs_loc_env%para_env
1099 ALLOCATE (moment_set(nm, nmoloc))
1102 mo_localized => moloc_coeff(ispin)
1104 DO istate = 1, nmoloc
1105 rcc = centers(1:3, istate)
1108 ALLOCATE (moments(nm))
1110 ALLOCATE (moments(imoment)%matrix)
1111 CALL dbcsr_copy(moments(imoment)%matrix, matrix_s(ispin)%matrix,
'MOM MAT')
1112 CALL dbcsr_set(moments(imoment)%matrix, 0.0_dp)
1118 CALL cp_fm_get_info(mo_localized, ncol_global=ncol_global, nrow_global=nrow_global)
1120 para_env=mo_localized%matrix_struct%para_env, &
1121 context=mo_localized%matrix_struct%context)
1123 CALL cp_fm_create(omvector, fm_struct, name=
"omvector")
1128 CALL cp_fm_to_fm(mo_localized, mvector, 1, istate, 1)
1134 moment_set(imoment, istate) = sum(momv%local_data)
1144 DEALLOCATE (moments)
1147 CALL para_env%sum(moment_set)
1149 IF (output_unit_sm > 0)
THEN
1150 WRITE (unit=output_unit_sm, fmt=
'(A,T13,A,I1)')
"#", &
1151 "SECOND MOMENTS OF WANNIER CENTERS FOR SPIN ", ispin
1152 WRITE (unit=output_unit_sm, fmt=
'(A,T29,A2,5(14x,A2))')
"#",
"XX",
"XY",
"XZ",
"YY",
"YZ",
"ZZ"
1153 DO istate = 1, nmoloc
1155 cov(1) = moment_set(4, istate) - moment_set(1, istate)*moment_set(1, istate)
1156 cov(2) = moment_set(5, istate) - moment_set(1, istate)*moment_set(2, istate)
1157 cov(3) = moment_set(6, istate) - moment_set(1, istate)*moment_set(3, istate)
1158 cov(4) = moment_set(7, istate) - moment_set(2, istate)*moment_set(2, istate)
1159 cov(5) = moment_set(8, istate) - moment_set(2, istate)*moment_set(3, istate)
1160 cov(6) = moment_set(9, istate) - moment_set(3, istate)*moment_set(3, istate)
1161 WRITE (unit=output_unit_sm, fmt=
'(T4,A,I6,6(T20,6F16.8))')
"Center:", istate, cov(1:6)
1162 IF (debug_this_subroutine)
THEN
1163 WRITE (unit=output_unit_sm, fmt=
'(T4,A,I5,9(T20,9F12.6))')
"Center:", istate, moment_set(1:, istate)
1170 DEALLOCATE (moment_set)
1192 INTEGER,
INTENT(IN) :: ispin
1194 INTEGER,
PARAMETER :: taylor_order = 1
1195 LOGICAL,
PARAMETER :: debug_this_subroutine = .false.
1197 CHARACTER(len=default_path_length) :: file_tmp
1198 COMPLEX(KIND=dp) :: z
1199 INTEGER :: icov, imoment, istate, ncol_global, nm, &
1200 nmoloc, norder, nrow_global, &
1201 output_unit, output_unit_sm
1202 REAL(
dp),
DIMENSION(:, :),
POINTER :: centers
1203 REAL(kind=
dp) :: imagpart, lx, ly, lz, realpart
1204 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :) :: moment_set
1205 REAL(kind=
dp),
DIMENSION(3) :: rcc
1206 REAL(kind=
dp),
DIMENSION(6) :: cov
1210 TYPE(
cp_fm_type),
DIMENSION(:),
POINTER :: moloc_coeff
1213 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: matrix_s, moments
1221 extension=
".locInfo")
1223 IF (output_unit > 0)
THEN
1224 WRITE (output_unit,
'(/,T2,A)') &
1225 '!-----------------------------------------------------------------------------!'
1226 WRITE (output_unit,
'(T12,A)')
"Computing second moments of Wannier functions..."
1227 WRITE (output_unit,
'(T2,A)') &
1228 '!-----------------------------------------------------------------------------!'
1231 file_tmp =
"_r_berry_cov_matrix_"//trim(adjustl(
cp_to_string(ispin)))
1233 middle_name=file_tmp, extension=
".data")
1235 norder = 2*(2*taylor_order + 1)
1236 nm = (6 + 11*norder + 6*norder**2 + norder**3)/6 - 1
1239 CALL get_qs_loc_env(qs_loc_env=qs_loc_env, moloc_coeff=moloc_coeff, cell=cell)
1240 lx = cell%hmat(1, 1)
1241 ly = cell%hmat(2, 2)
1242 lz = cell%hmat(3, 3)
1244 centers => qs_loc_env%localized_wfn_control%centers_set(ispin)%array
1246 para_env => qs_loc_env%para_env
1252 ALLOCATE (moment_set(nm, nmoloc))
1255 mo_localized => moloc_coeff(ispin)
1257 DO istate = 1, nmoloc
1258 rcc = centers(1:3, istate)
1261 ALLOCATE (moments(nm))
1263 ALLOCATE (moments(imoment)%matrix)
1264 CALL dbcsr_copy(moments(imoment)%matrix, matrix_s(ispin)%matrix,
'MOM MAT')
1265 CALL dbcsr_set(moments(imoment)%matrix, 0.0_dp)
1271 CALL cp_fm_get_info(mo_localized, ncol_global=ncol_global, nrow_global=nrow_global)
1273 para_env=mo_localized%matrix_struct%para_env, &
1274 context=mo_localized%matrix_struct%context)
1276 CALL cp_fm_create(omvector, fm_struct, name=
"omvector")
1281 CALL cp_fm_to_fm(mo_localized, mvector, 1, istate, 1)
1286 moment_set(imoment, istate) = sum(momv%local_data)
1296 DEALLOCATE (moments)
1299 CALL para_env%sum(moment_set)
1301 IF (output_unit_sm > 0)
THEN
1302 WRITE (unit=output_unit_sm, fmt=
'(A,T13,A,I1)')
"#", &
1303 "SECOND MOMENTS OF WANNIER CENTERS FOR SPIN ", ispin
1304 WRITE (unit=output_unit_sm, fmt=
'(A,T29,A2,5(14x,A2))')
"#",
"XX",
"XY",
"XZ",
"YY",
"YZ",
"ZZ"
1305 DO istate = 1, nmoloc
1310 z = cmplx(realpart, imagpart,
dp)
1315 realpart = 1.0 - 0.5*
twopi*
twopi/lx/lx/lx/lx &
1316 *moment_set(20, istate)
1317 imagpart =
twopi/lx/lx*moment_set(4, istate) &
1325 z = cmplx(realpart, imagpart,
dp)
1326 cov(1) = lx*lx/
twopi*aimag(log(z)) - lx*lx/
twopi/
twopi*moment_set(1, istate)*moment_set(1, istate)
1330 realpart = 1.0 - 0.5*
twopi*
twopi/lx/ly/lx/ly &
1331 *moment_set(23, istate)
1332 imagpart =
twopi/lx/ly*moment_set(5, istate) &
1340 z = cmplx(realpart, imagpart,
dp)
1341 cov(2) = lx*ly/
twopi*aimag(log(z)) - lx*ly/
twopi/
twopi*moment_set(1, istate)*moment_set(2, istate)
1345 realpart = 1.0 - 0.5*
twopi*
twopi/lx/lz/lx/lz &
1346 *moment_set(25, istate)
1347 imagpart =
twopi/lx/lz*moment_set(6, istate) &
1355 z = cmplx(realpart, imagpart,
dp)
1356 cov(3) = lx*lz/
twopi*aimag(log(z)) - lx*lz/
twopi/
twopi*moment_set(1, istate)*moment_set(3, istate)
1360 realpart = 1.0 - 0.5*
twopi*
twopi/ly/ly/ly/ly &
1361 *moment_set(30, istate)
1362 imagpart =
twopi/ly/ly*moment_set(7, istate) &
1370 z = cmplx(realpart, imagpart,
dp)
1371 cov(4) = ly*ly/
twopi*aimag(log(z)) - ly*ly/
twopi/
twopi*moment_set(2, istate)*moment_set(2, istate)
1375 realpart = 1.0 - 0.5*
twopi*
twopi/ly/lz/ly/lz &
1376 *moment_set(32, istate)
1377 imagpart =
twopi/ly/lz*moment_set(8, istate) &
1385 z = cmplx(realpart, imagpart,
dp)
1386 cov(5) = ly*lz/
twopi*aimag(log(z)) - ly*lz/
twopi/
twopi*moment_set(2, istate)*moment_set(3, istate)
1390 realpart = 1.0 - 0.5*
twopi*
twopi/lz/lz/lz/lz &
1391 *moment_set(34, istate)
1392 imagpart =
twopi/lz/lz*moment_set(9, istate) &
1400 z = cmplx(realpart, imagpart,
dp)
1401 cov(6) = lz*lz/
twopi*aimag(log(z)) - lz*lz/
twopi/
twopi*moment_set(3, istate)*moment_set(3, istate)
1405 WRITE (unit=output_unit_sm, fmt=
'(T4,A,I6,6(T20,6F16.8))')
"Center:", istate, cov(1:6)
1406 IF (debug_this_subroutine)
THEN
1407 WRITE (unit=output_unit_sm, fmt=
'(T4,A,I5,9(T20,9F12.6))')
"Center:", istate, moment_set(1:, istate)
1414 DEALLOCATE (moment_set)
Define the atomic kind types and their sub types.
subroutine, public set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, natom, atom_list, fist_potential, shell, shell_active, damping)
Set the components of an atomic kind data set.
subroutine, public deallocate_atomic_kind_set(atomic_kind_set)
Destructor routine for a set of atomic kinds.
Handles all functions related to the CELL.
Defines control structures, which contain the parameters and the settings for the DFT-based calculati...
subroutine, public dbcsr_deallocate_matrix(matrix)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_set(matrix, alpha)
...
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_sm_fm_multiply(matrix, fm_in, fm_out, ncol, alpha, beta)
multiply a dbcsr with a fm matrix
subroutine, public copy_dbcsr_to_fm(matrix, fm)
Copy a DBCSR matrix to a BLACS matrix.
basic linear algebra operations for full matrices
subroutine, public cp_fm_rot_rows(matrix, irow, jrow, cs, sn)
Applies a planar rotation defined by cs and sn to the i'th and j'th rows.
subroutine, public cp_fm_rot_cols(matrix, icol, jcol, cs, sn)
Applies a planar rotation defined by cs and sn to the i'th and j'th columnns.
subroutine, public cp_fm_schur_product(matrix_a, matrix_b, matrix_c)
computes the schur product of two matrices c_ij = a_ij * b_ij
pool for for elements that are retained and released
subroutine, public fm_pool_create_fm(pool, element, name)
returns an element, allocating it if none is in the pool
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_get_element(matrix, irow_global, icol_global, alpha, local)
returns an element of a fm this value is valid on every cpu using this call is expensive
subroutine, public cp_fm_maxabsval(matrix, a_max, ir_max, ic_max)
find the maximum absolute value of the matrix element maxval(abs(matrix))
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
character(len=default_string_length) function, public cp_iter_string(iter_info, print_key, for_file)
returns the iteration string, a string that is useful to create unique filenames (once you trim it)
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
integer, parameter, public cp_p_file
integer function, public cp_print_key_should_output(iteration_info, basis_section, print_key_path, used_print_key, first_time)
returns what should be done with the given property if btest(res,cp_p_store) then the property should...
A wrapper around pw_to_cube() which accepts particle_list_type.
subroutine, public cp_pw_to_cube(pw, unit_nr, title, particles, stride, zero_tails, silent, mpi_io)
...
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
Defines the basic variable types.
integer, parameter, public dp
integer, parameter, public default_string_length
integer, parameter, public default_path_length
integer, parameter, public sp
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
real(kind=dp), parameter, public twopi
Interface to the message passing library MPI.
Output Utilities for MOTION_SECTION.
subroutine, public get_output_format(section, path, my_form, my_ext)
Info on the unit to be opened to dump MD informations.
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:), allocatable, public ncoset
basic linear algebra operations for full matrixes
represent a simple array based list of the given type
Define methods related to particle_type.
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis)
Get the components of a particle set.
subroutine, public write_particle_coordinates(particle_set, iunit, output_format, content, title, cell, array, unit_conv, charge_occup, charge_beta, charge_extended, print_kind)
Should be able to write a few formats e.g. xmol, and some binary format (dcd) some format can be used...
Define the data structure for the particle information.
subroutine, public deallocate_particle_set(particle_set)
Deallocate a particle set.
subroutine, public allocate_particle_set(particle_set, nparticle)
Allocate a particle set.
Definition of physical constants:
real(kind=dp), parameter, public angstrom
container for various plainwaves related things
subroutine, public pw_env_get(pw_env, pw_pools, cube_info, gridlevel_info, auxbas_pw_pool, auxbas_grid, auxbas_rs_desc, auxbas_rs_grid, rs_descs, rs_grids, xc_pw_pool, vdw_pw_pool, poisson_env, interp_section)
returns the various attributes of the pw env
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Calculate the plane wave density by collocating the primitive Gaussian functions (pgf).
subroutine, public calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, pw_env, basis_type)
maps a given wavefunction on the grid
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, ecoul_1c, rho0_s_rs, rho0_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs)
Get the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
Driver for the localization that should be general for all the methods available and all the definiti...
subroutine, public optimize_loc_pipek(qs_env, method, qs_loc_env, vectors, zij_fm_set, ispin, print_loc_section)
...
subroutine, public centers_second_moments_berry(qs_env, qs_loc_env, print_loc_section, ispin)
Compute the second moments of the centers using a periodic quadrupole operator.
subroutine, public centers_second_moments_loc(qs_env, qs_loc_env, print_loc_section, ispin)
Compute the second moments of the centers using the local (non-periodic) pos operators.
subroutine, public optimize_loc_berry(method, qs_loc_env, vectors, op_sm_set, zij_fm_set, para_env, cell, weights, ispin, print_loc_section, restricted, nextra, nmo, vectors_2, guess_mos)
Calculate and optimize the spread functional as calculated from the selected mos and by the definitio...
subroutine, public centers_spreads_berry(qs_loc_env, zij, nmoloc, cell, weights, ispin, print_loc_section, only_initial_out)
...
subroutine, public qs_print_cubes(qs_env, mo_coeff, nstates, state_list, centers, print_key, root, ispin, idir, state0, file_position)
write the cube files for a set of selected states
subroutine, public jacobi_rotation_pipek(zij_fm_set, vectors, sweeps)
2by2 rotation for the pipek operator in this case the z_ij numbers are reals
New version of the module for the localization of the molecular orbitals This should be able to use d...
subroutine, public get_qs_loc_env(qs_loc_env, cell, local_molecules, localized_wfn_control, moloc_coeff, op_sm_set, op_fm_set, para_env, particle_set, weights, dim_op)
...
Localization methods such as 2x2 Jacobi rotations Steepest Decents Conjugate Gradient.
subroutine, public approx_l1_norm_sd(c, iterations, eps, converged, sweeps)
...
subroutine, public rotate_orbitals(rmat, vectors)
...
subroutine, public jacobi_rotations(weights, zij, vectors, para_env, max_iter, eps_localization, sweeps, out_each, target_time, start_time, restricted)
wrapper for the jacobi routines, should be removed if jacobi_rot_para can deal with serial para_envs.
subroutine, public zij_matrix(vectors, op_sm_set, zij_fm_set)
...
subroutine, public direct_mini(weights, zij, vectors, max_iter, eps_localization, iterations)
use the exponential parametrization as described in to perform a direct mini Gerd Berghold et al....
subroutine, public crazy_rotations(weights, zij, vectors, max_iter, max_crazy_angle, crazy_scale, crazy_use_diag, eps_localization, iterations, converged)
yet another crazy try, computes the angles needed to rotate the orbitals first and rotates them all a...
subroutine, public scdm_qrfact(vectors)
...
subroutine, public jacobi_cg_edf_ls(para_env, weights, zij, vectors, max_iter, eps_localization, iter, out_each, nextra, do_cg, nmo, vectors_2, mos_guess)
combine jacobi rotations (serial) and conjugate gradient with golden section line search for partiall...
wrapper for the pools of matrixes
subroutine, public mpools_get(mpools, ao_mo_fm_pools, ao_ao_fm_pools, mo_mo_fm_pools, ao_mosub_fm_pools, mosub_mosub_fm_pools, maxao_maxmo_fm_pool, maxao_maxao_fm_pool, maxmo_maxmo_fm_pool)
returns various attributes of the mpools (notably the pools contained in it)
Calculates the moment integrals <a|r^m|b> and <a|r x d/dr|b>
subroutine, public build_local_moment_matrix(qs_env, moments, nmoments, ref_point, ref_points, basis_type)
...
types that represent a quickstep subsys
subroutine, public qs_subsys_get(subsys, atomic_kinds, atomic_kind_set, particles, particle_set, local_particles, molecules, molecule_set, molecule_kinds, molecule_kind_set, local_molecules, para_env, colvar_p, shell_particles, core_particles, gci, multipoles, natom, nparticle, ncore, nshell, nkind, atprop, virial, results, cell, cell_ref, use_ref_cell, energy, force, qs_kind_set, cp_subsys, nelectron_total, nelectron_spin)
...
Utilities for string manipulations.
elemental subroutine, public xstring(string, ia, ib)
...
Provides all information about an atomic kind.
Type defining parameters related to the simulation cell.
to create arrays of pools
keeps the information about the structure of a full matrix
type of a logger, at the moment it contains just a print level starting at which level it should be l...
stores all the informations relevant to an mpi environment
represent a list of objects
contained for different pw related things
Manages a pool of grids (to be used for example as tmp objects), but can also be used to instantiate ...
Provides all information about a quickstep kind.
contains all the info needed by quickstep to calculate the spread of a selected set of orbitals and i...