Esope source files

   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 
 110 :          CALL IVPERM (NNZ, JA(IFIRST), IWORK) 
 110 :          IF (VALUES) CALL DVPERM (NNZ, A(IFIRST), IWORK) 
 111 : c
 112 : c reshift the pointers of the original matrix back.
 113 : c 
 114 :       DO 8 I=N,1,-1
 115 :          IA(I+1) = IA(I)
 116 :  8    CONTINUE
 117 :       IA(1) = IFIRST 
 118 : c
 119 :       RETURN 
 120 : c---------------end-of-csort-------------------------------------------- 
 121 : c-----------------------------------------------------------------------
 122 :       END
 123 :  
 124 :