Performs a variety of matrix multiplies of same matrices on different processor grids
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | DIMENSION(:, :) | :: | group_sizes |
array of (sub) communicator sizes to test (2-D) |
||
| type(dbcsr_type), | intent(in) | :: | matrix_a |
matrices to multiply matrices to multiply matrices to multiply |
||
| type(dbcsr_type), | intent(in) | :: | matrix_b |
matrices to multiply matrices to multiply matrices to multiply |
||
| type(dbcsr_type), | intent(in) | :: | matrix_c |
matrices to multiply matrices to multiply matrices to multiply |
||
| character(len=1), | intent(in) | :: | transa | |||
| character(len=1), | intent(in) | :: | transb | |||
| type(dbcsr_scalar_type), | intent(in) | :: | alpha | |||
| type(dbcsr_scalar_type), | intent(in) | :: | beta | |||
| integer, | intent(in), | optional, | DIMENSION(6) | :: | limits | |
| logical, | intent(in), | optional | :: | retain_sparsity | ||
| integer, | intent(in) | :: | n_loops | |||
| real(kind=dp), | intent(in) | :: | eps | |||
| integer, | intent(in) | :: | io_unit |
which unit to write to, if not negative |
||
| logical | :: | always_checksum |
SUBROUTINE test_multiplies_multiproc(group_sizes, & matrix_a, matrix_b, matrix_c, & transa, transb, alpha, beta, limits, retain_sparsity, & n_loops, eps, & io_unit, always_checksum) !! Performs a variety of matrix multiplies of same matrices on different !! processor grids INTEGER, DIMENSION(:, :) :: group_sizes !! array of (sub) communicator sizes to test (2-D) TYPE(dbcsr_type), INTENT(in) :: matrix_a, matrix_b, matrix_c !! matrices to multiply !! matrices to multiply !! matrices to multiply CHARACTER, INTENT(in) :: transa, transb TYPE(dbcsr_scalar_type), INTENT(in) :: alpha, beta INTEGER, DIMENSION(6), INTENT(in), OPTIONAL :: limits LOGICAL, INTENT(in), OPTIONAL :: retain_sparsity INTEGER, INTENT(IN) :: n_loops REAL(kind=dp), INTENT(in) :: eps INTEGER, INTENT(IN) :: io_unit !! which unit to write to, if not negative LOGICAL :: always_checksum CHARACTER(len=*), PARAMETER :: routineN = 'test_multiplies_multiproc' INTEGER :: error_handle, & loop_iter, mynode, numnodes, test INTEGER(kind=int_8) :: flop, flop_sum INTEGER, DIMENSION(2) :: npdims INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_dist_a, col_dist_b, col_dist_c, & row_dist_a, row_dist_b, row_dist_c LOGICAL :: i_am_alive REAL(kind=real_8) :: cs, cs_pos, flops_all, t1, t2 TYPE(dbcsr_distribution_obj) :: dist_a, dist_b, dist_c TYPE(dbcsr_mp_obj) :: mp_env TYPE(dbcsr_type) :: m_a, m_b, m_c, m_c_reserve TYPE(mp_comm_type) :: cart_group, group ! --------------------------------------------------------------------------- CALL timeset(routineN, error_handle) IF (SIZE(group_sizes, 2) /= 2) & DBCSR_ABORT("second dimension of group_sizes must be 2") p_sizes: DO test = 1, SIZE(group_sizes, 1) t2 = 0.0_real_8 flop_sum = 0 npdims(1:2) = group_sizes(test, 1:2) numnodes = npdims(1)*npdims(2) group = dbcsr_mp_group(dbcsr_distribution_mp( & dbcsr_distribution(matrix_c))) IF (numnodes .EQ. 0) THEN CALL dbcsr_mp_make_env(mp_env, cart_group, group, nprocs=MAXVAL(npdims)) ELSE CALL dbcsr_mp_make_env(mp_env, cart_group, group, pgrid_dims=npdims) END IF IF (numnodes < 0) & DBCSR_ABORT("Cartesian sides must be greater or equal to 0") i_am_alive = dbcsr_mp_active(mp_env) alive: IF (i_am_alive) THEN npdims(1) = dbcsr_mp_nprows(mp_env) npdims(2) = dbcsr_mp_npcols(mp_env) group = dbcsr_mp_group(mp_env) CALL mp_environ(numnodes, mynode, group) ! Row & column distributions CALL dbcsr_dist_bin(row_dist_a, & dbcsr_nblkrows_total(matrix_a), npdims(1), & dbcsr_row_block_sizes(matrix_a)) CALL dbcsr_dist_bin(col_dist_a, & dbcsr_nblkcols_total(matrix_a), npdims(2), & dbcsr_col_block_sizes(matrix_a)) CALL dbcsr_dist_bin(row_dist_b, & dbcsr_nblkrows_total(matrix_b), npdims(1), & dbcsr_row_block_sizes(matrix_b)) CALL dbcsr_dist_bin(col_dist_b, & dbcsr_nblkcols_total(matrix_b), npdims(2), & dbcsr_col_block_sizes(matrix_b)) CALL dbcsr_dist_bin(row_dist_c, & dbcsr_nblkrows_total(matrix_c), npdims(1), & dbcsr_row_block_sizes(matrix_c)) CALL dbcsr_dist_bin(col_dist_c, & dbcsr_nblkcols_total(matrix_c), npdims(2), & dbcsr_col_block_sizes(matrix_c)) CALL dbcsr_distribution_new(dist_a, & mp_env, row_dist_a, col_dist_a, reuse_arrays=.TRUE.) CALL dbcsr_distribution_new(dist_b, & mp_env, row_dist_b, col_dist_b, reuse_arrays=.TRUE.) CALL dbcsr_distribution_new(dist_c, & mp_env, row_dist_c, col_dist_c, reuse_arrays=.TRUE.) ! Redistribute the matrices ! A CALL dbcsr_create(m_a, "Test for "//TRIM(dbcsr_name(matrix_a)), & dist_a, dbcsr_type_no_symmetry, & row_blk_size_obj=matrix_a%row_blk_size, & col_blk_size_obj=matrix_a%col_blk_size, & data_type=dbcsr_get_data_type(matrix_a)) CALL dbcsr_distribution_release(dist_a) CALL dbcsr_redistribute(matrix_a, m_a) ! B CALL dbcsr_create(m_b, "Test for "//TRIM(dbcsr_name(matrix_b)), & dist_b, dbcsr_type_no_symmetry, & row_blk_size_obj=matrix_b%row_blk_size, & col_blk_size_obj=matrix_b%col_blk_size, & data_type=dbcsr_get_data_type(matrix_b)) CALL dbcsr_distribution_release(dist_b) CALL dbcsr_redistribute(matrix_b, m_b) ! C CALL dbcsr_create(m_c, "Test for "//TRIM(dbcsr_name(matrix_c)), & dist_c, dbcsr_type_no_symmetry, & row_blk_size_obj=matrix_c%row_blk_size, & col_blk_size_obj=matrix_c%col_blk_size, & data_type=dbcsr_get_data_type(matrix_c)) CALL dbcsr_distribution_release(dist_c) CALL dbcsr_redistribute(matrix_c, m_c) CALL dbcsr_copy(m_c_reserve, m_c) ! Perform multiply loops: DO loop_iter = 1, n_loops CALL dbcsr_release(m_c) CALL dbcsr_copy(m_c, m_c_reserve) CALL mp_sync(group) t1 = -m_walltime() IF (PRESENT(limits)) THEN IF (eps .LE. -0.0_dp) THEN CALL dbcsr_multiply(transa, transb, alpha, & m_a, m_b, beta, m_c, & first_row=limits(1), & last_row=limits(2), & first_column=limits(3), & last_column=limits(4), & first_k=limits(5), & last_k=limits(6), & retain_sparsity=retain_sparsity, flop=flop) ELSE CALL dbcsr_multiply(transa, transb, alpha, & m_a, m_b, beta, m_c, & first_row=limits(1), & last_row=limits(2), & first_column=limits(3), & last_column=limits(4), & first_k=limits(5), & last_k=limits(6), & retain_sparsity=retain_sparsity, flop=flop, & filter_eps=eps) END IF ELSE IF (eps .LE. -0.0_dp) THEN CALL dbcsr_multiply(transa, transb, alpha, & m_a, m_b, beta, m_c, & retain_sparsity=retain_sparsity, flop=flop) ELSE CALL dbcsr_multiply(transa, transb, alpha, & m_a, m_b, beta, m_c, & retain_sparsity=retain_sparsity, flop=flop, & filter_eps=eps) END IF END IF t1 = t1 + m_walltime() t2 = t2 + t1 flop_sum = flop_sum + flop ! CALL mp_max(t1, group) CALL mp_sum(flop, group) t1 = MAX(t1, EPSILON(t1)) flops_all = REAL(flop, KIND=real_8)/t1/numnodes/(1024*1024) IF (io_unit .GT. 0) THEN WRITE (io_unit, '(A,I5,A,I5,A,F12.3,A,I9,A)') & " loop ", loop_iter, " with ", numnodes, " MPI ranks: using ", t1, "s ", INT(flops_all), " Mflops/rank" CALL m_flush(io_unit) END IF IF (loop_iter .EQ. n_loops .OR. always_checksum) THEN cs = dbcsr_checksum(m_c) cs_pos = dbcsr_checksum(m_c, pos=.TRUE.) IF (io_unit > 0) THEN WRITE (io_unit, *) "Final checksums", cs, cs_pos END IF END IF END DO loops ! Release CALL dbcsr_mp_release(mp_env) CALL dbcsr_release(m_a) CALL dbcsr_release(m_b) CALL dbcsr_release(m_c) CALL dbcsr_release(m_c_reserve) END IF alive CALL mp_comm_free(cart_group) END DO p_sizes CALL timestop(error_handle) END SUBROUTINE test_multiplies_multiproc