1!--------------------------------------------------------------------------------------------------!
2! Copyright (C) by the DBCSR developers group - All rights reserved                                !
3! This file is part of the DBCSR library.                                                          !
4!                                                                                                  !
5! For information on the license, see the LICENSE file.                                            !
6! For further information please visit https://dbcsr.cp2k.org                                      !
7! SPDX-License-Identifier: GPL-2.0+                                                                !
8!--------------------------------------------------------------------------------------------------!
9
10MODULE dbcsr_tas_io
11
12   !! tall-and-skinny matrices: Input / Output
13   USE dbcsr_tas_types, ONLY: &
14      dbcsr_tas_type, dbcsr_tas_split_info
15   USE dbcsr_tas_global, ONLY: &
16      dbcsr_tas_rowcol_data, dbcsr_tas_distribution
17   USE dbcsr_kinds, ONLY: &
18      int_8, real_8, default_string_length
19   USE dbcsr_tas_base, ONLY: &
20      dbcsr_tas_get_info, dbcsr_tas_get_num_blocks, dbcsr_tas_get_num_blocks_total, dbcsr_tas_get_nze_total, &
21      dbcsr_tas_get_nze, dbcsr_tas_nblkrows_total, dbcsr_tas_nblkcols_total, dbcsr_tas_info
22   USE dbcsr_tas_split, ONLY: &
23      dbcsr_tas_get_split_info, rowsplit, colsplit
24   USE dbcsr_mpiwrap, ONLY: &
25      mp_environ, mp_sum, mp_max
26   USE dbcsr_dist_methods, ONLY: &
27      dbcsr_distribution_row_dist, dbcsr_distribution_col_dist
28
29   IMPLICIT NONE
30   PRIVATE
31
32   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbcsr_tas_io'
33
34   PUBLIC :: &
35      dbcsr_tas_write_dist, &
36      dbcsr_tas_write_matrix_info, &
37      dbcsr_tas_write_split_info, &
38      prep_output_unit
39
40CONTAINS
41
42   SUBROUTINE dbcsr_tas_write_matrix_info(matrix, unit_nr, full_info)
43      !! Write basic infos of tall-and-skinny matrix: block dimensions, full dimensions, process grid dimensions
44
45      TYPE(dbcsr_tas_type), INTENT(IN) :: matrix
46      INTEGER, INTENT(IN)            :: unit_nr
47      LOGICAL, OPTIONAL, INTENT(IN)  :: full_info
48         !! Whether to print distribution and block size vectors
49
50      INTEGER(KIND=int_8)                      :: nblkrows_total, nblkcols_total, nfullrows_total, &
51                                                  nfullcols_total
52      INTEGER                                  :: nprow, npcol, unit_nr_prv
53      CLASS(dbcsr_tas_distribution), ALLOCATABLE :: proc_row_dist, proc_col_dist
54      CLASS(dbcsr_tas_rowcol_data), ALLOCATABLE  :: row_blk_size, col_blk_size
55      INTEGER(KIND=int_8)                      :: iblk
56      CHARACTER(default_string_length)         :: name
57
58      unit_nr_prv = prep_output_unit(unit_nr)
59      IF (unit_nr_prv == 0) RETURN
60
61      CALL dbcsr_tas_get_info(matrix, nblkrows_total=nblkrows_total, nblkcols_total=nblkcols_total, &
62                              nfullrows_total=nfullrows_total, nfullcols_total=nfullcols_total, &
63                              nprow=nprow, npcol=npcol, proc_row_dist=proc_row_dist, proc_col_dist=proc_col_dist, &
64                              row_blk_size=row_blk_size, col_blk_size=col_blk_size, name=name)
65
66      IF (unit_nr_prv > 0) THEN
67         WRITE (unit_nr_prv, "(T2,A)") &
68            "GLOBAL INFO OF "//TRIM(name)
69         WRITE (unit_nr_prv, "(T4,A,1X)", advance="no") "block dimensions:"
70         WRITE (unit_nr_prv, "(I12,I12)", advance="no") nblkrows_total, nblkcols_total
71         WRITE (unit_nr_prv, "(/T4,A,1X)", advance="no") "full dimensions:"
72         WRITE (unit_nr_prv, "(I14,I14)", advance="no") nfullrows_total, nfullcols_total
73         WRITE (unit_nr_prv, "(/T4,A,1X)", advance="no") "process grid dimensions:"
74         WRITE (unit_nr_prv, "(I10,I10)", advance="no") nprow, npcol
75         IF (PRESENT(full_info)) THEN
76            IF (full_info) THEN
77               WRITE (unit_nr_prv, '(/T4,A)', advance='no') "Block sizes:"
78               WRITE (unit_nr_prv, '(/T8,A)', advance='no') 'Row:'
79               DO iblk = 1, row_blk_size%nmrowcol
80                  WRITE (unit_nr_prv, '(I4,1X)', advance='no') row_blk_size%data(iblk)
81               ENDDO
82               WRITE (unit_nr_prv, '(/T8,A)', advance='no') 'Column:'
83               DO iblk = 1, col_blk_size%nmrowcol
84                  WRITE (unit_nr_prv, '(I4,1X)', advance='no') col_blk_size%data(iblk)
85               ENDDO
86               WRITE (unit_nr_prv, '(/T4,A)', advance='no') "Block distribution:"
87               WRITE (unit_nr_prv, '(/T8,A)', advance='no') 'Row:'
88               DO iblk = 1, proc_row_dist%nmrowcol
89                  WRITE (unit_nr_prv, '(I4,1X)', advance='no') proc_row_dist%dist(iblk)
90               ENDDO
91               WRITE (unit_nr_prv, '(/T8,A)', advance='no') 'Column:'
92               DO iblk = 1, proc_col_dist%nmrowcol
93                  WRITE (unit_nr_prv, '(I4,1X)', advance='no') proc_col_dist%dist(iblk)
94               ENDDO
95
96            ENDIF
97         ENDIF
98         WRITE (unit_nr_prv, *)
99      ENDIF
100
101   END SUBROUTINE
102
103   SUBROUTINE dbcsr_tas_write_dist(matrix, unit_nr, full_info)
104      !! Write info on tall-and-skinny matrix distribution & load balance
105
106      TYPE(dbcsr_tas_type), INTENT(IN) :: matrix
107      INTEGER, INTENT(IN)              :: unit_nr
108      LOGICAL, INTENT(IN), OPTIONAL    :: full_info
109         !! Whether to print subgroup DBCSR distribution
110
111      CHARACTER(default_string_length) :: name
112      INTEGER                          :: mp_comm, ngroup, igroup, mp_comm_group, nproc, iproc, &
113                                          nblock_p_max, nelement_p_max, &
114                                          nblock, nelement
115      INTEGER(KIND=int_8), DIMENSION(2) :: tmp_i8
116      INTEGER, DIMENSION(2)            :: tmp
117      INTEGER(KIND=int_8)              :: nblock_tot, nblock_p_sum, nelement_p_sum, nelement_s_max, &
118                                          nblock_s, nelement_s, nblock_s_max
119      REAL(KIND=real_8)                :: occupation
120      INTEGER, DIMENSION(:), POINTER   :: rowdist, coldist
121      INTEGER                          :: split_rowcol, icol, irow, unit_nr_prv
122
123      unit_nr_prv = prep_output_unit(unit_nr)
124      IF (unit_nr_prv == 0) RETURN
125
126      CALL dbcsr_tas_get_split_info(matrix%dist%info, mp_comm, ngroup, igroup, mp_comm_group, split_rowcol)
127      CALL dbcsr_tas_get_info(matrix, name=name)
128      CALL mp_environ(nproc, iproc, mp_comm)
129
130      nblock = dbcsr_tas_get_num_blocks(matrix)
131      nelement = dbcsr_tas_get_nze(matrix)
132
133      nblock_p_sum = dbcsr_tas_get_num_blocks_total(matrix)
134      nelement_p_sum = dbcsr_tas_get_nze_total(matrix)
135
136      tmp = (/nblock, nelement/)
137      CALL mp_max(tmp, mp_comm)
138      nblock_p_max = tmp(1); nelement_p_max = tmp(2)
139
140      nblock_s = nblock
141      nelement_s = nelement
142
143      CALL mp_sum(nblock_s, mp_comm_group)
144      CALL mp_sum(nelement_s, mp_comm_group)
145
146      tmp_i8 = (/nblock_s, nelement_s/)
147      CALL mp_max(tmp_i8, mp_comm)
148      nblock_s_max = tmp_i8(1); nelement_s_max = tmp_i8(2)
149
150      nblock_tot = dbcsr_tas_nblkrows_total(matrix)*dbcsr_tas_nblkcols_total(matrix)
151      occupation = -1.0_real_8
152      IF (nblock_tot .NE. 0) occupation = 100.0_real_8*REAL(nblock_p_sum, real_8)/REAL(nblock_tot, real_8)
153
154      rowdist => dbcsr_distribution_row_dist(matrix%matrix%dist)
155      coldist => dbcsr_distribution_col_dist(matrix%matrix%dist)
156
157      IF (unit_nr_prv > 0) THEN
158         WRITE (unit_nr_prv, "(T2,A)") &
159            "DISTRIBUTION OF "//TRIM(name)
160         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Number of non-zero blocks:", nblock_p_sum
161         WRITE (unit_nr_prv, "(T15,A,T75,F6.2)") "Percentage of non-zero blocks:", occupation
162         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Average number of blocks per group:", (nblock_p_sum + ngroup - 1)/ngroup
163         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Maximum number of blocks per group:", nblock_s_max
164         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Average number of matrix elements per group:", (nelement_p_sum + ngroup - 1)/ngroup
165         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Maximum number of matrix elements per group:", nelement_s_max
166         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Average number of blocks per CPU:", (nblock_p_sum + nproc - 1)/nproc
167         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Maximum number of blocks per CPU:", nblock_p_max
168         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Average number of matrix elements per CPU:", (nelement_p_sum + nproc - 1)/nproc
169         WRITE (unit_nr_prv, "(T15,A,T68,I13)") "Maximum number of matrix elements per CPU:", nelement_p_max
170         IF (PRESENT(full_info)) THEN
171            IF (full_info) THEN
172               WRITE (unit_nr_prv, "(T15,A)") "Row distribution on subgroup:"
173               WRITE (unit_nr_prv, '(T15)', advance='no')
174               DO irow = 1, SIZE(rowdist)
175                  WRITE (unit_nr_prv, '(I3, 1X)', advance='no') rowdist(irow)
176               ENDDO
177               WRITE (unit_nr_prv, "(/T15,A)") "Column distribution on subgroup:"
178               WRITE (unit_nr_prv, '(T15)', advance='no')
179               DO icol = 1, SIZE(coldist)
180                  WRITE (unit_nr_prv, '(I3, 1X)', advance='no') coldist(icol)
181               ENDDO
182               WRITE (unit_nr_prv, *)
183            ENDIF
184         ENDIF
185      ENDIF
186   END SUBROUTINE
187
188   SUBROUTINE dbcsr_tas_write_split_info(info, unit_nr, name)
189      !! Print info on how matrix is split
190      TYPE(dbcsr_tas_split_info), INTENT(IN)             :: info
191      INTEGER, INTENT(IN) :: unit_nr
192      CHARACTER(len=*), INTENT(IN), OPTIONAL             :: name
193      INTEGER                                            :: groupsize, igroup, mp_comm, &
194                                                            mp_comm_group, mynode, nsplit, &
195                                                            numnodes, split_rowcol, unit_nr_prv
196      INTEGER, DIMENSION(2)                              :: coord, dims, groupcoord, groupdims, &
197                                                            pgrid_offset
198      CHARACTER(len=:), ALLOCATABLE                      :: name_prv
199
200      unit_nr_prv = prep_output_unit(unit_nr)
201      IF (unit_nr_prv == 0) RETURN
202
203      IF (PRESENT(name)) THEN
204         ALLOCATE (name_prv, SOURCE=TRIM(name))
205      ELSE
206         ALLOCATE (name_prv, SOURCE="")
207      ENDIF
208
209      CALL dbcsr_tas_get_split_info(info, mp_comm, nsplit, igroup, mp_comm_group, split_rowcol, pgrid_offset)
210
211      CALL mp_environ(numnodes, mynode, mp_comm)
212      CALL mp_environ(numnodes, dims, coord, mp_comm)
213      CALL mp_environ(groupsize, groupdims, groupcoord, mp_comm_group)
214
215      IF (unit_nr_prv > 0) THEN
216         SELECT CASE (split_rowcol)
217         CASE (rowsplit)
218            WRITE (unit_nr_prv, "(T4,A,I4,1X,A,I4)") name_prv//"splitting rows by factor", nsplit
219         CASE (colsplit)
220            WRITE (unit_nr_prv, "(T4,A,I4,1X,A,I4)") name_prv//"splitting columns by factor", nsplit
221         END SELECT
222         WRITE (unit_nr_prv, "(T4,A,I4,A1,I4)") name_prv//"global grid sizes:", dims(1), "x", dims(2)
223      ENDIF
224
225      IF (unit_nr_prv > 0) THEN
226         WRITE (unit_nr_prv, "(T4,A,I4,A1,I4)") &
227            name_prv//"grid sizes on subgroups:", &
228            groupdims(1), "x", groupdims(2)
229      ENDIF
230
231   END SUBROUTINE
232
233   FUNCTION prep_output_unit(unit_nr) RESULT(unit_nr_out)
234      INTEGER, INTENT(IN), OPTIONAL :: unit_nr
235      INTEGER                       :: unit_nr_out
236
237      IF (PRESENT(unit_nr)) THEN
238         unit_nr_out = unit_nr
239      ELSE
240         unit_nr_out = 0
241      ENDIF
242
243   END FUNCTION
244
245END MODULE
246
247