Code covered by the BSD License  

Highlights from
slatec

from slatec by Ben Barrowes
The slatec library converted into matlab functions.

[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

Contact us