Télécharger number.eso

Retour à la liste

Numérotation des lignes :

  1. C NUMBER SOURCE CHAT 05/01/13 02:03:05 5004
  2. SUBROUTINE NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,
  3. $ S,
  4. $ Q,P,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : NUMBER
  10. C DESCRIPTION : Number nodes in component of graph for small profile
  11. C and rms wavefront
  12. C
  13. C LANGAGE : FORTRAN 77 (sauf E/S)
  14. C
  15. C AUTEUR : Scott Sloan
  16. C
  17. C BIBLIO : @Article{,
  18. C author = {S. W. Sloan},
  19. C title = {A Fortran Program for Profile and Wavefront Reduction},
  20. C journal = {International Journal for Numerical Methods in Engineering},
  21. C year = {1989},
  22. C volume = {28},
  23. C pages = {2651-2679}
  24. C}
  25. C
  26. C***********************************************************************
  27. C APPELE PAR : LABEL
  28. C***********************************************************************
  29. C ENTREES :
  30. C N - Number of nodes in graph
  31. C NC - Number of nodes in component of graph
  32. C SNODE - Node at which numbering starts
  33. C E2 - Twice the number of edges in the graph = XADJ(N+1)-1
  34. C ADJ - Adjacency list for all nodes in graph
  35. C - List of length 2E where E is the number of edges in
  36. C the graph and 2E = XADJ(N+1)-1
  37. C XADJ - Index vector for ADJ
  38. C - Nodes adjacent to node I are found in ADJ(J), where
  39. C J = XADJ(I),...,XADJ(I+1)-1
  40. C - Degree of node I given by XADJ(I+1)-XADJ(I)
  41. C Q - List of nodes which are in this component
  42. C - Also used to store queue of active or preactive nodes
  43. C ENTREES-SORTIES :
  44. C (E) LSTNUM - Count of nodes which have already been numbered
  45. C (S) LSTNUM - Count of numbered nodes (input value incremented by NC)
  46. C (E) S - List giving the distance of each node in this
  47. C component from the end node
  48. C (S) S - List of new node numbers
  49. C - New number for node I is S(I)
  50. C TABLEAU DE TRAVAIL :
  51. C P -
  52. C
  53. C NOTES :
  54. C
  55. C S also serves as a list giving the status of the nodes
  56. C during the numbering process:
  57. C S(I) gt 0 indicates node I is postactive
  58. C S(I) = 0 indicates node I is active
  59. C S(I) = -1 indicates node I is preactive
  60. C S(I) = -2 indicates node I is inactive
  61. C P is used to hold the priorities for each node
  62. C
  63. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  64. C***********************************************************************
  65. C VERSION : v1, 05/11/99, version initiale
  66. C HISTORIQUE : v1, 10/03/89, création
  67. C HISTORIQUE :
  68. C HISTORIQUE :
  69. C***********************************************************************
  70. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  71. C en cas de modification de ce sous-programme afin de faciliter
  72. C la maintenance !
  73. C***********************************************************************
  74. -INC CCOPTIO
  75. INTEGER NC,LSTNUM,JSTRT,JSTOP,ISTRT,ISTOP,NBR,NABOR,I,J
  76. INTEGER NEXT,ADDRES,NN,NODE,SNODE,MAXPRT,PRTY,N,W1,W2,E2
  77. INTEGER Q(NC),XADJ(N+1),ADJ(E2),P(N),S(N)
  78. INTEGER IMPR,IRET
  79. *
  80. PARAMETER(W1=1,
  81. $ W2=2)
  82. *
  83. *
  84. * Executable statements
  85. *
  86. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans number'
  87. *
  88. * Initialise priorities and status for each node in this component
  89. * Initial priority = W1*DIST - W2*DEGREE where:
  90. * W1 = a positive weight
  91. * W2 = a positive weight
  92. * DEGREE = initial current degree for node
  93. * DIST = distance of node from end node
  94. *
  95. DO 10 I=1,NC
  96. NODE=Q(I)
  97. P(NODE)=W1*S(NODE)-W2*(XADJ(NODE+1)-XADJ(NODE)+1)
  98. S(NODE)=-2
  99. 10 CONTINUE
  100. *
  101. * Insert starting node in queue and assign it a preactive status
  102. * NN is the size of queue
  103. *
  104. NN=1
  105. Q(NN)=SNODE
  106. S(SNODE)=-1
  107. *
  108. * Loop while queue is not empty
  109. *
  110. 30 CONTINUE
  111. IF (NN.GT.0) THEN
  112. *
  113. * Scan queue for node with max priority
  114. *
  115. ADDRES=1
  116. MAXPRT=P(Q(1))
  117. DO 35 I=2,NN
  118. PRTY=P(Q(I))
  119. IF (PRTY.GT.MAXPRT) THEN
  120. ADDRES=I
  121. MAXPRT=PRTY
  122. ENDIF
  123. 35 CONTINUE
  124. *
  125. * NEXT is the node to be numbered next
  126. *
  127. NEXT=Q(ADDRES)
  128. *
  129. * Delete node NEXT from queue
  130. *
  131. Q(ADDRES)=Q(NN)
  132. NN=NN-1
  133. ISTRT=XADJ(NEXT)
  134. ISTOP=XADJ(NEXT+1)-1
  135. IF (S(NEXT).EQ.-1) THEN
  136. *
  137. * Node NEXT is preactive, examine its neighbours
  138. *
  139. DO 50 I=ISTRT,ISTOP
  140. *
  141. * Decrease current degree of neighbour by -1
  142. *
  143. NBR=ADJ(I)
  144. P(NBR)=P(NBR)+W2
  145. *
  146. * Add neighbour to queue if it is inactive
  147. * assign it a preactive status
  148. *
  149. IF (S(NBR).EQ.-2) THEN
  150. NN=NN+1
  151. Q(NN)=NBR
  152. S(NBR)=-1
  153. ENDIF
  154. 50 CONTINUE
  155. ENDIF
  156. *
  157. * Store new node number for node NEXT
  158. * Status for node NEXT is now postactive
  159. *
  160. LSTNUM=LSTNUM+1
  161. S(NEXT)=LSTNUM
  162. *
  163. * Search for preactive neighbours of node NEXT
  164. *
  165. DO 80 I=ISTRT,ISTOP
  166. NBR=ADJ(I)
  167. IF (S(NBR).EQ.-1) THEN
  168. *
  169. * Decrease current degree of preactive neighbour by -1
  170. * assign neighbour an active status
  171. *
  172. P(NBR)=P(NBR)+W2
  173. S(NBR)=0
  174. *
  175. * Loop over nodes adjacent to preactive neighbour
  176. *
  177. JSTRT=XADJ(NBR)
  178. JSTOP=XADJ(NBR+1)-1
  179. DO 60 J=JSTRT,JSTOP
  180. NABOR=ADJ(J)
  181. *
  182. * Decrease current degree of adjacent node by -1
  183. *
  184. P(NABOR)=P(NABOR)+W2
  185. IF (S(NABOR).EQ.-2) THEN
  186. *
  187. * Insert inactive node in queue with a preactive status
  188. *
  189. NN=NN+1
  190. Q(NN)=NABOR
  191. S(NABOR)=-1
  192. ENDIF
  193. 60 CONTINUE
  194. ENDIF
  195. 80 CONTINUE
  196. GOTO 30
  197. ENDIF
  198. *
  199. * Normal termination
  200. *
  201. IRET=0
  202. RETURN
  203. *
  204. * Format handling
  205. *
  206. *
  207. * Error handling
  208. *
  209. 9999 CONTINUE
  210. IRET=1
  211. WRITE(IOIMP,*) 'An error was detected in subroutine number'
  212. RETURN
  213. *
  214. * End of subroutine NUMBER
  215. *
  216. END
  217.  
  218.  
  219.  
  220.  

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