desseg.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE desseg
!                   *****************
!
     &(x, xa,typexa,b,gloseg,nseg,npoin,ditr,copy)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    SOLVES THE SYSTEM L X = B (SEGMENT BY SEGMENT).
!code
!+            MATRIX L IS HERE THE RESULT OF THE FACTORISATION
!+            PERFORMED IN SUBROUTINE DECLDU.
!+
!+            EACH ELEMENTARY MATRIX IS DECOMPOSED IN THE FORM:
!+
!+            LE X DE X UE
!+
!+            LE : LOWER TRIANGULAR WITH 1S ON THE DIAGONAL
!+            DE : DIAGONAL
!+            UE : UPPER TRIANGULAR WITH 1S ON THE DIAGONAL
!+
!+                                                T
!+            IF THE MATRIX IS SYMMETRICAL : LE =  UE
!
!history  J-M HERVOUET (LNH)
!+        25/02/04
!+        V5P5
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| B              |<--| RIGHT-HAND SIDE OF THE LINEAR SYSTEM TO BE SOLVED
!| COPY           |-->| IF .TRUE. B IS COPIED INTO X TO START WITH
!| DITR           |-->| CHARACTER, IF  'D' : DIRECT MATRIX A CONSIDERED
!|                |   |                'T' : TRANSPOSED MATRIX A CONSIDERED
!| GLOSEG         |-->| GLOBAL NUMBERS OF POINTS OF SEGMENTS
!| NPOIN          |-->| NUMBER OF POINTS
!| NSEG           |-->| NUMBER OF SEGMENTS
!| TYPEXA         |-->| TYPE OF OFF-DIAGONAL TERMS IN THE MATRIX
!| X              |<--| SOLUTION OF THE SYSTEM AX = B
!| XA             |<--| OFF-DIAGONAL TERMS OF THE MATRIX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_desseg => desseg
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(IN)    :: NPOIN,NSEG
      INTEGER         , INTENT(IN)    :: GLOSEG(nseg,2)
      DOUBLE PRECISION, INTENT(INOUT) :: X(npoin)
      DOUBLE PRECISION, INTENT(IN)    :: XA(nseg,*),B(npoin)
      CHARACTER(LEN=1), INTENT(IN)    :: TYPEXA,DITR
      LOGICAL         , INTENT(IN)    :: COPY
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
!
!-----------------------------------------------------------------------
!
! 1) INITIALISES : X = SECOND MEMBER
!
      IF(copy) CALL ov('X=Y     ', x=x, y=b, dim1=npoin)
!
!-----------------------------------------------------------------------
!
! 2) INVERTS THE LOWER TRIANGULAR MATRICES (DESCENT)
!
      IF(typexa(1:1).EQ.'S' .OR.
     &  (typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'T')) THEN
!
        DO i=1,nseg
          x(gloseg(i,2))=x(gloseg(i,2))-xa(i,1)*x(gloseg(i,1))
        ENDDO
!
      ELSEIF(typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'D') THEN
!
        DO i=1,nseg
          x(gloseg(i,2))=x(gloseg(i,2))-xa(i,2)*x(gloseg(i,1))
        ENDDO
!
      ELSE
        WRITE(lu,*) 'DESSEG, CASE NOT IMPLEMENTED'
        WRITE(lu,*) '        TYPEXA=',typexa,' DITR=',ditr(1:1)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END