sd_solve_4.f

Go to the documentation of this file.

!                   *********************
                    SUBROUTINE sd_solve_4
!                   *********************
!
     &(npoin,nsegb,glosegb,dab1,dab2,dab3,dab4,xab1,xab2,xab3,xab4,
     & xx1,xx2,cvb1,cvb2,infogr,typext1,typext2,typext3,typext4)
!
!***********************************************************************
! BIEF   V6P2                                   08/2012
!***********************************************************************
!
!brief    DIRECT RESOLUTION OF A SYSTEM 2 X 2 WITH
!+                MINIMUM DEGREE PERMUTATION AND LDLT DECOMPOSITION.
!+
!+            FROM SEGMENT STORAGE TO COMPACT STORAGE (MORSE).
!
!note     IMPORTANT: INSPIRED FROM PACKAGE CMLIB3 - YALE UNIVERSITE-YSMP
!
!history  E. RAZAFINDRAKOTO (LNH)
!+        20/11/06
!+        V5P9
!+
!
!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
!
!history  J.PARISI (HRW)
!+        09/08/2012
!+        V6P2
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CVB1,CVB2      |-->| SECOND MEMBERS OF THE 2 SUB-SYSTEMS
!| DABX           |-->| DIAGONAL TERMS OF SUB-MATRIX X
!| GLOSEGB        |-->| GLOBAL NUMBER OF SEGMENT OF A SUB-MATRIX
!| INFOGR         |-->| IF, YES INFORMATIONS ON LISTING
!| NPOIN          |-->| NOMBRE D'INCONNUES
!| NSEGB          |-->| NOMBRE DE SEGMENTS
!| TYPEXT1        |-->| TYPE OF MATRIX STORAGE : BLOCK 1
!| TYPEXT2        |-->| TYPE OF MATRIX STORAGE : BLOCK 2
!| TYPEXT3        |-->| TYPE OF MATRIX STORAGE : BLOCK 3
!| TYPEXT4        |-->| TYPE OF MATRIX STORAGE : BLOCK 4
!| XABX           |-->| OFF-DIAGONAL TERMS OF SUB-MATRIX X
!| XX1,XX2        |<--| SOLUTIONS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_sd_solve_4 => sd_solve_4
      USE declarations_telemac, ONLY : gloseg4_ss4,da_ss4,xa_ss4,
     &                                 rhs_ss4,xinc_ss4,size_gloseg4,
     &                                 size_da,size_xa,size_rhs,
     &                                 size_xinc
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN,NSEGB
      INTEGER, INTENT(IN) :: GLOSEGB(nsegb*2)
      LOGICAL, INTENT(IN) :: INFOGR
      DOUBLE PRECISION, INTENT(IN)    :: DAB1(npoin),DAB2(npoin)
      DOUBLE PRECISION, INTENT(IN)    :: DAB3(npoin),DAB4(npoin)
      DOUBLE PRECISION, INTENT(IN)    :: XAB1(*),XAB2(*)
      DOUBLE PRECISION, INTENT(IN)    :: XAB3(*),XAB4(*)
      DOUBLE PRECISION, INTENT(INOUT) :: XX1(npoin),XX2(npoin)
      DOUBLE PRECISION, INTENT(IN)    :: CVB1(npoin),CVB2(npoin)
      CHARACTER(LEN=1), INTENT(IN)    :: TYPEXT1,TYPEXT2
      CHARACTER(LEN=1), INTENT(IN)    :: TYPEXT3,TYPEXT4
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NPBLK,NSEGBLK,I
!
!-----------------------------------------------------------------------
!
      npblk=npoin*2
      nsegblk=4*nsegb+npoin
!
      IF(size_gloseg4.EQ.0) THEN
        ALLOCATE(gloseg4_ss4(2*nsegblk))
        size_gloseg4=    2*nsegblk
      ELSEIF(            2*nsegblk.GT.size_gloseg4) THEN
        DEALLOCATE(gloseg4_ss4)
        ALLOCATE(gloseg4_ss4(2*nsegblk))
        size_gloseg4=    2*nsegblk
      ENDIF
      IF(size_da.EQ.0) THEN
        ALLOCATE(da_ss4(npblk))
        size_da=    npblk
      ELSEIF(       npblk.GT.size_da) THEN
        DEALLOCATE(da_ss4)
        ALLOCATE(da_ss4(npblk))
        size_da=    npblk
      ENDIF
      IF(size_xa.EQ.0) THEN
        ALLOCATE(xa_ss4(2*nsegblk))
        size_xa=    2*nsegblk
      ELSEIF(       2*nsegblk.GT.size_xa) THEN
        DEALLOCATE(xa_ss4)
        ALLOCATE(xa_ss4(2*nsegblk))
        size_xa=    2*nsegblk
      ENDIF
      IF(size_rhs.EQ.0) THEN
        ALLOCATE(rhs_ss4(npblk))
        size_rhs=    npblk
      ELSEIF(        npblk.GT.size_rhs) THEN
        DEALLOCATE(rhs_ss4)
        ALLOCATE(rhs_ss4(npblk))
        size_rhs=    npblk
      ENDIF
      IF(size_xinc.EQ.0) THEN
        ALLOCATE(xinc_ss4(npblk))
        size_xinc=    npblk
      ELSEIF(         npblk.GT.size_xinc) THEN
        DEALLOCATE(xinc_ss4)
        ALLOCATE(xinc_ss4(npblk))
        size_xinc=    npblk
      ENDIF
!
!-----------------------------------------------------------------------
!
!     1. SECOND MEMBER OF THE SYSTEM
!     ===========================
!
      DO i=1,npoin
        rhs_ss4(i)      = cvb1(i)
        rhs_ss4(i+npoin)= cvb2(i)
      ENDDO
!
!     2. BUILDS SEGMENT STORAGE MATRIX BLOCK (OF 4)
!     =====================================================
!
      CALL sd_strsg4(npoin,nsegb,glosegb,nsegblk,gloseg4_ss4)
!
      CALL sd_fabsg4(npoin,nsegb,dab1,dab2,dab3,dab4,
     &               xab1,xab2,xab3,xab4,npblk,nsegblk,da_ss4,xa_ss4,
     &               typext1,typext2,typext3,typext4)
!
!     3. SOLVES LIKE A STANDARD SYMMETRICAL MATRIX
!     ==================================================
!
!     HERE TYPEXT1 IS TENTATIVE ACTUALLY IT WOULD BE BETTER TO
!     DECLARE THE SYSTEM AS ALWAYS NON-SYMMETRIC
!
      CALL sd_solve_1(npblk,nsegblk,gloseg4_ss4,nsegblk,da_ss4,xa_ss4,
     &                xinc_ss4,rhs_ss4,infogr,typext1)
!
!     4. RECOVERS THE UNKNOWNS
!     =============================
!
      DO i=1,npoin
        xx1(i) = xinc_ss4(i)
        xx2(i) = xinc_ss4(i+npoin)
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END