assex3.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE assex3
!                   *****************
!
     &(xm,sto,name,ielm1,ielm2,typext,xmt,dim1xmt,dim2xmt,stoxmt,
     & mesh,nelmax,eltseg,oriseg)
!
!***********************************************************************
! BIEF   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    ASSEMBLES MATRICES EXTRA-DIAGONAL TERMS
!+                IN THE CASE OF EDGE-BASED STORAGE.
!
!history  J-M HERVOUET (LNHE)
!+        05/02/2010
!+        V6P0
!+
!
!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-M HERVOUET (LNHE)
!+        25/08/2011
!+        V6P2
!+   Tetrahedron element added
!
!history  S. PAVAN (LNHE)
!+        01/08/2013
!+        V6P3
!+   Arguments added to AS3_1111_Q
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DIM1XMT        |-->| FIRST DIMENSION OF XMT
!| DIM2XMT        |-->| SECOND DIMENSION OF XMT
!| ELTSEG         |-->| SEGMENTS IN AN ELEMENT
!| IELM1          |-->| ELEMENT OF LINES IN THE MATRIX
!| IELM2          |-->| ELEMENT OF ROWS IN THE MATRIX
!| MESH           |-->| MESH-STRUCTURE
!| NAME           |-->| FORTRAN NAME OF THE MATRIX
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN THE MESH
!| ORISEG         |-->| ORIENTATION OF SEGMENTS
!| STO            |-->| STORAGE REQUIRED IN XM 1: EBE  3: EDGE-BASED
!| STOXMT         |-->| STORAGE OF OFF-DIAGONAL TERMS
!|                |   | 1: XMT(NELMAX,*)  2: XMT(*,NELMAX)
!| TYPEXT         |-->| TYPE OF OFF-DIAGONAL TERMS
!| XM             |<->| ASSEMBLED OFF-DIAGONAL TERMS
!| XMT            |<->| OFF-DIAGONAL TERMS OF THE WORK MATRIX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_assex3 => assex3
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(INOUT) :: STO
      CHARACTER(LEN=6), INTENT(IN)    :: NAME
      INTEGER         , INTENT(IN)    :: IELM1,IELM2,NELMAX
      INTEGER         , INTENT(IN)    :: DIM1XMT,DIM2XMT,STOXMT
      INTEGER         , INTENT(IN)    :: ELTSEG(nelmax,*)
      INTEGER         , INTENT(IN)    :: ORISEG(nelmax,*)
      CHARACTER(LEN=1), INTENT(IN)    :: TYPEXT
      DOUBLE PRECISION, INTENT(INOUT) :: XMT(dim1xmt,dim2xmt)
      DOUBLE PRECISION, INTENT(INOUT) :: XM(*)
      TYPE(bief_mesh) , INTENT(IN)    :: MESH
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER NELEM,STOM
!
!-----------------------------------------------------------------------
!
!  EXTRACTS MATRIX M CHARACTERISTICS
!
      stom = sto
      IF(stom.NE.1) THEN
        WRITE(lu,501) name,stom
501     FORMAT(1x,'ASSEX3 (BIEF) : MATRIX  M (REAL NAME:',a6,')',/,1x,
     &            '                UNEXPECTED STORAGE: ',1i6)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF( (dimens(ielm1).NE.mesh%DIM1) .AND.
     &   (ielm1.NE.81.AND.ielm2.NE.81) ) THEN
!       BOUNDARY MATRIX : NOT TREATED HERE
        WRITE(lu,101) name
        WRITE(lu,201) ielm1,ielm2
        WRITE(lu,301)
        CALL plante(1)
        stop
      ENDIF
!
      IF(dimens(ielm1).EQ.mesh%DIM1) THEN
!       NORMAL MATRIX
        nelem  = mesh%NELEM
      ELSE
!       BOUNDARY MATRIX
        nelem  = mesh%NELEB
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(ielm1.EQ.11.AND.ielm2.EQ.11) THEN
!
!       P1-P1 TRIANGLES MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_1111_s(xm,bief_nbseg(11,mesh),
     &                    xmt,nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3))
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_1111_q(xm,bief_nbseg(11,mesh),
     &                    xmt,dim1xmt,dim2xmt,nelmax,nelem,stoxmt,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    oriseg(1,1),oriseg(1,2),oriseg(1,3))
        ENDIF
!
      ELSEIF(ielm1.EQ.11.AND.ielm2.EQ.12) THEN
!
!       P1-QB TRIANGLES MATRIX
!
          CALL as3_1112(xm,bief_nbseg(ielm1,mesh),
     &                  bief_nbseg(ielm2,mesh),
     &                  xmt,nelmax,nelem,
     &                  eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                  eltseg(1,4),eltseg(1,5),eltseg(1,6),
     &                  oriseg(1,1),oriseg(1,2),oriseg(1,3))
!
      ELSEIF(ielm1.EQ.11.AND.ielm2.EQ.13) THEN
!
!       P1-QUADRATIC TRIANGLES MATRIX
!
          CALL as3_1113(xm,bief_nbseg(ielm1,mesh),
     &                  bief_nbseg(ielm2,mesh),
     &                  xmt,nelmax,nelem,eltseg,oriseg)
!
      ELSEIF(ielm1.EQ.13.AND.ielm2.EQ.11) THEN
!
!       QUADRATIC-P1 TRIANGLES MATRIX
!
          CALL as3_1311(xm,bief_nbseg(ielm2,mesh),
     &                  bief_nbseg(ielm1,mesh),
     &                  xmt,nelmax,nelem,eltseg,oriseg)
!
      ELSEIF(ielm1.EQ.12.AND.ielm2.EQ.11) THEN
!
!       P1-QB TRIANGLES MATRIX
!
          CALL as3_1211(xm,bief_nbseg(11,mesh),
     &                  bief_nbseg(12,mesh),
     &                  xmt,nelmax,nelem,
     &                  eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                  eltseg(1,4),eltseg(1,5),eltseg(1,6),
     &                  oriseg(1,1),oriseg(1,2),oriseg(1,3))
!
      ELSEIF(ielm1.EQ.12.AND.ielm2.EQ.12) THEN
!
!       QB-QB TRIANGLES MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_1212_s(xm,bief_nbseg(11,mesh),
     &                    bief_nbseg(12,mesh),xmt,nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    eltseg(1,4),eltseg(1,5),eltseg(1,6))
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_1212_q(xm,bief_nbseg(11,mesh),
     &                    bief_nbseg(12,mesh),
     &                    xmt,nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    eltseg(1,4),eltseg(1,5),eltseg(1,6),
     &                    oriseg(1,1),oriseg(1,2),oriseg(1,3))
        ENDIF
!
      ELSEIF(ielm1.EQ.13.AND.ielm2.EQ.13) THEN
!
!       QUADRATIC TRIANGLES MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_1313_s(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,eltseg)
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_1313_q(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,eltseg,oriseg)
        ENDIF
!
      ELSEIF(ielm1.EQ.41.AND.ielm2.EQ.41) THEN
!
!       PRISMS MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_4141_s(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,eltseg)
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_4141_q(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,eltseg,oriseg)
        ENDIF
!
      ELSEIF( (ielm1.EQ.31.AND.ielm2.EQ.31).OR.
     &        (ielm1.EQ.51.AND.ielm2.EQ.51)     ) THEN
!
!       TETRAHEDRONS MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_3131_s(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    eltseg(1,4),eltseg(1,5),eltseg(1,6))
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_3131_q(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    eltseg(1,4),eltseg(1,5),eltseg(1,6),
     &                    oriseg(1,1),oriseg(1,2),oriseg(1,3),
     &                    oriseg(1,4),oriseg(1,5),oriseg(1,6))
        ENDIF
!
      ELSEIF(ielm1.EQ.81.AND.ielm2.EQ.81) THEN
!
!       TETRAHEDRONS MATRIX
!
        IF(typext.EQ.'S') THEN
          CALL as3_8181_s(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3))
        ELSEIF(typext.EQ.'Q') THEN
          CALL as3_8181_q(xm,bief_nbseg(ielm1,mesh),
     &                    xmt,dim1xmt,dim2xmt,stoxmt,
     &                    nelmax,nelem,
     &                    eltseg(1,1),eltseg(1,2),eltseg(1,3),
     &                    oriseg(1,1),oriseg(1,2),oriseg(1,3))
        ENDIF
!
      ELSE
!
!       IELM1 / IELM2 COMBINATION NOT IMPLEMENTED: ERROR
!
        WRITE(lu,101) name
        WRITE(lu,201) ielm1,ielm2
        WRITE(lu,301)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!  NEW TYPE OF STORAGE
!
      sto=3
!
!-----------------------------------------------------------------------
!
101   FORMAT(1x,'ASSEX3 (BIEF) : MATRIX  M (REAL NAME:',a6,')')
201   FORMAT(1x,'                IELM1 = ',1i6,' IELM2 = ',1i6)
301   FORMAT(1x,'                THIS CASE IS NOT IMPLEMENTED')
!
!-----------------------------------------------------------------------
!
      RETURN
      END