| [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
|
|