Numérotation des lignes :

C DVPERM    SOURCE    CHAT      05/01/12    22:59:02     5004      SUBROUTINE DVPERM (N, X, PERM)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C***********************************************************************C NOM         : IVPERMC DESCRIPTION : Permutation d'un tableau de réels.CCC LANGAGE     : FORTRAN 77C ADAPTATION  :  Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)C                mél : gounand@semt2.smts.cea.frC AUTEUR      :C  Sparskit : a basic tool kit for sparse matrix computationsC  Version 2 (Youcef Saad)C  -> URL : http://www.cs.umn.edu/Research/arpa/SPARSKIT/sparskit.htmlCC***********************************************************************      INTEGER N, PERM(N)      REAL*8 X(N)c-----------------------------------------------------------------------c this subroutine performs an in-place permutation of a real vector xc according to the permutation array perm(*), i.e., on return,c the vector x satisfies,cc       x(perm(j)) :== x(j), j=1,2,.., ncc-----------------------------------------------------------------------c on entry:c---------c n     = length of vector x.c perm  = integer array of length n containing the permutation  array.c x     = input vectorcc on return:c----------c x     = vector x permuted according to x(perm(*)) :=  x(*)cc----------------------------------------------------------------------cc           Y. Saad, Sep. 21 1989                                      cc----------------------------------------------------------------------cc local variables      REAL*8 TMP, TMP1      INTEGER II,J,K,INIT,NEXTc      INIT      = 1      TMP       = X(INIT)      II        = PERM(INIT)      PERM(INIT)= -PERM(INIT)      K         = 0cc loopc 6    CONTINUE      K = K+1cc save the chased element --c      TMP1        = X(II)      X(II)     = TMP      NEXT        = PERM(II)      IF (NEXT .LT. 0 ) GOTO 65cc test for endc      IF (K .GT. N) GOTO 101      TMP       = TMP1      PERM(II)  = - PERM(II)      II        = NEXTcc end loopc      GOTO 6cc reinitilaize cycle --c 65   INIT      = INIT+1      IF (INIT .GT. N) GOTO 101      IF (PERM(INIT) .LT. 0) GOTO 65      TMP       = X(INIT)      II        = PERM(INIT)      PERM(INIT)=-PERM(INIT)      GOTO 6c 101  CONTINUE      DO 200 J=1, N         PERM(J) = -PERM(J) 200  CONTINUEc      RETURNc-------------------end-of-dvperm---------------------------------------c-----------------------------------------------------------------------      END

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