cdotc3.f

Go to the documentation of this file.
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 cdotc3(m,n,k,a,b,c)
00022 c purpose:      a 3-dimensional dot product.
00023 c               c = sum (conj (a) .* b, 2), where a and b are 3d arrays.
00024 c arguments:
00025 c m,n,k (in)    the dimensions of a and b
00026 c a,b (in)      complex input arrays of size (m,k,n)
00027 c c (out)       complex output array, size (m,n)
00028       integer m,n,k,i,j,l
00029       complex a(m,k,n),b(m,k,n)
00030       complex c(m,n)
00031 
00032       complex cdotc
00033       external cdotc
00034 
00035 c quick return if possible.
00036       if (m <= 0 .or. n <= 0) return
00037 
00038       if (m == 1) then
00039 c the column-major case.
00040         do j = 1,n
00041           c(1,j) = cdotc(k,a(1,1,j),1,b(1,1,j),1)
00042         end do
00043       else
00044 c We prefer performance here, because that's what we generally
00045 c do by default in reduction functions. Besides, the accuracy
00046 c of xDOT is questionable. Hence, do a cache-aligned nested loop.
00047         do j = 1,n
00048           do i = 1,m
00049             c(i,j) = 0e0
00050           end do
00051           do l = 1,k
00052             do i = 1,m
00053               c(i,j) = c(i,j) + conjg(a(i,l,j))*b(i,l,j)
00054             end do
00055           end do
00056         end do
00057       end if
00058 
00059       end subroutine
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Defines