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