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