OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
therm3c.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 therm3c (nel, pm, thk, ixtg, px1, py1, py2, area, dt, tempnc, tempel, dheat, fphi, theaccfact)

Function/Subroutine Documentation

◆ therm3c()

subroutine therm3c ( integer, intent(in) nel,
pm,
thk,
integer, dimension(nixtg,*), intent(in) ixtg,
px1,
py1,
py2,
area,
intent(in) dt,
tempnc,
tempel,
dheat,
fphi,
intent(in) theaccfact )

Definition at line 29 of file therm3c.F.

32C-----------------------------------------------
33C calculates nodal thermic force from heat energy increment
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C G l o b a l P a r a m e t e r s
40C-----------------------------------------------
41#include "mvsiz_p.inc"
42#include "param_c.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER, INTENT(IN) :: NEL
47 INTEGER, INTENT(IN) :: IXTG(NIXTG,*)
48 my_real ,INTENT(IN) :: theaccfact
49 my_real ,INTENT(IN) :: dt
50 my_real :: area(nel), px1(mvsiz),py1(mvsiz), py2(mvsiz),
51 . tempnc(*), fphi(mvsiz,3), pm(*),dheat(nel),
52 . thk(nel),tempel(nel)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER :: I
57 my_real :: ca,cb ,kc,phix,phiy,a
58!===========================================================================
59 ca = pm(75)
60 cb = pm(76)
61!
62 DO i=1,nel
63cc ! element form functions
64cc PX1(I) = HALF*(X(2,IXTG(3,I)) - X(2,IXTG(4,I)))/AREA(I)
65cc PX2(I) = HALF*(X(2,IXTG(4,I)) - X(2,IXTG(2,I)))/AREA(I)
66cc PY1(I) = HALF*(X(1,IXTG(4,I)) - X(1,IXTG(3,I)))/AREA(I)
67cc PY2(I) = HALF*(X(1,IXTG(2,I)) - X(1,IXTG(4,I)))/AREA(I)
68
69 kc = (ca + cb*tempel(i))*dt / max(em20,area(i))*theaccfact
70 phix = tempnc(ixtg(2,i))*px1(i) - tempnc(ixtg(3,i))*px1(i)
71
72 phiy = tempnc(ixtg(2,i))*py1(i) + tempnc(ixtg(3,i))*py2(i) -
73 . tempnc(ixtg(4,i))*(py1(i) + py2(i))
74C
75 phix = kc*phix*thk(i)
76 phiy = kc*phiy*thk(i)
77C
78C nodal thermal force (flux)
79C
80 a = third * dheat(i)
81 fphi(i,1) = a - phix*px1(i) - phiy*py1(i)
82 fphi(i,2) = a + phix*px1(i) - phiy*py2(i)
83 fphi(i,3) = a + phiy*(py1(i)+py2(i))
84 ENDDO
85!------------
86 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define max(a, b)
Definition macros.h:21