Télécharger la plaquette Cast3M


fr en

Télécharger rperm.eso

Retour à la liste

Numérotation des lignes : 

rperm

  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.  
  94.  

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