1 : C PROFI1 SOURCE CHAT 05/01/13 02:30:38 5004
2 : SUBROUTINE PROFI1(N,NNN,E2,ADJ,XADJ,
3 : $ OLDPRO,NEWPRO,
4 : $ IMPR,IRET)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8 (A-H,O-Z)
7 : C***********************************************************************
8 : C NOM : PROFI1
9 : C DESCRIPTION : Compute the profile using original and new node numbers
10 : C
11 : C LANGAGE : FORTRAN 77 (sauf E/S)
12 : C
13 : C AUTEUR : Scott Sloan
14 : C
15 : C BIBLIO : @Article{,
16 : C author = {S. W. Sloan},
17 : C title = {A Fortran Program for Profile and Wavefront Reduction},
18 : C journal = {International Journal for Numerical Methods in Engineering},
19 : C year = {1989},
20 : C volume = {28},
21 : C pages = {2651-2679}
22 : C}
23 : C
24 : C***********************************************************************
25 : C APPELE PAR : LABEL
26 : C***********************************************************************
27 : C ENTREES :
28 : C N - Number of nodes in graph
29 : C NNN - List of new node numbers
30 : C - New number for node I given by NNN(I)
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 OLDPRO - Profile with original node numbering
42 : C NEWPRO - Profile with new node numbering
43 : C
44 : C NOTES :
45 : C
46 : C Profiles include diagonal terms
47 : C
48 : C
49 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
50 : C***********************************************************************
51 : C VERSION : v1, 05/11/99, version initiale
52 : C HISTORIQUE : v1, 10/03/89, création
53 : C HISTORIQUE :
54 : C HISTORIQUE :
55 : C***********************************************************************
56 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
57 : C en cas de modification de ce sous-programme afin de faciliter
58 : C la maintenance !
59 : C***********************************************************************
60 : -INC CCOPTIO
61 : INTEGER NEWPRO,I,J,N,JSTRT,JSTOP,OLDPRO,NEWMIN,OLDMIN,E2
62 : INTEGER NNN(N),XADJ(N+1),ADJ(E2)
63 : INTEGER IMPR,IRET
64 : *
65 : * Executable statements
66 : *
67 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi1'
68 : *
69 : * Set profiles and loop over each node in graph
70 : *
71 : OLDPRO=0
72 : NEWPRO=0
73 : DO 20 I=1,N
74 : JSTRT=XADJ(I)
75 : JSTOP=XADJ(I+1)-1
76 : OLDMIN=ADJ(JSTRT)
77 : NEWMIN=NNN(ADJ(JSTRT))
78 : *
79 : * Find lowest numbered neighbour of node I
80 : * (using both old and new node numbers)
81 : *
82 : DO 10 J=JSTRT+1,JSTOP
83 : OLDMIN=MIN(OLDMIN,ADJ(J))
84 : NEWMIN=MIN(NEWMIN,NNN(ADJ(J)))
85 : 10 CONTINUE
86 : *
87 : * Update profiles
88 : *
89 : OLDPRO=OLDPRO+DIM(I,OLDMIN)
90 : NEWPRO=NEWPRO+DIM(NNN(I),NEWMIN)
91 : 20 CONTINUE
92 : *
93 : * Add diagonal terms to profiles
94 : *
95 : OLDPRO=OLDPRO+N
96 : NEWPRO=NEWPRO+N
97 : *
98 : * Normal termination
99 : *
100 : IRET=0
101 : RETURN
102 : *
103 : * Format handling
104 : *
105 : *
106 : * Error handling
107 : *
108 : 9999 CONTINUE
109 : IRET=1
110 : WRITE(IOIMP,*) 'An error was detected in subroutine profi1'
111 : RETURN
112 : *
113 : * End of subroutine PROFI1
114 : *
115 : END
116 :
117 :
118 :
© Cast3M 2003 - All rights reserved.
Disclaimer