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