Create a DBCSR matrix with random values and random blocks
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(out) | :: | matrix_a | |||
integer, | intent(in) | :: | group | |||
integer, | DIMENSION(:), POINTER | :: | col_blk_sizes | |||
integer, | DIMENSION(:), POINTER | :: | row_blk_sizes | |||
integer, | DIMENSION(:), POINTER | :: | col_dist | |||
integer, | DIMENSION(:), POINTER | :: | row_dist | |||
real(kind=real_8), | intent(in) | :: | sparsity |
SUBROUTINE make_random_dbcsr_matrix(matrix_a, group, &
!! Create a DBCSR matrix with random values and random blocks
col_blk_sizes, row_blk_sizes, col_dist, row_dist, sparsity)
TYPE(dbcsr_type), INTENT(OUT) :: matrix_a
INTEGER, INTENT(IN) :: group
INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes, col_dist, &
row_dist
REAL(real_8), INTENT(IN) :: sparsity
INTEGER :: col, col_s, max_col_size, max_nze, &
max_row_size, node_holds_blk, nze, &
row, row_s
LOGICAL :: tr
REAL(real_8) :: rn
REAL(real_8), ALLOCATABLE, DIMENSION(:) :: values
TYPE(dbcsr_distribution_type) :: dist
CALL dbcsr_distribution_new(dist, group=group, row_dist=row_dist, col_dist=col_dist, reuse_arrays=.TRUE.)
CALL dbcsr_create(matrix=matrix_a, &
name="this is my matrix a", &
dist=dist, &
matrix_type=dbcsr_type_no_symmetry, &
row_blk_size=row_blk_sizes, &
col_blk_size=col_blk_sizes, &
data_type=dbcsr_type_real_8)
CALL dbcsr_distribution_get(dist, mynode=mynode)
! get the maximum block size of the matrix
max_row_size = MAXVAL(row_blk_sizes)
max_col_size = MAXVAL(col_blk_sizes)
max_nze = max_row_size*max_col_size
ALLOCATE (values(max_nze))
DO row = 1, dbcsr_nblkrows_total(matrix_a)
DO col = 1, dbcsr_nblkcols_total(matrix_a)
CALL RANDOM_NUMBER(rn)
IF (rn .GT. sparsity) THEN
tr = .FALSE.
row_s = row; col_s = col
CALL dbcsr_get_stored_coordinates(matrix_a, row_s, col_s, node_holds_blk)
IF (node_holds_blk .EQ. mynode) THEN
nze = row_blk_sizes(row_s)*col_blk_sizes(col_s)
CALL RANDOM_NUMBER(values(1:nze))
CALL dbcsr_put_block(matrix_a, row_s, col_s, values(1:nze))
END IF
END IF
END DO
END DO
DEALLOCATE (values)
CALL dbcsr_finalize(matrix_a)
CALL dbcsr_distribution_release(dist)
DEALLOCATE (row_blk_sizes, col_blk_sizes)
END SUBROUTINE make_random_dbcsr_matrix