sd_mdu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_mdu.f
00002 !
00055                      SUBROUTINE SD_MDU
00056 !                    *****************
00057 !
00058      &(EK,DMIN,V,L,HEAD,LAST,NEXT,MARK)
00059 !
00060 !***********************************************************************
00061 ! BIEF   V6P0                                   21/08/2010
00062 !***********************************************************************
00063 !
00064 !
00065 !
00066 !
00067 !
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| DMIN           |---|
00071 !| EK             |-->|
00072 !| HEAD           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
00073 !| L              |<--| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
00074 !| LAST           |---| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE
00075 !|                |   | PERMUTATION OF THE ROWS AND COLUMNS OF M
00076 !|                |   | CORRESPONDING TO THE MINIMUM DEGREE ORDERING;
00077 !|                |   | DIMENSION = N
00078 !| MARK           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
00079 !| NEXT           |---| INVERSE OF THE PERMUTATION RETURNED IN LAST
00080 !|                |   | DIMENSION = N
00081 !| V              |-->| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !
00084       USE BIEF, EX_SD_MDU => SD_MDU
00085 !
00086       IMPLICIT NONE
00087       INTEGER LNG,LU
00088       COMMON/INFO/LNG,LU
00089 !
00090 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00091 !
00092       INTEGER, INTENT(IN)    ::  EK,V(*),L(*)
00093       INTEGER, INTENT(INOUT) ::  DMIN,HEAD(*),LAST(*),NEXT(*),MARK(*)
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER TAG,VI,EVI,DVI,S,VS,ES,B,VB,ILP,ILPMAX,BLP,BLPMAX,I
00098       EQUIVALENCE (VS,ES)
00099 !
00100 !----INITIALISES TAG
00101 !
00102       TAG = MARK(EK) - LAST(EK)
00103 !
00104 !----FOR EACH VERTEX VI IN EK
00105 !
00106       I = EK
00107       ILPMAX = LAST(EK)
00108       IF(ILPMAX.LE.0)  GO TO 11
00109       DO 10 ILP=1,ILPMAX
00110         I = L(I)
00111         VI = V(I)
00112         IF (LAST(VI) < 0) GOTO 1
00113         IF (LAST(VI) == 0) GOTO 10
00114         IF (LAST(VI) > 0) GOTO 8
00115 !
00116 !------IF VI NEITHER PROTOTYPE NOR DUPLICATE VERTEX, THEN MERGES ELEMENTS
00117 !------TO COMPUTE DEGREE
00118 !
00119 1       TAG = TAG + 1
00120         DVI = LAST(EK)
00121 !
00122 !--------FOR EACH VERTEX/ELEMENT VS/ES IN ELEMENT LIST OF VI
00123 !
00124         S = L(VI)
00125 2       S = L(S)
00126         IF(S.EQ.0) GO TO 9
00127         VS = V(S)
00128         IF(NEXT(VS).LT.0)  GO TO 3
00129 !
00130 !----------IF VS IS UNELIMINATED VERTEX, THEN TAGS AND ADJUSTS DEGREE
00131 !
00132         MARK(VS) = TAG
00133         DVI = DVI + 1
00134         GO TO 5
00135 !
00136 !----------IF ES IS ACTIVE ELEMENT, THEN EXPANDS
00137 !------------CHECK FOR OUTMATCHED VERTEX
00138 !
00139 3       IF(MARK(ES).LT.0)  GO TO 6
00140 !
00141 !------------FOR EACH VERTEX VB IN ES
00142 !
00143         B = ES
00144         BLPMAX = LAST(ES)
00145         DO 4 BLP=1,BLPMAX
00146           B = L(B)
00147           VB = V(B)
00148 !
00149 !--------------IF VB IS UNTAGGED, THEN TAGS AND ADJUSTS DEGREE
00150 !
00151           IF(MARK(VB).GE.TAG)  GO TO 4
00152           MARK(VB) = TAG
00153           DVI = DVI + 1
00154 4       CONTINUE
00155 !
00156 5       GO TO 2
00157 !
00158 !------ELSE IF VI IS OUTMATCHED VERTEX, THEN ADJUSTS OVERLAPS BUT DOES NOT
00159 !------COMPUTE DEGREE
00160 !
00161 6       LAST(VI) = 0
00162         MARK(ES) = MARK(ES) - 1
00163 7       S = L(S)
00164         IF(S.EQ.0)  GO TO 10
00165         ES = V(S)
00166         IF(MARK(ES).LT.0)  MARK(ES) = MARK(ES) - 1
00167         GO TO 7
00168 !
00169 !------ELSE IF VI IS PROTOTYPE VERTEX, THEN CALCULATES DEGREE BY
00170 !------INCLUSION/EXCLUSION AND RESETS OVERLAP COUNT
00171 !
00172 8       EVI = LAST(VI)
00173         DVI = LAST(EK) + LAST(EVI) + MARK(EVI)
00174         MARK(EVI) = 0
00175 !
00176 !------INSERTS VI IN APPROPRIATE DEGREE LIST
00177 !
00178 9       NEXT(VI)  = HEAD(DVI)
00179         HEAD(DVI) = VI
00180         LAST(VI)  = -DVI
00181         IF(NEXT(VI).GT.0)  LAST(NEXT(VI)) = VI
00182         IF(DVI.LT.DMIN)  DMIN = DVI
00183 !
00184 10    CONTINUE
00185 !
00186 11    CONTINUE
00187 !
00188 !-----------------------------------------------------------------------
00189 !
00190       RETURN
00191       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0