1!--------------------------------------------------------------------------------------------------!
2! Copyright (C) by the DBCSR developers group - All rights reserved                                !
3! This file is part of the DBCSR library.                                                          !
4!                                                                                                  !
5! For information on the license, see the LICENSE file.                                            !
6! For further information please visit https://dbcsr.cp2k.org                                      !
7! SPDX-License-Identifier: GPL-2.0+                                                                !
8!--------------------------------------------------------------------------------------------------!
9
10PROGRAM dbcsr_unittest
11   !! Tests for DBCSR operations
12
13   USE dbcsr_kinds, ONLY: dp
14   USE dbcsr_lib, ONLY: dbcsr_finalize_lib, &
15                        dbcsr_init_lib, &
16                        dbcsr_print_statistics
17   USE dbcsr_machine, ONLY: default_output_unit
18   USE dbcsr_mp_methods, ONLY: dbcsr_mp_new, &
19                               dbcsr_mp_release
20   USE dbcsr_mpiwrap, ONLY: mp_cart_create, &
21                            mp_cart_rank, &
22                            mp_comm_free, &
23                            mp_environ, &
24                            mp_world_finalize, &
25                            mp_world_init
26   USE dbcsr_test_methods, ONLY: dbcsr_reset_randmat_seed
27   USE dbcsr_test_multiply, ONLY: dbcsr_test_multiplies
28   USE dbcsr_types, ONLY: dbcsr_mp_obj
29#include "base/dbcsr_base_uses.f90"
30
31   IMPLICIT NONE
32
33   INTEGER                                  :: mp_comm, group, numnodes, mynode, &
34                                               prow, pcol, io_unit, handle
35   INTEGER, DIMENSION(2)                    :: npdims, myploc
36   INTEGER, DIMENSION(:, :), POINTER         :: pgrid
37   TYPE(dbcsr_mp_obj)                       :: mp_env
38
39   CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_unittest'
40
41   !***************************************************************************************
42
43   !
44   ! initialize mpi
45   CALL mp_world_init(mp_comm)
46
47   ! setup the mp environment
48   npdims(:) = 0
49   CALL mp_cart_create(mp_comm, 2, npdims, myploc, group)
50   CALL mp_environ(numnodes, mynode, group)
51   ALLOCATE (pgrid(0:npdims(1) - 1, 0:npdims(2) - 1))
52   DO prow = 0, npdims(1) - 1
53      DO pcol = 0, npdims(2) - 1
54         CALL mp_cart_rank(group, (/prow, pcol/), pgrid(prow, pcol))
55      ENDDO
56   ENDDO
57   CALL dbcsr_mp_new(mp_env, group, pgrid, mynode, numnodes, &
58                     myprow=myploc(1), mypcol=myploc(2))
59   DEALLOCATE (pgrid)
60   !
61   ! set standard output parameters
62   io_unit = 0
63   IF (mynode .EQ. 0) io_unit = default_output_unit
64
65   !
66   ! initialize libdbcsr
67   CALL dbcsr_init_lib(mp_comm, io_unit)
68
69   !
70   ! initialize libdbcsr errors
71   CALL timeset(routineN, handle)
72
73   CALL dbcsr_reset_randmat_seed()
74
75   ! run tests
76
77   ! multiply ------------------------------------------------------------------
78
79   ! Large Blocks
80   CALL dbcsr_test_multiplies("large_blocks_1", &
81                              group, mp_env, npdims, io_unit, matrix_sizes=(/500, 500, 500/), &
82                              sparsities=(/0.5_dp, 0.5_dp, 0.5_dp/), retain_sparsity=.FALSE., &
83                              alpha=CMPLX(1.0_dp, 0.0_dp, dp), beta=CMPLX(0.0_dp, 0.0_dp, dp), &
84                              bs_m=(/1, 100/), bs_n=(/1, 100/), bs_k=(/1, 100/), &
85                              limits=(/1, 500, 1, 500, 1, 500/))
86
87   CALL dbcsr_test_multiplies("large_blocks_2", &
88                              group, mp_env, npdims, io_unit, matrix_sizes=(/500, 50, 50/), &
89                              sparsities=(/0.5_dp, 0.5_dp, 0.5_dp/), retain_sparsity=.FALSE., &
90                              alpha=CMPLX(1.0_dp, 0.0_dp, dp), beta=CMPLX(0.0_dp, 0.0_dp, dp), &
91                              bs_m=(/1, 100/), bs_n=(/1, 10/), bs_k=(/1, 10/), &
92                              limits=(/1, 500, 1, 50, 1, 50/))
93
94   ! Rectangular matrices
95   CALL dbcsr_test_multiplies("rectangular_matrix_M", &
96                              group, mp_env, npdims, io_unit, matrix_sizes=(/500, 50, 50/), &
97                              sparsities=(/0.5_dp, 0.5_dp, 0.5_dp/), retain_sparsity=.FALSE., &
98                              alpha=CMPLX(1.0_dp, 0.0_dp, dp), beta=CMPLX(0.0_dp, 0.0_dp, dp), &
99                              bs_m=(/1, 5/), bs_n=(/1, 5/), bs_k=(/1, 5/), &
100                              limits=(/1, 500, 1, 50, 1, 50/))
101
102   CALL dbcsr_test_multiplies("rectangular_matrix_K", &
103                              group, mp_env, npdims, io_unit, matrix_sizes=(/50, 50, 500/), &
104                              sparsities=(/0.5_dp, 0.5_dp, 0.5_dp/), retain_sparsity=.FALSE., &
105                              alpha=CMPLX(1.0_dp, 0.0_dp, dp), beta=CMPLX(0.0_dp, 0.0_dp, dp), &
106                              bs_m=(/1, 5/), bs_n=(/1, 5/), bs_k=(/1, 5/), &
107                              limits=(/1, 50, 1, 50, 1, 500/))
108
109   ! end of test cases ---------------------------------------------------------
110
111   !
112   ! finalize libdbcsr errors
113   CALL timestop(handle)
114
115   !
116   ! clean mp environment
117   CALL dbcsr_mp_release(mp_env)
118
119   !
120   ! finalize mpi
121   CALL mp_comm_free(group)
122
123   call dbcsr_print_statistics(.true.)
124   ! finalize libdbcsr
125   CALL dbcsr_finalize_lib()
126
127   CALL mp_world_finalize()
128
129END PROGRAM dbcsr_unittest
130