sd_mdi.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\sd_mdi.f
00002 !
00060                      SUBROUTINE SD_MDI
00061 !                    *****************
00062 !
00063      &(N,IA,JA,MAXIMUM,V,L,HEAD,LAST,NEXT,MARK,TAG,FLAG)
00064 !
00065 !***********************************************************************
00066 ! BIEF   V6P2                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| FLAG           |<--| FLAG - INTEGER ERROR FLAG;  VALUES AND THEIR
00077 !|                |   | MEANINGS ARE : 0      NO ERRORS DETECTED
00078 !|                |   |         9*N + VI  INSUFFICIENT STORAGE IN MDI
00079 !| HEAD           |<--| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
00080 !| IA, JA         |-->| COMPACT STORAGE STRUCTURE OF MATRIX
00081 !| L              |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
00082 !| LAST           |---| INTEGER ONE-DIMENSIONAL ARRAY USED TO RETURN THE
00083 !|                |   | PERMUTATION OF THE ROWS AND COLUMNS OF M
00084 !|                |   | CORRESPONDING TO THE MINIMUM DEGREE ORDERING;
00085 !|                |   | DIMENSION = N
00086 !| MARK           |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=N
00087 !| MAXIMUM        |-->| DECLARED DIMENSION OF THE ONE-DIMENSIONAL ARRAYS
00088 !|                |   | V AND L;
00089 !| N              |-->| RANK OF MATRIX
00090 !| NEXT           |<--| INVERSE OF THE PERMUTATION RETURNED IN LAST
00091 !|                |   | DIMENSION = N
00092 !| TAG            |-->| SEE DEFINITION IN INTERNAL PARAMATERS OF SD_MD.f
00093 !| V              |---| INTEGER ONE-DIMENSIONAL WORK ARRAY;DIMENSION=MAX
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF, EX_SD_MDI => SD_MDI
00097 !
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       INTEGER, INTENT(IN)    :: N,MAXIMUM,IA(*),JA(*)
00105       INTEGER, INTENT(INOUT) :: V(*),L(*),HEAD(*),LAST(*)
00106       INTEGER, INTENT(INOUT) :: NEXT(*),MARK(*),TAG,FLAG
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER SFS,VI,DVI,VJ,JMIN,JMAX,J
00111 !
00112 !----INITIALISES DEGREES, ELEMENT LISTS, AND DEGREE LISTS
00113 !
00114       DO VI=1,N
00115         MARK(VI) = 1
00116         L(VI) = 0
00117         HEAD(VI) = 0
00118       ENDDO ! VI
00119       SFS = N+1
00120 !
00121 !----CREATES NONZERO STRUCTURE
00122 !----FOR EACH NONZERO ENTRY A(VI,VJ) IN STRICT UPPER TRIANGLE
00123 !
00124       DO VI=1,N
00125         JMIN = IA(VI)
00126         JMAX = IA(VI+1) - 1
00127         IF(JMIN.GT.JMAX)  CYCLE
00128         DO J=JMIN,JMAX
00129           VJ = JA(J)
00130           IF(VI.GE.VJ) CYCLE
00131           IF(SFS.GE.MAXIMUM) GO TO 101
00132 !
00133 !------ENTERS VJ IN ELEMENT LIST FOR VI
00134 !
00135           MARK(VI) = MARK(VI) + 1
00136           V(SFS) = VJ
00137           L(SFS) = L(VI)
00138           L(VI) = SFS
00139           SFS = SFS+1
00140 !
00141 !------ENTERS VI IN ELEMENT LIST FOR VJ
00142 !
00143           MARK(VJ) = MARK(VJ) + 1
00144           V(SFS) = VI
00145           L(SFS) = L(VJ)
00146           L(VJ) = SFS
00147           SFS = SFS+1
00148         ENDDO ! J
00149       ENDDO ! VI
00150 !
00151 !----CREATES DEGREE LISTS AND INITIALISES MARK VECTOR
00152 !
00153       DO VI=1,N
00154         DVI = MARK(VI)
00155         NEXT(VI) = HEAD(DVI)
00156         HEAD(DVI) = VI
00157         LAST(VI) = -DVI
00158         IF(NEXT(VI).GT.0)  LAST(NEXT(VI)) = VI
00159         MARK(VI) = TAG
00160       ENDDO ! VI
00161 !
00162       RETURN
00163 !
00164 ! ** ERROR -- INSUFFICIENT STORAGE
00165 !
00166 101   FLAG = 9*N + VI
00167 !
00168 !-----------------------------------------------------------------------
00169 !
00170       RETURN
00171       END

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