1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
! 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 naivmat
IMPLICIT none
PRIVATE
PUBLIC :: naivmull
PRIVATE :: naivmull_4, naivmull_8, naivmull_16
INTERFACE naivmull
procedure naivmull_4, naivmull_8, naivmull_16
END INTERFACE naivmull
CONTAINS
FUNCTION naivmull_4(A, B) result(C)
IMPLICIT none
real(kind=4), intent(in), dimension(1:,1:) :: A, B
real(kind=4), dimension(:,:), allocatable :: C
integer :: i, j, k
allocate(C(size(A, 1), size(B, 2)))
C = 0
DO i = 1, size(A, 1))
DO j = 1, size(B, 2)
DO k = 1, size(A, 2)
C(i,j) = C(i,j) + A(i,k) * B(k,j)
END DO
END DO
END DO
END FUNCTION naivmull_4
FUNCTION naivmull_8(A, B) result(C)
IMPLICIT none
real(kind=8), intent(in), dimension(1:,1:) :: A, B
real(kind=8), dimension(:,:), allocatable :: C
integer :: i, j, k
allocate(C(size(A, 1), size(B, 2)))
C = 0
DO i = 1, size(A, 1)
DO j = 1, size(B, 2)
DO k = 1, size(A, 2)
C(i,j) = C(i,j) + A(i,k) * B(k,j)
END DO
END DO
END DO
END FUNCTION naivmull_8
FUNCTION naivmull_16(A, B) result(C)
IMPLICIT none
real(kind=16), intent(in), dimension(1:,1:) :: A, B
real(kind=16), dimension(:,:), allocatable :: C
integer :: i, j, k
allocate(C(size(A, 1), size(B, 2)))
C = 0
DO i = 1, size(A, 1)
DO j = 1, size(B, 2)
DO k = 1, size(A, 2)
C(i,j) = C(i,j) + A(i,k) * B(k,j)
END DO
END DO
END DO
END FUNCTION naivmull_16
END MODULE naivmat
|
