(git:4cf809f)
Loading...
Searching...
No Matches
cp_dbcsr_output.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief DBCSR output in CP2K
10!> \author VW
11!> \date 2009-09-09
12!> \version 0.1
13!>
14!> <b>Modification history:</b>
15!> - Created 2009-09-09
16! **************************************************************************************************
17MODULE cp_dbcsr_output
18 USE atomic_kind_types, ONLY: atomic_kind_type,&
19 get_atomic_kind
20 USE basis_set_types, ONLY: get_gto_basis_set,&
21 gto_basis_set_type
22 USE cp_dbcsr_api, ONLY: &
23 dbcsr_get_data_size, dbcsr_get_info, dbcsr_get_matrix_type, dbcsr_get_num_blocks, &
24 dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, dbcsr_iterator_start, &
25 dbcsr_iterator_stop, dbcsr_iterator_type, dbcsr_type, dbcsr_type_antisymmetric, &
26 dbcsr_type_no_symmetry, dbcsr_type_symmetric
27 USE cp_fm_types, ONLY: cp_fm_get_info,&
28 cp_fm_get_submatrix,&
29 cp_fm_type
30 USE cp_log_handling, ONLY: cp_get_default_logger,&
31 cp_logger_type
32 USE kinds, ONLY: default_string_length,&
33 dp,&
34 int_8
35 USE machine, ONLY: m_flush
36 USE mathlib, ONLY: symmetrize_matrix
37 USE message_passing, ONLY: mp_para_env_type
38 USE orbital_pointers, ONLY: nco,&
39 nso
40 USE particle_methods, ONLY: get_particle_set
41 USE particle_types, ONLY: particle_type
42 USE qs_environment_types, ONLY: get_qs_env,&
43 qs_environment_type
44 USE qs_kind_types, ONLY: get_qs_kind,&
45 get_qs_kind_set,&
46 qs_kind_type
47#include "./base/base_uses.f90"
48
49 IMPLICIT NONE
50
51 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_dbcsr_output'
52
53 PUBLIC :: cp_dbcsr_write_sparse_matrix
54 PUBLIC :: cp_dbcsr_write_matrix_dist
55 PUBLIC :: write_fm_with_basis_info
56
57 PRIVATE
58
59CONTAINS
60
61! **************************************************************************************************
62!> \brief Print a spherical matrix of blacs type.
63!> \param blacs_matrix ...
64!> \param before ...
65!> \param after ...
66!> \param qs_env ...
67!> \param para_env ...
68!> \param first_row ...
69!> \param last_row ...
70!> \param first_col ...
71!> \param last_col ...
72!> \param output_unit ...
73!> \param omit_headers Write only the matrix data, not the row/column headers
74!> \author Creation (12.06.2001,MK)
75!> Allow for printing of a sub-matrix (01.07.2003,MK)
76! **************************************************************************************************
77 SUBROUTINE write_fm_with_basis_info(blacs_matrix, before, after, qs_env, para_env, &
78 first_row, last_row, first_col, last_col, output_unit, omit_headers)
79
80 TYPE(cp_fm_type), INTENT(IN) :: blacs_matrix
81 INTEGER, INTENT(IN) :: before, after
82 TYPE(qs_environment_type), POINTER :: qs_env
83 TYPE(mp_para_env_type), POINTER :: para_env
84 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_col, last_col
85 INTEGER, INTENT(IN) :: output_unit
86 LOGICAL, INTENT(IN), OPTIONAL :: omit_headers
87
88 CHARACTER(LEN=60) :: matrix_name
89 INTEGER :: col1, col2, ncol_global, nrow_global, &
90 nsgf, row1, row2
91 LOGICAL :: my_omit_headers
92 REAL(kind=dp), DIMENSION(:, :), POINTER :: matrix
93 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
94
95 IF (.NOT. ASSOCIATED(blacs_matrix%matrix_struct)) RETURN
96 CALL cp_fm_get_info(blacs_matrix, name=matrix_name, nrow_global=nrow_global, &
97 ncol_global=ncol_global)
98
99 ALLOCATE (matrix(nrow_global, ncol_global))
100 CALL cp_fm_get_submatrix(blacs_matrix, matrix)
101
102 ! *** Get the matrix dimension and check the optional arguments ***
103 CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
104 CALL get_qs_kind_set(qs_kind_set=qs_kind_set, nsgf=nsgf)
105
106 IF (PRESENT(first_row)) THEN
107 row1 = max(1, first_row)
108 ELSE
109 row1 = 1
110 END IF
111
112 IF (PRESENT(last_row)) THEN
113 row2 = min(nsgf, last_row)
114 ELSE
115 row2 = nsgf
116 END IF
117
118 IF (PRESENT(first_col)) THEN
119 col1 = max(1, first_col)
120 ELSE
121 col1 = 1
122 END IF
123
124 IF (PRESENT(last_col)) THEN
125 col2 = min(nsgf, last_col)
126 ELSE
127 col2 = nsgf
128 END IF
129
130 IF (PRESENT(omit_headers)) THEN
131 my_omit_headers = omit_headers
132 ELSE
133 my_omit_headers = .false.
134 END IF
135
136 CALL write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env, &
137 row1, row2, col1, col2, output_unit, omit_headers=my_omit_headers)
138
139 ! *** Release work storage ***
140 IF (ASSOCIATED(matrix)) THEN
141 DEALLOCATE (matrix)
142 END IF
143
144 END SUBROUTINE write_fm_with_basis_info
145
146! **************************************************************************************************
147!> \brief ...
148!> \param sparse_matrix ...
149!> \param before ...
150!> \param after ...
151!> \param qs_env ...
152!> \param para_env ...
153!> \param first_row ...
154!> \param last_row ...
155!> \param first_col ...
156!> \param last_col ...
157!> \param scale ...
158!> \param output_unit ...
159!> \param omit_headers Write only the matrix data, not the row/column headers
160!> \param cartesian_basis Use Cartesian instead of spherical basis labels
161! **************************************************************************************************
162 SUBROUTINE cp_dbcsr_write_sparse_matrix(sparse_matrix, before, after, qs_env, para_env, &
163 first_row, last_row, first_col, last_col, scale, &
164 output_unit, omit_headers, cartesian_basis)
165
166 TYPE(dbcsr_type) :: sparse_matrix
167 INTEGER, INTENT(IN) :: before, after
168 TYPE(qs_environment_type), POINTER :: qs_env
169 TYPE(mp_para_env_type), POINTER :: para_env
170 INTEGER, INTENT(IN), OPTIONAL :: first_row, last_row, first_col, last_col
171 REAL(dp), INTENT(IN), OPTIONAL :: scale
172 INTEGER, INTENT(IN) :: output_unit
173 LOGICAL, INTENT(IN), OPTIONAL :: omit_headers, cartesian_basis
174
175 CHARACTER(LEN=default_string_length) :: matrix_name
176 INTEGER :: col1, col2, dim_col, dim_row, row1, row2
177 LOGICAL :: my_cartesian_basis, my_omit_headers, &
178 print_sym
179 REAL(kind=dp), DIMENSION(:, :), POINTER :: matrix
180 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
181
182 NULLIFY (matrix)
183
184 CALL copy_repl_dbcsr_to_repl_fm(sparse_matrix, matrix)
185
186 CALL para_env%sum(matrix)
187
188 SELECT CASE (dbcsr_get_matrix_type(sparse_matrix))
189 CASE (dbcsr_type_symmetric)
190 CALL symmetrize_matrix(matrix, "upper_to_lower")
191 print_sym = .true.
192 CASE (dbcsr_type_antisymmetric)
193 CALL symmetrize_matrix(matrix, "anti_upper_to_lower")
194 print_sym = .true.
195 CASE (dbcsr_type_no_symmetry)
196 print_sym = .false.
197 CASE DEFAULT
198 cpabort("WRONG")
199 END SELECT
200
201 ! *** Get the matrix dimension and check the optional arguments ***
202 CALL get_qs_env(qs_env=qs_env, qs_kind_set=qs_kind_set)
203 dim_row = SIZE(matrix, 1)
204 dim_col = SIZE(matrix, 2)
205
206 IF (PRESENT(first_row)) THEN
207 row1 = max(1, first_row)
208 ELSE
209 row1 = 1
210 END IF
211
212 IF (PRESENT(last_row)) THEN
213 row2 = min(dim_row, last_row)
214 ELSE
215 row2 = dim_row
216 END IF
217
218 IF (PRESENT(first_col)) THEN
219 col1 = max(1, first_col)
220 ELSE
221 col1 = 1
222 END IF
223
224 IF (PRESENT(last_col)) THEN
225 col2 = min(dim_col, last_col)
226 ELSE
227 col2 = dim_col
228 END IF
229
230 IF (PRESENT(scale)) THEN
231 matrix = matrix*scale
232 END IF
233
234 IF (PRESENT(omit_headers)) THEN
235 my_omit_headers = omit_headers
236 ELSE
237 my_omit_headers = .false.
238 END IF
239 my_cartesian_basis = .false.
240 IF (PRESENT(cartesian_basis)) my_cartesian_basis = cartesian_basis
241
242 CALL dbcsr_get_info(sparse_matrix, name=matrix_name)
243 IF (print_sym) THEN
244 CALL write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env, &
245 row1, row2, col1, col2, output_unit, my_omit_headers, &
246 cartesian_basis=my_cartesian_basis)
247 ELSE
248 CALL write_matrix_gen(matrix, matrix_name, before, after, para_env, &
249 row1, row2, col1, col2, output_unit, my_omit_headers)
250 END IF
251
252 IF (ASSOCIATED(matrix)) THEN
253 DEALLOCATE (matrix)
254 END IF
255
256 END SUBROUTINE cp_dbcsr_write_sparse_matrix
257
258! **************************************************************************************************
259!> \brief ...
260!> \param sparse_matrix ...
261!> \param fm ...
262! **************************************************************************************************
263 SUBROUTINE copy_repl_dbcsr_to_repl_fm(sparse_matrix, fm)
264
265 TYPE(dbcsr_type) :: sparse_matrix
266 REAL(kind=dp), DIMENSION(:, :), POINTER :: fm
267
268 CHARACTER(len=*), PARAMETER :: routinen = 'copy_repl_dbcsr_to_repl_fm'
269
270 INTEGER :: col, handle, i, j, nblkcols_total, &
271 nblkrows_total, nc, nr, row
272 INTEGER, ALLOCATABLE, DIMENSION(:) :: c_offset, r_offset
273 INTEGER, DIMENSION(:), POINTER :: col_blk_size, row_blk_size
274 REAL(kind=dp), DIMENSION(:, :), POINTER :: block
275 TYPE(dbcsr_iterator_type) :: iter
276
277 CALL timeset(routinen, handle)
278
279 IF (ASSOCIATED(fm)) DEALLOCATE (fm)
280
281 CALL dbcsr_get_info(matrix=sparse_matrix, &
282 col_blk_size=col_blk_size, &
283 row_blk_size=row_blk_size, &
284 nblkrows_total=nblkrows_total, &
285 nblkcols_total=nblkcols_total)
286
287 !> this should be precomputed somewhere else
288 ALLOCATE (r_offset(nblkrows_total), c_offset(nblkcols_total))
289
290 r_offset(1) = 1
291 DO row = 2, nblkrows_total
292 r_offset(row) = r_offset(row - 1) + row_blk_size(row - 1)
293 END DO
294 nr = sum(row_blk_size)
295 c_offset(1) = 1
296 DO col = 2, nblkcols_total
297 c_offset(col) = c_offset(col - 1) + col_blk_size(col - 1)
298 END DO
299 nc = sum(col_blk_size)
300 !<
301
302 ALLOCATE (fm(nr, nc))
303
304 fm(:, :) = 0.0_dp
305
306 CALL dbcsr_iterator_start(iter, sparse_matrix)
307 DO WHILE (dbcsr_iterator_blocks_left(iter))
308 CALL dbcsr_iterator_next_block(iter, row, col, block)
309 DO j = 1, SIZE(block, 2)
310 DO i = 1, SIZE(block, 1)
311 fm(r_offset(row) + i - 1, c_offset(col) + j - 1) = block(i, j)
312 END DO
313 END DO
314 END DO
315 CALL dbcsr_iterator_stop(iter)
316
317 DEALLOCATE (r_offset, c_offset)
318
319 CALL timestop(handle)
320
321 END SUBROUTINE copy_repl_dbcsr_to_repl_fm
322
323! **************************************************************************************************
324!> \brief Write a matrix or a sub-matrix to the output unit (symmetric)
325!> \param matrix ...
326!> \param matrix_name ...
327!> \param before ...
328!> \param after ...
329!> \param qs_env ...
330!> \param para_env ...
331!> \param first_row ...
332!> \param last_row ...
333!> \param first_col ...
334!> \param last_col ...
335!> \param output_unit ...
336!> \param omit_headers Write only the matrix data, not the row/column headers
337!> \param cartesian_basis Use Cartesian instead of spherical basis labels
338!> \author Creation (01.07.2003,MK)
339! **************************************************************************************************
340 SUBROUTINE write_matrix_sym(matrix, matrix_name, before, after, qs_env, para_env, &
341 first_row, last_row, first_col, last_col, output_unit, omit_headers, cartesian_basis)
342
343 REAL(kind=dp), DIMENSION(:, :), POINTER :: matrix
344 CHARACTER(LEN=*), INTENT(IN) :: matrix_name
345 INTEGER, INTENT(IN) :: before, after
346 TYPE(qs_environment_type), POINTER :: qs_env
347 TYPE(mp_para_env_type), POINTER :: para_env
348 INTEGER, INTENT(IN) :: first_row, last_row, first_col, &
349 last_col, output_unit
350 LOGICAL, INTENT(IN) :: omit_headers
351 LOGICAL, INTENT(IN), OPTIONAL :: cartesian_basis
352
353 CHARACTER(LEN=12), DIMENSION(:), POINTER :: cgf_symbol
354 CHARACTER(LEN=2) :: element_symbol
355 CHARACTER(LEN=25) :: fmtstr1
356 CHARACTER(LEN=35) :: fmtstr2
357 CHARACTER(LEN=6), DIMENSION(:), POINTER :: sgf_symbol
358 INTEGER :: from, iatom, icol, ikind, irow, iset, &
359 isgf, ishell, iso, jcol, l, left, &
360 natom, ncol, ndigits, nset, nsgf, &
361 right, to, width
362 INTEGER, ALLOCATABLE, DIMENSION(:) :: first_sgf, last_sgf
363 INTEGER, DIMENSION(:), POINTER :: nshell
364 INTEGER, DIMENSION(:, :), POINTER :: lshell
365 LOGICAL :: my_cartesian_basis
366 TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
367 TYPE(gto_basis_set_type), POINTER :: orb_basis_set
368 TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
369 TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
370
371 IF (output_unit > 0) THEN
372 CALL m_flush(output_unit)
373
374 CALL get_qs_env(qs_env=qs_env, &
375 qs_kind_set=qs_kind_set, &
376 atomic_kind_set=atomic_kind_set, &
377 particle_set=particle_set)
378
379 natom = SIZE(particle_set)
380
381 my_cartesian_basis = .false.
382 IF (PRESENT(cartesian_basis)) my_cartesian_basis = cartesian_basis
383
384 CALL get_qs_kind_set(qs_kind_set=qs_kind_set, nsgf=nsgf)
385
386 ALLOCATE (first_sgf(natom))
387 ALLOCATE (last_sgf(natom))
388 CALL get_particle_set(particle_set, qs_kind_set, &
389 first_sgf=first_sgf, &
390 last_sgf=last_sgf)
391
392 ! *** Definition of the variable formats ***
393 fmtstr1 = "(/,T2,23X, ( X,I5, X))"
394 IF (omit_headers) THEN
395 fmtstr2 = "(T2, (1X,F . ))"
396 ELSE
397 fmtstr2 = "(T2,2I5,2X,A2,1X,A8, (1X,F . ))"
398 END IF
399
400 ! *** Write headline ***
401 WRITE (unit=output_unit, fmt="(/,/,T2,A)") trim(matrix_name)
402
403 ! *** Write the variable format strings ***
404 ndigits = after
405
406 width = before + ndigits + 3
407 ncol = int(56/width)
408
409 right = max((ndigits - 2), 1)
410 left = width - right - 5
411
412 WRITE (unit=fmtstr1(11:12), fmt="(I2)") ncol
413 WRITE (unit=fmtstr1(14:15), fmt="(I2)") left
414 WRITE (unit=fmtstr1(21:22), fmt="(I2)") right
415
416 IF (omit_headers) THEN
417 WRITE (unit=fmtstr2(6:7), fmt="(I2)") ncol
418 WRITE (unit=fmtstr2(13:14), fmt="(I2)") width - 1
419 WRITE (unit=fmtstr2(16:17), fmt="(I2)") ndigits
420 ELSE
421 WRITE (unit=fmtstr2(22:23), fmt="(I2)") ncol
422 WRITE (unit=fmtstr2(29:30), fmt="(I2)") width - 1
423 WRITE (unit=fmtstr2(32:33), fmt="(I2)") ndigits
424 END IF
425
426 ! *** Write the matrix in the selected format ***
427 DO icol = first_col, last_col, ncol
428 from = icol
429 to = min((from + ncol - 1), last_col)
430 IF (.NOT. omit_headers) THEN
431 WRITE (unit=output_unit, fmt=fmtstr1) (jcol, jcol=from, to)
432 END IF
433 irow = 1
434 DO iatom = 1, natom
435 NULLIFY (orb_basis_set)
436 CALL get_atomic_kind(particle_set(iatom)%atomic_kind, &
437 kind_number=ikind, element_symbol=element_symbol)
438 CALL get_qs_kind(qs_kind_set(ikind), basis_set=orb_basis_set)
439 IF (ASSOCIATED(orb_basis_set)) THEN
440 CALL get_gto_basis_set(gto_basis_set=orb_basis_set, &
441 nset=nset, nshell=nshell, l=lshell, &
442 cgf_symbol=cgf_symbol, sgf_symbol=sgf_symbol)
443 isgf = 1
444 DO iset = 1, nset
445 DO ishell = 1, nshell(iset)
446 l = lshell(ishell, iset)
447 DO iso = 1, merge(nco(l), nso(l), my_cartesian_basis)
448 IF ((irow >= first_row) .AND. (irow <= last_row)) THEN
449 IF (omit_headers) THEN
450 WRITE (unit=output_unit, fmt=fmtstr2) &
451 (matrix(irow, jcol), jcol=from, to)
452 ELSE
453 IF (my_cartesian_basis) THEN
454 WRITE (unit=output_unit, fmt=fmtstr2) &
455 irow, iatom, element_symbol, cgf_symbol(isgf), &
456 (matrix(irow, jcol), jcol=from, to)
457 ELSE
458 WRITE (unit=output_unit, fmt=fmtstr2) &
459 irow, iatom, element_symbol, sgf_symbol(isgf), &
460 (matrix(irow, jcol), jcol=from, to)
461 END IF
462 END IF
463 END IF
464 isgf = isgf + 1
465 irow = irow + 1
466 END DO
467 END DO
468 END DO
469 IF ((irow >= first_row) .AND. (irow <= last_row)) THEN
470 WRITE (unit=output_unit, fmt="(A)")
471 END IF
472 ELSE
473 DO iso = first_sgf(iatom), last_sgf(iatom)
474 IF ((irow >= first_row) .AND. (irow <= last_row)) THEN
475 IF (omit_headers) THEN
476 WRITE (unit=output_unit, fmt=fmtstr2) &
477 (matrix(irow, jcol), jcol=from, to)
478 ELSE
479 WRITE (unit=output_unit, fmt=fmtstr2) &
480 irow, iatom, element_symbol, " ", &
481 (matrix(irow, jcol), jcol=from, to)
482 END IF
483 END IF
484 irow = irow + 1
485 END DO
486 IF ((irow >= first_row) .AND. (irow <= last_row)) THEN
487 WRITE (unit=output_unit, fmt="(A)")
488 END IF
489 END IF
490 END DO
491 END DO
492
493 WRITE (unit=output_unit, fmt="(/)")
494 DEALLOCATE (first_sgf)
495 DEALLOCATE (last_sgf)
496 END IF
497
498 CALL para_env%sync()
499 IF (output_unit > 0) CALL m_flush(output_unit)
500
501 END SUBROUTINE write_matrix_sym
502
503! **************************************************************************************************
504!> \brief Write a matrix not necessarily symmetric (no index with atomic labels)
505!> \param matrix ...
506!> \param matrix_name ...
507!> \param before ...
508!> \param after ...
509!> \param para_env ...
510!> \param first_row ...
511!> \param last_row ...
512!> \param first_col ...
513!> \param last_col ...
514!> \param output_unit ...
515!> \param omit_headers Write only the matrix data, not the row/column headers
516!> \author Teodoro Laino [tlaino] - 10.2007 - University of Zurich
517! **************************************************************************************************
518 SUBROUTINE write_matrix_gen(matrix, matrix_name, before, after, para_env, &
519 first_row, last_row, first_col, last_col, output_unit, omit_headers)
520
521 REAL(kind=dp), DIMENSION(:, :), POINTER :: matrix
522 CHARACTER(LEN=*), INTENT(IN) :: matrix_name
523 INTEGER, INTENT(IN) :: before, after
524 TYPE(mp_para_env_type), POINTER :: para_env
525 INTEGER, INTENT(IN) :: first_row, last_row, first_col, &
526 last_col, output_unit
527 LOGICAL, INTENT(IN) :: omit_headers
528
529 CHARACTER(LEN=25) :: fmtstr1
530 CHARACTER(LEN=35) :: fmtstr2
531 INTEGER :: from, icol, irow, jcol, left, ncol, &
532 ndigits, right, to, width
533
534 IF (output_unit > 0) THEN
535 CALL m_flush(output_unit)
536
537 ! *** Definition of the variable formats ***
538 fmtstr1 = "(/,T2,23X, ( X,I5, X))"
539 IF (omit_headers) THEN
540 fmtstr2 = "(T2, (1X,F . ))"
541 ELSE
542 fmtstr2 = "(T2, I5, 18X, (1X,F . ))"
543 END IF
544
545 ! *** Write headline ***
546 WRITE (unit=output_unit, fmt="(/,/,T2,A)") trim(matrix_name)
547
548 ! *** Write the variable format strings ***
549 ndigits = after
550
551 width = before + ndigits + 3
552 ncol = int(56/width)
553
554 right = max((ndigits - 2), 1)
555 left = width - right - 5
556
557 WRITE (unit=fmtstr1(11:12), fmt="(I2)") ncol
558 WRITE (unit=fmtstr1(14:15), fmt="(I2)") left
559 WRITE (unit=fmtstr1(21:22), fmt="(I2)") right
560
561 IF (omit_headers) THEN
562 WRITE (unit=fmtstr2(6:7), fmt="(I2)") ncol
563 WRITE (unit=fmtstr2(13:14), fmt="(I2)") width - 1
564 WRITE (unit=fmtstr2(16:17), fmt="(I2)") ndigits
565 ELSE
566 WRITE (unit=fmtstr2(22:23), fmt="(I2)") ncol
567 WRITE (unit=fmtstr2(29:30), fmt="(I2)") width - 1
568 WRITE (unit=fmtstr2(32:33), fmt="(I2)") ndigits
569 END IF
570
571 ! *** Write the matrix in the selected format ***
572 DO icol = first_col, last_col, ncol
573 from = icol
574 to = min((from + ncol - 1), last_col)
575 IF (.NOT. omit_headers) THEN
576 WRITE (unit=output_unit, fmt=fmtstr1) (jcol, jcol=from, to)
577 END IF
578 irow = 1
579 DO irow = first_row, last_row
580 IF (omit_headers) THEN
581 WRITE (unit=output_unit, fmt=fmtstr2) &
582 irow, (matrix(irow, jcol), jcol=from, to)
583 ELSE
584 WRITE (unit=output_unit, fmt=fmtstr2) &
585 (matrix(irow, jcol), jcol=from, to)
586 END IF
587 END DO
588 END DO
589
590 WRITE (unit=output_unit, fmt="(/)")
591 END IF
592
593 CALL para_env%sync()
594 IF (output_unit > 0) CALL m_flush(output_unit)
595
596 END SUBROUTINE write_matrix_gen
597
598! **************************************************************************************************
599!> \brief Print the distribution of a sparse matrix.
600!> \param matrix ...
601!> \param output_unit ...
602!> \param para_env ...
603!> \par History
604!> Creation (25.06.2003,MK)
605! **************************************************************************************************
606 SUBROUTINE cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env)
607 TYPE(dbcsr_type) :: matrix
608 INTEGER, INTENT(IN) :: output_unit
609 TYPE(mp_para_env_type), POINTER :: para_env
610
611 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_dbcsr_write_matrix_dist'
612 LOGICAL, PARAMETER :: full_output = .false.
613
614 CHARACTER :: matrix_type
615 CHARACTER(LEN=default_string_length) :: matrix_name
616 INTEGER :: handle, ipe, mype, natom, nblock_max, &
617 nelement_max, npe, nrow, tmp(2)
618 INTEGER(KIND=int_8) :: nblock_sum, nblock_tot, nelement_sum
619 INTEGER, ALLOCATABLE, DIMENSION(:) :: nblock, nelement
620 LOGICAL :: ionode
621 REAL(kind=dp) :: occupation
622 TYPE(cp_logger_type), POINTER :: logger
623
624 NULLIFY (logger)
625 logger => cp_get_default_logger()
626
627 CALL timeset(routinen, handle)
628
629 ionode = para_env%is_source()
630 mype = para_env%mepos + 1
631 npe = para_env%num_pe
632
633 ! *** Allocate work storage ***
634 ALLOCATE (nblock(npe))
635 nblock(:) = 0
636
637 ALLOCATE (nelement(npe))
638 nelement(:) = 0
639
640 nblock(mype) = dbcsr_get_num_blocks(matrix)
641 nelement(mype) = dbcsr_get_data_size(matrix)
642
643 CALL dbcsr_get_info(matrix=matrix, &
644 name=matrix_name, &
645 matrix_type=matrix_type, &
646 nblkrows_total=natom, &
647 nfullrows_total=nrow)
648
649 IF (full_output) THEN
650 ! XXXXXXXX should gather/scatter this on ionode
651 CALL para_env%sum(nblock)
652 CALL para_env%sum(nelement)
653
654 nblock_sum = sum(int(nblock, kind=int_8))
655 nelement_sum = sum(int(nelement, kind=int_8))
656 ELSE
657 nblock_sum = nblock(mype)
658 nblock_max = nblock(mype)
659 nelement_sum = nelement(mype)
660 nelement_max = nelement(mype)
661 CALL para_env%sum(nblock_sum)
662 CALL para_env%sum(nelement_sum)
663 tmp = [nblock_max, nelement_max]
664 CALL para_env%max(tmp)
665 nblock_max = tmp(1); nelement_max = tmp(2)
666 END IF
667
668 IF (matrix_type == dbcsr_type_symmetric .OR. &
669 matrix_type == dbcsr_type_antisymmetric) THEN
670 nblock_tot = int(natom, kind=int_8)*int(natom + 1, kind=int_8)/2
671 ELSE
672 nblock_tot = int(natom, kind=int_8)**2
673 END IF
674
675 occupation = -1.0_dp
676 IF (nblock_tot /= 0) occupation = 100.0_dp*real(nblock_sum, dp)/real(nblock_tot, dp)
677
678 IF (ionode) THEN
679 WRITE (unit=output_unit, fmt="(/,/,T2,A)") &
680 "DISTRIBUTION OF THE "//trim(matrix_name)
681 IF (full_output) THEN
682 WRITE (unit=output_unit, fmt="(/,T3,A,/,/,(I9,T27,I10,T55,I10))") &
683 "Process Number of matrix blocks Number of matrix elements", &
684 (ipe - 1, nblock(ipe), nelement(ipe), ipe=1, npe)
685 WRITE (unit=output_unit, fmt="(/,T7,A3,T27,I10,T55,I10)") &
686 "Sum", nblock_sum, nelement_sum
687 WRITE (unit=output_unit, fmt="(/,T7,A3,T27,I10,A,F5.1,A,T55,I10,A,F5.1,A)") &
688 " of", nblock_tot, " (", occupation, " % occupation)"
689 ELSE
690 WRITE (unit=output_unit, fmt="(T15,A,T68,I13)") "Number of non-zero blocks:", nblock_sum
691 WRITE (unit=output_unit, fmt="(T15,A,T75,F6.2)") "Percentage non-zero blocks:", occupation
692 WRITE (unit=output_unit, fmt="(T15,A,T68,I13)") "Average number of blocks per CPU:", &
693 (nblock_sum + npe - 1)/npe
694 WRITE (unit=output_unit, fmt="(T15,A,T68,I13)") "Maximum number of blocks per CPU:", nblock_max
695 WRITE (unit=output_unit, fmt="(T15,A,T68,I13)") "Average number of matrix elements per CPU:", &
696 (nelement_sum + npe - 1)/npe
697 WRITE (unit=output_unit, fmt="(T15,A,T68,I13)") "Maximum number of matrix elements per CPU:", &
698 nelement_max
699 END IF
700 END IF
701
702 ! *** Release work storage ***
703 DEALLOCATE (nblock)
704
705 DEALLOCATE (nelement)
706
707 CALL timestop(handle)
708
709 END SUBROUTINE cp_dbcsr_write_matrix_dist
710
711END MODULE cp_dbcsr_output
atomic_kind_types
Define the atomic kind types and their sub types.
Definition atomic_kind_types.F:23
atomic_kind_types::get_atomic_kind
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.
Definition atomic_kind_types.F:138
basis_set_types
Definition basis_set_types.F:15
basis_set_types::get_gto_basis_set
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, ccon)
...
Definition basis_set_types.F:643
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_get_data_size
integer function, public dbcsr_get_data_size(matrix)
...
Definition cp_dbcsr_api.F:765
cp_dbcsr_api::dbcsr_get_matrix_type
character function, public dbcsr_get_matrix_type(matrix)
...
Definition cp_dbcsr_api.F:860
cp_dbcsr_api::dbcsr_iterator_blocks_left
logical function, public dbcsr_iterator_blocks_left(iterator)
...
Definition cp_dbcsr_api.F:943
cp_dbcsr_api::dbcsr_iterator_stop
subroutine, public dbcsr_iterator_stop(iterator)
...
Definition cp_dbcsr_api.F:1049
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:807
cp_dbcsr_api::dbcsr_iterator_next_block
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
Definition cp_dbcsr_api.F:970
cp_dbcsr_api::dbcsr_iterator_start
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
Definition cp_dbcsr_api.F:1011
cp_dbcsr_api::dbcsr_get_num_blocks
integer function, public dbcsr_get_num_blocks(matrix)
...
Definition cp_dbcsr_api.F:876
cp_dbcsr_output
DBCSR output in CP2K.
Definition cp_dbcsr_output.F:17
cp_dbcsr_output::write_fm_with_basis_info
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.
Definition cp_dbcsr_output.F:79
cp_dbcsr_output::cp_dbcsr_write_matrix_dist
subroutine, public cp_dbcsr_write_matrix_dist(matrix, output_unit, para_env)
Print the distribution of a sparse matrix.
Definition cp_dbcsr_output.F:607
cp_dbcsr_output::cp_dbcsr_write_sparse_matrix
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, cartesian_basis)
...
Definition cp_dbcsr_output.F:165
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_get_info
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
Definition cp_fm_types.F:1087
cp_fm_types::cp_fm_get_submatrix
subroutine, public cp_fm_get_submatrix(fm, target_m, start_row, start_col, n_rows, n_cols, transpose)
gets a submatrix of a full matrix op(target_m)(1:n_rows,1:n_cols) =fm(start_row:start_row+n_rows,...
Definition cp_fm_types.F:972
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition cp_log_handling.F:41
cp_log_handling::cp_get_default_logger
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Definition cp_log_handling.F:234
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_flush
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
Definition machine.F:124
mathlib
Collection of simple mathematical functions and subroutines.
Definition mathlib.F:15
mathlib::symmetrize_matrix
subroutine, public symmetrize_matrix(a, option)
Symmetrize the matrix a.
Definition mathlib.F:1204
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
orbital_pointers
Provides Cartesian and spherical orbital pointers and indices.
Definition orbital_pointers.F:15
orbital_pointers::nco
integer, dimension(:), allocatable, public nco
Definition orbital_pointers.F:42
orbital_pointers::nso
integer, dimension(:), allocatable, public nso
Definition orbital_pointers.F:42
particle_methods
Define methods related to particle_type.
Definition particle_methods.F:14
particle_methods::get_particle_set
subroutine, public get_particle_set(particle_set, qs_kind_set, first_sgf, last_sgf, nsgf, nmao, basis, ncgf)
Get the components of a particle set.
Definition particle_methods.F:121
particle_types
Define the data structure for the particle information.
Definition particle_types.F:19
qs_environment_types
Definition qs_environment_types.F:14
qs_environment_types::get_qs_env
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, mimic, 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, sab_cneo, 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, xcint_weights, 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, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_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.
Definition qs_environment_types.F:530
qs_kind_types
Define the quickstep kind type and their sub types.
Definition qs_kind_types.F:23
qs_kind_types::get_qs_kind
subroutine, public get_qs_kind(qs_kind, basis_set, basis_type, ncgf, nsgf, all_potential, tnadd_potential, gth_potential, sgp_potential, upf_potential, cneo_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, monovalent, floating, name, element_symbol, pao_basis_size, pao_model_file, pao_potentials, pao_descriptors, nelec)
Get attributes of an atomic kind.
Definition qs_kind_types.F:468
qs_kind_types::get_qs_kind_set
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, cneo_potential_present, nkind_q, natom_q)
Get attributes of an atomic kind set.
Definition qs_kind_types.F:913
atomic_kind_types::atomic_kind_type
Provides all information about an atomic kind.
Definition atomic_kind_types.F:45
basis_set_types::gto_basis_set_type
Definition basis_set_types.F:72
cp_dbcsr_api::dbcsr_iterator_type
Definition cp_dbcsr_api.F:188
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:176
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:115
cp_log_handling::cp_logger_type
type of a logger, at the moment it contains just a print level starting at which level it should be l...
Definition cp_log_handling.F:140
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:743
particle_types::particle_type
Definition particle_types.F:35
qs_environment_types::qs_environment_type
Definition qs_environment_types.F:220
qs_kind_types::qs_kind_type
Provides all information about a quickstep kind.
Definition qs_kind_types.F:177