aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorWojtek Kosior <kwojtus@protonmail.com>2019-04-25 14:27:07 +0200
committerWojtek Kosior <kwojtus@protonmail.com>2019-04-25 14:27:07 +0200
commit3145eb5b2ed843cdd0c707486346bcf9fe8c4007 (patch)
tree0960428287c8679d2bdcba236b8a53a25cee3318 /src
parent5b4f6ba34919f74e0793b1e0e2f611844b52df57 (diff)
downloadfortran-assignment1-3145eb5b2ed843cdd0c707486346bcf9fe8c4007.tar.gz
fortran-assignment1-3145eb5b2ed843cdd0c707486346bcf9fe8c4007.zip
add additional improved implementation
Diffstat (limited to 'src')
-rw-r--r--src/bettermath2.F9092
-rw-r--r--src/main.F9015
2 files changed, 104 insertions, 3 deletions
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 <http://unlicense.org/>
+
+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