(git:ed6f26b)
Loading...
Searching...
No Matches
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-2025 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! **************************************************************************************************
12PROGRAM dbt_tas_unittest
13 USE cp_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
169END PROGRAM
dbt_tas_unittest
program dbt_tas_unittest
Unit testing for tall-and-skinny matrices.
Definition dbt_tas_unittest.F:12
dbt_tas_base::dbt_tas_create
Definition dbt_tas_base.F:89
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
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
pure integer(kind=int_8) function, public dbt_tas_nblkrows_total(matrix)
...
Definition dbt_tas_base.F:838
dbt_tas_base::dbt_tas_nblkcols_total
pure integer(kind=int_8) function, public dbt_tas_nblkcols_total(matrix)
...
Definition dbt_tas_base.F:864
dbt_tas_base::dbt_tas_info
type(dbt_tas_split_info) function, pointer, public dbt_tas_info(matrix)
get info on mpi grid splitting
Definition dbt_tas_base.F:825
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:53
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
dbt_tas_types::dbt_tas_type
Definition dbt_tas_types.F:102
message_passing::mp_cart_type
Definition message_passing.F:740
message_passing::mp_comm_type
Definition message_passing.F:189