GNU Octave  6.2.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
dmatm3.f
Go to the documentation of this file.
1 c Copyright (C) 2009-2021 The Octave Project Developers
2 c
3 c See the file COPYRIGHT.md in the top-level directory of this
4 c distribution or <https://octave.org/copyright/>.
5 c
6 c This file is part of Octave.
7 c
8 c Octave is free software: you can redistribute it and/or modify it
9 c under the terms of the GNU General Public License as published by
10 c the Free Software Foundation, either version 3 of the License, or
11 c (at your option) any later version.
12 c
13 c Octave is distributed in the hope that it will be useful, but
14 c WITHOUT ANY WARRANTY; without even the implied warranty of
15 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 c GNU General Public License for more details.
17 c
18 c You should have received a copy of the GNU General Public License
19 c along with Octave; see the file COPYING. If not, see
20 c <https://www.gnu.org/licenses/>.
21 c
22  subroutine dmatm3(m,n,k,np,a,b,c)
23 c purpose: a 3-dimensional matrix product.
24 c given a (m,k,np) array a and (k,n,np) array b,
25 c calculates a (m,n,np) array c such that
26 c for i = 1:np
27 c c(:,:,i) = a(:,:,i) * b(:,:,i)
28 c
29 c arguments:
30 c m,n,k (in) the dimensions
31 c np (in) number of multiplications
32 c a (in) a double prec. input array, size (m,k,np)
33 c b (in) a double prec. input array, size (k,n,np)
34 c c (out) a double prec. output array, size (m,n,np)
35  integer m,n,k,np
36  double precision a(m*k,np),b(k*n,np)
37  double precision c(m*n,np)
38 
39  double precision ddot,one,zero
40  parameter(one = 1d0, zero = 0d0)
41  external ddot,dgemv,dgemm
42  integer i
43 
44 c quick return if possible.
45  if (np <= 0) return
46 
47  if (m == 1) then
48  if (n == 1) then
49  do i = 1,np
50  c(1,i) = ddot(k,a(1,i),1,b(1,i),1)
51  end do
52  else
53  do i = 1,np
54  call dgemv("T",k,n,one,b(1,i),k,a(1,i),1,zero,c(1,i),1)
55  end do
56  end if
57  else
58  if (n == 1) then
59  do i = 1,np
60  call dgemv("N",m,k,one,a(1,i),m,b(1,i),1,zero,c(1,i),1)
61  end do
62  else
63  do i = 1,np
64  call dgemm("N","N",m,n,k,
65  + one,a(1,i),m,b(1,i),k,zero,c(1,i),m)
66  end do
67  end if
68  end if
69 
70  end subroutine
subroutine dmatm3(m, n, k, np, a, b, c)
Definition: dmatm3.f:23