C NUMBER SOURCE CHAT 05/01/13 02:03:05 5004 SUBROUTINE NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ, $ S, $ Q,P, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : NUMBER C DESCRIPTION : Number nodes in component of graph for small profile C and rms wavefront C C LANGAGE : FORTRAN 77 (sauf E/S) C C AUTEUR : Scott Sloan C C BIBLIO : @Article{, C author = {S. W. Sloan}, C title = {A Fortran Program for Profile and Wavefront Reduction}, C journal = {International Journal for Numerical Methods in Engineering}, C year = {1989}, C volume = {28}, C pages = {2651-2679} C} C C*********************************************************************** C APPELE PAR : LABEL C*********************************************************************** C ENTREES : C N - Number of nodes in graph C NC - Number of nodes in component of graph C SNODE - Node at which numbering starts C E2 - Twice the number of edges in the graph = XADJ(N+1)-1 C ADJ - Adjacency list for all nodes in graph C - List of length 2E where E is the number of edges in C the graph and 2E = XADJ(N+1)-1 C XADJ - Index vector for ADJ C - Nodes adjacent to node I are found in ADJ(J), where C J = XADJ(I),...,XADJ(I+1)-1 C - Degree of node I given by XADJ(I+1)-XADJ(I) C Q - List of nodes which are in this component C - Also used to store queue of active or preactive nodes C ENTREES-SORTIES : C (E) LSTNUM - Count of nodes which have already been numbered C (S) LSTNUM - Count of numbered nodes (input value incremented by NC) C (E) S - List giving the distance of each node in this C component from the end node C (S) S - List of new node numbers C - New number for node I is S(I) C TABLEAU DE TRAVAIL : C P - C C NOTES : C C S also serves as a list giving the status of the nodes C during the numbering process: C S(I) gt 0 indicates node I is postactive C S(I) = 0 indicates node I is active C S(I) = -1 indicates node I is preactive C S(I) = -2 indicates node I is inactive C P is used to hold the priorities for each node C C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 05/11/99, version initiale C HISTORIQUE : v1, 10/03/89, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO INTEGER NC,LSTNUM,JSTRT,JSTOP,ISTRT,ISTOP,NBR,NABOR,I,J INTEGER NEXT,ADDRES,NN,NODE,SNODE,MAXPRT,PRTY,N,W1,W2,E2 INTEGER Q(NC),XADJ(N+1),ADJ(E2),P(N),S(N) INTEGER IMPR,IRET * PARAMETER(W1=1, $ W2=2) * * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans number' * * Initialise priorities and status for each node in this component * Initial priority = W1*DIST - W2*DEGREE where: * W1 = a positive weight * W2 = a positive weight * DEGREE = initial current degree for node * DIST = distance of node from end node * DO 10 I=1,NC NODE=Q(I) P(NODE)=W1*S(NODE)-W2*(XADJ(NODE+1)-XADJ(NODE)+1) S(NODE)=-2 10 CONTINUE * * Insert starting node in queue and assign it a preactive status * NN is the size of queue * NN=1 Q(NN)=SNODE S(SNODE)=-1 * * Loop while queue is not empty * 30 CONTINUE IF (NN.GT.0) THEN * * Scan queue for node with max priority * ADDRES=1 MAXPRT=P(Q(1)) DO 35 I=2,NN PRTY=P(Q(I)) IF (PRTY.GT.MAXPRT) THEN ADDRES=I MAXPRT=PRTY ENDIF 35 CONTINUE * * NEXT is the node to be numbered next * NEXT=Q(ADDRES) * * Delete node NEXT from queue * Q(ADDRES)=Q(NN) NN=NN-1 ISTRT=XADJ(NEXT) ISTOP=XADJ(NEXT+1)-1 IF (S(NEXT).EQ.-1) THEN * * Node NEXT is preactive, examine its neighbours * DO 50 I=ISTRT,ISTOP * * Decrease current degree of neighbour by -1 * NBR=ADJ(I) P(NBR)=P(NBR)+W2 * * Add neighbour to queue if it is inactive * assign it a preactive status * IF (S(NBR).EQ.-2) THEN NN=NN+1 Q(NN)=NBR S(NBR)=-1 ENDIF 50 CONTINUE ENDIF * * Store new node number for node NEXT * Status for node NEXT is now postactive * LSTNUM=LSTNUM+1 S(NEXT)=LSTNUM * * Search for preactive neighbours of node NEXT * DO 80 I=ISTRT,ISTOP NBR=ADJ(I) IF (S(NBR).EQ.-1) THEN * * Decrease current degree of preactive neighbour by -1 * assign neighbour an active status * P(NBR)=P(NBR)+W2 S(NBR)=0 * * Loop over nodes adjacent to preactive neighbour * JSTRT=XADJ(NBR) JSTOP=XADJ(NBR+1)-1 DO 60 J=JSTRT,JSTOP NABOR=ADJ(J) * * Decrease current degree of adjacent node by -1 * P(NABOR)=P(NABOR)+W2 IF (S(NABOR).EQ.-2) THEN * * Insert inactive node in queue with a preactive status * NN=NN+1 Q(NN)=NABOR S(NABOR)=-1 ENDIF 60 CONTINUE ENDIF 80 CONTINUE GOTO 30 ENDIF * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine number' RETURN * * End of subroutine NUMBER * END