Esope source files

   1 : C RPERM     SOURCE    CHAT      05/01/13    03:07:15     5004           
   2 :       SUBROUTINE RPERM (NROW,A,JA,IA,AO,JAO,IAO,PERM,JOB)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C***********************************************************************
   6 : C NOM         : RPERM
   7 : C DESCRIPTION : Permutation des lignes 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 :       INTEGER NROW,JA(*),IA(NROW+1),JAO(*),IAO(NROW+1),PERM(NROW),JOB
  20 :       REAL*8 A(*),AO(*) 
  21 : c-----------------------------------------------------------------------
  22 : c this subroutine permutes the rows of a matrix in CSR format. 
  23 : c rperm  computes B = P A  where P is a permutation matrix.  
  24 : c the permutation P is defined through the array perm: for each j, 
  25 : c perm(j) represents the destination row number of row number j. 
  26 : c Youcef Saad -- recoded Jan 28, 1991.
  27 : c-----------------------------------------------------------------------
  28 : c on entry:
  29 : c----------
  30 : c n     = dimension of the matrix
  31 : c a, ja, ia = input matrix in csr format
  32 : c perm  = integer array of length nrow containing the permutation arrays
  33 : c         for the rows: perm(i) is the destination of row i in the
  34 : c         permuted matrix. 
  35 : c         ---> a(i,j) in the original matrix becomes a(perm(i),j) 
  36 : c         in the output  matrix.
  37 : c
  38 : c job   = integer indicating the work to be done:
  39 : c               job = 1 permute a, ja, ia into ao, jao, iao 
  40 : c                       (including the copying of real values ao and
  41 : c                       the array iao).
  42 : c               job .ne. 1 :  ignore real values.
  43 : c                     (in which case arrays a and ao are not needed nor
  44 : c                      used).
  45 : c
  46 : c------------
  47 : c on return: 
  48 : c------------ 
  49 : c ao, jao, iao = input matrix in a, ja, ia format
  50 : c note : 
  51 : c        if (job.ne.1)  then the arrays a and ao are not used.
  52 : c----------------------------------------------------------------------c
  53 : c           Y. Saad, May  2, 1990                                      c
  54 : c----------------------------------------------------------------------c
  55 : C Local variables
  56 :       INTEGER I,II,J,K,KO
  57 :       LOGICAL VALUES
  58 :       VALUES = (JOB .EQ. 1) 
  59 : c     
  60 : c     determine pointers for output matix. 
  61 : c     
  62 :       DO 50 J=1,NROW
  63 :          I = PERM(J)
  64 :          IAO(I+1) = IA(J+1) - IA(J)
  65 :  50   CONTINUE
  66 : c
  67 : c get pointers from lengths
  68 : c
  69 :       IAO(1) = 1
  70 :       DO 51 J=1,NROW
  71 :          IAO(J+1)=IAO(J+1)+IAO(J)
  72 :  51   CONTINUE
  73 : c
  74 : c copying 
  75 : c
  76 :       DO 100 II=1,NROW
  77 : c
  78 : c old row = ii  -- new row = iperm(ii) -- ko = new pointer
  79 : c        
  80 :          KO = IAO(PERM(II)) 
  81 :          DO 60 K=IA(II), IA(II+1)-1 
  82 :             JAO(KO) = JA(K) 
  83 :             IF (VALUES) AO(KO) = A(K)
  84 :             KO = KO+1
  85 :  60      CONTINUE
  86 :  100  CONTINUE
  87 : c
  88 :       RETURN
  89 : c---------end-of-rperm ------------------------------------------------- 
  90 : c-----------------------------------------------------------------------
  91 :       END
  92 :  
  93 :