1*DECK SPPERM 2 SUBROUTINE SPPERM (X, N, IPERM, IER) 3C***BEGIN PROLOGUE SPPERM 4C***PURPOSE Rearrange a given array according to a prescribed 5C permutation vector. 6C***LIBRARY SLATEC 7C***CATEGORY N8 8C***TYPE SINGLE PRECISION (SPPERM-S, DPPERM-D, IPPERM-I, HPPERM-H) 9C***KEYWORDS APPLICATION OF PERMUTATION TO DATA VECTOR 10C***AUTHOR McClain, M. A., (NIST) 11C Rhoads, G. S., (NBS) 12C***DESCRIPTION 13C 14C SPPERM rearranges the data vector X according to the 15C permutation IPERM: X(I) <--- X(IPERM(I)). IPERM could come 16C from one of the sorting routines IPSORT, SPSORT, DPSORT or 17C HPSORT. 18C 19C Description of Parameters 20C X - input/output -- real array of values to be rearranged. 21C N - input -- number of values in real array X. 22C IPERM - input -- permutation vector. 23C IER - output -- error indicator: 24C = 0 if no error, 25C = 1 if N is zero or negative, 26C = 2 if IPERM is not a valid permutation. 27C 28C***REFERENCES (NONE) 29C***ROUTINES CALLED XERMSG 30C***REVISION HISTORY (YYMMDD) 31C 901004 DATE WRITTEN 32C 920507 Modified by M. McClain to revise prologue text. 33C***END PROLOGUE SPPERM 34 INTEGER N, IPERM(*), I, IER, INDX, INDX0, ISTRT 35 REAL X(*), TEMP 36C***FIRST EXECUTABLE STATEMENT SPPERM 37 IER=0 38 IF(N.LT.1)THEN 39 IER=1 40 CALL XERMSG ('SLATEC', 'SPPERM', 41 + 'The number of values to be rearranged, N, is not positive.', 42 + IER, 1) 43 RETURN 44 ENDIF 45C 46C CHECK WHETHER IPERM IS A VALID PERMUTATION 47C 48 DO 100 I=1,N 49 INDX=ABS(IPERM(I)) 50 IF((INDX.GE.1).AND.(INDX.LE.N))THEN 51 IF(IPERM(INDX).GT.0)THEN 52 IPERM(INDX)=-IPERM(INDX) 53 GOTO 100 54 ENDIF 55 ENDIF 56 IER=2 57 CALL XERMSG ('SLATEC', 'SPPERM', 58 + 'The permutation vector, IPERM, is not valid.', IER, 1) 59 RETURN 60 100 CONTINUE 61C 62C REARRANGE THE VALUES OF X 63C 64C USE THE IPERM VECTOR AS A FLAG. 65C IF IPERM(I) > 0, THEN THE I-TH VALUE IS IN CORRECT LOCATION 66C 67 DO 330 ISTRT = 1 , N 68 IF (IPERM(ISTRT) .GT. 0) GOTO 330 69 INDX = ISTRT 70 INDX0 = INDX 71 TEMP = X(ISTRT) 72 320 CONTINUE 73 IF (IPERM(INDX) .GE. 0) GOTO 325 74 X(INDX) = X(-IPERM(INDX)) 75 INDX0 = INDX 76 IPERM(INDX) = -IPERM(INDX) 77 INDX = IPERM(INDX) 78 GOTO 320 79 325 CONTINUE 80 X(INDX0) = TEMP 81 330 CONTINUE 82C 83 RETURN 84 END 85