diff options
Diffstat (limited to 'src/bettermath2.F90')
-rw-r--r-- | src/bettermath2.F90 | 92 |
1 files changed, 92 insertions, 0 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 |