Esope source files

   1 : C IVPERM    SOURCE    CHAT      05/01/13    00:45:44     5004           
   2 :       SUBROUTINE IVPERM (N, IX, PERM) 
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C***********************************************************************
   6 : C NOM         : IVPERM
   7 : C DESCRIPTION : Permutation d'un tableau d'entiers.
   8 : C
   9 : C
  10 : C LANGAGE     : FORTRAN 77
  11 : C ADAPTATION  :  Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12 : C                mél : gounand@semt2.smts.cea.fr
  13 : C AUTEUR      :
  14 : C  Sparskit : a basic tool kit for sparse matrix computations
  15 : C  Version 2 (Youcef Saad)
  16 : C  -> URL : http://www.cs.umn.edu/Research/arpa/SPARSKIT/sparskit.html
  17 : C
  18 : C***********************************************************************
  19 :       INTEGER N, PERM(N), IX(N)
  20 : c-----------------------------------------------------------------------
  21 : c this subroutine performs an in-place permutation of an integer vector 
  22 : c ix according to the permutation array perm(*), i.e., on return, 
  23 : c the vector x satisfies,
  24 : c
  25 : c       ix(perm(j)) :== ix(j), j=1,2,.., n
  26 : c
  27 : c-----------------------------------------------------------------------
  28 : c on entry:
  29 : c---------
  30 : c n     = length of vector x.
  31 : c perm  = integer array of length n containing the permutation  array.
  32 : c ix    = input vector
  33 : c
  34 : c on return:
  35 : c---------- 
  36 : c ix    = vector x permuted according to ix(perm(*)) :=  ix(*)
  37 : c
  38 : c----------------------------------------------------------------------c
  39 : c           Y. Saad, Sep. 21 1989                                      c
  40 : c----------------------------------------------------------------------c
  41 : c local variables
  42 :       INTEGER TMP, TMP1
  43 :       INTEGER II,J,K,INIT,NEXT
  44 : c
  45 :       INIT      = 1
  46 :       TMP       = IX(INIT)      
  47 :       II        = PERM(INIT)
  48 :       PERM(INIT)= -PERM(INIT)
  49 :       K         = 0
  50 : c     
  51 : c loop
  52 : c 
  53 :  6    CONTINUE
  54 :       K = K+1
  55 : c
  56 : c save the chased element --
  57 : c 
  58 :       TMP1        = IX(II) 
  59 :       IX(II)     = TMP
  60 :       NEXT        = PERM(II) 
  61 :       IF (NEXT .LT. 0 ) GOTO 65
  62 : c     
  63 : c test for end 
  64 : c
  65 :       IF (K .GT. N) GOTO 101
  66 :       TMP       = TMP1
  67 :       PERM(II)  = - PERM(II)
  68 :       II        = NEXT 
  69 : c
  70 : c end loop 
  71 : c
  72 :       GOTO 6
  73 : c
  74 : c reinitialize cycle --
  75 : c
  76 :  65   CONTINUE
  77 :       INIT      = INIT+1
  78 :       IF (INIT .GT. N) GOTO 101
  79 :       IF (PERM(INIT) .LT. 0) GOTO 65
  80 :       TMP       = IX(INIT)
  81 :       II        = PERM(INIT)
  82 :       PERM(INIT)=-PERM(INIT)
  83 :       GOTO 6
  84 : c     
  85 :  101  CONTINUE
  86 :       DO 200 J=1, N
  87 :          PERM(J) = -PERM(J)
  88 :  200  CONTINUE 
  89 : C     
  90 :       RETURN
  91 : c-------------------end-of-ivperm--------------------------------------- 
  92 : c-----------------------------------------------------------------------
  93 :       END
  94 :  
  95 :