1 : C LABEL SOURCE CHAT 05/01/13 01:11:46 5004
2 : SUBROUTINE LABEL(N,E2,ADJ,XADJ,
3 : $ NNN,
4 : $ IW,
5 : $ IMPR,IRET)
6 : IMPLICIT INTEGER(I-N)
7 : IMPLICIT REAL*8 (A-H,O-Z)
8 : C***********************************************************************
9 : C NOM : LABEL
10 : C DESCRIPTION : Label a graph for small profile and rms wavefront
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 : DIAMTR, NUMBER
27 : C APPELE PAR : PRSLOA
28 : C***********************************************************************
29 : C ENTREES :
30 : C N - Number of nodes in graph
31 : C E2 - Twice the number of edges in the graph = XADJ(N+1)-1
32 : C ADJ - Adjacency list for all nodes in graph
33 : C - List of length 2E where E is the number of edges in
34 : C the graph and 2E = XADJ(N+1)-1
35 : C XADJ - Index vector for ADJ
36 : C - Nodes adjacent to node I are found in ADJ(J), where
37 : C J = XADJ(I),...,XADJ(I+1)-1
38 : C - Degree of node I given by XADJ(I+1)-XADJ(I)
39 : C ENTREES/SORTIES : -
40 : C SORTIES :
41 : C NNN - List of new node numbers
42 : C - New number for node I given by NNN(I)
43 : C TABLEAU DE TRAVAIL : IW
44 : C
45 : C
46 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
47 : C***********************************************************************
48 : C VERSION : v1, 05/11/99, version initiale
49 : C HISTORIQUE : v1, 10/03/89, création
50 : C HISTORIQUE :
51 : C HISTORIQUE :
52 : C***********************************************************************
53 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
54 : C en cas de modification de ce sous-programme afin de faciliter
55 : C la maintenance !
56 : C***********************************************************************
57 : -INC CCOPTIO
58 : INTEGER N,I1,I2,I3,SNODE,LSTNUM,NC,E2
59 : INTEGER XADJ(N+1),ADJ(E2),NNN(N),IW(3*N+1)
60 : INTEGER IMPR,IRET
61 : *
62 : * Executable statements
63 : *
64 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans label'
65 : *
66 : * Set all new node numbers = 0
67 : * This is used to denote all visible nodes
68 : * (already done)
69 : *
70 : * DO 10 I=1,N
71 : * NNN(I)=0
72 : * 10 CONTINUE
73 : *
74 : * Define offsets
75 : *
76 : I1=1
77 : I2=I1+N
78 : I3=I2+N+1
79 : *
80 : * Loop while some nodes remain unnumbered
81 : *
82 : LSTNUM=0
83 : 20 CONTINUE
84 : IF (LSTNUM.LT.N) THEN
85 : *
86 : * Find end points of p-diameter for nodes in this component
87 : * Compute distances of nodes from end node
88 : *
88 : CALL DIAMTR(N,E2,ADJ,XADJ,
89 : $ NNN,
90 : $ IW(I1),IW(I2),IW(I3),
91 : $ SNODE,NC,
92 : $ IMPR,IRET)
93 : IF (IRET.NE.0) GOTO 9999
94 : *
95 : * Number nodes in this component
96 : *
96 : CALL NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,
97 : $ NNN,
98 : $ IW(I1),IW(I2),
99 : $ IMPR,IRET)
100 : IF (IRET.NE.0) GOTO 9999
101 : GOTO 20
102 : ENDIF
103 : *
104 : * Normal termination
105 : *
106 : IRET=0
107 : RETURN
108 : *
109 : * Format handling
110 : *
111 : *
112 : * Error handling
113 : *
114 : 9999 CONTINUE
115 : IRET=1
116 : WRITE(IOIMP,*) 'An error was detected in subroutine label'
117 : RETURN
118 : *
119 : * End of subroutine LABEL
120 : *
121 : END
122 :
123 :
124 :
© Cast3M 2003 - All rights reserved.
Disclaimer