Esope source files

   1 : C SPPERM    SOURCE    CHAT      06/03/29    21:34:50     5360           
   2 :       SUBROUTINE SPPERM(TAB,NBNMAX,NBE,IT1,IT2,iarr)
   3 : C     **********************************************************************
   4 : C     OBJET : PERMUTE 2 ELEMENTS D'UN TABLEAU
   5 : C     EN ENTREE:
   6 : C      ITAB     :   TABLEAU DES ELEMENTS
   7 : C      NBCMAX :    (2..6) NOMBRE DE COTES MAXIMUM DES ELEMENTS
   8 : C      NBE     :   NOMBRE D'ELEMENTS DU MAILLAGE
   9 : C      ITL,IT2:    LES 2 ELEMENTS A PERMUTER
  10 : C     EN SORTIE:
  11 : C     **********************************************************************
  12 :       IMPLICIT INTEGER(I-N)
  13 :       REAL*8        TAB(*)
  14 :       INTEGER     NBNMAX,NBE
  15 :       INTEGER     IT1, IT2, iarr
  16 : C
  17 :       INTEGER I
  18 :       REAL*8     TAMPON(4)
  19 : C
  20 :       IF( IT1 .EQ. IT2 )GO TO 999
  21 :       IF((IT1.LT.1).OR.(IT1.GT.NBE).OR.
  22 :      >    (IT2.LT.1).OR.(IT2.GT.NBE))THEN
  23 :         iarr = -1
  24 :         GO TO 999
  25 :       ENDIF
  26 : C     ------------------ SAUVEGARDE IT2 ---
  27 :       DO 10 I=1,NBNMAX
  28 :        TAMPON(I)=TAB((IT2-1)*NBNMAX+I)
  29 :    10 CONTINUE
  30 : C     ---------- TRANSFERT IT1 -> IT2 ----------
  31 :       DO 20 I=1,NBNMAX
  32 :         TAB((IT2-1)*NBNMAX+I)=TAB((IT1-1)*NBNMAX+I)
  33 :    20 CONTINUE
  34 : C     ---------- TRANSFERT IT2 -> IT1 ----------
  35 :       DO 30 I=1,NBNMAX
  36 :         TAB((IT1-1)*NBNMAX+I)=TAMPON(I)
  37 :    30 CONTINUE
  38 : C     ------------------
  39 :   999 END
  40 :  
  41 :  
  42 :