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 (output, 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 ( type(output_), intent(inout) output,
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 35 of file i21ass3.F.

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