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 :
© Cast3M 2003 - All rights reserved.
Disclaimer