OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20buce_crit.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "task_c.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20buce_crit (itask, x, v, ms, nty, nin, inacti, nsn, nmn, nsv, msr, xsav, stfa, xslv_g, xmsr_g, vslv_g, vmsr_g, daanc6, dxanc, dvanc, nsne, nmne, nlinsa, nlinma, nsve, msre, xsave, penise, penime, stfes, xa, va, nln, nlg, penis, penim, penia, nrtm, ixlins, dxancg, ikine, diag_sms, alphak, daanc, stfac, h3d_data)

Function/Subroutine Documentation

◆ i20buce_crit()

subroutine i20buce_crit ( integer itask,
x,
v,
ms,
integer nty,
integer nin,
integer inacti,
integer nsn,
integer nmn,
integer, dimension(nsn) nsv,
integer, dimension(nmn) msr,
xsav,
stfa,
xslv_g,
xmsr_g,
vslv_g,
vmsr_g,
double precision, dimension(3,6,*) daanc6,
dxanc,
dvanc,
integer nsne,
integer nmne,
integer nlinsa,
integer nlinma,
integer, dimension(nsne) nsve,
integer, dimension(nmne) msre,
xsave,
penise,
penime,
stfes,
xa,
va,
integer nln,
integer, dimension(nln) nlg,
penis,
penim,
penia,
integer nrtm,
integer, dimension(2,*) ixlins,
dxancg,
integer, dimension(numnod) ikine,
diag_sms,
alphak,
daanc,
stfac,
type (h3d_database) h3d_data )

Definition at line 33 of file i20buce_crit.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE h3d_mod
50 USE anim_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com01_c.inc"
60#include "com04_c.inc"
61#include "com06_c.inc"
62#include "com08_c.inc"
63#include "scr07_c.inc"
64#include "scr14_c.inc"
65#include "scr16_c.inc"
66#include "task_c.inc"
67#include "sms_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER NSN,NMN,ITASK,NSV(NSN),MSR(NMN), NIN ,NTY ,INACTI,
72 . NLINSA,NLINMA,NLN,NLG(NLN),NRTM
73 INTEGER NSNE,NMNE,NSVE(NSNE),MSRE(NMNE),IXLINS(2,*),IKINE(NUMNOD)
74 my_real
75 . x(3,*), v(3,*), xsav(3,*), stfa(*),
76 . xslv_g(*),xmsr_g(*), vslv_g(*), vmsr_g(*), ms(*), diag_sms(*),
77 . xsave(3,*), stfes(*),penise(2,nlinsa),penime(2,nlinma),
78 . penis(2,nsn),penim(2,nrtm),penia(5,nln),stfac
79 my_real
80 . dvanc(3,*) ,dxanc(3,*),daanc(3,*) ,dxancg(3,*)
81 my_real
82 . va(3,nsn) ,xa(3,nsn),alphak(3,nln)
83 DOUBLE PRECISION
84 . DAANC6(3,6,*)
85 TYPE (H3D_DATABASE) :: H3D_DATA
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER NSNF,NMNF,NSNL,NMNL,I, II, N,NLNF,NLNL,IL,IG,NRTMF,NRTML
90 INTEGER NSNEF,NMNEF,NSNEL,NMNEL,NLINSAF,NLINSAL,NLINMAF,NLINMAL
91 INTEGER IRBY
92 my_real
93 . aaa,da(3), xslv(6), xmsr(6), vslv(6), vmsr(6) ,amass
94C-----------------------------------------------
95C S o u r c e L i n e s
96C-----------------------------------------------
97C
98C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
99C
100 xslv(1) = -ep30
101 xslv(2) = -ep30
102 xslv(3) = -ep30
103 xslv(4) = ep30
104 xslv(5) = ep30
105 xslv(6) = ep30
106 xmsr(1) = -ep30
107 xmsr(2) = -ep30
108 xmsr(3) = -ep30
109 xmsr(4) = ep30
110 xmsr(5) = ep30
111 xmsr(6) = ep30
112 vslv(1) = -ep30
113 vslv(2) = -ep30
114 vslv(3) = -ep30
115 vslv(4) = ep30
116 vslv(5) = ep30
117 vslv(6) = ep30
118 vmsr(1) = -ep30
119 vmsr(2) = -ep30
120 vmsr(3) = -ep30
121 vmsr(4) = ep30
122 vmsr(5) = ep30
123 vmsr(6) = ep30
124
125 nlnf = 1 + itask*nln / nthread
126 nlnl = (itask+1)*nln / nthread
127 nsnf = 1 + itask*nsn / nthread
128 nsnl = (itask+1)*nsn / nthread
129 nmnf = 1 + itask*nmn / nthread
130 nmnl = (itask+1)*nmn / nthread
131
132 nrtmf = 1 + itask*nrtm / nthread
133 nrtml = (itask+1)*nrtm / nthread
134
135 nsnef = 1 + itask*nsne / nthread
136 nsnel = (itask+1)*nsne / nthread
137 nmnef = 1 + itask*nmne / nthread
138 nmnel = (itask+1)*nmne / nthread
139
140 nlinsaf = 1 + itask * nlinsa / nthread
141 nlinsal = (itask+1) * nlinsa / nthread
142 nlinmaf = 1 + itask * nlinma / nthread
143 nlinmal = (itask+1) * nlinma / nthread
144C=======================================================================
145C POINTS D'ANCRAGE INTEGRATION dA dV dX
146C=======================================================================
147C=======================================================================
148C NOUVELLE FORMULATION
149C=======================================================================
150 IF(stfac > zero)THEN
151 amass = max(two,stfac+sqrt(two*stfac))
152 ELSE
153 amass = two
154 ENDIF
155 IF(idtmins==0.AND.idtmins_int==0)THEN
156 DO i=nlnf,nlnl
157 ig=nlg(i)
158 irby = ikine(ig) - (ikine(ig)/2)*2
159 IF(ms(ig) > zero .and. irby /= 1)THEN
160
161c essai viscosite critique
162c AAA = DT12/(TWO*MS(IG))
163 aaa = dt12/(amass*ms(ig))
164c delta A parith on
165 da(1) = daanc(1,i)
166 da(2) = daanc(2,i)
167 da(3) = daanc(3,i)
168 IF(alphak(2,i)<zero)THEN
169 da(1) = daanc6(1,1,i) + daanc6(1,2,i) + daanc6(1,3,i)
170 . + daanc6(1,4,i) + daanc6(1,5,i) + daanc6(1,6,i)
171 . + da(1)
172 da(2) = daanc6(2,1,i) + daanc6(2,2,i) + daanc6(2,3,i)
173 . + daanc6(2,4,i) + daanc6(2,5,i) + daanc6(2,6,i)
174 . + da(2)
175 da(3) = daanc6(3,1,i) + daanc6(3,2,i) + daanc6(3,3,i)
176 . + daanc6(3,4,i) + daanc6(3,5,i) + daanc6(3,6,i)
177 . + da(3)
178
179 daanc6(1,1,i) = zero
180 daanc6(1,2,i) = zero
181 daanc6(1,3,i) = zero
182 daanc6(1,4,i) = zero
183 daanc6(1,5,i) = zero
184 daanc6(1,6,i) = zero
185
186 daanc6(2,1,i) = zero
187 daanc6(2,2,i) = zero
188 daanc6(2,3,i) = zero
189 daanc6(2,4,i) = zero
190 daanc6(2,5,i) = zero
191 daanc6(2,6,i) = zero
192
193 daanc6(3,1,i) = zero
194 daanc6(3,2,i) = zero
195 daanc6(3,3,i) = zero
196 daanc6(3,4,i) = zero
197 daanc6(3,5,i) = zero
198 daanc6(3,6,i) = zero
199
200 ENDIF
201
202 dvanc(1,i) = dvanc(1,i) + da(1)*aaa
203 dvanc(2,i) = dvanc(2,i) + da(2)*aaa
204 dvanc(3,i) = dvanc(3,i) + da(3)*aaa
205 dxanc(1,i) = dxanc(1,i) + dvanc(1,i)*dt1
206 dxanc(2,i) = dxanc(2,i) + dvanc(2,i)*dt1
207 dxanc(3,i) = dxanc(3,i) + dvanc(3,i)*dt1
208
209 ELSE
210
211 dvanc(1,i) = zero
212 dvanc(2,i) = zero
213 dvanc(3,i) = zero
214 dxanc(1,i) = zero
215 dxanc(2,i) = zero
216 dxanc(3,i) = zero
217
218 ENDIF
219
220 va(1,i) = v(1,ig) + dvanc(1,i)
221 va(2,i) = v(2,ig) + dvanc(2,i)
222 va(3,i) = v(3,ig) + dvanc(3,i)
223 xa(1,i) = x(1,ig) + dxanc(1,i)
224 xa(2,i) = x(2,ig) + dxanc(2,i)
225 xa(3,i) = x(3,ig) + dxanc(3,i)
226
227 END DO
228 ELSE
229C-- AMS
230 DO i=nlnf,nlnl
231 ig=nlg(i)
232 irby = ikine(ig) - (ikine(ig)/2)*2
233 IF(diag_sms(ig) > zero .and. irby /= 1)THEN
234
235 aaa = dt12/(amass*diag_sms(ig))
236c delta A parith on
237 da(1) = daanc(1,i)
238 da(2) = daanc(2,i)
239 da(3) = daanc(3,i)
240 IF(alphak(2,i)<zero)THEN
241 da(1) = daanc6(1,1,i) + daanc6(1,2,i) + daanc6(1,3,i)
242 . + daanc6(1,4,i) + daanc6(1,5,i) + daanc6(1,6,i)
243 . + da(1)
244 da(2) = daanc6(2,1,i) + daanc6(2,2,i) + daanc6(2,3,i)
245 . + daanc6(2,4,i) + daanc6(2,5,i) + daanc6(2,6,i)
246 . + da(2)
247 da(3) = daanc6(3,1,i) + daanc6(3,2,i) + daanc6(3,3,i)
248 . + daanc6(3,4,i) + daanc6(3,5,i) + daanc6(3,6,i)
249 . + da(3)
250 daanc6(1,1,i) = zero
251 daanc6(1,2,i) = zero
252 daanc6(1,3,i) = zero
253 daanc6(1,4,i) = zero
254 daanc6(1,5,i) = zero
255 daanc6(1,6,i) = zero
256
257 daanc6(2,1,i) = zero
258 daanc6(2,2,i) = zero
259 daanc6(2,3,i) = zero
260 daanc6(2,4,i) = zero
261 daanc6(2,5,i) = zero
262 daanc6(2,6,i) = zero
263
264 daanc6(3,1,i) = zero
265 daanc6(3,2,i) = zero
266 daanc6(3,3,i) = zero
267 daanc6(3,4,i) = zero
268 daanc6(3,5,i) = zero
269 daanc6(3,6,i) = zero
270 ENDIF
271
272 dvanc(1,i) = dvanc(1,i) + da(1)*aaa
273 dvanc(2,i) = dvanc(2,i) + da(2)*aaa
274 dvanc(3,i) = dvanc(3,i) + da(3)*aaa
275 dxanc(1,i) = dxanc(1,i) + dvanc(1,i)*dt1
276 dxanc(2,i) = dxanc(2,i) + dvanc(2,i)*dt1
277 dxanc(3,i) = dxanc(3,i) + dvanc(3,i)*dt1
278
279 ELSE
280
281 dvanc(1,i) = zero
282 dvanc(2,i) = zero
283 dvanc(3,i) = zero
284 dxanc(1,i) = zero
285 dxanc(2,i) = zero
286 dxanc(3,i) = zero
287
288 ENDIF
289
290 va(1,i) = v(1,ig) + dvanc(1,i)
291 va(2,i) = v(2,ig) + dvanc(2,i)
292 va(3,i) = v(3,ig) + dvanc(3,i)
293 xa(1,i) = x(1,ig) + dxanc(1,i)
294 xa(2,i) = x(2,ig) + dxanc(2,i)
295 xa(3,i) = x(3,ig) + dxanc(3,i)
296
297 END DO
298 END IF
299
300 IF(anim_v(15)+outp_v(15)+h3d_data%N_VECT_DXANC >0.AND.
301 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
302 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))THEN
303 DO i=nlnf,nlnl
304 ig=nlg(i)
305 dxancg(1,ig) = dxanc(1,i)
306 dxancg(2,ig) = dxanc(2,i)
307 dxancg(3,ig) = dxanc(3,i)
308 END DO
309 ENDIF
310C=======================================================================
311C maj pene a verifier !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
312C=======================================================================
313 IF(inacti==5.OR.inacti==6)THEN
314 IF(nspmd > 1 .AND. tt > zero) THEN ! a tt=0. les frontieres ne sont que partiellement baties
315C
316C Partie non parallele smt
317C
318!$OMP SINGLE
319 CALL spmd_get_penis20(nsv,ixlins,penis,penise,penia,nin)
320C Fin Partie non parallele smt
321!$OMP END SINGLE
322 ENDIF
323c a faire ici ou dans I20BUCE_CRIT IF(PENIA(5,I)+... /= ZERO)NACTI=NACTI+1
324 DO i=nlnf,nlnl
325 penia(4,i) = min(penia(4,i),penia(5,i))
326 penia(5,i) = zero
327 ENDDO
328
329 DO i=nsnf,nsnl
330 penis(1,i)=min(penis(1,i),penis(2,i))
331 penis(2,i)=zero
332 ENDDO
333 DO i=nrtmf,nrtml
334 penim(1,i)=min(penim(1,i),penim(2,i))
335 penim(2,i)=zero
336 ENDDO
337
338 DO i=nlinsaf,nlinsal
339 penise(1,i)=min(penise(1,i),penise(2,i))
340 penise(2,i)=zero
341 ENDDO
342 DO i=nlinmaf,nlinmal
343 penime(1,i)=min(penime(1,i),penime(2,i))
344 penime(2,i)=zero
345 ENDDO
346 ENDIF
347C=======================================================================
348C maj pene edges !!!!! deplace
349C=======================================================================
350c IF(INACTI==5.OR.INACTI==6)THEN
351cC
352cC maj PENIS sur partie non locale
353cC
354c IF(NSPMD > 1) THEN
355cC
356cC Partie non parallele smt
357cC
358c!$OMP SINGLE
359c
360c CALL SPMD_GET_PENIS20E(NLINSA,PENIS,NIN)
361c
362cC Fin Partie non parallele smt
363c!$OMP END SINGLE
364c
365c END IF
366c ENDIF
367C=======================================================================
368C maj pene edges fin !!!!! deplace
369C=======================================================================
370C=======================================================================
371C CALCUL CRITERE TRI
372C=======================================================================
373#include "vectorize.inc"
374 DO i=nsnf,nsnl
375 il = nsv(i)
376 IF(stfa(il)/=zero) THEN
377
378 xslv(1)=max(xslv(1),xa(1,il)-xsav(1,i))
379 xslv(2)=max(xslv(2),xa(2,il)-xsav(2,i))
380 xslv(3)=max(xslv(3),xa(3,il)-xsav(3,i))
381 xslv(4)=min(xslv(4),xa(1,il)-xsav(1,i))
382 xslv(5)=min(xslv(5),xa(2,il)-xsav(2,i))
383 xslv(6)=min(xslv(6),xa(3,il)-xsav(3,i))
384C
385 vslv(1)=max(vslv(1),va(1,il))
386 vslv(2)=max(vslv(2),va(2,il))
387 vslv(3)=max(vslv(3),va(3,il))
388 vslv(4)=min(vslv(4),va(1,il))
389 vslv(5)=min(vslv(5),va(2,il))
390 vslv(6)=min(vslv(6),va(3,il))
391
392 ENDIF
393C
394 END DO
395#include "vectorize.inc"
396 DO i=nmnf,nmnl
397 ii = i+nsn
398 il=msr(i)
399 IF(il>0) THEN
400 xmsr(1)=max(xmsr(1),xa(1,il)-xsav(1,ii))
401 xmsr(2)=max(xmsr(2),xa(2,il)-xsav(2,ii))
402 xmsr(3)=max(xmsr(3),xa(3,il)-xsav(3,ii))
403 xmsr(4)=min(xmsr(4),xa(1,il)-xsav(1,ii))
404 xmsr(5)=min(xmsr(5),xa(2,il)-xsav(2,ii))
405 xmsr(6)=min(xmsr(6),xa(3,il)-xsav(3,ii))
406C
407 vmsr(1)=max(vmsr(1),va(1,il))
408 vmsr(2)=max(vmsr(2),va(2,il))
409 vmsr(3)=max(vmsr(3),va(3,il))
410 vmsr(4)=min(vmsr(4),va(1,il))
411 vmsr(5)=min(vmsr(5),va(2,il))
412 vmsr(6)=min(vmsr(6),va(3,il))
413 ENDIF
414 END DO
415C dist calcule une fois pour toutes les interfaces dans SMP_CRIT (ci-dessous) ou SPMD_CRIT
416C
417C EDGES
418C
419 DO i=nsnef,nsnel
420 il=nsve(i)
421C shooting nodes
422 IF(il>0) THEN
423 xslv(1)=max(xslv(1),xa(1,il)-xsave(1,i))
424 xslv(2)=max(xslv(2),xa(2,il)-xsave(2,i))
425 xslv(3)=max(xslv(3),xa(3,il)-xsave(3,i))
426 xslv(4)=min(xslv(4),xa(1,il)-xsave(1,i))
427 xslv(5)=min(xslv(5),xa(2,il)-xsave(2,i))
428 xslv(6)=min(xslv(6),xa(3,il)-xsave(3,i))
429C
430 vslv(1)=max(vslv(1),va(1,il))
431 vslv(2)=max(vslv(2),va(2,il))
432 vslv(3)=max(vslv(3),va(3,il))
433 vslv(4)=min(vslv(4),va(1,il))
434 vslv(5)=min(vslv(5),va(2,il))
435 vslv(6)=min(vslv(6),va(3,il))
436 ENDIF
437 END DO
438 DO i=nmnef,nmnel
439 ii = i+nsne
440 il=msre(i)
441C shooting nodes
442 IF(il>0) THEN
443 xmsr(1)=max(xmsr(1),xa(1,il)-xsave(1,ii))
444 xmsr(2)=max(xmsr(2),xa(2,il)-xsave(2,ii))
445 xmsr(3)=max(xmsr(3),xa(3,il)-xsave(3,ii))
446 xmsr(4)=min(xmsr(4),xa(1,il)-xsave(1,ii))
447 xmsr(5)=min(xmsr(5),xa(2,il)-xsave(2,ii))
448 xmsr(6)=min(xmsr(6),xa(3,il)-xsave(3,ii))
449C
450 vmsr(1)=max(vmsr(1),va(1,il))
451 vmsr(2)=max(vmsr(2),va(2,il))
452 vmsr(3)=max(vmsr(3),va(3,il))
453 vmsr(4)=min(vmsr(4),va(1,il))
454 vmsr(5)=min(vmsr(5),va(2,il))
455 vmsr(6)=min(vmsr(6),va(3,il))
456CDAANC6
457 ENDIF
458 END DO
459
460C
461#include "lockon.inc"
462 xslv_g(1)=max(xslv_g(1),xslv(1))
463 xslv_g(2)=max(xslv_g(2),xslv(2))
464 xslv_g(3)=max(xslv_g(3),xslv(3))
465 xslv_g(4)=min(xslv_g(4),xslv(4))
466 xslv_g(5)=min(xslv_g(5),xslv(5))
467 xslv_g(6)=min(xslv_g(6),xslv(6))
468 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
469 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
470 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
471 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
472 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
473 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
474C
475 vslv_g(1)=max(vslv_g(1),vslv(1))
476 vslv_g(2)=max(vslv_g(2),vslv(2))
477 vslv_g(3)=max(vslv_g(3),vslv(3))
478 vslv_g(4)=min(vslv_g(4),vslv(4))
479 vslv_g(5)=min(vslv_g(5),vslv(5))
480 vslv_g(6)=min(vslv_g(6),vslv(6))
481 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
482 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
483 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
484 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
485 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
486 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
487#include "lockoff.inc"
488
489C
490C=======================================================================
491C STIF
492C=======================================================================
493 IF(nspmd==1) THEN
494C traitement deplace dans SPMD_GET_STIF en SPMD
495 DO i=nlnf,nlnl
496 stfa(i)=max(stfa(i),zero)
497 ENDDO
498C
499 DO i=nlinsaf,nlinsal
500 stfes(i)=max(stfes(i),zero)
501 ENDDO
502 END IF
503C=======================================================================
504C maj pene edges !!!!! deplace
505C=======================================================================
506c IF(INACTI==5.OR.INACTI==6)THEN
507cC
508cC maj PENIS sur partie non locale
509cC
510c IF(NSPMD > 1) THEN
511cC
512cC Partie non parallele smt
513cC
514c!$OMP SINGLE
515c
516c CALL SPMD_GET_PENIS20E(NLINSA,PENIS,NIN)
517c
518cC Fin Partie non parallele smt
519c!$OMP END SINGLE
520c
521c END IF
522c DO I=NLINSAF,NLINSAL
523c PENIS(1,I)=MIN(PENIS(1,I),PENIS(2,I))
524c PENIS(2,I)=ZERO
525c ENDDO
526c DO I=NLINMAF,NLINMAL
527c PENIM(1,I)=MIN(PENIM(1,I),PENIM(2,I))
528c PENIM(2,I)=ZERO
529c ENDDO
530c ENDIF
531C=======================================================================
532C maj pene edges fin !!!!! deplace
533C=======================================================================
534C
535C sur les noeuds frontieres en SPMD, suffit d'initialiser ALPHAKFI a ONE ds i20main_tri/i20xsinir
536 DO i=nlnf,nlnl
537 alphak(1,i)=max(alphak(1,i),alphak(3,i))
538 alphak(1,i)=min(alphak(1,i),abs(alphak(2,i)))
539 alphak(2,i)=one
540 alphak(3,i)=one
541 ENDDO
542C
543 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308
spmd_get_penis20
subroutine spmd_get_penis20(nsv, ixlins, penis, penise, penia, nin)
Definition send_cand.F:2832