| [n,dx,incx,dy,incy,dparam]=drotm(n,dx,incx,dy,incy,dparam); |
function [n,dx,incx,dy,incy,dparam]=drotm(n,dx,incx,dy,incy,dparam);
persistent dflag dh11 dh12 dh21 dh22 firstCall i kx ky nsteps two w z zero ; if isempty(firstCall),firstCall=1;end;
if isempty(i), i=0; end;
if isempty(kx), kx=0; end;
if isempty(ky), ky=0; end;
if isempty(nsteps), nsteps=0; end;
%***BEGIN PROLOGUE DROTM
%***PURPOSE Apply a modified Givens transformation.
%***LIBRARY SLATEC (BLAS)
%***CATEGORY D1A8
%***TYPE doubleprecision (SROTM-S, DROTM-D)
%***KEYWORDS BLAS, LINEAR ALGEBRA, MODIFIED GIVENS ROTATION, 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
% DY doubleprecision vector with N elements
% INCY storage spacing between elements of DY
% DPARAM 5-element D.P. vector. DPARAM(1) is DFLAG described below.
% Locations 2-5 of SPARAM contain elements of the
% transformation matrix H described below.
%
% --Output--
% DX rotated vector (unchanged if N .LE. 0)
% DY rotated vector (unchanged if N .LE. 0)
%
% Apply the modified Givens transformation, H, to the 2 by N matrix
% (DX**T)
% (DY**T) , where **T indicates transpose. The elements of DX are
% in DX(LX+I*INCX), I = 0 to N-1, where LX = 1 if INCX .GE. 0, else
% LX = 1+(1-N)*INCX, and similarly for DY using LY and INCY.
%
% With DPARAM(1)=DFLAG, H has one of the following forms:
%
% DFLAG=-1.0D0 DFLAG=0.0D0 DFLAG=1.0D0 DFLAG=-2.0D0
%
% (DH11 DH12) (1.0D0 DH12) (DH11 1.0D0) (1.0D0 0.0D0)
% H=( ) ( ) ( ) ( )
% (DH21 DH22), (DH21 1.0D0), (-1.0D0 DH22), (0.0D0 1.0D0).
%
% See DROTMG for a description of data storage in DPARAM.
%
%***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
% 861211 REVISION DATE from Version 3.2
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 920310 Corrected definition of LX in DESCRIPTION. (WRB)
% 920501 Reformatted the REFERENCES section. (WRB)
%***end PROLOGUE DROTM
if isempty(dflag), dflag=0; end;
if isempty(dh12), dh12=0; end;
if isempty(dh22), dh22=0; end;
if isempty(two), two=0; end;
if isempty(z), z=0; end;
if isempty(dh11), dh11=0; end;
if isempty(dh21), dh21=0; end;
if isempty(w), w=0; end;
if isempty(zero), zero=0; end;
dx_shape=size(dx);dx=reshape(dx,1,[]);
dy_shape=size(dy);dy=reshape(dy,1,[]);
if firstCall, zero =[0.0d0]; end;
if firstCall, two=[2.0d0]; end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT DROTM
dflag = dparam(1);
if( n>0 &&(dflag+two~=zero) )
if( incx~=incy || incx<=0 )
kx = 1;
ky = 1;
if( incx<0 )
kx = fix(1 +(1-n).*incx);
end;
if( incy<0 )
ky = fix(1 +(1-n).*incy);
end;
%
if( dflag<0 )
dh11 = dparam(2);
dh12 = dparam(4);
dh21 = dparam(3);
dh22 = dparam(5);
for i = 1 : n;
w = dx(kx);
z = dy(ky);
dx(kx) = w.*dh11 + z.*dh12;
dy(ky) = w.*dh21 + z.*dh22;
kx = fix(kx + incx);
ky = fix(ky + incy);
end; i = fix(n+1);
elseif( dflag==0 ) ;
dh12 = dparam(4);
dh21 = dparam(3);
for i = 1 : n;
w = dx(kx);
z = dy(ky);
dx(kx) = w + z.*dh12;
dy(ky) = w.*dh21 + z;
kx = fix(kx + incx);
ky = fix(ky + incy);
end; i = fix(n+1);
else;
dh11 = dparam(2);
dh22 = dparam(5);
for i = 1 : n;
w = dx(kx);
z = dy(ky);
dx(kx) = w.*dh11 + z;
dy(ky) = -w + dh22.*z;
kx = fix(kx + incx);
ky = fix(ky + incy);
end; i = fix(n+1);
end;
else;
%
nsteps = fix(n.*incx);
if( dflag<0 )
dh11 = dparam(2);
dh12 = dparam(4);
dh21 = dparam(3);
dh22 = dparam(5);
for i = 1 : incx: nsteps ;
w = dx(i);
z = dy(i);
dx(i) = w.*dh11 + z.*dh12;
dy(i) = w.*dh21 + z.*dh22;
end; i = fix(nsteps +1);
elseif( dflag==0 ) ;
dh12 = dparam(4);
dh21 = dparam(3);
for i = 1 : incx: nsteps ;
w = dx(i);
z = dy(i);
dx(i) = w + z.*dh12;
dy(i) = w.*dh21 + z;
end; i = fix(nsteps +1);
else;
dh11 = dparam(2);
dh22 = dparam(5);
for i = 1 : incx: nsteps ;
w = dx(i);
z = dy(i);
dx(i) = w.*dh11 + z;
dy(i) = -w + dh22.*z;
end; i = fix(nsteps +1);
end;
end;
end;
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
dy_shape=zeros(dy_shape);dy_shape(:)=dy(1:numel(dy_shape));dy=dy_shape;
end
%DECK DROTMG
|
|