45
46
47
48 use matparam_def_mod
49
50
51
52#include "implicit_f.inc"
53
54
55
56#include "mvsiz_p.inc"
57#include "param_c.inc"
58
59
60
61 INTEGER, INTENT(IN) :: NEL
62 my_real,
INTENT(IN) :: theaccfact
63 INTEGER IPARTS(*),
64 . NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),
65 . NC5(MVSIZ),NC6(MVSIZ),NC7(MVSIZ),NC8(MVSIZ)
66
68 . vol(*), px1(mvsiz), py1(mvsiz),pz1(mvsiz),
69 . px2(mvsiz), py2(mvsiz),pz2(mvsiz),
70 . px3(mvsiz), py3(mvsiz),pz3(mvsiz),
71 . px4(mvsiz), py4(mvsiz),pz4(mvsiz),
72 . px5(mvsiz), py5(mvsiz),pz5(mvsiz),
73 . px6(mvsiz), py6(mvsiz),pz6(mvsiz),
74 . px7(mvsiz), py7(mvsiz),pz7(mvsiz),
75 . px8(mvsiz), py8(mvsiz),pz8(mvsiz),
76 . ni(8),tempnc(*), fphi(mvsiz,8), heat(*),
77 . dt1, tel(*), off(*), offg(*)
78 my_real partsav(npsav,*),vol0(*)
79 type (matparam_struct_) ,intent(in) :: mat_param
80
81
82
83 INTEGER I, M
84 my_real ca, cb, kc, phix, phiy, phiz, rhocp, t0
85
86 ca = mat_param%THERM%AS
87 cb = mat_param%THERM%BS
88 rhocp = mat_param%THERM%RHOCP
89 t0 = mat_param%THERM%TINI
90
91 DO i=1,nel
92 IF(off(i)==zero.OR.offg(i)<=zero) cycle
93
94
95 phix = tempnc(nc1(i))*px1(i) + tempnc(nc2(i))*px2(i) +
96 . tempnc(nc3(i))*px3(i) + tempnc(nc4(i))*px4(i) +
97 . tempnc(nc5(i))*px5(i) + tempnc(nc6(i))*px6(i) +
98 . tempnc(nc7(i))*px7(i) + tempnc(nc8(i))*px8(i)
99
100 phiy = tempnc(nc1(i))*py1(i) + tempnc(nc2(i))*py2(i) +
101 . tempnc(nc3(i))*py3(i) + tempnc(nc4(i))*py4(i) +
102 . tempnc(nc5(i))*py5(i) + tempnc(nc6(i))*py6(i) +
103 . tempnc(nc7(i))*py7(i) + tempnc(nc8(i))*py8(i)
104
105 phiz = tempnc(nc1(i))*pz1(i) + tempnc(nc2(i))*pz2(i) +
106 . tempnc(nc3(i))*pz3(i) + tempnc(nc4(i))*pz4(i) +
107 . tempnc(nc5(i))*pz5(i) + tempnc(nc6(i))*pz6(i) +
108 . tempnc(nc7(i))*pz7(i) + tempnc(nc8(i))*pz8(i)
109
110 kc = (ca + cb*tel(i))*dt1*vol(i)*theaccfact
111 phix = kc*phix
112 phiy = kc*phiy
113 phiz = kc*phiz
114
115
116
117 fphi(i,1) = fphi(i,1) +
118 . heat(i)*ni(1) - (phix*px1(i) + phiy*py1(i) + phiz*pz1(i))
119 fphi(i,2) = fphi(i,2) +
120 . heat(i)*ni(2) - (phix*px2(i) + phiy*py2(i) + phiz*pz2(i))
121 fphi(i,3) = fphi(i,3) +
122 . heat(i)*ni(3) - (phix*px3(i) + phiy*py3(i) + phiz*pz3(i))
123 fphi(i,4) = fphi(i,4) +
124 . heat(i)*ni(4) - (phix*px4(i) + phiy*py4(i) + phiz*pz4(i))
125 fphi(i,5) = fphi(i,5) +
126 . heat(i)*ni(5) - (phix*px5(i) + phiy*py5(i) + phiz*pz5(i))
127 fphi(i,6) = fphi(i,6) +
128 . heat(i)*ni(6) - (phix*px6(i) + phiy*py6(i) + phiz*pz6(i))
129 fphi(i,7) = fphi(i,7) +
130 . heat(i)*ni(7) - (phix*px7(i) + phiy*py7(i) + phiz*pz7(i))
131 fphi(i,8) = fphi(i,8) +
132 . heat(i)*ni(8) - (phix*px8(i) + phiy*py8(i) + phiz*pz8(i))
133 ENDDO
134
135 DO i=1,nel
136 IF(off(i)==zero.OR.offg(i)<=zero) cycle
137 m = iparts(i)
138 partsav(28,m)=partsav(28,m) + rhocp*vol0(i)*(tel(i)-t0) + heat(i)
139 ENDDO
140
141 RETURN