assvec.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE assvec
!                   *****************
!
     &(x, ikle,npoin,nelem,nelmax,w,init,lv,msk,maskel,ndp,errx)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    VECTOR ASSEMBLY.
!
!warning  THIS VECTOR IS ONLY INITIALISED TO 0 IF INIT = .TRUE.
!
!history  J-M HERVOUET (LNH)
!+        29/02/08
!+        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  R.NHEILI (Univerte de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!+      COMPENSATED ASSEMBLY (MODASS=3)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IKLE           |-->| CONNECTIVITY TABLE
!| INIT           |-->| LOGICAL : IF TRUE X IS INITIALISED TO 0.
!| LV             |-->| VECTOR LENGTH OF THE COMPUTER
!| MASKEL         |-->| MASKING OF ELEMENTS
!|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
!| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
!| NDP            |-->| NUMBER OF POINTS PER ELEMENT
!| NELEM          |-->| NUMBER OF ELEMENTS IN THE MESH
!| NELMAX         |-->| FIRST DIMENSION OF IKLE AND W.
!| NPOIN          |-->| NUMBER OF POINTS IN X
!| W              |-->| WORK ARRAY WITH A NON ASSEMBLED FORM OF THE
!|                |   | RESULT
!|                |   | W HAS DIMENSION NELMAX * NDP
!|                |   | NDP IS THE NUMBER OF POINTS IN THE ELEMENT
!| X              |<->| ASSEMBLED VECTOR
!| ERRX           |<->| ERRORS OF ASSEMBLED VECTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_assvec => assvec
      USE declarations_telemac, ONLY : modass
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION, INTENT(INOUT) :: X(*)
      INTEGER         , INTENT(IN)    :: NELEM,NELMAX,NPOIN,LV,NDP
      INTEGER         , INTENT(IN)    :: IKLE(nelmax,ndp)
      DOUBLE PRECISION, INTENT(IN)    :: W(nelmax,ndp),MASKEL(*)
      LOGICAL         , INTENT(IN)    :: INIT,MSK
      DOUBLE PRECISION,OPTIONAL, INTENT(INOUT) :: ERRX(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IDP,IELEM
      DOUBLE PRECISION ERREUR
      DOUBLE PRECISION TMP
!
!-----------------------------------------------------------------------
!   INITIALISES VECTOR X TO 0 IF(INIT)
!-----------------------------------------------------------------------
!
      IF(init) THEN
        CALL ov('X=C     ', x=x, c=0.d0, dim1=npoin)
      ENDIF
!
!-----------------------------------------------------------------------
!   ASSEMBLES, CONTRIBUTION OF LOCAL POINTS 1,... TO NDP
!-----------------------------------------------------------------------
!
!     FpSum
      IF(modass.EQ.1) THEN
        DO idp = 1 , ndp
          CALL assve1(x,ikle(1,idp),w(1,idp),nelem,nelmax,lv,msk,
     &      maskel)
        ENDDO
!     CompSum
      ELSEIF(modass.EQ.3) THEN
        IF(PRESENT(errx)) THEN
          IF(msk) THEN
            IF(lv.EQ.1) THEN
              DO idp = 1 , ndp
                DO ielem = 1 , nelem
                  erreur=0.d0
                  tmp = x(ikle(ielem,idp))
                  CALL twosum(tmp,
     &                w(ielem,idp)* maskel(ielem),
     &                x(ikle(ielem,idp)),erreur)
!                  CALL TWOSUM(ERRX(IKLE(IELEM,IDP)),ERREUR,
!     &                ERRX(IKLE(IELEM,IDP)),ERREUR)
                  errx(ikle(ielem,idp)) = errx(ikle(ielem,idp))+erreur
                ENDDO
              ENDDO
!            DO IDP = 1 , NDP
!              CALL ASSVE1(X,IKLE(1,IDP),W(1,IDP),NELEM,NELMAX,LV,MSK
!     &          ,MASKEL,NPOIN)
!            ENDDO
            ELSE
              DO idp = 1 , ndp
                CALL assve1(x,ikle(1,idp),w(1,idp),nelem,nelmax,lv,msk
     &            ,maskel)
              ENDDO
            ENDIF
          ELSE
            IF(lv.EQ.1) THEN
              DO idp = 1 , ndp
                DO ielem = 1 , nelem
                  erreur=0.d0
                  tmp = x(ikle(ielem,idp))
                  CALL twosum(tmp,w(ielem,idp),
     &                x(ikle(ielem,idp)),erreur)
!                  CALL TWOSUM(ERRX(IKLE(IELEM,IDP)),ERREUR,
!     &                ERRX(IKLE(IELEM,IDP)),ERREUR)
                  errx(ikle(ielem,idp)) = errx(ikle(ielem,idp))+erreur
                ENDDO
              ENDDO
            ELSE
              DO idp = 1 , ndp
                CALL assve1(x,ikle(1,idp),w(1,idp),nelem,nelmax,lv,msk
     &          ,maskel)
              ENDDO
            ENDIF
          ENDIF
        ELSE
          DO idp = 1 , ndp
            CALL assve1(x,ikle(1,idp),w(1,idp),nelem,nelmax,lv,msk
     &        ,maskel)
          ENDDO
!
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END