Download noeper.eso

Back to the list

   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
  53 :         LONG=LONG+1
  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
  79 :            LONG=LONG+1
  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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer