| [usrmat,mrelas,nvars,prgopt,dattrv,bl,bu,ind,info,amat,imat,sizeup,asmall,abig]=splpup(usrmat,mrelas,nvars,prgopt,dattrv,bl,bu,ind,info,amat,imat,sizeup,asmall,abig); |
function [usrmat,mrelas,nvars,prgopt,dattrv,bl,bu,ind,info,amat,imat,sizeup,asmall,abig]=splpup(usrmat,mrelas,nvars,prgopt,dattrv,bl,bu,ind,info,amat,imat,sizeup,asmall,abig);
persistent aij amn amx first i iflag indcat indexmlv iplace itcnt itmax j xern1 xern2 xern3 xern4 xval zero ;
if isempty(i), i=0; end;
if isempty(indcat), indcat=0; end;
if isempty(indexmlv), indexmlv=0; end;
if isempty(iplace), iplace=0; end;
if isempty(itcnt), itcnt=0; end;
if isempty(itmax), itmax=0; end;
if isempty(j), j=0; end;
%***BEGIN PROLOGUE SPLPUP
%***SUBSIDIARY
%***PURPOSE Subsidiary to SPLP
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (SPLPUP-S, DPLPUP-D)
%***AUTHOR (UNKNOWN)
%***DESCRIPTION
%
% THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO
% doubleprecision INVOLVES THE FOLLOWING CHARACTER STRING CHANGES.
%
% use AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/.
% /REAL (12 BLANKS)/doubleprecision/.
%
% REVISED 810613-1130
% REVISED YYMMDD-HHMM
%
% THIS SUBROUTINE COLLECTS INFORMATION ABOUT THE BOUNDS AND MATRIX
% FROM THE USER. IT IS PART OF THE SPLP( ) PACKAGE.
%
%***SEE ALSO SPLP
%***ROUTINES CALLED PCHNGS, PNNZRS, XERMSG
%***REVISION HISTORY (YYMMDD)
% 811215 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 890605 Corrected references to XERRWV. (WRB)
% 890605 Removed unreferenced labels. (WRB)
% 891009 Removed unreferenced variables. (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)
% 900510 Convert XERRWV calls to XERMSG calls, changed do-it-yourself
% DO loops to DO loops. (RWC)
% 900602 Get rid of ASSIGNed GOTOs. (RWC)
%***end PROLOGUE SPLPUP
if isempty(aij), aij=0; end;
amat_shape=size(amat);amat=reshape(amat,1,[]);
if isempty(amn), amn=0; end;
if isempty(amx), amx=0; end;
bl_shape=size(bl);bl=reshape(bl,1,[]);
bu_shape=size(bu);bu=reshape(bu,1,[]);
dattrv_shape=size(dattrv);dattrv=reshape(dattrv,1,[]);
prgopt_shape=size(prgopt);prgopt=reshape(prgopt,1,[]);
if isempty(xval), xval=0; end;
if isempty(zero), zero=0; end;
if isempty(iflag), iflag=zeros(1,10); end;
imat_shape=size(imat);imat=reshape(imat,1,[]);
ind_shape=size(ind);ind=reshape(ind,1,[]);
if isempty(first), first=false; end;
if isempty(xern1), xern1=repmat(' ',1,8); end;
if isempty(xern2), xern2=repmat(' ',1,8); end;
if isempty(xern3), xern3=repmat(' ',1,16); end;
if isempty(xern4), xern4=repmat(' ',1,16); end;
%
%***FIRST EXECUTABLE STATEMENT SPLPUP
zero = 0.0e0;
%
% CHECK USER-SUPPLIED BOUNDS
%
% CHECK THAT IND(*) VALUES ARE 1,2,3 OR 4.
% ALSO CHECK CONSISTENCY OF UPPER AND LOWER BOUNDS.
%
for j = 1 : nvars;
if( ind(j)<1 || ind(j)>4 )
xern1=sprintf(['%8i'], j);
xermsg('SLATEC','SPLPUP',['IN SPLP, INDEPENDENT VARIABLE = ',[xern1,' IS NOT DEFINED.']],10,1);
info = -10;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
%
if( ind(j)==3 )
if( bl(j)>bu(j) )
xern1=sprintf(['%8i'], j);
xern3=sprintf([repmat('%15.6f',1,1)], bl(j));
xern4=sprintf([repmat('%15.6f',1,1)], bu(j));
xermsg('SLATEC','SPLPUP',['IN SPLP, LOWER BOUND = ',[xern3,[' AND UPPER BOUND = ',[xern4,[' FOR INDEPENDENT VARIABLE = ',[xern1,' ARE NOT CONSISTENT.']]]]]],11,1);
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
end;
end; j = fix(nvars+1);
%
for i = nvars + 1 : nvars + mrelas;
if( ind(i)<1 || ind(i)>4 )
xern1=sprintf(['%8i'], i - nvars);
xermsg('SLATEC','SPLPUP',['IN SPLP, DEPENDENT VARIABLE = ',[xern1,' IS NOT DEFINED.']],12,1);
info = -12;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
%
if( ind(i)==3 )
if( bl(i)>bu(i) )
xern1=sprintf(['%8i'], i);
xern3=sprintf([repmat('%15.6f',1,1)], bl(i));
xern4=sprintf([repmat('%15.6f',1,1)], bu(i));
xermsg('SLATEC','SPLPUP',['IN SPLP, LOWER BOUND = ',[xern3,[' AND UPPER BOUND = ',[xern4,[' FOR DEPENDANT VARIABLE = ',[xern1,' ARE NOT CONSISTENT.']]]]]],13,1);
info = -13;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
end;
end; i = fix(nvars + mrelas+1);
%
% GET UPDATES OR DATA FOR MATRIX FROM THE USER
%
% GET THE ELEMENTS OF THE MATRIX FROM THE USER. IT WILL BE STORED
% BY COLUMNS USING THE SPARSE STORAGE CODES OF RJ HANSON AND
% JA WISNIEWSKI.
%
iflag(1) = 1;
%
% KEEP ACCEPTING ELEMENTS UNTIL THE USER IS FINISHED GIVING THEM.
% LIMIT THIS LOOP TO 2*NVARS*MRELAS ITERATIONS.
%
itmax = fix(2.*nvars.*mrelas + 1);
itcnt = 0;
first = true;
%
% CHECK ON THE ITERATION COUNT.
%
while (1);
itcnt = fix(itcnt + 1);
if( itcnt>itmax )
xermsg('SLATEC','SPLPUP',['IN SPLP, MORE THAN 2*NVARS*MRELAS ITERATIONS DEFINING ','OR UPDATING MATRIX DATA.'],7,1);
info = -7;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
%
aij = zero;
[i,j,aij,indcat,prgopt,dattrv,iflag]=usrmat(i,j,aij,indcat,prgopt,dattrv,iflag);
if( iflag(1)==1 )
iflag(1) = 2;
continue;
end;
%
% CHECK TO SEE THAT THE SUBSCRIPTS I AND J ARE VALID.
%
if( i<1 || i>mrelas || j<1 || j>nvars )
%
% CHECK ON SIZE OF MATRIX DATA
% RECORD THE LARGEST AND SMALLEST(IN MAGNITUDE) NONZERO ELEMENTS.
%
if( iflag(1)==3 )
if( sizeup && abs(aij)~=zero )
if( first )
amx = abs(aij);
amn = abs(aij);
first = false;
elseif( abs(aij)>amx ) ;
amx = abs(aij);
elseif( abs(aij)<amn ) ;
amn = abs(aij);
end;
end;
break;
end;
%
xern1=sprintf(['%8i'], i);
xern2=sprintf(['%8i'], j);
xermsg('SLATEC','SPLPUP',['IN SPLP, ROW INDEX = ',[xern1,[' OR COLUMN INDEX = ',[xern2,' IS OUT OF RANGE.']]]],8,1);
info = -8;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
%
% IF INDCAT=0 THEN SET A(I,J)=AIJ.
% IF INDCAT=1 THEN ACCUMULATE ELEMENT, A(I,J)=A(I,J)+AIJ.
%
if( indcat==0 )
[i,aij,iplace,amat,imat,j]=pchngs(i,aij,iplace,amat,imat,j);
elseif( indcat==1 ) ;
indexmlv = -(i-1);
[indexmlv,xval,iplace,amat,imat,j]=pnnzrs(indexmlv,xval,iplace,amat,imat,j);
if( indexmlv==i )
aij = aij + xval;
end;
[i,aij,iplace,amat,imat,j]=pchngs(i,aij,iplace,amat,imat,j);
else;
xern1=sprintf(['%8i'], indcat);
xermsg('SLATEC','SPLPUP',['IN SPLP, INDICATION FLAG = ',[xern1,' FOR MATRIX DATA MUST BE EITHER 0 OR 1.']],9,1);
info = -9;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
%
% CHECK ON SIZE OF MATRIX DATA
% RECORD THE LARGEST AND SMALLEST(IN MAGNITUDE) NONZERO ELEMENTS.
%
if( sizeup && abs(aij)~=zero )
if( first )
amx = abs(aij);
amn = abs(aij);
first = false;
elseif( abs(aij)>amx ) ;
amx = abs(aij);
elseif( abs(aij)<amn ) ;
amn = abs(aij);
end;
end;
if( iflag(1)~=3 )
continue;
end;
break;
end;
%
if( sizeup && ~first )
if( amn<asmall || amx>abig )
xermsg('SLATEC','SPLPUP',['IN SPLP, A MATRIX ELEMENT''S SIZE IS OUT OF THE ','SPECIFIED RANGE.'],22,1);
info = -22;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
return;
end;
end;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
bl_shape=zeros(bl_shape);bl_shape(:)=bl(1:numel(bl_shape));bl=bl_shape;
bu_shape=zeros(bu_shape);bu_shape(:)=bu(1:numel(bu_shape));bu=bu_shape;
dattrv_shape=zeros(dattrv_shape);dattrv_shape(:)=dattrv(1:numel(dattrv_shape));dattrv=dattrv_shape;
prgopt_shape=zeros(prgopt_shape);prgopt_shape(:)=prgopt(1:numel(prgopt_shape));prgopt=prgopt_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
end %subroutine splpup
%DECK SPOCO
|
|
