Télécharger rootls.eso

Retour à la liste

Numérotation des lignes :

  1. C ROOTLS SOURCE CHAT 05/01/13 03:04:26 5004
  2. SUBROUTINE ROOTLS(N,ROOT,MAXWID,E2,ADJ,XADJ,MASK,
  3. $ LS,XLS,DEPTH,WIDTH,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : ROOTLS
  9. C DESCRIPTION : Generate rooted level structure using a FORTRAN 77
  10. C implementation of the algorithm given by George and Liu
  11. C
  12. C LANGAGE : FORTRAN 77 (sauf E/S)
  13. C
  14. C AUTEUR : Scott Sloan
  15. C
  16. C BIBLIO : @Article{,
  17. C author = {S. W. Sloan},
  18. C title = {A Fortran Program for Profile and Wavefront Reduction},
  19. C journal = {International Journal for Numerical Methods in Engineering},
  20. C year = {1989},
  21. C volume = {28},
  22. C pages = {2651-2679}
  23. C}
  24. C
  25. C***********************************************************************
  26. C APPELES : ROOTLS, ISHELI
  27. C APPELE PAR : DIAMTR
  28. C***********************************************************************
  29. C ENTREES :
  30. C N - Number of nodes
  31. C ROOT - Root node for level structure
  32. C MAXWID - Max permissible width of rooted level structure
  33. C - Abort assembly of level structure if width is ge MAXWID
  34. C - Assembly insured by setting MAXWID = N+1
  35. C E2 - Twice the number of edges in the graph = XADJ(N+1)-1
  36. C ADJ - Adjacency list for all nodes in graph
  37. C - List of length 2E where E is the number of edges in
  38. C the graph and 2E = XADJ(N+1)-1
  39. C XADJ - Index vector for ADJ
  40. C - Nodes adjacent to node I are found in ADJ(J), where
  41. C J = XADJ(I),...,XADJ(I+1)-1
  42. C - Degree of node I given by XADJ(I+1)-XADJ(I)
  43. C MASK - Masking vector for graph
  44. C - Visible nodes have MASK = 0
  45. C ENTREES/SORTIES : -
  46. C SORTIES :
  47. C LS - List containing a rooted level structure
  48. C - List of length NC
  49. C XLS - Index vector for LS
  50. C - Nodes in level I are found in LS(J), where
  51. C J = XLS(I),...,XLS(I+1)-1
  52. C - List of max length NC+1
  53. C DEPTH - Number of levels in rooted level structure
  54. C WIDTH - Width of rooted level structure
  55. C
  56. C NOTES :
  57. C
  58. C If WIDTH ge MAXWID then assembly has been aborted
  59. C
  60. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  61. C***********************************************************************
  62. C VERSION : v1, 05/11/99, version initiale
  63. C HISTORIQUE : v1, 10/03/89, création
  64. C HISTORIQUE :
  65. C HISTORIQUE :
  66. C***********************************************************************
  67. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  68. C en cas de modification de ce sous-programme afin de faciliter
  69. C la maintenance !
  70. C***********************************************************************
  71. -INC CCOPTIO
  72. INTEGER ROOT,DEPTH,NBR,MAXWID,LSTRT,LSTOP,LWDTH
  73. INTEGER NODE,NC,WIDTH,N,JSTRT,JSTOP,I,J,E2
  74. INTEGER XADJ(N+1),ADJ(E2),MASK(N),XLS(N+1),LS(N)
  75. INTEGER IMPR,IRET
  76. *
  77. * Executable statements
  78. *
  79. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rootls'
  80. *
  81. * Initialisation
  82. *
  83. MASK(ROOT)=1
  84. LS(1)=ROOT
  85. NC =1
  86. WIDTH=1
  87. DEPTH=0
  88. LSTOP=0
  89. LWDTH=1
  90. 10 CONTINUE
  91. IF (LWDTH.GT.0) THEN
  92. *
  93. * LWDTH is the width of the current level
  94. * LSTRT points to start of current level
  95. * LSTOP points to ende of current level
  96. * NC counts the nodes in component
  97. *
  98. LSTRT=LSTOP+1
  99. LSTOP=NC
  100. DEPTH=DEPTH+1
  101. XLS(DEPTH)=LSTRT
  102. *
  103. * Generate next levle by finding all visible neighbours
  104. * of node in current level
  105. *
  106. DO 30 I=LSTRT,LSTOP
  107. NODE=LS(I)
  108. JSTRT=XADJ(NODE)
  109. JSTOP=XADJ(NODE+1)-1
  110. DO 20 J=JSTRT,JSTOP
  111. NBR=ADJ(J)
  112. IF (MASK(NBR).EQ.0) THEN
  113. NC=NC+1
  114. LS(NC)=NBR
  115. MASK(NBR)=1
  116. ENDIF
  117. 20 CONTINUE
  118. 30 CONTINUE
  119. *
  120. * Compute width of level just assembled and the width of the
  121. * level structure so far
  122. *
  123. LWDTH=NC-LSTOP
  124. WIDTH=MAX(LWDTH,WIDTH)
  125. *
  126. * Abort assembly if level structure is too wide
  127. *
  128. IF (WIDTH.GE.MAXWID) GOTO 35
  129. GOTO 10
  130. ENDIF
  131. XLS(DEPTH+1)=LSTOP+1
  132. *
  133. * Reset MASK=0 for nodes in the level structure
  134. *
  135. 35 CONTINUE
  136. DO 40 I=1,NC
  137. MASK(LS(I))=0
  138. 40 CONTINUE
  139. *
  140. * Normal termination
  141. *
  142. IRET=0
  143. RETURN
  144. *
  145. * Format handling
  146. *
  147. *
  148. * Error handling
  149. *
  150. 9999 CONTINUE
  151. IRET=1
  152. WRITE(IOIMP,*) 'An error was detected in subroutine rootls'
  153. RETURN
  154. *
  155. * End of subroutine ROOTLS
  156. *
  157. END
  158.  
  159.  
  160.  
  161.  

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