sd_mdu.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE sd_mdu
!                   *****************
!
     &(ek,dmin,v,l,head,last,next,mark)
!
!***********************************************************************
! BIEF   V6P0                                   21/08/2010
!***********************************************************************
!
!brief    UPDATES DEGREES OF UNELIMINATED VERTICES IN EK.
!
!note     IMPORTANT : INSPIRED FROM PACKAGE CMLIB3 - YALE UNIVERSITE-YSMP
!
!history  E. RAZAFINDRAKOTO (LNH)
!+        20/11/06
!+        V5P7
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DMIN           |---|
!| EK             |-->|
!| HEAD           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
!| L              |<--| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
!| LAST           |---| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE
!|                |   | PERMUTATION OF THE ROWS AND COLUMNS OF M
!|                |   | CORRESPONDING TO THE MINIMUM DEGREE ORDERING;
!|                |   | DIMENSION = N
!| MARK           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
!| NEXT           |---| INVERSE OF THE PERMUTATION RETURNED IN LAST
!|                |   | DIMENSION = N
!| V              |-->| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_sd_mdu => sd_mdu
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)    ::  EK,V(*),L(*)
      INTEGER, INTENT(INOUT) ::  DMIN,HEAD(*),LAST(*),NEXT(*),MARK(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER TAG,VI,EVI,DVI,S,VS,ES,B,VB,ILP,ILPMAX,BLP,BLPMAX,I
      equivalence(vs,es)
!
!----INITIALISES TAG
!
      tag = mark(ek) - last(ek)
!
!----FOR EACH VERTEX VI IN EK
!
      i = ek
      ilpmax = last(ek)
      IF(ilpmax.LE.0)  GO TO 11
      DO 10 ilp=1,ilpmax
        i = l(i)
        vi = v(i)
        IF (last(vi) < 0) GOTO 1
        IF (last(vi) == 0) GOTO 10
        IF (last(vi) > 0) GOTO 8
!
!------IF VI NEITHER PROTOTYPE NOR DUPLICATE VERTEX, THEN MERGES ELEMENTS
!------TO COMPUTE DEGREE
!
1       tag = tag + 1
        dvi = last(ek)
!
!--------FOR EACH VERTEX/ELEMENT VS/ES IN ELEMENT LIST OF VI
!
        s = l(vi)
2       s = l(s)
        IF(s.EQ.0) GO TO 9
        vs = v(s)
        IF(next(vs).LT.0)  GO TO 3
!
!----------IF VS IS UNELIMINATED VERTEX, THEN TAGS AND ADJUSTS DEGREE
!
        mark(vs) = tag
        dvi = dvi + 1
        GO TO 5
!
!----------IF ES IS ACTIVE ELEMENT, THEN EXPANDS
!------------CHECK FOR OUTMATCHED VERTEX
!
3       IF(mark(es).LT.0)  GO TO 6
!
!------------FOR EACH VERTEX VB IN ES
!
        b = es
        blpmax = last(es)
        DO 4 blp=1,blpmax
          b = l(b)
          vb = v(b)
!
!--------------IF VB IS UNTAGGED, THEN TAGS AND ADJUSTS DEGREE
!
          IF(mark(vb).GE.tag)  GO TO 4
          mark(vb) = tag
          dvi = dvi + 1
4       CONTINUE
!
5       GO TO 2
!
!------ELSE IF VI IS OUTMATCHED VERTEX, THEN ADJUSTS OVERLAPS BUT DOES NOT
!------COMPUTE DEGREE
!
6       last(vi) = 0
        mark(es) = mark(es) - 1
7       s = l(s)
        IF(s.EQ.0)  GO TO 10
        es = v(s)
        IF(mark(es).LT.0)  mark(es) = mark(es) - 1
        GO TO 7
!
!------ELSE IF VI IS PROTOTYPE VERTEX, THEN CALCULATES DEGREE BY
!------INCLUSION/EXCLUSION AND RESETS OVERLAP COUNT
!
8       evi = last(vi)
        dvi = last(ek) + last(evi) + mark(evi)
        mark(evi) = 0
!
!------INSERTS VI IN APPROPRIATE DEGREE LIST
!
9       next(vi)  = head(dvi)
        head(dvi) = vi
        last(vi)  = -dvi
        IF(next(vi).GT.0)  last(next(vi)) = vi
        IF(dvi.LT.dmin)  dmin = dvi
!
10    CONTINUE
!
11    CONTINUE
!
!-----------------------------------------------------------------------
!
      RETURN
      END