Télécharger dvperm.eso

Retour à la liste

Numérotation des lignes :

  1. C DVPERM SOURCE CHAT 05/01/12 22:59:02 5004
  2. SUBROUTINE DVPERM (N, X, 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 de réels.
  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)
  20. REAL*8 X(N)
  21. c-----------------------------------------------------------------------
  22. c this subroutine performs an in-place permutation of a real vector x
  23. c according to the permutation array perm(*), i.e., on return,
  24. c the vector x satisfies,
  25. c
  26. c x(perm(j)) :== x(j), j=1,2,.., n
  27. c
  28. c-----------------------------------------------------------------------
  29. c on entry:
  30. c---------
  31. c n = length of vector x.
  32. c perm = integer array of length n containing the permutation array.
  33. c x = input vector
  34. c
  35. c on return:
  36. c----------
  37. c x = vector x permuted according to x(perm(*)) := x(*)
  38. c
  39. c----------------------------------------------------------------------c
  40. c Y. Saad, Sep. 21 1989 c
  41. c----------------------------------------------------------------------c
  42. c local variables
  43. REAL*8 TMP, TMP1
  44. INTEGER II,J,K,INIT,NEXT
  45. c
  46. INIT = 1
  47. TMP = X(INIT)
  48. II = PERM(INIT)
  49. PERM(INIT)= -PERM(INIT)
  50. K = 0
  51. c
  52. c loop
  53. c
  54. 6 CONTINUE
  55. K = K+1
  56. c
  57. c save the chased element --
  58. c
  59. TMP1 = X(II)
  60. X(II) = TMP
  61. NEXT = PERM(II)
  62. IF (NEXT .LT. 0 ) GOTO 65
  63. c
  64. c test for end
  65. c
  66. IF (K .GT. N) GOTO 101
  67. TMP = TMP1
  68. PERM(II) = - PERM(II)
  69. II = NEXT
  70. c
  71. c end loop
  72. c
  73. GOTO 6
  74. c
  75. c reinitilaize cycle --
  76. c
  77. 65 INIT = INIT+1
  78. IF (INIT .GT. N) GOTO 101
  79. IF (PERM(INIT) .LT. 0) GOTO 65
  80. TMP = X(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-dvperm---------------------------------------
  92. c-----------------------------------------------------------------------
  93. END
  94.  
  95.  
  96.  

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