[x,n,iperm,ier]=spperm(x,n,iperm,ier);

function [x,n,iperm,ier]=spperm(x,n,iperm,ier);
%***BEGIN PROLOGUE  SPPERM
%***PURPOSE  Rearrange a given array according to a prescribed
%            permutation vector.
%***LIBRARY   SLATEC
%***CATEGORY  N8
%***TYPE      SINGLE PRECISION (SPPERM-S, DPPERM-D, IPPERM-I, HPPERM-H)
%***KEYWORDS  APPLICATION OF PERMUTATION TO DATA VECTOR
%***AUTHOR  McClain, M. A., (NIST)
%           Rhoads, G. S., (NBS)
%***DESCRIPTION
%
%         SPPERM rearranges the data vector X according to the
%         permutation IPERM: X(I) <--- X(IPERM(I)).  IPERM could come
%         from one of the sorting routines IPSORT, SPSORT, DPSORT or
%         HPSORT.
%
%     Description of Parameters
%         X - input/output -- real array of values to be rearranged.
%         N - input -- number of values in real array X.
%         IPERM - input -- permutation vector.
%         IER - output -- error indicator:
%             =  0  if no error,
%             =  1  if N is zero or negative,
%             =  2  if IPERM is not a valid permutation.
%
%***REFERENCES  (NONE)
%***ROUTINES CALLED  XERMSG
%***REVISION HISTORY  (YYMMDD)
%   901004  DATE WRITTEN
%   920507  Modified by M. McClain to revise prologue text.
%***end PROLOGUE  SPPERM
persistent i indx indx0 istrt temp ; 

iperm_shape=size(iperm);iperm=reshape(iperm,1,[]);
if isempty(i), i=0; end;
if isempty(indx), indx=0; end;
if isempty(indx0), indx0=0; end;
if isempty(istrt), istrt=0; end;
x_shape=size(x);x=reshape(x,1,[]);
if isempty(temp), temp=0; end;
%***FIRST EXECUTABLE STATEMENT  SPPERM
ier = 0;
if( n<1 )
ier = 1;
[dumvar1,dumvar2,dumvar3,ier]=xermsg('SLATEC','SPPERM','The number of values to be rearranged, N, is not positive.',ier,1);
iperm_shape=zeros(iperm_shape);iperm_shape(:)=iperm(1:numel(iperm_shape));iperm=iperm_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
return;
end;
%
%     CHECK WHETHER IPERM IS A VALID PERMUTATION
%
for i = 1 : n;
indx = fix(abs(iperm(i)));
if((indx>=1) &&(indx<=n) )
if( iperm(indx)>0 )
iperm(indx) = fix(-iperm(indx));
continue;
end;
end;
ier = 2;
[dumvar1,dumvar2,dumvar3,ier]=xermsg('SLATEC','SPPERM','The permutation vector, IPERM, is not valid.',ier,1);
iperm_shape=zeros(iperm_shape);iperm_shape(:)=iperm(1:numel(iperm_shape));iperm=iperm_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
return;
end; i = fix(n+1);
%
%     REARRANGE THE VALUES OF X
%
%     use THE IPERM VECTOR AS A FLAG.
%     IF IPERM(I) > 0, THEN THE I-TH VALUE IS IN CORRECT LOCATION
%
for istrt = 1 : n;
if( iperm(istrt)<=0 )
indx = fix(istrt);
indx0 = fix(indx);
temp = x(istrt);
while( iperm(indx)<0 );
x(indx) = x(-iperm(indx));
indx0 = fix(indx);
iperm(indx) = fix(-iperm(indx));
indx = fix(iperm(indx));
end;
x(indx0) = temp;
end;
end; istrt = fix(n+1);
iperm_shape=zeros(iperm_shape);iperm_shape(:)=iperm(1:numel(iperm_shape));iperm=iperm_shape;
x_shape=zeros(x_shape);x_shape(:)=x(1:numel(x_shape));x=x_shape;
return;
%
end %subroutine spperm
%DECK SPPFA