sd_mdp.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE sd_mdp
!                   *****************
!
     &(k,ek,tail,v,l,head,last,next,mark)
!
!***********************************************************************
! BIEF   V6P1                                   21/07/2011
!***********************************************************************
!
!brief    PURGES INACTIVE ELEMENTS AND DOES MASS ELIMINATION.
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| EK             |-->|
!| HEAD           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
!| K              |-->|
!| 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
!| TAIL           |---|
!| V              |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_sd_mdp => sd_mdp
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)    :: EK
      INTEGER, INTENT(INOUT) :: K,TAIL,V(*),L(*),HEAD(*)
      INTEGER, INTENT(INOUT) :: LAST(*),NEXT(*),MARK(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER TAG,FREE,ILI,VI,LVI,EVI,S,LS,ES,ILP,ILPMAX,I
!
!----INITIALISES TAG
!
      tag = mark(ek)
!
!----FOR EACH VERTEX VI IN EK
!
      ili = ek
      ilpmax = last(ek)
      IF(ilpmax.LE.0)  GO TO 12
      DO 11 ilp=1,ilpmax
        i = ili
        ili = l(i)
        vi = v(ili)
!
!------REMOVES VI FROM DEGREE LIST
!
        IF(last(vi).EQ.0) GO TO 3
        IF(last(vi).GT.0) GO TO 1
        head(-last(vi)) = next(vi)
        GO TO 2
1       next(last(vi)) = next(vi)
2       IF(next(vi).GT.0)  last(next(vi)) = last(vi)
!
!------REMOVES INACTIVE ITEMS FROM ELEMENT LIST OF VI
!
3       ls = vi
4       s = ls
        ls = l(s)
        IF(ls.EQ.0)  GO TO 6
        es = v(ls)
        IF (mark(es).LT.tag)  GO TO 5
        free = ls
        l(s) = l(ls)
        ls = s
5       GO TO 4
!
!------IF VI IS INTERIOR VERTEX, THEN REMOVES FROM LIST AND ELIMINATES
!
6       lvi = l(vi)
        IF(lvi.NE.0)  GO TO 7
        l(i) = l(ili)
        ili = i
!
        k = k+1
        next(vi) = -k
        last(ek) = last(ek) - 1
        GO TO 11
!
!------ELSE ...
!--------CLASSIFIES VERTEX VI
!
7       IF (l(lvi).NE.0)  GO TO 9
        evi = v(lvi)
        IF(next(evi).GE.0)  GO TO 9
        IF(mark(evi).LT.0)  GO TO 8
!
!----------IF VI IS PROTOTYPE VERTEX, THEN MARKS AS SUCH, INITIALISES
!----------OVERLAP COUNT FOR CORRESPONDING ELEMENT, AND MOVES VI TO END
!----------OF BOUNDARY LIST
!
        last(vi) = evi
        mark(evi) = -1
        l(tail) = ili
        tail = ili
        l(i) = l(ili)
        ili = i
        GO TO 10
!
!----------ELSE IF VI IS DUPLICATE VERTEX, THEN MARKS AS SUCH AND ADJUSTS
!----------OVERLAP COUNT FOR CORRESPONDING ELEMENT
!
8       last(vi) = 0
        mark(evi) = mark(evi) - 1
        GO TO 10
!
!----------ELSE MARKS VI TO COMPUTE DEGREE
!
9       last(vi) = -ek
!
!--------INSERTS EK IN ELEMENT LIST OF VI
!
10      v(free) = ek
        l(free) = l(vi)
        l(vi) = free
11    CONTINUE
!
!----TERMINATES BOUNDARY LIST
!
12    l(tail) = 0
!
!-----------------------------------------------------------------------
!
      RETURN
      END