| [i,xval,iplace,sx,ix,ircx]=pnnzrs(i,xval,iplace,sx,ix,ircx); |
function [i,xval,iplace,sx,ix,ircx]=pnnzrs(i,xval,iplace,sx,ix,ircx);
persistent firstCall i1 idiff iend ii il ilast iopt ipl ipploc istart j l ll lmx lpg n20046 nerr np zero ; if isempty(firstCall),firstCall=1;end;
if isempty(i1), i1=0; end;
if isempty(idiff), idiff=0; end;
if isempty(iend), iend=0; end;
if isempty(ii), ii=0; end;
if isempty(il), il=0; end;
if isempty(ilast), ilast=0; end;
if isempty(iopt), iopt=0; end;
if isempty(ipl), ipl=0; end;
if isempty(ipploc), ipploc=0; end;
if isempty(istart), istart=0; end;
if isempty(j), j=0; end;
if isempty(l), l=0; end;
if isempty(ll), ll=0; end;
if isempty(lmx), lmx=0; end;
if isempty(lpg), lpg=0; end;
if isempty(n20046), n20046=0; end;
if isempty(nerr), nerr=0; end;
if isempty(np), np=0; end;
%***BEGIN PROLOGUE PNNZRS
%***SUBSIDIARY
%***PURPOSE Subsidiary to SPLP
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (PNNZRS-S, DPNNZR-D)
%***AUTHOR Hanson, R. J., (SNLA)
% Wisniewski, J. A., (SNLA)
%***DESCRIPTION
%
% PNNZRS LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SCHEME.
% SPARSE MATRIX NON ZERO RETRIEVAL SUBROUTINE.
%
% subroutine PNNZRS() GETS THE NEXT NONZERO VALUE IN ROW OR COLUMN
% +/- IRCX WITH AN INDEX GREATER THAN THE VALUE OF I.
%
% I ABSOLUTE VALUE OF THIS SUBSCRIPT IS TO BE EXCEEDED
% IN THE SEARCH FOR THE NEXT NONZERO VALUE. A NEGATIVE
% OR ZERO VALUE OF I CAUSES THE SEARCH TO START AT
% THE BEGINNING OF THE VECTOR. A POSITIVE VALUE
% OF I CAUSES THE SEARCH TO CONTINUE FROM THE LAST PLACE
% ACCESSED. ON OUTPUT, THE ARGUMENT I
% contains THE VALUE OF THE SUBSCRIPT FOUND. AN OUTPUT
% VALUE OF I EQUAL TO ZERO INDICATES THAT ALL COMPONENTS
% WITH AN INDEX GREATER THAN THE INPUT VALUE OF I ARE
% ZERO.
% XVAL VALUE OF THE NONZERO ELEMENT FOUND. ON OUTPUT,
% XVAL=0. WHENEVER I=0.
% IPLACE POINTER INFORMATION WHICH IS MAINTAINED BY THE PACKAGE.
% SX(*),IX(*) THE WORK ARRAYS WHICH ARE USED TO STORE THE SPARSE
% MATRIX. THESE ARRAY CONTENTS ARE AUTOMATICALLY
% MAINTAINED BY THE PACKAGE FOR THE USER.
% IRCX POINTS TO THE VECTOR OF THE MATRIX BEING SCANNED. A
% NEGATIVE VALUE OF IRCX INDICATES THAT ROW -IRCX IS TO BE
% SCANNED. A POSITIVE VALUE OF IRCX INDICATES THAT
% COLUMN IRCX IS TO BE SCANNED. A ZERO VALUE OF IRCX IS
% AN ERROR.
%
% THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LNNZRS,
% SANDIA LABS. REPT. SAND78-0785.
% MODIFICATIONS BY K.L. HIEBERT AND R.J. HANSON
% REVISED 811130-1000
% REVISED YYMMDD-HHMM
%
%***SEE ALSO SPLP
%***ROUTINES CALLED IPLOC, XERMSG
%***REVISION HISTORY (YYMMDD)
% 811215 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 890605 Removed unreferenced labels. (WRB)
% 891214 Prologue converted to Version 4.0 format. (BAB)
% 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
% 900328 Added TYPE section. (WRB)
% 910403 Updated AUTHOR and DESCRIPTION sections. (WRB)
%***end PROLOGUE PNNZRS
ix_shape=size(ix);ix=reshape(ix,1,[]);
sx_shape=size(sx);sx=reshape(sx,1,[]);
if isempty(zero), zero=0; end;
if firstCall, zero=[0.0e0]; end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT PNNZRS
iopt = 1;
%
% CHECK VALIDITY OF ROW/COL. INDEX.
%
if( ircx==0 )
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PNNZRS','IRCX=0.',nerr,iopt);
end;
%
% LMX IS THE LENGTH OF THE IN-MEMORY STORAGE AREA.
%
lmx = fix(ix(1));
if( ircx>=0 )
%
% CHECK SUBSCRIPTS OF THE COLUMN. THE COL. NUMBER MUST BE .LE. N AND
% THE INDEX MUST BE .LE. M.
%
if( ircx>ix(3) || abs(i)>ix(2) )
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PNNZRS',['SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ','BOUNDS.'],nerr,iopt);
end;
l = fix(ix(2));
else;
%
% CHECK SUBSCRIPTS OF THE ROW. THE ROW NUMBER MUST BE .LE. M AND
% THE INDEX MUST BE .LE. N.
%
if( ix(2)<-ircx || ix(3)<abs(i) )
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PNNZRS',['SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ','BOUNDS.'],nerr,iopt);
end;
l = fix(ix(3));
end;
%
% HERE L IS THE LARGEST POSSIBLE SUBSCRIPT WITHIN THE VECTOR.
%
j = fix(abs(ircx));
ll = fix(ix(3) + 4);
lpg = fix(lmx - ll);
if( ircx<=0 )
%
% SEARCH A ROW FOR THE NEXT NONZERO.
% FIND ELEMENT J=ABS(IRCX) IN ROWS ABS(I)+1,...,L.
%
i = fix(abs(i));
%
% CHECK FOR END OF VECTOR.
%
if( i==l )
i = 0;
xval = zero;
else;
i1 = fix(i + 1);
ii = fix(i1);
n20046 = fix(l);
while((n20046-ii)>=0 );
%
% INITIALIZE IPPLOC FOR ORTHOGONAL SCAN.
% LOOK FOR J AS A SUBSCRIPT IN ROWS II, II=I+1,...,L.
%
if( ii==1 )
ipploc = fix(ll + 1);
else;
ipploc = fix(ix(ii+3) + 1);
end;
iend = fix(ix(ii+4));
%
% SCAN THROUGH SEVERAL PAGES, IF NECESSARY, TO FIND MATRIX ENTRY.
%
[ipl ,ipploc,sx,ix]=iploc(ipploc,sx,ix);
%
% FIX UP IPPLOC AND IPL TO POINT TO MATRIX DATA.
%
idiff = fix(lmx - ipl);
if( idiff<=1 && ix(lmx-1)>0 )
ipploc = fix(ipploc + idiff + 1);
[ipl ,ipploc,sx,ix]=iploc(ipploc,sx,ix);
end;
np = fix(abs(ix(lmx-1)));
while( true );
ilast = fix(min(iend,np.*lpg+ll-2));
[il ,ilast,sx,ix]=iploc(ilast,sx,ix);
il = fix(min(il,lmx-2));
while( ipl<il & ix(ipl)<j );
ipl = fix(ipl + 1);
end;
if( ix(ipl)==j && sx(ipl)~=zero && ipl<=il )
i = fix(ii);
xval = sx(ipl);
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
else;
if( ix(ipl)>=j )
ilast = fix(iend);
end;
ipl = fix(ll + 1);
np = fix(np + 1);
if( ilast==iend )
break;
end;
end;
end;
ii = fix(ii + 1);
end;
%
% ORTHOGONAL SCAN FAILED. THE VALUE J WAS NOT A SUBSCRIPT
% IN ANY ROW.
%
i = 0;
xval = zero;
end;
else;
%
% SEARCHING FOR THE NEXT NONZERO IN A COLUMN.
%
% INITIALIZE STARTING LOCATIONS..
if( i<=0 )
if( j==1 )
iplace = fix(ll + 1);
else;
iplace = fix(ix(j+3) + 1);
end;
end;
%
% THE CASE I.LE.0 SIGNALS THAT THE SCAN FOR THE ENTRY
% IS TO BEGIN AT THE START OF THE VECTOR.
%
i = fix(abs(i));
if( j==1 )
istart = fix(ll + 1);
else;
istart = fix(ix(j+3) + 1);
end;
iend = fix(ix(j+4));
%
% VALIDATE IPLACE. SET TO START OF VECTOR IF OUT OF RANGE.
%
if( istart>iplace || iplace>iend )
if( j==1 )
iplace = fix(ll + 1);
else;
iplace = fix(ix(j+3) + 1);
end;
end;
%
% SCAN THROUGH SEVERAL PAGES, IF NECESSARY, TO FIND MATRIX ENTRY.
%
[ipl ,iplace,sx,ix]=iploc(iplace,sx,ix);
%
% FIX UP IPLACE AND IPL IF THEY POINT TO PAGING DATA.
% THIS IS NECESSARY BECAUSE THERE IS CONTROL INFORMATION AT THE
% end OF EACH PAGE.
%
idiff = fix(lmx - ipl);
if( idiff<=1 && ix(lmx-1)>0 )
%
% UPDATE THE RELATIVE ADDRESS IN A NEW PAGE.
%
iplace = fix(iplace + idiff + 1);
[ipl ,iplace,sx,ix]=iploc(iplace,sx,ix);
end;
np = fix(abs(ix(lmx-1)));
while( true );
ilast = fix(min(iend,np.*lpg+ll-2));
%
% THE VIRTUAL END OF THE DATA FOR THIS PAGE IS ILAST.
%
[il ,ilast,sx,ix]=iploc(ilast,sx,ix);
il = fix(min(il,lmx-2));
%
% THE RELATIVE END OF DATA FOR THIS PAGE IS IL.
% SEARCH FOR A NONZERO VALUE WITH AN INDEX .GT. I ON THE PRESENT
% PAGE.
%
while( ~(ipl>=il |(ix(ipl)>i & sx(ipl)~=zero)) );
ipl = fix(ipl + 1);
end;
if( ix(ipl)>i && sx(ipl)~=zero && ipl<=il )
break;
end;
%
% UPDATE TO SCAN THE NEXT PAGE.
ipl = fix(ll + 1);
np = fix(np + 1);
if( ilast==iend )
%
% NO DATA WAS FOUND. END OF VECTOR ENCOUNTERED.
%
i = 0;
xval = zero;
il = fix(il + 1);
if( il==lmx-1 )
il = fix(il + 2);
end;
%
% IF A NEW ITEM WOULD BE INSERTED, IPLACE POINTS TO THE PLACE
% TO PUT IT.
%
iplace =fix((np-1).*lpg + il);
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
end;
end;
i = fix(ix(ipl));
xval = sx(ipl);
iplace =fix((np-1).*lpg + ipl);
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
return;
end;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
end %subroutine pnnzrs
%DECK POCH1
|
|