[mrelas,nvars,lmx,lbm,ienter,ibasis,imat,ibrc,ipr,iwr,ind,ibb,erdnrm,eps,gg,dulnrm,dirnrm,amat,basmat,csc,wr,ww,bl,bu,rz,rg,colnrm,duals,found]=dplpfe(mrelas,nvars,lmx,lbm,ienter,ibasis,imat,ibrc,ipr,iwr,ind,ibb,erdnrm,eps,gg,dulnrm,dirnrm,amat,basmat,csc

function [mrelas,nvars,lmx,lbm,ienter,ibasis,imat,ibrc,ipr,iwr,ind,ibb,erdnrm,eps,gg,dulnrm,dirnrm,amat,basmat,csc,wr,ww,bl,bu,rz,rg,colnrm,duals,found]=dplpfe(mrelas,nvars,lmx,lbm,ienter,ibasis,imat,ibrc,ipr,iwr,ind,ibb,erdnrm,eps,gg,dulnrm,dirnrm,amat,basmat,csc,wr,ww,bl,bu,rz,rg,colnrm,duals,found);
persistent cnorm i ihi il1 ilow ipage iu1 j key lpg n20002 n20050 one ratio rcost rmax trans zero ; 

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(n20002), n20002=0; end;
if isempty(n20050), n20050=0; end;
%***BEGIN PROLOGUE  DPLPFE
%***SUBSIDIARY
%***PURPOSE  Subsidiary to DSPLP
%***LIBRARY   SLATEC
%***TYPE      doubleprecision (SPLPFE-S, DPLPFE-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/,/SASUM/DASUM/,
%     /SCOPY/DCOPY/.
%
%     THIS SUBPROGRAM IS PART OF THE DSPLP( ) PACKAGE.
%     IT IMPLEMENTS THE PROCEDURE (FIND VARIABLE TO ENTER BASIS
%     AND GET SEARCH DIRECTION).
%     REVISED 811130-1100
%     REVISED YYMMDD-HHMM
%
%***SEE ALSO  DSPLP
%***ROUTINES CALLED  DASUM, DCOPY, DPRWPG, IDLOC, LA05BD
%***REVISION HISTORY  (YYMMDD)
%   811215  DATE WRITTEN
%   890531  Changed all specific intrinsics to generic.  (WRB)
%   890605  Removed unreferenced labels.  (WRB)
%   890606  Changed references from IPLOC to IDLOC.  (WRB)
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900328  Added TYPE section.  (WRB)
%***end PROLOGUE  DPLPFE
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,[]);
bl_shape=size(bl);bl=reshape(bl,1,[]);
bu_shape=size(bu);bu=reshape(bu,1,[]);
rz_shape=size(rz);rz=reshape(rz,1,[]);
rg_shape=size(rg);rg=reshape(rg,1,[]);
colnrm_shape=size(colnrm);colnrm=reshape(colnrm,1,[]);
duals_shape=size(duals);duals=reshape(duals,1,[]);
if isempty(cnorm), cnorm=0; end;
if isempty(one), one=0; end;
if isempty(ratio), ratio=0; end;
if isempty(rcost), rcost=0; end;
if isempty(rmax), rmax=0; end;
if isempty(zero), zero=0; end;
if isempty(trans), trans=false; end;
%***FIRST EXECUTABLE STATEMENT  DPLPFE
lpg = fix(lmx -(nvars+4));
zero = 0.0d0;
one = 1.0d0;
rmax = zero;
found = false;
i = fix(mrelas + 1);
n20002 = fix(mrelas + nvars);
while((n20002-i)>=0 );
j = fix(ibasis(i));
%
%     IF J=IBASIS(I) .LT. 0 THEN THE VARIABLE LEFT AT A ZERO LEVEL
%     AND IS NOT CONSIDERED AS A CANDIDATE TO ENTER.
while (1);
if( j>0 )
%
%     DO NOT CONSIDER VARIABLES CORRESPONDING TO UNBOUNDED STEP LENGTHS.
if( ibb(j)~=0 )
%
%     IF A VARIABLE CORRESPONDS TO AN EQUATION(IND=3 AND BL=BU),
%     THEN DO NOT CONSIDER IT AS A CANDIDATE TO ENTER.
if( ind(j)==3 )
if((bu(j)-bl(j))<=eps.*(abs(bl(j))+abs(bu(j))) )
break;
end;
end;
rcost = rz(j);
%
%     IF VARIABLE IS AT UPPER BOUND IT CAN ONLY DECREASE.  THIS
%     ACCOUNTS FOR THE POSSIBLE CHANGE OF SIGN.
if( rem(ibb(j),2)==0 )
rcost = -rcost;
end;
%
%     IF THE VARIABLE IS FREE, USE THE NEGATIVE MAGNITUDE OF THE
%     REDUCED COST FOR THAT VARIABLE.
if( ind(j)==4 )
rcost = -abs(rcost);
end;
cnorm = one;
if( j<=nvars )
cnorm = colnrm(j);
end;
%
%     TEST FOR NEGATIVITY OF REDUCED COSTS.
if( rcost+erdnrm.*dulnrm.*cnorm<zero )
found = true;
ratio = rcost.^2./rg(j);
if( ratio>rmax )
rmax = ratio;
ienter = fix(i);
end;
end;
end;
end;
break;
end;
i = fix(i + 1);
end;
if( found )
j = fix(ibasis(ienter));
ww(1) = zero;
ww_orig=ww;    [mrelas,ww,dumvar3,dumvar4]=dcopy(mrelas,ww,0,ww,1);    ww(dumvar4~=ww_orig)=dumvar4(dumvar4~=ww_orig);
if( j<=nvars )
if( j==1 )
ilow = fix(nvars + 5);
else;
ilow = fix(imat(j+3) + 1);
end;
[il1 ,ilow,amat,imat]=idloc(ilow,amat,imat);
if( il1>=lmx-1 )
ilow = fix(ilow + 2);
[il1 ,ilow,amat,imat]=idloc(ilow,amat,imat);
end;
ipage = fix(abs(imat(lmx-1)));
ihi = fix(imat(j+4) -(ilow-il1));
while( true );
iu1 = fix(min(lmx-2,ihi));
if( il1>iu1 )
break;
end;
for i = il1 : iu1;
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]=dprwpg(key,ipage,lpg,amat,imat);
il1 = fix(nvars + 5);
ihi = fix(ihi - lpg);
end;
elseif( ind(j)==2 ) ;
ww(j-nvars) = one;
else;
ww(j-nvars) = -one;
end;
%
%     COMPUTE SEARCH DIRECTION.
trans = false;
[basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans]=la05bd(basmat,ibrc,lbm,mrelas,ipr,iwr,wr,gg,ww,trans);
%
%     THE SEARCH DIRECTION REQUIRES THE FOLLOWING SIGN CHANGE IF EITHER
%     VARIABLE ENTERING IS AT ITS UPPER BOUND OR IS FREE AND HAS
%     POSITIVE REDUCED COST.
if( rem(ibb(j),2)==0 ||(ind(j)==4 && rz(j)>zero) )
i = 1;
n20050 = fix(mrelas);
while((n20050-i)>=0 );
ww(i) = -ww(i);
i = fix(i + 1);
end;
end;
[dirnrm ,mrelas,ww]=dasum(mrelas,ww,1);
%
%     COPY CONTENTS OF WR(*) TO DUALS(*) FOR USE IN
%     ADD-DROP (EXCHANGE) STEP, LA05CD( ).
[mrelas,wr,dumvar3,duals]=dcopy(mrelas,wr,1,duals,1);
end;
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;
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;
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;
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 dplpfe
%DECK DPLPFL