Télécharger la plaquette Cast3M


fr en

Télécharger separ.eso

Retour à la liste

Numérotation des lignes : 

separ

  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.  
  37.         CALL NOEPER(IADJ,IVOIS,PIVOT,LONG,NRELONG,NOELON,
  38.      *                  DIMLON,MASQUE,IPOS,NODES)
  39.  
  40. C       recherche la distance maximale de PIVOT a un tout autre noeud, renvoie
  41. C       le resultat dans LONG. DIMLON contient le nombre des noeuds de longueur
  42. C       LONG,ces derniers sont MASQues,et on leur associe une (I)POSition.
  43. C       NRELONG(I) contient la profondeur du noeud I.
  44. C       NOELON contient les noeuds de longueur LONG.
  45.  
  46.  
  47.  
  48. 10      CALL DEGMIN(IADJ,IVOIS,NOELON,PIVOT,DIMLON)
  49.  
  50. C       on recherche le noeud de minimum degre parmi les noeuds de profondeur
  51. C       LONG (contenu dans NOELON).
  52. C       ON renvoie le resultat dans PIVOT.
  53.  
  54.  
  55.         CALL NOEPER(IADJ,IVOIS,PIVOT,LONG2,NRELONG,NOELON,
  56.      *                 DIMLON,MASQUE,IPOS,NODES)
  57.  
  58. C       on recommence la procedure NOEPERI avec le nouveau PIVOT pour etre sur
  59. C       d'avoir trouve la LONGueur maximale.
  60.  
  61.  
  62. C       Si ce n'est pas le cas,on met LONG2 dans LONG.
  63.  
  64.         IF (LONG2.GT.LONG) THEN
  65.                 LONG=LONG2
  66.                 GOTO 10
  67.         ENDIF
  68.  
  69. C       PIVOT correspond au noeud pseudo-peripherique.
  70. C       LONG2 correspond au pseudo-diametre.
  71.  
  72.  
  73.  
  74.         DIMSEP=0
  75.  
  76. C       pour l'instant,aucun noeud n'appartient a la separation.
  77.  
  78.  
  79.         L=INT(LONG2/2)
  80. C       L correspond a la distance moyenne pour aller d'un bout a l'autre
  81. C       du domaine.
  82.  
  83.  
  84.  
  85. C       on arrete de separer si LONG < = 5.
  86. C       on masque alors tous les noeuds repondant a cette condition.
  87.  
  88.         IF(LONG2.LE.5) THEN
  89.            DO 30 J=1,LONG2
  90.               DO 40 I=1,NODES
  91.                 IF(((NRELONG(I)).EQ.J).AND.(MASQ(I))) THEN
  92.                         MASQ(I)=.FALSE.
  93.                         DIMSEP=DIMSEP+1
  94.                 ENDIF
  95. 40            CONTINUE
  96. 30         CONTINUE
  97.            GOTO 50
  98.         ENDIF
  99.  
  100.  
  101.  
  102. C       On calcule la position de chaque noeud I.
  103. C       si I a une profondeur L, I appartient a la separation.
  104.  
  105.  
  106.         DO 20 I=1,NODES
  107.  
  108.              IF(MASQ(I)) THEN
  109.  
  110.                 IF((NRELONG(I).LT.L).AND.(NRELONG(I).GT.0)) THEN
  111.                         IPOS(I+NODES)=IPOS(I+NODES)*3+1
  112.                         IPOS(I)=IPOS(I)+1
  113.                 ENDIF
  114.  
  115.                 IF(NRELONG(I).EQ.L) THEN
  116.                         IF (IPOS(I+NODES).GT.42946799) THEN
  117.                            DO 5 J=1,NODES
  118.                                 MASQ(I)=.FALSE.
  119. 5                          CONTINUE
  120.                            GOTO 50
  121.                         ENDIF
  122.                         MASQ(I)=.FALSE.
  123.                         DIMSEP=DIMSEP+1
  124.                 ENDIF
  125.  
  126.                 IF(NRELONG(I).GT.L) THEN
  127.                         IPOS(I+NODES)=IPOS(I+NODES)*3+2
  128.                         IPOS(I)=IPOS(I)+1
  129.                 ENDIF
  130.  
  131.             ENDIF
  132.  
  133. 20      CONTINUE
  134. 50      SEGSUP NRELONG,NOELON
  135.  
  136.  
  137.         RETURN
  138.         END
  139.  
  140.  

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