OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thermc.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 thermc (jft, jlt, pm, mat, thk, ixc, px1, px2, py1, py2, area, dt1c, tempnc, tempel, die, fphi, theaccfact)

Function/Subroutine Documentation

◆ thermc()

subroutine thermc ( integer jft,
integer jlt,
pm,
integer, dimension(*) mat,
thk,
integer, dimension(nixc,*) ixc,
px1,
px2,
py1,
py2,
area,
dt1c,
tempnc,
tempel,
die,
fphi,
intent(in) theaccfact )

Definition at line 33 of file thermc.F.

36 use element_mod , only : nixc
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER JFT, JLT,MAT(*),IXC(NIXC,*)
50 my_real ,INTENT(IN) :: theaccfact
52 . area(*), px1(*), px2(*), py1(*), py2(*),
53 . tempnc(*), fphi(mvsiz,4), pm(npropm,*),die(*),
54 . dt1c(*), thk(*),tempel(*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER I,MX
59 my_real :: ca,cb ,kc ,phix,phiy,a
60!=======================================================================
61 mx =mat(jft)
62 ca = pm(75,mx)
63 cb = pm(76,mx)
64!
65 DO i=jft,jlt
66C
67C - flux
68C
69 kc = (ca + cb*tempel(i))*dt1c(i)/max(em20,area(i))*theaccfact
70 phix = tempnc(ixc(2,i))*px1(i) + tempnc(ixc(3,i))*px2(i) -
71 . tempnc(ixc(4,i))*px1(i) - tempnc(ixc(5,i))*px2(i)
72
73 phiy = tempnc(ixc(2,i))*py1(i) + tempnc(ixc(3,i))*py2(i) -
74 . tempnc(ixc(4,i))*py1(i) - tempnc(ixc(5,i))*py2(i)
75C
76 phix = kc*phix*thk(i)
77 phiy = kc*phiy*thk(i)
78C
79C nodal thermal force
80C
81 a = fourth * die(i)
82 fphi(i,1) = a - (phix*px1(i) + phiy*py1(i))
83 fphi(i,2) = a - (phix*px2(i) + phiy*py2(i))
84 fphi(i,3) = a + (phix*px1(i) + phiy*py1(i))
85 fphi(i,4) = a + (phix*px2(i) + phiy*py2(i))
86 ENDDO
87C
88 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