32 2 OFFG ,OFF ,STI ,STIR,STIFN,
33 3 STIFR,IXTG,NODADT_THERM,
34 4 F11 ,F12 ,F13 ,F21 ,F22 ,F23 ,
35 5 F31 ,F32 ,F33 ,M11 ,M12 ,
36 6 M13 ,M21 ,M22 ,M23 ,M31 ,
37 7 M32 ,M33 ,JTHE,THEM,FTHE,
38 8 EINT ,PM ,AREA,THK ,PARTSAV,
39 9 MAT,IPARTTG,CONDN,CONDE)
40 use element_mod ,
only : nixtg
44#include "implicit_f.inc"
57 INTEGER ,
INTENT(IN) :: NODADT_THERM
58 INTEGER JTHE,JFT, JLT, NVC
59 INTEGER IXTG(NIXTG,*),MAT(MVSIZ),IPARTTG(*)
61 . F(3,*), M(3,*), OFFG(*), OFF(*), STI(*), STIR(*),
62 . STIFN(*), STIFR(*),CONDN(*),CONDE(*)
63 my_real F11(MVSIZ), F12(MVSIZ), F13(MVSIZ),
64 . F21(MVSIZ), F22(MVSIZ), F23(MVSIZ),
65 . f31(mvsiz), f32(mvsiz), f33(mvsiz),
66 . m11(mvsiz), m12(mvsiz), m13(mvsiz),
67 . m21(mvsiz), m22(mvsiz), m23(mvsiz),
68 . m31(mvsiz), m32(mvsiz), m33(mvsiz),
69 . them(mvsiz,3),fthe(*),eint(jlt,2),pm(npropm,*),
area(*),thk(*),
74 INTEGER I,NVC1,NVC2,NVC3,NC1,NC2,NC3
81 IF(off(i)<one)offg(i) = off(i)
82 off_l =
min(off_l,offg(i))
86 IF (offg(i) < zero)
THEN
117 nvc3=(nvc-nvc1*8-nvc2*4)/2
121#include "vectorize.inc"
124 f(1,nc1)=f(1,nc1)-f11(i)
125 f(2,nc1)=f(2,nc1)-f21(i)
126 f(3,nc1)=f(3,nc1)-f31(i)
127 m(1,nc1)=m(1,nc1)-m11(i)
128 m(2,nc1)=m(2,nc1)-m21(i)
129 m(3,nc1)=m(3,nc1)-m31(i)
130 stifn(nc1)=stifn(nc1)+sti(i)
131 stifr(nc1)=stifr(nc1)+stir(i)
134 IF(nodadt_therm == 1 )
THEN
135#include "vectorize.inc"
138 f(1,nc1)=f(1,nc1)-f11(i)
139 f(2,nc1)=f(2,nc1)-f21(i)
140 f(3,nc1)=f(3,nc1)-f31(i)
141 m(1,nc1)=m(1,nc1)-m11(i)
142 m(2,nc1)=m(2,nc1)-m21(i)
143 m(3,nc1)=m(3,nc1)-m31(i)
144 stifn(nc1)=stifn(nc1)+sti(i)
145 stifr(nc1)=stifr(nc1)+stir(i)
146 fthe(nc1) = fthe(nc1) + them(i,1)
147 condn(nc1)=condn(nc1)+conde(i)
150#include "vectorize.inc"
153 f(1,nc1)=f(1,nc1)-f11(i)
154 f(2,nc1)=f(2,nc1)-f21(i)
156 m(1,nc1)=m(1,nc1)-m11(i)
157 m(2,nc1)=m(2,nc1)-m21(i)
158 m(3,nc1)=m(3,nc1)-m31(i)
159 stifn(nc1)=stifn(nc1)+sti(i)
160 stifr(nc1)=stifr(nc1)+stir(i)
161 fthe(nc1) = fthe(nc1) + them(i,1)
170 f(1,nc1)=f(1,nc1)-f11(i)
171 f(2,nc1)=f(2,nc1)-f21(i)
172 f(3,nc1)=f(3,nc1)-f31(i)
173 m(1,nc1)=m(1,nc1)-m11(i)
174 m(2,nc1)=m(2,nc1)-m21(i)
175 m(3,nc1)=m(3,nc1)-m31(i)
176 stifn(nc1)=stifn(nc1)+sti(i)
177 stifr(nc1)=stifr(nc1)+stir(i)
180 IF(nodadt_therm == 1 )
THEN
183 f(1,nc1)=f(1,nc1)-f11(i)
184 f(2,nc1)=f(2,nc1)-f21(i)
185 f(3,nc1)=f(3,nc1)-f31(i)
186 m(1,nc1)=m(1,nc1)-m11(i)
187 m(2,nc1)=m(2,nc1)-m21(i)
188 m(3,nc1)=m(3,nc1)-m31(i)
189 stifn(nc1)=stifn(nc1)+sti(i)
190 stifr(nc1)=stifr(nc1)+stir(i)
191 fthe(nc1) = fthe(nc1) + them(i,1)
192 condn(nc1)=condn(nc1)+conde(i)
197 f(1,nc1)=f(1,nc1)-f11(i)
198 f(2,nc1)=f(2,nc1)-f21(i)
199 f(3,nc1)=f(3,nc1)-f31(i)
200 m(1,nc1)=m(1,nc1)-m11(i)
201 m(2,nc1)=m(2,nc1)-m21(i)
202 m(3,nc1)=m(3,nc1)-m31(i)
203 stifn(nc1)=stifn(nc1)+sti(i)
204 stifr(nc1)=stifr(nc1)+stir(i)
205 fthe(nc1) = fthe(nc1) + them(i,1)
213#include "vectorize.inc"
216 f(1,nc2)=f(1,nc2)-f12(i)
217 f(2,nc2)=f(2,nc2)-f22(i)
218 f(3,nc2)=f(3,nc2)-f32(i)
219 m(1,nc2)=m(1,nc2)-m12(i)
220 m(2,nc2)=m(2,nc2)-m22(i)
221 m(3,nc2)=m(3,nc2)-m32(i)
222 stifn(nc2)=stifn(nc2)+sti(i)
223 stifr(nc2)=stifr(nc2)+stir(i)
226 IF(nodadt_therm == 1 )
THEN
227#include "vectorize.inc"
230 f(1,nc2)=f(1,nc2)-f12(i)
231 f(2,nc2)=f(2,nc2)-f22(i)
232 f(3,nc2)=f(3,nc2)-f32(i)
233 m(1,nc2)=m(1,nc2)-m12(i)
234 m(2,nc2)=m(2,nc2)-m22(i)
235 m(3,nc2)=m(3,nc2)-m32(i)
236 stifn(nc2)=stifn(nc2)+sti(i)
237 stifr(nc2)=stifr(nc2)+stir(i)
238 fthe(nc2) = fthe(nc2) + them(i,2)
239 condn(nc2)=condn(nc2)+conde(i)
242#include "vectorize.inc"
245 f(1,nc2)=f(1,nc2)-f12(i)
246 f(2,nc2)=f(2,nc2)-f22(i)
247 f(3,nc2)=f(3,nc2)-f32(i)
248 m(1,nc2)=m(1,nc2)-m12(i)
249 m(2,nc2)=m(2,nc2)-m22(i)
250 m(3,nc2)=m(3,nc2)-m32(i)
251 stifn(nc2)=stifn(nc2)+sti(i)
252 stifr(nc2)=stifr(nc2)+stir(i)
253 fthe(nc2) = fthe(nc2) + them(i,2)
261 f(1,nc2)=f(1,nc2)-f12(i)
262 f(2,nc2)=f(2,nc2)-f22(i)
263 f(3,nc2)=f(3,nc2)-f32(i)
264 m(1,nc2)=m(1,nc2)-m12(i)
265 m(2,nc2)=m(2,nc2)-m22(i)
266 m(3,nc2)=m(3,nc2)-m32(i)
267 stifn(nc2)=stifn(nc2)+sti(i)
268 stifr(nc2)=stifr(nc2)+stir(i)
271 IF(nodadt_therm == 1 )
THEN
274 f(1,nc2)=f(1,nc2)-f12(i)
275 f(2,nc2)=f(2,nc2)-f22(i)
276 f(3,nc2)=f(3,nc2)-f32(i)
277 m(1,nc2)=m(1,nc2)-m12(i)
278 m(2,nc2)=m(2,nc2)-m22(i)
279 m(3,nc2)=m(3,nc2)-m32(i)
280 stifn(nc2)=stifn(nc2)+sti(i)
281 stifr(nc2)=stifr(nc2)+stir(i)
282 fthe(nc2) = fthe(nc2) + them(i,2)
283 condn(nc2)=condn(nc2)+conde(i)
288 f(1,nc2)=f(1,nc2)-f12(i)
289 f(2,nc2)=f(2,nc2)-f22(i)
290 f(3,nc2)=f(3,nc2)-f32(i)
291 m(1,nc2)=m(1,nc2)-m12(i)
292 m(2,nc2)=m(2,nc2)-m22(i)
293 m(3,nc2)=m(3,nc2)-m32(i)
294 stifn(nc2)=stifn(nc2)+sti(i)
295 stifr(nc2)=stifr(nc2)+stir(i)
296 fthe(nc2) = fthe(nc2) + them(i,2)
304#include "vectorize.inc"
307 f(1,nc3)=f(1,nc3)-f13(i)
308 f(2,nc3)=f(2,nc3)-f23(i)
309 f(3,nc3)=f(3,nc3)-f33(i)
310 m(1,nc3)=m(1,nc3)-m13(i)
311 m(2,nc3)=m(2,nc3)-m23(i)
312 m(3,nc3)=m(3,nc3)-m33(i)
313 stifn(nc3)=stifn(nc3)+sti(i)
314 stifr(nc3)=stifr(nc3)+stir(i)
317 IF(nodadt_therm == 1 )
THEN
318#include "vectorize.inc"
321 f(1,nc3)=f(1,nc3)-f13(i)
322 f(2,nc3)=f(2,nc3)-f23(i)
323 f(3,nc3)=f(3,nc3)-f33(i)
324 m(1,nc3)=m(1,nc3)-m13(i)
325 m(2,nc3)=m(2,nc3)-m23(i)
326 m(3,nc3)=m(3,nc3)-m33(i)
327 stifn(nc3)=stifn(nc3)+sti(i)
328 stifr(nc3)=stifr(nc3)+stir(i)
329 fthe(nc3) = fthe(nc3) + them(i,3)
330 condn(nc3)=condn(nc3)+conde(i)
333#include "vectorize.inc"
336 f(1,nc3)=f(1,nc3)-f13(i)
337 f(2,nc3)=f(2,nc3)-f23(i)
338 f(3,nc3)=f(3,nc3)-f33(i)
339 m(1,nc3)=m(1,nc3)-m13(i)
340 m(2,nc3)=m(2,nc3)-m23(i)
341 m(3,nc3)=m(3,nc3)-m33(i)
342 stifn(nc3)=stifn(nc3)+sti(i)
343 stifr(nc3)=stifr(nc3)+stir(i)
344 fthe(nc3) = fthe(nc3) + them(i,3)
353 f(1,nc3)=f(1,nc3)-f13(i)
354 f(2,nc3)=f(2,nc3)-f23(i)
355 f(3,nc3)=f(3,nc3)-f33(i)
356 m(1,nc3)=m(1,nc3)-m13(i)
357 m(2,nc3)=m(2,nc3)-m23(i)
358 m(3,nc3)=m(3,nc3)-m33(i)
359 stifn(nc3)=stifn(nc3)+sti(i)
360 stifr(nc3)=stifr(nc3)+stir(i)
363 IF(nodadt_therm == 1 )
THEN
366 f(1,nc3)=f(1,nc3)-f13(i)
367 f(2,nc3)=f(2,nc3)-f23(i)
368 f(3,nc3)=f(3,nc3)-f33(i)
369 m(1,nc3)=m(1,nc3)-m13(i)
370 m(2,nc3)=m(2,nc3)-m23(i)
371 m(3,nc3)=m(3,nc3)-m33(i)
372 stifn(nc3)=stifn(nc3)+sti(i)
373 stifr(nc3)=stifr(nc3)+stir(i)
374 fthe(nc3) = fthe(nc3) + them(i,3)
375 condn(nc3)=condn(nc3)+conde(i)
380 f(1,nc3)=f(1,nc3)-f13(i)
381 f(2,nc3)=f(2,nc3)-f23(i)
382 f(3,nc3)=f(3,nc3)-f33(i)
383 m(1,nc3)=m(1,nc3)-m13(i)
384 m(2,nc3)=m(2,nc3)-m23(i)
385 m(3,nc3)=m(3,nc3)-m33(i)
386 stifn(nc3)=stifn(nc3)+sti(i)
387 stifr(nc3)=stifr(nc3)+stir(i)
388 fthe(nc3) = fthe(nc3) + them(i,3)
403 2 STIR,FSKY,FSKYV,IADTG,F11 ,
404 4 F12 ,F13 ,F21 ,F22 ,F23 ,
405 5 F31 ,F32 ,F33 ,M11 ,M12 ,
406 6 M13 ,M21 ,M22 ,M23 ,M31 ,
407 7 M32 ,M33 ,JTHE,THEM,FTHESKY,
408 8 EINT ,PM ,AREA,THK ,PARTSAV,
409 9 MAT,IPARTTG,CONDNSKY,CONDE ,
414#include "implicit_f.inc"
418#include "mvsiz_p.inc"
422#include "param_c.inc"
423#include "parit_c.inc"
424#include "scr18_c.inc"
428 INTEGER ,
INTENT(IN) :: NODADT_THERM
429 INTEGER JFT, JLT, IADTG(3,*),JTHE,MAT(),IPARTTG(*)
431 . OFFG(*), OFF(*), STI(*), STIR(*), FSKYV(LSKY,8),
433 my_real F11(MVSIZ), F12(MVSIZ), F13(MVSIZ),
434 . F21(MVSIZ), F22(MVSIZ), F23(MVSIZ),
435 . F31(MVSIZ), F32(MVSIZ), F33(MVSIZ),
436 . M11(MVSIZ), M12(MVSIZ), M13(MVSIZ),
437 . M21(MVSIZ), M22(MVSIZ), M23(MVSIZ),
438 . M31(MVSIZ), M32(MVSIZ), M33(MVSIZ),
440 . THEM(MVSIZ,3),FTHESKY(LSKY),CONDNSKY(*),
441 . EINT(JLT,2),PM(NPROPM,*),AREA(*),THK(*),PARTSAV(NPSAV,*)
452 IF (off(i) < one) offg(i) = off(i)
453 off_l =
min(off_l,offg(i))
457 IF(offg(i) < zero)
THEN
487 IF (ivector == 1)
THEN
488#include
"vectorize.inc"
550 IF (ivector == 1)
THEN
551 IF(nodadt_therm == 1)
THEN
552#include "vectorize.inc"
563 fthesky(k) = them(i,1)
564 condnsky(k) = conde(i)
574 fthesky(k) = them(i,2)
575 condnsky(k) = conde(i)
585 fthesky(k) = them(i,3)
586 condnsky(k) = conde(i)
589#include "vectorize.inc"
600 fthesky(k) = them(i,1)
601 condnsky(k) = conde(i)
611 fthesky(k) = them(i,2)
612 condnsky(k) = conde(i)
622 fthesky(k) = them(i,3)
623 condnsky(k) = conde(i)
627 IF(nodadt_therm == 1)
THEN
638 fthesky(k) = them(i,1)
648 fthesky(k) = them(i,2)
658 fthesky(k) = them(i,3)
671 fthesky(k) = them(i,1)
681 fthesky(k) = them(i,2)
691 fthesky(k) = them(i,3)
subroutine c3updt3(jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixtg, nodadt_therm, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthe, eint, pm, area, thk, partsav, mat, iparttg, condn, conde)
subroutine c3updt3p(jft, jlt, offg, off, sti, stir, fsky, fskyv, iadtg, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, jthe, them, fthesky, eint, pm, area, thk, partsav, mat, iparttg, condnsky, conde, nodadt_therm)
subroutine cdkforc3(timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, itab, epsdot, iparttg, thke, group_param, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, igeo, ipm, ifailure, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, jthe, condn, condnsky, isubstack, stack, itask, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, nxlaymax, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)