Numérotation des lignes :

dvperm
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