[dx,n,iperm,ier]=dpperm(dx,n,iperm,ier);

function [dx,n,iperm,ier]=dpperm(dx,n,iperm,ier);
%***BEGIN PROLOGUE  DPPERM
%***PURPOSE  Rearrange a given array according to a prescribed
%            permutation vector.
%***LIBRARY   SLATEC
%***CATEGORY  N8
%***TYPE      doubleprecision (SPPERM-S, DPPERM-D, IPPERM-I, HPPERM-H)
%***KEYWORDS  PERMUTATION, REARRANGEMENT
%***AUTHOR  McClain, M. A., (NIST)
%           Rhoads, G. S., (NBS)
%***DESCRIPTION
%
%         DPPERM rearranges the data vector DX according to the
%         permutation IPERM: DX(I) <--- DX(IPERM(I)).  IPERM could come
%         from one of the sorting routines IPSORT, SPSORT, DPSORT or
%         HPSORT.
%
%     Description of Parameters
%         DX - input/output -- doubleprecision array of values to be
%                   rearranged.
%         N - input -- number of values in doubleprecision array DX.
%         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  DPPERM
persistent dtemp i indx indx0 istrt ; 

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;
dx_shape=size(dx);dx=reshape(dx,1,[]);
if isempty(dtemp), dtemp=0; end;
%***FIRST EXECUTABLE STATEMENT  DPPERM
ier = 0;
if( n<1 )
ier = 1;
[dumvar1,dumvar2,dumvar3,ier]=xermsg('SLATEC','DPPERM','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;
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_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','DPPERM','The permutation vector, IPERM, is not valid.',ier,1);
iperm_shape=zeros(iperm_shape);iperm_shape(:)=iperm(1:numel(iperm_shape));iperm=iperm_shape;
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
return;
end; i = fix(n+1);
%
%     REARRANGE THE VALUES OF DX
%
%     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);
dtemp = dx(istrt);
while( iperm(indx)<0 );
dx(indx) = dx(-iperm(indx));
indx0 = fix(indx);
iperm(indx) = fix(-iperm(indx));
indx = fix(iperm(indx));
end;
dx(indx0) = dtemp;
end;
end; istrt = fix(n+1);
%
iperm_shape=zeros(iperm_shape);iperm_shape(:)=iperm(1:numel(iperm_shape));iperm=iperm_shape;
dx_shape=zeros(dx_shape);dx_shape(:)=dx(1:numel(dx_shape));dx=dx_shape;
end %subroutine dpperm
%DECK DPPFA