sd_ssf.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_ssf.f
00002 !
00101                      SUBROUTINE SD_SSF
00102 !                    *****************
00103 !
00104      &(N,P,IP,IA,JA,IJU,JU,IU,JUMAX,Q,MARK,JL,FLAG)
00105 !
00106 !***********************************************************************
00107 ! BIEF   V6P1                                   21/08/2010
00108 !***********************************************************************
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !| FLAG           |<--| LOGICAL VARIABLE;  IF DFLAG = .TRUE., THEN
00116 !|                |   | STORE NONZERO DIAGONAL ELEMENTS AT THE
00117 !|                |   | BEGINNING OF THE ROW
00118 !| IA             |<--| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING
00119 !|                |   | POINTERS TO DELIMIT ROWS IN JA AND A;
00120 !|                |   | DIMENSION = N+1
00121 !| IJU            |---| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING
00122 !|                |   | POINTERS TO THE START OF EACH ROW IN JU;  DIMENSION = N
00123 !| IP             |<--| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN
00124 !|                |   | THE INVERSE OF THE PERMUTATION RETURNED IN P;
00125 !|                |   | DIMENSION = N
00126 !| IU             |---| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING
00127 !|                |   | POINTERS TO DELIMIT ROWS IN U;  DIMENSION = N+1
00128 !| JA             |<--| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING THE
00129 !|                |   | COLUMN INDICES CORRESPONDING TO THE ELEMENTS
00130 !|                |   | OF A;  DIMENSION = NUMBER OF NONZERO ENTRIES
00131 !|                |   | IN (THE UPPER TRIANGLE OF) M
00132 !| JL             |-->| INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION N
00133 !|                |   | DIMENSION = NUMBER OF NONZERO ENTRIES IN THE
00134 !|                |   | UPPER TRIANGLE OF M. JL CONTAINS LISTS OF ROWS
00135 !|                |   | TO BE MERGED INTO UNELIMINATED ROWS --
00136 !|                |   | I GE K => JL(I) IS THE FIRST ROW TO BE
00137 !|                |   | MERGED INTO ROW I
00138 !|                |   | I LT K => JL(I) IS THE ROW FOLLOWING ROW I IN
00139 !|                |   | SOME LIST OF ROWS
00140 !|                |   | IN EITHER CASE, JL(I) = 0 INDICATES THE
00141 !|                |   | END OF A LIST
00142 !| JU             |---| INTEGER ONE-DIMENSIONAL ARRAY CONTAINING THE
00143 !|                |   | COLUMN INDICES CORRESPONDING TO THE ELEMENTS
00144 !|                |   | OF U;  DIMENSION = JUMAX
00145 !| JUMAX          |---| DECLARED DIMENSION OF THE ONE-DIMENSIONAL
00146 !|                |   | ARRAY JU;  JUMAX MUST BE AT LEAST THE SIZE
00147 !|                |   | OF U MINUS COMPRESSION (IJU(N) AFTER THE
00148 !|                |   | CALL TO SSF)
00149 !| MARK           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY; DIMENSION N
00150 !|                |   | THE LAST ROW STORED IN JU FOR WHICH U(MARK(I),I)
00151 !|                |   | NE 0
00152 !| N              |-->| ORDER OF THE MATRIX
00153 !| P              |<--| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN
00154 !|                |   | THE PERMUTATION OF THE ROWS AND COLUMNS OF M
00155 !|                |   | CORRESPONDING TO THE MINIMUM DEGREE ORDERING;
00156 !|                |   | DIMENSION = N
00157 !| Q              |-->| INTEGER ONE-DIMENSIONAL WORK ARRAY, DIMENSION N
00158 !|                |   | Q CONTAINS AN ORDERED LINKED LIST
00159 !|                |   | REPRESENTATION OF THE NONZERO
00160 !|                |   | STRUCTURE OF THE K-TH ROW OF U --
00161 !|                |   | Q(K) IS THE FIRST COLUMN WITH A NONZERO ENTRY
00162 !|                |   | Q(I) IS THE NEXT COLUMN WITH A NONZERO ENTRY
00163 !|                |   | AFTER COLUMN I
00164 !|                |   | IN EITHER CASE, Q(I) = N+1 INDICATES THE
00165 !|                |   | END OF THE LIST
00166 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00167 !
00168       USE BIEF, EX_SD_SSF => SD_SSF
00169 !
00170       IMPLICIT NONE
00171       INTEGER LNG,LU
00172       COMMON/INFO/LNG,LU
00173 !
00174 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00175 !
00176       INTEGER, INTENT(IN) :: N,JUMAX
00177       INTEGER, INTENT(INOUT) :: P(N),IP(N),IA(N+1),JA(*),IJU(N),FLAG
00178       INTEGER, INTENT(INOUT) :: JU(JUMAX),IU(N+1),Q(N),MARK(N),JL(N)
00179 !
00180 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00181 !
00182       INTEGER I,J,M,TAG,VJ,QM,JUMIN,JUPTR,K,LUK,LUI,JMIN,JMAX,LMAX
00183       LOGICAL CLIQUE
00184 !
00185 !-----------------------------------------------------------------------
00186 !
00187 !----INITIALISES
00188 !
00189 !    JUMIN AND JUPTR ARE THE INDICES IN JU OF THE FIRST AND LAST
00190 !    ELEMENTS IN THE LAST ROW SAVED IN JU
00191 !
00192 !    LUK IS THE NUMBER OF NONZERO ENTRIES IN THE K-TH ROW
00193 !
00194       JUMIN = 1
00195       JUPTR = 0
00196       IU(1) = 1
00197       DO K=1,N
00198         MARK(K) = 0
00199         JL(K) = 0
00200       ENDDO
00201 !
00202 !----FOR EACH ROW K
00203 !
00204       DO 19 K=1,N
00205         LUK = 0
00206         Q(K) = N+1
00207 !
00208         TAG = MARK(K)
00209         CLIQUE = .FALSE.
00210         IF(JL(K).NE.0)  CLIQUE = JL(JL(K)).EQ.0
00211 !
00212 !------INITIALISES NONZERO STRUCTURE OF K-TH ROW TO ROW P(K) OF M
00213 !
00214         JMIN = IA(P(K))
00215         JMAX = IA(P(K)+1) - 1
00216         IF (JMIN.GT.JMAX)  GO TO 4
00217         DO 3 J=JMIN,JMAX
00218           VJ = IP(JA(J))
00219           IF(VJ.LE.K)  GO TO 3
00220 !
00221           QM = K
00222 2         M = QM
00223           QM = Q(M)
00224           IF (QM.LT.VJ)  GO TO 2
00225           IF (QM.EQ.VJ)  GO TO 102
00226           LUK = LUK+1
00227           Q(M) = VJ
00228           Q(VJ) = QM
00229           IF (MARK(VJ).NE.TAG)  CLIQUE = .FALSE.
00230 !
00231 3       CONTINUE
00232 !
00233 !------IF EXACTLY ONE ROW IS TO BE MERGED INTO THE K-TH ROW AND THERE IS
00234 !------A NONZERO ENTRY IN EVERY COLUMN IN THAT ROW IN WHICH THERE IS A
00235 !------NONZERO ENTRY IN ROW P(K) OF M, THEN DOES NOT COMPUTE FILL-IN, JUST
00236 !------USES THE COLUMN INDICES FOR THE ROW WHICH WAS TO HAVE BEEN MERGED
00237 !
00238 4       IF(.NOT.CLIQUE)  GO TO 5
00239         IJU(K) = IJU(JL(K)) + 1
00240         LUK = IU(JL(K)+1) - (IU(JL(K))+1)
00241         GO TO 17
00242 !
00243 !------MODIFIES NONZERO STRUCTURE OF K-TH ROW BY COMPUTING FILL-IN
00244 !------FOR EACH ROW I TO BE MERGED IN
00245 !
00246 5       LMAX = 0
00247         IJU(K) = JUPTR
00248 !
00249         I = K
00250 6       I = JL(I)
00251         IF (I.EQ.0)  GO TO 10
00252 !
00253 !--------MERGES ROW I INTO K-TH ROW
00254 !
00255         LUI = IU(I+1) - (IU(I)+1)
00256         JMIN = IJU(I) +  1
00257         JMAX = IJU(I) + LUI
00258         QM = K
00259 !
00260         DO 8 J=JMIN,JMAX
00261           VJ = JU(J)
00262 7         M = QM
00263           QM = Q(M)
00264           IF (QM.LT.VJ)  GO TO 7
00265           IF (QM.EQ.VJ)  GO TO 8
00266           LUK = LUK+1
00267           Q(M) = VJ
00268           Q(VJ) = QM
00269           QM = VJ
00270 8       CONTINUE
00271 !
00272 !--------REMEMBERS LENGTH AND POSITION IN JU OF LONGEST ROW MERGED
00273 !
00274         IF(LUI.LE.LMAX)  GO TO 6
00275         LMAX = LUI
00276         IJU(K) = JMIN
00277 !
00278         GO TO 6
00279 !
00280 !------IF THE K-TH ROW IS THE SAME LENGTH AS THE LONGEST ROW MERGED,
00281 !------THEN USES THE COLUMN INDICES FOR THAT ROW
00282 !
00283 10      IF (LUK.EQ.LMAX)  GO TO 17
00284 !
00285 !------IF THE TAIL OF THE LAST ROW SAVED IN JU IS THE SAME AS THE HEAD
00286 !------OF THE K-TH ROW, THEN OVERLAPS THE TWO SETS OF COLUMN INDICES --
00287 !--------SEARCHES LAST ROW SAVED FOR FIRST NONZERO ENTRY IN K-TH ROW ...
00288 !
00289         I = Q(K)
00290         IF (JUMIN.GT.JUPTR)  GO TO 12
00291         DO 11 JMIN=JUMIN,JUPTR
00292           IF (JU(JMIN) < I) GOTO 11
00293           IF (JU(JMIN) == I) GOTO 13
00294           IF (JU(JMIN) > I) GOTO 12
00295 11      CONTINUE
00296 12      GO TO 15
00297 !
00298 !--------... AND THEN TESTS WHETHER TAIL MATCHES HEAD OF K-TH ROW
00299 !
00300 13      IJU(K) = JMIN
00301         DO J=JMIN,JUPTR
00302           IF (JU(J).NE.I)  GO TO 15
00303           I = Q(I)
00304           IF (I.GT.N)  GO TO 17
00305         ENDDO
00306         JUPTR = JMIN - 1
00307 !
00308 !------SAVES NONZERO STRUCTURE OF K-TH ROW IN JU
00309 !
00310 15      I = K
00311         JUMIN = JUPTR +  1
00312         JUPTR = JUPTR + LUK
00313         IF (JUPTR.GT.JUMAX)  GO TO 106
00314         DO J=JUMIN,JUPTR
00315           I = Q(I)
00316           JU(J) = I
00317           MARK(I) = K
00318         ENDDO
00319         IJU(K) = JUMIN
00320 !
00321 !------ADDS K TO ROW LIST FOR FIRST NONZERO ELEMENT IN K-TH ROW
00322 !
00323 17      IF(LUK.LE.1)  GO TO 18
00324         I = JU(IJU(K))
00325         JL(K) = JL(I)
00326         JL(I) = K
00327 !
00328 18    IU(K+1) = IU(K) + LUK
00329 !
00330 19    CONTINUE
00331 !
00332       FLAG = 0
00333       RETURN
00334 !
00335 ! ** ERROR -- DUPLICATE ENTRY IN A
00336 !
00337 102   FLAG = 2*N + P(K)
00338       RETURN
00339 !
00340 ! ** ERROR -- INSUFFICIENT STORAGE FOR JU
00341 !
00342 106   FLAG = 6*N + K
00343       RETURN
00344       END

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