Télécharger la plaquette Cast3M


fr en

Télécharger noeper.eso

Retour à la liste

Numérotation des lignes : 

noeper

  1. C NOEPER    SOURCE    CHAT      05/01/13    01:58:03     5004
  2. C****************************************************************************
  3. C****************************************************************************
  4. C*************NOEPERI ..NOEuds PERIpheriques*********************************
  5. C****************************************************************************
  6. C****************************************************************************
  7.  
  8. C  NOEPERI part de PIVOT,lui associe l=1, associe l=l+1 a ses voisins directs,
  9. C  repart des voisins directs pour associer un l a leur voisins....
  10. C  LONG=max(l).
  11. C  NRELONG(I)=l ,NOELON contient les noeuds tels que l=LONG.
  12.  
  13.  
  14.  
  15.  
  16.         SUBROUTINE NOEPER(IADJ,IVOIS,PIVOT,LONG,NRELONG,NOELON,
  17.      *DIMLON,MASQUE,IPOS,NODES)
  18.  
  19.  
  20.       IMPLICIT INTEGER(I-N)
  21.         SEGMENT IADJ(0)
  22.         SEGMENT IVOIS(0)
  23.  
  24.         INTEGER PIVOT,LONG,DIMLON,Y,X
  25.         SEGMENT NRELONG(0),NOELON(0)
  26.  
  27.         SEGMENT IPOS(0)
  28.  
  29.         SEGMENT MASQUE
  30.                 LOGICAL MASQ(0)
  31.         ENDSEGMENT
  32.  
  33.         INTEGER NODES
  34.  
  35.  
  36.         SEGMENT NOEL2(NODES)
  37.         INTEGER DIML2
  38.         LOGICAL BOOL
  39.  
  40.         SEGINI NOEL2
  41.  
  42.  
  43.         DO 5 I=1,NODES
  44.                 NRELONG(I)=0
  45. 5       CONTINUE
  46.  
  47.  
  48.         BOOL=.FALSE.
  49.         DIMLON=0
  50.         LONG=1
  51.  
  52.         NRELONG(PIVOT)=LONG
  54.  
  55.  
  56.         DO 10 I=1,IADJ(PIVOT+1)-IADJ(PIVOT)
  57.                 Y=IVOIS(IADJ(PIVOT)+I-1)
  58. C               Y:voisin de PIVOT.
  59.                 IF(Y.EQ.0) GOTO 10
  60.                 IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN
  61.                   BOOL=.TRUE.
  62.                   DIMLON=DIMLON+1
  63.                   NOELON(DIMLON)=Y
  64.                   NRELONG(Y)=LONG
  65.                 ENDIF
  66. C               pour chaque voisin Y de PIVOT, on determine sa profondeur.
  67. 10      CONTINUE
  68. C       Tous les voisins Y de PIVOT non masques tels que RELONG(Y)=LONG
  69. C       constituent NOELON.
  70. C       DIMLON=dimension(NOELON)
  71.  
  72.         DIML2=DIMLON
  73. C       on copie DIMLON dans DIML2.
  74.  
  75. 20      IF(BOOL) THEN
  76.            BOOL=.FALSE.
  77.            DIMLON=DIML2
  78.            DIML2=0
  80.            DO 30 I=1,DIMLON
  81.               X=NOELON(I)
  82.               DO 40 J=1,IADJ(X+1)-IADJ(X)
  83.                 Y=IVOIS(IADJ(X)+J-1)
  84. C               Y: voisin d'un noeud de profondeur LONG-1.
  85.                 IF(Y.EQ.0) GOTO 40
  86.                 IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN
  87.                   BOOL=.TRUE.
  88.                   DIML2=DIML2+1
  89.                   NOEL2(DIML2)=Y
  90.                   NRELONG(Y)=LONG
  91.                 ENDIF
  92. 40           CONTINUE
  93. 30        CONTINUE
  94. C         On recherche les voisins de NOELON(I) pouvant avoir
  95. C         une profondeur LONG. On les met dans NOEL2.
  96.  
  97.  
  98.           DO 50 I=1,DIML2
  99.                 NOELON(I)=NOEL2(I)
  100. C         On recopie NOEL2 dans NOELON.
  101. 50        CONTINUE
  102.  
  103.         GOTO 20
  104. C       on s'arrete que si BOOL=.FALSE.
  105.         ENDIF
  106.  
  107.  
  108.         SEGSUP NOEL2
  109. C       suppression du segment de travail.
  110.  
  111.         RETURN
  112.         END
  113.  
  114.  

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