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