cbapinchproj.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	cbapinchproj (jft, jlt, vqn, vq, vfpinch, nplat, iplat, fp, corel, di, thk0, vfpinchdampx, vfpinchdampy)

Function/Subroutine Documentation

cbapinchproj()

subroutine cbapinchproj	(	integer	jft,
		integer	jlt,
			vqn,
			vq,
			vfpinch,
		integer	nplat,
		integer, dimension(*)	iplat,
			fp,
			corel,
			di,
			thk0,
			vfpinchdampx,
			vfpinchdampy )

Definition at line 31 of file cbapinchproj.F.

C-------------------------------------------------------------------------------
C   M o d u l e s
C-------------------------------------------------------------------------------
      USE pinchtype_mod
      USE elbufdef_mod
C-------------------------------------------------------------------------------
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
C-------------------------------------------------------------------------------
C   D U M M Y   A R G U M E N T S
C-------------------------------------------------------------------------------
      INTEGER JFT,JLT,NPLAT,IPLAT(*)
      my_real 
     .   vqn(mvsiz,9,4),vfpinch(mvsiz,4),vq(mvsiz,3,3),
     .   corel(mvsiz,3,4),di(mvsiz,6),fp(mvsiz,3,4), thk0(*),
     .   vfpinchdampx(mvsiz,4),vfpinchdampy(mvsiz,4)
C-------------------------------------------------------------------------------
C   L O C A L   V A R I A B L E S
C-------------------------------------------------------------------------------
      INTEGER I, J, K,EP
      my_real 
     .     fpp(3,4), elthkinv
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
#include "vectorize.inc"
      DO ep=jft,jlt
        k=iplat(ep)        
        elthkinv = one/thk0(ep)
C       FPP(1:3,node) = VFPINCH(node) * Normal(1:3,node)
C       Node 1 : FX,FY,FZ
        fpp(1,1)= vfpinch(k,1)*vqn(k,7,1)*elthkinv
        fpp(2,1)= vfpinch(k,1)*vqn(k,8,1)*elthkinv
        fpp(3,1)= vfpinch(k,1)*vqn(k,9,1)*elthkinv
C       Node 2 : FX,FY,FZ
        fpp(1,2)= vfpinch(k,2)*vqn(k,7,2)*elthkinv
        fpp(2,2)= vfpinch(k,2)*vqn(k,8,2)*elthkinv
        fpp(3,2)= vfpinch(k,2)*vqn(k,9,2)*elthkinv
C       Node 3 : FX,FY,FZ
        fpp(1,3)= vfpinch(k,3)*vqn(k,7,3)*elthkinv
        fpp(2,3)= vfpinch(k,3)*vqn(k,8,3)*elthkinv
        fpp(3,3)= vfpinch(k,3)*vqn(k,9,3)*elthkinv
C       Node 1 : FX,FY,FZ
        fpp(1,4)= vfpinch(k,4)*vqn(k,7,4)*elthkinv
        fpp(2,4)= vfpinch(k,4)*vqn(k,8,4)*elthkinv
        fpp(3,4)= vfpinch(k,4)*vqn(k,9,4)*elthkinv
 
C       damping contribution X
        fpp(1,1)= fpp(1,1)+vfpinchdampx(k,1)*vqn(k,1,1)*elthkinv
        fpp(2,1)= fpp(2,1)+vfpinchdampx(k,1)*vqn(k,2,1)*elthkinv
        fpp(3,1)= fpp(3,1)+vfpinchdampx(k,1)*vqn(k,3,1)*elthkinv
C       Node 2 : FX,FY,FZ
        fpp(1,2)= fpp(1,2)+vfpinchdampx(k,2)*vqn(k,1,2)*elthkinv
        fpp(2,2)= fpp(2,2)+vfpinchdampx(k,2)*vqn(k,2,2)*elthkinv
        fpp(3,2)= fpp(3,2)+vfpinchdampx(k,2)*vqn(k,3,2)*elthkinv
C       Node 3 : FX,FY,FZ
        fpp(1,3)= fpp(1,3)+vfpinchdampx(k,3)*vqn(k,1,3)*elthkinv
        fpp(2,3)= fpp(2,3)+vfpinchdampx(k,3)*vqn(k,2,3)*elthkinv
        fpp(3,3)= fpp(3,3)+vfpinchdampx(k,3)*vqn(k,3,3)*elthkinv
C       Node 4 : FX,FY,FZ
        fpp(1,4)= fpp(1,4)+vfpinchdampx(k,4)*vqn(k,1,4)*elthkinv
        fpp(2,4)= fpp(2,4)+vfpinchdampx(k,4)*vqn(k,2,4)*elthkinv
        fpp(3,4)= fpp(3,4)+vfpinchdampx(k,4)*vqn(k,3,4)*elthkinv
 
C       damping contribution Y
        fpp(1,1)= fpp(1,1)+vfpinchdampy(k,1)*vqn(k,4,1)*elthkinv
        fpp(2,1)= fpp(2,1)+vfpinchdampy(k,1)*vqn(k,5,1)*elthkinv
        fpp(3,1)= fpp(3,1)+vfpinchdampy(k,1)*vqn(k,6,1)*elthkinv
C       Node 2 : FX,FY,FZ
        fpp(1,2)= fpp(1,2)+vfpinchdampy(k,2)*vqn(k,4,2)*elthkinv
        fpp(2,2)= fpp(2,2)+vfpinchdampy(k,2)*vqn(k,5,2)*elthkinv
        fpp(3,2)= fpp(3,2)+vfpinchdampy(k,2)*vqn(k,6,2)*elthkinv
C       Node 3 : FX,FY,FZ
        fpp(1,3)= fpp(1,3)+vfpinchdampy(k,3)*vqn(k,4,3)*elthkinv
        fpp(2,3)= fpp(2,3)+vfpinchdampy(k,3)*vqn(k,5,3)*elthkinv
        fpp(3,3)= fpp(3,3)+vfpinchdampy(k,3)*vqn(k,6,3)*elthkinv
C       Node 4 : FX,FY,FZ
        fpp(1,4)= fpp(1,4)+vfpinchdampy(k,4)*vqn(k,4,4)*elthkinv
        fpp(2,4)= fpp(2,4)+vfpinchdampy(k,4)*vqn(k,5,4)*elthkinv
        fpp(3,4)= fpp(3,4)+vfpinchdampy(k,4)*vqn(k,6,4)*elthkinv
C
C       global projection
C       FP(1:3,node) (3x1) = VQ (3x3) * FPP(1:3,node) (3,1)
C       Node 1 : FX,FY,FZ
        fp(k,1,1)= vq(k,1,1)*fpp(1,1)+vq(k,1,2)*fpp(2,1)+vq(k,1,3)*fpp(3,1)
        fp(k,2,1)= vq(k,2,1)*fpp(1,1)+vq(k,2,2)*fpp(2,1)+vq(k,2,3)*fpp(3,1)
        fp(k,3,1)= vq(k,3,1)*fpp(1,1)+vq(k,3,2)*fpp(2,1)+vq(k,3,3)*fpp(3,1)
C       Node 2 : FX,FY,FZ
        fp(k,1,2)= vq(k,1,1)*fpp(1,2)+vq(k,1,2)*fpp(2,2)+vq(k,1,3)*fpp(3,2)
        fp(k,2,2)= vq(k,2,1)*fpp(1,2)+vq(k,2,2)*fpp(2,2)+vq(k,2,3)*fpp(3,2)
        fp(k,3,2)= vq(k,3,1)*fpp(1,2)+vq(k,3,2)*fpp(2,2)+vq(k,3,3)*fpp(3,2)
C       Node 3 : FX,FY,FZ
        fp(k,1,3)= vq(k,1,1)*fpp(1,3)+vq(k,1,2)*fpp(2,3)+vq(k,1,3)*fpp(3,3)
        fp(k,2,3)= vq(k,2,1)*fpp(1,3)+vq(k,2,2)*fpp(2,3)+vq(k,2,3)*fpp(3,3)
        fp(k,3,3)= vq(k,3,1)*fpp(1,3)+vq(k,3,2)*fpp(2,3)+vq(k,3,3)*fpp(3,3)
C       Node 4 : FX,FY,FZ
        fp(k,1,4)= vq(k,1,1)*fpp(1,4)+vq(k,1,2)*fpp(2,4)+vq(k,1,3)*fpp(3,4)
        fp(k,2,4)= vq(k,2,1)*fpp(1,4)+vq(k,2,2)*fpp(2,4)+vq(k,2,3)*fpp(3,4)
        fp(k,3,4)= vq(k,3,1)*fpp(1,4)+vq(k,3,2)*fpp(2,4)+vq(k,3,3)*fpp(3,4)
C
      ENDDO     
      RETURN