Télécharger la plaquette Cast3M


fr en

Télécharger number.eso

Retour à la liste

Numérotation des lignes : 

number

  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.  
  75. -INC PPARAM
  76. -INC CCOPTIO
  77.       INTEGER NC,LSTNUM,JSTRT,JSTOP,ISTRT,ISTOP,NBR,NABOR,I,J
  78.       INTEGER NEXT,ADDRES,NN,NODE,SNODE,MAXPRT,PRTY,N,W1,W2,E2
  79.       INTEGER Q(NC),XADJ(N+1),ADJ(E2),P(N),S(N)
  80.       INTEGER IMPR,IRET
  81. *
  82.       PARAMETER(W1=1,
  83.      $          W2=2)
  84. *
  85. *
  86. * Executable statements
  87. *
  88.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans number'
  89. *
  90. *     Initialise priorities and status for each node in this component
  91. *     Initial priority = W1*DIST - W2*DEGREE     where:
  92. *     W1     = a positive weight
  93. *     W2     = a positive weight
  94. *     DEGREE = initial current degree for node
  95. *     DIST   = distance of node from end node
  96. *
  97.       DO 10 I=1,NC
  98.          NODE=Q(I)
  99.          P(NODE)=W1*S(NODE)-W2*(XADJ(NODE+1)-XADJ(NODE)+1)
  100.          S(NODE)=-2
  101.  10   CONTINUE
  102. *
  103. *     Insert starting node in queue and assign it a preactive status
  104. *     NN is the size of queue
  105. *
  106.       NN=1
  107.       Q(NN)=SNODE
  108.       S(SNODE)=-1
  109. *
  110. *     Loop while queue is not empty
  111. *
  112.  30   CONTINUE
  113.       IF (NN.GT.0) THEN
  114. *
  115. *     Scan queue for node with max priority
  116. *
  117.          ADDRES=1
  118.          MAXPRT=P(Q(1))
  119.          DO 35 I=2,NN
  120.             PRTY=P(Q(I))
  121.             IF (PRTY.GT.MAXPRT) THEN
  122.                ADDRES=I
  123.                MAXPRT=PRTY
  124.             ENDIF
  125.  35      CONTINUE
  126. *
  127. *     NEXT is the node to be numbered next
  128. *
  129.          NEXT=Q(ADDRES)
  130. *
  131. *     Delete node NEXT from queue
  132. *
  133.          Q(ADDRES)=Q(NN)
  134.          NN=NN-1
  135.          ISTRT=XADJ(NEXT)
  136.          ISTOP=XADJ(NEXT+1)-1
  137.          IF (S(NEXT).EQ.-1) THEN
  138. *
  139. *     Node NEXT is preactive, examine its neighbours
  140. *
  141.             DO 50 I=ISTRT,ISTOP
  142. *
  143. *     Decrease current degree of neighbour by -1
  144. *
  145.                NBR=ADJ(I)
  146.                P(NBR)=P(NBR)+W2
  147. *
  148. *     Add neighbour to queue if it is inactive
  149. *     assign it a preactive status
  150. *
  151.                IF (S(NBR).EQ.-2) THEN
  152.                   NN=NN+1
  153.                   Q(NN)=NBR
  154.                   S(NBR)=-1
  155.                ENDIF
  156.  50         CONTINUE
  157.          ENDIF
  158. *
  159. *     Store new node number for node NEXT
  160. *     Status for node NEXT is now postactive
  161. *
  162.          LSTNUM=LSTNUM+1
  163.          S(NEXT)=LSTNUM
  164. *
  165. *     Search for preactive neighbours of node NEXT
  166. *
  167.          DO 80 I=ISTRT,ISTOP
  168.             NBR=ADJ(I)
  169.             IF (S(NBR).EQ.-1) THEN
  170. *
  171. *     Decrease current degree of preactive neighbour by -1
  172. *     assign neighbour an active status
  173. *
  174.                P(NBR)=P(NBR)+W2
  175.                S(NBR)=0
  176. *
  177. *     Loop over nodes adjacent to preactive neighbour
  178. *
  179.                JSTRT=XADJ(NBR)
  180.                JSTOP=XADJ(NBR+1)-1
  181.                DO 60 J=JSTRT,JSTOP
  182.                   NABOR=ADJ(J)
  183. *
  184. *     Decrease current degree of adjacent node by -1
  185. *
  186.                   P(NABOR)=P(NABOR)+W2
  187.                   IF (S(NABOR).EQ.-2) THEN
  188. *
  189. *     Insert inactive node in queue with a preactive status
  190. *
  191.                      NN=NN+1
  192.                      Q(NN)=NABOR
  193.                      S(NABOR)=-1
  194.                   ENDIF
  195.  60            CONTINUE
  196.             ENDIF
  197.  80      CONTINUE
  198.          GOTO 30
  199.       ENDIF
  200. *
  201. * Normal termination
  202. *
  203.       IRET=0
  204.       RETURN
  205. *
  206. * Format handling
  207. *
  208. *
  209. * Error handling
  210. *
  211.  9999 CONTINUE
  212.       IRET=1
  213.       WRITE(IOIMP,*) 'An error was detected in subroutine number'
  214.       RETURN
  215. *
  216. * End of subroutine NUMBER
  217. *
  218.       END
  219.  
  220.  
  221.  
  222.  

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