[idlocresult,locmlv,sx,ix]=idloc(locmlv,sx,ix);

function [idlocresult,locmlv,sx,ix]=idloc(locmlv,sx,ix);
idlocresult=[];
persistent ipage itemp k key lmx lmxm1 lpg np ; 

;
if isempty(ipage), ipage=0; end;
if isempty(itemp), itemp=0; end;
if isempty(k), k=0; end;
if isempty(key), key=0; end;
if isempty(lmx), lmx=0; end;
if isempty(lmxm1), lmxm1=0; end;
if isempty(lpg), lpg=0; end;
if isempty(np), np=0; end;
%***BEGIN PROLOGUE  IDLOC
%***SUBSIDIARY
%***PURPOSE  Subsidiary to DSPLP
%***LIBRARY   SLATEC
%***TYPE      doubleprecision (IPLOC-S, IDLOC-D)
%***KEYWORDS  RELATIVE ADDRESS DETERMINATION FUNCTION, SLATEC
%***AUTHOR  Boland, W. Robert, (LANL)
%           Nicol, Tom, (University of British Columbia)
%***DESCRIPTION
%
%   Given a 'virtual' location,  IDLOC returns the relative working
%   address of the vector component stored in SX, IX.  Any necessary
%   page swaps are performed automatically for the user in this
%   function subprogram.
%
%   LOC       is the 'virtual' address of the data to be retrieved.
%   SX ,IX    represent the matrix where the data is stored.
%
%***SEE ALSO  DSPLP
%***ROUTINES CALLED  DPRWPG, XERMSG
%***REVISION HISTORY  (YYMMDD)
%   890606  DATE WRITTEN
%   890606  REVISION DATE from Version 3.2
%   891214  Prologue converted to Version 4.0 format.  (BAB)
%   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
%   910731  Added code to set IDLOC to 0 if LOC is non-positive.  (WRB)
%***end PROLOGUE  IDLOC
sx_shape=size(sx);sx=reshape(sx,1,[]);
ix_shape=size(ix);ix=reshape(ix,1,[]);
%***FIRST EXECUTABLE STATEMENT  IDLOC
if( locmlv<=0 )
xermsg('SLATEC','IDLOC','A value of LOC, the first argument, .LE. 0 was encountered',55,1);
idlocresult = 0;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',sx); evalin('caller',[inputname(2),'=FUntemp;']); end
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',locmlv); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',ix); evalin('caller',[inputname(3),'=FUntemp;']); end
return;
end;
%
%     Two cases exist:  (1.LE.LOC.LE.K) .OR. (LOC.GT.K).
%
k = fix(ix(3) + 4);
lmx = fix(ix(1));
lmxm1 = fix(lmx - 1);
if( locmlv<=k )
idlocresult = locmlv;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',sx); evalin('caller',[inputname(2),'=FUntemp;']); end
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',locmlv); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',ix); evalin('caller',[inputname(3),'=FUntemp;']); end
return;
end;
%
%     Compute length of the page, starting address of the page, page
%     number and relative working address.
%
lpg = fix(lmx - k);
itemp = fix(locmlv - k - 1);
ipage = fix(fix(itemp./lpg) + 1);
idlocresult = rem(itemp,lpg) + k + 1;
np = fix(abs(ix(lmxm1)));
%
%     Determine if a page fault has occurred.  If so, write page NP
%     and read page IPAGE.  Write the page only if it has been
%     modified.
%
if( ipage~=np )
if( sx(lmx)==1.0 )
sx(lmx) = 0.0;
key = 2;
[key,np,lpg,sx,ix]=dprwpg(key,np,lpg,sx,ix);
end;
key = 1;
[key,ipage,lpg,sx,ix]=dprwpg(key,ipage,lpg,sx,ix);
end;
sx_shape=zeros(sx_shape);sx_shape(:)=sx(1:numel(sx_shape));sx=sx_shape;
ix_shape=zeros(ix_shape);ix_shape(:)=ix(1:numel(ix_shape));ix=ix_shape;
csnil=dbstack(1); csnil=csnil(1).name(1)~='@';
if csnil&&~isempty(inputname(2)), assignin('caller','FUntemp',sx); evalin('caller',[inputname(2),'=FUntemp;']); end
if csnil&&~isempty(inputname(1)), assignin('caller','FUntemp',locmlv); evalin('caller',[inputname(1),'=FUntemp;']); end
if csnil&&~isempty(inputname(3)), assignin('caller','FUntemp',ix); evalin('caller',[inputname(3),'=FUntemp;']); end
end
%DECK IMTQL1