Code covered by the BSD License  

Highlights from
slatec

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

[ii,xval,iplace,sx,ix,ircx]=pchngs(ii,xval,iplace,sx,ix,ircx);
function [ii,xval,iplace,sx,ix,ircx]=pchngs(ii,xval,iplace,sx,ix,ircx);
persistent firstCall i iend il ilast iopt ipl istart ixlast j jj jstart k key ll lmx lpg n20055 nerr np one sxlast sxval zero ; if isempty(firstCall),firstCall=1;end; 

if isempty(i), i=0; end;
if isempty(iend), iend=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(istart), istart=0; end;
if isempty(ixlast), ixlast=0; end;
if isempty(j), j=0; end;
if isempty(jj), jj=0; end;
if isempty(jstart), jstart=0; end;
if isempty(k), k=0; end;
if isempty(key), key=0; end;
if isempty(ll), ll=0; end;
if isempty(lmx), lmx=0; end;
if isempty(lpg), lpg=0; end;
if isempty(n20055), n20055=0; end;
if isempty(nerr), nerr=0; end;
if isempty(np), np=0; end;
%***BEGIN PROLOGUE  PCHNGS
%***SUBSIDIARY
%***PURPOSE  Subsidiary to SPLP
%***LIBRARY   SLATEC
%***TYPE      SINGLE PRECISION (PCHNGS-S, DPCHNG-D)
%***AUTHOR  Hanson, R. J., (SNLA)
%           Wisniewski, J. A., (SNLA)
%***DESCRIPTION
%
%     PCHNGS LIMITS THE TYPE OF STORAGE TO A SEQUENTIAL SCHEME.
%     SPARSE MATRIX ELEMENT ALTERATION SUBROUTINE.
%
%     subroutine PCHNGS() CHANGES ELEMENT II IN VECTOR +/- IRCX TO THE
%     VALUE XVAL.
%
%            II THE ABSOLUTE VALUE OF THIS INTEGER IS THE SUBSCRIPT FOR
%               THE ELEMENT TO BE CHANGED.
%          XVAL NEW VALUE OF THE MATRIX ELEMENT BEING CHANGED.
%     IPLACE POINTER INFORMATION WHICH IS MAINTAINED BY THE PACKAGE.
%   SX(*),IX(*) THE WORK ARRAYS WHICH ARE USED TO STORE THE SPARSE
%               MATRIX. THESE ARRAYS ARE AUTOMATICALLY MAINTAINED BY THE
%               PACKAGE FOR THE USER.
%          IRCX POINTS TO THE VECTOR OF THE MATRIX BEING UPDATED.
%               A NEGATIVE VALUE OF IRCX INDICATES THAT ROW -IRCX IS
%               BEING UPDATED.  A POSITIVE VALUE OF IRCX INDICATES THAT
%               COLUMN IRCX IS BEING UPDATED.  A ZERO VALUE OF IRCX IS
%               AN ERROR.
%
%     SINCE DATA ITEMS ARE KEPT SORTED IN THE SEQUENTIAL DATA STRUCTURE,
%     CHANGING A MATRIX ELEMENT CAN REQUIRE THE MOVEMENT OF ALL THE DATA
%     ITEMS IN THE MATRIX. FOR THIS REASON, IT IS SUGGESTED THAT DATA
%     ITEMS BE ADDED A COL. AT A TIME, IN ASCENDING COL. SEQUENCE.
%     FURTHERMORE, SINCE DELETING ITEMS FROM THE DATA STRUCTURE MAY ALSO
%     REQUIRE MOVING LARGE AMOUNTS OF DATA, ZERO ELEMENTS ARE EXPLICITLY
%     STORED IN THE MATRIX.
%
%     THIS SUBROUTINE IS A MODIFICATION OF THE SUBROUTINE LCHNGS,
%     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, PRWPGE, XERMSG
%***REVISION HISTORY  (YYMMDD)
%   811215  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (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  PCHNGS
ix_shape=size(ix);ix=reshape(ix,1,[]);
sx_shape=size(sx);sx=reshape(sx,1,[]);
if isempty(zero), zero=0; end;
if isempty(one), one=0; end;
if isempty(sxlast), sxlast=0; end;
if isempty(sxval), sxval=0; end;
if firstCall,   zero =[0.0e0];  end;
if firstCall,  one=[1.0e0];  end;
firstCall=0;
%***FIRST EXECUTABLE STATEMENT  PCHNGS
iopt = 1;
%
%     DETERMINE NULL-CASES..
if( ii~=0 )
%
%     CHECK VALIDITY OF ROW/COL. INDEX.
%
if( ircx==0 )
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PCHNGS','IRCX=0.',nerr,iopt);
end;
lmx = fix(ix(1));
%
%     LMX IS THE LENGTH OF THE IN-MEMORY STORAGE AREA.
%
if( ircx>=0 )
%
%     CHECK SUBSCRIPTS OF THE COLUMN. THE COL. NUMBER MUST BE .LE. N AND
%     THE INDEX MUST BE .LE. M.
%
if( ix(3)<ircx || ix(2)<abs(ii) )
%
%     CHECK SUBSCRIPTS OF THE ROW. THE ROW NUMBER MUST BE .LE. M AND
%     THE INDEX MUST BE .LE. N.
%
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PCHNGS',['SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ','BOUNDS.'],nerr,iopt);
end;
elseif( ix(2)<-ircx || ix(3)<abs(ii) ) ;
nerr = 55;
[dumvar1,dumvar2,dumvar3,nerr,iopt]=xermsg('SLATEC','PCHNGS',['SUBSCRIPTS FOR ARRAY ELEMENT TO BE ACCESSED WERE OUT OF ','BOUNDS.'],nerr,iopt);
end;
%
%     SET I TO BE THE ELEMENT OF ROW/COLUMN J TO BE CHANGED.
%
if( ircx<=0 )
i = fix(abs(ircx));
j = fix(abs(ii));
else;
i = fix(abs(ii));
j = fix(abs(ircx));
end;
%
%     THE INTEGER LL POINTS TO THE START OF THE MATRIX ELEMENT DATA.
%
ll = fix(ix(3) + 4);
ii = fix(abs(ii));
lpg = fix(lmx - ll);
%
%     SET IPLACE TO START OUR SCAN FOR THE ELEMENT AT THE BEGINNING
%     OF THE VECTOR.
%
if( j==1 )
iplace = fix(ll + 1);
else;
iplace = fix(ix(j+3) + 1);
end;
%
%     IEND POINTS TO THE LAST ELEMENT OF THE VECTOR TO BE SCANNED.
%
iend = fix(ix(j+4));
%
%     SCAN THROUGH SEVERAL PAGES, IF NECESSARY, TO FIND MATRIX ELEMENT.
%
[ipl ,iplace,sx,ix]=iploc(iplace,sx,ix);
np = fix(abs(ix(lmx-1)));
%
%     THE VIRTUAL END OF DATA FOR THIS PAGE IS ILAST.
%
while( true );
ilast = fix(min(iend,np.*lpg+ll-2));
%
%     THE RELATIVE END OF DATA FOR THIS PAGE IS IL.
%     SEARCH FOR A MATRIX VALUE WITH AN INDEX .GE. I ON THE PRESENT
%     PAGE.
%
[il ,ilast,sx,ix]=iploc(ilast,sx,ix);
il = fix(min(il,lmx-2));
while( ipl<il & ix(ipl)<i );
ipl = fix(ipl + 1);
end;
if( ix(ipl)==i && ipl<=il )
break;
end;
%
%     EXIT FROM LOOP IF ITEM WAS FOUND.
%
if( ix(ipl)>i && ipl<=il )
ilast = fix(iend);
end;
if( ilast~=iend )
ipl = fix(ll + 1);
np = fix(np + 1);
end;
if( ilast==iend )
%
%     INSERT NEW DATA ITEM INTO LOCATION AT IPLACE(IPL).
%
if( ipl>il ||(ipl==il && i>ix(ipl)) )
ipl = fix(il + 1);
if( ipl==lmx-1 )
ipl = fix(ipl + 2);
end;
end;
iplace =fix((np-1).*lpg + ipl);
%
%     GO TO A NEW PAGE, IF NECESSARY, TO INSERT THE ITEM.
%
if( ipl<=lmx || ix(lmx-1)>=0 )
[ ipl ,iplace,sx,ix]=iploc(iplace,sx,ix);
end;
iend = fix(ix(ll));
np = fix(abs(ix(lmx-1)));
%
%     LOOP THROUGH ALL SUBSEQUENT PAGES OF THE MATRIX MOVING DATA DOWN.
%     THIS IS NECESSARY TO MAKE ROOM FOR THE NEW MATRIX ELEMENT AND
%     KEEP THE ENTRIES SORTED.
%
sxval = xval;
while( true );
ilast = fix(min(iend,np.*lpg+ll-2));
[il ,ilast,sx,ix]=iploc(ilast,sx,ix);
il = fix(min(il,lmx-2));
sxlast = sx(il);
ixlast = fix(ix(il));
istart = fix(ipl + 1);
if( istart<=il )
k = fix(istart + il);
for jj = istart : il;
sx(k-jj) = sx(k-jj-1);
ix(k-jj) = fix(ix(k-jj-1));
end; jj = fix(il+1);
sx(lmx) = one;
end;
if( ipl<=lmx )
sx(ipl) = sxval;
ix(ipl) = fix(i);
sxval = sxlast;
i = fix(ixlast);
sx(lmx) = one;
if( ix(lmx-1)>0 )
ipl = fix(ll + 1);
np = fix(np + 1);
end;
end;
if( ix(lmx-1)<=0 )
break;
end;
end;
np = fix(abs(ix(lmx-1)));
%
%     DETERMINE IF A NEW PAGE IS TO BE CREATED FOR THE LAST ELEMENT
%     MOVED DOWN.
%
il = fix(il + 1);
if( il==lmx-1 )
%
%     CREATE A NEW PAGE.
%
ix(lmx-1) = fix(np);
%
%     WRITE THE OLD PAGE.
%
sx(lmx) = zero;
key = 2;
[key,np,lpg,sx,ix]=prwpge(key,np,lpg,sx,ix);
sx(lmx) = one;
%
%     STORE LAST ELEMENT MOVED DOWN IN A NEW PAGE.
%
ipl = fix(ll + 1);
np = fix(np + 1);
ix(lmx-1) = fix(-np);
sx(ipl) = sxval;
ix(ipl) = fix(i);
%
%     LAST ELEMENT MOVED REMAINED ON THE OLD PAGE.
%
elseif( ipl~=il ) ;
sx(il) = sxval;
ix(il) = fix(i);
sx(lmx) = one;
end;
%
%     INCREMENT POINTERS TO LAST ELEMENT IN VECTORS J,J+1,... .
%
jstart = fix(j + 4);
jj = fix(jstart);
n20055 = fix(ll);
while((n20055-jj)>=0 );
ix(jj) = fix(ix(jj) + 1);
if( rem(ix(jj)-ll,lpg)==lpg-1 )
ix(jj) = fix(ix(jj) + 2);
end;
jj = fix(jj + 1);
end;
%
%     IPLACE POINTS TO THE INSERTED DATA ITEM.
%
[ipl ,iplace,sx,ix]=iploc(iplace,sx,ix);
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;
sx(ipl) = xval;
sx(lmx) = one;
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 pchngs
%DECK PCHSP

Contact us