Télécharger ivperm.eso

Retour à la liste

Numérotation des lignes :

  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