OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20pwr3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "vect07_c.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20pwr3ae (itab, inacti, cand_m, cand_s, stfs, stfm, xanew, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, igap, x, fpenmax)
subroutine i20pwr3a (itab, inacti, cand_e, cand_n, stfn, stf, xanew, nsv, iwpene, iwrn, cand_en, cand_nn, tag, noint, gapv, nty, itied, fpenmax, id, titr, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, n1, n2, n3, pene, nsvg)
subroutine i20pwr3 (itab, inacti, cand_e, cand_n, stfn, stf, x, nsv, iwpene, iwrn, cand_en, cand_nn, tag, noint, gapv, nty, itied, penis, penim, gap_s, igap, id, titr, ix1, ix2, ix3, ix4, n1, n2, n3, pene, nsvg)
subroutine i20pwr3e (itab, inacti, cand_m, cand_s, stfs, stfm, x, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, penis, penim, igap)

Function/Subroutine Documentation

◆ i20pwr3()

subroutine i20pwr3 ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stfn,
stf,
x,
integer, dimension(*) nsv,
integer iwpene,
integer iwrn,
integer, dimension(*) cand_en,
integer, dimension(*) cand_nn,
integer, dimension(*) tag,
integer noint,
gapv,
integer nty,
integer itied,
penis,
penim,
gap_s,
integer igap,
integer id,
character(len=nchartitle) titr,
integer, dimension(mvsiz), intent(in) ix1,
integer, dimension(mvsiz), intent(in) ix2,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
intent(inout) n1,
intent(inout) n2,
intent(inout) n3,
intent(inout) pene,
integer, dimension(mvsiz), intent(in) nsvg )

Definition at line 404 of file i20pwr3.F.

411C-----------------------------------------------
412C M o d u l e s
413C-----------------------------------------------
414 USE message_mod
415 USE names_and_titles_mod , ONLY : nchartitle
416 USE format_mod , ONLY : fmw_5i, fmw_4i, fmw_i_3f
417C-----------------------------------------------
418C I m p l i c i t T y p e s
419C-----------------------------------------------
420#include "implicit_f.inc"
421C-----------------------------------------------
422C G l o b a l P a r a m e t e r s
423C-----------------------------------------------
424#include "mvsiz_p.inc"
425C-----------------------------------------------
426C C o m m o n B l o c k s
427C-----------------------------------------------
428#include "units_c.inc"
429#include "vect07_c.inc"
430#include "scr03_c.inc"
431C-----------------------------------------------
432C D u m m y A r g u m e n t s
433C-----------------------------------------------
434 INTEGER ITAB(*),CAND_E(*),CAND_N(*),CAND_EN(*),CAND_NN(*)
435 INTEGER NSV(*),TAG(*),IWPENE,INACTI,NOINT,NTY,ITIED,IWRN,IGAP
436 my_real stf(*),stfn(*),x(3,*),gapv(*),penis(2,*) ,penim(2,*),gap_s(*)
437 INTEGER ID
438 CHARACTER(LEN=NCHARTITLE) :: TITR
439 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4,NSVG
440 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3,pene
441C-----------------------------------------------
442C L o c a l V a r i a b l e s
443C-----------------------------------------------
444 INTEGER I,IS,IM,JWARN
445 my_real peneold,pplus,aaa
446 my_real dn
447C-----------------------------------------------
448 jwarn = 0
449 DO 100 i=lft,llt
450 is=cand_n(i)
451 im=cand_e(i)
452 IF(stfn(is)==zero) cycle
453C
454 IF(ipri>=1.AND.pene(i)>zero)THEN
455 WRITE(iout,fmt=fmw_5i)
456 1 itab(nsvg(i)),
457 2 itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
458 ELSEIF(ipri>=6)THEN
459 WRITE(iout,fmt=fmw_5i)
460 1 itab(nsvg(i)),
461 2 itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
462 ENDIF
463 IF(pene(i)>zero)THEN
464 tag(nsvg(i))=tag(nsvg(i))+1
465 dn=n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)
466 IF(dn<=em30) THEN
467 WRITE(iout,1100)pene(i),itab(nsvg(i))
468 IF(nty/=10.OR.itied==0)THEN
469 IF(inacti/=1.AND.inacti/=2) THEN
470
471 IF (inacti==0) THEN
472 CALL ancmsg(msgid=612,
473 . msgtype=msgerror,
474 . anmode=aninfo_blind_1,
475 . i1=id,
476 . c1=titr,
477 . i2=inacti,
478 . i3=itab(nsvg(i)))
479 ELSE
480 CALL ancmsg(msgid=611,
481 . msgtype=msgerror,
482 . anmode=aninfo_blind_1,
483 . i1=id,
484 . c1=titr,
485 . i2=inacti,
486 . i3=itab(nsvg(i)))
487 ENDIF
488 ENDIF
489 END IF
490
491 ELSE
492 pene(i) = pene(i) + em8*pene(i)
493 ENDIF
494
495 IF(inacti == 5.or.inacti == 6) THEN
496C INACTI == 6
497 IF(pene(i) >= gapv(i)*zep995)THEN
498 WRITE(iout,'(A)')' *** PENETRATION > GAP - 0.5% !! '
499 WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
500 pene(i)=gapv(i)
501 stfn(is) = zero
502 ELSE
503 jwarn = 1
504 pplus=(pene(i)+zep05*(gapv(i)-pene(i)))
505 IF(igap > 0) THEN
506C---
507 IF (pplus < gap_s(is)) THEN
508 penis(2,is)=max(penis(2,is),pplus)
509 ELSE
510 penis(2,is)=max(penis(2,is),gap_s(is))
511 penim(2,im)=max(penim(2,im),pplus-gap_s(is))
512 ENDIF
513 ELSE
514 penim(2,im)=max(penim(2,im),pplus)
515 END IF
516C---
517c AAA = GAP_S(IS)/GAPV(I)
518c PENIS(2,IS)=MAX(PENIS(2,IS),AAA*PPLUS)
519c PENIM(2,IM)=MAX(PENIM(2,IM),(ONE-AAA)*PPLUS)
520C---
521 penis(1,is)=penis(2,is)
522 penim(1,im)=penim(2,im)
523 ENDIF
524
525c CAND_P(IWPENE+1) = PENE(I)
526 cand_nn(iwpene+1) = cand_n(i)
527 cand_en(iwpene+1) = cand_e(i)
528 END IF
529
530 iwpene=iwpene+1
531 ENDIF
532 100 CONTINUE
533
534 IF(iwpene /= 0.and.inacti == 3.or.inacti == 4) iwrn = 1
535C
536 1100 FORMAT(2x,'** INITIAL PENETRATION =',e14.7,
537 . ' IMPOSSIBLE TO CALCULATE NEW COORDINATES OF SECONDARY NODE',i8)
538 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ i20pwr3a()

subroutine i20pwr3a ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stfn,
stf,
xanew,
integer, dimension(*) nsv,
integer iwpene,
integer iwrn,
integer, dimension(*) cand_en,
integer, dimension(*) cand_nn,
integer, dimension(*) tag,
integer noint,
gapv,
integer nty,
integer itied,
fpenmax,
integer id,
character(len=nchartitle) titr,
integer, dimension(mvsiz), intent(in) ix1,
integer, dimension(mvsiz), intent(in) ix2,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) xi,
intent(inout) yi,
intent(inout) zi,
intent(inout) n1,
intent(inout) n2,
intent(inout) n3,
intent(inout) pene,
integer, dimension(mvsiz), intent(in) nsvg )

Definition at line 168 of file i20pwr3.F.

177 USE message_mod
178 USE names_and_titles_mod , ONLY : nchartitle
179 USE format_mod , ONLY : fmw_5i, fmw_i_3f
180C-----------------------------------------------
181C I m p l i c i t T y p e s
182C-----------------------------------------------
183#include "implicit_f.inc"
184C-----------------------------------------------
185C G l o b a l P a r a m e t e r s
186C-----------------------------------------------
187#include "mvsiz_p.inc"
188C-----------------------------------------------
189C D u m m y A r g u m e n t s
190C-----------------------------------------------
191 INTEGER ITAB(*),CAND_E(*),CAND_N(*),CAND_EN(*),CAND_NN(*)
192 INTEGER NSV(*),TAG(*),IWPENE,INACTI,NOINT,NTY,ITIED,IWRN
193 my_real fpenmax
194 my_real stf(*),stfn(*),xanew(3,*),gapv(*)
195 INTEGER ID
196 CHARACTER(LEN=NCHARTITLE) :: TITR
197C-----------------------------------------------
198C C o m m o n B l o c k s
199C-----------------------------------------------
200#include "units_c.inc"
201#include "vect07_c.inc"
202#include "scr03_c.inc"
203C-----------------------------------------------
204C D u m m y A r g u m e n t s
205C-----------------------------------------------
206 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4,NSVG
207 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
208 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
209 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
210 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3,pene
211 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
212C-----------------------------------------------
213C L o c a l V a r i a b l e s
214C-----------------------------------------------
215 INTEGER I,IS,IM
216C REAL
217 my_real ::peneold,pplus,ps2,penmax
218 my_real
219 . dn
220C-----------------------------------------------
221 DO 100 i=lft,llt
222 IF(ipri>=1.AND.pene(i)>zero)THEN
223 WRITE(iout,fmt=fmw_5i)
224 1 itab(nsvg(i)),
225 2 itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
226 ELSEIF(ipri>=6)THEN
227 WRITE(iout,fmt=fmw_5i)
228 1 itab(nsvg(i)),
229 2 itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
230 ENDIF
231 penmax = fpenmax*gapv(i)
232C
233 IF(pene(i)>zero)THEN
234 tag(nsvg(i))=tag(nsvg(i))+1
235 dn=n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)
236 IF(dn<=em30) THEN
237 WRITE(iout,1100)pene(i),itab(nsvg(i))
238 IF(nty/=10.OR.itied==0)THEN
239 IF (inacti/=1.AND.inacti/=2.AND.
240 . pene(i)<=penmax) THEN
241
242 IF (inacti==0) THEN
243 CALL ancmsg(msgid=612,
244 . msgtype=msgerror,
245 . anmode=aninfo_blind_1,
246 . i1=id,
247 . c1=titr,
248 . i2=inacti,
249 . i3=itab(nsvg(i)))
250 ELSE
251 CALL ancmsg(msgid=611,
252 . msgtype=msgerror,
253 . anmode=aninfo_blind_1,
254 . i1=id,
255 . c1=titr,
256 . i2=inacti,
257 . i3=itab(nsvg(i)))
258 ENDIF
259 ENDIF
260 END IF
261 ELSEIF (pene(i) <= penmax) THEN
262 WRITE(iout,1000)pene(i)
263 pene(i) = pene(i) + em8*pene(i)
264 WRITE(iout,fmt=fmw_i_3f)itab(nsvg(i)),
265 . xi(i)+pene(i)*n1(i),
266 . yi(i)+pene(i)*n2(i),
267 . zi(i)+pene(i)*n3(i)
268 ENDIF
269
270 IF (inacti == 1 .OR. pene(i) > penmax) THEN
271C DESACTIVATION DES NOEUDS
272 IF (pene(i) > penmax)
273 . WRITE(iout,'(A,I8,A,1PG20.13,A)')' NODE ',itab(nsvg(i)),
274 . ' : MAX INITIAL PENETRATION ',penmax,' IS REACHED'
275 WRITE(iout,'(A)')' SECONDARY STIFFNESS IS SET TO ZERO'
276 stfn(cand_n(i)) = zero
277 ELSE IF(inacti==2) THEN
278C DESACTIVATION DES ELEMENTS
279 WRITE(iout,'(A)')'ELEMENT STIFFNESS IS SET TO ZERO'
280 stf(cand_e(i)) = zero
281 ELSE IF(inacti==3) THEN
282C CHANGE LES COORDONNEES DES NOEUDS SECONDARY
283 WRITE(iout,'(A)')'NODE COORD IS CHANGED AS PROPOSED'
284 peneold = sqrt( (xanew(1,nsv(cand_n(i)))-xi(i))**2 +
285 . (xanew(2,nsv(cand_n(i)))-yi(i))**2 +
286 . (xanew(3,nsv(cand_n(i)))-zi(i))**2 )
287 IF(pene(i)>peneold) THEN
288 xanew(1,nsv(cand_n(i))) = xi(i)+pene(i)*n1(i)
289 xanew(2,nsv(cand_n(i))) = yi(i)+pene(i)*n2(i)
290 xanew(3,nsv(cand_n(i))) = zi(i)+pene(i)*n3(i)
291 ENDIF
292 ELSE IF(inacti==4) THEN
293C CHANGE LES COORDONNEES DES NOEUDS MAIN
294 WRITE(iout,'(A)')'SEG. COORD IS CHANGED AS PROPOSED'
295 peneold = sqrt( (xanew(1,ix1(i))-x1(i))**2 +
296 . (xanew(2,ix1(i))-y1(i))**2 +
297 . (xanew(3,ix1(i))-z1(i))**2 )
298 IF(pene(i)>peneold) THEN
299 xanew(1,ix1(i)) = x1(i)-pene(i)*n1(i)
300 xanew(2,ix1(i)) = y1(i)-pene(i)*n2(i)
301 xanew(3,ix1(i)) = z1(i)-pene(i)*n3(i)
302 ENDIF
303C
304 peneold = sqrt( (xanew(1,ix2(i))-x2(i))**2 +
305 . (xanew(2,ix2(i))-y2(i))**2 +
306 . (xanew(3,ix2(i))-z2(i))**2 )
307 IF(pene(i)>peneold) THEN
308 xanew(1,ix2(i)) = x2(i)-pene(i)*n1(i)
309 xanew(2,ix2(i)) = y2(i)-pene(i)*n2(i)
310 xanew(3,ix2(i)) = z2(i)-pene(i)*n3(i)
311 ENDIF
312C
313 peneold = sqrt( (xanew(1,ix3(i))-x3(i))**2 +
314 . (xanew(2,ix3(i))-y3(i))**2 +
315 . (xanew(3,ix3(i))-z3(i))**2 )
316 IF(pene(i)>peneold) THEN
317 xanew(1,ix3(i)) = x3(i)-pene(i)*n1(i)
318 xanew(2,ix3(i)) = y3(i)-pene(i)*n2(i)
319 xanew(3,ix3(i)) = z3(i)-pene(i)*n3(i)
320 ENDIF
321C
322 peneold = sqrt( (xanew(1,ix4(i))-x4(i))**2 +
323 . (xanew(2,ix4(i))-y4(i))**2 +
324 . (xanew(3,ix4(i))-z4(i))**2 )
325 IF(pene(i)>peneold) THEN
326 xanew(1,ix4(i)) = x4(i)-pene(i)*n1(i)
327 xanew(2,ix4(i)) = y4(i)-pene(i)*n2(i)
328 xanew(3,ix4(i)) = z4(i)-pene(i)*n3(i)
329 ENDIF
330 ELSE IF(inacti == 6) THEN
331C INACTI == 6
332C CHANGE LES COORDONNEES DES NOEUDS SECONDARY
333 WRITE(iout,'(A)')'NODE COORD IS CHANGED AS PROPOSED'
334 ps2 = half*pene(i)
335 peneold = sqrt( (xanew(1,nsv(cand_n(i)))-xi(i))**2 +
336 . (xanew(2,nsv(cand_n(i)))-yi(i))**2 +
337 . (xanew(3,nsv(cand_n(i)))-zi(i))**2 )
338 IF(ps2>peneold) THEN
339 xanew(1,nsv(cand_n(i))) = xi(i)+ps2*n1(i)
340 xanew(2,nsv(cand_n(i))) = yi(i)+ps2*n2(i)
341 xanew(3,nsv(cand_n(i))) = zi(i)+ps2*n3(i)
342 ENDIF
343C CHANGE LES COORDONNEES DES NOEUDS MAIN
344 WRITE(iout,'(A)')'SEG. COORD IS CHANGED AS PROPOSED'
345 peneold = sqrt( (xanew(1,ix1(i))-x1(i))**2 +
346 . (xanew(2,ix1(i))-y1(i))**2 +
347 . (xanew(3,ix1(i))-z1(i))**2 )
348 IF(ps2>peneold) THEN
349 xanew(1,ix1(i)) = x1(i)-ps2*n1(i)
350 xanew(2,ix1(i)) = y1(i)-ps2*n2(i)
351 xanew(3,ix1(i)) = z1(i)-ps2*n3(i)
352 ENDIF
353C
354 peneold = sqrt( (xanew(1,ix2(i))-x2(i))**2 +
355 . (xanew(2,ix2(i))-y2(i))**2 +
356 . (xanew(3,ix2(i))-z2(i))**2 )
357 IF(ps2>peneold) THEN
358 xanew(1,ix2(i)) = x2(i)-ps2*n1(i)
359 xanew(2,ix2(i)) = y2(i)-ps2*n2(i)
360 xanew(3,ix2(i)) = z2(i)-ps2*n3(i)
361 ENDIF
362C
363 peneold = sqrt( (xanew(1,ix3(i))-x3(i))**2 +
364 . (xanew(2,ix3(i))-y3(i))**2 +
365 . (xanew(3,ix3(i))-z3(i))**2 )
366 IF(ps2>peneold) THEN
367 xanew(1,ix3(i)) = x3(i)-ps2*n1(i)
368 xanew(2,ix3(i)) = y3(i)-ps2*n2(i)
369 xanew(3,ix3(i)) = z3(i)-ps2*n3(i)
370 ENDIF
371C
372 peneold = sqrt( (xanew(1,ix4(i))-x4(i))**2 +
373 . (xanew(2,ix4(i))-y4(i))**2 +
374 . (xanew(3,ix4(i))-z4(i))**2 )
375 IF(ps2>peneold) THEN
376 xanew(1,ix4(i)) = x4(i)-ps2*n1(i)
377 xanew(2,ix4(i)) = y4(i)-ps2*n2(i)
378 xanew(3,ix4(i)) = z4(i)-ps2*n3(i)
379 ENDIF
380 END IF
381
382 iwpene=iwpene+1
383 ENDIF
384 100 CONTINUE
385
386 IF(iwpene /= 0 .and.inacti == 3 .or.inacti == 4) iwrn = 1
387C
388 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
389 . ' POSSIBLE NEW COORDINATES OF SECONDARY NODE')
390 1100 FORMAT(2x,'** INITIAL PENETRATION =',e14.7,
391 . ' IMPOSSIBLE TO CALCULATE NEW COORDINATES OF SECONDARY NODE',i8)
392 RETURN

◆ i20pwr3ae()

subroutine i20pwr3ae ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
stfs,
stfm,
xanew,
integer, dimension(*) nsv,
integer iwpene,
integer, dimension(*) n1,
integer, dimension(*) n2,
integer, dimension(*) m1,
integer, dimension(*) m2,
nx,
ny,
nz,
gapv,
gap_s,
gap_m,
integer igap,
x,
fpenmax )

Definition at line 30 of file i20pwr3.F.

35 USE format_mod , ONLY : fmw_4i, fmw_i_3f, fmw_5i
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER ITAB(*),CAND_M(*),CAND_S(*),INACTI,IGAP ,
48 4 N1(*) ,N2(*) ,M1(*) ,M2(*)
49 INTEGER NSV(*),IWPENE
50 my_real fpenmax
51 my_real stfs(*),stfm(*),xanew(3,*),x(3,*),gap_s(*) ,gap_m(*),
52 . nx(mvsiz), ny(mvsiz), nz(mvsiz),gapv(*)
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "units_c.inc"
57#include "vect07_c.inc"
58#include "scr03_c.inc"
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I, IS, IM
63C REAL
64 my_real
65 . pene(mvsiz),
66 . peneold, s2, d, pplus,ps2, penmax
67C-----------------------------------------------
68C
69
70 DO i=1,llt
71 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
72 gapv(i) = sqrt(gapv(i))
73 pene(i) = gapv(i) - s2
74 s2 = 1./max(em30,s2)
75 nx(i) = nx(i)*s2
76 ny(i) = ny(i)*s2
77 nz(i) = nz(i)*s2
78 ENDDO
79C
80 DO 100 i=lft,llt
81 IF(ipri>=1)THEN
82 WRITE(iout,fmt=fmw_4i)
83 2 itab(n1(i)),itab(n2(i)),itab(m1(i)),itab(m2(i))
84 ENDIF
85 IF(pene(i)>zero)THEN
86 WRITE(iout,1000)pene(i)
87 WRITE(iout,fmt=fmw_i_3f)itab(n1(i)),
88 . xanew(1,n1(i))+pene(i)*nx(i),
89 . xanew(2,n1(i))+pene(i)*ny(i),
90 . xanew(3,n1(i))+pene(i)*nz(i)
91 WRITE(iout,fmt=fmw_i_3f)itab(n2(i)),
92 . xanew(1,n2(i))+pene(i)*nx(i),
93 . xanew(2,n2(i))+pene(i)*ny(i),
94 . xanew(3,n2(i))+pene(i)*nz(i)
95 pene(i) = pene(i) + em8*pene(i)
96 penmax = fpenmax*gapv(i)
97 IF (inacti == 1 .OR. pene(i) > penmax) THEN
98C DESACTIVATION DES NOEUDS
99 IF (pene(i) > penmax)
100 . WRITE(iout,'(A,1PG20.13,A)')
101 . ' MAX INITIAL PENETRATION ',penmax,' IS REACHED'
102 WRITE(iout,'(a)')' secondary stiffness is set to zero'
103 STFS(CAND_S(I)) = ZERO
104 ELSE IF(INACTI==2) THEN
105C DESACTIVATION DES ELEMENTS
106 WRITE(IOUT,'(a)')'main stiffness is set to zero'
107 STFM(CAND_M(I)) = ZERO
108 ELSE IF(INACTI==6) THEN
109C INACTI==6
110C CHANGE LES COORDONNEES DES NOEUDS SECONDARY
111 WRITE(IOUT,'(a)')'node coord is changed as proposed'
112 PS2 = HALF*PENE(I)
113 PENEOLD = SQRT( (XANEW(1,N1(I))-X(1,N1(I)))**2 +
114 . (XANEW(2,N1(I))-X(2,N1(I)))**2 +
115 . (XANEW(3,N1(I))-X(3,N1(I)))**2 )
116 IF(PS2>PENEOLD) THEN
117 XANEW(1,N1(I)) = X(1,N1(I))+PS2*NX(I)
118 XANEW(2,N1(I)) = X(2,N1(I))+PS2*NY(I)
119 XANEW(3,N1(I)) = X(3,N1(I))+PS2*NZ(I)
120 ENDIF
121 PENEOLD = SQRT( (XANEW(1,N2(I))-X(1,N2(I)))**2 +
122 . (XANEW(2,N2(I))-X(2,N2(I)))**2 +
123 . (XANEW(3,N2(I))-X(3,N2(I)))**2 )
124 IF(PS2>PENEOLD) THEN
125 XANEW(1,N2(I)) = X(1,N2(I))+PS2*NX(I)
126 XANEW(2,N2(I)) = X(2,N2(I))+PS2*NY(I)
127 XANEW(3,N2(I)) = X(3,N2(I))+PS2*NZ(I)
128 ENDIF
129C CHANGE LES COORDONNEES DES NOEUDS MAIN
130 WRITE(IOUT,'(a)')'seg. coord is changed as proposed'
131 peneold = sqrt( (xanew(1,m1(i))-x(1,m1(i)))**2 +
132 . (xanew(2,m1(i))-x(2,m1(i)))**2 +
133 . (xanew(3,m1(i))-x(3,m1(i)))**2 )
134 IF(ps2>peneold) THEN
135 xanew(1,m1(i)) = x(1,m1(i))-ps2*nx(i)
136 xanew(2,m1(i)) = x(2,m1(i))-ps2*ny(i)
137 xanew(3,m1(i)) = x(3,m1(i))-ps2*nz(i)
138 ENDIF
139C
140 peneold = sqrt( (xanew(1,m2(i))-x(1,m2(i)))**2 +
141 . (xanew(2,m2(i))-x(2,m2(i)))**2 +
142 . (xanew(3,m2(i))-x(3,m2(i)))**2 )
143 IF(ps2>peneold) THEN
144 xanew(1,m2(i)) = x(1,m2(i))-ps2*nx(i)
145 xanew(2,m2(i)) = x(2,m2(i))-ps2*ny(i)
146 xanew(3,m2(i)) = x(3,m2(i))-ps2*nz(i)
147 ENDIF
148
149 END IF
150 iwpene=iwpene+1
151 ENDIF
152 100 CONTINUE
153C
154 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
155 . ' POSSIBLE NEW COORDINATES OF SECONDARY NODES')
156 RETURN
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841

◆ i20pwr3e()

subroutine i20pwr3e ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_m,
integer, dimension(*) cand_s,
stfs,
stfm,
x,
integer, dimension(*) nsv,
integer iwpene,
integer, dimension(*) n1,
integer, dimension(*) n2,
integer, dimension(*) m1,
integer, dimension(*) m2,
nx,
ny,
nz,
gapv,
gap_s,
gap_m,
penis,
penim,
integer igap )

Definition at line 547 of file i20pwr3.F.

552 USE format_mod , ONLY : fmw_4i, fmw_i_3f
553C-----------------------------------------------
554C I m p l i c i t T y p e s
555C-----------------------------------------------
556#include "implicit_f.inc"
557C-----------------------------------------------
558C G l o b a l P a r a m e t e r s
559C-----------------------------------------------
560#include "mvsiz_p.inc"
561C-----------------------------------------------
562C D u m m y A r g u m e n t s
563C-----------------------------------------------
564 INTEGER ITAB(*),CAND_M(*),CAND_S(*),INACTI,IGAP ,N1(*) ,N2(*) ,M1(*) ,M2(*)
565 INTEGER NSV(*),IWPENE
566 my_real stfs(*),stfm(*),x(3,*),gap_s(*) ,gap_m(*),penis(2,*) , penim(2,*),nx(mvsiz), ny(mvsiz), nz(mvsiz),gapv(*)
567C-----------------------------------------------
568C C o m m o n B l o c k s
569C-----------------------------------------------
570#include "units_c.inc"
571#include "vect07_c.inc"
572#include "scr03_c.inc"
573C-----------------------------------------------
574C L o c a l V a r i a b l e s
575C-----------------------------------------------
576 INTEGER I, IS, IM,JWARN
577C REAL
578 my_real
579 . pene(mvsiz),
580 . peneold, s2, d, pplus
581C-----------------------------------------------
582C
583 jwarn = 0
584 DO i=1,llt
585 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
586 gapv(i) = sqrt(gapv(i))
587 pene(i) = gapv(i) - s2
588 s2 = 1./max(em30,s2)
589 nx(i) = nx(i)*s2
590 ny(i) = ny(i)*s2
591 nz(i) = nz(i)*s2
592 ENDDO
593C
594 DO 100 i=lft,llt
595 IF(stfs(cand_s(i))==zero) cycle
596 IF(ipri>=1)THEN
597 WRITE(iout,fmt=fmw_4i)
598 2 itab(n1(i)),itab(n2(i)),itab(m1(i)),itab(m2(i))
599 ENDIF
600 IF(pene(i)>zero)THEN
601 WRITE(iout,1000)pene(i)
602 WRITE(iout,fmt=fmw_i_3f)itab(n1(i)),
603 . x(1,n1(i))+pene(i)*nx(i),
604 . x(2,n1(i))+pene(i)*ny(i),
605 . x(3,n1(i))+pene(i)*nz(i)
606 WRITE(iout,fmt=fmw_i_3f)itab(n2(i)),
607 . x(1,n2(i))+pene(i)*nx(i),
608 . x(2,n2(i))+pene(i)*ny(i),
609 . x(3,n2(i))+pene(i)*nz(i)
610 pene(i) = pene(i) + em8*pene(i)
611 IF(inacti == 5.or.inacti == 6) THEN
612C INACTI==6
613 IF(pene(i)>=gapv(i)*zep995)THEN
614 WRITE(iout,'(A)')' *** PENETRATION > GAP - 0.5% !! '
615 WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
616 pene(i)=gapv(i)
617 stfs(cand_s(i)) = zero
618 ELSE
619 jwarn = 1
620 is=cand_s(i)
621 im=cand_m(i)
622 pplus=half*(pene(i)+zep05*(gapv(i)-pene(i)))
623 penis(2,is)=max(penis(2,is),pplus)
624 penim(2,im)=max(penim(2,im),pplus)
625 penis(1,is)=penis(2,is)
626 penim(1,im)=penim(2,im)
627 ENDIF
628 END IF
629 iwpene=iwpene+1
630 ENDIF
631 100 CONTINUE
632 IF (jwarn /= 0) WRITE(iout,'(A)')'REDUCE INITIAL GAP'
633C
634 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
635 . ' POSSIBLE NEW COORDINATES OF SECONDARY NODES')
636 RETURN