Télécharger noeper.eso

Retour à la liste

Numérotation des lignes :

  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.  
  54.  
  55. DO 10 I=1,IADJ(PIVOT+1)-IADJ(PIVOT)
  56. Y=IVOIS(IADJ(PIVOT)+I-1)
  57. C Y:voisin de PIVOT.
  58. IF(Y.EQ.0) GOTO 10
  59. IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN
  60. BOOL=.TRUE.
  61. DIMLON=DIMLON+1
  62. NOELON(DIMLON)=Y
  63. NRELONG(Y)=LONG
  64. ENDIF
  65. C pour chaque voisin Y de PIVOT, on determine sa profondeur.
  66. 10 CONTINUE
  67. C Tous les voisins Y de PIVOT non masques tels que RELONG(Y)=LONG
  68. C constituent NOELON.
  69. C DIMLON=dimension(NOELON)
  70.  
  71. DIML2=DIMLON
  72. C on copie DIMLON dans DIML2.
  73.  
  74. 20 IF(BOOL) THEN
  75. BOOL=.FALSE.
  76. DIMLON=DIML2
  77. DIML2=0
  78. DO 30 I=1,DIMLON
  79. X=NOELON(I)
  80. DO 40 J=1,IADJ(X+1)-IADJ(X)
  81. Y=IVOIS(IADJ(X)+J-1)
  82. C Y: voisin d'un noeud de profondeur LONG-1.
  83. IF(Y.EQ.0) GOTO 40
  84. IF((NRELONG(Y).EQ.0).AND.(MASQ(Y))) THEN
  85. BOOL=.TRUE.
  86. DIML2=DIML2+1
  87. NOEL2(DIML2)=Y
  88. NRELONG(Y)=LONG
  89. ENDIF
  90. 40 CONTINUE
  91. 30 CONTINUE
  92. C On recherche les voisins de NOELON(I) pouvant avoir
  93. C une profondeur LONG. On les met dans NOEL2.
  94.  
  95.  
  96. DO 50 I=1,DIML2
  97. NOELON(I)=NOEL2(I)
  98. C On recopie NOEL2 dans NOELON.
  99. 50 CONTINUE
  100.  
  101. GOTO 20
  102. C on s'arrete que si BOOL=.FALSE.
  103. ENDIF
  104.  
  105.  
  106. SEGSUP NOEL2
  107. C suppression du segment de travail.
  108.  
  109. RETURN
  110. END
  111.  
  112.  

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