remseg.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE remseg
!                   *****************
!
     &(x, xa,typexa,b,gloseg,nseg,npoin,ditr,copy)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    SOLVES THE SYSTEM U X = B (SEGMENT BY SEGMENT).
!code
!+            THE MATRIX U IS HERE THE RESULT OF A DECOMPOSITION
!+            DONE IN SUBROUTINE DECLDU
!+
!+            EACH ELEMENTARY MATRIX WAS FACTORISED 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)
!+        26/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         |-->| FIRST AND SECOND POINT OF SEGMENTS
!| NPOIN          |-->| NUMBER OF POINTS
!| NSEG           |-->| NUMBER OF SEGMENTS
!| TYPEXA         |-->| TYPE OF OFF-DIAGONAL TERMS
!|                |   | TYPEXA = 'Q' : ANY VALUE
!|                |   | TYPEXA = 'S' : SYMMETRIC
!|                |   | TYPEXA = '0' : ZERO
!| X              |<--| SOLUTION OF THE SYSTEM AX = B
!| XA             |<--| OFF-DIAGONAL TERMS OF THE MATRIX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_remseg => remseg
!
      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 UPPER TRIANGULAR MATRICES (TRACEBACK)
!
      IF(typexa(1:1).EQ.'S' .OR.
     &  (typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'D')) THEN
!
        DO i=nseg,1,-1
          x(gloseg(i,1))=x(gloseg(i,1))-xa(i,1)*x(gloseg(i,2))
        ENDDO
!
      ELSEIF(typexa(1:1).EQ.'Q'.AND.ditr(1:1).EQ.'T') THEN
!
        DO i=nseg,1,-1
          x(gloseg(i,1))=x(gloseg(i,1))-xa(i,2)*x(gloseg(i,2))
        ENDDO
!
      ELSE
        WRITE(lu,*) 'REMSEG, CASE NOT IMPLEMENTED'
        WRITE(lu,*) '        TYPEXA=',typexa,' DITR=',ditr(1:1)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END