Télécharger la plaquette Cast3M


fr en

Télécharger ivperm.eso

Retour à la liste

Numérotation des lignes : 

ivperm

  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.  
  96.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales