Line data Source code
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 Tall-and-skinny matrices: base routines similar to DBM API,
10 : !> mostly wrappers around existing DBM routines.
11 : !> \author Patrick Seewald
12 : ! **************************************************************************************************
13 : MODULE dbt_tas_base
14 : USE dbm_api, ONLY: &
15 : dbm_clear, dbm_create, dbm_create_from_template, dbm_distribution_col_dist, &
16 : dbm_distribution_hold, dbm_distribution_new, dbm_distribution_obj, &
17 : dbm_distribution_release, dbm_distribution_row_dist, dbm_filter, dbm_finalize, &
18 : dbm_get_block_p, dbm_get_col_block_sizes, dbm_get_distribution, dbm_get_local_cols, &
19 : dbm_get_local_rows, dbm_get_name, dbm_get_num_blocks, dbm_get_nze, &
20 : dbm_get_row_block_sizes, dbm_iterator, dbm_iterator_blocks_left, dbm_iterator_next_block, &
21 : dbm_iterator_num_blocks, dbm_iterator_start, dbm_iterator_stop, dbm_put_block, &
22 : dbm_release, dbm_reserve_blocks, dbm_type
23 : USE dbt_tas_global, ONLY: dbt_tas_blk_size_arb,&
24 : dbt_tas_dist_arb,&
25 : dbt_tas_distribution,&
26 : dbt_tas_rowcol_data
27 : USE dbt_tas_split, ONLY: colsplit,&
28 : dbt_index_global_to_local,&
29 : dbt_index_local_to_global,&
30 : dbt_tas_create_split,&
31 : dbt_tas_info_hold,&
32 : dbt_tas_release_info,&
33 : group_to_mrowcol,&
34 : rowsplit
35 : USE dbt_tas_types, ONLY: dbt_tas_distribution_type,&
36 : dbt_tas_iterator,&
37 : dbt_tas_split_info,&
38 : dbt_tas_type
39 : USE kinds, ONLY: default_string_length,&
40 : dp,&
41 : int_8
42 : USE message_passing, ONLY: mp_cart_type
43 : #include "../../base/base_uses.f90"
44 :
45 : IMPLICIT NONE
46 : PRIVATE
47 :
48 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_tas_base'
49 :
50 : ! DBM wrappers / interface routines
51 : PUBLIC :: &
52 : dbt_tas_blk_sizes, &
53 : dbt_tas_clear, &
54 : dbt_tas_copy, &
55 : dbt_tas_create, &
56 : dbt_tas_destroy, &
57 : dbt_tas_distribution_destroy, &
58 : dbt_tas_distribution_new, &
59 : dbt_tas_filter, &
60 : dbt_tas_finalize, &
61 : dbt_tas_get_block_p, &
62 : dbt_tas_get_info, &
63 : dbt_tas_get_num_blocks, &
64 : dbt_tas_get_nze, &
65 : dbt_tas_get_nze_total, &
66 : dbt_tas_get_num_blocks_total, &
67 : dbt_tas_get_stored_coordinates, &
68 : dbt_tas_info, &
69 : dbt_tas_iterator_num_blocks, &
70 : dbt_tas_iterator_blocks_left, &
71 : dbt_tas_iterator_next_block, &
72 : dbt_tas_iterator_start, &
73 : dbt_tas_iterator_stop, &
74 : dbt_tas_nblkcols_local, &
75 : dbt_tas_nblkcols_total, &
76 : dbt_tas_nblkrows_local, &
77 : dbt_tas_nblkrows_total, &
78 : dbt_tas_nfullrows_total, &
79 : dbt_tas_nfullcols_total, &
80 : dbt_tas_put_block, &
81 : dbt_tas_reserve_blocks, &
82 : dbt_repl_get_stored_coordinates
83 :
84 : ! conversion routines
85 : PUBLIC :: &
86 : dbt_tas_convert_to_dbm, &
87 : dbt_tas_convert_to_tas
88 :
89 : INTERFACE dbt_tas_create
90 : MODULE PROCEDURE dbt_tas_create_new
91 : MODULE PROCEDURE dbt_tas_create_template
92 : END INTERFACE
93 :
94 : INTERFACE dbt_tas_reserve_blocks
95 : MODULE PROCEDURE dbt_tas_reserve_blocks_template
96 : MODULE PROCEDURE dbt_tas_reserve_blocks_index
97 : END INTERFACE
98 :
99 : INTERFACE dbt_tas_iterator_next_block
100 : MODULE PROCEDURE dbt_tas_iterator_next_block_d
101 : MODULE PROCEDURE dbt_tas_iterator_next_block_index
102 : END INTERFACE
103 :
104 : CONTAINS
105 :
106 : ! **************************************************************************************************
107 : !> \brief Create new tall-and-skinny matrix.
108 : !> Exactly like dbt_create_new but with custom types for row_blk_size and col_blk_size
109 : !> instead of arrays.
110 : !> \param matrix ...
111 : !> \param name ...
112 : !> \param dist ...
113 : !> \param row_blk_size ...
114 : !> \param col_blk_size ...
115 : !> \param own_dist whether matrix should own distribution
116 : !> \author Patrick Seewald
117 : ! **************************************************************************************************
118 3290532 : SUBROUTINE dbt_tas_create_new(matrix, name, dist, row_blk_size, col_blk_size, own_dist)
119 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix
120 : CHARACTER(len=*), INTENT(IN) :: name
121 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist
122 :
123 : CLASS(dbt_tas_rowcol_data), INTENT(IN) :: row_blk_size, col_blk_size
124 : LOGICAL, INTENT(IN), OPTIONAL :: own_dist
125 :
126 2820456 : TYPE(dbt_tas_split_info) :: info
127 :
128 940152 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: row_blk_size_vec, col_blk_size_vec
129 : INTEGER :: nrows, ncols, irow, col, icol, row
130 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_create_new'
131 : INTEGER :: handle
132 :
133 470076 : CALL timeset(routineN, handle)
134 :
135 470076 : CALL dbt_tas_copy_distribution(dist, matrix%dist, own_dist)
136 470076 : matrix%nblkrows = row_blk_size%nmrowcol
137 470076 : matrix%nblkcols = col_blk_size%nmrowcol
138 :
139 470076 : CPASSERT(matrix%nblkrows == dist%row_dist%nmrowcol)
140 470076 : CPASSERT(matrix%nblkcols == dist%col_dist%nmrowcol)
141 :
142 470076 : matrix%nfullrows = row_blk_size%nfullrowcol
143 470076 : matrix%nfullcols = col_blk_size%nfullrowcol
144 :
145 470076 : ALLOCATE (matrix%row_blk_size, source=row_blk_size)
146 470076 : ALLOCATE (matrix%col_blk_size, source=col_blk_size)
147 :
148 470076 : info = dbt_tas_info(matrix)
149 :
150 354012 : SELECT CASE (info%split_rowcol)
151 : CASE (rowsplit)
152 354012 : matrix%nblkrowscols_split = matrix%nblkrows
153 :
154 354012 : ASSOCIATE (rows => dist%local_rowcols)
155 354012 : nrows = SIZE(rows)
156 354012 : ncols = INT(dist%col_dist%nmrowcol)
157 1061716 : ALLOCATE (row_blk_size_vec(nrows))
158 1062036 : ALLOCATE (col_blk_size_vec(ncols))
159 3701593 : DO irow = 1, nrows
160 3701593 : row_blk_size_vec(irow) = row_blk_size%data(rows(irow))
161 : END DO
162 3452521 : DO col = 1, ncols
163 3098509 : col_blk_size_vec(col) = col_blk_size%data(INT(col, KIND=int_8))
164 : END DO
165 : END ASSOCIATE
166 : CASE (colsplit)
167 116064 : matrix%nblkrowscols_split = matrix%nblkcols
168 :
169 470076 : ASSOCIATE (cols => dist%local_rowcols)
170 116064 : ncols = SIZE(cols)
171 116064 : nrows = INT(dist%row_dist%nmrowcol)
172 348192 : ALLOCATE (row_blk_size_vec(nrows))
173 347440 : ALLOCATE (col_blk_size_vec(ncols))
174 6512298 : DO icol = 1, ncols
175 6512298 : col_blk_size_vec(icol) = col_blk_size%data(cols(icol))
176 : END DO
177 1253485 : DO row = 1, nrows
178 1137421 : row_blk_size_vec(row) = row_blk_size%data(INT(row, KIND=int_8))
179 : END DO
180 : END ASSOCIATE
181 : END SELECT
182 :
183 : CALL dbm_create(matrix=matrix%matrix, &
184 : name=name, &
185 : dist=dist%dbm_dist, &
186 : row_block_sizes=row_blk_size_vec, &
187 470076 : col_block_sizes=col_blk_size_vec)
188 :
189 470076 : DEALLOCATE (row_blk_size_vec, col_blk_size_vec)
190 470076 : matrix%valid = .TRUE.
191 470076 : CALL timestop(handle)
192 :
193 1880304 : END SUBROUTINE
194 :
195 : ! **************************************************************************************************
196 : !> \brief Create matrix from template
197 : !> \param matrix_in ...
198 : !> \param matrix ...
199 : !> \param name ...
200 : !> \author Patrick Seewald
201 : ! **************************************************************************************************
202 1758890 : SUBROUTINE dbt_tas_create_template(matrix_in, matrix, name)
203 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_in
204 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix
205 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
206 :
207 251270 : IF (PRESENT(name)) THEN
208 251258 : CALL dbm_create_from_template(matrix%matrix, name=name, template=matrix_in%matrix)
209 : ELSE
210 : CALL dbm_create_from_template(matrix%matrix, name=dbm_get_name(matrix_in%matrix), &
211 12 : template=matrix_in%matrix)
212 : END IF
213 251270 : CALL dbm_finalize(matrix%matrix)
214 :
215 251270 : CALL dbt_tas_copy_distribution(matrix_in%dist, matrix%dist)
216 251270 : ALLOCATE (matrix%row_blk_size, source=matrix_in%row_blk_size)
217 251270 : ALLOCATE (matrix%col_blk_size, source=matrix_in%col_blk_size)
218 251270 : matrix%nblkrows = matrix_in%nblkrows
219 251270 : matrix%nblkcols = matrix_in%nblkcols
220 251270 : matrix%nblkrowscols_split = matrix_in%nblkrowscols_split
221 251270 : matrix%nfullrows = matrix_in%nfullrows
222 251270 : matrix%nfullcols = matrix_in%nfullcols
223 251270 : matrix%valid = .TRUE.
224 :
225 251270 : END SUBROUTINE
226 :
227 : ! **************************************************************************************************
228 : !> \brief ...
229 : !> \param matrix ...
230 : !> \author Patrick Seewald
231 : ! **************************************************************************************************
232 721346 : SUBROUTINE dbt_tas_destroy(matrix)
233 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
234 :
235 721346 : CALL dbm_release(matrix%matrix)
236 721346 : CALL dbt_tas_distribution_destroy(matrix%dist)
237 721346 : DEALLOCATE (matrix%row_blk_size)
238 721346 : DEALLOCATE (matrix%col_blk_size)
239 721346 : matrix%valid = .FALSE.
240 721346 : END SUBROUTINE
241 :
242 : ! **************************************************************************************************
243 : !> \brief Copy matrix_a to matrix_b
244 : !> \param matrix_b ...
245 : !> \param matrix_a ...
246 : !> \param summation Whether to sum matrices b = a + b
247 : !> \author Patrick Seewald
248 : ! **************************************************************************************************
249 211521 : SUBROUTINE dbt_tas_copy(matrix_b, matrix_a, summation)
250 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_b
251 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_a
252 : LOGICAL, INTENT(IN), OPTIONAL :: summation
253 :
254 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_copy'
255 :
256 : INTEGER :: handle
257 : INTEGER(KIND=int_8) :: column, row
258 211521 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
259 : TYPE(dbt_tas_iterator) :: iter
260 :
261 211521 : CALL timeset(routineN, handle)
262 211521 : CPASSERT(matrix_b%valid)
263 :
264 211521 : IF (PRESENT(summation)) THEN
265 41114 : IF (.NOT. summation) CALL dbt_tas_clear(matrix_b)
266 : ELSE
267 170407 : CALL dbt_tas_clear(matrix_b)
268 : END IF
269 :
270 211521 : CALL dbt_tas_reserve_blocks(matrix_a, matrix_b)
271 :
272 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_a,matrix_b,summation) &
273 211521 : !$OMP PRIVATE(iter,row,column,block)
274 : CALL dbt_tas_iterator_start(iter, matrix_a)
275 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
276 : CALL dbt_tas_iterator_next_block(iter, row, column, block)
277 : CALL dbt_tas_put_block(matrix_b, row, column, block, summation=summation)
278 : END DO
279 : CALL dbt_tas_iterator_stop(iter)
280 : !$OMP END PARALLEL
281 :
282 211521 : CALL timestop(handle)
283 211521 : END SUBROUTINE
284 :
285 : ! **************************************************************************************************
286 : !> \brief Make sure that matrix_out has same blocks reserved as matrix_in.
287 : !> This assumes that both matrices have same number of block rows and block columns.
288 : !> \param matrix_in ...
289 : !> \param matrix_out ...
290 : !> \author Patrick Seewald
291 : ! **************************************************************************************************
292 255085 : SUBROUTINE dbt_tas_reserve_blocks_template(matrix_in, matrix_out)
293 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_in
294 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix_out
295 :
296 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_reserve_blocks_template'
297 :
298 : INTEGER :: handle, iblk, nblk
299 255085 : INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:) :: columns, rows
300 : TYPE(dbt_tas_iterator) :: iter
301 :
302 255085 : CALL timeset(routineN, handle)
303 :
304 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_in,matrix_out) &
305 255085 : !$OMP PRIVATE(iter,nblk,rows,columns)
306 : CALL dbt_tas_iterator_start(iter, matrix_in)
307 : nblk = dbt_tas_iterator_num_blocks(iter)
308 : ALLOCATE (rows(nblk), columns(nblk))
309 : DO iblk = 1, nblk
310 : CALL dbt_tas_iterator_next_block(iter, row=rows(iblk), column=columns(iblk))
311 : END DO
312 : CPASSERT(.NOT. dbt_tas_iterator_blocks_left(iter))
313 : CALL dbt_tas_iterator_stop(iter)
314 :
315 : CALL dbt_tas_reserve_blocks_index(matrix_out, rows=rows, columns=columns)
316 : !$OMP END PARALLEL
317 :
318 255085 : CALL timestop(handle)
319 510170 : END SUBROUTINE
320 :
321 : ! **************************************************************************************************
322 : !> \brief ...
323 : !> \param matrix ...
324 : !> \author Patrick Seewald
325 : ! **************************************************************************************************
326 1518332 : SUBROUTINE dbt_tas_finalize(matrix)
327 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
328 :
329 1518332 : CALL dbm_finalize(matrix%matrix)
330 1518332 : END SUBROUTINE
331 :
332 : ! **************************************************************************************************
333 : !> \brief create new distribution.
334 : !> Exactly like dbm_distribution_new but with custom types for row_dist and col_dist
335 : !> instead of arrays.
336 : !> \param dist ...
337 : !> \param mp_comm ...
338 : !> \param row_dist ...
339 : !> \param col_dist ...
340 : !> \param split_info Strategy of how to split process grid (optional).
341 : !> If not present a default split heuristic is applied.
342 : !> \param nosplit if .TRUE. don't split process grid (optional)
343 : !> \author Patrick Seewald
344 : ! **************************************************************************************************
345 4131862 : SUBROUTINE dbt_tas_distribution_new(dist, mp_comm, row_dist, col_dist, split_info, nosplit)
346 : TYPE(dbt_tas_distribution_type), INTENT(OUT) :: dist
347 : TYPE(mp_cart_type), INTENT(IN) :: mp_comm
348 :
349 : CLASS(dbt_tas_distribution), INTENT(IN) :: row_dist, col_dist
350 : TYPE(dbt_tas_split_info), INTENT(IN), OPTIONAL :: split_info
351 : !!
352 : LOGICAL, INTENT(IN), OPTIONAL :: nosplit
353 : !LOGICAL, INTENT(IN), OPTIONAL :: strict_split
354 :
355 3541596 : TYPE(dbt_tas_split_info) :: split_info_prv
356 :
357 590266 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: row_dist_vec
358 590266 : INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_dist_vec
359 : INTEGER :: nrows, ncols, irow, col, icol, row, &
360 : split_rowcol, nsplit, handle
361 : LOGICAL :: opt_nsplit
362 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_distribution_new'
363 :
364 590266 : CALL timeset(routineN, handle)
365 590266 : IF (PRESENT(split_info)) THEN
366 447304 : CALL dbt_tas_info_hold(split_info)
367 447304 : split_info_prv = split_info
368 : ELSE
369 : ! default split heuristic: split into submatrices that have roughly same block dimensions
370 142962 : IF (row_dist%nmrowcol >= col_dist%nmrowcol) THEN
371 132854 : split_rowcol = rowsplit
372 132854 : nsplit = INT((row_dist%nmrowcol - 1)/col_dist%nmrowcol + 1)
373 : ELSE
374 10108 : split_rowcol = colsplit
375 10108 : nsplit = INT((col_dist%nmrowcol - 1)/row_dist%nmrowcol + 1)
376 : END IF
377 142962 : opt_nsplit = .TRUE.
378 142962 : IF (PRESENT(nosplit)) THEN
379 103254 : IF (nosplit) THEN
380 103254 : nsplit = 1
381 103254 : opt_nsplit = .FALSE.
382 : END IF
383 : END IF
384 142962 : CALL dbt_tas_create_split(split_info_prv, mp_comm, split_rowcol, nsplit=nsplit, opt_nsplit=opt_nsplit)
385 : END IF
386 :
387 1012476 : SELECT CASE (split_info_prv%split_rowcol)
388 : CASE (rowsplit)
389 422210 : CALL group_to_mrowcol(split_info_prv, row_dist, split_info_prv%igroup, dist%local_rowcols)
390 422210 : nrows = SIZE(dist%local_rowcols)
391 422210 : ncols = INT(col_dist%nmrowcol)
392 1266051 : ALLOCATE (row_dist_vec(nrows))
393 1266630 : ALLOCATE (col_dist_vec(ncols))
394 4332140 : DO irow = 1, nrows
395 4332140 : row_dist_vec(irow) = row_dist%dist(dist%local_rowcols(irow)) - split_info_prv%pgrid_split_size*split_info_prv%igroup
396 : END DO
397 4049793 : DO col = 1, ncols
398 3627583 : col_dist_vec(col) = col_dist%dist(INT(col, KIND=int_8))
399 : END DO
400 : CASE (colsplit)
401 168056 : CALL group_to_mrowcol(split_info_prv, col_dist, split_info_prv%igroup, dist%local_rowcols)
402 168056 : ncols = SIZE(dist%local_rowcols)
403 168056 : nrows = INT(row_dist%nmrowcol)
404 502664 : ALLOCATE (col_dist_vec(ncols))
405 504168 : ALLOCATE (row_dist_vec(nrows))
406 8706942 : DO icol = 1, ncols
407 8706942 : col_dist_vec(icol) = col_dist%dist(dist%local_rowcols(icol)) - split_info_prv%pgrid_split_size*split_info_prv%igroup
408 : END DO
409 2215719 : DO row = 1, nrows
410 1457397 : row_dist_vec(row) = row_dist%dist(INT(row, KIND=int_8))
411 : END DO
412 : END SELECT
413 :
414 590266 : dist%info = split_info_prv
415 :
416 : CALL dbm_distribution_new(dist%dbm_dist, split_info_prv%mp_comm_group, &
417 590266 : row_dist_vec, col_dist_vec)
418 590266 : DEALLOCATE (row_dist_vec, col_dist_vec)
419 590266 : ALLOCATE (dist%row_dist, source=row_dist)
420 590266 : ALLOCATE (dist%col_dist, source=col_dist)
421 :
422 : !IF(PRESENT(strict_split)) dist%strict_split = strict_split
423 :
424 590266 : CALL timestop(handle)
425 1180532 : END SUBROUTINE
426 :
427 : ! **************************************************************************************************
428 : !> \brief ...
429 : !> \param dist ...
430 : !> \author Patrick Seewald
431 : ! **************************************************************************************************
432 1092818 : SUBROUTINE dbt_tas_distribution_destroy(dist)
433 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist
434 :
435 : ! Note: Issue with Cray CCE compiler
436 : ! commented out the following deallocate statements on polymorphic variables,
437 : ! these cause segfaults with CCE compiler at a later point
438 :
439 : !IF (ALLOCATED(dist%row_dist)) THEN
440 : ! DEALLOCATE (dist%row_dist)
441 : !ENDIF
442 : !IF (ALLOCATED(dist%col_dist)) THEN
443 : ! DEALLOCATE (dist%col_dist)
444 : !ENDIF
445 :
446 1092818 : IF (ALLOCATED(dist%local_rowcols)) THEN
447 1092818 : DEALLOCATE (dist%local_rowcols)
448 : END IF
449 1092818 : CALL dbt_tas_release_info(dist%info)
450 1092818 : CALL dbm_distribution_release(dist%dbm_dist)
451 1092818 : END SUBROUTINE
452 :
453 : ! **************************************************************************************************
454 : !> \brief As dbt_get_stored_coordinates
455 : !> \param matrix ...
456 : !> \param row global matrix blocked row
457 : !> \param column global matrix blocked column
458 : !> \param processor process ID
459 : !> \author Patrick Seewald
460 : ! **************************************************************************************************
461 9928552 : SUBROUTINE dbt_tas_get_stored_coordinates(matrix, row, column, processor)
462 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
463 : INTEGER(KIND=int_8), INTENT(IN) :: row, column
464 : INTEGER, INTENT(OUT) :: processor
465 :
466 : INTEGER, DIMENSION(2) :: pcoord
467 59571312 : TYPE(dbt_tas_split_info) :: info
468 :
469 9928552 : pcoord(1) = matrix%dist%row_dist%dist(row)
470 9928552 : pcoord(2) = matrix%dist%col_dist%dist(column)
471 9928552 : info = dbt_tas_info(matrix)
472 :
473 : ! workaround for inefficient mpi_cart_rank
474 9928552 : processor = pcoord(1)*info%pdims(2) + pcoord(2)
475 :
476 9928552 : END SUBROUTINE
477 :
478 : ! **************************************************************************************************
479 : !> \brief Get all processors for a given row/col combination if matrix is replicated on each process
480 : !> subgroup.
481 : !> \param matrix tall-and-skinny matrix whose DBM submatrices are replicated matrices
482 : !> \param row row of a submatrix
483 : !> \param column column of a submatrix
484 : !> \param processors ...
485 : !> \author Patrick Seewald
486 : ! **************************************************************************************************
487 2347708 : SUBROUTINE dbt_repl_get_stored_coordinates(matrix, row, column, processors)
488 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
489 : INTEGER, INTENT(IN) :: row, column
490 : INTEGER, DIMENSION(:), INTENT(OUT) :: processors
491 :
492 : INTEGER :: igroup
493 : INTEGER(KIND=int_8) :: col_s, row_s
494 : INTEGER, DIMENSION(2) :: pcoord
495 14086248 : TYPE(dbt_tas_split_info) :: info
496 :
497 2347708 : row_s = INT(row, KIND=int_8); col_s = INT(column, KIND=int_8)
498 :
499 2347708 : info = dbt_tas_info(matrix)
500 2347708 : pcoord(1) = matrix%dist%row_dist%dist(row_s)
501 2347708 : pcoord(2) = matrix%dist%col_dist%dist(col_s)
502 :
503 6005704 : DO igroup = 0, info%ngroup - 1
504 3657996 : CALL info%mp_comm%rank_cart(pcoord, processors(igroup + 1))
505 2347708 : SELECT CASE (info%split_rowcol)
506 : CASE (rowsplit)
507 2257992 : row_s = row_s + dbt_tas_nblkrows_local(matrix)
508 2257992 : pcoord(1) = matrix%dist%row_dist%dist(row_s)
509 : CASE (colsplit)
510 1400004 : col_s = col_s + dbt_tas_nblkcols_local(matrix)
511 5058000 : pcoord(2) = matrix%dist%col_dist%dist(col_s)
512 : END SELECT
513 : END DO
514 2347708 : END SUBROUTINE
515 :
516 : ! **************************************************************************************************
517 : !> \brief Convert a tall-and-skinny matrix into a normal DBM matrix.
518 : !> This is not recommended for matrices with a very large dimension.
519 : !> \param matrix_rect ...
520 : !> \param matrix_dbm ...
521 : !> \author Patrick Seewald
522 : ! **************************************************************************************************
523 448 : SUBROUTINE dbt_tas_convert_to_dbm(matrix_rect, matrix_dbm)
524 : TYPE(dbt_tas_type), INTENT(IN) :: matrix_rect
525 : TYPE(dbm_type), INTENT(OUT) :: matrix_dbm
526 :
527 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_convert_to_dbm'
528 :
529 : INTEGER :: handle, nblks_local, rb_count
530 : INTEGER(KIND=int_8) :: col, row
531 224 : INTEGER, ALLOCATABLE, DIMENSION(:) :: nz_cols, nz_rows
532 224 : INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_dist_vec, col_size_vec, &
533 224 : row_dist_vec, row_size_vec
534 224 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
535 : TYPE(dbm_distribution_obj) :: dist
536 : TYPE(dbt_tas_iterator) :: iter
537 1344 : TYPE(dbt_tas_split_info) :: info
538 :
539 224 : CALL timeset(routineN, handle)
540 :
541 224 : info = dbt_tas_info(matrix_rect)
542 :
543 672 : ALLOCATE (row_dist_vec(matrix_rect%nblkrows))
544 448 : ALLOCATE (row_size_vec(matrix_rect%nblkrows))
545 672 : ALLOCATE (col_dist_vec(matrix_rect%nblkcols))
546 448 : ALLOCATE (col_size_vec(matrix_rect%nblkcols))
547 :
548 8944 : DO row = 1, matrix_rect%nblkrows
549 8720 : row_dist_vec(row) = matrix_rect%dist%row_dist%dist(row)
550 8944 : row_size_vec(row) = matrix_rect%row_blk_size%data(row)
551 : END DO
552 :
553 7998 : DO col = 1, matrix_rect%nblkcols
554 7774 : col_dist_vec(col) = matrix_rect%dist%col_dist%dist(col)
555 7998 : col_size_vec(col) = matrix_rect%col_blk_size%data(col)
556 : END DO
557 :
558 224 : CALL dbm_distribution_new(dist, info%mp_comm, row_dist_vec, col_dist_vec)
559 224 : DEALLOCATE (row_dist_vec, col_dist_vec)
560 :
561 : CALL dbm_create(matrix=matrix_dbm, &
562 : name=TRIM(dbm_get_name(matrix_rect%matrix)), &
563 : dist=dist, &
564 : row_block_sizes=row_size_vec, &
565 224 : col_block_sizes=col_size_vec)
566 :
567 224 : CALL dbm_distribution_release(dist)
568 :
569 224 : DEALLOCATE (row_size_vec, col_size_vec)
570 :
571 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_rect,matrix_dbm) &
572 224 : !$OMP PRIVATE(iter,nblks_local,nz_rows,nz_cols,rb_count,row,col,block)
573 : CALL dbt_tas_iterator_start(iter, matrix_rect)
574 : nblks_local = dbt_tas_iterator_num_blocks(iter)
575 : ALLOCATE (nz_rows(nblks_local), nz_cols(nblks_local))
576 : rb_count = 0
577 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
578 : CALL dbt_tas_iterator_next_block(iter, row, col)
579 : rb_count = rb_count + 1
580 : nz_rows(rb_count) = INT(row)
581 : nz_cols(rb_count) = INT(col)
582 : END DO
583 : CALL dbt_tas_iterator_stop(iter)
584 :
585 : CALL dbm_reserve_blocks(matrix_dbm, nz_rows, nz_cols)
586 :
587 : CALL dbt_tas_iterator_start(iter, matrix_rect)
588 : DO WHILE (dbt_tas_iterator_blocks_left(iter))
589 : CALL dbt_tas_iterator_next_block(iter, row, col, block)
590 : CALL dbm_put_block(matrix_dbm, INT(row), INT(col), block)
591 : END DO
592 : CALL dbt_tas_iterator_stop(iter)
593 : !$OMP END PARALLEL
594 :
595 224 : CALL dbm_finalize(matrix_dbm)
596 :
597 224 : CALL timestop(handle)
598 672 : END SUBROUTINE
599 :
600 : ! **************************************************************************************************
601 : !> \brief Converts a DBM matrix into the tall-and-skinny matrix type.
602 : !> \param info Strategy of how to split process grid
603 : !> \param matrix_rect ...
604 : !> \param matrix_dbm ...
605 : !> \author Patrick Seewald
606 : ! **************************************************************************************************
607 0 : SUBROUTINE dbt_tas_convert_to_tas(info, matrix_rect, matrix_dbm)
608 : TYPE(dbt_tas_split_info), INTENT(IN) :: info
609 : TYPE(dbt_tas_type), INTENT(OUT) :: matrix_rect
610 : TYPE(dbm_type), INTENT(IN) :: matrix_dbm
611 :
612 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_convert_to_tas'
613 :
614 : CHARACTER(len=default_string_length) :: name
615 : INTEGER :: col, handle, row
616 : INTEGER(KIND=int_8) :: nbcols, nbrows
617 0 : INTEGER, CONTIGUOUS, DIMENSION(:), POINTER :: col_blk_size, row_blk_size
618 : INTEGER, DIMENSION(2) :: pdims
619 0 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: block
620 : TYPE(dbm_distribution_obj) :: dbm_dist
621 : TYPE(dbm_iterator) :: iter
622 0 : TYPE(dbt_tas_blk_size_arb) :: col_blk_size_obj, row_blk_size_obj
623 0 : TYPE(dbt_tas_dist_arb) :: col_dist_obj, row_dist_obj
624 0 : TYPE(dbt_tas_distribution_type) :: dist
625 :
626 : NULLIFY (col_blk_size, row_blk_size)
627 0 : CALL timeset(routineN, handle)
628 0 : pdims = info%mp_comm%num_pe_cart
629 :
630 0 : name = dbm_get_name(matrix_dbm)
631 0 : row_blk_size => dbm_get_row_block_sizes(matrix_dbm)
632 0 : col_blk_size => dbm_get_col_block_sizes(matrix_dbm)
633 :
634 0 : nbrows = SIZE(row_blk_size)
635 0 : nbcols = SIZE(col_blk_size)
636 :
637 0 : dbm_dist = dbm_get_distribution(matrix_dbm)
638 0 : row_dist_obj = dbt_tas_dist_arb(dbm_distribution_row_dist(dbm_dist), pdims(1), nbrows)
639 0 : col_dist_obj = dbt_tas_dist_arb(dbm_distribution_col_dist(dbm_dist), pdims(2), nbcols)
640 :
641 0 : row_blk_size_obj = dbt_tas_blk_size_arb(row_blk_size)
642 0 : col_blk_size_obj = dbt_tas_blk_size_arb(col_blk_size)
643 :
644 0 : CALL dbt_tas_distribution_new(dist, info%mp_comm, row_dist_obj, col_dist_obj)
645 :
646 : CALL dbt_tas_create(matrix_rect, TRIM(name)//"_compressed", &
647 0 : dist, row_blk_size_obj, col_blk_size_obj)
648 :
649 0 : !$OMP PARALLEL DEFAULT(NONE) SHARED(matrix_dbm,matrix_rect) PRIVATE(iter,row,col,block)
650 : CALL dbm_iterator_start(iter, matrix_dbm)
651 : DO WHILE (dbm_iterator_blocks_left(iter))
652 : CALL dbm_iterator_next_block(iter, row, col, block)
653 : CALL dbt_tas_put_block(matrix_rect, INT(row, KIND=int_8), INT(col, KIND=int_8), block)
654 : END DO
655 : CALL dbm_iterator_stop(iter)
656 : !$OMP END PARALLEL
657 :
658 0 : CALL dbt_tas_finalize(matrix_rect)
659 :
660 0 : CALL timestop(handle)
661 0 : END SUBROUTINE
662 :
663 : ! **************************************************************************************************
664 : !> \brief As dbm_iterator_start
665 : !> \param iter ...
666 : !> \param matrix_in ...
667 : !> \author Patrick Seewald
668 : ! **************************************************************************************************
669 2285393 : SUBROUTINE dbt_tas_iterator_start(iter, matrix_in)
670 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter
671 : TYPE(dbt_tas_type), INTENT(IN), TARGET :: matrix_in
672 :
673 2285393 : CALL dbm_iterator_start(iter%iter, matrix_in%matrix)
674 :
675 2285393 : iter%dist => matrix_in%dist
676 2285393 : END SUBROUTINE
677 :
678 : ! **************************************************************************************************
679 : !> \brief As dbm_iterator_num_blocks
680 : !> \param iter ...
681 : !> \return ...
682 : !> \author Ole Schuett
683 : ! **************************************************************************************************
684 493566 : FUNCTION dbt_tas_iterator_num_blocks(iter)
685 : TYPE(dbt_tas_iterator), INTENT(IN) :: iter
686 : INTEGER :: dbt_tas_iterator_num_blocks
687 :
688 493566 : dbt_tas_iterator_num_blocks = dbm_iterator_num_blocks(iter%iter)
689 493566 : END FUNCTION
690 :
691 : ! **************************************************************************************************
692 : !> \brief As dbm_iterator_blocks_left
693 : !> \param iter ...
694 : !> \return ...
695 : !> \author Patrick Seewald
696 : ! **************************************************************************************************
697 42634650 : FUNCTION dbt_tas_iterator_blocks_left(iter)
698 : TYPE(dbt_tas_iterator), INTENT(IN) :: iter
699 : LOGICAL :: dbt_tas_iterator_blocks_left
700 :
701 42634650 : dbt_tas_iterator_blocks_left = dbm_iterator_blocks_left(iter%iter)
702 42634650 : END FUNCTION
703 :
704 : ! **************************************************************************************************
705 : !> \brief As dbm_iterator_stop
706 : !> \param iter ...
707 : !> \author Patrick Seewald
708 : ! **************************************************************************************************
709 2285393 : SUBROUTINE dbt_tas_iterator_stop(iter)
710 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iter
711 :
712 2285393 : CALL dbm_iterator_stop(iter%iter)
713 2285393 : END SUBROUTINE
714 :
715 : ! **************************************************************************************************
716 : !> \brief As dbm_iterator_next_block
717 : !> \param iterator ...
718 : !> \param row global block row
719 : !> \param column global block column
720 : !> \param row_size ...
721 : !> \param col_size ...
722 : !> \author Patrick Seewald
723 : ! **************************************************************************************************
724 77567208 : SUBROUTINE dbt_tas_iterator_next_block_index(iterator, row, column, row_size, col_size)
725 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iterator
726 : INTEGER(KIND=int_8), INTENT(OUT) :: row, column
727 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
728 :
729 : INTEGER :: column_group, row_group
730 :
731 : CALL dbm_iterator_next_block(iterator%iter, row=row_group, column=column_group, &
732 38783604 : row_size=row_size, col_size=col_size)
733 :
734 : CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, &
735 38783604 : row=row, column=column)
736 :
737 38783604 : END SUBROUTINE
738 :
739 : ! **************************************************************************************************
740 : !> \brief As dbm_reserve_blocks
741 : !> \param matrix ...
742 : !> \param rows ...
743 : !> \param columns ...
744 : !> \author Patrick Seewald
745 : ! **************************************************************************************************
746 944875 : SUBROUTINE dbt_tas_reserve_blocks_index(matrix, rows, columns)
747 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
748 : INTEGER(KIND=int_8), DIMENSION(:), INTENT(IN) :: rows, columns
749 :
750 : CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_tas_reserve_blocks_index'
751 :
752 : INTEGER :: handle, i
753 1889750 : INTEGER, DIMENSION(SIZE(rows)) :: columns_group, rows_group
754 :
755 944875 : CALL timeset(routineN, handle)
756 :
757 944875 : CPASSERT(SIZE(rows) == SIZE(columns))
758 21698371 : DO i = 1, SIZE(rows)
759 : CALL dbt_index_global_to_local(dbt_tas_info(matrix), matrix%dist, &
760 : row=rows(i), row_group=rows_group(i), &
761 21698371 : column=columns(i), column_group=columns_group(i))
762 : END DO
763 :
764 944875 : CALL dbm_reserve_blocks(matrix%matrix, rows_group, columns_group)
765 :
766 944875 : CALL timestop(handle)
767 944875 : END SUBROUTINE
768 :
769 : ! **************************************************************************************************
770 : !> \brief Copy a distribution
771 : !> \param dist_in ...
772 : !> \param dist_out ...
773 : !> \param own_dist Whether distribution should be owned by dist_out
774 : !> \author Patrick Seewald
775 : ! **************************************************************************************************
776 5049422 : SUBROUTINE dbt_tas_copy_distribution(dist_in, dist_out, own_dist)
777 : TYPE(dbt_tas_distribution_type), INTENT(INOUT) :: dist_in
778 : TYPE(dbt_tas_distribution_type), INTENT(OUT) :: dist_out
779 : LOGICAL, INTENT(IN), OPTIONAL :: own_dist
780 :
781 : LOGICAL :: own_dist_prv
782 :
783 721346 : IF (PRESENT(own_dist)) THEN
784 218794 : own_dist_prv = own_dist
785 : ELSE
786 : own_dist_prv = .FALSE.
787 : END IF
788 :
789 218794 : IF (.NOT. own_dist_prv) THEN
790 502552 : CALL dbm_distribution_hold(dist_in%dbm_dist)
791 502552 : CALL dbt_tas_info_hold(dist_in%info)
792 : END IF
793 :
794 721346 : dist_out = dist_in
795 721346 : END SUBROUTINE
796 :
797 : ! **************************************************************************************************
798 : !> \brief Get block size for a given row & column
799 : !> \param matrix ...
800 : !> \param row ...
801 : !> \param col ...
802 : !> \param row_size ...
803 : !> \param col_size ...
804 : !> \author Patrick Seewald
805 : ! **************************************************************************************************
806 3771763 : SUBROUTINE dbt_tas_blk_sizes(matrix, row, col, row_size, col_size)
807 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
808 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
809 : INTEGER, INTENT(OUT) :: row_size, col_size
810 :
811 3771763 : row_size = matrix%row_blk_size%data(row)
812 3771763 : col_size = matrix%col_blk_size%data(col)
813 3771763 : END SUBROUTINE
814 :
815 : ! **************************************************************************************************
816 : !> \brief get info on mpi grid splitting
817 : !> \param matrix ...
818 : !> \return ...
819 : !> \author Patrick Seewald
820 : ! **************************************************************************************************
821 37537169 : FUNCTION dbt_tas_info(matrix)
822 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
823 : TYPE(dbt_tas_split_info) :: dbt_tas_info
824 :
825 37537169 : dbt_tas_info = matrix%dist%info
826 187685845 : END FUNCTION
827 :
828 : ! **************************************************************************************************
829 : !> \brief ...
830 : !> \param matrix ...
831 : !> \return ...
832 : !> \author Patrick Seewald
833 : ! **************************************************************************************************
834 940460 : FUNCTION dbt_tas_nblkrows_total(matrix) RESULT(nblkrows_total)
835 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
836 : INTEGER(KIND=int_8) :: nblkrows_total
837 :
838 940460 : nblkrows_total = matrix%nblkrows
839 940460 : END FUNCTION
840 :
841 : ! **************************************************************************************************
842 : !> \brief ...
843 : !> \param matrix ...
844 : !> \return ...
845 : !> \author Patrick Seewald
846 : ! **************************************************************************************************
847 0 : FUNCTION dbt_tas_nfullrows_total(matrix) RESULT(nfullrows_total)
848 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
849 : INTEGER(KIND=int_8) :: nfullrows_total
850 :
851 0 : nfullrows_total = matrix%nfullrows
852 0 : END FUNCTION
853 :
854 : ! **************************************************************************************************
855 : !> \brief ...
856 : !> \param matrix ...
857 : !> \return ...
858 : !> \author Patrick Seewald
859 : ! **************************************************************************************************
860 940968 : FUNCTION dbt_tas_nblkcols_total(matrix) RESULT(nblkcols_total)
861 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
862 : INTEGER(KIND=int_8) :: nblkcols_total
863 :
864 940968 : nblkcols_total = matrix%nblkcols
865 940968 : END FUNCTION
866 :
867 : ! **************************************************************************************************
868 : !> \brief ...
869 : !> \param matrix ...
870 : !> \return ...
871 : !> \author Patrick Seewald
872 : ! **************************************************************************************************
873 0 : FUNCTION dbt_tas_nfullcols_total(matrix) RESULT(nfullcols_total)
874 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
875 : INTEGER(KIND=int_8) :: nfullcols_total
876 :
877 0 : nfullcols_total = matrix%nfullcols
878 0 : END FUNCTION
879 :
880 : ! **************************************************************************************************
881 : !> \brief ...
882 : !> \param matrix ...
883 : !> \return ...
884 : !> \author Patrick Seewald
885 : ! **************************************************************************************************
886 1400004 : FUNCTION dbt_tas_nblkcols_local(matrix) RESULT(nblkcols_local)
887 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
888 : INTEGER :: nblkcols_local
889 :
890 1400004 : nblkcols_local = SIZE(dbm_get_col_block_sizes(matrix%matrix))
891 1400004 : END FUNCTION
892 :
893 : ! **************************************************************************************************
894 : !> \brief ...
895 : !> \param matrix ...
896 : !> \return ...
897 : !> \author Patrick Seewald
898 : ! **************************************************************************************************
899 2257992 : FUNCTION dbt_tas_nblkrows_local(matrix) RESULT(nblkrows_local)
900 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
901 : INTEGER :: nblkrows_local
902 :
903 2257992 : nblkrows_local = SIZE(dbm_get_row_block_sizes(matrix%matrix))
904 2257992 : END FUNCTION
905 :
906 : ! **************************************************************************************************
907 : !> \brief As dbt_get_num_blocks: get number of local blocks
908 : !> \param matrix ...
909 : !> \return ...
910 : !> \author Patrick Seewald
911 : ! **************************************************************************************************
912 831308 : PURE FUNCTION dbt_tas_get_num_blocks(matrix) RESULT(num_blocks)
913 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
914 : INTEGER :: num_blocks
915 :
916 831308 : num_blocks = dbm_get_num_blocks(matrix%matrix)
917 831308 : END FUNCTION
918 :
919 : ! **************************************************************************************************
920 : !> \brief get total number of blocks
921 : !> \param matrix ...
922 : !> \return ...
923 : !> \author Patrick Seewald
924 : ! **************************************************************************************************
925 276982 : FUNCTION dbt_tas_get_num_blocks_total(matrix) RESULT(num_blocks)
926 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
927 : INTEGER(KIND=int_8) :: num_blocks
928 :
929 1384910 : TYPE(dbt_tas_split_info) :: info
930 :
931 276982 : info = dbt_tas_info(matrix)
932 276982 : num_blocks = dbt_tas_get_num_blocks(matrix)
933 276982 : CALL info%mp_comm%sum(num_blocks)
934 :
935 276982 : END FUNCTION
936 :
937 : ! **************************************************************************************************
938 : !> \brief As dbt_get_nze: get number of local non-zero elements
939 : !> \param matrix ...
940 : !> \return ...
941 : !> \author Patrick Seewald
942 : ! **************************************************************************************************
943 1205003 : PURE FUNCTION dbt_tas_get_nze(matrix)
944 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
945 : INTEGER :: dbt_tas_get_nze
946 :
947 1205003 : dbt_tas_get_nze = dbm_get_nze(matrix%matrix)
948 :
949 1205003 : END FUNCTION
950 :
951 : ! **************************************************************************************************
952 : !> \brief Get total number of non-zero elements
953 : !> \param matrix ...
954 : !> \return ...
955 : !> \author Patrick Seewald
956 : ! **************************************************************************************************
957 930081 : FUNCTION dbt_tas_get_nze_total(matrix)
958 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
959 : INTEGER(KIND=int_8) :: dbt_tas_get_nze_total
960 :
961 4650405 : TYPE(dbt_tas_split_info) :: info
962 :
963 930081 : dbt_tas_get_nze_total = dbt_tas_get_nze(matrix)
964 930081 : info = dbt_tas_info(matrix)
965 930081 : CALL info%mp_comm%sum(dbt_tas_get_nze_total)
966 930081 : END FUNCTION
967 :
968 : ! **************************************************************************************************
969 : !> \brief Clear matrix (erase all data)
970 : !> \param matrix ...
971 : !> \author Patrick Seewald
972 : ! **************************************************************************************************
973 1224038 : SUBROUTINE dbt_tas_clear(matrix)
974 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
975 :
976 1224038 : CALL dbm_clear(matrix%matrix)
977 1224038 : END SUBROUTINE
978 :
979 : ! **************************************************************************************************
980 : !> \brief ...
981 : !> \param matrix ...
982 : !> \param nblkrows_total ...
983 : !> \param nblkcols_total ...
984 : !> \param local_rows ...
985 : !> \param local_cols ...
986 : !> \param proc_row_dist ...
987 : !> \param proc_col_dist ...
988 : !> \param row_blk_size ...
989 : !> \param col_blk_size ...
990 : !> \param distribution ...
991 : !> \param name ...
992 : !> \author Patrick Seewald
993 : ! **************************************************************************************************
994 885695 : SUBROUTINE dbt_tas_get_info(matrix, &
995 : nblkrows_total, nblkcols_total, &
996 : local_rows, local_cols, &
997 : proc_row_dist, proc_col_dist, &
998 : row_blk_size, col_blk_size, distribution, name)
999 :
1000 : TYPE(dbt_tas_type), INTENT(IN) :: matrix
1001 : INTEGER(KIND=int_8), INTENT(OUT), OPTIONAL :: nblkrows_total, nblkcols_total
1002 : INTEGER(KIND=int_8), ALLOCATABLE, DIMENSION(:), &
1003 : OPTIONAL :: local_rows, local_cols
1004 :
1005 : CLASS(dbt_tas_distribution), ALLOCATABLE, OPTIONAL, &
1006 : INTENT(OUT) :: proc_row_dist, proc_col_dist
1007 : CLASS(dbt_tas_rowcol_data), ALLOCATABLE, OPTIONAL, &
1008 : INTENT(OUT) :: row_blk_size, col_blk_size
1009 : TYPE(dbt_tas_distribution_type), OPTIONAL :: distribution
1010 : CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
1011 :
1012 4428475 : TYPE(dbt_tas_split_info) :: info
1013 : INTEGER :: irow, icol
1014 885695 : INTEGER, ALLOCATABLE, DIMENSION(:) :: local_rows_local, local_cols_local
1015 :
1016 885695 : info = dbt_tas_info(matrix)
1017 :
1018 885695 : IF (PRESENT(local_rows)) THEN
1019 164316 : CALL dbm_get_local_rows(matrix%matrix, local_rows_local)
1020 492924 : ALLOCATE (local_rows(SIZE(local_rows_local)))
1021 2887844 : DO irow = 1, SIZE(local_rows_local)
1022 2887844 : CALL dbt_index_local_to_global(info, matrix%dist, row_group=local_rows_local(irow), row=local_rows(irow))
1023 : END DO
1024 : END IF
1025 :
1026 885695 : IF (PRESENT(local_cols)) THEN
1027 73518 : CALL dbm_get_local_cols(matrix%matrix, local_cols_local)
1028 217430 : ALLOCATE (local_cols(SIZE(local_cols_local)))
1029 38400552 : DO icol = 1, SIZE(local_cols_local)
1030 38400552 : CALL dbt_index_local_to_global(info, matrix%dist, column_group=local_cols_local(icol), column=local_cols(icol))
1031 : END DO
1032 : END IF
1033 :
1034 885695 : IF (PRESENT(name)) name = dbm_get_name(matrix%matrix)
1035 885695 : IF (PRESENT(nblkrows_total)) nblkrows_total = dbt_tas_nblkrows_total(matrix)
1036 885695 : IF (PRESENT(nblkcols_total)) nblkcols_total = dbt_tas_nblkcols_total(matrix)
1037 885695 : IF (PRESENT(proc_row_dist)) ALLOCATE (proc_row_dist, SOURCE=matrix%dist%row_dist)
1038 885695 : IF (PRESENT(proc_col_dist)) ALLOCATE (proc_col_dist, SOURCE=matrix%dist%col_dist)
1039 885695 : IF (PRESENT(row_blk_size)) ALLOCATE (row_blk_size, SOURCE=matrix%row_blk_size)
1040 885695 : IF (PRESENT(col_blk_size)) ALLOCATE (col_blk_size, SOURCE=matrix%col_blk_size)
1041 885695 : IF (PRESENT(distribution)) distribution = matrix%dist
1042 :
1043 1771390 : END SUBROUTINE
1044 :
1045 : ! **************************************************************************************************
1046 : !> \brief As dbm_iterator_next_block
1047 : !> \param iterator ...
1048 : !> \param row ...
1049 : !> \param column ...
1050 : !> \param block ...
1051 : !> \param row_size ...
1052 : !> \param col_size ...
1053 : !> \author Patrick Seewald
1054 : ! **************************************************************************************************
1055 19245906 : SUBROUTINE dbt_tas_iterator_next_block_d(iterator, row, column, block, row_size, col_size)
1056 : TYPE(dbt_tas_iterator), INTENT(INOUT) :: iterator
1057 : INTEGER(KIND=int_8), INTENT(OUT) :: row, column
1058 : REAL(dp), DIMENSION(:, :), POINTER :: block
1059 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1060 :
1061 : INTEGER :: column_group, row_group
1062 :
1063 : CALL dbm_iterator_next_block(iterator%iter, row_group, column_group, block, &
1064 9622953 : row_size=row_size, col_size=col_size)
1065 :
1066 : CALL dbt_index_local_to_global(iterator%dist%info, iterator%dist, row_group=row_group, column_group=column_group, &
1067 9622953 : row=row, column=column)
1068 :
1069 9622953 : END SUBROUTINE
1070 :
1071 : ! **************************************************************************************************
1072 : !> \brief As dbm_put_block
1073 : !> \param matrix ...
1074 : !> \param row ...
1075 : !> \param col ...
1076 : !> \param block ...
1077 : !> \param summation ...
1078 : !> \author Patrick Seewald
1079 : ! **************************************************************************************************
1080 24999069 : SUBROUTINE dbt_tas_put_block(matrix, row, col, block, summation)
1081 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1082 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
1083 : REAL(dp), DIMENSION(:, :), INTENT(IN) :: block
1084 : LOGICAL, INTENT(IN), OPTIONAL :: summation
1085 :
1086 : INTEGER :: col_group, row_group
1087 :
1088 : CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1089 24999069 : row_group=row_group, column_group=col_group)
1090 :
1091 12651955425 : CALL dbm_put_block(matrix%matrix, row_group, col_group, block, summation=summation)
1092 :
1093 24999069 : END SUBROUTINE
1094 :
1095 : ! **************************************************************************************************
1096 : !> \brief As dbm_get_block_p
1097 : !> \param matrix ...
1098 : !> \param row ...
1099 : !> \param col ...
1100 : !> \param block ...
1101 : !> \param row_size ...
1102 : !> \param col_size ...
1103 : !> \author Patrick Seewald
1104 : ! **************************************************************************************************
1105 34976402 : SUBROUTINE dbt_tas_get_block_p(matrix, row, col, block, row_size, col_size)
1106 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1107 : INTEGER(KIND=int_8), INTENT(IN) :: row, col
1108 : REAL(dp), DIMENSION(:, :), POINTER :: block
1109 : INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
1110 :
1111 : INTEGER :: col_group, row_group
1112 :
1113 : CALL dbt_index_global_to_local(matrix%dist%info, matrix%dist, row=row, column=col, &
1114 17488201 : row_group=row_group, column_group=col_group)
1115 :
1116 : CALL dbm_get_block_p(matrix%matrix, row_group, col_group, block, &
1117 17488201 : row_size=row_size, col_size=col_size)
1118 :
1119 17488201 : END SUBROUTINE
1120 :
1121 : ! **************************************************************************************************
1122 : !> \brief As dbm_filter
1123 : !> \param matrix ...
1124 : !> \param eps ...
1125 : !> \author Patrick Seewald
1126 : ! **************************************************************************************************
1127 300818 : SUBROUTINE dbt_tas_filter(matrix, eps)
1128 : TYPE(dbt_tas_type), INTENT(INOUT) :: matrix
1129 : REAL(dp), INTENT(IN) :: eps
1130 :
1131 300818 : CALL dbm_filter(matrix%matrix, eps)
1132 :
1133 300818 : END SUBROUTINE
1134 :
1135 14839318 : END MODULE
|
