downup.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\downup.f
00002 !
00114                      SUBROUTINE DOWNUP
00115 !                    *****************
00116 !
00117      &(X, A,B ,DITR,MESH)
00118 !
00119 !***********************************************************************
00120 ! BIEF   V6P1                                   21/08/2010
00121 !***********************************************************************
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !
00128 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00129 !| A              |-->| MATRIX A
00130 !| B              |<--| RIGHT-HAND SIDE OF THE SYSTEM
00131 !| DITR           |-->| OPTION  'D' : MATRIX A IS TAKEN
00132 !|                |   |         'T' : MATRIX TRANSPOSED(A)
00133 !| MESH           |-->| MESH STRUCTURE
00134 !| X              |<--| SOLUTION OF SYSTEM AX = B
00135 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00136 !
00137       USE BIEF, EX_DOXNUP => DOWNUP
00138 !
00139       IMPLICIT NONE
00140       INTEGER LNG,LU
00141       COMMON/INFO/LNG,LU
00142 !
00143 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00144 !
00145       TYPE(BIEF_OBJ), INTENT(INOUT) :: X
00146       TYPE(BIEF_OBJ), INTENT(IN)    :: A,B
00147       TYPE(BIEF_MESH), INTENT(IN)   :: MESH
00148       CHARACTER(LEN=1), INTENT(IN)  :: DITR
00149 !
00150 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00151 !
00152       INTEGER S,SA,I
00153 !
00154 !-----------------------------------------------------------------------
00155 !
00156       IF(X%TYPE.EQ.4) THEN
00157         S = X%N
00158       ELSE
00159         S = 0
00160       ENDIF
00161 !
00162 !     COVERS THE CASE WHERE THE SYSTEM IS A BLOCK BUT WHERE ONLY ONE OF
00163 !     PRECONDITIONING MATRICES IS USED
00164 !
00165       IF(A%TYPE.EQ.3) THEN
00166         SA = 0
00167       ELSEIF(A%TYPE.EQ.4) THEN
00168         SA = A%N
00169       ELSE
00170         IF (LNG.EQ.1) WRITE(LU,300) A%TYPE
00171         IF (LNG.EQ.2) WRITE(LU,400) A%TYPE
00172 300     FORMAT(1X,'DOWNUP (BIEF) :',1I6,' TYPE DE A NON PREVU.')
00173 400     FORMAT(1X,'DOWNUP (BIEF) :',1I6,' UNEXPECTED TYPE FOR A.')
00174         CALL PLANTE(1)
00175         STOP
00176       ENDIF
00177 !
00178 !-----------------------------------------------------------------------
00179 !
00180       IF(S.EQ.0.AND.SA.EQ.0) THEN
00181 !
00182 !     CASE WHERE A IS A SIMPLE MATRIX AND X A SIMPLE VECTOR
00183 !
00184         CALL DWNUP1(X, A,B ,DITR,MESH)
00185 !
00186       ELSEIF(S.GT.0.AND.S.EQ.SA) THEN
00187 !
00188 !     CASE WHERE BLOCK A ONLY CONTAINS THE DIAGONALS
00189 !
00190         DO I=1,S
00191           CALL DWNUP1(X%ADR(I)%P,
00192      &                A%ADR(I)%P,
00193      &                B%ADR(I)%P,
00194      &                DITR,MESH)
00195         ENDDO ! I
00196 !
00197       ELSEIF(S.GT.0.AND.S**2.EQ.SA) THEN
00198 !
00199 !     CASE WHERE BLOCK A CONTAINS AS MANY MATRICES AS THERE ARE IN
00200 !     THE COMPLETE SYSTEM: ONLY CONSIDERS THE DIAGONALS
00201 !
00202         DO I=1,S
00203           CALL DWNUP1(X%ADR(I)%P,
00204      &                A%ADR(1+(S+1)*(I-1))%P,
00205      &                B%ADR(I)%P,
00206      &                DITR,MESH)
00207         ENDDO ! I
00208 !
00209 !     CASE WHERE A IS A SINGLE MATRIX AND X IS A BLOCK
00210 !
00211       ELSEIF(S.GT.0.AND.SA.EQ.0) THEN
00212 !
00213         DO I=1,S
00214           CALL DWNUP1(X%ADR(I)%P,
00215      &                A,
00216      &                B%ADR(I)%P,
00217      &                DITR,MESH)
00218         ENDDO ! I
00219 !
00220       ELSE
00221         IF (LNG.EQ.1) WRITE(LU,301)
00222         IF (LNG.EQ.2) WRITE(LU,401)
00223 301     FORMAT(1X,'DOWNUP (BIEF) : CAS NON PREVU')
00224 401     FORMAT(1X,'DOWNUP (BIEF) : UNEXPECTED CASE')
00225         CALL PLANTE(1)
00226         STOP
00227       ENDIF
00228 !
00229 !-----------------------------------------------------------------------
00230 !
00231       RETURN
00232       END

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