Esope source files

   1 : C DOUBL4    SOURCE    MAUGIS    05/09/01    21:15:02     5152           
   2 :       SUBROUTINE DOUBL4(NUM,NBNN,NBELEM,LECT,LECT1,LECT2)
   3 : C----------------------------------------------------
   4 : C
   5 : C     Esclave de DOUBL3 : detection des occurences multiples d'elements
   6 : C
   7 : C     Variables :
   8 : C       LECT  : liste des sommes des numéros de noeuds pour chaque élément
   9 : C               classée par ordre croissant
  10 : C       LECT1 : liste (non croissante) des indices classant LECT par ordre croissant
  11 : C       LECT2 : liste des indices dans l'ordre original (croissant de 1 à N)
  12 : C
  13 : C     Fortran pur
  14 : C
  15 : C----------------------------------------------------
  16 : C
  17 :       IMPLICIT INTEGER(I-N)
  18 :       IMPLICIT REAL*8(A-H,O-Z)
  19 : C
  20 :       DIMENSION NUM(NBNN,NBELEM)
  21 :       DIMENSION LECT(NBELEM),LECT1(NBELEM),LECT2(NBELEM)
  22 :       LOGICAL GENTST
  23 : C
  24 : C     On parcourt LECT et on compare chaque valeur à celle de l'indice précédent
  25 :       IFI=LECT(1)
  26 :       DO IE1=2,NBELEM
  27 :         IFF=LECT(IE1)
  28 :         IF(IFI.EQ.IFF)THEN
  29 : C         deux sommes identiques
  30 :           JE1=LECT1(IE1-1)
  31 :           IF(LECT2(JE1).EQ.JE1)THEN
  32 : C           dans le cas contraire, cet indice a déjà été traité
  33 : C           et fait l'objet d'une interversion dans LECT2
  34 : 
  35 :             DO IE2=IE1,NBELEM
  36 : C             on parcourt toutes les valeurs semblables
  37 :               IFFF=LECT(IE2)
  38 :               IF(IFI.NE.IFFF)GOTO 1
  39 :               JE2=LECT1(IE2)
  40 :               IF(LECT2(JE2).EQ.JE2)THEN
  41 : C               dans le cas contraire, cet indice a déjà été traité
  42 : C               et fait l'objet d'une interversion dans LECT2
  43 :                 IF(GENTST(NUM(1,JE1),NUM(1,JE2),NBNN))THEN
  44 : C                 les deux éléments sont semblables.
  45 : C                 On intervertit leurs indices dans LECT2
  46 : C PM              LECT2(JE1)=JE2
  47 : C PM              LECT2(JE2)=JE1
  48 :                   JSAV=LECT2(JE1)
  49 :                   LECT2(JE1)=LECT2(JE2)
  50 :                   LECT2(JE2)=JSAV
  51 :                 ENDIF
  52 :               ENDIF
  53 :             ENDDO
  54 : 
  55 :           ENDIF
  56 :         ENDIF
  57 :  1      IFI=IFF
  58 :       ENDDO
  59 : C
  60 :       RETURN
  61 :       END
  62 :