Mercurial > octave-nkf
annotate libcruft/blas-xtra/zmatm3.f @ 14138:72c96de7a403 stable
maint: update copyright notices for 2012
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Mon, 02 Jan 2012 14:25:41 -0500 |
parents | e81ddf9cacd5 |
children |
rev | line source |
---|---|
14138
72c96de7a403
maint: update copyright notices for 2012
John W. Eaton <jwe@octave.org>
parents:
13141
diff
changeset
|
1 c Copyright (C) 2009-2012 VZLU Prague, a.s., Czech Republic |
9874
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
2 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
3 c Author: Jaroslav Hajek <highegg@gmail.com> |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
4 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
5 c This file is part of Octave. |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
6 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
7 c Octave is free software; you can redistribute it and/or modify |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
8 c it under the terms of the GNU General Public License as published by |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
9 c the Free Software Foundation; either version 3 of the License, or |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
10 c (at your option) any later version. |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
11 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
12 c This program is distributed in the hope that it will be useful, |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
13 c but WITHOUT ANY WARRANTY; without even the implied warranty of |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
14 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
15 c GNU General Public License for more details. |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
16 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
17 c You should have received a copy of the GNU General Public License |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
18 c along with this software; see the file COPYING. If not, see |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
19 c <http://www.gnu.org/licenses/>. |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
20 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
21 subroutine zmatm3(m,n,k,np,a,b,c) |
13141
e81ddf9cacd5
maint: untabify and remove trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
22 c purpose: a 3-dimensional matrix product. |
9874
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
23 c given a (m,k,np) array a and (k,n,np) array b, |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
24 c calculates a (m,n,np) array c such that |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
25 c for i = 1:np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
26 c c(:,:,i) = a(:,:,i) * b(:,:,i) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
27 c |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
28 c arguments: |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
29 c m,n,k (in) the dimensions |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
30 c np (in) number of multiplications |
13141
e81ddf9cacd5
maint: untabify and remove trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
31 c a (in) a double complex input array, size (m,k,np) |
e81ddf9cacd5
maint: untabify and remove trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
32 c b (in) a double complex input array, size (k,n,np) |
9874
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
33 c c (out) a double complex output array, size (m,n,np) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
34 integer m,n,k,np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
35 double complex a(m*k,np),b(k*n,np) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
36 double complex c(m*n,np) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
37 |
10508 | 38 double complex zdotu,one,zero |
9874
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
39 parameter (one = 1d0, zero = 0d0) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
40 external zdotu,zgemv,zgemm |
10508 | 41 integer i |
9874
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
42 |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
43 c quick return if possible. |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
44 if (np <= 0) return |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
45 |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
46 if (m == 1) then |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
47 if (n == 1) then |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
48 do i = 1,np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
49 c(1,i) = zdotu(k,a(1,i),1,b(1,i),1) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
50 end do |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
51 else |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
52 do i = 1,np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
53 call zgemv("T",k,n,one,b(1,i),k,a(1,i),1,zero,c(1,i),1) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
54 end do |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
55 end if |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
56 else |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
57 if (n == 1) then |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
58 do i = 1,np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
59 call zgemv("N",m,k,one,a(1,i),m,b(1,i),1,zero,c(1,i),1) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
60 end do |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
61 else |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
62 do i = 1,np |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
63 call zgemm("N","N",m,n,k, |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
64 + one,a(1,i),m,b(1,i),k,zero,c(1,i),m) |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
65 end do |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
66 end if |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
67 end if |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
68 |
90bc0cc4518f
implement compiled dot and blkmm
Jaroslav Hajek <highegg@gmail.com>
parents:
diff
changeset
|
69 end subroutine |