desseg.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\desseg.f
00002 !
00076                      SUBROUTINE DESSEG
00077 !                    *****************
00078 !
00079      &(X, XA,TYPEXA,B,GLOSEG,NSEG,NPOIN,DITR,COPY)
00080 !
00081 !***********************************************************************
00082 ! BIEF   V6P1                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !| B              |<--| RIGHT-HAND SIDE OF THE LINEAR SYSTEM TO BE SOLVED
00091 !| COPY           |-->| IF .TRUE. B IS COPIED INTO X TO START WITH
00092 !| DITR           |-->| CHARACTER, IF  'D' : DIRECT MATRIX A CONSIDERED
00093 !|                |   |                'T' : TRANSPOSED MATRIX A CONSIDERED
00094 !| GLOSEG         |-->| GLOBAL NUMBERS OF POINTS OF SEGMENTS
00095 !| NPOIN          |-->| NUMBER OF POINTS
00096 !| NSEG           |-->| NUMBER OF SEGMENTS
00097 !| TYPEXA         |-->| TYPE OF OFF-DIAGONAL TERMS IN THE MATRIX
00098 !| X              |<--| SOLUTION OF THE SYSTEM AX = B
00099 !| XA             |<--| OFF-DIAGONAL TERMS OF THE MATRIX
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !
00102       USE BIEF, EX_DESSEG => DESSEG
00103 !
00104       IMPLICIT NONE
00105       INTEGER LNG,LU
00106       COMMON/INFO/LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER         , INTENT(IN)    :: NPOIN,NSEG
00111       INTEGER         , INTENT(IN)    :: GLOSEG(NSEG,2)
00112       DOUBLE PRECISION, INTENT(INOUT) :: X(NPOIN)
00113       DOUBLE PRECISION, INTENT(IN)    :: XA(NSEG,*),B(NPOIN)
00114       CHARACTER(LEN=1), INTENT(IN)    :: TYPEXA,DITR
00115       LOGICAL         , INTENT(IN)    :: COPY
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER I
00120 !
00121 !-----------------------------------------------------------------------
00122 !
00123 ! 1) INITIALISES : X = SECOND MEMBER
00124 !
00125       IF(COPY) CALL OV( 'X=Y     ' , X , B , B , 0.D0 , NPOIN )
00126 !
00127 !-----------------------------------------------------------------------
00128 !
00129 ! 2) INVERTS THE LOWER TRIANGULAR MATRICES (DESCENT)
00130 !
00131       IF(TYPEXA(1:1).EQ.'S' .OR.
00132      &  (TYPEXA(1:1).EQ.'Q'.AND.DITR(1:1).EQ.'T')) THEN
00133 !
00134         DO I=1,NSEG
00135           X(GLOSEG(I,2))=X(GLOSEG(I,2))-XA(I,1)*X(GLOSEG(I,1))
00136         ENDDO
00137 !
00138       ELSEIF(TYPEXA(1:1).EQ.'Q'.AND.DITR(1:1).EQ.'D') THEN
00139 !
00140         DO I=1,NSEG
00141           X(GLOSEG(I,2))=X(GLOSEG(I,2))-XA(I,2)*X(GLOSEG(I,1))
00142         ENDDO
00143 !
00144       ELSE
00145         WRITE(LU,*) 'DESSEG, CASE NOT IMPLEMENTED'
00146         WRITE(LU,*) '        TYPEXA=',TYPEXA,' DITR=',DITR(1:1)
00147         CALL PLANTE(1)
00148         STOP
00149       ENDIF
00150 !
00151 !-----------------------------------------------------------------------
00152 !
00153       RETURN
00154       END

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