(git:ccc2433)
dbt_tas_unittest.F
Go to the documentation of this file.
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 Unit testing for tall-and-skinny matrices
10 !> \author Patrick Seewald
11 ! **************************************************************************************************
12 PROGRAM dbt_tas_unittest
13  USE dbcsr_api, ONLY: dbcsr_finalize_lib,&
14  dbcsr_init_lib
15  USE dbm_api, ONLY: dbm_get_name,&
16  dbm_library_finalize,&
17  dbm_library_init,&
18  dbm_library_print_stats
19  USE dbt_tas_base, ONLY: dbt_tas_create,&
20  dbt_tas_destroy,&
21  dbt_tas_info,&
22  dbt_tas_nblkcols_total,&
23  dbt_tas_nblkrows_total
24  USE dbt_tas_io, ONLY: dbt_tas_write_split_info
25  USE dbt_tas_test, ONLY: dbt_tas_random_bsizes,&
26  dbt_tas_reset_randmat_seed,&
27  dbt_tas_setup_test_matrix,&
28  dbt_tas_test_mm
29  USE dbt_tas_types, ONLY: dbt_tas_type
30  USE kinds, ONLY: dp,&
31  int_8
32  USE machine, ONLY: default_output_unit
33  USE message_passing, ONLY: mp_cart_type,&
34  mp_comm_type,&
35  mp_world_finalize,&
36  mp_world_init
37  USE offload_api, ONLY: offload_get_device_count,&
38  offload_set_chosen_device
39 #include "../../base/base_uses.f90"
40 
41  IMPLICIT NONE
42 
43  INTEGER(KIND=int_8), PARAMETER :: m = 100, k = 20, n = 10
44  TYPE(dbt_tas_type) :: a, b, c, at, bt, ct, a_out, b_out, c_out, at_out, bt_out, ct_out
45  INTEGER, DIMENSION(m) :: bsize_m
46  INTEGER, DIMENSION(n) :: bsize_n
47  INTEGER, DIMENSION(k) :: bsize_k
48  REAL(kind=dp), PARAMETER :: sparsity = 0.1
49  INTEGER :: mynode, io_unit
50  TYPE(mp_comm_type) :: mp_comm
51  TYPE(mp_cart_type) :: mp_comm_a, mp_comm_at, mp_comm_b, mp_comm_bt, mp_comm_c, mp_comm_ct
52  REAL(kind=dp), PARAMETER :: filter_eps = 1.0e-08
53 
54  CALL mp_world_init(mp_comm)
55 
56  mynode = mp_comm%mepos
57 
58  ! Select active offload device when available.
59  IF (offload_get_device_count() > 0) THEN
60  CALL offload_set_chosen_device(mod(mynode, offload_get_device_count()))
61  END IF
62 
63  io_unit = -1
64  IF (mynode .EQ. 0) io_unit = default_output_unit
65 
66  CALL dbcsr_init_lib(mp_comm%get_handle(), io_unit) ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
67  CALL dbm_library_init()
68 
69  CALL dbt_tas_reset_randmat_seed()
70 
71  CALL dbt_tas_random_bsizes([13, 8, 5, 25, 12], 2, bsize_m)
72  CALL dbt_tas_random_bsizes([3, 78, 33, 12, 3, 15], 1, bsize_n)
73  CALL dbt_tas_random_bsizes([9, 64, 23, 2], 3, bsize_k)
74 
75  CALL dbt_tas_setup_test_matrix(a, mp_comm_a, mp_comm, m, k, bsize_m, bsize_k, [5, 1], "A", sparsity)
76  CALL dbt_tas_setup_test_matrix(at, mp_comm_at, mp_comm, k, m, bsize_k, bsize_m, [3, 8], "A^t", sparsity)
77  CALL dbt_tas_setup_test_matrix(b, mp_comm_b, mp_comm, n, m, bsize_n, bsize_m, [3, 2], "B", sparsity)
78  CALL dbt_tas_setup_test_matrix(bt, mp_comm_bt, mp_comm, m, n, bsize_m, bsize_n, [1, 3], "B^t", sparsity)
79  CALL dbt_tas_setup_test_matrix(c, mp_comm_c, mp_comm, k, n, bsize_k, bsize_n, [5, 7], "C", sparsity)
80  CALL dbt_tas_setup_test_matrix(ct, mp_comm_ct, mp_comm, n, k, bsize_n, bsize_k, [1, 1], "C^t", sparsity)
81 
82  CALL dbt_tas_create(a, a_out)
83  CALL dbt_tas_create(at, at_out)
84  CALL dbt_tas_create(b, b_out)
85  CALL dbt_tas_create(bt, bt_out)
86  CALL dbt_tas_create(c, c_out)
87  CALL dbt_tas_create(ct, ct_out)
88 
89  IF (mynode == 0) WRITE (io_unit, '(A)') "DBM TALL-AND-SKINNY MATRICES"
90  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
91  trim(dbm_get_name(a%matrix)), &
92  dbt_tas_nblkrows_total(a), 'X', dbt_tas_nblkcols_total(a)
93  CALL dbt_tas_write_split_info(dbt_tas_info(a), io_unit, name="A")
94  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
95  trim(dbm_get_name(at%matrix)), &
96  dbt_tas_nblkrows_total(at), 'X', dbt_tas_nblkcols_total(at)
97  CALL dbt_tas_write_split_info(dbt_tas_info(at), io_unit, name="At")
98  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
99  trim(dbm_get_name(b%matrix)), &
100  dbt_tas_nblkrows_total(b), 'X', dbt_tas_nblkcols_total(b)
101  CALL dbt_tas_write_split_info(dbt_tas_info(b), io_unit, name="B")
102  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
103  trim(dbm_get_name(bt%matrix)), &
104  dbt_tas_nblkrows_total(bt), 'X', dbt_tas_nblkcols_total(bt)
105  CALL dbt_tas_write_split_info(dbt_tas_info(bt), io_unit, name="Bt")
106  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
107  trim(dbm_get_name(c%matrix)), &
108  dbt_tas_nblkrows_total(c), 'X', dbt_tas_nblkcols_total(c)
109  CALL dbt_tas_write_split_info(dbt_tas_info(c), io_unit, name="C")
110  IF (mynode == 0) WRITE (io_unit, '(1X, A, 1X, A, I10, 1X, A, 1X, I10)') "Split info for matrix", &
111  trim(dbm_get_name(ct%matrix)), &
112  dbt_tas_nblkrows_total(ct), 'X', dbt_tas_nblkcols_total(ct)
113  CALL dbt_tas_write_split_info(dbt_tas_info(ct), io_unit, name="Ct")
114 
115  CALL dbt_tas_test_mm(.false., .false., .false., b, a, ct_out, unit_nr=io_unit, filter_eps=filter_eps)
116  CALL dbt_tas_test_mm(.true., .false., .false., bt, a, ct_out, unit_nr=io_unit, filter_eps=filter_eps)
117  CALL dbt_tas_test_mm(.false., .true., .false., b, at, ct_out, unit_nr=io_unit, filter_eps=filter_eps)
118  CALL dbt_tas_test_mm(.true., .true., .false., bt, at, ct_out, unit_nr=io_unit, filter_eps=filter_eps)
119  CALL dbt_tas_test_mm(.false., .false., .true., b, a, c_out, unit_nr=io_unit, filter_eps=filter_eps)
120  CALL dbt_tas_test_mm(.true., .false., .true., bt, a, c_out, unit_nr=io_unit, filter_eps=filter_eps)
121  CALL dbt_tas_test_mm(.false., .true., .true., b, at, c_out, unit_nr=io_unit, filter_eps=filter_eps)
122  CALL dbt_tas_test_mm(.true., .true., .true., bt, at, c_out, unit_nr=io_unit, filter_eps=filter_eps)
123 
124  CALL dbt_tas_test_mm(.false., .false., .false., a, c, bt_out, unit_nr=io_unit, filter_eps=filter_eps)
125  CALL dbt_tas_test_mm(.true., .false., .false., at, c, bt_out, unit_nr=io_unit, filter_eps=filter_eps)
126  CALL dbt_tas_test_mm(.false., .true., .false., a, ct, bt_out, unit_nr=io_unit, filter_eps=filter_eps)
127  CALL dbt_tas_test_mm(.true., .true., .false., at, ct, bt_out, unit_nr=io_unit, filter_eps=filter_eps)
128 
129  CALL dbt_tas_test_mm(.false., .false., .true., a, c, b_out, unit_nr=io_unit, filter_eps=filter_eps)
130  CALL dbt_tas_test_mm(.true., .false., .true., at, c, b_out, unit_nr=io_unit, filter_eps=filter_eps)
131  CALL dbt_tas_test_mm(.false., .true., .true., a, ct, b_out, unit_nr=io_unit, filter_eps=filter_eps)
132  CALL dbt_tas_test_mm(.true., .true., .true., at, ct, b_out, unit_nr=io_unit, filter_eps=filter_eps)
133 
134  CALL dbt_tas_test_mm(.false., .false., .false., c, b, at_out, unit_nr=io_unit, filter_eps=filter_eps)
135  CALL dbt_tas_test_mm(.true., .false., .false., ct, b, at_out, unit_nr=io_unit, filter_eps=filter_eps)
136  CALL dbt_tas_test_mm(.false., .true., .false., c, bt, at_out, unit_nr=io_unit, filter_eps=filter_eps)
137  CALL dbt_tas_test_mm(.true., .true., .false., ct, bt, at_out, unit_nr=io_unit, filter_eps=filter_eps)
138 
139  CALL dbt_tas_test_mm(.false., .false., .true., c, b, a_out, unit_nr=io_unit, filter_eps=filter_eps)
140  CALL dbt_tas_test_mm(.true., .false., .true., ct, b, a_out, unit_nr=io_unit, filter_eps=filter_eps)
141  CALL dbt_tas_test_mm(.false., .true., .true., c, bt, a_out, unit_nr=io_unit, filter_eps=filter_eps)
142  CALL dbt_tas_test_mm(.true., .true., .true., ct, bt, a_out, unit_nr=io_unit, filter_eps=filter_eps)
143 
144  CALL dbt_tas_destroy(a)
145  CALL dbt_tas_destroy(at)
146  CALL dbt_tas_destroy(b)
147  CALL dbt_tas_destroy(bt)
148  CALL dbt_tas_destroy(c)
149  CALL dbt_tas_destroy(ct)
150  CALL dbt_tas_destroy(a_out)
151  CALL dbt_tas_destroy(at_out)
152  CALL dbt_tas_destroy(b_out)
153  CALL dbt_tas_destroy(bt_out)
154  CALL dbt_tas_destroy(c_out)
155  CALL dbt_tas_destroy(ct_out)
156 
157  CALL mp_comm_a%free()
158  CALL mp_comm_at%free()
159  CALL mp_comm_b%free()
160  CALL mp_comm_bt%free()
161  CALL mp_comm_c%free()
162  CALL mp_comm_ct%free()
163 
164  CALL dbm_library_print_stats(mp_comm, io_unit)
165  CALL dbm_library_finalize()
166  CALL dbcsr_finalize_lib() ! Needed for DBM_VALIDATE_AGAINST_DBCSR.
167  CALL mp_world_finalize()
168 
169 END PROGRAM
dbt_tas_unittest
program dbt_tas_unittest
Unit testing for tall-and-skinny matrices.
Definition: dbt_tas_unittest.F:12
dbm_api
Definition: dbm_api.F:8
dbm_api::dbm_library_init
subroutine, public dbm_library_init()
Initialize DBM library.
Definition: dbm_api.F:1483
dbm_api::dbm_library_finalize
subroutine, public dbm_library_finalize()
Finalize DBM library.
Definition: dbm_api.F:1497
dbm_api::dbm_get_name
character(len=default_string_length) function, public dbm_get_name(matrix)
Returns the name of the matrix of the given matrix.
Definition: dbm_api.F:1023
dbm_api::dbm_library_print_stats
subroutine, public dbm_library_print_stats(mpi_comm, output_unit)
Print DBM library statistics.
Definition: dbm_api.F:1513
dbt_tas_base
Tall-and-skinny matrices: base routines similar to DBM API, mostly wrappers around existing DBM routi...
Definition: dbt_tas_base.F:13
dbt_tas_base::dbt_tas_nblkrows_total
integer(kind=int_8) function, public dbt_tas_nblkrows_total(matrix)
...
Definition: dbt_tas_base.F:835
dbt_tas_base::dbt_tas_info
type(dbt_tas_split_info) function, public dbt_tas_info(matrix)
get info on mpi grid splitting
Definition: dbt_tas_base.F:822
dbt_tas_base::dbt_tas_nblkcols_total
integer(kind=int_8) function, public dbt_tas_nblkcols_total(matrix)
...
Definition: dbt_tas_base.F:861
dbt_tas_base::dbt_tas_destroy
subroutine, public dbt_tas_destroy(matrix)
...
Definition: dbt_tas_base.F:233
dbt_tas_io
tall-and-skinny matrices: Input / Output
Definition: dbt_tas_io.F:12
dbt_tas_io::dbt_tas_write_split_info
subroutine, public dbt_tas_write_split_info(info, unit_nr, name)
Print info on how matrix is split.
Definition: dbt_tas_io.F:214
dbt_tas_test
testing infrastructure for tall-and-skinny matrices
Definition: dbt_tas_test.F:12
dbt_tas_test::dbt_tas_test_mm
subroutine, public dbt_tas_test_mm(transa, transb, transc, matrix_a, matrix_b, matrix_c, filter_eps, unit_nr, log_verbose)
Test tall-and-skinny matrix multiplication for accuracy.
Definition: dbt_tas_test.F:320
dbt_tas_test::dbt_tas_reset_randmat_seed
subroutine, public dbt_tas_reset_randmat_seed()
Reset the seed used for generating random matrices to default value.
Definition: dbt_tas_test.F:510
dbt_tas_test::dbt_tas_setup_test_matrix
subroutine, public dbt_tas_setup_test_matrix(matrix, mp_comm_out, mp_comm, nrows, ncols, rbsizes, cbsizes, dist_splitsize, name, sparsity, reuse_comm)
Setup tall-and-skinny matrix for testing.
Definition: dbt_tas_test.F:70
dbt_tas_test::dbt_tas_random_bsizes
subroutine, public dbt_tas_random_bsizes(sizes, repeat, dbt_sizes)
Create random block sizes.
Definition: dbt_tas_test.F:493
dbt_tas_types
DBT tall-and-skinny base types. Mostly wrappers around existing DBM routines.
Definition: dbt_tas_types.F:13
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition: kinds.F:54
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
machine
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
machine::default_output_unit
integer, parameter, public default_output_unit
Definition: machine.F:45
message_passing
Interface to the message passing library MPI.
Definition: message_passing.F:23
message_passing::mp_world_init
subroutine, public mp_world_init(mp_comm)
initializes the system default communicator
Definition: message_passing.F:1274
message_passing::mp_world_finalize
subroutine, public mp_world_finalize()
finalizes the system default communicator
Definition: message_passing.F:1386
offload_api
Fortran API for the offload package, which is written in C.
Definition: offload_api.F:12
offload_api::offload_set_chosen_device
subroutine, public offload_set_chosen_device(device_id)
Selects the chosen device to be used.
Definition: offload_api.F:132
offload_api::offload_get_device_count
integer function, public offload_get_device_count()
Returns the number of available devices.
Definition: offload_api.F:112