OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
int2rupt.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com08_c.inc"
#include "scr14_c.inc"
#include "comlock.inc"
#include "userlib.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine int2rupt (ipari, ms, in, x, v, a, stifn, igeo, weight, fsav, ilev, npf, tf, itab, fncont, pdama2, intbuf_tab, h3d_data, fncontp, ftcontp)
subroutine i2rupt (x, v, a, ms, in, stifn, fsav, weight, irect, nsv, msr, irtl, irupt, crst, mmass, miner, smass, siner, area, uvar, xsm0, dsm, fsm, prop, ipari, nsn, nmn, nuvar, igtyp, pid, npf, tf, itab, fncont, pdama2, isym, inorm, h3d_data, fncontp, ftcontp)

Function/Subroutine Documentation

◆ i2rupt()

subroutine i2rupt ( x,
v,
a,
ms,
in,
stifn,
fsav,
integer, dimension(*) weight,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) msr,
integer, dimension(*) irtl,
integer, dimension(*) irupt,
crst,
mmass,
miner,
smass,
siner,
area,
dimension(nuvar,nsn) uvar,
xsm0,
dsm,
fsm,
prop,
integer, dimension(*) ipari,
integer nsn,
integer nmn,
integer nuvar,
integer igtyp,
integer pid,
integer, dimension(*) npf,
tf,
integer, dimension(*) itab,
fncont,
integer, dimension(*) pdama2,
integer isym,
integer, dimension(*) inorm,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 114 of file int2rupt.F.

122C-----------------------------------------------
123C M o d u l e s
124C-----------------------------------------------
125 USE uintbuf_mod
126 USE h3d_mod
127 USE message_mod
128C-----------------------------------------------
129C I m p l i c i t T y p e s
130C-----------------------------------------------
131#include "implicit_f.inc"
132C-----------------------------------------------
133C D u m m y A r g u m e n t s
134C-----------------------------------------------
135 INTEGER NSN, NMN,NUVAR,PID,IGTYP,ISYM
136 INTEGER IRECT(4,*),MSR(*),NSV(*),IRTL(*),IRUPT(*),IPARI(*),
137 . WEIGHT(*),NPF(*),ITAB(*),PDAMA2(*),INORM(*)
138C REAL
139 my_real
140 . x(3,*),v(3,*),a(3,*),xsm0(3,*),dsm(3,*),fsm(3,*),prop(*),
141 . area(*),stifn(*),siner(*),smass(*),fncont(3,*),
142 . ms(*),in(*),mmass(*),miner(*),crst(2,*),fsav(*),tf(*),
143 . fncontp(3,*) ,ftcontp(3,* )
144 my_real, DIMENSION(NUVAR,NSN) ::
145 . uvar
146 TYPE (H3D_DATABASE) :: H3D_DATA
147C-----------------------------------------------
148C C o m m o n B l o c k s
149C-----------------------------------------------
150#include "com01_c.inc"
151#include "com08_c.inc"
152#include "scr14_c.inc"
153#include "comlock.inc"
154#include "userlib.inc"
155C-----------------------------------------------
156C L o c a l V a r i a b l e s
157C-----------------------------------------------
158 INTEGER NIR,I,J,II,JJ,L,N1,N2,N3,N4,RFLAG,W,IONE,
159 . IMOD,IFILTR,IFUNS,IFUNN,IFUNT,NOINT,IDBG
160C REAL
161 my_real
162 . s,t,sp,sm,tp,tm,aa,ins,mxi,myi,mzi,xsm,ysm,zsm,xc,yc,zc,
163 . x0,x1,x2,x3,x4,y0,y1,y2,y3,y4,z0,z1,z2,z3,z4,sum,dx,dy,dz,
164 . fx,fy,fz,fxi,fyi,fzi,sx,sy,sz,tx,ty,tz,dt12m,dtime,
165 . dxnorm,dxtang,dxtan2,fnorm,ftang,ftan2,mcdg,
166 . vx,vy,vz,vnx,vny,vnz,vtx,vty,vtz,vux,vuy,vuz,facn,fact,
167 . fsav1,fsav2,fsav3,fsav4,fsav5,fsav6,fsav7,fsav8,fsav9,fsav10,
168 . fsav11,fsav12,fsav13,fsav14,fsav15,impx,impy,impz
169 my_real
170 . h(4),dxn(3),dxt(3),dxu(3),fn(3),ft(3),fu(3),fnarea,ftarea,adxtang
171C----
172 type(UINTBUF) :: USERBUF
173!
174 CHARACTER OPTION*256
175 INTEGER SIZE
176C=======================================================================
177 nir =4
178 ione=1
179C
180 IF (tt == zero) THEN
181 DO ii=1,nsn
182 i=nsv(ii)
183 l=irtl(ii)
184 irupt(ii) = 0
185 inorm(ii) = 0
186C initial distance main-secnd
187 s = crst(1,ii)
188 t = crst(2,ii)
189 sp=one + s
190 sm=one - s
191 tp=fourth*(one + t)
192 tm=fourth*(one - t)
193 h(1)=tm*sm
194 h(2)=tm*sp
195 h(3)=tp*sp
196 h(4)=tp*sm
197 n1 = irect(1,l)
198 n2 = irect(2,l)
199 n3 = irect(3,l)
200 n4 = irect(4,l)
201 x0 = x(1,i)
202 y0 = x(2,i)
203 z0 = x(3,i)
204 x1 = x(1,n1)
205 y1 = x(2,n1)
206 z1 = x(3,n1)
207 x2 = x(1,n2)
208 y2 = x(2,n2)
209 z2 = x(3,n2)
210 x3 = x(1,n3)
211 y3 = x(2,n3)
212 z3 = x(3,n3)
213 x4 = x(1,n4)
214 y4 = x(2,n4)
215 z4 = x(3,n4)
216 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
217 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
218 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
219 xsm = x0 - xc
220 ysm = y0 - yc
221 zsm = z0 - zc
222C
223 xsm0(1,ii) = xsm
224 xsm0(2,ii) = ysm
225 xsm0(3,ii) = zsm
226 dsm(1,ii) = zero
227 dsm(2,ii) = zero
228 dsm(3,ii) = zero
229 IF (isym == 1) THEN
230 sx = -(x2 + x3 - x1 - x4)
231 sy = -(y2 + y3 - y1 - y4)
232 sz = -(z2 + z3 - z1 - z4)
233 tx = -(x3 + x4 - x1 - x2)
234 ty = -(y3 + y4 - y1 - y2)
235 tz = -(z3 + z4 - z1 - z2)
236 vnx = sy * tz - sz * ty
237 vny = sz * tx - sx * tz
238 vnz = sx * ty - sy * tx
239 sum = one / sqrt(vnx*vnx + vny*vny + vnz*vnz)
240 vnx = vnx * sum
241 vny = vny * sum
242 vnz = vnz * sum
243 sum = vnx*xsm + vny*ysm + vnz*zsm
244 inorm(ii) = sign(ione, nint(sum))
245 ELSE
246 inorm(ii) = ione
247 ENDIF
248 ENDDO
249 dt12m = one/dt2
250 ELSE
251 dt12m = one/dt12
252 ENDIF
253C---------------
254C Reset initial main & secnd masse /inertia
255C---------------
256 DO ii=1,nmn
257 i=msr(ii)
258 ms(i) = mmass(ii)
259 IF (iroddl /= 0) in(i) = miner(ii)
260 ENDDO
261 DO ii=1,nsn
262 i=nsv(ii)
263 ms(i) = smass(ii)
264 IF (iroddl /= 0) in(i)= siner(ii)
265 ENDDO
266C
267C------------------------------------------------
268 DO ii=1,nsn
269 i=nsv(ii)
270 l=irtl(ii)
271 rflag = irupt(ii)
272C
273 IF (i > 0) THEN
274 IF (irupt(ii) == 1) THEN
275c rupture totale
276 fn(1) = zero
277 fn(2) = zero
278 fn(3) = zero
279 ft(1) = zero
280 ft(2) = zero
281 ft(3) = zero
282 fu(1) = zero
283 fu(2) = zero
284 fu(3) = zero
285 fnorm = zero
286 ftang = zero
287 ELSE
288 s = crst(1,ii)
289 t = crst(2,ii)
290 sp=one + s
291 sm=one - s
292 tp=fourth*(one + t)
293 tm=fourth*(one - t)
294 h(1)=tm*sm
295 h(2)=tm*sp
296 h(3)=tp*sp
297 h(4)=tp*sm
298C
299 n1 = irect(1,l)
300 n2 = irect(2,l)
301 n3 = irect(3,l)
302 n4 = irect(4,l)
303C------------------------------------------------
304C relative deplacement main-secnd
305C------------------------------------------------
306 x0 = x(1,i)
307 y0 = x(2,i)
308 z0 = x(3,i)
309 x1 = x(1,n1)
310 y1 = x(2,n1)
311 z1 = x(3,n1)
312 x2 = x(1,n2)
313 y2 = x(2,n2)
314 z2 = x(3,n2)
315 x3 = x(1,n3)
316 y3 = x(2,n3)
317 z3 = x(3,n3)
318 x4 = x(1,n4)
319 y4 = x(2,n4)
320 z4 = x(3,n4)
321 xc = x1 * h(1) + x2 * h(2) + x3 * h(3) + x4 * h(4)
322 yc = y1 * h(1) + y2 * h(2) + y3 * h(3) + y4 * h(4)
323 zc = z1 * h(1) + z2 * h(2) + z3 * h(3) + z4 * h(4)
324 xsm = x0 - xc
325 ysm = y0 - yc
326 zsm = z0 - zc
327C--------- depl relatif total
328 dx = xsm - xsm0(1,ii)
329 dy = ysm - xsm0(2,ii)
330 dz = zsm - xsm0(3,ii)
331 dsm(1,ii) = dx
332 dsm(2,ii) = dy
333 dsm(3,ii) = dz
334C------------------------------------------------
335C direction normale facette main
336C------------------------------------------------
337 sx = -(x2 + x3 - x1 - x4)
338 sy = -(y2 + y3 - y1 - y4)
339 sz = -(z2 + z3 - z1 - z4)
340 tx = -(x3 + x4 - x1 - x2)
341 ty = -(y3 + y4 - y1 - y2)
342 tz = -(z3 + z4 - z1 - z2)
343 vnx = sy * tz - sz * ty
344 vny = sz * tx - sx * tz
345 vnz = sx * ty - sy * tx
346 sum = inorm(ii) / sqrt(vnx*vnx + vny*vny + vnz*vnz)
347 vnx = vnx * sum
348 vny = vny * sum
349 vnz = vnz * sum
350 sum = one / sqrt(sx*sx + sy*sy + sz*sz)
351 vtx = sx * sum
352 vty = sy * sum
353 vtz = sz * sum
354C------------------------------------------------
355C composantes N/T du deplacement
356C------------------------------------------------
357 dxnorm = vnx*dx + vny*dy + vnz*dz
358 dxn(1) = vnx*dxnorm
359 dxn(2) = vny*dxnorm
360 dxn(3) = vnz*dxnorm
361 dxt(1) = dx - dxn(1)
362 dxt(2) = dy - dxn(2)
363 dxt(3) = dz - dxn(3)
364 dxtang = sqrt(dxt(1)**2 + dxt(2)**2 + dxt(3)**2)
365C repere local
366 IF (dxtang > zero) THEN
367 sum = one / dxtang
368 vtx = dxt(1) * sum
369 vty = dxt(2) * sum
370 vtz = dxt(3) * sum
371 ENDIF
372 vux = vny * vtz - vnz * vty
373 vuy = vnz * vtx - vnx * vtz
374 vuz = vnx * vty - vny * vtx
375C------------------------------------------------
376C force main/secnd
377C------------------------------------------------
378 IF (irupt(ii) == 0) THEN
379C pas de rupture - interface cinematique
380 mcdg = one/(ms(i)+ms(n1)+ms(n2)+ms(n3)+ms(n4))
381 vx = v(1,i)*ms(i)+v(1,n1)*ms(n1)
382 . +v(1,n2)*ms(n2)+v(1,n3)*ms(n3)+v(1,n4)*ms(n4)
383 vy = v(2,i)*ms(i)+v(2,n1)*ms(n1)
384 . +v(2,n2)*ms(n2)+v(2,n3)*ms(n3)+v(2,n4)*ms(n4)
385 vz = v(3,i)*ms(i)+v(3,n1)*ms(n1)
386 . +v(3,n2)*ms(n2)+v(3,n3)*ms(n3)+v(3,n4)*ms(n4)
387 vx = vx * mcdg
388 vy = vy * mcdg
389 vz = vz * mcdg
390 fx = a(1,i) + (v(1,i) - vx)*ms(i)*dt12m
391 fy = a(2,i) + (v(2,i) - vy)*ms(i)*dt12m
392 fz = a(3,i) + (v(3,i) - vz)*ms(i)*dt12m
393 ELSEIF (irupt(ii) == -1) THEN
394C rupture partielle = spring main/secnd
395 fx = stifn(i)*dx
396 fy = stifn(i)*dy
397 fz = stifn(i)*dz
398 ENDIF
399C composantes N/T de la forces nodale
400 fnorm = vnx*fx + vny*fy + vnz*fz
401 ftang = vtx*fx + vty*fy + vtz*fz
402 ftan2 = vux*fx + vuy*fy + vuz*fz
403 fn(1) = vnx*fnorm
404 fn(2) = vny*fnorm
405 fn(3) = vnz*fnorm
406 ft(1) = vtx*ftang
407 ft(2) = vty*ftang
408 ft(3) = vtz*ftang
409 fu(1) = vux*ftan2
410 fu(2) = vuy*ftan2
411 fu(3) = vuz*ftan2
412C------------------------------------------------
413C Call user subroutine - test rupture
414C------------------------------------------------
415 dtime = max(dt1,em20)
416 IF(userl_avail==1.AND.igtyp /= -1)THEN
417 adxtang = abs(dxtang)
418 fnarea=fnorm / area(ii)
419 ftarea=max(abs(ftang),abs(ftan2)) / area(ii)
420 CALL eng_userlib_uintbuf_var(i,area(ii),dxnorm,adxtang,fnarea,ftarea,dtime,rflag)
421
422 ELSE
423 userbuf%ISECND = i
424 userbuf%AREA = area(ii)
425 userbuf%DXN = dxnorm
426 userbuf%DXT = abs(dxtang)
427 userbuf%SIGN = fnorm / area(ii)
428 userbuf%SIGT = max(abs(ftang),abs(ftan2)) / area(ii)
429 userbuf%DT = dtime
430 userbuf%RUPT = rflag
431 ENDIF
432C
433 IF (igtyp == -1) THEN
434 noint = ipari(15)
435 imod = ipari(43)
436 ifiltr= ipari(59)
437 ifuns = ipari(48)
438 ifunn = ipari(49)
439 ifunt = ipari(50)
440 idbg = 0
441 CALL ruptint2(
442 . nsn ,ii ,nuvar ,uvar(1,ii),userbuf ,
443 . prop ,ifuns ,ifunn ,ifunt ,imod ,
444 . ifiltr ,idbg ,npf ,tf ,noint ,
445 . itab ,pdama2 ,isym ,h3d_data )
446 ELSEIF (igtyp == 29) THEN
447 IF(userl_avail==1)THEN
448 CALL eng_userlib_userint(igtyp,
449 . nsn ,ii ,pid ,nuvar ,
450 . uvar(1,ii),userbuf )
451 ELSE
452 ! ----------------
453 ! ERROR to be printed & exit
454 option='INTERFACE type2 rupture model'
455 SIZE=LEN_TRIM(OPTION)
456 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
457 CALL ARRET(2)
458 ! ----------------
459 ENDIF
460
461 ELSEIF (IGTYP == 30) THEN
462 IF(USERL_AVAIL==1)THEN
463 CALL ENG_USERLIB_USERINT(IGTYP,
464 . NSN ,II ,PID ,NUVAR ,
465 . UVAR(1,II),USERBUF )
466 ELSE
467 ! ----------------
468 ! ERROR to be printed & exit
469 OPTION='INTERFACE type2 rupture model'
470 SIZE=LEN_TRIM(OPTION)
471 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
472 CALL ARRET(2)
473 ! ----------------
474 ENDIF
475 ELSEIF (IGTYP == 31) THEN
476 IF(USERL_AVAIL==1)THEN
477 CALL ENG_USERLIB_USERINT(IGTYP,
478 . NSN ,II ,PID ,NUVAR ,
479 . UVAR(1,II),USERBUF )
480 ELSE
481 ! ----------------
482 ! ERROR to be printed & exit
483 OPTION='INTERFACE type2 rupture model'
484 SIZE=LEN_TRIM(OPTION)
485 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
486 CALL ARRET(2)
487 ! ----------------
488 ENDIF
489 ELSEIF (IGTYP == 37) THEN
490 IF(USERL_AVAIL==1)THEN
491 CALL ENG_USERLIB_USERINT(IGTYP,
492 . NSN ,II ,PID ,NUVAR ,
493 . UVAR(1,II),USERBUF )
494 ELSE
495 ! ----------------
496 ! ERROR to be printed & exit
497 OPTION='INTERFACE type2 rupture model'
498 SIZE=LEN_TRIM(OPTION)
499 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
500 CALL ARRET(2)
501 ! ----------------
502 ENDIF
503 ELSEIF (IGTYP == 38) THEN
504 IF(USERL_AVAIL==1)THEN
505 CALL ENG_USERLIB_USERINT(IGTYP,
506 . NSN ,II ,PID ,NUVAR ,
507 . UVAR(1,II),USERBUF )
508 ELSE
509 ! ----------------
510 ! ERROR to be printed & exit
511 OPTION='INTERFACE type2 rupture model'
512 SIZE=LEN_TRIM(OPTION)
513 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
514 CALL ARRET(2)
515 ! ----------------
516 ENDIF
517 ELSEIF (IGTYP == 39) THEN
518 IF(USERL_AVAIL==1)THEN
519 CALL ENG_USERLIB_USERINT(IGTYP,
520 . NSN ,II ,PID ,NUVAR ,
521 . UVAR(1,II),USERBUF )
522 ELSE
523 ! ----------------
524 ! ERROR to be printed & exit
525 OPTION='INTERFACE type2 rupture model'
526 SIZE=LEN_TRIM(OPTION)
527 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
528 CALL ARRET(2)
529 ! ----------------
530 ENDIF
531 ELSEIF (IGTYP == 40) THEN
532 IF(USERL_AVAIL==1)THEN
533 CALL ENG_USERLIB_USERINT(IGTYP,
534 . NSN ,II ,PID ,NUVAR ,
535 . UVAR(1,II),USERBUF )
536 ELSE
537 ! ----------------
538 ! ERROR to be printed & exit
539 OPTION='INTERFACE type2 rupture model'
540 SIZE=LEN_TRIM(OPTION)
541 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
542 CALL ARRET(2)
543 ! ----------------
544 ENDIF
545 ELSEIF (IGTYP == 41) THEN
546 IF(USERL_AVAIL==1)THEN
547 CALL ENG_USERLIB_USERINT(IGTYP,
548 . NSN ,II ,PID ,NUVAR ,
549 . UVAR(1,II),USERBUF )
550 ELSE
551 ! ----------------
552 ! ERROR to be printed & exit
553 OPTION='INTERFACE type2 rupture model'
554 SIZE=LEN_TRIM(OPTION)
555 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
556 CALL ARRET(2)
557 ! ----------------
558 ENDIF
559 ELSEIF (IGTYP == 42) THEN
560 IF(USERL_AVAIL==1)THEN
561 CALL ENG_USERLIB_USERINT(IGTYP,
562 . NSN ,II ,PID ,NUVAR ,
563 . UVAR(1,II),USERBUF )
564 ELSE
565 ! ----------------
566 ! ERROR to be printed & exit
567 OPTION='INTERFACE type2 rupture model'
568 SIZE=LEN_TRIM(OPTION)
569 CALL ANCMSG(MSGID=257,C1=OPTION(1:SIZE),ANMODE=ANINFO)
570 CALL ARRET(2)
571 ! ----------------
572 ENDIF
573 ENDIF
574C
575 FACN = USERBUF%FACN
576 FACT = USERBUF%FACT
577 IRUPT(II) = NINT(USERBUF%RUPT)
578 FN(1) = FN(1) * FACN
579 FN(2) = FN(2) * FACN
580 FN(3) = FN(3) * FACN
581 FT(1) = FT(1) * FACT
582 FT(2) = FT(2) * FACT
583 FT(3) = FT(3) * FACT
584 FU(1) = FU(1) * FACT
585 FU(2) = FU(2) * FACT
586 FU(3) = FU(3) * FACT
587 FNORM = FNORM*FACN
588 FTANG = FTANG*FACT
589 FTAN2 = FTAN2*FACT
590 FSM(1,II) = VNX*FNORM + VTX*FTANG + VUX*FTAN2
591 FSM(2,II) = VNY*FNORM + VTY*FTANG + VUY*FTAN2
592 FSM(3,II) = VNZ*FNORM + VTZ*FTANG + VUZ*FTAN2
593C
594 ENDIF
595C------------------------------------------------
596C Save TH
597C------------------------------------------------
598 W = WEIGHT(I)
599 IMPX=FN(1)
600 IMPY=FN(2)
601 IMPZ=FN(3)
602 FSAV1 = IMPX*DT12
603 FSAV2 = IMPY*DT12
604 FSAV3 = IMPZ*DT12
605 FSAV8 = ABS(IMPX)
606 FSAV9 = ABS(IMPY)
607 FSAV10= ABS(IMPZ)
608 FSAV11= FNORM
609 IMPX=FT(1)
610 IMPY=FT(2)
611 IMPZ=FT(3)
612 FSAV4 = IMPX*DT12
613 FSAV5 = IMPY*DT12
614 FSAV6 = IMPZ*DT12
615 FSAV12= ABS(IMPX)
616 FSAV13= ABS(IMPY)
617 FSAV14= ABS(IMPZ)
618 FSAV15= FTANG
619#include "lockon.inc"
620 FSAV(1) = FSAV(1) + FSAV1*W
621 FSAV(2) = FSAV(2) + FSAV2*W
622 FSAV(3) = FSAV(3) + FSAV3*W
623 FSAV(4) = FSAV(4) + FSAV4*W
624 FSAV(5) = FSAV(5) + FSAV5*W
625 FSAV(6) = FSAV(6) + FSAV6*W
626 FSAV(8) = FSAV(8) + FSAV8*W
627 FSAV(9) = FSAV(9) + FSAV9*W
628 FSAV(10)= FSAV(10)+ FSAV10*W
629 FSAV(11)= FSAV(11)+ FSAV11*W
630 FSAV(12)= FSAV(12)+ FSAV12*W
631 FSAV(13)= FSAV(13)+ FSAV13*W
632 FSAV(14)= FSAV(14)+ FSAV14*W
633 FSAV(15)= FSAV(15)+ FSAV15*W
634#include "lockoff.inc"
635C---
636 IF(ANIM_V(13)+H3D_DATA%N_VECT_CONT2>0) THEN
637 FNCONT(1,I) = - (FN(1)+FT(1)) * W
638 FNCONT(2,I) = - (FN(2)+FT(2)) * W
639 FNCONT(3,I) = - (FN(3)+FT(3)) * W
640 DO JJ=1,NIR
641 J=IRECT(JJ,L)
642 FNCONT(1,J) = FNCONT(1,J) + W *(FN(1)+FT(1))*H(JJ)
643 FNCONT(2,J) = FNCONT(2,J) + W *(FN(2)+FT(2))*H(JJ)
644 FNCONT(3,J) = FNCONT(3,J) + W *(FN(3)+FT(3))*H(JJ)
645 ENDDO
646 ENDIF
647
648 IF(ANIM_V(27)+H3D_DATA%N_VECT_PCONT2>0) THEN ! Normal/Tangential forces output
649 FNCONTP(1,I) = - (FN(1)+FT(1)) * W
650 FNCONTP(2,I) = - (FN(2)+FT(2)) * W
651 FNCONTP(3,I) = - (FN(3)+FT(3)) * W
652 DO JJ=1,NIR
653 J=IRECT(JJ,L)
654 FNCONTP(1,J) = FNCONTP(1,J) - FNCONTP(1,I)*H(JJ)
655 FNCONTP(2,J) = FNCONTP(2,J) - FNCONTP(2,I)*H(JJ)
656 FNCONTP(3,J) = FNCONTP(3,J) - FNCONTP(3,I)*H(JJ)
657 ENDDO
658
659 FTCONTP(1,I) = VNX * W
660 FTCONTP(2,I) = VNY * W
661 FTCONTP(3,I) = VNZ * W
662 DO JJ=1,NIR
663 J=IRECT(JJ,L)
664 FTCONTP(1,J) = FTCONTP(1,J) - FTCONTP(1,I)*H(JJ)
665 FTCONTP(2,J) = FTCONTP(2,J) - FTCONTP(2,I)*H(JJ)
666 FTCONTP(3,J) = FTCONTP(3,J) - FTCONTP(3,I)*H(JJ)
667 ENDDO
668 ENDIF
669 ENDIF
670 ENDDO
671C-----------
672 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:308
message_mod
Definition message_mod.F:1249
uintbuf_mod
Definition uintbuf_mod.F:29
ruptint2
subroutine ruptint2(nsl, isl, nuvar, uvar, userbuf, prop, ifuns, ifunn, ifunt, imod, ifiltr, idbg, npf, tf, noint, itab, pdama2, isym, h3d_data)
Definition ruptint2.F:38

◆ int2rupt()

subroutine int2rupt ( integer, dimension(*) ipari,
ms,
in,
x,
v,
a,
stifn,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) weight,
fsav,
integer ilev,
integer, dimension(*) npf,
tf,
integer, dimension(*) itab,
fncont,
pdama2,
type(intbuf_struct_) intbuf_tab,
type (h3d_database) h3d_data,
fncontp,
ftcontp )

Definition at line 33 of file int2rupt.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE intbufdef_mod
42 USE h3d_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER ILEV
51 INTEGER IPARI(*),WEIGHT(*),IGEO(NPROPGI,*),NPF(*),ITAB(*)
52C REAL
53 my_real
54 . ms(*),in(*), x(*), v(*), a(*),stifn(*),fsav(*),tf(*),
55 . fncont(*),pdama2(*), fncontp(*) ,ftcontp(* )
56
57 TYPE(INTBUF_STRUCT_) INTBUF_TAB
58 TYPE (H3D_DATABASE) :: H3D_DATA
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "param_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 integer
67 . nuvar,nsn,nmn,nrts,nrtm,igtyp,pid,isym
68C=======================================================================
69 nrts = ipari(3)
70 nrtm = ipari(4)
71 nsn = ipari(5)
72 nmn = ipari(6)
73 nuvar = ipari(35)
74 isym = ipari(44)
75c
76 IF (ilev == 10 .OR. ilev == 11 .OR. ilev == 12) THEN
77 pid = ipari(43)
78 IF(pid > 0) THEN ! on test test_i2_10_0001.rad , PID = 0
79 igtyp = igeo(11,pid)
80 ELSE
81 igtyp = -1
82 ENDIF
83 ELSE
84 pid = 0
85 igtyp =-1
86 ENDIF
87C
88 CALL i2rupt(
89 1 x ,v ,a ,ms ,in ,
90 2 stifn ,fsav ,weight ,intbuf_tab%IRECTM,intbuf_tab%NSV,
91 3 intbuf_tab%MSR ,intbuf_tab%IRTLM,intbuf_tab%IRUPT ,intbuf_tab%CSTS ,intbuf_tab%NMAS(1),
92 4 intbuf_tab%NMAS(1+nmn),intbuf_tab%SMAS ,intbuf_tab%SINER ,intbuf_tab%AREAS2,intbuf_tab%UVAR ,
93 5 intbuf_tab%XM0 ,intbuf_tab%DSM ,intbuf_tab%FSM ,intbuf_tab%RUPT ,ipari ,
94 6 nsn ,nmn ,nuvar ,igtyp ,pid ,
95 7 npf ,tf ,itab ,fncont ,pdama2 ,
96 8 isym ,intbuf_tab%INORM,h3d_data,fncontp ,ftcontp )
97C-----------
98 RETURN
i2rupt
subroutine i2rupt(x, v, a, ms, in, stifn, fsav, weight, irect, nsv, msr, irtl, irupt, crst, mmass, miner, smass, siner, area, uvar, xsm0, dsm, fsm, prop, ipari, nsn, nmn, nuvar, igtyp, pid, npf, tf, itab, fncont, pdama2, isym, inorm, h3d_data, fncontp, ftcontp)
Definition int2rupt.F:122