00001 c Copyright (C) 2009-2012 VZLU Prague, a.s., Czech Republic 00002 c 00003 c Author: Jaroslav Hajek <highegg@gmail.com> 00004 c 00005 c This file is part of Octave. 00006 c 00007 c Octave is free software; you can redistribute it and/or modify 00008 c it under the terms of the GNU General Public License as published by 00009 c the Free Software Foundation; either version 3 of the License, or 00010 c (at your option) any later version. 00011 c 00012 c This program is distributed in the hope that it will be useful, 00013 c but WITHOUT ANY WARRANTY; without even the implied warranty of 00014 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00015 c GNU General Public License for more details. 00016 c 00017 c You should have received a copy of the GNU General Public License 00018 c along with this software; see the file COPYING. If not, see 00019 c <http://www.gnu.org/licenses/>. 00020 c 00021 subroutine zmatm3(m,n,k,np,a,b,c) 00022 c purpose: a 3-dimensional matrix product. 00023 c given a (m,k,np) array a and (k,n,np) array b, 00024 c calculates a (m,n,np) array c such that 00025 c for i = 1:np 00026 c c(:,:,i) = a(:,:,i) * b(:,:,i) 00027 c 00028 c arguments: 00029 c m,n,k (in) the dimensions 00030 c np (in) number of multiplications 00031 c a (in) a double complex input array, size (m,k,np) 00032 c b (in) a double complex input array, size (k,n,np) 00033 c c (out) a double complex output array, size (m,n,np) 00034 integer m,n,k,np 00035 double complex a(m*k,np),b(k*n,np) 00036 double complex c(m*n,np) 00037 00038 double complex zdotu,one,zero 00039 parameter (one = 1d0, zero = 0d0) 00040 external zdotu,zgemv,zgemm 00041 integer i 00042 00043 c quick return if possible. 00044 if (np <= 0) return 00045 00046 if (m == 1) then 00047 if (n == 1) then 00048 do i = 1,np 00049 c(1,i) = zdotu(k,a(1,i),1,b(1,i),1) 00050 end do 00051 else 00052 do i = 1,np 00053 call zgemv("T",k,n,one,b(1,i),k,a(1,i),1,zero,c(1,i),1) 00054 end do 00055 end if 00056 else 00057 if (n == 1) then 00058 do i = 1,np 00059 call zgemv("N",m,k,one,a(1,i),m,b(1,i),1,zero,c(1,i),1) 00060 end do 00061 else 00062 do i = 1,np 00063 call zgemm("N","N",m,n,k, 00064 + one,a(1,i),m,b(1,i),k,zero,c(1,i),m) 00065 end do 00066 end if 00067 end if 00068 00069 end subroutine