← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/spperm.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/spperm.f
 
1
*DECK SPPERM
 
2
      SUBROUTINE SPPERM (X, N, IPERM, IER)
 
3
C***BEGIN PROLOGUE  SPPERM
 
4
C***PURPOSE  Rearrange a given array according to a prescribed
 
5
C            permutation vector.
 
6
C***LIBRARY   SLATEC
 
7
C***CATEGORY  N8
 
8
C***TYPE      SINGLE PRECISION (SPPERM-S, DPPERM-D, IPPERM-I, HPPERM-H)
 
9
C***KEYWORDS  APPLICATION OF PERMUTATION TO DATA VECTOR
 
10
C***AUTHOR  McClain, M. A., (NIST)
 
11
C           Rhoads, G. S., (NBS)
 
12
C***DESCRIPTION
 
13
C
 
14
C         SPPERM rearranges the data vector X according to the
 
15
C         permutation IPERM: X(I) <--- X(IPERM(I)).  IPERM could come
 
16
C         from one of the sorting routines IPSORT, SPSORT, DPSORT or
 
17
C         HPSORT.
 
18
C
 
19
C     Description of Parameters
 
20
C         X - input/output -- real array of values to be rearranged.
 
21
C         N - input -- number of values in real array X.
 
22
C         IPERM - input -- permutation vector.
 
23
C         IER - output -- error indicator:
 
24
C             =  0  if no error,
 
25
C             =  1  if N is zero or negative,
 
26
C             =  2  if IPERM is not a valid permutation.
 
27
C
 
28
C***REFERENCES  (NONE)
 
29
C***ROUTINES CALLED  XERMSG
 
30
C***REVISION HISTORY  (YYMMDD)
 
31
C   901004  DATE WRITTEN
 
32
C   920507  Modified by M. McClain to revise prologue text.
 
33
C***END PROLOGUE  SPPERM
 
34
      INTEGER N, IPERM(*), I, IER, INDX, INDX0, ISTRT
 
35
      REAL X(*), TEMP
 
36
C***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
 
45
C
 
46
C     CHECK WHETHER IPERM IS A VALID PERMUTATION
 
47
C
 
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
 
61
C
 
62
C     REARRANGE THE VALUES OF X
 
63
C
 
64
C     USE THE IPERM VECTOR AS A FLAG.
 
65
C     IF IPERM(I) > 0, THEN THE I-TH VALUE IS IN CORRECT LOCATION
 
66
C
 
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
 
82
C
 
83
      RETURN
 
84
      END