OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
set_failwave_nod3.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!|| set_failwave_nod3 ../engine/source/materials/fail/failwave/set_failwave_nod3.F
25!||--- called by ------------------------------------------------------
26!|| c3forc3 ../engine/source/elements/sh3n/coque3n/c3forc3.F
27!|| cdkforc3 ../engine/source/elements/sh3n/coquedk/cdkforc3.F
28!||--- calls -----------------------------------------------------
29!|| seg_intersect ../engine/source/materials/fail/failwave/seg_intersect.F
30!||--- uses -----------------------------------------------------
31!|| failwave_mod ../common_source/modules/failwave_mod.F
32!||====================================================================
33 SUBROUTINE set_failwave_nod3(FAILWAVE ,FWAVE_EL ,NGL ,
34 . NEL ,IXTG ,ITAB ,CRKDIR ,DIR_A ,
35 . NROT ,XL2 ,XL3 ,YL2 ,YL3 )
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE failwave_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "com04_c.inc"
48#include "units_c.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NEL,NROT
54 INTEGER ,DIMENSION(NIXTG,NEL),INTENT(IN) :: IXTG
55 INTEGER ,DIMENSION(NUMNOD) ,INTENT(IN) :: ITAB
56 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL,FWAVE_EL
57C
58 my_real ,DIMENSION(NEL,NROT) ,INTENT(IN) :: dir_a
59 my_real ,DIMENSION(NEL,2) ,INTENT(IN) :: crkdir
60 my_real ,DIMENSION(NEL) ,INTENT(IN) :: xl2,xl3,yl2,yl3
61 TYPE (FAILWAVE_STR_) :: FAILWAVE
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,II,K,N1,N2,N3,INTERSECTION,INT1,INT2,INT3,INT4,INT5,INT6,
66 . LEVEL,NEWCRK1,NEWCRK2,
67 . ncurr,maxlev,found_existing,idebug
68 INTEGER ,DIMENSION(NEL) :: INDX1,INDX2
69 INTEGER ,DIMENSION(3) :: IDF1,IDF2,NOD_ID,NOD_NN
70C
71 my_real :: dx1,dx2,dy1,dy2,dir11,dir22,cosx,sinx,cosy,siny,
72 . lmax,xm,ym,x1,y1,x2,y2,x3,y3,x4,y4,x5,y5,x6,y6,xint,yint,
73 . rx,ry,rat1,rat2
74 INTEGER SEG_INTERSECT
75 EXTERNAL SEG_INTERSECT
76c-----------------------------------------------
77c damaged elements will set nodal frontwave values to propagate crack info
78C=======================================================================
79 idebug = 0
80c
81c---------------
82 SELECT CASE (failwave%WAVE_MOD)
83c---------------
84 CASE (1) ! isotropic propagation
85c---------------
86 DO i=1,nel
87 IF (fwave_el(i) < 0) THEN
88 n1 = failwave%IDXI(ixtg(2,i))
89 n2 = failwave%IDXI(ixtg(3,i))
90 n3 = failwave%IDXI(ixtg(4,i))
91 failwave%FWAVE_NOD_STACK(1,n1,1) = 1
92 failwave%FWAVE_NOD_STACK(1,n2,1) = 1
93 failwave%FWAVE_NOD_STACK(1,n3,1) = 1
94 failwave%MAXLEV_STACK(n1) = 1
95 failwave%MAXLEV_STACK(n2) = 1
96 failwave%MAXLEV_STACK(n3) = 1
97 ENDIF
98 ENDDO
99c---------------
100 CASE (2,3) ! directional propagation
101c---------------
102 newcrk1 = 0
103 newcrk2 = 0
104 DO i=1,nel
105 IF (fwave_el(i) == -1) THEN ! DIR 1 vient de cracker
106 newcrk1 = newcrk1 + 1
107 indx1(newcrk1) = i
108 ELSEIF (fwave_el(i) == -2) THEN ! DIR 2 vient de cracker
109 newcrk2 = newcrk2 + 1
110 indx2(newcrk2) = i
111 ELSEIF (fwave_el(i) == -3) THEN ! deux directions viennent de cracker
112 newcrk1 = newcrk1 + 1
113 newcrk2 = newcrk2 + 1
114 indx1(newcrk1) = i
115 indx2(newcrk2) = i
116 ENDIF
117 ENDDO
118c
119 IF (newcrk1 + newcrk2 > 0) THEN
120c
121 rat1 = half * tan(pi/six)
122 rat2 = one - rat1
123c------------------------------------------------
124c Propagation in first direction
125c------------------------------------------------
126 DO ii=1,newcrk1
127 i = indx1(ii)
128 n1 = ixtg(2,i)
129 n2 = ixtg(3,i)
130 n3 = ixtg(4,i)
131 nod_nn(1) = failwave%IDXI(n1)
132 nod_nn(2) = failwave%IDXI(n2)
133 nod_nn(3) = failwave%IDXI(n3)
134 nod_id(1) = itab(n1)
135 nod_id(2) = itab(n2)
136 nod_id(3) = itab(n3)
137 idf1(:) = 0
138 idf2(:) = 0
139c
140 idebug = 0
141c if (NGL(I) == 15607559) IDEBUG= 1
142
143 IF (nrot == 0) THEN
144 dir11 = -crkdir(i,2)
145 dir22 = crkdir(i,1)
146 ELSE
147 cosx = dir_a(i,1)
148 sinx = dir_a(i,2)
149 cosy =-crkdir(i,2)
150 siny = crkdir(i,1)
151 dir11 = cosx*cosy - sinx*siny
152 dir22 = cosx*siny + sinx*cosy
153 ENDIF
154c
155 xm = (xl2(i) + xl3(i)) * third
156 ym = (yl2(i) + yl3(i)) * third
157 lmax = max(xl2(i)*2 + yl2(i)**2, xl3(i)**2 + yl3(i))
158 lmax = sqrt(lmax) * two
159c
160 dx1 = xm - dir11 * lmax
161 dy1 = ym - dir22 * lmax
162 dx2 = xm + dir11 * lmax
163 dy2 = ym + dir22 * lmax
164c
165 x1 = xl2(i)*rat1
166 y1 = yl2(i)*rat1
167 x2 = xl2(i)*rat2
168 y2 = yl2(i)*rat2
169 rx = xl3(i) - xl2(i)
170 ry = yl3(i) - yl2(i)
171 x3 = xl2(i) + rx * rat1
172 y3 = yl2(i) + ry * rat1
173 x4 = xl2(i) + rx * rat2
174 y4 = yl2(i) + ry * rat2
175 rx =-xl3(i)
176 ry =-yl3(i)
177 x5 = xl3(i) + rx * rat1
178 y5 = yl3(i) + ry * rat1
179 x6 = xl3(i) + rx * rat2
180 y6 = yl3(i) + ry * rat2
181c
182 int1 = seg_intersect(x6,y6,x1,y1,dx1,dy1,dx2,dy2,xint,yint,idebug)
183 int2 = seg_intersect(x2,y2,x3,y3,dx1,dy1,dx2,dy2,xint,yint,idebug)
184 int3 = seg_intersect(x4,y4,x5,y5,dx1,dy1,dx2,dy2,xint,yint,idebug)
185 int4 = seg_intersect(x1,y1,x2,y2,dx1,dy1,dx2,dy2,xint,yint,idebug)
186 int5 = seg_intersect(x3,y3,x4,y4,dx1,dy1,dx2,dy2,xint,yint,idebug)
187 int6 = seg_intersect(x5,y5,x6,y6,dx1,dy1,dx2,dy2,xint,yint,idebug)
188c
189 intersection = 0
190 IF (int1 == 1) THEN ! N1 + N2-N3
191 idf1(1) = nod_id(3)
192 idf2(1) = nod_id(2)
193 idf1(2) = nod_id(3)
194 idf1(3) = nod_id(2)
195 intersection = 1
196 ELSE IF (int2 == 1) THEN ! N2 + N3-N1
197 idf1(1) = nod_id(3)
198 idf1(3) = nod_id(1)
199 idf1(2) = nod_id(1)
200 idf2(2) = nod_id(3)
201 intersection = 1
202 ELSE IF (int3 == 1) THEN ! N3 + N1-N2
203 idf1(1) = nod_id(2)
204 idf1(2) = nod_id(1)
205 idf1(3) = nod_id(2)
206 idf2(3) = nod_id(1)
207 intersection = 1
208 ELSE IF (int4 == 1) THEN ! N3 + N1-N2
209 idf1(1) = nod_id(2)
210 idf1(2) = nod_id(1)
211 idf1(3) = nod_id(2)
212 idf2(3) = nod_id(1)
213 intersection = 1
214 ELSE IF (int5 == 1) THEN ! N1 + N2-N3
215 idf1(1) = nod_id(3)
216 idf2(1) = nod_id(2)
217 idf1(2) = nod_id(3)
218 idf1(3) = nod_id(2)
219 intersection = 1
220 ELSE IF (int6 == 1) THEN ! N2 + N3-N1
221 idf1(1) = nod_id(3)
222 idf1(3) = nod_id(1)
223 idf1(2) = nod_id(1)
224 idf2(2) = nod_id(3)
225 intersection = 1
226 END IF
227c
228 IF (intersection == 1) THEN
229 DO k=1,3
230 ncurr = nod_nn(k)
231c--------------------------------------------------------------------
232!$OMP ATOMIC CAPTURE
233 failwave%MAXLEV_STACK(ncurr) = failwave%MAXLEV_STACK(ncurr) + 1
234 maxlev = failwave%MAXLEV_STACK(ncurr)
235!$OMP END ATOMIC
236c--------------------------------------------------------------------
237 IF (maxlev > failwave%SIZE) THEN
238#include "lockon.inc"
239 WRITE(iout,*) 'ERROR IN FAILWAVE PROPAGATION: ELEMENT =',ngl(i),
240 . 'LEVEL=',maxlev
241#include "lockoff.inc"
242 maxlev = failwave%SIZE
243 failwave%MAXLEV_STACK(ncurr) = maxlev
244 ENDIF
245 failwave%FWAVE_NOD_STACK(1,ncurr,maxlev) = idf1(k)
246 failwave%FWAVE_NOD_STACK(2,ncurr,maxlev) = idf2(k)
247 END DO ! K=1,3
248
249 ELSE ! NO intersection found
250c
251#include "lockon.inc"
252 WRITE(iout,*) 'ERROR ADVANCING CRACK IN ELEMENT, 1st DIR ',ngl(i)
253#include "lockoff.inc"
254 ENDIF
255c
256 ENDDO ! NEWCRK1
257c--------------------------------------
258c Propagation in second direction
259c--------------------------------------
260 DO ii=1,newcrk2
261 i = indx2(ii)
262 n1 = ixtg(2,i)
263 n2 = ixtg(3,i)
264 n3 = ixtg(4,i)
265 nod_nn(1) = failwave%IDXI(n1)
266 nod_nn(2) = failwave%IDXI(n2)
267 nod_nn(3) = failwave%IDXI(n3)
268 nod_id(1) = itab(n1)
269 nod_id(2) = itab(n2)
270 nod_id(3) = itab(n3)
271 idf1(:) = 0
272 idf2(:) = 0
273c
274 IF (nrot == 0) THEN
275 dir11 = crkdir(i,1)
276 dir22 = crkdir(i,2)
277 ELSE
278 cosx = dir_a(i,1)
279 sinx = dir_a(i,2)
280 cosy = crkdir(i,1)
281 siny = crkdir(i,2)
282 dir11 = cosx*cosy - sinx*siny
283 dir22 = cosx*siny + sinx*cosy
284 ENDIF
285c
286 xm = (xl2(i) + xl3(i)) * third
287 ym = (yl2(i) + yl3(i)) * third
288 lmax = max(xl2(i)*2 + yl2(i)**2, xl3(i)**2 + yl3(i))
289 lmax = sqrt(lmax) * two
290c
291 dx1 = xm - dir11 * lmax
292 dy1 = ym - dir22 * lmax
293 dx2 = xm + dir11 * lmax
294 dy2 = ym + dir22 * lmax
295c
296 x1 = xl2(i)*rat1
297 y1 = yl2(i)*rat1
298 x2 = xl2(i)*rat2
299 y2 = yl2(i)*rat2
300 rx = xl3(i) - xl2(i)
301 ry = yl3(i) - yl2(i)
302 x3 = xl2(i) + rx * rat1
303 y3 = yl2(i) + ry * rat1
304 x4 = xl2(i) + rx * rat2
305 y4 = yl2(i) + ry * rat2
306 rx =-xl3(i)
307 ry =-yl3(i)
308 x5 = xl3(i) + rx * rat1
309 y5 = yl3(i) + ry * rat1
310 x6 = xl3(i) + rx * rat2
311 y6 = yl3(i) + ry * rat2
312c
313 int1 = seg_intersect(x6,y6,x1,y1,dx1,dy1,dx2,dy2,xint,yint,idebug)
314 int2 = seg_intersect(x2,y2,x3,y3,dx1,dy1,dx2,dy2,xint,yint,idebug)
315 int3 = seg_intersect(x4,y4,x5,y5,dx1,dy1,dx2,dy2,xint,yint,idebug)
316 int4 = seg_intersect(x1,y1,x2,y2,dx1,dy1,dx2,dy2,xint,yint,idebug)
317 int5 = seg_intersect(x3,y3,x4,y4,dx1,dy1,dx2,dy2,xint,yint,idebug)
318 int6 = seg_intersect(x5,y5,x6,y6,dx1,dy1,dx2,dy2,xint,yint,idebug)
319c
320 intersection = 0
321 IF (int1 == 1) THEN ! N1 + N2-N3
322 idf1(1) = nod_id(3)
323 idf2(1) = nod_id(2)
324 idf1(2) = nod_id(3)
325 idf1(3) = nod_id(2)
326 intersection = 1
327 ELSE IF (int2 == 1) THEN ! N2 + N3-N1
328 idf1(1) = nod_id(3)
329 idf1(3) = nod_id(1)
330 idf1(2) = nod_id(1)
331 idf2(2) = nod_id(3)
332 intersection = 1
333 ELSE IF (int3 == 1) THEN ! N3 + N1-N2
334 idf1(1) = nod_id(2)
335 idf1(2) = nod_id(1)
336 idf1(3) = nod_id(2)
337 idf2(3) = nod_id(1)
338 intersection = 1
339 ELSE IF (int4 == 1) THEN ! N3 + N1-N2
340 idf1(1) = nod_id(2)
341 idf1(2) = nod_id(1)
342 idf1(3) = nod_id(2)
343 idf2(3) = nod_id(1)
344 intersection = 1
345 ELSE IF (int5 == 1) THEN ! N1 + N2-N3
346 idf1(1) = nod_id(3)
347 idf2(1) = nod_id(2)
348 idf1(2) = nod_id(3)
349 idf1(3) = nod_id(2)
350 intersection = 1
351 ELSE IF (int6 == 1) THEN ! N2 + N3-N1
352 idf1(1) = nod_id(3)
353 idf1(3) = nod_id(1)
354 idf1(2) = nod_id(1)
355 idf2(2) = nod_id(3)
356 intersection = 1
357 END IF
358c
359 IF (intersection == 1) THEN
360 DO k=1,3
361 ncurr = nod_nn(k)
362c--------------------------------------------------------------------
363!$OMP ATOMIC CAPTURE
364 failwave%MAXLEV_STACK(ncurr) = failwave%MAXLEV_STACK(ncurr) + 1
365 maxlev = failwave%MAXLEV_STACK(ncurr)
366!$OMP END ATOMIC
367c--------------------------------------------------------------------
368 IF (maxlev > failwave%SIZE) THEN
369#include "lockon.inc"
370 WRITE(iout,*) 'ERROR IN FAILWAVE PROPAGATION: ELEMENT =',ngl(i),
371 . 'LEVEL=',maxlev
372#include "lockoff.inc"
373 maxlev = failwave%SIZE
374 failwave%MAXLEV_STACK(ncurr) = maxlev
375 ENDIF
376 failwave%FWAVE_NOD_STACK(1,ncurr,maxlev) = idf1(k)
377 failwave%FWAVE_NOD_STACK(2,ncurr,maxlev) = idf2(k)
378 END DO ! k=1,3
379
380 ELSE ! NO intersection found
381c
382#include "lockon.inc"
383 WRITE(iout,*) 'error advancing crack in element, 2nd dir ',NGL(I)
384#include "lockoff.inc"
385 ENDIF
386c
387 ENDDO ! NEWCRK2
388 END IF ! NEWCRK1 + NEWCRK2 > 0
389c
390c---------------
391 END SELECT
392c---------------
393 RETURN
394 END
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
failwave_mod
Definition failwave_mod.F:61
set_failwave_nod3
subroutine set_failwave_nod3(failwave, fwave_el, ngl, nel, ixtg, itab, crkdir, dir_a, nrot, xl2, xl3, yl2, yl3)
Definition set_failwave_nod3.F:36