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