Télécharger la plaquette Cast3M


fr en

Télécharger csort.eso

Retour à la liste

Numérotation des lignes : 

csort

  1. C CSORT     SOURCE    CHAT      05/01/12    22:32:01     5004
  2.       SUBROUTINE CSORT(N,A,JA,IA,IWORK,VALUES)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM         : CSORT
  7. C DESCRIPTION : Ordonnancement du profil ou d'une matrice Morse.
  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.       LOGICAL VALUES
  20.       INTEGER N, JA(*), IA(N+1), IWORK(*)
  21.       REAL*8 A(*)
  22. c-----------------------------------------------------------------------
  23. c This routine sorts the elements of  a matrix (stored in Compressed
  24. c Sparse Row Format) in increasing order of their column indices within
  25. c each row. It uses a form of bucket sort with a cost of O(nnz) where
  26. c nnz = number of nonzero elements.
  27. c requires an integer work array of length 2*nnz.
  28. c-----------------------------------------------------------------------
  29. c on entry:
  30. c---------
  31. c n     = the row dimension of the matrix
  32. c a     = the matrix A in compressed sparse row format.
  33. c ja    = the array of column indices of the elements in array a.
  34. c ia    = the array of pointers to the rows.
  35. c iwork = integer work array of length max ( n+1, 2*nnz )
  36. c         where nnz = (ia(n+1)-ia(1))  ) .
  37. c values= logical indicating whether or not the real values a(*) must
  38. c         also be permuted. if (.not. values) then the array a is not
  39. c         touched by csort and can be a dummy array.
  40. c
  41. c on return:
  42. c----------
  43. c the matrix stored in the structure a, ja, ia is permuted in such a
  44. c way that the column indices are in increasing order within each row.
  45. c iwork(1:nnz) contains the permutation used  to rearrange the elements.
  46. c-----------------------------------------------------------------------
  47. c Y. Saad - Feb. 1, 1991.
  48. c-----------------------------------------------------------------------
  49. c local variables
  50.       INTEGER I, K, J, IFIRST, NNZ, NEXT
  51.       INTEGER IROW,KO
  52. c
  53. c count the number of elements in each column
  54. c
  55. * gounand : déjà fait
  56. *      DO 1 I=1,N+1
  57. *         IWORK(I) = 0
  58. * 1    CONTINUE
  59.       DO 3 I=1, N
  60.          DO 2 K=IA(I), IA(I+1)-1
  61.             J = JA(K)+1
  62.             IWORK(J) = IWORK(J)+1
  63.  2       CONTINUE
  64.  3    CONTINUE
  65. c
  66. c compute pointers from lengths.
  67. c
  68.       IWORK(1) = 1
  69.       DO 4 I=1,N
  70.          IWORK(I+1) = IWORK(I) + IWORK(I+1)
  71.  4    CONTINUE
  72. C
  73. C get the positions of the nonzero elements in order of columns.
  74. C
  75.       IFIRST = IA(1)
  76.       NNZ = IA(N+1)-IFIRST
  77.       DO 5 I=1,N
  78.          DO 51 K=IA(I),IA(I+1)-1
  79.             J = JA(K)
  80.             NEXT = IWORK(J)
  81.             IWORK(NNZ+NEXT) = K
  82.             IWORK(J) = NEXT+1
  83.  51      CONTINUE
  84.  5    CONTINUE
  85. c
  86. c convert to coordinate format
  87. c
  88.       DO 6 I=1, N
  89.          DO 61 K=IA(I), IA(I+1)-1
  90.             IWORK(K) = I
  91.  61      CONTINUE
  92.  6    CONTINUE
  93. c
  94. c loop to find permutation: for each element find the correct
  95. c position in (sorted) arrays a, ja. Record this in iwork.
  96. c
  97.       DO 7 K=1, NNZ
  98.          KO = IWORK(NNZ+K)
  99.          IROW = IWORK(KO)
  100.          NEXT = IA(IROW)
  101. c
  102. c the current element should go in next position in row. iwork
  103. c records this position.
  104. c
  105.          IWORK(KO) = NEXT
  106.          IA(IROW)  = NEXT+1
  107.  7       CONTINUE
  108. c
  109. c perform an in-place permutation of the  arrays.
  110. c
  111.          CALL IVPERM (NNZ, JA(IFIRST), IWORK)
  112.          IF (VALUES) CALL DVPERM (NNZ, A(IFIRST), IWORK)
  113. c
  114. c reshift the pointers of the original matrix back.
  115. c
  116.       DO 8 I=N,1,-1
  117.          IA(I+1) = IA(I)
  118.  8    CONTINUE
  119.       IA(1) = IFIRST
  120. c
  121.       RETURN
  122. c---------------end-of-csort--------------------------------------------
  123. c-----------------------------------------------------------------------
  124.       END
  125.  
  126.  
  127.  

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