r2cum3p.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	r2cum3p (forx, fory, forz, xmom, ymom, zmom, sti, stir, fsky, fskyv, iadr, fx1, fx2, fy1, fy2, fz1, fz2, mx1, mx2, my1, my2, mz1, mz2, geo, x1, y1, z1, x2, y2, z2, iequil, exx, eyx, ezx, exy, eyy, ezy, exz, eyz, ezz, nel, nft)

Function/Subroutine Documentation

r2cum3p()

subroutine r2cum3p	(		forx,
			fory,
			forz,
			xmom,
			ymom,
			zmom,
			sti,
			stir,
			fsky,
			fskyv,
		integer, dimension(3,*)	iadr,
			fx1,
			fx2,
			fy1,
			fy2,
			fz1,
			fz2,
			mx1,
			mx2,
			my1,
			my2,
			mz1,
			mz2,
			geo,
			x1,
			y1,
			z1,
			x2,
			y2,
			z2,
		integer, dimension(*)	iequil,
			exx,
			eyx,
			ezx,
			exy,
			eyy,
			ezy,
			exz,
			eyz,
			ezz,
		integer, intent(in)	nel,
		integer, intent(in)	nft )

Definition at line 29 of file r2cum3p.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"
#include      "param_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
     .   forx(*), fory(*), forz(*), xmom(*), ymom(*),
     .   zmom(*),sti(3,*),stir(3,*),fskyv(lsky,8), fsky(8,lsky),
     .   fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
     .   fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
     .   mx1(mvsiz),my1(mvsiz),mz1(mvsiz),
     .   mx2(mvsiz),my2(mvsiz),mz2(mvsiz),
     .   geo(npropg,*),x1(*),x2(*),y1(*),y2(*),
     .   z1(*),z2(*), 
     .   exx(mvsiz), eyx(mvsiz), ezx(mvsiz), exy(mvsiz),
     .   eyy(mvsiz), ezy(mvsiz), exz(mvsiz), eyz(mvsiz), ezz(mvsiz)
      INTEGER IADR(3,*),IEQUIL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II, N, J
C     REAL
      my_real
     .   mmx, mmy, mmz, xx
C-----------------------------------------------
C-------------------------
C     FORCES
C-------------------------
      DO i=1,nel
        fx2(i)=exx(i)*forx(i)+exy(i)*fory(i)+exz(i)*forz(i)
        fy2(i)=eyx(i)*forx(i)+eyy(i)*fory(i)+eyz(i)*forz(i)
        fz2(i)=ezx(i)*forx(i)+ezy(i)*fory(i)+ezz(i)*forz(i)
        fx1(i) = -fx2(i)
        fy1(i) = -fy2(i)
        fz1(i) = -fz2(i)
      ENDDO
C-------------------------
C     ASSEMBLE
C-------------------------
      IF (ivector == 1) THEN
#include "vectorize.inc"
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fskyv(n,1)=-fx1(i)
          fskyv(n,2)=-fy1(i)
          fskyv(n,3)=-fz1(i)
          fskyv(n,7)=sti(1,i)
          n = iadr(2,ii)
          fskyv(n,1)=-fx2(i)
          fskyv(n,2)=-fy2(i)
          fskyv(n,3)=-fz2(i)
          fskyv(n,7)=sti(2,i)
        ENDDO
      ELSE
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fsky(1,n)=-fx1(i)
          fsky(2,n)=-fy1(i)
          fsky(3,n)=-fz1(i)
          fsky(7,n)=sti(1,i)
          n = iadr(2,ii)
          fsky(1,n)=-fx2(i)
          fsky(2,n)=-fy2(i)
          fsky(3,n)=-fz2(i)
          fsky(7,n)=sti(2,i)
        ENDDO
      ENDIF
C-------------------------
C     MOMENTS
C-------------------------
      DO i=1,nel
        mx2(i)=exx(i)*xmom(i)+exy(i)*ymom(i)+exz(i)*zmom(i)
        my2(i)=eyx(i)*xmom(i)+eyy(i)*ymom(i)+eyz(i)*zmom(i)
        mz2(i)=ezx(i)*xmom(i)+ezy(i)*ymom(i)+ezz(i)*zmom(i)
        mx1(i) = -mx2(i)
        my1(i) = -my2(i)
        mz1(i) = -mz2(i)
      ENDDO
C
      DO i=1,nel
        IF (iequil(i) == 1) THEN
          mmx = half*((y2(i)-y1(i))*fz2(i) - (z2(i)-z1(i))*fy2(i))
          mmy = half*((z2(i)-z1(i))*fx2(i) - (x2(i)-x1(i))*fz2(i))
          mmz = half*((x2(i)-x1(i))*fy2(i) - (y2(i)-y1(i))*fx2(i)) 
          mx1(i) = mx1(i) - mmx
          my1(i) = my1(i) - mmy
          mz1(i) = mz1(i) - mmz
          mx2(i) = mx2(i) - mmx
          my2(i) = my2(i) - mmy
          mz2(i) = mz2(i) - mmz
          xx = (x2(i)-x1(i))*(x2(i)-x1(i)) 
     .       + (y2(i)-y1(i))*(y2(i)-y1(i))
     .       + (z2(i)-z1(i))*(z2(i)-z1(i))
          stir(1,i) = stir(1,i) + sti(2,i)*xx
          stir(2,i) = stir(2,i) + sti(1,i)*xx
        ENDIF
      ENDDO
C-------------------------
C     ASSEMBLE
C-------------------------
      IF (ivector == 1) THEN
#include "vectorize.inc"
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fskyv(n,4)=-mx1(i)
          fskyv(n,5)=-my1(i)
          fskyv(n,6)=-mz1(i)
          fskyv(n,8)=stir(1,i)
          n = iadr(2,ii)
          fskyv(n,4)=-mx2(i)
          fskyv(n,5)=-my2(i)
          fskyv(n,6)=-mz2(i)
          fskyv(n,8)=stir(2,i)
        ENDDO
      ELSE
        DO i=1,nel
          ii = i+nft
          n = iadr(1,ii)
          fsky(4,n)=-mx1(i)
          fsky(5,n)=-my1(i)
          fsky(6,n)=-mz1(i)
          fsky(8,n)=stir(1,i)
          n = iadr(2,ii)
          fsky(4,n)=-mx2(i)
          fsky(5,n)=-my2(i)
          fsky(6,n)=-mz2(i)
          fsky(8,n)=stir(2,i)
        ENDDO
      ENDIF
C---
      RETURN