r3cum3p.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "parit_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	r3cum3p (for, sti, fsky, fskyv, iadr, df, ex, ey, ez, ex2, ey2, ez2, nel, nft)

Function/Subroutine Documentation

r3cum3p()

subroutine r3cum3p	(		for,
			sti,
			fsky,
			fskyv,
		integer, dimension(3,*)	iadr,
			df,
			ex,
			ey,
			ez,
			ex2,
			ey2,
			ez2,
		integer, intent(in)	nel,
		integer, intent(in)	nft )

Definition at line 28 of file r3cum3p.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "parit_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: NFT
C     REAL
      my_real
     .   for(*), sti(3,*),fskyv(lsky,8),df(*),
     .   fsky(8,lsky),ex(mvsiz),ey(mvsiz),ez(mvsiz),
     .   ex2(mvsiz),ey2(mvsiz),ez2(mvsiz)
      INTEGER IADR(3,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II, N,  J
      my_real
     .   f11(mvsiz), f21(mvsiz), f31(mvsiz)
C-----------------------------------------------
C-------------------------
C     ASSEMBLE
C-------------------------
      DO i=1,nel
        f11(i)=ex(i)*(for(i)+df(i))
        f21(i)=ey(i)*(for(i)+df(i))
        f31(i)=ez(i)*(for(i)+df(i))
      ENDDO
C
      IF (ivector == 1) THEN
#include "vectorize.inc"
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fskyv(n,1)=f11(i)
          fskyv(n,2)=f21(i)
          fskyv(n,3)=f31(i)
          fskyv(n,7)=sti(1,i)
          n = iadr(2,ii)
          fskyv(n,1)=-f11(i)
          fskyv(n,2)=-f21(i)
          fskyv(n,3)=-f31(i)
          fskyv(n,7)=two*sti(2,i)
        ENDDO
      ELSE
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fsky(1,n)=f11(i)
          fsky(2,n)=f21(i)
          fsky(3,n)=f31(i)
          fsky(7,n)=sti(1,i)
          n = iadr(2,ii)
          fsky(1,n)=-f11(i)
          fsky(2,n)=-f21(i)
          fsky(3,n)=-f31(i)
          fsky(7,n)=two*sti(2,i)
        ENDDO
      ENDIF
C
      DO i=1,nel
        f11(i)=ex2(i)*(for(i)-df(i))
        f21(i)=ey2(i)*(for(i)-df(i))
        f31(i)=ez2(i)*(for(i)-df(i))
      ENDDO
C
      IF (ivector == 1) THEN
#include "vectorize.inc"
        DO i=1,nel
C
          ii = i+nft
          n = iadr(2,ii)
          fskyv(n,1)=fskyv(n,1)-f11(i)
          fskyv(n,2)=fskyv(n,2)-f21(i)
          fskyv(n,3)=fskyv(n,3)-f31(i)
          n = iadr(3,ii)
          fskyv(n,1)=f11(i)
          fskyv(n,2)=f21(i)
          fskyv(n,3)=f31(i)
          fskyv(n,7)=sti(3,i)
        ENDDO
      ELSE
        DO i=1,nel
          ii = i+nft
          n = iadr(2,ii)
          fsky(1,n)=fsky(1,n)-f11(i)
          fsky(2,n)=fsky(2,n)-f21(i)
          fsky(3,n)=fsky(3,n)-f31(i)
          n = iadr(3,ii)
          fsky(1,n)=f11(i)
          fsky(2,n)=f21(i)
          fsky(3,n)=f31(i)
          fsky(7,n)=sti(3,i)
        ENDDO
      ENDIF
C---
      RETURN