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