OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i24buce_crit.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i24buce_crit ../engine/source/interfaces/intsort/i24buce_crit.F
25!||--- called by ------------------------------------------------------
26!|| i24main_crit_tri ../engine/source/interfaces/intsort/i24main_crit_tri.F
27!||====================================================================
28 SUBROUTINE i24buce_crit(
29 1 X ,NSV ,MSR ,NSN ,NMN ,
30 2 ITASK ,XSAV ,NIN ,STFN ,V ,
31 3 XSLV_G ,XMSR_G ,VSLV_G ,VMSR_G ,PENE_OLD,
32 4 GAP_S ,GAPN_M ,DELTA_PMAX_GAP,PMAX_GAP,
33 5 EDGE_L2 ,ISEADD ,ISEDGE ,IEDGE ,DGAP_M ,
34 6 DELTA_PMAX_DGAP , INTPLY ,DELTA_PMAX_GAP_NODE,ITAB )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "comlock.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com01_c.inc"
44#include "com04_c.inc"
45#include "task_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NSN,NMN,ITASK,IEDGE, NIN,
50 . NSV(*),MSR(*),ISEADD(*) ,ISEDGE(*),INTPLY,DELTA_PMAX_GAP_NODE,ITAB(*)
51 my_real
52 . X(3,*), V(3,*), XSAV(3,*), STFN(*),PENE_OLD(5,NSN),
53 . XSLV_G(*),XMSR_G(*), VSLV_G(*), VMSR_G(*),GAP_S(*),GAPN_M(*),
54 . EDGE_L2(*),DELTA_PMAX_GAP,PMAX_GAP,DGAP_M(*),DELTA_PMAX_DGAP
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER NSNF,NMNF,NSNL,NMNL,I, J, K, II, N,IAD,NES,JG,DELTA_PMAX_GAP_NODE_L
59 my_real
60 . XSLV(18),XMSR(12), VSLV(6), VMSR(6),DELTA_PMAX_GAP_L,PMAX_GAP_L,
61 . EDGE_L2_OLD,EDGE_L2_NEW,AAA,DELTA_L
62C-----------------------------------------------
63C S o u r c e L i n e s
64C-----------------------------------------------
65C
66C 0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
67C
68C
69 delta_pmax_gap_l = zero
70 pmax_gap_l = zero
71 delta_pmax_gap_node_l=0
72
73 xslv(1) = -ep30
74 xslv(2) = -ep30
75 xslv(3) = -ep30
76 xslv(4) = ep30
77 xslv(5) = ep30
78 xslv(6) = ep30
79
80c XSLV(7) = -EP30
81c XSLV(8) = -EP30
82c XSLV(9) = -EP30
83c XSLV(10)= EP30
84c XSLV(11)= EP30
85c XSLV(12)= EP30
86
87c XSLV(13) = -EP30
88c XSLV(14) = -EP30
89c XSLV(15) = -EP30
90c XSLV(16)= EP30
91c XSLV(17)= EP30
92c XSLV(18)= EP30
93
94 xmsr(1) = -ep30
95 xmsr(2) = -ep30
96 xmsr(3) = -ep30
97 xmsr(4) = ep30
98 xmsr(5) = ep30
99 xmsr(6) = ep30
100
101c XMSR(7) = -EP30
102c XMSR(8) = -EP30
103c XMSR(9) = -EP30
104c XMSR(10)= EP30
105c XMSR(11)= EP30
106c XMSR(12)= EP30
107
108 vslv(1) = -ep30
109 vslv(2) = -ep30
110 vslv(3) = -ep30
111 vslv(4) = ep30
112 vslv(5) = ep30
113 vslv(6) = ep30
114
115 vmsr(1) = -ep30
116 vmsr(2) = -ep30
117 vmsr(3) = -ep30
118 vmsr(4) = ep30
119 vmsr(5) = ep30
120 vmsr(6) = ep30
121
122 nsnf = 1 + itask*nsn / nthread
123 nsnl = (itask+1)*nsn / nthread
124 nmnf = 1 + itask*nmn / nthread
125 nmnl = (itask+1)*nmn / nthread
126
127C=======================================================================
128 IF(nsn+nmn < numnod)THEN
129C
130#include "vectorize.inc"
131 DO i=nsnf,nsnl
132 j=nsv(i)
133 IF(stfn(i)/=zero .AND. j<=numnod) THEN
134
135 edge_l2_new = zero
136 edge_l2_old = zero
137 IF(iedge/=0)THEN
138c compute secnd edge half size
139 iad = iseadd(i)
140 nes = isedge(iad)
141 IF(nes/=0)THEN
142 DO k=1,nes
143 jg = isedge(iad+k)
144 aaa = (x(1,jg)-x(1,j))*(x(1,jg)-x(1,j))
145 . + (x(2,jg)-x(2,j))*(x(2,jg)-x(2,j))
146 . + (x(3,jg)-x(3,j))*(x(3,jg)-x(3,j))
147 edge_l2_new = max(edge_l2_new, aaa )
148 ENDDO
149 edge_l2_new = (half+em3)*sqrt(edge_l2_new)
150 edge_l2_old = edge_l2(i)
151 ENDIF
152 edge_l2(i) = edge_l2_new
153 ENDIF
154
155 delta_l=max(pene_old(3,i),edge_l2_new)
156 . -max(pene_old(4,i),edge_l2_old)
157
158 IF(delta_l > delta_pmax_gap_l) THEN
159 delta_pmax_gap_node_l = j
160 delta_pmax_gap_l = delta_l
161 ENDIF
162
163c DELTA_PMAX_GAP_L = MAX(DELTA_PMAX_GAP_L,
164c . MAX(PENE_OLD(3,I),EDGE_L2_NEW)
165c . -MAX(PENE_OLD(4,I),EDGE_L2_OLD) )
166c
167c a verifier en SPMD !!!!!!!!!!!!!!!!!!!
168 pmax_gap_l = max(pmax_gap_l,edge_l2_new)
169
170 xslv(1) =max(xslv(1),x(1,j)-xsav(1,i))
171 xslv(2) =max(xslv(2),x(2,j)-xsav(2,i))
172 xslv(3) =max(xslv(3),x(3,j)-xsav(3,i))
173 xslv(4) =min(xslv(4),x(1,j)-xsav(1,i))
174 xslv(5) =min(xslv(5),x(2,j)-xsav(2,i))
175 xslv(6) =min(xslv(6),x(3,j)-xsav(3,i))
176
177c XSLV(7) =MAX(XSLV(7) ,X(1,J)-XSAV(1,I)+GAP_S(I))
178c XSLV(8) =MAX(XSLV(8) ,X(2,J)-XSAV(2,I)+GAP_S(I))
179c XSLV(9) =MAX(XSLV(9) ,X(3,J)-XSAV(3,I)+GAP_S(I))
180c XSLV(10)=MIN(XSLV(10),X(1,J)-XSAV(1,I)-GAP_S(I))
181c XSLV(11)=MIN(XSLV(11),X(2,J)-XSAV(2,I)-GAP_S(I))
182c XSLV(12)=MIN(XSLV(12),X(3,J)-XSAV(3,I)-GAP_S(I))
183
184c XSLV(13)=MAX(XSLV(13),X(1,J)-XSAV(1,I)+PENE_OLD(3,I))
185c XSLV(14)=MAX(XSLV(14),X(2,J)-XSAV(2,I)+PENE_OLD(3,I))
186c XSLV(15)=MAX(XSLV(15),X(3,J)-XSAV(3,I)+PENE_OLD(3,I))
187c XSLV(16)=MIN(XSLV(16),X(1,J)-XSAV(1,I)-PENE_OLD(3,I))
188c XSLV(17)=MIN(XSLV(17),X(2,J)-XSAV(2,I)-PENE_OLD(3,I))
189c XSLV(18)=MIN(XSLV(18),X(3,J)-XSAV(3,I)-PENE_OLD(3,I))
190
191 vslv(1)=max(vslv(1),v(1,j))
192 vslv(2)=max(vslv(2),v(2,j))
193 vslv(3)=max(vslv(3),v(3,j))
194 vslv(4)=min(vslv(4),v(1,j))
195 vslv(5)=min(vslv(5),v(2,j))
196 vslv(6)=min(vslv(6),v(3,j))
197 ENDIF
198 END DO
199#include "vectorize.inc"
200 DO i=nmnf,nmnl
201 ii = i+nsn
202 j=msr(i)
203 IF(j>0) THEN
204
205 xmsr(1) =max(xmsr(1),x(1,j)-xsav(1,ii))
206 xmsr(2) =max(xmsr(2),x(2,j)-xsav(2,ii))
207 xmsr(3) =max(xmsr(3),x(3,j)-xsav(3,ii))
208 xmsr(4) =min(xmsr(4),x(1,j)-xsav(1,ii))
209 xmsr(5) =min(xmsr(5),x(2,j)-xsav(2,ii))
210 xmsr(6) =min(xmsr(6),x(3,j)-xsav(3,ii))
211
212c XMSR(7) =MAX(XMSR(7) ,X(1,J)-XSAV(1,II)+GAPN_M(I))
213c XMSR(8) =MAX(XMSR(8) ,X(2,J)-XSAV(2,II)+GAPN_M(I))
214c XMSR(9) =MAX(XMSR(9) ,X(3,J)-XSAV(3,II)+GAPN_M(I))
215c XMSR(10)=MIN(XMSR(10),X(1,J)-XSAV(1,II)-GAPN_M(I))
216c XMSR(11)=MIN(XMSR(11),X(2,J)-XSAV(2,II)-GAPN_M(I))
217c XMSR(12)=MIN(XMSR(12),X(3,J)-XSAV(3,II)-GAPN_M(I))
218
219 vmsr(1)=max(vmsr(1),v(1,j))
220 vmsr(2)=max(vmsr(2),v(2,j))
221 vmsr(3)=max(vmsr(3),v(3,j))
222 vmsr(4)=min(vmsr(4),v(1,j))
223 vmsr(5)=min(vmsr(5),v(2,j))
224 vmsr(6)=min(vmsr(6),v(3,j))
225 ENDIF
226 END DO
227 ELSE
228C
229#include "vectorize.inc"
230 DO i=nsnf,nsnl
231 j=nsv(i)
232 IF(stfn(i)/=zero .AND. j<=numnod) THEN
233
234 edge_l2_new = zero
235 edge_l2_old = zero
236 IF(iedge/=0)THEN
237c compute secnd edge half size
238 iad = iseadd(i)
239 nes = isedge(iad)
240 IF(nes/=0)THEN
241 DO k=1,nes
242 jg = isedge(iad+k)
243 aaa = (x(1,jg)-x(1,j))*(x(1,jg)-x(1,j))
244 . + (x(2,jg)-x(2,j))*(x(2,jg)-x(2,j))
245 . + (x(3,jg)-x(3,j))*(x(3,jg)-x(3,j))
246 edge_l2_new = max(edge_l2_new, aaa )
247 ENDDO
248 edge_l2_new = (half+em3)*sqrt(edge_l2_new)
249 edge_l2_old = edge_l2(i)
250 ENDIF
251 edge_l2(i) = edge_l2_new
252 ENDIF
253
254 delta_l=max(pene_old(3,i),edge_l2_new)
255 . -max(pene_old(4,i),edge_l2_old)
256 IF(delta_l > delta_pmax_gap_l) THEN
257 delta_pmax_gap_node_l = j
258 delta_pmax_gap_l = delta_l
259 ENDIF
260
261c DELTA_PMAX_GAP_L = MAX(DELTA_PMAX_GAP_L,
262c . MAX(PENE_OLD(3,I),EDGE_L2_NEW)
263c . -MAX(PENE_OLD(4,I),EDGE_L2_OLD) )
264
265c a verifier en SPMD !!!!!!!!!!!!!!!!!!!
266 pmax_gap_l = max(pmax_gap_l,edge_l2_new)
267
268 xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
269 xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
270 xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
271 xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
272 xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
273 xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
274
275c XSLV(7) =MAX(XSLV(7) ,X(1,J)-XSAV(1,J)+GAP_S(I))
276c XSLV(8) =MAX(XSLV(8) ,X(2,J)-XSAV(2,J)+GAP_S(I))
277c XSLV(9) =MAX(XSLV(9) ,X(3,J)-XSAV(3,J)+GAP_S(I))
278c XSLV(10)=MIN(XSLV(10),X(1,J)-XSAV(1,J)-GAP_S(I))
279c XSLV(11)=MIN(XSLV(11),X(2,J)-XSAV(2,J)-GAP_S(I))
280c XSLV(12)=MIN(XSLV(12),X(3,J)-XSAV(3,J)-GAP_S(I))
281
282c XSLV(13)=MAX(XSLV(13),X(1,J)-XSAV(1,J)+PENE_OLD(3,I))
283c XSLV(14)=MAX(XSLV(14),X(2,J)-XSAV(2,J)+PENE_OLD(3,I))
284c XSLV(15)=MAX(XSLV(15),X(3,J)-XSAV(3,J)+PENE_OLD(3,I))
285c XSLV(16)=MIN(XSLV(16),X(1,J)-XSAV(1,J)-PENE_OLD(3,I))
286c XSLV(17)=MIN(XSLV(17),X(2,J)-XSAV(2,J)-PENE_OLD(3,I))
287c XSLV(18)=MIN(XSLV(18),X(3,J)-XSAV(3,J)-PENE_OLD(3,I))
288
289 vslv(1)=max(vslv(1),v(1,j))
290 vslv(2)=max(vslv(2),v(2,j))
291 vslv(3)=max(vslv(3),v(3,j))
292 vslv(4)=min(vslv(4),v(1,j))
293 vslv(5)=min(vslv(5),v(2,j))
294 vslv(6)=min(vslv(6),v(3,j))
295C
296
297 ENDIF
298 END DO
299#include "vectorize.inc"
300 DO i=nmnf,nmnl
301 j=msr(i)
302 IF(j>0) THEN
303
304 xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
305 xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
306 xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
307 xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
308 xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
309 xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
310
311c XMSR(7) =MAX(XMSR(7) ,X(1,J)-XSAV(1,J)+GAPN_M(I))
312c XMSR(8) =MAX(XMSR(8) ,X(2,J)-XSAV(2,J)+GAPN_M(I))
313c XMSR(9) =MAX(XMSR(9) ,X(3,J)-XSAV(3,J)+GAPN_M(I))
314c XMSR(10)=MIN(XMSR(10),X(1,J)-XSAV(1,J)-GAPN_M(I))
315c XMSR(11)=MIN(XMSR(11),X(2,J)-XSAV(2,J)-GAPN_M(I))
316c XMSR(12)=MIN(XMSR(12),X(3,J)-XSAV(3,J)-GAPN_M(I))
317
318 vmsr(1)=max(vmsr(1),v(1,j))
319 vmsr(2)=max(vmsr(2),v(2,j))
320 vmsr(3)=max(vmsr(3),v(3,j))
321 vmsr(4)=min(vmsr(4),v(1,j))
322 vmsr(5)=min(vmsr(5),v(2,j))
323 vmsr(6)=min(vmsr(6),v(3,j))
324 ENDIF
325 ENDDO
326 ENDIF
327C dist calcule une fois pour toutes les interfaces dans COMCRIT (ci-dessous)
328C
329 IF(nspmd==1) THEN
330C traitement deplace dans SPMD_GET_STIF en SPMD
331 DO i=nsnf,nsnl
332 stfn(i)=max(stfn(i),zero)
333 ENDDO
334 ENDIF
335C
336#include "lockon.inc"
337C
338 IF(delta_pmax_gap_l > delta_pmax_gap)THEN
339 delta_pmax_gap=delta_pmax_gap_l
340 delta_pmax_gap_node=itab(delta_pmax_gap_node_l)
341 ENDIF
342C
343c DELTA_PMAX_GAP = MAX(DELTA_PMAX_GAP,DELTA_PMAX_GAP_L)
344
345 IF(intply > 0) delta_pmax_gap = delta_pmax_gap + delta_pmax_dgap
346C
347 pmax_gap = max(pmax_gap,pmax_gap_l)
348
349 xslv_g(1)=max(xslv_g(1),xslv(1))
350 xslv_g(2)=max(xslv_g(2),xslv(2))
351 xslv_g(3)=max(xslv_g(3),xslv(3))
352 xslv_g(4)=min(xslv_g(4),xslv(4))
353 xslv_g(5)=min(xslv_g(5),xslv(5))
354 xslv_g(6)=min(xslv_g(6),xslv(6))
355
356c XSLV_G(7) =MAX(XSLV_G(7) ,XSLV(7) )
357c XSLV_G(8) =MAX(XSLV_G(8) ,XSLV(8) )
358c XSLV_G(9) =MAX(XSLV_G(9) ,XSLV(9) )
359c XSLV_G(10)=MIN(XSLV_G(10),XSLV(10))
360c XSLV_G(11)=MIN(XSLV_G(11),XSLV(11))
361c XSLV_G(12)=MIN(XSLV_G(12),XSLV(12))
362
363c XSLV_G(13)=MAX(XSLV_G(13),XSLV(7) )
364c XSLV_G(14)=MAX(XSLV_G(14),XSLV(8) )
365c XSLV_G(15)=MAX(XSLV_G(15),XSLV(9) )
366c XSLV_G(16)=MIN(XSLV_G(16),XSLV(10))
367c XSLV_G(17)=MIN(XSLV_G(17),XSLV(11))
368c XSLV_G(18)=MIN(XSLV_G(18),XSLV(12))
369
370 xmsr_g(1)=max(xmsr_g(1),xmsr(1))
371 xmsr_g(2)=max(xmsr_g(2),xmsr(2))
372 xmsr_g(3)=max(xmsr_g(3),xmsr(3))
373 xmsr_g(4)=min(xmsr_g(4),xmsr(4))
374 xmsr_g(5)=min(xmsr_g(5),xmsr(5))
375 xmsr_g(6)=min(xmsr_g(6),xmsr(6))
376
377c XMSR_G(7) =MAX(XMSR_G(7) ,XMSR(7) )
378c XMSR_G(8) =MAX(XMSR_G(8) ,XMSR(8) )
379c XMSR_G(9) =MAX(XMSR_G(9) ,XMSR(9) )
380c XMSR_G(10)=MIN(XMSR_G(10),XMSR(10))
381c XMSR_G(11)=MIN(XMSR_G(11),XMSR(11))
382c XMSR_G(12)=MIN(XMSR_G(12),XMSR(12))
383
384 vslv_g(1)=max(vslv_g(1),vslv(1))
385 vslv_g(2)=max(vslv_g(2),vslv(2))
386 vslv_g(3)=max(vslv_g(3),vslv(3))
387 vslv_g(4)=min(vslv_g(4),vslv(4))
388 vslv_g(5)=min(vslv_g(5),vslv(5))
389 vslv_g(6)=min(vslv_g(6),vslv(6))
390 vmsr_g(1)=max(vmsr_g(1),vmsr(1))
391 vmsr_g(2)=max(vmsr_g(2),vmsr(2))
392 vmsr_g(3)=max(vmsr_g(3),vmsr(3))
393 vmsr_g(4)=min(vmsr_g(4),vmsr(4))
394 vmsr_g(5)=min(vmsr_g(5),vmsr(5))
395 vmsr_g(6)=min(vmsr_g(6),vmsr(6))
396C
397#include "lockoff.inc"
398C
399 RETURN
400 END
401C
i24buce_crit
subroutine i24buce_crit(x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g, pene_old, gap_s, gapn_m, delta_pmax_gap, pmax_gap, edge_l2, iseadd, isedge, iedge, dgap_m, delta_pmax_dgap, intply, delta_pmax_gap_node, itab)
Definition i24buce_crit.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21