1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
*DECK RENLST
SUBROUTINE RENLST(N,LC,NFIRST,IM,MCU,TYPOR,NLEV,LEV,LEVPT,MASK)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Level-set traversal method of the graph of a matrix stored
* in MSR format.
*
*Reference
* Y. Saad, "Iterative Methods for Sparse Linear Systems",
* PWS Publishing Company, Boston, 1996
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): R. Le Tellier
*
*Parameters: input
* N order of the system.
* LC size of MCU.
* NFIRST starting node.
* IM
* MCU connection matrices which defines the graph of the ACA matrix.
* TYPOR type of level traversal
* 0 : Breadth First Search
* 1 : Cuthill-McKee ordering
*
* Parameters: output
* NLEV number of level in the last level-set traversal.
* LEV
* LEVPT level data structure of the last level-set traversal.
* LEV(LEVPT(I):LEVPT(I+1)-1) : nodes in level i.
* MASK mask for node to be considered in this search.
*
*-----------------------------------------------------------------------
*
IMPLICIT NONE
*---
* SUBROUTINE ARGUMENTS
*---
INTEGER N,LC,NFIRST,IM(N+1),MCU(LC),TYPOR,NLEV,LEV(N),
1 LEVPT(N+1),MASK(N)
*---
* LOCAL VARIABLES
*---
INTEGER IDEB,IEND,NEWEND,I,NODE,J,NJ,RENDEG
INTEGER, DIMENSION(:), ALLOCATABLE :: DEG
*
ALLOCATE(DEG(N))
MASK(:N)=1
NLEV=1
IDEB=1
IEND=1
LEVPT(NLEV)=IDEB
LEV(1)=NFIRST
MASK(NFIRST)=0
*
DO WHILE (IEND.LT.N)
* visit neighboring nodes of nodes LEV(IDEB^in:IEND^in)
NEWEND=IEND
IF (TYPOR.EQ.1) THEN
* Cuthill McKee ordering
* find the degrees for this level
DO I=IDEB,IEND
NODE=LEV(I)
DEG(I-IDEB+1)=RENDEG(N,LC,IM,MCU,NODE,MASK)
ENDDO
* sort this level by increasing degrees
CALL RENINS((IEND-IDEB+1),LEV(IDEB),DEG)
ENDIF
DO I=IDEB,IEND
NODE=LEV(I)
DO J=IM(NODE)+1,IM(NODE+1)
NJ=MCU(J)
if (NJ.GT.0) THEN
if (MASK(NJ).EQ.1) THEN
NEWEND=NEWEND+1
MASK(NJ)=0
LEV(NEWEND)=NJ
ENDIF
ENDIF
ENDDO
ENDDO
IF (NEWEND.EQ.IEND)
1 CALL XABORT('RENLST: INCOHERENT MATRIX GRAPH')
IDEB=IEND+1
IEND=NEWEND
* unmarked neighbors are added in LEV(IDEB^out:IEND^out)
* where IDEB^out=IEND^in + 1
* IEND^out=IEND^in + number of unmarked neighbors found
* start new level
NLEV=NLEV+1
LEVPT(NLEV)=IEND+1
ENDDO
NLEV=NLEV-1
*
DEALLOCATE(DEG)
*
RETURN
END
|
