Code covered by the BSD License  

Highlights from
slatec

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

[mrelas,nvars,lmx,lbm,npp,jstrt,ibasis,imat,ibrc,ipr,iwr,ind,ibb,costsc,gg,erdnrm,dulnrm,amat,basmat,csc,wr,ww,rz,rg,costs,colnrm,duals,stpedg]=spincw(mrelas,nvars,lmx,lbm,npp,jstrt,ibasis,imat,ibrc,ipr,iwr,ind,ibb,costsc,gg,erdnrm,dulnrm,amat,basmat,csc,
function [mrelas,nvars,lmx,lbm,npp,jstrt,ibasis,imat,ibrc,ipr,iwr,ind,ibb,costsc,gg,erdnrm,dulnrm,amat,basmat,csc,wr,ww,rz,rg,costs,colnrm,duals,stpedg]=spincw(mrelas,nvars,lmx,lbm,npp,jstrt,ibasis,imat,ibrc,ipr,iwr,ind,ibb,costsc,gg,erdnrm,dulnrm,amat,basmat,csc,wr,ww,rz,rg,costs,colnrm,duals,stpedg);
persistent cnorm i ihi il1 ilow ipage iu1 j key lpg nnegrc one pagepl rcost rzj scalr trans zero ; 

if isempty(cnorm), cnorm=0; end;
if isempty(i), i=0; end;
if isempty(ihi), ihi=0; end;
if isempty(il1), il1=0; end;
if isempty(ilow), ilow=0; end;
if isempty(ipage), ipage=0; end;
if isempty(iu1), iu1=0; end;
if isempty(j), j=0; end;
if isempty(key), key=0; end;
if isempty(lpg), lpg=0; end;
if isempty(nnegrc), nnegrc=0; end;
%***BEGIN PROLOGUE  SPINCW
%***SUBSIDIARY
%***PURPOSE  Subsidiary to SPLP
%***LIBRARY   SLATEC
%***TYPE      SINGLE PRECISION (SPINCW-S, DPINCW-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/,/SDOT/DDOT/.
%
%     THIS SUBPROGRAM IS PART OF THE SPLP( ) PACKAGE.
%     IT IMPLEMENTS THE PROCEDURE (INITIALIZE REDUCED COSTS AND
%     STEEPEST EDGE WEIGHTS).
%
%***SEE ALSO  SPLP
%***ROUTINES CALLED  IPLOC, LA05BS, PRWPGE, SCOPY, SDOT
%***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  SPINCW
ibasis_shape=size(ibasis);ibasis=reshape(ibasis,1,[]);
imat_shape=size(imat);imat=reshape(imat,1,[]);
ibrc_orig=ibrc;ibrc_shape=[lbm,2];ibrc=reshape([ibrc_orig(1:min(prod(ibrc_shape),numel(ibrc_orig))),zeros(1,max(0,prod(ibrc_shape)-numel(ibrc_orig)))],ibrc_shape);
ipr_shape=size(ipr);ipr=reshape(ipr,1,[]);
iwr_shape=size(iwr);iwr=reshape(iwr,1,[]);
ind_shape=size(ind);ind=reshape(ind,1,[]);
ibb_shape=size(ibb);ibb=reshape(ibb,1,[]);
amat_shape=size(amat);amat=reshape(amat,1,[]);
basmat_shape=size(basmat);basmat=reshape(basmat,1,[]);
csc_shape=size(csc);csc=reshape(csc,1,[]);
wr_shape=size(wr);wr=reshape(wr,1,[]);
ww_shape=size(ww);ww=reshape(ww,1,[]);
rz_shape=size(rz);rz=reshape(rz,1,[]);
rg_shape=size(rg);rg=reshape(rg,1,[]);
costs_shape=size(costs);costs=reshape(costs,1,[]);
colnrm_shape=size(colnrm);colnrm=reshape(colnrm,1,[]);
duals_shape=size(duals);duals=reshape(duals,1,[]);
if isempty(one), one=0; end;
if isempty(rzj), rzj=0; end;
if isempty(scalr), scalr=0; end;
if isempty(zero), zero=0; end;
if isempty(rcost), rcost=0; end;
if isempty(pagepl), pagepl=false; end;
if isempty(trans), trans=false; end;
%***FIRST EXECUTABLE STATEMENT  SPINCW
lpg = fix(lmx -(nvars+4));
zero = 0.;
one = 1.;
%
%     FORM REDUCED COSTS, RZ(*), AND STEEPEST EDGE WEIGHTS, RG(*).
pagepl = true;
rz(1) = zero;
rz_orig=rz;    [dumvar1,rz,dumvar3,dumvar4]=scopy(nvars+mrelas,rz,0,rz,1);    rz(dumvar4~=rz_orig)=dumvar4(dumvar4~=rz_orig);
rg(1) = one;
rg_orig=rg;    [dumvar1,rg,dumvar3,dumvar4]=scopy(nvars+mrelas,rg,0,rg,1);    rg(dumvar4~=rg_orig)=dumvar4(dumvar4~=rg_orig);
nnegrc = 0;
j = fix(jstrt);
while( true );
if( ibb(j)<=0 )
pagepl = true;
%
%     THESE ARE NONBASIC INDEPENDENT VARIABLES. THE COLS. ARE IN SPARSE
%     MATRIX FORMAT.
elseif( j>nvars ) ;
pagepl = true;
ww(1) = zero;
ww_orig=ww;    [mrelas,ww,dumvar3,dumvar4]=scopy(mrelas,ww,0,ww,1);    ww(dumvar4~=ww_orig)=dumvar4(dumvar4~=ww_orig);
scalr = -one;
if( ind(j)==2 )
scalr = one;
end;
i = fix(j - nvars);
rz(j) = -scalr.*duals(i);
ww(i) = scalr;
if( stpedg )
trans = false;
[basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans]=la05bs(basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans);
rg(j) = sdot(mrelas,ww,1,ww,1) + one;
end;
else;
rzj = costsc.*costs(j);
ww(1) = zero;
ww_orig=ww;    [mrelas,ww,dumvar3,dumvar4]=scopy(mrelas,ww,0,ww,1);    ww(dumvar4~=ww_orig)=dumvar4(dumvar4~=ww_orig);
if( j==1 )
ilow = fix(nvars + 5);
else;
ilow = fix(imat(j+3) + 1);
end;
if( pagepl )
[il1 ,ilow,amat,imat]=iploc(ilow,amat,imat);
if( il1>=lmx-1 )
ilow = fix(ilow + 2);
[il1 ,ilow,amat,imat]=iploc(ilow,amat,imat);
end;
ipage = fix(abs(imat(lmx-1)));
else;
il1 = fix(ihi + 1);
end;
ihi = fix(imat(j+4) -(ilow-il1));
while( true );
iu1 = fix(min(lmx-2,ihi));
if( il1>iu1 )
break;
end;
for i = il1 : iu1;
rzj = rzj - amat(i).*duals(imat(i));
ww(imat(i)) = amat(i).*csc(j);
end; i = fix(iu1+1);
if( ihi<=lmx-2 )
break;
end;
ipage = fix(ipage + 1);
key = 1;
[key,ipage,lpg,amat,imat]=prwpge(key,ipage,lpg,amat,imat);
il1 = fix(nvars + 5);
ihi = fix(ihi - lpg);
end;
pagepl = ihi==(lmx-2);
rz(j) = rzj.*csc(j);
if( stpedg )
trans = false;
[basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans]=la05bs(basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans);
%
%     THESE ARE NONBASIC DEPENDENT VARIABLES. THE COLS. ARE IMPLICITLY
%     DEFINED.
rg(j) = sdot(mrelas,ww,1,ww,1) + one;
end;
end;
%
rcost = rz(j);
if( rem(ibb(j),2)==0 )
rcost = -rcost;
end;
if( ind(j)==4 )
rcost = -abs(rcost);
end;
cnorm = one;
if( j<=nvars )
cnorm = colnrm(j);
end;
if( rcost+erdnrm.*dulnrm.*cnorm<zero )
nnegrc = fix(nnegrc + 1);
end;
j = fix(rem(j,mrelas+nvars) + 1);
if( nnegrc>=npp || j==jstrt )
break;
end;
end;
jstrt = fix(j);
ibasis_shape=zeros(ibasis_shape);ibasis_shape(:)=ibasis(1:numel(ibasis_shape));ibasis=ibasis_shape;
imat_shape=zeros(imat_shape);imat_shape(:)=imat(1:numel(imat_shape));imat=imat_shape;
ibrc_orig(1:prod(ibrc_shape))=ibrc;ibrc=ibrc_orig;
ipr_shape=zeros(ipr_shape);ipr_shape(:)=ipr(1:numel(ipr_shape));ipr=ipr_shape;
iwr_shape=zeros(iwr_shape);iwr_shape(:)=iwr(1:numel(iwr_shape));iwr=iwr_shape;
ind_shape=zeros(ind_shape);ind_shape(:)=ind(1:numel(ind_shape));ind=ind_shape;
ibb_shape=zeros(ibb_shape);ibb_shape(:)=ibb(1:numel(ibb_shape));ibb=ibb_shape;
amat_shape=zeros(amat_shape);amat_shape(:)=amat(1:numel(amat_shape));amat=amat_shape;
basmat_shape=zeros(basmat_shape);basmat_shape(:)=basmat(1:numel(basmat_shape));basmat=basmat_shape;
csc_shape=zeros(csc_shape);csc_shape(:)=csc(1:numel(csc_shape));csc=csc_shape;
wr_shape=zeros(wr_shape);wr_shape(:)=wr(1:numel(wr_shape));wr=wr_shape;
ww_shape=zeros(ww_shape);ww_shape(:)=ww(1:numel(ww_shape));ww=ww_shape;
rz_shape=zeros(rz_shape);rz_shape(:)=rz(1:numel(rz_shape));rz=rz_shape;
rg_shape=zeros(rg_shape);rg_shape(:)=rg(1:numel(rg_shape));rg=rg_shape;
costs_shape=zeros(costs_shape);costs_shape(:)=costs(1:numel(costs_shape));costs=costs_shape;
colnrm_shape=zeros(colnrm_shape);colnrm_shape(:)=colnrm(1:numel(colnrm_shape));colnrm=colnrm_shape;
duals_shape=zeros(duals_shape);duals_shape(:)=duals(1:numel(duals_shape));duals=duals_shape;
end %subroutine spincw
%DECK SPINIT

Contact us