From 3145eb5b2ed843cdd0c707486346bcf9fe8c4007 Mon Sep 17 00:00:00 2001 From: Wojtek Kosior Date: Thu, 25 Apr 2019 14:27:07 +0200 Subject: add additional improved implementation --- CMakeLists.txt | 1 + src/bettermath2.F90 | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++++ src/main.F90 | 15 +++++++-- 3 files changed, 105 insertions(+), 3 deletions(-) create mode 100644 src/bettermath2.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index cd3dc18..18d3378 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -69,6 +69,7 @@ set(mull_SRC ${SRC}/naivemath.F90 ${SRC}/bettermath.F90 ${SRC}/dotmath.F90 + ${SRC}/bettermath2.F90 ${SRC}/main.F90 ) diff --git a/src/bettermath2.F90 b/src/bettermath2.F90 new file mode 100644 index 0000000..0baa473 --- /dev/null +++ b/src/bettermath2.F90 @@ -0,0 +1,92 @@ +! Copyright 2019 Wojciech Kosior + +! This is free and unencumbered software released into the public domain. + +! Anyone is free to copy, modify, publish, use, compile, sell, or +! distribute this software, either in source code form or as a compiled +! binary, for any purpose, commercial or non-commercial, and by any +! means. + +! In jurisdictions that recognize copyright laws, the author or authors +! of this software dedicate any and all copyright interest in the +! software to the public domain. We make this dedication for the benefit +! of the public at large and to the detriment of our heirs and +! successors. We intend this dedication to be an overt act of +! relinquishment in perpetuity of all present and future rights to this +! software under copyright law. + +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR +! OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +! ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +! OTHER DEALINGS IN THE SOFTWARE. + +! For more information, please refer to + +MODULE bettmat2 + IMPLICIT none + PRIVATE + + PUBLIC :: bett2mull + PRIVATE :: bett2mull_4, bett2mull_8, bett2mull_16 + + INTERFACE bett2mull + procedure bett2mull_4, bett2mull_8, bett2mull_16 + END INTERFACE bett2mull + +CONTAINS + + FUNCTION bett2mull_4(A, B) result(C) + IMPLICIT none + real(kind=4), intent(in), dimension(1:,1:) :: A, B + real(kind=4), dimension(size(A, 1), size(B, 2)) :: C + integer :: i, j, k + + C = 0 + + DO j = 1, size(B, 2) + DO k = 1, size(A, 2) + + C(:,j) = C(:,j) + A(:,j) * B(k,j) + END DO + END DO + + END FUNCTION bett2mull_4 + + FUNCTION bett2mull_8(A, B) result(C) + IMPLICIT none + real(kind=8), intent(in), dimension(1:,1:) :: A, B + real(kind=8), dimension(size(A, 1), size(B, 2)) :: C + integer :: i, j, k + + C = 0 + + DO j = 1, size(B, 2) + DO k = 1, size(A, 2) + + C(:,j) = C(:,j) + A(:,j) * B(k,j) + END DO + END DO + + END FUNCTION bett2mull_8 + + FUNCTION bett2mull_16(A, B) result(C) + IMPLICIT none + real(kind=16), intent(in), dimension(1:,1:) :: A, B + real(kind=16), dimension(size(A, 1), size(B, 2)) :: C + integer :: i, j, k + + C = 0 + + DO j = 1, size(B, 2) + DO k = 1, size(A, 2) + + C(:,j) = C(:,j) + A(:,j) * B(k,j) + END DO + END DO + + END FUNCTION bett2mull_16 + +END MODULE bettmat2 diff --git a/src/main.F90 b/src/main.F90 index 8b9823c..f28bbb8 100644 --- a/src/main.F90 +++ b/src/main.F90 @@ -2,6 +2,7 @@ PROGRAM mul USE naivmat USE bettmat USE dotmat + USE bettmat2 USE iso_fortran_env, only: error_unit IMPLICIT none @@ -35,6 +36,8 @@ PROGRAM mul multype = 3 ELSE IF (trim(impl_arg) .eq. "mat") THEN multype = 4 + ELSE IF (trim(impl_arg) .eq. "bett2") THEN + multype = 5 ELSE write (error_unit, '(A)') "Unrecognized implementation argument" call print_usage() @@ -108,8 +111,10 @@ CONTAINS res = bettmull(mat1, mat2) CASE (3) res = dotmull(mat1, mat2) - CASE default + CASE (4) res = matmul(mat1, mat2) + CASE default + res = bett2mull(mat1, mat2) END SELECT @@ -143,8 +148,10 @@ CONTAINS res = bettmull(mat1, mat2) CASE (3) res = dotmull(mat1, mat2) - CASE default + CASE (4) res = matmul(mat1, mat2) + CASE default + res = bett2mull(mat1, mat2) END SELECT @@ -178,8 +185,10 @@ CONTAINS res = bettmull(mat1, mat2) CASE (3) res = dotmull(mat1, mat2) - CASE default + CASE (4) res = matmul(mat1, mat2) + CASE default + res = bett2mull(mat1, mat2) END SELECT -- cgit v1.2.3