Esope source files

   1 : C SEPAR     SOURCE    CHAT      05/01/13    03:14:02     5004           
   2 : C****************************************************************************
   3 : C****************************************************************************
   4 : C***************SEPAR...trouve separation************************************
   5 : C****************************************************************************
   6 : C****************************************************************************
   7 : 
   8 : C    SEPAR   trouve la separation a  partir du domaine defini  par
   9 : C    MASQ=.TRUE. et du noeud appele PIVOT, renvoie DIMSEP,le nombre de 
  10 : C    noeuds contenant dans la separation, MASK=.FALSE. pour les noeuds 
  11 : C    appartenant a la separation, renumerote celle-ci dans IADJ,
  12 : 
  13 :         SUBROUTINE SEPAR(IADJ,IVOIS,PIVOT,MASQUE,DIMSEP,N,IPOS,
  14 :      &                   NODES)
  15 : 
  16 :       IMPLICIT INTEGER(I-N)
  17 :         SEGMENT IADJ(0)
  18 :         SEGMENT IVOIS(0)
  19 :         INTEGER PIVOT
  20 :         SEGMENT MASQUE
  21 :                 LOGICAL MASQ(0)
  22 :         ENDSEGMENT
  23 :         SEGMENT IPOS(0)
  24 :         INTEGER NODES
  25 :            
  26 :         INTEGER DIMSEP,N
  27 : 
  28 :         INTEGER LONG,LONG2,L,DIMLON
  29 :         SEGMENT NRELONG(NODES),NOELON(NODES)
  30 :         LOGICAL BOOL
  31 :         
  32 : C       initialisation des segments de travail.
  33 :         SEGINI NRELONG,NOELON
  34 :         
  35 : 
  36 : 
  36 :         CALL NOEPER(IADJ,IVOIS,PIVOT,LONG,NRELONG,NOELON,
  37 :      *                  DIMLON,MASQUE,IPOS,NODES)
  38 : 
  39 : C       recherche la distance maximale de PIVOT a un tout autre noeud, renvoie
  40 : C       le resultat dans LONG. DIMLON contient le nombre des noeuds de longueur
  41 : C       LONG,ces derniers sont MASQues,et on leur associe une (I)POSition.
  42 : C       NRELONG(I) contient la profondeur du noeud I.
  43 : C       NOELON contient les noeuds de longueur LONG.
  44 :         
  45 : 
  46 : 
  46 : 10      CALL DEGMIN(IADJ,IVOIS,NOELON,PIVOT,DIMLON)
  47 : 
  48 : C       on recherche le noeud de minimum degre parmi les noeuds de profondeur
  49 : C       LONG (contenu dans NOELON).
  50 : C       ON renvoie le resultat dans PIVOT.
  51 : 
  52 : 
  52 :         CALL NOEPER(IADJ,IVOIS,PIVOT,LONG2,NRELONG,NOELON,
  53 :      *                 DIMLON,MASQUE,IPOS,NODES)
  54 : 
  55 : C       on recommence la procedure NOEPERI avec le nouveau PIVOT pour etre sur
  56 : C       d'avoir trouve la LONGueur maximale.
  57 : 
  58 : 
  59 : C       Si ce n'est pas le cas,on met LONG2 dans LONG.
  60 :         
  61 :         IF (LONG2.GT.LONG) THEN
  62 :                 LONG=LONG2
  63 :                 GOTO 10
  64 :         ENDIF
  65 : 
  66 : C       PIVOT correspond au noeud pseudo-peripherique.
  67 : C       LONG2 correspond au pseudo-diametre.
  68 : 
  69 : 
  70 : 
  71 :         DIMSEP=0
  72 : 
  73 : C       pour l'instant,aucun noeud n'appartient a la separation.
  74 : 
  75 : 
  76 :         L=INT(LONG2/2)
  77 : C       L correspond a la distance moyenne pour aller d'un bout a l'autre 
  78 : C       du domaine.
  79 : 
  80 : 
  81 : 
  82 : C       on arrete de separer si LONG < = 5.
  83 : C       on masque alors tous les noeuds repondant a cette condition.
  84 : 
  85 :         IF(LONG2.LE.5) THEN
  86 :            DO 30 J=1,LONG2
  87 :               DO 40 I=1,NODES
  88 :                 IF(((NRELONG(I)).EQ.J).AND.(MASQ(I))) THEN
  89 :                         MASQ(I)=.FALSE.
  90 :                         DIMSEP=DIMSEP+1
  91 :                 ENDIF
  92 : 40            CONTINUE
  93 : 30         CONTINUE
  94 :            GOTO 50
  95 :         ENDIF
  96 : 
  97 : 
  98 : 
  99 : C       On calcule la position de chaque noeud I.
 100 : C       si I a une profondeur L, I appartient a la separation.
 101 : 
 102 : 
 103 :         DO 20 I=1,NODES
 104 : 
 105 :              IF(MASQ(I)) THEN
 106 : 
 107 :                 IF((NRELONG(I).LT.L).AND.(NRELONG(I).GT.0)) THEN
 108 :                         IPOS(I+NODES)=IPOS(I+NODES)*3+1
 109 :                         IPOS(I)=IPOS(I)+1
 110 :                 ENDIF
 111 : 
 112 :                 IF(NRELONG(I).EQ.L) THEN
 113 :                         IF (IPOS(I+NODES).GT.42946799) THEN 
 114 :                            DO 5 J=1,NODES
 115 :                                 MASQ(I)=.FALSE.
 116 : 5                          CONTINUE
 117 :                            GOTO 50
 118 :                         ENDIF
 119 :                         MASQ(I)=.FALSE.
 120 :                         DIMSEP=DIMSEP+1
 121 :                 ENDIF
 122 : 
 123 :                 IF(NRELONG(I).GT.L) THEN
 124 :                         IPOS(I+NODES)=IPOS(I+NODES)*3+2
 125 :                         IPOS(I)=IPOS(I)+1
 126 :                 ENDIF
 127 : 
 128 :             ENDIF
 129 : 
 130 : 20      CONTINUE
 131 : 50      SEGSUP NRELONG,NOELON
 132 : 
 133 :         
 134 :         RETURN
 135 :         END
 136 :