OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
upd_failwave_sh4n.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine set_failwave_sh4n (failwave, fwave_el, dadv, nel, ixc, itab, ngl, offly)

Function/Subroutine Documentation

◆ set_failwave_sh4n()

subroutine set_failwave_sh4n ( type (failwave_str_) failwave,
integer, dimension(nel), intent(out) fwave_el,
intent(in) dadv,
integer nel,
integer, dimension(nixc,*) ixc,
integer, dimension(numnod), intent(in) itab,
integer, dimension(nel), intent(in) ngl,
integer, dimension(nel), intent(in) offly )

Definition at line 32 of file upd_failwave_sh4n.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE failwave_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NEL
51 INTEGER IXC(NIXC,*)
52 INTEGER, DIMENSION(NEL) , INTENT(IN) :: NGL,OFFLY
53 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: ITAB
54 my_real ,DIMENSION(NEL) , INTENT(IN) :: dadv
55 INTEGER, DIMENSION(NEL) , INTENT(OUT) :: FWAVE_EL
56 TYPE (FAILWAVE_STR_) :: FAILWAVE
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,II,K,N1,N2,N3,N4,FOUND,LEVEL,NINDX,NFAIL,FNOD1,FNOD2,
61 . KNEXT,KPREV,NCURR
62 INTEGER ,DIMENSION(NEL) :: INDX
63 INTEGER ,DIMENSION(4) :: NDL,NDR,NOD_ID,NOD_NN
64c---
65 DATA ndr/2,3,4,1/
66 DATA ndl/4,1,2,3/
67c-----------------------------------------------
68c set failure flag to elements using nodal frontwave information from neighbors
69C=======================================================================
70c
71c---------------
72 SELECT CASE (failwave%WAVE_MOD)
73c---------------
74 CASE (1) ! isotropic propagation
75c---------------
76 DO i=1,nel
77 IF (offly(i) == 1 .and. dadv(i) == one) THEN
78 n1 = failwave%IDXI(ixc(2,i))
79 n2 = failwave%IDXI(ixc(3,i))
80 n3 = failwave%IDXI(ixc(4,i))
81 n4 = failwave%IDXI(ixc(5,i))
82 nfail = failwave%FWAVE_NOD(1,n1,1)
83 . + failwave%FWAVE_NOD(1,n2,1)
84 . + failwave%FWAVE_NOD(1,n3,1)
85 . + failwave%FWAVE_NOD(1,n4,1)
86 IF (nfail > 0) fwave_el(i) = 1
87 ENDIF
88 ENDDO
89c---------------
90 CASE (2) ! directional propagation through edges only
91c---------------
92 nindx = 0
93 DO i=1,nel
94 IF (offly(i) == 1 .and. dadv(i) == one) THEN
95 nindx = nindx + 1 ! count of non damaged elements
96 indx(nindx) = i
97 ENDIF
98 ENDDO
99c
100 DO ii=1,nindx
101 i = indx(ii)
102 n1 = ixc(2,i)
103 n2 = ixc(3,i)
104 n3 = ixc(4,i)
105 n4 = ixc(5,i)
106 nod_nn(1) = failwave%IDXI(n1)
107 nod_nn(2) = failwave%IDXI(n2)
108 nod_nn(3) = failwave%IDXI(n3)
109 nod_nn(4) = failwave%IDXI(n4)
110 nod_id(1) = itab(n1)
111 nod_id(2) = itab(n2)
112 nod_id(3) = itab(n3)
113 nod_id(4) = itab(n4)
114 found = 0
115c
116 DO k=1,4
117 ncurr = nod_nn(k)
118 IF (failwave%MAXLEV(ncurr) > 0) THEN
119 knext = ndr(k)
120 kprev = ndl(k)
121c
122 DO level = 1,failwave%MAXLEV(ncurr)
123 fnod1 = failwave%FWAVE_NOD(1,ncurr,level)
124 fnod2 = failwave%FWAVE_NOD(2,ncurr,level)
125c
126 IF (fnod1 == nod_id(knext) .and. fnod2 == 0) THEN
127 found = 1
128 fwave_el(i) = 1
129 EXIT
130 ENDIF
131 ENDDO ! LEVEL
132 IF (found == 1) EXIT
133 ENDIF
134 ENDDO ! K=1,4
135c
136c IF (FOUND == 1) THEN
137c#include "lockon.inc"
138c write(iout,'(A,I10)')'set failwave flag to element=',ngl(I)
139c#include "lockoff.inc"
140c ENDIF
141c
142 ENDDO ! II=1,NINDX
143c
144c---------------
145 CASE (3) ! directional propagation through edges and diagonals
146c---------------
147c
148 nindx = 0
149 DO i=1,nel
150 IF (offly(i) == 1 .and. dadv(i) == one) THEN
151 nindx = nindx + 1
152 indx(nindx) = i
153 ENDIF
154 ENDDO
155c
156 DO ii=1,nindx
157 i = indx(ii)
158 n1 = ixc(2,i)
159 n2 = ixc(3,i)
160 n3 = ixc(4,i)
161 n4 = ixc(5,i)
162 nod_nn(1) = failwave%IDXI(n1)
163 nod_nn(2) = failwave%IDXI(n2)
164 nod_nn(3) = failwave%IDXI(n3)
165 nod_nn(4) = failwave%IDXI(n4)
166 nod_id(1) = itab(n1)
167 nod_id(2) = itab(n2)
168 nod_id(3) = itab(n3)
169 nod_id(4) = itab(n4)
170 found = 0
171c
172 DO k=1,4
173 ncurr = nod_nn(k)
174 IF (failwave%MAXLEV(ncurr) > 0) THEN
175 knext = ndr(k)
176 kprev = ndl(k)
177c
178 DO level = 1,failwave%MAXLEV(ncurr)
179 fnod1 = failwave%FWAVE_NOD(1,ncurr,level)
180 fnod2 = failwave%FWAVE_NOD(2,ncurr,level)
181c
182 IF (fnod2 == 0 .and.
183 . (fnod1 == nod_id(knext) .or. fnod1 == nod_id(kprev))) THEN
184 found = 1 ! failwave coming by edge
185 EXIT
186 ELSE IF (fnod1 > 0 .and. fnod2 > 0 .and.
187 . fnod1 /= nod_id(kprev) .and. fnod1 /= nod_id(knext) .and.
188 . fnod2 /= nod_id(kprev) .and. fnod2 /= nod_id(knext)) THEN
189 found = 2 ! failwave coming by diagonal
190 EXIT
191 ENDIF
192 ENDDO ! LEVEL
193 IF (found > 0) THEN
194 fwave_el(i) = 1
195 EXIT
196 ENDIF
197c
198 ENDIF
199 ENDDO ! K=1,4
200c
201c IF (FOUND == 1) THEN
202c#include "lockon.inc"
203c write(iout,'(A,I10)') 'set edge failwave to element=',ngl(I)
204c#include "lockoff.inc"
205c ELSE IF (FOUND == 2) THEN
206c#include "lockon.inc"
207c write(iout,'(A,I10)') 'set diag failwave to element=',ngl(I)
208c#include "lockoff.inc"
209c ENDIF
210c
211 ENDDO ! II=1,NINDX
212c---------------
213 END SELECT
214c---------------
215 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
failwave_mod
Definition failwave_mod.F:61