OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21ass3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr18_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i21ass3 (jlt, a, nin, noint, fxn, fyn, fzn, fxt, fyt, fzt, ix1, ix2, ix3, ix4, nsvg, fcont, fncont, ftcont, lb, lc, itria, stifn, stif, fskyi, isky, isecin, nstrf, secfcum, ftxsav, ftysav, ftzsav, cand_n, intstamp, weight, msr, intth, phi, fthe, ftheskyi, mxi, myi, mzi, stri, nodglob, ncont, indexcont, tagcont, condn, condint, condnskyi, iform, phi1, phi2, phi3, phi4, h1, h2, h3, h4, niskyfi, msrl, itab, h3d_data, ninskid, pratio, ninterskid, pskids, iflagloadp, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, dist, gapv, s_loadpinter, efric_l, fheat, efrict, interefric, nodadt_therm)

Function/Subroutine Documentation

◆ i21ass3()

subroutine i21ass3 ( integer jlt,
a,
integer nin,
integer noint,
fxn,
fyn,
fzn,
fxt,
fyt,
fzt,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
fcont,
fncont,
ftcont,
lb,
lc,
integer, dimension(mvsiz) itria,
stifn,
stif,
fskyi,
integer, dimension(*) isky,
integer isecin,
integer, dimension(*) nstrf,
secfcum,
ftxsav,
ftysav,
ftzsav,
integer, dimension(*) cand_n,
type(intstamp_data) intstamp,
integer, dimension(*) weight,
integer, dimension(*) msr,
integer intth,
phi,
fthe,
ftheskyi,
mxi,
myi,
mzi,
stri,
integer, dimension(*) nodglob,
integer ncont,
integer, dimension(*) indexcont,
integer, dimension(*) tagcont,
condn,
condint,
condnskyi,
integer iform,
phi1,
phi2,
phi3,
phi4,
h1,
h2,
h3,
h4,
integer niskyfi,
integer, dimension(*) msrl,
integer, dimension(*) itab,
type(h3d_database) h3d_data,
integer ninskid,
pratio,
integer ninterskid,
pskids,
integer iflagloadp,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1), intent(in) kloadpinter,
integer, dimension(s_loadpinter), intent(in) loadpinter,
integer, dimension(nloadp_hyd), intent(in) loadp_hyd_inter,
dimension(s_loadpinter), intent(in) dgaploadint,
dimension(mvsiz), intent(in) dist,
dimension(mvsiz), intent(in) gapv,
integer, intent(in) s_loadpinter,
dimension(mvsiz), intent(inout) efric_l,
intent(in) fheat,
dimension(mvsiz), intent(inout) efrict,
integer, intent(in) interefric,
integer, intent(in) nodadt_therm )

Definition at line 36 of file i21ass3.F.

53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
56 USE intstamp_mod
57 USE tri7box
58 USE h3d_mod
59 USE tri7box
60 USE anim_mod
61 USE outputs_mod
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66#include "comlock.inc"
67C-----------------------------------------------
68C G l o b a l P a r a m e t e r s
69C-----------------------------------------------
70#include "mvsiz_p.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "com06_c.inc"
77#include "com08_c.inc"
78#include "parit_c.inc"
79#include "scr07_c.inc"
80#include "scr14_c.inc"
81#include "scr16_c.inc"
82#include "scr18_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER JLT, NIN, NOINT, ISKY(*), ISECIN, NSTRF(*),NCONT,IFORM,NISKYFI,
87 . NINSKID,NINTERSKID,IFLAGLOADP
88 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
89 . NSVG(MVSIZ), ITRIA(MVSIZ), CAND_N(*), WEIGHT(*),
90 . MSR(*), INTTH, NODGLOB(*),INDEXCONT(*),TAGCONT(*),MSRL(*),ITAB(*),
91 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD)
92 INTEGER , INTENT(IN) :: S_LOADPINTER
93 INTEGER , INTENT(IN) :: NODADT_THERM
94 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
95 . LOADP_HYD_INTER(NLOADP_HYD)
96 INTEGER , INTENT(IN) :: INTEREFRIC
97 my_real , INTENT(IN) :: fheat
98 my_real , INTENT(IN) :: dgaploadint(s_loadpinter),dist(mvsiz),gapv(mvsiz)
99 my_real , INTENT(INOUT) :: efric_l(mvsiz),efrict(mvsiz)
100 my_real
101 . a(3,*), fcont(3,*),fncont(3,*), ftcont(3,*), stifn(*),
102 . fskyi(lskyi,nfskyi), secfcum(7,numnod,nsect),
103 . fxn(mvsiz), fyn(mvsiz), fzn(mvsiz),
104 . fxt(mvsiz), fyt(mvsiz), fzt(mvsiz),
105 . stif(mvsiz), lb(mvsiz), lc(mvsiz),
106 . ftxsav(*), ftysav(*), ftzsav(*),
107 . phi(*), fthe(*), ftheskyi(*),
108 . mxi(mvsiz), myi(mvsiz), mzi(mvsiz), stri(mvsiz),condn(*),
109 . condint(mvsiz),condnskyi(lskyi),
110 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),pratio(mvsiz),
111 . pskids(ninterskid,*)
112 TYPE(INTSTAMP_DATA) INTSTAMP
113 TYPE(H3D_DATABASE) :: H3D_DATA
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117 INTEGER I, IG, J, JG , K0, NBINTER, K1S, K, NISKYL, IROT, I1,
118 . NISKYL1,NISKYL2, NISKYFIL, ND , N,PP ,PPL,INTF
119 my_real
120 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz),
121 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
122 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
123 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
124 . h1(mvsiz) , h2(mvsiz) , h3(mvsiz) , h4(mvsiz)
125 my_real gapp, h0 ,dgapload, efricsm
126 double precision
127 . fx6(6,mvsiz), fy6(6,mvsiz), fz6(6,mvsiz), st6(6,mvsiz),
128 . fx, fy, fz, stf,
129 . mx6(6,mvsiz), my6(6,mvsiz), mz6(6,mvsiz), str6(6,mvsiz),
130 . xx, yy, zz, mx, my, mz, str
131C---------------------------------
132 niskyfil = 0
133 DO i=1,jlt
134 fxi(i)=fxn(i)+fxt(i)
135 fyi(i)=fyn(i)+fyt(i)
136 fzi(i)=fzn(i)+fzt(i)
137 ENDDO
138C---------------------------------
139 DO i=1,jlt
140 ftxsav(cand_n(i))=fxt(i)
141 ftysav(cand_n(i))=fyt(i)
142 ftzsav(cand_n(i))=fzt(i)
143 ENDDO
144C------------For /LOAD/PRESSURE tag nodes in contact-------------
145 IF(iflagloadp > 0) THEN
146 DO k = kloadpinter(nin)+1, kloadpinter(nin+1)
147 pp = loadpinter(k)
148 ppl = loadp_hyd_inter(pp)
149 dgapload = dgaploadint(k)
150 DO i=1,jlt
151 jg = nsvg(i)
152 IF(weight(jg)/=1)cycle
153 gapp= gapv(i) + dgapload
154 IF(dist(i) <= gapp) THEN
155 tagncont(ppl,jg) = 1
156 ENDIF
157 ENDDO
158 ENDDO
159 ENDIF
160
161
162C---------------------------------
163 IF(iparit==0)THEN
164 DO i=1,jlt
165 ig=nsvg(i)
166 a(1,ig)=a(1,ig)-fxi(i)*weight(ig)
167 a(2,ig)=a(2,ig)-fyi(i)*weight(ig)
168 a(3,ig)=a(3,ig)-fzi(i)*weight(ig)
169 stifn(ig) = stifn(ig) + stif(i)*weight(ig)
170 END DO
171 IF(intth/=0)THEN
172 IF(nodadt_therm == 1 ) THEN
173 DO i=1,jlt
174 ig=nsvg(i)
175 fthe(ig)=fthe(ig)+phi(i)*weight(ig)
176 condn(ig)=condn(ig)+condint(i)*weight(ig)
177 END DO
178 ELSE
179 DO i=1,jlt
180 ig=nsvg(i)
181 fthe(ig)=fthe(ig)+phi(i)*weight(ig)
182 END DO
183 ENDIF
184C
185 IF(iform==1) THEN
186 DO i=1,jlt
187 i1 = ix1(i)
188 nd = msrl(i1)
189 ig=nsvg(i)
190 IF(nd>0) THEN
191 fthe(nd)=fthe(nd) + phi1(i)*weight(ig)
192 ELSE
193 nd = -nd
194 fthefi(nin)%P(nd)=fthefi(nin)%P(nd) + phi1(i)*weight(ig)
195 ENDIF
196c
197 i1 = ix2(i)
198 nd = msrl(i1)
199 IF(nd>0) THEN
200 fthe(nd)=fthe(nd) + phi2(i)*weight(ig)
201 ELSE
202 nd = -nd
203 fthefi(nin)%P(nd)=fthefi(nin)%P(nd) + phi2(i)*weight(ig)
204 ENDIF
205c
206 i1 = ix3(i)
207 nd = msrl(i1)
208 IF(nd>0) THEN
209 fthe(nd)=fthe(nd) + phi3(i)*weight(ig)
210 ELSE
211 nd = -nd
212 fthefi(nin)%P(nd)=fthefi(nin)%P(nd) + phi3(i)*weight(ig)
213 ENDIF
214c
215 i1 = ix4(i)
216 nd = msrl(i1)
217 IF(nd>0) THEN
218 fthe(nd)=fthe(nd) + phi4(i)*weight(ig)
219 ELSE
220 nd = -nd
221 fthefi(nin)%P(nd)=fthefi(nin)%P(nd) + phi4(i)*weight(ig)
222 ENDIF
223c
224 ENDDO
225 ENDIF
226
227 END IF
228
229C
230 fx =zero
231 fy =zero
232 fz =zero
233 stf=zero
234 DO i=1,jlt
235 ig=nsvg(i)
236 fx=fx+fxi(i) *weight(ig)
237 fy=fy+fyi(i) *weight(ig)
238 fz=fz+fzi(i) *weight(ig)
239 stf=stf+stif(i)*weight(ig)
240 END DO
241#include "lockon.inc"
242 intstamp%FC(1)=intstamp%FC(1)+fx
243 intstamp%FC(2)=intstamp%FC(2)+fy
244 intstamp%FC(3)=intstamp%FC(3)+fz
245 intstamp%STF =intstamp%STF +stf
246#include "lockoff.inc"
247 irot=intstamp%IROT
248 IF(irot/=0)THEN
249 mx =zero
250 my =zero
251 mz =zero
252 str=zero
253 DO i=1,jlt
254 ig=nsvg(i)
255 mx=mx+mxi(i) *weight(ig)
256 my=my+myi(i) *weight(ig)
257 mz=mz+mzi(i) *weight(ig)
258 str=str+stri(i)*weight(ig)
259 END DO
260#include "lockon.inc"
261 intstamp%MC(1)=intstamp%MC(1)+mx
262 intstamp%MC(2)=intstamp%MC(2)+my
263 intstamp%MC(3)=intstamp%MC(3)+mz
264 intstamp%STR =intstamp%STR +str
265#include "lockoff.inc"
266 END IF
267 ELSE
268C
269C Precalcul impact locaux / remote
270C
271 niskyl1 = 0
272 niskyl2 = 0
273 IF(iform /= 0) THEN
274 DO i = 1, jlt
275 IF (h1(i)/=zero) THEN
276 i1 = ix1(i)
277 nd = msrl(i1)
278 IF(nd>0) THEN
279 niskyl1 = niskyl1 + 1
280 ELSE
281 niskyl2 = niskyl2 + 1
282 ENDIF
283 ENDIF
284 IF (h2(i)/=zero) THEN
285 i1 = ix2(i)
286 nd = msrl(i1)
287 IF(nd>0) THEN
288 niskyl1 = niskyl1 + 1
289 ELSE
290 niskyl2 = niskyl2 + 1
291 ENDIF
292 ENDIF
293 IF (h3(i)/=zero) THEN
294 i1 = ix3(i)
295 nd = msrl(i1)
296 IF(nd>0) THEN
297 niskyl1 = niskyl1 + 1
298 ELSE
299 niskyl2 = niskyl2 + 1
300 ENDIF
301 ENDIF
302 IF (h4(i)/=zero) THEN
303 i1 = ix4(i)
304 nd = msrl(i1)
305 IF(nd>0) THEN
306 niskyl1 = niskyl1 + 1
307 ELSE
308 niskyl2 = niskyl2 + 1
309 ENDIF
310 ENDIF
311 ENDDO
312 ENDIF
313C
314
315#include "lockon.inc"
316 niskyl = nisky
317 nisky = nisky + jlt + niskyl1
318 IF(iform /= 0) THEN
319 niskyfil = niskyfi
320 niskyfi = niskyfi + niskyl2
321 ENDIF
322#include "lockoff.inc"
323 IF(intth==0)THEN
324 DO i=1,jlt
325 niskyl = niskyl + 1
326 ig=nsvg(i)
327 fskyi(niskyl,1)=-fxi(i)*weight(ig)
328 fskyi(niskyl,2)=-fyi(i)*weight(ig)
329 fskyi(niskyl,3)=-fzi(i)*weight(ig)
330 fskyi(niskyl,4)=stif(i)*weight(ig)
331 isky(niskyl) = ig
332 END DO
333 ELSE
334 IF(nodadt_therm == 1 ) THEN
335 DO i=1,jlt
336 niskyl = niskyl + 1
337 ig=nsvg(i)
338 fskyi(niskyl,1)=-fxi(i)*weight(ig)
339 fskyi(niskyl,2)=-fyi(i)*weight(ig)
340 fskyi(niskyl,3)=-fzi(i)*weight(ig)
341 fskyi(niskyl,4)=stif(i)*weight(ig)
342 ftheskyi(niskyl)=phi(i)*weight(ig)
343 condnskyi(niskyl)=condint(i)*weight(ig)
344 isky(niskyl) = ig
345 END DO
346 ELSE
347 DO i=1,jlt
348 niskyl = niskyl + 1
349 ig=nsvg(i)
350 fskyi(niskyl,1)=-fxi(i)*weight(ig)
351 fskyi(niskyl,2)=-fyi(i)*weight(ig)
352 fskyi(niskyl,3)=-fzi(i)*weight(ig)
353 fskyi(niskyl,4)=stif(i)*weight(ig)
354 ftheskyi(niskyl)=phi(i)*weight(ig)
355 isky(niskyl) = ig
356 END DO
357 ENDIF
358 IF(iform==1) THEN
359 IF(nodadt_therm == 1 ) THEN
360C
361 DO i=1,jlt
362 ig=nsvg(i)
363 IF (h1(i)/=zero) THEN
364 i1 = ix1(i)
365 nd = msrl(i1)
366 IF(nd>0) THEN
367 niskyl = niskyl + 1
368 fskyi(niskyl,1)=zero
369 fskyi(niskyl,2)=zero
370 fskyi(niskyl,3)=zero
371 fskyi(niskyl,4)=zero
372 condnskyi(niskyl)=zero
373 ftheskyi(niskyl)=phi1(i)*weight(ig)
374 isky(niskyl) = nd
375 ELSE
376 nd = -nd
377 niskyfil = niskyfil + 1
378 ftheskyfi(nin)%P(niskyfil)=phi1(i)*weight(ig)
379 iskyfi(nin)%P(niskyfil) = nd
380 ENDIF
381 ENDIF
382c
383 IF (h2(i)/=zero) THEN
384 i1 = ix2(i)
385 nd = msrl(i1)
386 IF(nd>0) THEN
387 niskyl = niskyl + 1
388 fskyi(niskyl,1)=zero
389 fskyi(niskyl,2)=zero
390 fskyi(niskyl,3)=zero
391 fskyi(niskyl,4)=zero
392 condnskyi(niskyl)=zero
393 ftheskyi(niskyl)=phi2(i)*weight(ig)
394 isky(niskyl) = nd
395 ELSE
396 nd = -nd
397 niskyfil = niskyfil + 1
398 ftheskyfi(nin)%P(niskyfil)=phi2(i)*weight(ig)
399 iskyfi(nin)%P(niskyfil) = nd
400 ENDIF
401 ENDIF
402c
403 IF (h3(i)/=zero) THEN
404 i1 = ix3(i)
405 nd = msrl(i1)
406 IF(nd>0) THEN
407 niskyl = niskyl + 1
408 fskyi(niskyl,1)=zero
409 fskyi(niskyl,2)=zero
410 fskyi(niskyl,3)=zero
411 fskyi(niskyl,4)=zero
412 condnskyi(niskyl)=zero
413 ftheskyi(niskyl)=phi3(i)*weight(ig)
414 isky(niskyl) = nd
415 ELSE
416 nd = -nd
417 niskyfil = niskyfil + 1
418 ftheskyfi(nin)%P(niskyfil)=phi3(i)*weight(ig)
419 iskyfi(nin)%P(niskyfil) = nd
420 ENDIF
421 ENDIF
422c
423 IF (h4(i)/=zero) THEN
424 i1 = ix4(i)
425 nd = msrl(i1)
426 IF(nd>0) THEN
427 niskyl = niskyl + 1
428 fskyi(niskyl,1)=zero
429 fskyi(niskyl,2)=zero
430 fskyi(niskyl,3)=zero
431 fskyi(niskyl,4)=zero
432 condnskyi(niskyl)=zero
433 ftheskyi(niskyl)=phi4(i)*weight(ig)
434 isky(niskyl) = nd
435 ELSE
436 nd = -nd
437 niskyfil = niskyfil + 1
438 ftheskyfi(nin)%P(niskyfil)=phi4(i)*weight(ig)
439 iskyfi(nin)%P(niskyfil) = nd
440 ENDIF
441 ENDIF
442 ENDDO
443C
444 ELSE ! NODADT_THERM
445C
446 DO i=1,jlt
447 ig=nsvg(i)
448 IF (h1(i)/=zero) THEN
449 i1 = ix1(i)
450 nd = msrl(i1)
451 IF(nd>0) THEN
452 niskyl = niskyl + 1
453 fskyi(niskyl,1)=zero
454 fskyi(niskyl,2)=zero
455 fskyi(niskyl,3)=zero
456 fskyi(niskyl,4)=zero
457 ftheskyi(niskyl)=phi1(i)*weight(ig)
458 isky(niskyl) = nd
459 ELSE
460 nd = -nd
461 niskyfil = niskyfil + 1
462 ftheskyfi(nin)%P(niskyfil)=phi1(i)*weight(ig)
463 iskyfi(nin)%P(niskyfil) = nd
464 ENDIF
465 ENDIF
466c
467 IF (h2(i)/=zero) THEN
468 i1 = ix2(i)
469 nd = msrl(i1)
470 IF(nd>0) THEN
471 niskyl = niskyl + 1
472 fskyi(niskyl,1)=zero
473 fskyi(niskyl,2)=zero
474 fskyi(niskyl,3)=zero
475 fskyi(niskyl,4)=zero
476 ftheskyi(niskyl)=phi2(i)*weight(ig)
477 isky(niskyl) = nd
478 ELSE
479 nd = -nd
480 niskyfil = niskyfil + 1
481 ftheskyfi(nin)%P(niskyfil)=phi2(i)*weight(ig)
482 iskyfi(nin)%P(niskyfil) = nd
483 ENDIF
484 ENDIF
485c
486 IF (h3(i)/=zero) THEN
487 i1 = ix3(i)
488 nd = msrl(i1)
489 IF(nd>0) THEN
490 niskyl = niskyl + 1
491 fskyi(niskyl,1)=zero
492 fskyi(niskyl,2)=zero
493 fskyi(niskyl,3)=zero
494 fskyi(niskyl,4)=zero
495 ftheskyi(niskyl)=phi3(i)*weight(ig)
496 isky(niskyl) = nd
497 ELSE
498 nd = -nd
499 niskyfil = niskyfil + 1
500 ftheskyfi(nin)%P(niskyfil)=phi3(i)*weight(ig)
501 iskyfi(nin)%P(niskyfil) = nd
502 ENDIF
503 ENDIF
504c
505 IF (h4(i)/=zero) THEN
506 i1 = ix4(i)
507 nd = msrl(i1)
508 IF(nd>0) THEN
509 niskyl = niskyl + 1
510 fskyi(niskyl,1)=zero
511 fskyi(niskyl,2)=zero
512 fskyi(niskyl,3)=zero
513 fskyi(niskyl,4)=zero
514 ftheskyi(niskyl)=phi4(i)*weight(ig)
515 isky(niskyl) = nd
516 ELSE
517 nd = -nd
518 niskyfil = niskyfil + 1
519 ftheskyfi(nin)%P(niskyfil)=phi4(i)*weight(ig)
520 iskyfi(nin)%P(niskyfil) = nd
521 ENDIF
522 ENDIF
523C
524 ENDDO
525 ENDIF
526
527 ENDIF
528 END IF
529
530 CALL foat_to_6_float(1,jlt,fxi,fx6)
531 CALL foat_to_6_float(1,jlt,fyi,fy6)
532 CALL foat_to_6_float(1,jlt,fzi,fz6)
533 CALL foat_to_6_float(1,jlt,stif,st6)
534 DO k=1,6
535 fx =zero
536 fy =zero
537 fz =zero
538 stf=zero
539 DO i=1,jlt
540 ig=nsvg(i)
541 fx =fx +fx6(k,i)*weight(ig)
542 fy =fy +fy6(k,i)*weight(ig)
543 fz =fz +fz6(k,i)*weight(ig)
544 stf=stf+st6(k,i)*weight(ig)
545 ENDDO
546#include "lockon.inc"
547 intstamp%FC6(k,1)=intstamp%FC6(k,1)+fx
548 intstamp%FC6(k,2)=intstamp%FC6(k,2)+fy
549 intstamp%FC6(k,3)=intstamp%FC6(k,3)+fz
550 intstamp%ST6(k) =intstamp%ST6(k) +stf
551#include "lockoff.inc"
552 ENDDO
553 irot=intstamp%IROT
554 IF(irot/=0)THEN
555 CALL foat_to_6_float(1,jlt,mxi,mx6)
556 CALL foat_to_6_float(1,jlt,myi,my6)
557 CALL foat_to_6_float(1,jlt,mzi,mz6)
558 CALL foat_to_6_float(1,jlt,stri,str6)
559 DO k=1,6
560 mx =zero
561 my =zero
562 mz =zero
563 str=zero
564 DO i=1,jlt
565 ig=nsvg(i)
566 mx =mx +mx6(k,i)*weight(ig)
567 my =my +my6(k,i)*weight(ig)
568 mz =mz +mz6(k,i)*weight(ig)
569 str=str+str6(k,i)*weight(ig)
570 ENDDO
571#include "lockon.inc"
572 intstamp%MC6(k,1)=intstamp%MC6(k,1)+mx
573 intstamp%MC6(k,2)=intstamp%MC6(k,2)+my
574 intstamp%MC6(k,3)=intstamp%MC6(k,3)+mz
575 intstamp%STR6(k) =intstamp%STR6(k) +str
576#include "lockoff.inc"
577 END DO
578 END IF
579 ENDIF
580
581C---------------------------------
582 IF(.NOT.( (anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0 .AND.
583 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
584 . (manim>=4.AND.manim<=15) .OR. h3d_data%MH3D /= 0))
585 . .OR.(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
586 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
587 . (manim>=4.AND.manim<=15) .OR. h3d_data%MH3D /= 0))
588 . .OR.h3d_data%N_VECT_PCONT_MAX>0.OR.ninskid > 0.OR.interefric>0
589 . .OR.h3d_data%N_SCAL_CSE_FRIC >0.OR.isecin/=0) ) RETURN
590C---------------------------------
591 DO i=1,jlt
592 IF(ix3(i)/=ix4(i))THEN
593 h0 =fourth*(one - lb(i) - lc(i))
594 IF(abs(itria(i))==1)THEN
595 h1(i)= lb(i)+h0
596 h2(i)= lc(i)+h0
597 h3(i)= h0
598 h4(i)= h0
599 ELSEIF(abs(itria(i))==2)THEN
600 h1(i)= h0
601 h2(i)= lb(i)+h0
602 h3(i)= lc(i)+h0
603 h4(i)= h0
604 ELSEIF(abs(itria(i))==3)THEN
605 h1(i)= h0
606 h2(i)= h0
607 h3(i)= lb(i)+h0
608 h4(i)= lc(i)+h0
609 ELSEIF(abs(itria(i))==4)THEN
610 h1(i)= lc(i)+h0
611 h2(i)= h0
612 h3(i)= h0
613 h4(i)= lb(i)+h0
614 END IF
615 ELSE
616 h1(i) = lb(i)
617 h2(i) = lc(i)
618 h3(i) = one - lb(i) - lc(i)
619 h4(i) = zero
620 END IF
621 END DO
622C---------------------------------
623 DO i=1,jlt
624 ix1(i)=msr(ix1(i))
625 ix2(i)=msr(ix2(i))
626 ix3(i)=msr(ix3(i))
627 ix4(i)=msr(ix4(i))
628 END DO
629C-------------Tag of nodes really impacting contact forces updating ----------------
630 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0.OR.
631 . anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0)THEN
632#include "lockon.inc"
633 DO i=1,jlt
634 jg = nsvg(i)
635 IF(weight(jg)/=1)cycle
636 ig = nodglob(jg)
637C
638 IF(tagcont(ig)==0) THEN
639 ncont= ncont+1
640 indexcont(ncont) = ig
641 tagcont(ig)= 1
642 ENDIF
643 IF(tagcont(ix1(i))==0) THEN
644 ncont= ncont+1
645 indexcont(ncont) = ix1(i)
646 tagcont(ix1(i))= 1
647 ENDIF
648 IF(tagcont(ix2(i))==0) THEN
649 ncont= ncont+1
650 indexcont(ncont) = ix2(i)
651 tagcont(ix2(i))= 1
652 ENDIF
653 IF(tagcont(ix3(i))==0) THEN
654 ncont= ncont+1
655 indexcont(ncont) = ix3(i)
656 tagcont(ix3(i))= 1
657 ENDIF
658 IF(tagcont(ix4(i))==0) THEN
659 ncont= ncont+1
660 indexcont(ncont) = ix4(i)
661 tagcont(ix4(i))= 1
662 ENDIF
663 ENDDO
664#include "lockoff.inc"
665 ENDIF
666
667C---------------------------------
668 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
669 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
670 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
671 . .OR.h3d_data%N_VECT_PCONT_MAX>0)THEN
672#include "lockon.inc"
673 DO i=1,jlt
674 jg = nsvg(i)
675 IF(weight(jg)/=1)cycle
676 fncont(1,nodglob(jg))=fncont(1,nodglob(jg))- fxn(i)
677 fncont(2,nodglob(jg))=fncont(2,nodglob(jg))- fyn(i)
678 fncont(3,nodglob(jg))=fncont(3,nodglob(jg))- fzn(i)
679C
680 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fxn(i)*h1(i)
681 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fyn(i)*h1(i)
682 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fzn(i)*h1(i)
683 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fxn(i)*h2(i)
684 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fyn(i)*h2(i)
685 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fzn(i)*h2(i)
686 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fxn(i)*h3(i)
687 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fyn(i)*h3(i)
688 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fzn(i)*h3(i)
689 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fxn(i)*h4(i)
690 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fyn(i)*h4(i)
691 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fzn(i)*h4(i)
692 ENDDO
693#include "lockoff.inc"
694 ENDIF
695C---------------------------------
696 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
697 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
698 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))
699 . .OR.h3d_data%N_VECT_PCONT_MAX>0)THEN
700#include "lockon.inc"
701 DO i=1,jlt
702 jg = nsvg(i)
703 IF(weight(jg)/=1)cycle
704 ftcont(1,nodglob(jg))=ftcont(1,nodglob(jg))- fxt(i)
705 ftcont(2,nodglob(jg))=ftcont(2,nodglob(jg))- fyt(i)
706 ftcont(3,nodglob(jg))=ftcont(3,nodglob(jg))- fzt(i)
707C
708 ftcont(1,ix1(i)) =ftcont(1,ix1(i)) + fxt(i)*h1(i)
709 ftcont(2,ix1(i)) =ftcont(2,ix1(i)) + fyt(i)*h1(i)
710 ftcont(3,ix1(i)) =ftcont(3,ix1(i)) + fzt(i)*h1(i)
711 ftcont(1,ix2(i)) =ftcont(1,ix2(i)) + fxt(i)*h2(i)
712 ftcont(2,ix2(i)) =ftcont(2,ix2(i)) + fyt(i)*h2(i)
713 ftcont(3,ix2(i)) =ftcont(3,ix2(i)) + fzt(i)*h2(i)
714 ftcont(1,ix3(i)) =ftcont(1,ix3(i)) + fxt(i)*h3(i)
715 ftcont(2,ix3(i)) =ftcont(2,ix3(i)) + fyt(i)*h3(i)
716 ftcont(3,ix3(i)) =ftcont(3,ix3(i)) + fzt(i)*h3(i)
717 ftcont(1,ix4(i)) =ftcont(1,ix4(i)) + fxt(i)*h4(i)
718 ftcont(2,ix4(i)) =ftcont(2,ix4(i)) + fyt(i)*h4(i)
719 ftcont(3,ix4(i)) =ftcont(3,ix4(i)) + fzt(i)*h4(i)
720 ENDDO
721#include "lockoff.inc"
722 ENDIF
723
724C-----------------------------------------------
725 DO i=1,jlt
726C
727 fx1(i)=fxi(i)*h1(i)
728 fy1(i)=fyi(i)*h1(i)
729 fz1(i)=fzi(i)*h1(i)
730C
731 fx2(i)=fxi(i)*h2(i)
732 fy2(i)=fyi(i)*h2(i)
733 fz2(i)=fzi(i)*h2(i)
734C
735 fx3(i)=fxi(i)*h3(i)
736 fy3(i)=fyi(i)*h3(i)
737 fz3(i)=fzi(i)*h3(i)
738C
739 fx4(i)=fxi(i)*h4(i)
740 fy4(i)=fyi(i)*h4(i)
741 fz4(i)=fzi(i)*h4(i)
742C
743 ENDDO
744C-----------------------------------------------
745 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
746 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
747 . (manim>=4.AND.manim<=15) .OR. h3d_data%MH3D /= 0 ))THEN
748#include "lockon.inc"
749 DO i=1,jlt
750 jg = nsvg(i)
751 IF(weight(jg)/=1)cycle
752 fcont(1,nodglob(jg))=fcont(1,nodglob(jg))- fxi(i)
753 fcont(2,nodglob(jg))=fcont(2,nodglob(jg))- fyi(i)
754 fcont(3,nodglob(jg))=fcont(3,nodglob(jg))- fzi(i)
755C
756 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
757 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
758 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
759 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
760 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
761 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
762 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
763 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
764 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
765 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
766 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
767 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
768 ENDDO
769#include "lockoff.inc"
770 ENDIF
771
772C-----------------------------------------------
773C code NSPMD > 1 a traiter de maniere specifique (IXi non present localement)
774 IF(nspmd == 1)THEN
775 IF(isecin>0)THEN
776 k0=nstrf(25)
777 IF(nstrf(1)+nstrf(2)/=0)THEN
778 DO i=1,nsect
779 nbinter=nstrf(k0+14)
780 k1s=k0+30
781 DO j=1,nbinter
782 IF(nstrf(k1s)==noint)THEN
783 IF(isecut/=0)THEN
784#include "lockon.inc"
785 DO k=1,jlt
786C attention aux signes pour le cumul des efforts
787C a rendre conforme avec CFORC3
788 IF(secfcum(4,ix1(k),i)==1.)THEN
789 secfcum(1,ix1(k),i)=secfcum(1,ix1(k),i)-fx1(k)
790 secfcum(2,ix1(k),i)=secfcum(2,ix1(k),i)-fy1(k)
791 secfcum(3,ix1(k),i)=secfcum(3,ix1(k),i)-fz1(k)
792 ENDIF
793 IF(secfcum(4,ix2(k),i)==1.)THEN
794 secfcum(1,ix2(k),i)=secfcum(1,ix2(k),i)-fx2(k)
795 secfcum(2,ix2(k),i)=secfcum(2,ix2(k),i)-fy2(k)
796 secfcum(3,ix2(k),i)=secfcum(3,ix2(k),i)-fz2(k)
797 ENDIF
798 IF(secfcum(4,ix3(k),i)==1.)THEN
799 secfcum(1,ix3(k),i)=secfcum(1,ix3(k),i)-fx3(k)
800 secfcum(2,ix3(k),i)=secfcum(2,ix3(k),i)-fy3(k)
801 secfcum(3,ix3(k),i)=secfcum(3,ix3(k),i)-fz3(k)
802 ENDIF
803 IF(secfcum(4,ix4(k),i)==1.)THEN
804 secfcum(1,ix4(k),i)=secfcum(1,ix4(k),i)-fx4(k)
805 secfcum(2,ix4(k),i)=secfcum(2,ix4(k),i)-fy4(k)
806 secfcum(3,ix4(k),i)=secfcum(3,ix4(k),i)-fz4(k)
807 ENDIF
808 jg = nsvg(k)
809 IF(secfcum(4,jg,i)==1.)THEN
810 secfcum(1,jg,i)=secfcum(1,jg,i)+fxi(k)
811 secfcum(2,jg,i)=secfcum(2,jg,i)+fyi(k)
812 secfcum(3,jg,i)=secfcum(3,jg,i)+fzi(k)
813 ENDIF
814 ENDDO
815#include "lockoff.inc"
816 ENDIF
817C +fsav(section)
818 ENDIF
819 k1s=k1s+1
820 ENDDO
821 k0=nstrf(k0+24)
822 ENDDO
823 ENDIF
824 ENDIF
825 ELSE
826C NSPMD > 1
827 ENDIF
828C
829 IF(ninskid > 0)THEN
830C-------------SKID LINES OUTPUTTING ----------------
831#include "lockon.inc"
832 DO i=1,jlt
833 jg = nsvg(i)
834 IF(weight(jg)/=1)cycle
835 n = nodglob(jg)
836 pskids(ninskid,n)=max(pskids(ninskid,n),pratio(i))
837
838 n= ix1(i)
839 pskids(ninskid,n)=max(pskids(ninskid,n),pratio(i))
840 n= ix2(i)
841 pskids(ninskid,n)=max(pskids(ninskid,n),pratio(i))
842 n= ix3(i)
843 pskids(ninskid,n)=max(pskids(ninskid,n),pratio(i))
844 n= ix4(i)
845 pskids(ninskid,n)=max(pskids(ninskid,n),pratio(i))
846
847 ENDDO
848#include "lockoff.inc"
849 ENDIF
850C
851C-------------FRICTION ENERGY OUTPUTTING ----------------
852 IF(interefric > 0)THEN
853 intf= interefric - ninefric
854#include "lockon.inc"
855 DO i=1,jlt
856 jg = nsvg(i)
857 IF(weight(jg)/=1)cycle
858 n = nodglob(jg)
859 efricsm = half*efric_l(i)
860 efric_stamp(intf,n)=efric_stamp(intf,n) + (efricsm-fheat*efrict(i))
861
862 n= ix1(i)
863 efric_stamp(intf,n)=efric_stamp(intf,n) + efricsm*h1(i)
864 n= ix2(i)
865 efric_stamp(intf,n)=efric_stamp(intf,n) + efricsm*h2(i)
866 n= ix3(i)
867 efric_stamp(intf,n)=efric_stamp(intf,n) + efricsm*h3(i)
868 n= ix4(i)
869 efric_stamp(intf,n)=efric_stamp(intf,n) + efricsm*h4(i)
870
871 ENDDO
872#include "lockoff.inc"
873 ENDIF
874C---------------------------------
875 IF(h3d_data%N_SCAL_CSE_FRIC >0)THEN
876#include "lockon.inc"
877 DO i=1,jlt
878 jg = nsvg(i)
879 IF(weight(jg)/=1)cycle
880 n = nodglob(jg)
881 efricsm = half*efric_l(i)
882 efricg_stamp(n)=efricg_stamp(n) + (efricsm-fheat*efrict(i))
883
884 n= ix1(i)
885 efricg_stamp(n)=efricg_stamp(n) + efricsm*h1(i)
886 n= ix2(i)
887 efricg_stamp(n)=efricg_stamp(n) + efricsm*h2(i)
888 n= ix3(i)
889 efricg_stamp(n)=efricg_stamp(n) + efricsm*h3(i)
890 n= ix4(i)
891 efricg_stamp(n)=efricg_stamp(n) + efricsm*h4(i)
892
893 ENDDO
894#include "lockoff.inc"
895 ENDIF
896C---------------------------------
897 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308
intstamp_mod
Definition intstamp_mod.F:38
outputs_mod
Definition outputs_mod.F:59
outputs_mod::ninefric
integer ninefric
Definition outputs_mod.F:65
tri7box::ftheskyfi
type(real_pointer), dimension(:), allocatable ftheskyfi
Definition tri7box.F:449
tri7box::iskyfi
type(int_pointer), dimension(:), allocatable iskyfi
Definition tri7box.F:480
tri7box::fthefi
type(real_pointer), dimension(:), allocatable fthefi
Definition tri7box.F:449
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:225
stri
character *8 function stri(n)
Definition stri.F:24