puog.f

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

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