| [mrelas,nvars,costs,bl,bu,ind,primal,info,amat,csc,costsc,colnrm,xlamda,anorm,rhs,rhsnrm,ibasis,ibb,imat,lopt]=spinit(mrelas,nvars,costs,bl,bu,ind,primal,info,amat,csc,costsc,colnrm,xlamda,anorm,rhs,rhsnrm,ibasis,ibb,imat,lopt); |
function [mrelas,nvars,costs,bl,bu,ind,primal,info,amat,csc,costsc,colnrm,xlamda,anorm,rhs,rhsnrm,ibasis,ibb,imat,lopt]=spinit(mrelas,nvars,costs,bl,bu,ind,primal,info,amat,csc,costsc,colnrm,xlamda,anorm,rhs,rhsnrm,ibasis,ibb,imat,lopt);
persistent aij cmax colscp contin cstscp csum i ip iplace j minprb n20007 n20019 n20028 n20041 n20056 n20066 n20070 n20074 n20078 one scalr testsc usrbas zero ;
if isempty(i), i=0; end;
if isempty(ip), ip=0; end;
if isempty(iplace), iplace=0; end;
if isempty(j), j=0; end;
if isempty(n20007), n20007=0; end;
if isempty(n20019), n20019=0; end;
if isempty(n20028), n20028=0; end;
if isempty(n20041), n20041=0; end;
if isempty(n20056), n20056=0; end;
if isempty(n20066), n20066=0; end;
if isempty(n20070), n20070=0; end;
if isempty(n20074), n20074=0; end;
if isempty(n20078), n20078=0; end;
%***BEGIN PROLOGUE SPINIT
%***SUBSIDIARY
%***PURPOSE Subsidiary to SPLP
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (SPINIT-S, DPINIT-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/,/SCOPY/DCOPY/
% REVISED 810519-0900
% REVISED YYMMDD-HHMM
%
% INITIALIZATION SUBROUTINE FOR SPLP(*) PACKAGE.
%
%***SEE ALSO SPLP
%***ROUTINES CALLED PNNZRS, SASUM, SCOPY
%***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)
% 900328 Added TYPE section. (WRB)
%***end PROLOGUE SPINIT
if isempty(aij), aij=0; end;
amat_shape=size(amat);amat=reshape(amat,1,[]);
bl_shape=size(bl);bl=reshape(bl,1,[]);
bu_shape=size(bu);bu=reshape(bu,1,[]);
if isempty(cmax), cmax=0; end;
colnrm_shape=size(colnrm);colnrm=reshape(colnrm,1,[]);
costs_shape=size(costs);costs=reshape(costs,1,[]);
csc_shape=size(csc);csc=reshape(csc,1,[]);
if isempty(csum), csum=0; end;
if isempty(one), one=0; end;
primal_shape=size(primal);primal=reshape(primal,1,[]);
rhs_shape=size(rhs);rhs=reshape(rhs,1,[]);
if isempty(scalr), scalr=0; end;
if isempty(testsc), testsc=0; end;
if isempty(zero), zero=0; end;
ibasis_shape=size(ibasis);ibasis=reshape(ibasis,1,[]);
ibb_shape=size(ibb);ibb=reshape(ibb,1,[]);
imat_shape=size(imat);imat=reshape(imat,1,[]);
ind_shape=size(ind);ind=reshape(ind,1,[]);
if isempty(contin), contin=false; end;
if isempty(usrbas), usrbas=false; end;
if isempty(colscp), colscp=false; end;
if isempty(cstscp), cstscp=false; end;
if isempty(minprb), minprb=false; end;
%
%***FIRST EXECUTABLE STATEMENT SPINIT
zero = 0.;
one = 1.;
contin = lopt(1);
usrbas = lopt(2);
colscp = lopt(5);
cstscp = lopt(6);
%
% SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS.
%
% INITIALIZE ACTIVE BASIS MATRIX.
minprb = lopt(7);
%
% PROCEDURE (SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS)
%
% DO COLUMN SCALING IF NOT PROVIDED BY THE USER.
if( ~colscp )
j = 1;
n20007 = fix(nvars);
while((n20007-j)>=0 );
cmax = zero;
i = 0;
while( true );
[i,aij,iplace,amat,imat,j]=pnnzrs(i,aij,iplace,amat,imat,j);
if( i==0 )
break;
end;
cmax = max(cmax,abs(aij));
end;
if( cmax==zero )
csc(j) = one;
else;
csc(j) = one./cmax;
end;
j = fix(j + 1);
end;
end;
%
% FORM CHECK SUMS OF COLUMNS. COMPUTE MATRIX NORM OF SCALED MATRIX.
anorm = zero;
j = 1;
n20019 = fix(nvars);
while((n20019-j)>=0 );
primal(j) = zero;
csum = zero;
i = 0;
while( true );
[i,aij,iplace,amat,imat,j]=pnnzrs(i,aij,iplace,amat,imat,j);
if( i<=0 )
break;
end;
primal(j) = primal(j) + aij;
csum = csum + abs(aij);
end;
if( ind(j)==2 )
csc(j) = -csc(j);
end;
primal(j) = primal(j).*csc(j);
colnrm(j) = abs(csc(j).*csum);
anorm = max(anorm,colnrm(j));
j = fix(j + 1);
end;
%
% IF THE USER HAS NOT PROVIDED COST VECTOR SCALING THEN SCALE IT
% USING THE MAX. NORM OF THE TRANSFORMED COST VECTOR, IF NONZERO.
testsc = zero;
j = 1;
n20028 = fix(nvars);
while((n20028-j)>=0 );
testsc = max(testsc,abs(csc(j).*costs(j)));
j = fix(j + 1);
end;
if( ~cstscp )
if( testsc<=zero )
costsc = one;
else;
costsc = one./testsc;
end;
end;
xlamda =(costsc+costsc).*testsc;
if( xlamda==zero )
xlamda = one;
end;
%
% IF MAXIMIZATION PROBLEM, THEN CHANGE SIGN OF COSTSC AND LAMDA
% =WEIGHT FOR PENALTY-FEASIBILITY METHOD.
if( ~minprb )
costsc = -costsc;
end;
%:CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
% PROCEDURE (INITIALIZE RHS(*),IBASIS(*), AND IBB(*))
%
% INITIALLY SET RIGHT-HAND SIDE VECTOR TO ZERO.
[mrelas,zero,dumvar3,rhs]=scopy(mrelas,zero,0,rhs,1);
%
% TRANSLATE RHS ACCORDING TO CLASSIFICATION OF INDEPENDENT VARIABLES
j = 1;
n20041 = fix(nvars);
while((n20041-j)>=0 );
if( ind(j)==1 )
scalr = -bl(j);
elseif( ind(j)==2 ) ;
scalr = -bu(j);
elseif( ind(j)==3 ) ;
scalr = -bl(j);
elseif( ind(j)==4 ) ;
scalr = zero;
end;
if( scalr==zero )
j = fix(j + 1);
else;
i = 0;
while( true );
[i,aij,iplace,amat,imat,j]=pnnzrs(i,aij,iplace,amat,imat,j);
if( i<=0 )
break;
end;
rhs(i) = scalr.*aij + rhs(i);
end;
j = fix(j + 1);
end;
end;
%
% TRANSLATE RHS ACCORDING TO CLASSIFICATION OF DEPENDENT VARIABLES.
i = fix(nvars + 1);
n20056 = fix(nvars + mrelas);
while((n20056-i)>=0 );
if( ind(i)==1 )
scalr = bl(i);
elseif( ind(i)==2 ) ;
scalr = bu(i);
elseif( ind(i)==3 ) ;
scalr = bl(i);
elseif( ind(i)==4 ) ;
scalr = zero;
end;
rhs(i-nvars) = rhs(i-nvars) + scalr;
i = fix(i + 1);
end;
[rhsnrm ,mrelas,rhs]=sasum(mrelas,rhs,1);
%
% IF THIS IS NOT A CONTINUATION OR THE USER HAS NOT PROVIDED THE
% INITIAL BASIS, THEN THE INITIAL BASIS IS COMPRISED OF THE
% DEPENDENT VARIABLES.
if( ~(contin || usrbas) )
j = 1;
n20066 = fix(mrelas);
while((n20066-j)>=0 );
ibasis(j) = fix(nvars + j);
j = fix(j + 1);
end;
end;
%
% DEFINE THE ARRAY IBB(*)
j = 1;
n20070 = fix(nvars + mrelas);
while((n20070-j)>=0 );
ibb(j) = 1;
j = fix(j + 1);
end;
j = 1;
n20074 = fix(mrelas);
while((n20074-j)>=0 );
ibb(ibasis(j)) = -1;
j = fix(j + 1);
end;
%
% DEFINE THE REST OF IBASIS(*)
ip = fix(mrelas);
j = 1;
n20078 = fix(nvars + mrelas);
while((n20078-j)>=0 );
if( ibb(j)>0 )
ip = fix(ip + 1);
ibasis(ip) = fix(j);
end;
j = fix(j + 1);
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;
colnrm_shape=zeros(colnrm_shape);colnrm_shape(:)=colnrm(1:numel(colnrm_shape));colnrm=colnrm_shape;
costs_shape=zeros(costs_shape);costs_shape(:)=costs(1:numel(costs_shape));costs=costs_shape;
csc_shape=zeros(csc_shape);csc_shape(:)=csc(1:numel(csc_shape));csc=csc_shape;
primal_shape=zeros(primal_shape);primal_shape(:)=primal(1:numel(primal_shape));primal=primal_shape;
rhs_shape=zeros(rhs_shape);rhs_shape(:)=rhs(1:numel(rhs_shape));rhs=rhs_shape;
ibasis_shape=zeros(ibasis_shape);ibasis_shape(:)=ibasis(1:numel(ibasis_shape));ibasis=ibasis_shape;
ibb_shape=zeros(ibb_shape);ibb_shape(:)=ibb(1:numel(ibb_shape));ibb=ibb_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 spinit
%DECK SPLPCE
|
|