| [dasumresult,n,dx,incx]=dasum(n,dx,incx); |
function [dasumresult,n,dx,incx]=dasum(n,dx,incx);
dasumresult=[];
persistent i ix m mp1 ;
;
%***BEGIN PROLOGUE DASUM
%***PURPOSE Compute the sum of the magnitudes of the elements of a
% vector.
%***LIBRARY SLATEC (BLAS)
%***CATEGORY D1A3A
%***TYPE doubleprecision (SASUM-S, DASUM-D, SCASUM-C)
%***KEYWORDS BLAS, LINEAR ALGEBRA, SUM OF MAGNITUDES OF A VECTOR
%***AUTHOR Lawson, C. L., (JPL)
% Hanson, R. J., (SNLA)
% Kincaid, D. R., (U. of Texas)
% Krogh, F. T., (JPL)
%***DESCRIPTION
%
% B L A S Subprogram
% Description of Parameters
%
% --Input--
% N number of elements in input vector(s)
% DX doubleprecision vector with N elements
% INCX storage spacing between elements of DX
%
% --Output--
% DASUM doubleprecision result (zero if N .LE. 0)
%
% Returns sum of magnitudes of doubleprecision DX.
% DASUM = sum from 0 to N-1 of ABS(DX(IX+I*INCX)),
% where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
%
%***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
% Krogh, Basic linear algebra subprograms for Fortran
% usage, Algorithm No. 539, Transactions on Mathematical
% Software 5, 3 (September 1979), pp. 308-323.
%***ROUTINES CALLED (NONE)
%***REVISION HISTORY (YYMMDD)
% 791001 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 890831 Modified array declarations. (WRB)
% 890831 REVISION DATE from Version 3.2
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900821 Modified to correct problem with a negative increment.
% (WRB)
% 920501 Reformatted the REFERENCES section. (WRB)
%***end PROLOGUE DASUM
dx_shape=size(dx);dx=reshape(dx,1,[]);
if isempty(i), i=0; end;
if isempty(ix), ix=0; end;
if isempty(m), m=0; end;
if isempty(mp1), mp1=0; end;
%***FIRST EXECUTABLE STATEMENT DASUM
dasumresult = 0.0d0;
if( n<=0 )
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',n); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',incx); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',dx); evalin('caller',[inputname(2),'=FUntemp;']); end
return;
end;
%
if( incx==1 )
%
% Code for increment equal to 1.
%
% Clean-up loop so remaining vector length is a multiple of 6.
%
m = fix(rem(n,6));
if( m~=0 )
for i = 1 : m;
dasumresult = dasumresult + abs(dx(i));
end; i = fix(m+1);
if( n<6 )
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',n); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',incx); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',dx); evalin('caller',[inputname(2),'=FUntemp;']); end
return;
end;
end;
mp1 = fix(m + 1);
for i = mp1 : 6: n ;
dasumresult = dasumresult + abs(dx(i)) + abs(dx(i+1)) + abs(dx(i+2))+ abs(dx(i+3)) + abs(dx(i+4)) + abs(dx(i+5));
end; i = fix(n +1);
else;
%
% Code for increment not equal to 1.
%
ix = 1;
if( incx<0 )
ix =fix((-n+1).*incx + 1);
end;
for i = 1 : n;
dasumresult = dasumresult + abs(dx(ix));
ix = fix(ix + incx);
end; i = fix(n+1);
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',n); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',incx); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',dx); evalin('caller',[inputname(2),'=FUntemp;']); end
return;
end;
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',n); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',incx); evalin('caller',[inputname(3),'=FUntemp;']); end
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',dx); evalin('caller',[inputname(2),'=FUntemp;']); end
end
%DECK DASYIK
|
|