rcum33p.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	rcum33p (jft, jlt, xl, fsky, fskyv, forx, fory, forz, xmom, ymom, zmom, sti, stir, fx1, fx2, fy1, fy2, fz1, fz2, mx1, mx2, my1, my2, mz1, mz2, iadr, nuvar, uvar, nft)

Function/Subroutine Documentation

rcum33p()

subroutine rcum33p	(	integer	jft,
		integer	jlt,
		double precision, dimension(mvsiz,3)	xl,
			fsky,
			fskyv,
			forx,
			fory,
			forz,
			xmom,
			ymom,
			zmom,
			sti,
			stir,
			fx1,
			fx2,
			fy1,
			fy2,
			fz1,
			fz2,
			mx1,
			mx2,
			my1,
			my2,
			mz1,
			mz2,
		integer, dimension(3,*)	iadr,
		integer	nuvar,
			uvar,
		integer, intent(in)	nft )

Definition at line 28 of file rcum33p.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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) :: NFT
      INTEGER JFT,JLT,IADR(3,*),NUVAR
      my_real forx(*), fory(*), forz(*), xmom(*), ymom(*), zmom(*),
     .        sti(3,*),stir(3,*),fsky(8,lsky),fskyv(lsky,8),
     .        fx1(*),fx2(*),fy1(*),fy2(*),fz1(*),fz2(*),
     .        mx1(*),mx2(*),my1(*),my2(*),mz1(*),mz2(*),uvar(nuvar,*)
      DOUBLE PRECISION XL(MVSIZ,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),
     .        m11(mvsiz), m21(mvsiz), m31(mvsiz),
     .        m12(mvsiz), m22(mvsiz), m32(mvsiz),
     .        xmom1, xmom2, ymom1, ymom2, zmom1, zmom2, m1,m2,m3,
     .        ex(9), xx
C=======================================================================
C-------------------------
C     FORCES
C-------------------------
C
      DO i=jft,jlt
        DO j=1,9
          ex(j) = uvar(21+j,i)
        END DO      
        f11(i)=ex(1)*forx(i)+ex(4)*fory(i)+ex(7)*forz(i)
        f21(i)=ex(2)*forx(i)+ex(5)*fory(i)+ex(8)*forz(i)
        f31(i)=ex(3)*forx(i)+ex(6)*fory(i)+ex(9)*forz(i)
      ENDDO
C
C----  Assembly
C
      IF(ivector==1) THEN
#include "vectorize.inc"
        DO i=jft,jlt
          ii = i+nft
          n = iadr(1,ii)
          fskyv(n,1)=f11(i)
          fskyv(n,2)=f21(i)
          fskyv(n,3)=f31(i)
          fx1(i) = -f11(i)
          fy1(i) = -f21(i)
          fz1(i) = -f31(i)
          fskyv(n,7)=sti(1,i)*two
          n = iadr(2,ii)
          fskyv(n,1)=-f11(i)
          fskyv(n,2)=-f21(i)
          fskyv(n,3)=-f31(i)
          fx2(i) = f11(i)
          fy2(i) = f21(i)
          fz2(i) = f31(i)
          fskyv(n,7)=sti(2,i)*two
        ENDDO
      ELSE
        DO i=jft,jlt
          ii = i+nft
          n = iadr(1,ii)
          fsky(1,n)=f11(i)
          fsky(2,n)=f21(i)
          fsky(3,n)=f31(i)
          fx1(i) = -f11(i)
          fy1(i) = -f21(i)
          fz1(i) = -f31(i)
          fsky(7,n)=sti(1,i)*two
          n = iadr(2,ii)
          fsky(1,n)=-f11(i)
          fsky(2,n)=-f21(i)
          fsky(3,n)=-f31(i)
          fx2(i) = f11(i)
          fy2(i) = f21(i)
          fz2(i) = f31(i)
          fsky(7,n)=sti(2,i)*two
        ENDDO
      ENDIF
C
C-------------------------
C     momentum
C-------------------------
C
      DO i=jft,jlt
        DO j=1,9
          ex(j) = uvar(21+j,i)
        END DO
C
        m1 = half*(xl(i,2)*forz(i)-xl(i,3)*fory(i))
        m2 = half*(xl(i,3)*forx(i)-xl(i,1)*forz(i))
        m3 = half*(xl(i,1)*fory(i)-xl(i,2)*forx(i))
C
        xmom1 = xmom(i) + m1
        ymom1 = ymom(i) + m2
        zmom1 = zmom(i) + m3
        m11(i)=ex(1)*xmom1+ex(4)*ymom1+ex(7)*zmom1
        m21(i)=ex(2)*xmom1+ex(5)*ymom1+ex(8)*zmom1
        m31(i)=ex(3)*xmom1+ex(6)*ymom1+ex(9)*zmom1
C
        xmom2 = xmom(i) - m1
        ymom2 = ymom(i) - m2
        zmom2 = zmom(i) - m3
        m12(i)=ex(1)*xmom2+ex(4)*ymom2+ex(7)*zmom2
        m22(i)=ex(2)*xmom2+ex(5)*ymom2+ex(8)*zmom2
        m32(i)=ex(3)*xmom2+ex(6)*ymom2+ex(9)*zmom2
C
        xx = xl(i,1)*xl(i,1) + xl(i,2)*xl(i,2) + xl(i,3)*xl(i,3)
        stir(1,i) = stir(1,i) + sti(2,i)*xx
        stir(2,i) = stir(2,i) + sti(1,i)*xx
      ENDDO
C
C----   Assemble
C
      IF(ivector==1) THEN
#include "vectorize.inc"
        DO i=jft,jlt
          ii = i+nft
          n = iadr(1,ii)
          fskyv(n,4)=m11(i)
          fskyv(n,5)=m21(i)
          fskyv(n,6)=m31(i)
          mx1(i) = -m11(i)
          my1(i) = -m21(i)
          mz1(i) = -m31(i)
          fskyv(n,8)=stir(1,i)
          n = iadr(2,ii)
          fskyv(n,4)=-m12(i)
          fskyv(n,5)=-m22(i)
          fskyv(n,6)=-m32(i)
          mx2(i) = m12(i)
          my2(i) = m22(i)
          mz2(i) = m32(i)
          fskyv(n,8)=stir(2,i)
        ENDDO
      ELSE
        DO i=jft,jlt
          ii = i+nft
          n = iadr(1,ii)
          fsky(4,n)=m11(i)
          fsky(5,n)=m21(i)
          fsky(6,n)=m31(i)
          mx1(i) = -m11(i)
          my1(i) = -m21(i)
          mz1(i) = -m31(i)
          fsky(8,n)=stir(1,i)
          n = iadr(2,ii)
          fsky(4,n)=-m12(i)
          fsky(5,n)=-m22(i)
          fsky(6,n)=-m32(i)
          mx2(i) = m12(i)
          my2(i) = m22(i)
          mz2(i) = m32(i)
          fsky(8,n)=stir(2,i)
        ENDDO
      ENDIF
C-----------------------------------------------
      RETURN