opass.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE opass
!                   ****************
!
     &(op,x,w,iw,y,iy,limvoi,mxptvs,npmax)
!
!***********************************************************************
! BIEF   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    FRONTAL MATRIX-VECTOR PRODUCT FOR ELEMENT 11-11.
!+
!+            OMITS THE DIAGONAL TERMS HERE.
!
!history  J-M HERVOUET (LNH)    ; F  LEPEINTRE (LNH)
!+        05/02/91
!+        V5P1
!+
!
!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 (EDF R&D, LNHE)
!+        11/03/2013
!+        V6P3
!+   Dimension of LIMVOI now set to 11.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IW             |-->| ADDRESSES IN W
!| IY             |-->| ADDRESSES IN Y
!| LIMVOI         |-->| LIMVOI(N,1): LOWER RANK OF POINTS WITH N NEIGHBOURS
!|                |   | LIMVOI(N,2): UPPER RANK OF POINTS WITH N NEIGHBOURS
!| MXPTVS         |-->| MAXIMUM NUMBER OF NEIGHBOURS OF A POINT
!| NPMAX          |-->| MAXIMUM NUMBER OF POINTS
!| OP             |-->| OPERATION TO BE DONE (SEE ABOVE)
!| W              |-->| OFF-DIAGONAL TERMS OF MATRIX
!| X              |<->| FINAL ASSEMBLED VECTOR
!| Y              |-->| X=AY WHERE OFF-DIAGONAL TERMS OF A ARE HERE W
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPMAX,MXPTVS
      INTEGER, INTENT(IN) :: IW(npmax,*),IY(npmax,*)
!                                   11: SEE ALMESH
      INTEGER, INTENT(IN) :: LIMVOI(11,2)
      DOUBLE PRECISION, INTENT(INOUT) :: X(*)
      DOUBLE PRECISION, INTENT(IN)    :: W(*),Y(*)
      CHARACTER(LEN=8), INTENT(IN)    :: OP
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
!
!-----------------------------------------------------------------------
!
      IF(mxptvs.GT.11) THEN
        WRITE(lu,778)
778   FORMAT(1x,'OPASS (BIEF): IMPLEMENTED UP TO 11 NEIGHBOURS ONLY',/,
     &       1x,'CHOOSE STORAGE OF MATRICES : 1')
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(op(1:8).EQ.'X=WY    ') THEN
!
      IF(limvoi(1,1).GT.0) THEN
!       THIS CASE IS NOT POSSIBLE IN THEORY
        DO i = limvoi(1,1) , limvoi(1,2)
          x(i) = w(iw(i,1))*y(iy(i,1))
        ENDDO
      ENDIF
!
      IF(limvoi(2,1).GT.0) THEN
!       THIS CASE ONLY EXISTS IF THERE ARE OVERSTRESSED TRIANGLES
        DO i = limvoi(2,1) , limvoi(2,2)
          x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
        ENDDO
      ENDIF
!
      IF(mxptvs.GE.3.AND.limvoi(3,1).GT.0) THEN
      DO i = limvoi(3,1) , limvoi(3,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.4.AND.limvoi(4,1).GT.0) THEN
      DO i = limvoi(4,1) , limvoi(4,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.5.AND.limvoi(5,1).GT.0) THEN
      DO i = limvoi(5,1) , limvoi(5,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.6.AND.limvoi(6,1).GT.0) THEN
      DO i = limvoi(6,1) , limvoi(6,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.7.AND.limvoi(7,1).GT.0) THEN
      DO i = limvoi(7,1) , limvoi(7,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
     &       + w(iw(i,7))*y(iy(i,7))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.8.AND.limvoi(8,1).GT.0) THEN
      DO i = limvoi(8,1) , limvoi(8,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
     &       + w(iw(i,7))*y(iy(i,7)) + w(iw(i,8))*y(iy(i,8))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.9.AND.limvoi(9,1).GT.0) THEN
      DO i = limvoi(9,1) , limvoi(9,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
     &       + w(iw(i,7))*y(iy(i,7)) + w(iw(i,8))*y(iy(i,8))
     &       + w(iw(i,9))*y(iy(i,9))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.10.AND.limvoi(10,1).GT.0) THEN
      DO i = limvoi(10,1) , limvoi(10,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
     &       + w(iw(i,7))*y(iy(i,7)) + w(iw(i,8))*y(iy(i,8))
     &       + w(iw(i,9))*y(iy(i,9)) + w(iw(i,10))*y(iy(i,10))
      ENDDO
      ENDIF
!
      IF(mxptvs.GE.11.AND.limvoi(11,1).GT.0) THEN
      DO i = limvoi(11,1) , limvoi(11,2)
        x(i) = w(iw(i,1))*y(iy(i,1)) + w(iw(i,2))*y(iy(i,2))
     &       + w(iw(i,3))*y(iy(i,3)) + w(iw(i,4))*y(iy(i,4))
     &       + w(iw(i,5))*y(iy(i,5)) + w(iw(i,6))*y(iy(i,6))
     &       + w(iw(i,7))*y(iy(i,7)) + w(iw(i,8))*y(iy(i,8))
     &       + w(iw(i,9))*y(iy(i,9)) + w(iw(i,10))*y(iy(i,10))
     &       + w(iw(i,11))*y(iy(i,11))
      ENDDO
      ENDIF
!
      ELSE
!
        WRITE(lu,3001) op
3001    FORMAT(1x,'OPASS (BIEF) : UNKNOWN OPERATION : ',a8)
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END