sd_fabcad.f

Go to the documentation of this file.

!                   ********************
                    SUBROUTINE sd_fabcad
!                   ********************
!
     &(npblk,nsegblk,in,ip,isegip,
     & indtri,istri,inx,ipx,actri,xa1,xa2,da,ac)
!
!***********************************************************************
! BIEF   V6P2                                   21/07/2011
!***********************************************************************
!
!brief    BUILDS A COMPACT STORAGE
!+               (INX,IPX) STRUCTURE WITH THE DIAGONAL
!+                VIA (IN,IP) = (XADJ, ADJNCY) OF EXTRADIAGONAL TERMS
!+                AND THE SEGMENT STORAGE (ISEGIP, XA, DA).
!
!note     IMPORTANT : INSPIRED FROM PACKAGE CMLIB3 - YALE UNIVERSITE-YSMP
!
!
!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  E. RAZAFINDRAKOTO (LNH)
!+        21/11/11
!+        V6P1
!+
!
!history  J-M HERVOUET (LNHE)
!+        08/06/2012
!+        V6P2
!+   Dimensions and algorithm slightly changed.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AC             |<--|COMPACT STORED MATRIX WITH DIAGONAL
!| ACTRI          |---|REAL WORKING STORAGE
!| DA             |-->|MATRIX DIAGONAL COEFFICIENTS
!| (IN,IP)        |-->|STRUCTURE WITHOUT THE DIAGONAL
!| INDTRI         |---|INTEGER WORKING STORAGE
!| (INX,IPX)      |<--|STRUCTURE WITH THE DIAGONAL
!| ISEGIP         |-->|INVERSE TABLE OF CONNECTIVITY: POINT ---> SEGMENT
!| ISTRI          |---|INTEGER WORKING STORAGE
!| NPBLK          |-->| SIZE OF MATRIX DIAGONAL
!| NSEGBLK        |-->| NUMBER OF SEGMENTS IN ORIGINAL MATRIX
!| XA1            |-->| OFF-DIAGONAL TERM OF MATRIX A
!| XA2            |-->| OFF-DIAGONAL TERM OF MATRIX A
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_sd_fabcad => sd_fabcad
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NPBLK,NSEGBLK
      INTEGER, INTENT(IN)             :: IN(npblk+1),IP(nsegblk*2)
      INTEGER, INTENT(IN)             :: ISEGIP(nsegblk*2)
      INTEGER, INTENT(INOUT)          :: INDTRI(npblk)
      INTEGER, INTENT(INOUT)          :: ISTRI(npblk)
      INTEGER, INTENT(INOUT)          :: INX(npblk+1)
      INTEGER, INTENT(INOUT)          :: IPX(nsegblk*2+npblk)
      DOUBLE PRECISION, INTENT(INOUT) :: ACTRI(npblk)
      DOUBLE PRECISION, INTENT(IN)    :: XA1(nsegblk),XA2(nsegblk)
      DOUBLE PRECISION, INTENT(IN)    :: DA(npblk)
      DOUBLE PRECISION, INTENT(INOUT) :: AC(nsegblk*2+npblk)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,J,J1,J2,JN,ISEG,ND
!
!-----------------------------------------------------------------------
!
!---> COMPACT STORAGE WITH THE DIAGONAL ADDED : (XADJ, ADJNCY) = (INX,IPX)
!
      DO i = 1, npblk+1
        inx(i) = in(i)+i-1
      ENDDO
!
!     J2 WILL BE THE ADDRESS IN AC
      j2=0
      DO i = 1, npblk
        ipx(inx(i)) = i
!       DIAGONAL AS FIRST COEFFICIENT OF THE LIST
        j2=j2+1
!       NOTE: HERE J2=INX(I)
        ac(inx(i)) = da(i)
!       LOOP ON MATRIX COEFFICIENTS OF POINT I
!       EXCLUDING DIAGONAL TERMS AT ADDRESS INX(I)
        DO j1 = inx(i)+1, inx(i+1)-1
!         BACK TO ADDRESS WITHOUT THE DIAGONAL
          jn = j1-i
          j = ip(jn)
          j2=j2+1
          iseg = isegip(jn)
          ipx(j2) = j
          IF(iseg.LT.0) THEN
            ac(j2) = xa1(-iseg)
          ELSEIF(iseg.GT.0) THEN
            ac(j2) = xa2(iseg)
          ENDIF
        ENDDO
      ENDDO
      DO i = 1, npblk
        nd = inx(i+1)-inx(i)
        DO j = 1,nd
          istri(j) = ipx(inx(i)+j-1)
          actri(j) = ac(inx(i)+j-1)
        ENDDO
        CALL sd_strtri(istri,nd,indtri)
        DO j = 1,nd
          j1 = indtri(j)
          ipx(inx(i)+j-1) = istri(j1)
          ac(inx(i)+j-1) = actri(j1)
        ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END