gsebe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\gsebe.f
00002 !
00063                      SUBROUTINE GSEBE
00064 !                    ****************
00065 !
00066      &(B,A,MESH)
00067 !
00068 !***********************************************************************
00069 ! BIEF   V6P1                                   21/08/2010
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00078 !| A              |<--| MATRIX A.
00079 !| B              |<--| RESULTING MATRIX.
00080 !| MESH           |-->| MESH STRUCTURE.
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE BIEF, EX_GSEBE => GSEBE
00084 !
00085       IMPLICIT NONE
00086       INTEGER LNG,LU
00087       COMMON/INFO/LNG,LU
00088 !
00089 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00090 !
00091       TYPE(BIEF_OBJ), INTENT(IN) :: A
00092       TYPE(BIEF_OBJ), INTENT(INOUT) :: B
00093       TYPE(BIEF_MESH), INTENT(IN) :: MESH
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER SA,SB,I
00098 !
00099       DOUBLE PRECISION C
00100 !
00101 !-----------------------------------------------------------------------
00102 !
00103       IF(A%TYPE.EQ.3) THEN
00104         SA = 0
00105       ELSEIF(A%TYPE.EQ.4) THEN
00106         SA = A%N
00107       ELSE
00108         IF (LNG.EQ.1) WRITE(LU,300) A%TYPE
00109         IF (LNG.EQ.2) WRITE(LU,400) A%TYPE
00110 300     FORMAT(1X,'GSEBE (BIEF) :',1I6,' TYPE DE A NON PREVU.')
00111 400     FORMAT(1X,'GSEBE (BIEF) :',1I6,' UNEXPECTED TYPE FOR A.')
00112         CALL PLANTE(1)
00113         STOP
00114       ENDIF
00115 !
00116       IF(B%TYPE.EQ.3) THEN
00117         SB = 0
00118       ELSEIF(B%TYPE.EQ.4) THEN
00119         SB = B%N
00120       ELSE
00121         IF (LNG.EQ.1) WRITE(LU,301) B%TYPE
00122         IF (LNG.EQ.2) WRITE(LU,401) B%TYPE
00123 301     FORMAT(1X,'GSEBE (BIEF) :',1I6,' TYPE DE B NON PREVU.')
00124 401     FORMAT(1X,'GSEBE (BIEF) :',1I6,' UNEXPECTED TYPE FOR B.')
00125         CALL PLANTE(1)
00126         STOP
00127       ENDIF
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       IF(SA.EQ.0.AND.SB.EQ.0) THEN
00132 !
00133 !         B%D IS HERE A STRUCTURE OF VECTOR
00134 !         USED AS DUMMY DIAGONAL
00135           CALL OM( 'M=N     ' , B , A , B%D , C , MESH )
00136           B%TYPDIA='I'
00137 !
00138       ELSEIF(SA.GT.0.AND.SB.GT.0) THEN
00139 !
00140 !       TAKES THE DIAGONALS OF BLOCK A
00141 !
00142         DO I=1,SB
00143           CALL OM( 'M=N     ' ,  B%ADR(I)%P ,
00144      &              A%ADR(1+(SB+1)*(I-1))%P , B%ADR(I)%P%D ,
00145      &              C , MESH )
00146           B%ADR(I)%P%TYPDIA='I'
00147         ENDDO ! I
00148 !
00149       ELSEIF(SA.NE.0.AND.SB.EQ.0) THEN
00150 !
00151 !       TAKES THE 1ST DIAGONAL OF BLOCK A
00152 !
00153         CALL OM( 'M=N     ' ,B,A%ADR(1)%P,B%D,C,MESH)
00154         B%TYPDIA='I'
00155 !
00156       ELSE
00157 !
00158         IF (LNG.EQ.1) WRITE(LU,302)
00159         IF (LNG.EQ.2) WRITE(LU,402)
00160 302     FORMAT(1X,'GSEBE (BIEF) : CAS NON PREVU')
00161 402     FORMAT(1X,'GSEBE (BIEF) : UNEXPECTED CASE')
00162         CALL PLANTE(1)
00163         STOP
00164 !
00165       ENDIF
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169       RETURN
00170       END

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