| [iplocresult,locmlv,sx,ix]=iploc(locmlv,sx,ix); |
function [iplocresult,locmlv,sx,ix]=iploc(locmlv,sx,ix);
iplocresult=[];
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 IPLOC
%***SUBSIDIARY
%***PURPOSE Subsidiary to SPLP
%***LIBRARY SLATEC
%***TYPE SINGLE PRECISION (IPLOC-S, IDLOC-D)
%***KEYWORDS RELATIVE ADDRESS DETERMINATION FUNCTION, SLATEC
%***AUTHOR Hanson, R. J., (SNLA)
% Wisniewski, J. A., (SNLA)
%***DESCRIPTION
%
% Given a 'virtual' location, IPLOC 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 SPLP
%***ROUTINES CALLED PRWPGE, XERMSG
%***REVISION HISTORY (YYMMDD)
% 810306 DATE WRITTEN
% 890531 Changed all specific intrinsics to generic. (WRB)
% 890606 Restructured to match doubleprecision version. (WRB)
% 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 IPLOC to 0 if LOC is non-positive. (WRB)
%***end PROLOGUE IPLOC
sx_shape=size(sx);sx=reshape(sx,1,[]);
ix_shape=size(ix);ix=reshape(ix,1,[]);
%***FIRST EXECUTABLE STATEMENT IPLOC
if( locmlv<=0 )
xermsg('SLATEC','IPLOC','A value of LOC, the first argument, .LE. 0 was encountered',55,1);
iplocresult = 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 )
iplocresult = 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);
iplocresult = 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]=prwpge(key,np,lpg,sx,ix);
end;
key = 1;
[key,ipage,lpg,sx,ix]=prwpge(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 IPPERM
|
|