(git:97501a3)
Loading...
Searching...
No Matches
population_analyses.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7! **************************************************************************************************
8!> \brief Provide various population analyses and print the requested output
9!> information
10!>
11!> \author Matthias Krack (MK)
12!> \date 09.07.2010
13!> \version 1.0
14! **************************************************************************************************
15
23 USE cp_dbcsr_api, ONLY: &
31 USE cp_fm_diag, ONLY: cp_fm_power
35 USE cp_fm_types, ONLY: cp_fm_create,&
42 USE kinds, ONLY: default_string_length,&
43 dp
44 USE machine, ONLY: m_flush
46 USE orbital_pointers, ONLY: nso
52 USE qs_kind_types, ONLY: get_qs_kind,&
55 USE qs_rho_types, ONLY: qs_rho_get,&
58#include "./base/base_uses.f90"
59
60 IMPLICIT NONE
61
62 PRIVATE
63
64 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'population_analyses'
65
68
69CONTAINS
70
71! **************************************************************************************************
72!> \brief Perform a Lowdin population analysis based on a symmetric
73!> orthogonalisation of the density matrix using S^(1/2)
74!>
75!> \param qs_env ...
76!> \param output_unit ...
77!> \param print_level ...
78!> \date 06.07.2010
79!> \author Matthias Krack (MK)
80!> \version 1.0
81! **************************************************************************************************
82 SUBROUTINE lowdin_population_analysis(qs_env, output_unit, print_level)
83
84 TYPE(qs_environment_type), POINTER :: qs_env
85 INTEGER, INTENT(IN) :: output_unit, print_level
86
87 CHARACTER(LEN=*), PARAMETER :: routinen = 'lowdin_population_analysis'
88
89 CHARACTER(LEN=default_string_length) :: headline
90 INTEGER :: handle, ispin, ndep, nsgf, nspin
91 LOGICAL :: print_gop
92 REAL(kind=dp), DIMENSION(:, :), POINTER :: orbpop
93 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
94 TYPE(cp_blacs_env_type), POINTER :: blacs_env
95 TYPE(cp_fm_struct_type), POINTER :: fmstruct
96 TYPE(cp_fm_type) :: fm_s_half, fm_work1, fm_work2
97 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_p
98 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrixkp_p, matrixkp_s
99 TYPE(dbcsr_type), POINTER :: sm_p, sm_s
100 TYPE(mp_para_env_type), POINTER :: para_env
101 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
102 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
103 TYPE(qs_rho_type), POINTER :: rho
104 TYPE(scf_control_type), POINTER :: scf_control
105
106 CALL timeset(routinen, handle)
107
108 NULLIFY (atomic_kind_set)
109 NULLIFY (qs_kind_set)
110 NULLIFY (fmstruct)
111 NULLIFY (matrix_p)
112 NULLIFY (matrixkp_p)
113 NULLIFY (matrixkp_s)
114 NULLIFY (orbpop)
115 NULLIFY (particle_set)
116 NULLIFY (rho)
117 NULLIFY (scf_control)
118 NULLIFY (sm_p)
119 NULLIFY (sm_s)
120 NULLIFY (orbpop)
121 NULLIFY (para_env)
122 NULLIFY (blacs_env)
123
124 CALL get_qs_env(qs_env=qs_env, &
125 atomic_kind_set=atomic_kind_set, &
126 qs_kind_set=qs_kind_set, &
127 matrix_s_kp=matrixkp_s, &
128 particle_set=particle_set, &
129 rho=rho, &
130 scf_control=scf_control, &
131 para_env=para_env, &
132 blacs_env=blacs_env)
133
134 cpassert(ASSOCIATED(atomic_kind_set))
135 cpassert(ASSOCIATED(qs_kind_set))
136 cpassert(ASSOCIATED(matrixkp_s))
137 cpassert(ASSOCIATED(particle_set))
138 cpassert(ASSOCIATED(rho))
139 cpassert(ASSOCIATED(scf_control))
140
141 IF (SIZE(matrixkp_s, 2) > 1) THEN
142
143 cpwarn("Lowdin population analysis not implemented for k-points.")
144
145 ELSE
146
147 sm_s => matrixkp_s(1, 1)%matrix ! Overlap matrix in sparse format
148 CALL qs_rho_get(rho, rho_ao_kp=matrixkp_p) ! Density matrices in sparse format
149
150 matrix_p => matrixkp_p(:, 1)
151 nspin = SIZE(matrix_p, 1)
152
153 ! Get the total number of contracted spherical Gaussian basis functions
154 CALL get_qs_kind_set(qs_kind_set, nsgf=nsgf)
155
156 ! Provide an array to store the orbital populations for each spin
157 ALLOCATE (orbpop(nsgf, nspin))
158 orbpop(:, :) = 0.0_dp
159
160 ! Write headline
161 IF (output_unit > 0) THEN
162 WRITE (unit=output_unit, fmt="(/,/,T2,A)") "LOWDIN POPULATION ANALYSIS"
163 END IF
164
165 ! Provide full size work matrices
166 CALL cp_fm_struct_create(fmstruct=fmstruct, &
167 para_env=para_env, &
168 context=blacs_env, &
169 nrow_global=nsgf, &
170 ncol_global=nsgf)
171 CALL cp_fm_create(matrix=fm_s_half, &
172 matrix_struct=fmstruct, &
173 name="S^(1/2) MATRIX")
174 CALL cp_fm_create(matrix=fm_work1, &
175 matrix_struct=fmstruct, &
176 name="FULL WORK MATRIX 1")
177 headline = "SYMMETRICALLY ORTHOGONALISED DENSITY MATRIX"
178 CALL cp_fm_create(matrix=fm_work2, &
179 matrix_struct=fmstruct, &
180 name=trim(headline))
181 CALL cp_fm_struct_release(fmstruct=fmstruct)
182
183 ! Build full S^(1/2) matrix (computationally expensive)
184 CALL copy_dbcsr_to_fm(sm_s, fm_s_half)
185 CALL cp_fm_power(fm_s_half, fm_work1, 0.5_dp, scf_control%eps_eigval, ndep)
186 IF (ndep /= 0) &
187 CALL cp_warn(__location__, &
188 "Overlap matrix exhibits linear dependencies. At least some "// &
189 "eigenvalues have been quenched.")
190
191 ! Build Lowdin population matrix for each spin
192 DO ispin = 1, nspin
193 sm_p => matrix_p(ispin)%matrix ! Density matrix for spin ispin in sparse format
194 ! Calculate S^(1/2)*P*S^(1/2) as a full matrix (Lowdin)
195 CALL cp_dbcsr_sm_fm_multiply(sm_p, fm_s_half, fm_work1, nsgf)
196 CALL parallel_gemm(transa="N", &
197 transb="N", &
198 m=nsgf, &
199 n=nsgf, &
200 k=nsgf, &
201 alpha=1.0_dp, &
202 matrix_a=fm_s_half, &
203 matrix_b=fm_work1, &
204 beta=0.0_dp, &
205 matrix_c=fm_work2)
206 IF (print_level > 2) THEN
207 ! Write the full Lowdin population matrix
208 IF (nspin > 1) THEN
209 IF (ispin == 1) THEN
210 fm_work2%name = trim(headline)//" FOR ALPHA SPIN"
211 ELSE
212 fm_work2%name = trim(headline)//" FOR BETA SPIN"
213 END IF
214 END IF
215 CALL write_fm_with_basis_info(fm_work2, 4, 6, qs_env, para_env, &
216 output_unit=output_unit)
217 END IF
218 CALL cp_fm_get_diag(fm_work2, orbpop(:, ispin))
219 END DO ! next spin ispin
220
221 ! Write atomic populations and charges
222 IF (output_unit > 0) THEN
223 print_gop = (print_level > 1) ! Print also orbital populations
224 CALL write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, output_unit, print_gop)
225 END IF
226
227 ! Release local working storage
228 CALL cp_fm_release(matrix=fm_s_half)
229 CALL cp_fm_release(matrix=fm_work1)
230 CALL cp_fm_release(matrix=fm_work2)
231 IF (ASSOCIATED(orbpop)) THEN
232 DEALLOCATE (orbpop)
233 END IF
234
235 END IF
236
237 CALL timestop(handle)
238
239 END SUBROUTINE lowdin_population_analysis
240
241! **************************************************************************************************
242!> \brief Perform a Mulliken population analysis
243!>
244!> \param qs_env ...
245!> \param output_unit ...
246!> \param print_level ...
247!> \date 10.07.2010
248!> \author Matthias Krack (MK)
249!> \version 1.0
250! **************************************************************************************************
251 SUBROUTINE mulliken_population_analysis(qs_env, output_unit, print_level)
252
253 TYPE(qs_environment_type), POINTER :: qs_env
254 INTEGER, INTENT(IN) :: output_unit, print_level
255
256 CHARACTER(LEN=*), PARAMETER :: routinen = 'mulliken_population_analysis'
257
258 CHARACTER(LEN=default_string_length) :: headline
259 INTEGER :: handle, iatom, ic, isgf, ispin, jatom, &
260 jsgf, natom, nsgf, nspin, sgfa, sgfb
261 INTEGER, ALLOCATABLE, DIMENSION(:) :: first_sgf_atom
262 LOGICAL :: found, print_gop
263 REAL(kind=dp) :: ps
264 REAL(kind=dp), DIMENSION(:, :), POINTER :: orbpop, p_block, ps_block, s_block
265 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
266 TYPE(dbcsr_iterator_type) :: iter
267 TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_p, matrix_s
268 TYPE(dbcsr_type), POINTER :: sm_p, sm_ps, sm_s
269 TYPE(mp_para_env_type), POINTER :: para_env
270 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
271 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
272 TYPE(qs_rho_type), POINTER :: rho
273
274 CALL timeset(routinen, handle)
275
276 NULLIFY (atomic_kind_set)
277 NULLIFY (qs_kind_set)
278 NULLIFY (matrix_p)
279 NULLIFY (matrix_s)
280 NULLIFY (orbpop)
281 NULLIFY (particle_set)
282 NULLIFY (ps_block)
283 NULLIFY (p_block)
284 NULLIFY (rho)
285 NULLIFY (sm_p)
286 NULLIFY (sm_ps)
287 NULLIFY (sm_s)
288 NULLIFY (s_block)
289 NULLIFY (para_env)
290
291 CALL get_qs_env(qs_env=qs_env, &
292 atomic_kind_set=atomic_kind_set, &
293 qs_kind_set=qs_kind_set, &
294 matrix_s_kp=matrix_s, &
295 particle_set=particle_set, &
296 rho=rho, &
297 para_env=para_env)
298
299 cpassert(ASSOCIATED(atomic_kind_set))
300 cpassert(ASSOCIATED(qs_kind_set))
301 cpassert(ASSOCIATED(particle_set))
302 cpassert(ASSOCIATED(rho))
303 cpassert(ASSOCIATED(matrix_s))
304
305 CALL qs_rho_get(rho, rho_ao_kp=matrix_p) ! Density matrices in sparse format
306 nspin = SIZE(matrix_p, 1)
307
308 ! Get the total number of contracted spherical Gaussian basis functions
309 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
310 CALL get_qs_kind_set(qs_kind_set, nsgf=nsgf)
311 ALLOCATE (first_sgf_atom(natom))
312 first_sgf_atom(:) = 0
313
314 CALL get_particle_set(particle_set, qs_kind_set, first_sgf=first_sgf_atom)
315
316 ! Provide an array to store the orbital populations for each spin
317 ALLOCATE (orbpop(nsgf, nspin))
318 orbpop(:, :) = 0.0_dp
319
320 ! Write headline
321 IF (output_unit > 0) THEN
322 WRITE (unit=output_unit, fmt="(/,T2,A)") &
323 '!-----------------------------------------------------------------------------!'
324 WRITE (unit=output_unit, fmt="(T22,A)") "Mulliken Population Analysis"
325 END IF
326
327 ! Create a DBCSR work matrix, if needed
328 IF (print_level > 2) THEN
329 sm_s => matrix_s(1, 1)%matrix ! Overlap matrix in sparse format
330 ALLOCATE (sm_ps)
331 headline = "MULLIKEN NET ATOMIC ORBITAL AND OVERLAP POPULATION MATRIX"
332 IF (nspin > 1) THEN
333 IF (ispin == 1) THEN
334 headline = trim(headline)//" For Alpha Spin"
335 ELSE
336 headline = trim(headline)//" For Beta Spin"
337 END IF
338 END IF
339 CALL dbcsr_copy(matrix_b=sm_ps, matrix_a=sm_s, name=trim(headline))
340 END IF
341
342 ! Build Mulliken population matrix for each spin
343 DO ispin = 1, nspin
344 DO ic = 1, SIZE(matrix_s, 2)
345 IF (print_level > 2) THEN
346 CALL dbcsr_set(sm_ps, 0.0_dp)
347 END IF
348 sm_s => matrix_s(1, ic)%matrix ! Overlap matrix in sparse format
349 sm_p => matrix_p(ispin, ic)%matrix ! Density matrix for spin ispin in sparse format
350 ! Calculate Hadamard product of P and S as sparse matrix (Mulliken)
351 ! CALL dbcsr_hadamard_product(sm_p,sm_s,sm_ps)
352 CALL dbcsr_iterator_start(iter, sm_s)
353 DO WHILE (dbcsr_iterator_blocks_left(iter))
354 CALL dbcsr_iterator_next_block(iter, iatom, jatom, s_block)
355 IF (.NOT. (ASSOCIATED(s_block))) cycle
356 CALL dbcsr_get_block_p(matrix=sm_p, &
357 row=iatom, &
358 col=jatom, &
359 block=p_block, &
360 found=found)
361 IF (print_level > 2) THEN
362 CALL dbcsr_get_block_p(matrix=sm_ps, &
363 row=iatom, &
364 col=jatom, &
365 block=ps_block, &
366 found=found)
367 cpassert(ASSOCIATED(ps_block))
368 END IF
369
370 sgfb = first_sgf_atom(jatom)
371 DO jsgf = 1, SIZE(s_block, 2)
372 DO isgf = 1, SIZE(s_block, 1)
373 ps = p_block(isgf, jsgf)*s_block(isgf, jsgf)
374 IF (ASSOCIATED(ps_block)) ps_block(isgf, jsgf) = ps_block(isgf, jsgf) + ps
375 orbpop(sgfb, ispin) = orbpop(sgfb, ispin) + ps
376 END DO
377 sgfb = sgfb + 1
378 END DO
379 IF (iatom /= jatom) THEN
380 sgfa = first_sgf_atom(iatom)
381 DO isgf = 1, SIZE(s_block, 1)
382 DO jsgf = 1, SIZE(s_block, 2)
383 ps = p_block(isgf, jsgf)*s_block(isgf, jsgf)
384 orbpop(sgfa, ispin) = orbpop(sgfa, ispin) + ps
385 END DO
386 sgfa = sgfa + 1
387 END DO
388 END IF
389 END DO
390 CALL dbcsr_iterator_stop(iter)
391 END DO
392
393 IF (print_level > 2) THEN
394 ! Write the full Mulliken net AO and overlap population matrix
395 CALL cp_dbcsr_write_sparse_matrix(sm_ps, 4, 6, qs_env, para_env, output_unit=output_unit)
396 END IF
397 END DO
398
399 CALL para_env%sum(orbpop)
400
401 ! Write atomic populations and charges
402 IF (output_unit > 0) THEN
403 print_gop = (print_level > 1) ! Print also orbital populations
404 CALL write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, output_unit, print_gop)
405 END IF
406
407 ! Save the Mulliken charges to results
408 CALL save_mulliken_charges(orbpop, atomic_kind_set, qs_kind_set, particle_set, qs_env)
409
410 ! Release local working storage
411 IF (ASSOCIATED(sm_ps)) CALL dbcsr_deallocate_matrix(sm_ps)
412 IF (ASSOCIATED(orbpop)) THEN
413 DEALLOCATE (orbpop)
414 END IF
415 IF (ALLOCATED(first_sgf_atom)) THEN
416 DEALLOCATE (first_sgf_atom)
417 END IF
418
419 IF (output_unit > 0) THEN
420 WRITE (unit=output_unit, fmt="(T2,A)") &
421 '!-----------------------------------------------------------------------------!'
422 END IF
423
424 CALL timestop(handle)
425
426 END SUBROUTINE mulliken_population_analysis
427
428! **************************************************************************************************
429!> \brief Save the Mulliken atomic orbital populations and charges in results
430!>
431!> \param orbpop ...
432!> \param atomic_kind_set ...
433!> \param qs_kind_set ...
434!> \param particle_set ...
435!> \param qs_env ...
436!> \par History
437!> 27.05.2022 BT
438!> 16.07.2025 RK
439!> \author Bo Thomsen (BT)
440!> Rangsiman Ketkaew (RK)
441!> \version 1.0
442! **************************************************************************************************
443 SUBROUTINE save_mulliken_charges(orbpop, atomic_kind_set, qs_kind_set, particle_set, qs_env)
444 REAL(kind=dp), DIMENSION(:, :), POINTER :: orbpop
445 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
446 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
447 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
448 TYPE(qs_environment_type), POINTER :: qs_env
449
450 CHARACTER(LEN=default_string_length) :: description
451 INTEGER :: iao, iatom, ikind, iset, isgf, ishell, &
452 iso, l, natom, nset, nsgf, nspin
453 INTEGER, DIMENSION(:), POINTER :: nshell
454 INTEGER, DIMENSION(:, :), POINTER :: lshell
455 REAL(kind=dp) :: zeff
456 REAL(kind=dp), DIMENSION(3) :: sumorbpop
457 REAL(kind=dp), DIMENSION(:), POINTER :: all_sumorbpop, charges_save
458 TYPE(cp_result_type), POINTER :: results
459 TYPE(gto_basis_set_type), POINTER :: orb_basis_set
460
461 NULLIFY (lshell)
462 NULLIFY (nshell)
463 NULLIFY (orb_basis_set)
464
465 cpassert(ASSOCIATED(orbpop))
466 cpassert(ASSOCIATED(atomic_kind_set))
467 cpassert(ASSOCIATED(particle_set))
468
469 nspin = SIZE(orbpop, 2)
470
471 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
472 CALL get_qs_kind_set(qs_kind_set, nsgf=nsgf)
473 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
474 NULLIFY (results)
475 CALL get_qs_env(qs_env, results=results)
476 ALLOCATE (all_sumorbpop(natom))
477 ALLOCATE (charges_save(natom))
478
479 iao = 1
480 DO iatom = 1, natom
481 sumorbpop(:) = 0.0_dp
482 NULLIFY (orb_basis_set)
483 CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, &
484 kind_number=ikind)
485 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, zeff=zeff)
486 IF (ASSOCIATED(orb_basis_set)) THEN
487 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
488 nset=nset, &
489 nshell=nshell, &
490 l=lshell)
491 isgf = 1
492 DO iset = 1, nset
493 DO ishell = 1, nshell(iset)
494 l = lshell(ishell, iset)
495 DO iso = 1, nso(l)
496 IF (nspin == 1) THEN
497 sumorbpop(1) = sumorbpop(1) + orbpop(iao, 1)
498 ELSE
499 sumorbpop(1:2) = sumorbpop(1:2) + orbpop(iao, 1:2)
500 sumorbpop(3) = sumorbpop(3) + orbpop(iao, 1) - orbpop(iao, 2)
501 END IF
502 isgf = isgf + 1
503 iao = iao + 1
504 END DO
505 END DO
506 END DO
507 IF (nspin == 1) THEN
508 charges_save(iatom) = zeff - sumorbpop(1)
509 all_sumorbpop(iatom) = sumorbpop(1)
510 ELSE
511 charges_save(iatom) = zeff - sumorbpop(1) - sumorbpop(2)
512 all_sumorbpop(iatom) = sumorbpop(1) + sumorbpop(2)
513 END IF
514 END IF ! atom has an orbital basis
515 END DO ! next atom iatom
516
517 ! Store atomic orbital populations in results
518 description = "[MULLIKEN-ORBPOP]"
519 CALL cp_results_erase(results=results, description=description)
520 CALL put_results(results=results, description=description, &
521 values=orbpop)
522
523 ! Store sum orbital population in results
524 description = "[MULLIKEN-SUMORBPOP]"
525 CALL cp_results_erase(results=results, description=description)
526 CALL put_results(results=results, description=description, &
527 values=all_sumorbpop)
528
529 ! Store charges in results
530 description = "[MULLIKEN-CHARGES]"
531 CALL cp_results_erase(results=results, description=description)
532 CALL put_results(results=results, description=description, &
533 values=charges_save)
534
535 DEALLOCATE (all_sumorbpop)
536 DEALLOCATE (charges_save)
537
538 END SUBROUTINE save_mulliken_charges
539
540! **************************************************************************************************
541!> \brief Write atomic orbital populations and net atomic charges
542!>
543!> \param orbpop ...
544!> \param atomic_kind_set ...
545!> \param qs_kind_set ...
546!> \param particle_set ...
547!> \param output_unit ...
548!> \param print_orbital_contributions ...
549!> \date 07.07.2010
550!> \author Matthias Krack (MK)
551!> \version 1.0
552! **************************************************************************************************
553 SUBROUTINE write_orbpop(orbpop, atomic_kind_set, qs_kind_set, particle_set, output_unit, &
554 print_orbital_contributions)
555
556 REAL(kind=dp), DIMENSION(:, :), POINTER :: orbpop
557 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
558 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
559 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
560 INTEGER, INTENT(IN) :: output_unit
561 LOGICAL, INTENT(IN) :: print_orbital_contributions
562
563 CHARACTER(LEN=*), PARAMETER :: routinen = 'write_orbpop'
564
565 CHARACTER(LEN=2) :: element_symbol
566 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
567 INTEGER :: handle, iao, iatom, ikind, iset, isgf, &
568 ishell, iso, l, natom, nset, nsgf, &
569 nspin
570 INTEGER, DIMENSION(:), POINTER :: nshell
571 INTEGER, DIMENSION(:, :), POINTER :: lshell
572 REAL(kind=dp) :: zeff
573 REAL(kind=dp), DIMENSION(3) :: sumorbpop, totsumorbpop
574 TYPE(gto_basis_set_type), POINTER :: orb_basis_set
575
576 CALL timeset(routinen, handle)
577
578 NULLIFY (lshell)
579 NULLIFY (nshell)
580 NULLIFY (orb_basis_set)
581 NULLIFY (sgf_symbol)
582
583 cpassert(ASSOCIATED(orbpop))
584 cpassert(ASSOCIATED(atomic_kind_set))
585 cpassert(ASSOCIATED(particle_set))
586
587 nspin = SIZE(orbpop, 2)
588
589 CALL get_atomic_kind_set(atomic_kind_set, natom=natom)
590 CALL get_qs_kind_set(qs_kind_set, nsgf=nsgf)
591
592 ! Select and write headline
593 IF (nspin == 1) THEN
594 IF (print_orbital_contributions) THEN
595 WRITE (unit=output_unit, fmt="(/,T2,A)") &
596 "# Orbital AO symbol Orbital population Net charge"
597 ELSE
598 WRITE (unit=output_unit, fmt="(/,T2,A)") &
599 "# Atom Element Kind Atomic population Net charge"
600 END IF
601 ELSE
602 IF (print_orbital_contributions) THEN
603 WRITE (unit=output_unit, fmt="(/,T2,A)") &
604 "# Orbital AO symbol Orbital population (alpha,beta) Net charge Spin moment"
605 ELSE
606 WRITE (unit=output_unit, fmt="(/,T2,A)") &
607 "# Atom Element Kind Atomic population (alpha,beta) Net charge Spin moment"
608 END IF
609 END IF
610
611 totsumorbpop(:) = 0.0_dp
612
613 iao = 1
614 DO iatom = 1, natom
615 sumorbpop(:) = 0.0_dp
616 NULLIFY (orb_basis_set)
617 CALL get_atomic_kind(atomic_kind=particle_set(iatom)%atomic_kind, &
618 element_symbol=element_symbol, &
619 kind_number=ikind)
620 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set, zeff=zeff)
621 IF (ASSOCIATED(orb_basis_set)) THEN
622 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
623 nset=nset, &
624 nshell=nshell, &
625 l=lshell, &
626 sgf_symbol=sgf_symbol)
627 isgf = 1
628 DO iset = 1, nset
629 DO ishell = 1, nshell(iset)
630 l = lshell(ishell, iset)
631 DO iso = 1, nso(l)
632 IF (nspin == 1) THEN
633 sumorbpop(1) = sumorbpop(1) + orbpop(iao, 1)
634 IF (print_orbital_contributions) THEN
635 IF (isgf == 1) WRITE (unit=output_unit, fmt="(A)") ""
636 WRITE (unit=output_unit, &
637 fmt="(T2,I9,2X,A2,1X,A,T30,F12.6)") &
638 iao, element_symbol, sgf_symbol(isgf), orbpop(iao, 1)
639 END IF
640 ELSE
641 sumorbpop(1:2) = sumorbpop(1:2) + orbpop(iao, 1:2)
642 sumorbpop(3) = sumorbpop(3) + orbpop(iao, 1) - orbpop(iao, 2)
643 IF (print_orbital_contributions) THEN
644 IF (isgf == 1) WRITE (unit=output_unit, fmt="(A)") ""
645 WRITE (unit=output_unit, &
646 fmt="(T2,I9,2X,A2,1X,A,T29,2(1X,F12.6),T68,F12.6)") &
647 iao, element_symbol, sgf_symbol(isgf), orbpop(iao, 1:2), &
648 orbpop(iao, 1) - orbpop(iao, 2)
649 END IF
650 END IF
651 isgf = isgf + 1
652 iao = iao + 1
653 END DO
654 END DO
655 END DO
656 IF (nspin == 1) THEN
657 totsumorbpop(1) = totsumorbpop(1) + sumorbpop(1)
658 totsumorbpop(3) = totsumorbpop(3) + zeff - sumorbpop(1)
659 WRITE (unit=output_unit, &
660 fmt="(T2,I7,5X,A2,2X,I6,T30,F12.6,T68,F12.6)") &
661 iatom, element_symbol, ikind, sumorbpop(1), zeff - sumorbpop(1)
662 ELSE
663 totsumorbpop(1:2) = totsumorbpop(1:2) + sumorbpop(1:2)
664 totsumorbpop(3) = totsumorbpop(3) + zeff - sumorbpop(1) - sumorbpop(2)
665 WRITE (unit=output_unit, &
666 fmt="(T2,I7,5X,A2,2X,I6,T28,4(1X,F12.6))") &
667 iatom, element_symbol, ikind, sumorbpop(1:2), &
668 zeff - sumorbpop(1) - sumorbpop(2), sumorbpop(3)
669 END IF
670 END IF ! atom has an orbital basis
671 END DO ! next atom iatom
672
673 ! Write total sums
674 IF (print_orbital_contributions) WRITE (unit=output_unit, fmt="(A)") ""
675 IF (nspin == 1) THEN
676 WRITE (unit=output_unit, &
677 fmt="(T2,A,T42,F12.6,T68,F12.6,/)") &
678 "# Total charge", totsumorbpop(1), totsumorbpop(3)
679 ELSE
680 WRITE (unit=output_unit, &
681 fmt="(T2,A,T28,4(1X,F12.6),/)") &
682 "# Total charge and spin", totsumorbpop(1:2), totsumorbpop(3), &
683 totsumorbpop(1) - totsumorbpop(2)
684 END IF
685
686 IF (output_unit > 0) CALL m_flush(output_unit)
687
688 CALL timestop(handle)
689
690 END SUBROUTINE write_orbpop
691
692END MODULE population_analyses
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius, npgf_seg_sum)
...
methods related to the blacs parallel environment
subroutine, public dbcsr_deallocate_matrix(matrix)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset)
...
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
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.
DBCSR output in CP2K.
subroutine, public write_fm_with_basis_info(blacs_matrix, before, after, qs_env, para_env, first_row, last_row, first_col, last_col, output_unit, omit_headers)
Print a spherical matrix of blacs type.
subroutine, public cp_dbcsr_write_sparse_matrix(sparse_matrix, before, after, qs_env, para_env, first_row, last_row, first_col, last_col, scale, output_unit, omit_headers)
...
used for collecting some of the diagonalization schemes available for cp_fm_type. cp_fm_power also mo...
Definition cp_fm_diag.F:17
subroutine, public cp_fm_power(matrix, work, exponent, threshold, n_dependent, verbose, eigvals)
...
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
Definition cp_fm_types.F:15
subroutine, public cp_fm_get_diag(matrix, diag)
returns the diagonal elements of a fm
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
set of type/routines to handle the storage of results in force_envs
subroutine, public cp_results_erase(results, description, nval)
erase a part of result_list
set of type/routines to handle the storage of results in force_envs
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
integer, parameter, public default_string_length
Definition kinds.F:57
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:131
Interface to the message passing library MPI.
Provides Cartesian and spherical orbital pointers and indices.
integer, dimension(:), allocatable, public nso
basic linear algebra operations for full matrixes
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.
Define the data structure for the particle information.
Provide various population analyses and print the requested output information.
subroutine, public lowdin_population_analysis(qs_env, output_unit, print_level)
Perform a Lowdin population analysis based on a symmetric orthogonalisation of the density matrix usi...
subroutine, public mulliken_population_analysis(qs_env, output_unit, print_level)
Perform a Mulliken population analysis.
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, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Define the quickstep kind type and their sub types.
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, se_parameter, dftb_parameter, xtb_parameter, dftb3_param, zatom, zeff, elec_conf, mao, lmax_dftb, alpha_core_charge, ccore_charge, core_charge, core_charge_radius, paw_proj_set, paw_atom, hard_radius, hard0_radius, max_rad_local, covalent_radius, vdw_radius, gpw_type_forced, harmonics, max_iso_not0, max_s_harm, grid_atom, ngrid_ang, ngrid_rad, lmax_rho0, dft_plus_u_atom, l_of_dft_plus_u, n_of_dft_plus_u, u_minus_j, u_of_dft_plus_u, j_of_dft_plus_u, alpha_of_dft_plus_u, beta_of_dft_plus_u, j0_of_dft_plus_u, occupation_of_dft_plus_u, dispersion, bs_occupation, magnetization, no_optimize, addel, laddel, naddel, orbitals, max_scf, eps_scf, smear, u_ramping, u_minus_j_target, eps_u_ramping, init_u_ramping_each_scf, reltmat, ghost, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
subroutine, public get_qs_kind_set(qs_kind_set, all_potential_present, tnadd_potential_present, gth_potential_present, sgp_potential_present, paw_atom_present, dft_plus_u_atom_present, maxcgf, maxsgf, maxco, maxco_proj, maxgtops, maxlgto, maxlprj, maxnset, maxsgf_set, ncgf, npgf, nset, nsgf, nshell, maxpol, maxlppl, maxlppnl, maxppnl, nelectron, maxder, max_ngrid_rad, max_sph_harm, maxg_iso_not0, lmax_rho0, basis_rcut, basis_type, total_zeff_corr, npgf_seg)
Get attributes of an atomic kind set.
superstucture that hold various representations of the density and keeps track of which ones are vali...
subroutine, public qs_rho_get(rho_struct, rho_ao, rho_ao_im, rho_ao_kp, rho_ao_im_kp, rho_r, drho_r, rho_g, drho_g, tau_r, tau_g, rho_r_valid, drho_r_valid, rho_g_valid, drho_g_valid, tau_r_valid, tau_g_valid, tot_rho_r, tot_rho_g, rho_r_sccs, soft_valid, complex_rho_ao)
returns info about the density described by this object. If some representation is not available an e...
parameters that control an scf iteration
Provides all information about an atomic kind.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
represent a full matrix
contains arbitrary information which need to be stored
stores all the informations relevant to an mpi environment
Provides all information about a quickstep kind.
keeps the density in various representations, keeping track of which ones are valid.