Testing DBCSR to CSR conversion with random matrices
Type | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|
type(dbcsr_type) | :: | matrix_a | ||||
type(csr_type) | :: | matrix_b | ||||
integer, | DIMENSION(:), POINTER | :: | col_blk_sizes | |||
integer, | DIMENSION(:), POINTER | :: | row_blk_sizes | |||
integer | :: | nblkrows_total | ||||
integer | :: | nblkcols_total | ||||
integer, | DIMENSION(:), POINTER | :: | col_dist | |||
integer, | DIMENSION(:), POINTER | :: | row_dist | |||
integer | :: | mp_comm | ||||
integer | :: | group | ||||
integer | :: | numnodes | ||||
integer | :: | mynode | ||||
integer | :: | io_unit | ||||
integer, | DIMENSION(2) | :: | npdims | |||
integer, | DIMENSION(2) | :: | myploc | |||
integer | :: | max_blks_total | ||||
integer | :: | max_blk_size | ||||
integer | :: | k | ||||
integer | :: | seedsz | ||||
integer, | ALLOCATABLE, DIMENSION(:) | :: | seed | |||
real | :: | rn | ||||
real, | ALLOCATABLE, DIMENSION(:) | :: | rn_array | |||
real(kind=real_8) | :: | norm | ||||
real(kind=real_8) | :: | norm_eps | ||||
real(kind=real_8) | :: | sparsity | ||||
real(kind=real_8) | :: | eps | ||||
character(len=10) | :: | k_str | ||||
character(len=10) | :: | mynode_str |
Test the conversion by converting to CSR format and converting back, where the CSR sparsity is defined by some filtering threshold eps. The maximum norm of the differences between the original and the back-converted matrix is calculated.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | dbcsr_mat | |||
type(csr_type), | intent(out) | :: | csr_mat | |||
real(kind=real_8), | intent(out) | :: | norm | |||
real(kind=real_8), | intent(in) | :: | eps |
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 |
PROGRAM dbcsr_test_csr_conversions
!! Testing DBCSR to CSR conversion with random matrices
USE dbcsr_kinds, ONLY: dp, real_8
USE dbcsr_api, ONLY: &
dbcsr_convert_csr_to_dbcsr, dbcsr_convert_dbcsr_to_csr, &
dbcsr_csr_create_from_dbcsr, dbcsr_csr_destroy, &
dbcsr_csr_eqrow_ceil_dist, dbcsr_csr_type, dbcsr_add, dbcsr_copy, dbcsr_create, &
dbcsr_distribution_get, dbcsr_distribution_new, dbcsr_distribution_release, &
dbcsr_distribution_type, dbcsr_finalize, dbcsr_finalize_lib, dbcsr_get_stored_coordinates, &
dbcsr_init_lib, dbcsr_nblkcols_total, dbcsr_nblkrows_total, dbcsr_norm, &
dbcsr_norm_maxabsnorm, dbcsr_put_block, dbcsr_release, dbcsr_to_csr_filter, dbcsr_type, &
dbcsr_type_no_symmetry, dbcsr_type_real_8, dbcsr_print_statistics
USE dbcsr_machine, ONLY: default_output_unit
USE dbcsr_mpiwrap, ONLY: mp_bcast, &
mp_cart_create, &
mp_comm_free, &
mp_environ, &
mp_world_finalize, &
mp_world_init
#include "base/dbcsr_base_uses.f90"
IMPLICIT NONE
TYPE(dbcsr_type) :: matrix_a
TYPE(dbcsr_csr_type) :: matrix_b
INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes
INTEGER :: nblkrows_total, nblkcols_total
INTEGER, DIMENSION(:), POINTER :: col_dist, row_dist
INTEGER :: mp_comm, group, numnodes, mynode, io_unit
INTEGER, DIMENSION(2) :: npdims, myploc
INTEGER :: max_blks_total, max_blk_size, k, seedsz
INTEGER, ALLOCATABLE, DIMENSION(:) ::seed
REAL :: rn
REAL, ALLOCATABLE, DIMENSION(:) :: rn_array
REAL(KIND=real_8) :: norm, norm_eps, sparsity, eps
CHARACTER(LEN=10) :: k_str, mynode_str
! Set up everything as in the dbcsr example codes
CALL mp_world_init(mp_comm)
CALL mp_environ(numnodes, mynode, mp_comm)
io_unit = 0
IF (mynode .EQ. 0) io_unit = default_output_unit
CALL dbcsr_init_lib(mp_comm, io_unit)
npdims(:) = 0
CALL mp_cart_create(mp_comm, 2, npdims, myploc, group)
CALL mp_environ(numnodes, mynode, group)
! Set seed for random number generator
CALL RANDOM_SEED(size=seedsz)
ALLOCATE (seed(seedsz))
seed = 434358235
! Maximum number of blocks and maximum block sizes (in 1 dimension)
max_blks_total = 50
max_blk_size = 10
eps = 0.1_dp ! Filter threshold
DO k = 1, 100 ! test 100 matrices
CALL RANDOM_SEED(get=seed)
CALL mp_bcast(seed, 0, mp_comm)
CALL RANDOM_SEED(put=seed)
CALL RANDOM_NUMBER(rn)
nblkrows_total = FLOOR(rn*(max_blks_total)) + 1
CALL RANDOM_NUMBER(rn)
nblkcols_total = FLOOR(rn*(max_blks_total)) + 1
ALLOCATE (rn_array(MAX(nblkcols_total, nblkrows_total)))
ALLOCATE (col_blk_sizes(nblkcols_total))
ALLOCATE (row_blk_sizes(nblkrows_total))
ALLOCATE (row_dist(nblkrows_total))
ALLOCATE (col_dist(nblkcols_total))
CALL RANDOM_NUMBER(rn_array)
col_blk_sizes = FLOOR(rn_array(1:nblkcols_total)*(max_blk_size)) + 1
CALL RANDOM_NUMBER(rn_array)
row_blk_sizes = FLOOR(rn_array(1:nblkrows_total)*(max_blk_size)) + 1
CALL RANDOM_NUMBER(rn)
sparsity = rn
CALL RANDOM_NUMBER(rn_array)
row_dist = FLOOR(rn_array(1:nblkrows_total)*npdims(1))
CALL RANDOM_NUMBER(rn_array)
col_dist = FLOOR(rn_array(1:nblkcols_total)*npdims(2))
CALL make_random_dbcsr_matrix(matrix_a, group, col_blk_sizes, row_blk_sizes, col_dist, row_dist, sparsity)
WRITE (UNIT=k_str, FMT='(I0)') k
WRITE (UNIT=mynode_str, FMT='(I0)') mynode
CALL csr_conversion_test(matrix_a, matrix_b, norm, 0.0_dp)
CALL dbcsr_csr_destroy(matrix_b)
CALL csr_conversion_test(matrix_a, matrix_b, norm_eps, eps)
CALL dbcsr_csr_destroy(matrix_b)
IF ((norm > EPSILON(norm)) .OR. (norm_eps > eps)) THEN
IF (io_unit > 0) WRITE (io_unit, *) "Conversion error > 0 for matrix no.", k_str
DBCSR_ABORT("Error in csr conversion")
ELSE
IF (io_unit > 0) WRITE (io_unit, *) "Conversion OK!"
END IF
CALL dbcsr_release(matrix_a)
DEALLOCATE (rn_array)
END DO
DEALLOCATE (seed)
CALL mp_comm_free(group)
call dbcsr_print_statistics(.true.)
CALL dbcsr_finalize_lib()
CALL mp_world_finalize()
CONTAINS
SUBROUTINE csr_conversion_test(dbcsr_mat, csr_mat, norm, eps)
!! Test the conversion by converting to CSR format and converting back,
!! where the CSR sparsity is defined by some filtering threshold eps.
!! The maximum norm of the differences between the original and the
!! back-converted matrix is calculated.
TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
TYPE(dbcsr_csr_type), INTENT(OUT) :: csr_mat
REAL(KIND=real_8), INTENT(OUT) :: norm
REAL(KIND=real_8), INTENT(IN) :: eps
TYPE(dbcsr_type) :: csr_sparsity, dbcsr_mat_conv
CALL dbcsr_to_csr_filter(dbcsr_mat, csr_sparsity, eps)
CALL dbcsr_csr_create_from_dbcsr(dbcsr_mat, csr_mat, dbcsr_csr_eqrow_ceil_dist, csr_sparsity)
CALL dbcsr_convert_dbcsr_to_csr(dbcsr_mat, csr_mat)
CALL dbcsr_copy(dbcsr_mat_conv, dbcsr_mat)
CALL dbcsr_convert_csr_to_dbcsr(dbcsr_mat_conv, csr_mat)
CALL dbcsr_add(dbcsr_mat_conv, dbcsr_mat, 1.0_dp, -1.0_dp)
CALL dbcsr_norm(dbcsr_mat_conv, dbcsr_norm_maxabsnorm, norm_scalar=norm)
CALL dbcsr_release(dbcsr_mat_conv)
CALL dbcsr_release(csr_sparsity)
END SUBROUTINE csr_conversion_test
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
END PROGRAM dbcsr_test_csr_conversions