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