OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upd_failwave_sh4n.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_sh4n ../engine/source/materials/fail/failwave/upd_failwave_sh4n.f
25!||--- called by ------------------------------------------------------
26!|| cbaforc3 ../engine/source/elements/shell/coqueba/cbaforc3.F
27!|| cforc3 ../engine/source/elements/shell/coque/cforc3.f
28!|| czforc3 ../engine/source/elements/shell/coquez/czforc3.f
29!||--- uses -----------------------------------------------------
30!|| element_mod ../common_source/modules/elements/element_mod.F90
31!|| failwave_mod ../common_source/modules/failwave_mod.f
32!||====================================================================
33 SUBROUTINE set_failwave_sh4n(FAILWAVE ,FWAVE_EL ,DADV ,
34 . NEL ,IXC ,ITAB ,NGL ,OFFLY )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE failwave_mod
39 use element_mod , only : nixc
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 "comlock.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NEL
53 INTEGER IXC(NIXC,*)
54 INTEGER, DIMENSION(NEL) , INTENT(IN) :: NGL,OFFLY
55 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: ITAB
56 my_real ,DIMENSION(NEL) , INTENT(IN) :: dadv
57 INTEGER, DIMENSION(NEL) , INTENT(OUT) :: FWAVE_EL
58 TYPE (FAILWAVE_STR_) :: FAILWAVE
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,II,K,N1,N2,N3,N4,FOUND,LEVEL,NINDX,NFAIL,FNOD1,FNOD2,
63 . knext,kprev,ncurr
64 INTEGER ,DIMENSION(NEL) :: INDX
65 INTEGER ,DIMENSION(4) :: NDL,NDR,NOD_ID,NOD_NN
66c---
67 DATA ndr/2,3,4,1/
68 DATA ndl/4,1,2,3/
69c-----------------------------------------------
70c set failure flag to elements using nodal frontwave information from neighbors
71C=======================================================================
72c
73c---------------
74 SELECT CASE (failwave%WAVE_MOD)
75c---------------
76 CASE (1) ! isotropic propagation
77c---------------
78 DO i=1,nel
79 IF (offly(i) == 1 .and. dadv(i) == one) THEN
80 n1 = failwave%IDXI(ixc(2,i))
81 n2 = failwave%IDXI(ixc(3,i))
82 n3 = failwave%IDXI(ixc(4,i))
83 n4 = failwave%IDXI(ixc(5,i))
84 nfail = failwave%FWAVE_NOD(1,n1,1)
85 . + failwave%FWAVE_NOD(1,n2,1)
86 . + failwave%FWAVE_NOD(1,n3,1)
87 . + failwave%FWAVE_NOD(1,n4,1)
88 IF (nfail > 0) fwave_el(i) = 1
89 ENDIF
90 ENDDO
91c---------------
92 CASE (2) ! directional propagation through edges only
93c---------------
94 nindx = 0
95 DO i=1,nel
96 IF (offly(i) == 1 .and. dadv(i) == one) THEN
97 nindx = nindx + 1 ! count of non damaged elements
98 indx(nindx) = i
99 ENDIF
100 ENDDO
101c
102 DO ii=1,nindx
103 i = indx(ii)
104 n1 = ixc(2,i)
105 n2 = ixc(3,i)
106 n3 = ixc(4,i)
107 n4 = ixc(5,i)
108 nod_nn(1) = failwave%IDXI(n1)
109 nod_nn(2) = failwave%IDXI(n2)
110 nod_nn(3) = failwave%IDXI(n3)
111 nod_nn(4) = failwave%IDXI(n4)
112 nod_id(1) = itab(n1)
113 nod_id(2) = itab(n2)
114 nod_id(3) = itab(n3)
115 nod_id(4) = itab(n4)
116 found = 0
117c
118 DO k=1,4
119 ncurr = nod_nn(k)
120 IF (failwave%MAXLEV(ncurr) > 0) THEN
121 knext = ndr(k)
122 kprev = ndl(k)
123c
124 DO level = 1,failwave%MAXLEV(ncurr)
125 fnod1 = failwave%FWAVE_NOD(1,ncurr,level)
126 fnod2 = failwave%FWAVE_NOD(2,ncurr,level)
127c
128 IF (fnod1 == nod_id(knext) .and. fnod2 == 0) THEN
129 found = 1
130 fwave_el(i) = 1
131 EXIT
132 ENDIF
133 ENDDO ! level
134 IF (found == 1) EXIT
135 ENDIF
136 ENDDO ! K=1,4
137c
138c IF (FOUND == 1) THEN
139c#include "lockon.inc"
140c write(iout,'(A,I10)')'set failwave flag to element=',ngl(I)
141c#include "lockoff.inc"
142c ENDIF
143c
144 ENDDO ! II=1,NINDX
145c
146c---------------
147 CASE (3) ! directional propagation through edges and diagonals
148c---------------
149c
150 nindx = 0
151 DO i=1,nel
152 IF (offly(i) == 1 .and. dadv(i) == one) THEN
153 nindx = nindx + 1
154 indx(nindx) = i
155 ENDIF
156 ENDDO
157c
158 DO ii=1,nindx
159 i = indx(ii)
160 n1 = ixc(2,i)
161 n2 = ixc(3,i)
162 n3 = ixc(4,i)
163 n4 = ixc(5,i)
164 nod_nn(1) = failwave%IDXI(n1)
165 nod_nn(2) = failwave%IDXI(n2)
166 nod_nn(3) = failwave%IDXI(n3)
167 nod_nn(4) = failwave%IDXI(n4)
168 nod_id(1) = itab(n1)
169 nod_id(2) = itab(n2)
170 nod_id(3) = itab(n3)
171 nod_id(4) = itab(n4)
172 found = 0
173c
174 DO k=1,4
175 ncurr = nod_nn(k)
176 IF (failwave%MAXLEV(ncurr) > 0) THEN
177 knext = ndr(k)
178 kprev = ndl(k)
179c
180 DO level = 1,failwave%MAXLEV(ncurr)
181 fnod1 = failwave%FWAVE_NOD(1,ncurr,level)
182 fnod2 = failwave%FWAVE_NOD(2,ncurr,level)
183c
184 IF (fnod2 == 0 .and.
185 . (fnod1 == nod_id(knext) .or. fnod1 == nod_id(kprev))) THEN
186 found = 1 ! failwave coming by edge
187 EXIT
188 ELSE IF (fnod1 > 0 .and. fnod2 > 0 .and.
189 . fnod1 /= nod_id(kprev) .and. fnod1 /= nod_id(knext) .and.
190 . fnod2 /= nod_id(kprev) .and. fnod2 /= nod_id(knext)) THEN
191 found = 2 ! failwave coming by diagonal
192 EXIT
193 ENDIF
194 ENDDO ! LEVEL
195 IF (found > 0) THEN
196 fwave_el(i) = 1
197 EXIT
198 ENDIF
199c
200 ENDIF
201 ENDDO ! K=1,4
202c
203c IF (FOUND == 1) THEN
204c#include "lockon.inc"
205c write(iout,'(A,I10)') 'set edge failwave to element=',ngl(I)
206c#include "lockoff.inc"
207c ELSE IF (FOUND == 2) THEN
208c#include "lockon.inc"
209c write(iout,'(A,I10)') 'set diag failwave to element=',ngl(I)
210c#include "lockoff.inc"
211c ENDIF
212c
213 ENDDO ! II=1,NINDX
214c---------------
215 END SELECT
216c---------------
217 RETURN
218 END
cforc3
subroutine cforc3(timers, elbuf_str, jft, jlt, pm, ixc, x, f, m, v, vr, failwave, nvc, mtn, geo, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadc, itab, d, dr, tani, offset, eani, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, indxof, ipartc, thke, group_param, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, xedge4n, igrth, msc, dmelc, jsms, table, iparg, ixfem, knod2elc, sensors, elcutc, inod_crk, iel_crk, ibordnode, nodenr, iadc_crk, nodedge, crknodiad, condn, condnsky, stack, isubstack, xfem_str, ig, crkedge, drape_sh4n, ipri, nloc_dmg, indx_drape, igre, jtur, output, dt, snpc, stf, glob_therm, userl_avail, maxfunc, sbufmat, ipart)
Definition cforc3.F:113
my_real
#define my_real
Definition cppsort.cpp:32
czforc3
subroutine czforc3(timers, elbuf_str, jft, jlt, nft, npt, itab, mtn, ipri, ithk, neltst, istrain, ipla, dt1, dt2t, pm, geo, partsav, ixc, ityptst, bufmat, tf, npf, iadc, failwave, x, dr, v, vr, f, m, stifn, stifr, fsky, tani, indxof, ismstr, group_param, ipartc, thke, nvc, iofc, ihbe, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, xedge4n, msc, dmelc, jsms, table, iparg, mat_elem, ixfem, knod2elc, sensors, elcutc, inod_crk, iel_crk, nodenr, iadc_crk, nodedge, crknodiad, condn, condnsky, stack, isubstack, xfem_str, crkedge, drape_sh4n, nel, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
Definition czforc3.F:116
failwave_mod
Definition failwave_mod.F:61
set_failwave_sh4n
subroutine set_failwave_sh4n(failwave, fwave_el, dadv, nel, ixc, itab, ngl, offly)
Definition upd_failwave_sh4n.F:35