stherm.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	stherm (pm, imat, vol, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, dt1, tempnc, tempel, heat, fphi, offg, off, partsav, iparts, vol0, nel, numnod, theaccfact)

Function/Subroutine Documentation

stherm()

subroutine stherm	(		pm,
		integer, intent(in)	imat,
			vol,
		integer, dimension(mvsiz)	nc1,
		integer, dimension(mvsiz)	nc2,
		integer, dimension(mvsiz)	nc3,
		integer, dimension(mvsiz)	nc4,
		integer, dimension(mvsiz)	nc5,
		integer, dimension(mvsiz)	nc6,
		integer, dimension(mvsiz)	nc7,
		integer, dimension(mvsiz)	nc8,
			px1,
			px2,
			px3,
			px4,
			py1,
			py2,
			py3,
			py4,
			pz1,
			pz2,
			pz3,
			pz4,
			dt1,
			tempnc,
			tempel,
		dimension(mvsiz), intent(in)	heat,
			fphi,
			offg,
			off,
			partsav,
		integer, dimension(*)	iparts,
			vol0,
		integer, intent(in)	nel,
		integer, intent(in)	numnod,
		intent(in)	theaccfact )

Definition at line 29 of file stherm.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"
#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) :: NUMNOD
      INTEGER, INTENT(IN) :: IMAT
      INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),
     .        NC5(MVSIZ),NC6(MVSIZ),NC7(MVSIZ),NC8(MVSIZ)
      INTEGER IPARTS(*)
      my_real :: dt1
      my_real ,INTENT(IN) :: theaccfact
      my_real ,INTENT(IN) :: heat(mvsiz)
      my_real :: tempnc(numnod)
      my_real :: tempel(nel) 
      my_real :: off(nel)
      my_real :: offg(nel)
      my_real :: vol(nel)
      my_real :: vol0(nel)
      my_real :: px1(*), px2(*), px3(*), px4(*), 
     .           py1(*), py2(*), py3(*), py4(*),
     .           pz1(*), pz2(*), pz3(*), pz4(*)
      my_real :: fphi(mvsiz,8)
      my_real :: pm(npropm,*)
      my_real :: partsav(npsav,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,M
      my_real as, bs, kc, phix, phiy, phiz, a, b, rhocp, t0
!==============================================================================
      as    = pm(75,imat)    !< thermal conductivity coefficient A for solid phase
      bs    = pm(76,imat)    !< thermal conductivity coefficient B for solid phase
      rhocp = pm(69,imat)
      t0    = pm(79,imat)
C 
C     calculate thermal flux  
C      
      DO i=1,nel
        IF(off(i)==zero.OR.offg(i)<=zero) cycle
        phix =  tempnc(nc1(i))*px1(i) + tempnc(nc2(i))*px2(i)  +
     .          tempnc(nc3(i))*px3(i) + tempnc(nc4(i))*px4(i)  -
     .          tempnc(nc5(i))*px3(i) - tempnc(nc6(i))*px4(i)  -
     .          tempnc(nc7(i))*px1(i) - tempnc(nc8(i))*px2(i)       
        
        phiy =  tempnc(nc1(i))*py1(i) + tempnc(nc2(i))*py2(i)  +
     .          tempnc(nc3(i))*py3(i) + tempnc(nc4(i))*py4(i)  -
     .          tempnc(nc5(i))*py3(i) - tempnc(nc6(i))*py4(i)  -
     .          tempnc(nc7(i))*py1(i) - tempnc(nc8(i))*py2(i)
      
        phiz =  tempnc(nc1(i))*pz1(i) + tempnc(nc2(i))*pz2(i)  +
     .          tempnc(nc3(i))*pz3(i) + tempnc(nc4(i))*pz4(i)  -
     .          tempnc(nc5(i))*pz3(i) - tempnc(nc6(i))*pz4(i)  -
     .          tempnc(nc7(i))*pz1(i) - tempnc(nc8(i))*pz2(i)          
C
        kc = (as + bs*tempel(i))*vol(i)*dt1*theaccfact
        phix = kc*phix
        phiy = kc*phiy
        phiz = kc*phiz         
C
C       ! nodal thermal force
C
        a = one_over_8 * heat(i)
        b = phix*px1(i) + phiy*py1(i) + pz1(i)*phiz        
        fphi(i,1) = a - b
        fphi(i,7) = a + b
        b = phix*px2(i) + phiy*py2(i) + pz2(i)*phiz
        fphi(i,2) = a - b
        fphi(i,8) = a + b
        b = phix*px3(i) + phiy*py3(i) + pz3(i)*phiz
        fphi(i,3) = a - b
        fphi(i,5) = a + b
        b = phix*px4(i) + phiy*py4(i) + pz4(i)*phiz
        fphi(i,4) = a - b 
        fphi(i,6) = a + b
      ENDDO
C  
      DO i=1,nel
        IF (off(i)==zero.OR.offg(i)<=zero) cycle
        m = iparts(i)
        partsav(28,m) = partsav(28,m) + rhocp*vol0(i)*(tempel(i)-t0) + heat(i)
      ENDDO
!-----------
      RETURN