spbilan.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	spbilan (v, partsav, nc1, eint, rho, rk, vol, vnew, ipartsp, offg, gresav, grth, igrth, eintth, iexpan, x, lft, llt, jtur, igre)

Function/Subroutine Documentation

spbilan()

subroutine spbilan	(		v,
			partsav,
		integer, dimension(*)	nc1,
			eint,
			rho,
			rk,
			vol,
			vnew,
		integer, dimension(*)	ipartsp,
			offg,
			gresav,
		integer, dimension(*)	grth,
		integer, dimension(*)	igrth,
			eintth,
		integer	iexpan,
			x,
		integer, intent(inout)	lft,
		integer, intent(inout)	llt,
		integer, intent(inout)	jtur,
		integer, intent(inout)	igre )

Definition at line 30 of file spbilan.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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(INOUT) :: LFT
      INTEGER, INTENT(INOUT) :: LLT
      INTEGER, INTENT(INOUT) :: JTUR
      INTEGER, INTENT(INOUT) :: IGRE
C     REAL
      my_real
     .  v(3,*),x(3,*),
     .  partsav(npsav,*), eint(*), rho(*), rk(*), vol(*),
     .  vnew(*),offg(*),gresav(*),eintth(*)
      INTEGER NC1(*),IPARTSP(*),GRTH(*),IGRTH(*),IEXPAN
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, M, FLAG
C     REAL
      my_real
     .   vxa(mvsiz),vya(mvsiz),vza(mvsiz),va2(mvsiz),xmas(mvsiz),
     .   rbidon(1),off(mvsiz),ei(mvsiz),ek(mvsiz),
     .   xm(mvsiz),ym(mvsiz),zm(mvsiz),
     .   xx(mvsiz), yy(mvsiz), zz(mvsiz),
     .   xcg(mvsiz), ycg(mvsiz), zcg(mvsiz),
     .   xy(mvsiz) , yz(mvsiz) , zx(mvsiz),
     .   xx2(mvsiz), yy2(mvsiz), zz2(mvsiz),
     .   xxm(mvsiz), yym(mvsiz), zzm(mvsiz),
     .   ixx(mvsiz), iyy(mvsiz), izz(mvsiz),
     .   ixy(mvsiz), iyz(mvsiz), izx(mvsiz),
     .   rei(mvsiz), rek(mvsiz)
C-----------------------------------------------
      rbidon = zero
      off    = zero
      ei = zero
      ek = zero
      xm = zero
      ym = zero
      zm = zero
C
C     NODAL VELOCITIES AND COORDINATES
      DO 20 i=lft,llt
       vxa(i)=v(1,nc1(i))
       vya(i)=v(2,nc1(i))
       vza(i)=v(3,nc1(i))
       va2(i)=vxa(i)*vxa(i)+vya(i)*vya(i)+vza(i)*vza(i)
       xx(i) =x(1,nc1(i))
       yy(i) =x(2,nc1(i))
       zz(i) =x(3,nc1(i))
       xx2(i)=x(1,nc1(i))**2
       yy2(i)=x(2,nc1(i))**2
       zz2(i)=x(3,nc1(i))**2
       xy(i) =x(1,nc1(i))*x(2,nc1(i))
       yz(i) =x(2,nc1(i))*x(3,nc1(i))
       zx(i) =x(3,nc1(i))*x(1,nc1(i))
   20 CONTINUE
C
      DO i=lft,llt
        xmas(i)=rho(i)*vnew(i)
        ei(i)  = eint(i)*vol(i)
        ek(i)  = xmas(i)*va2(i)*half
        off(i) = one
        xm(i)  = xmas(i)*vxa(i)
        ym(i)  = xmas(i)*vya(i)
        zm(i)  = xmas(i)*vza(i)
      ENDDO
 
      DO i=lft,llt
        xcg(i)= xmas(i)*xx(i)
        ycg(i)= xmas(i)*yy(i)
        zcg(i)= xmas(i)*zz(i)
        ixy(i)= -xmas(i)*xy(i)
        iyz(i)= -xmas(i)*yz(i)
        izx(i)= -xmas(i)*zx(i)
        ixx(i)= xmas(i)*(yy2(i) + zz2(i))
        iyy(i)= xmas(i)*(zz2(i) + xx2(i))
        izz(i)= xmas(i)*(xx2(i) + yy2(i))
        xxm(i)= vza(i)*ycg(i)-vya(i)*zcg(i)
        yym(i)= vxa(i)*zcg(i)-vza(i)*xcg(i)
        zzm(i)= vya(i)*xcg(i)-vxa(i)*ycg(i)
        rei(i)= zero
        rek(i)= zero
      ENDDO
 
      flag = 0
      IF (igre /= 0) THEN
          CALL grelem_sav(lft   ,llt   ,gresav,igrth ,grth  ,
     2                    off   ,ei    ,ek    ,xm    ,ym    ,
     3                    zm    ,xmas  ,xcg   ,ycg   ,zcg   ,
     4                    xxm   ,yym   ,zzm   ,ixx   ,iyy   ,
     5                    izz   ,ixy   ,iyz   ,izx   ,rei   ,
     6                    rek   ,flag  )
      ENDIF
C
      DO i=lft,llt
        m=ipartsp(i)
        partsav(1,m)=partsav(1,m) + eint(i)*vol(i)
        partsav(2,m)=partsav(2,m) + xmas(i)*va2(i)*half
        partsav(6,m)=partsav(6,m) + xmas(i)
        partsav(3,m)=partsav(3,m) + xmas(i)*vxa(i)
        partsav(4,m)=partsav(4,m) + xmas(i)*vya(i)
        partsav(5,m)=partsav(5,m) + xmas(i)*vza(i)
        partsav(9,m) =partsav(9,m)  + xcg(i)
        partsav(10,m)=partsav(10,m) + ycg(i)
        partsav(11,m)=partsav(11,m) + zcg(i)
        partsav(12,m)=partsav(12,m) + xxm(i)
        partsav(13,m)=partsav(13,m) + yym(i)
        partsav(14,m)=partsav(14,m) + zzm(i)
        partsav(15,m)=partsav(15,m) + ixx(i)
        partsav(16,m)=partsav(16,m) + iyy(i)
        partsav(17,m)=partsav(17,m) + izz(i)
        partsav(18,m)=partsav(18,m) + ixy(i)
        partsav(19,m)=partsav(19,m) + iyz(i)
        partsav(20,m)=partsav(20,m) + izx(i)
        partsav(21,m)=partsav(21,m) + rei(i)
        partsav(22,m)=partsav(22,m) + rek(i) 
      ENDDO
C
      IF(jtur/=0)THEN
       DO 50 i=lft,llt
       IF(offg(i)>zero)THEN
        m=ipartsp(i)
        partsav(7,m)=partsav(7,m) + rk(i)*vol(i)
       ENDIF
   50  CONTINUE
      ENDIF
 
Cbm   THERMAL EXPANSION
      IF(iexpan/=0)THEN
       DO i=lft,llt
         m=ipartsp(i)
         partsav(27,m)=partsav(27,m) + eintth(i)*vol(i)
       END DO
      ENDIF
 
C
      RETURN