as3_8181_q.f

Go to the documentation of this file.

!                   *********************
                    SUBROUTINE as3_8181_q
!                   *********************
!
     &(xm,nseg,xmt,dim1xmt,dim2xmt,stoxmt,
     & nelmax,nelem,eltseg1,eltseg2,eltseg3,
     & oriseg1,oriseg2,oriseg3)
!
!***********************************************************************
! BIEF   V6P2                                   21/08/2010
!***********************************************************************
!
!brief    ASSEMBLES MATRICES EXTRA-DIAGONAL TERMS
!+                IN THE CASE OF EDGE-BASED STORAGE AND NON SYMMETRICAL
!+                MATRIX.
!+
!+            CASE OF TETRAHEDRON ELEMENT.
!+            SEE EBE STORAGE IN XMT FROM AAS IN MATRIY.f
!
!history  F. DECUNG (LNHE)
!+        20/07/2012
!+        V6P2
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DIM1XMT        |-->| FIRST DIMENSION OF XMT
!| DIM2XMT        |-->| SECOND DIMENSION OF XMT
!| ELTSEG1        |-->| FIRST SEGMENT OF A TRIANGLE
!| ELTSEG2        |-->| SECOND SEGMENT OF A TRIANGLE
!| ELTSEG3        |-->| THIRD SEGMENT OF A TRIANGLE
!| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
!| NELMAX         |-->| FIRST DIMENSION OF IKLE AND W.
!| NSEG           |-->| NUMBER OF SEGMENTS
!| ORISEG1        |-->| ORIENTATION OF SEGMENT 1 OF TRIANGLE
!| ORISEG2        |-->| ORIENTATION OF SEGMENT 2 OF TRIANGLE
!| ORISEG3        |-->| ORIENTATION OF SEGMENT 3 OF TRIANGLE
!| STOXMT         |-->| STORAGE MODE OF XMT
!| XM             |<--| ASSEMBLED OFF-DIAGONAL TERMS XA12,23,31
!| XMT            |-->| ELEMENT BY ELEMENT STORAGE OF MATRIX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(IN)    :: NELMAX,NELEM,NSEG
      INTEGER         , INTENT(IN)    :: DIM1XMT,DIM2XMT,STOXMT
      INTEGER         , INTENT(IN)    :: ELTSEG1(nelmax),ELTSEG2(nelmax)
      INTEGER         , INTENT(IN)    :: ELTSEG3(nelmax)
      INTEGER         , INTENT(IN)    :: ORISEG1(nelmax),ORISEG2(nelmax)
      INTEGER         , INTENT(IN)    :: ORISEG3(nelmax)
      DOUBLE PRECISION, INTENT(INOUT) :: XMT(dim1xmt,dim2xmt)
      DOUBLE PRECISION, INTENT(INOUT) :: XM(nseg*2)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER ISEG,IELEM
!
!-----------------------------------------------------------------------
!
!  INITIALISES
!
      DO iseg = 1 , 2*nseg
        xm(iseg) = 0.d0
      ENDDO
!
!-----------------------------------------------------------------------
!
      IF(stoxmt.EQ.1) THEN
!
!     ASSEMBLES
!
      DO ielem = 1,nelem
!         TERM 12
          xm(eltseg1(ielem)+nseg*(oriseg1(ielem)-1))
     &  = xm(eltseg1(ielem)+nseg*(oriseg1(ielem)-1)) + xmt(ielem,01)
!         TERM 23
          xm(eltseg2(ielem)+nseg*(oriseg2(ielem)-1))
     &  = xm(eltseg2(ielem)+nseg*(oriseg2(ielem)-1)) + xmt(ielem,02)
!         TERM 31
          xm(eltseg3(ielem)+nseg*(oriseg3(ielem)-1))
     &  = xm(eltseg3(ielem)+nseg*(oriseg3(ielem)-1)) + xmt(ielem,06)
!         TERM 21
          xm(eltseg1(ielem)+nseg*(2-oriseg1(ielem)))
     &  = xm(eltseg1(ielem)+nseg*(2-oriseg1(ielem))) + xmt(ielem,04)
!         TERM 32
          xm(eltseg2(ielem)+nseg*(2-oriseg2(ielem)))
     &  = xm(eltseg2(ielem)+nseg*(2-oriseg2(ielem))) + xmt(ielem,05)
!         TERM 13
          xm(eltseg3(ielem)+nseg*(2-oriseg3(ielem)))
     &  = xm(eltseg3(ielem)+nseg*(2-oriseg3(ielem))) + xmt(ielem,03)
      ENDDO
!
!-----------------------------------------------------------------------
!
      ELSEIF(stoxmt.EQ.2) THEN
!
      DO ielem = 1,nelem
!         TERM 12
          xm(eltseg1(ielem)+nseg*(oriseg1(ielem)-1))
     &  = xm(eltseg1(ielem)+nseg*(oriseg1(ielem)-1)) + xmt(01,ielem)
!         TERM 23
          xm(eltseg2(ielem)+nseg*(oriseg2(ielem)-1))
     &  = xm(eltseg2(ielem)+nseg*(oriseg2(ielem)-1)) + xmt(02,ielem)
!         TERM 31
          xm(eltseg3(ielem)+nseg*(oriseg3(ielem)-1))
     &  = xm(eltseg3(ielem)+nseg*(oriseg3(ielem)-1)) + xmt(06,ielem)
!         TERM 21
          xm(eltseg1(ielem)+nseg*(2-oriseg1(ielem)))
     &  = xm(eltseg1(ielem)+nseg*(2-oriseg1(ielem))) + xmt(04,ielem)
!         TERM 32
          xm(eltseg2(ielem)+nseg*(2-oriseg2(ielem)))
     &  = xm(eltseg2(ielem)+nseg*(2-oriseg2(ielem))) + xmt(05,ielem)
!         TERM 13
          xm(eltseg3(ielem)+nseg*(2-oriseg3(ielem)))
     &  = xm(eltseg3(ielem)+nseg*(2-oriseg3(ielem))) + xmt(03,ielem)
      ENDDO
!
!-----------------------------------------------------------------------
!
      ELSE
        WRITE(lu,*) 'AS3_8181_Q: UNKNOWN STORAGE OF XMT : ',stoxmt
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END