Initial commit from Polytechnique Montreal

1 files changed, 105 insertions, 0 deletions

diff --git a/Utilib/src/RENLST.f b/Utilib/src/RENLST.f
new file mode 100644
index 0000000..06cd860
--- /dev/null
+++ b/Utilib/src/RENLST.f
@@ -0,0 +1,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