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

Go to the source code of this file.

Functions/Subroutines

subroutine fail_setoff_wind_frwave (elbuf_str, mat_elem, geo, pid, ngl, nel, ir, is, nlay, npttot, thk_ly, thkly, off, npg, stack, isubstack, igtyp, failwave, fwave_el, dmg_flag, time, trelax, tfail, dmg_scale)

Function/Subroutine Documentation

◆ fail_setoff_wind_frwave()

subroutine fail_setoff_wind_frwave ( type(elbuf_struct_), target elbuf_str,
type (mat_elem_), intent(inout) mat_elem,
dimension(npropg,*) geo,
integer pid,
integer, dimension(nel) ngl,
integer nel,
integer ir,
integer is,
integer nlay,
integer npttot,
dimension(nel,*) thk_ly,
dimension(npttot*nel) thkly,
dimension(nel ) off,
integer npg,
type (stack_ply) stack,
integer isubstack,
integer igtyp,
type (failwave_str_), target failwave,
integer, dimension(nel) fwave_el,
integer dmg_flag,
time,
trelax,
dimension(nel ) tfail,
dimension(nel ) dmg_scale )

Definition at line 34 of file fail_setoff_wind_frwave.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE mat_elem_mod
45 USE stack_mod
46 USE failwave_mod
47 USE elbufdef_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "param_c.inc"
56#include "comlock.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER :: NEL,NPTTOT,NLAY,PID,IR,IS,NPG,ISUBSTACK,IGTYP,DMG_FLAG
61 my_real :: time,trelax
62 INTEGER, DIMENSION(NEL) :: NGL,FWAVE_EL
63 my_real, DIMENSION(NPTTOT*NEL) :: thkly
64 my_real, DIMENSION(NPROPG,*) :: geo
65 my_real, DIMENSION(NEL ) :: off,tfail,dmg_scale
66 my_real, DIMENSION(NEL,*) :: thk_ly
67 TYPE(ELBUF_STRUCT_) ,TARGET :: ELBUF_STR
68 TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE
69 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,II,IEL,IPOS,IL,IFL,IP,IPT,IG,IPG,JPG,NPTR,NPTS,NPTT,IMAT,
74 . IDMG,COUNTPG,NINDXPG,NINDXLY,IPT_ALL,NFAIL,IPWEIGHT,IPTHKLY
75 INTEGER, DIMENSION(NEL) :: NPTF,INDXPG,INDXLY
76 INTEGER, DIMENSION(10) :: ISTRESS
77 INTEGER, DIMENSION(:), POINTER :: OFFLY,OFFPG,FOFF
78 my_real, DIMENSION(NLAY,100) :: pthkf
79 my_real, DIMENSION(NEL) :: uel1,dfmax,tdel,npttf,sigscale
80 my_real, DIMENSION(:), POINTER :: dmax
81 my_real, DIMENSION(NLAY) :: weight,p_thkly
82 my_real :: thk_lay,p_thickg,fail_exp,thfact,norm,dfail
83 TYPE(L_BUFEL_) ,POINTER :: LBUF
84 TYPE (STACK_PLY) :: STACK
85c-----------------------------------------------------------------------
86c NPTT NUMBER OF INTEGRATION POINTS IN CURRENT LAYER
87c NPTTF NUMBER OF FAILED INTEGRATION POINTS IN THE LAYER
88c NPTTOT NUMBER OF INTEGRATION POINTS IN ALL LAYERS (TOTAL)
89c OFFPG(NEL,NPG) failure flag of PG in each layer 1=alive ,0=dead
90c THK_LY Ratio of layer thickness / element thickness
91c THK Total element thickness
92c TFAIL(NEL) : global element variable - start of relaxation time before element suppression
93C=======================================================================
94 ipthkly = 700
95 ipweight = 900
96 p_thickg = geo(42,pid)
97 fail_exp = geo(43,pid)
98c
99 nptr = elbuf_str%NPTR
100 npts = elbuf_str%NPTS
101 npg = nptr*npts ! number of in-plane Gauss points
102 ipg = (is-1)*nptr + ir ! current Gauss point
103 jpg = (ipg-1)*nel
104c
105 DO il=1,nlay
106 nfail = elbuf_str%BUFLY(il)%NFAIL
107 imat = elbuf_str%BUFLY(il)%IMAT
108 DO ifl = 1,nfail
109 pthkf(il,ifl) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%PTHK
110 END DO
111 END DO
112c------------------------------------
113 IF (nlay == 1) THEN
114c------------------------------------
115 il = 1
116 nfail = elbuf_str%BUFLY(il)%NFAIL
117 nptt = elbuf_str%BUFLY(il)%NPTT
118 offpg => elbuf_str%BUFLY(il)%OFFPG(jpg+1:jpg+nel)
119 offly => elbuf_str%BUFLY(il)%OFF
120c
121 IF (nfail == 1 .and. p_thickg > zero) THEN
122 pthkf(il,1) = max(p_thickg,em06)
123 pthkf(il,1) = min(p_thickg,one-em06)
124 ELSE
125 DO ifl = 1,nfail
126 pthkf(il,ifl) = max(pthkf(il,ifl),em06)
127 pthkf(il,ifl) = min(pthkf(il,ifl),one-em06)
128 ENDDO
129 ENDIF
130c------------------
131 IF (failwave%WAVE_MOD > 0) THEN
132 DO ifl = 1,nfail
133 DO ipt=1,nptt
134 dmax => elbuf_str%BUFLY(il)%FAIL(ir,is,ipt)%FLOC(ifl)%DAMMX
135 DO iel=1,nel
136 IF (offly(iel) < 0 .and. dmax(iel) == one) THEN
137 fwave_el(iel) = offly(iel) ! set element frontwave flag
138 offly(iel) = 0
139 ENDIF
140 ENDDO ! IPT=1,NPTT
141 ENDDO ! IFL = 1,NFAIL
142 ENDDO ! IEL=1,NEL
143 ENDIF
144c------------------
145 DO iel=1,nel
146 IF (off(iel) == zero .or. offpg(iel) == 0) cycle
147 DO ifl = 1,nfail
148 thfact = zero
149 DO ipt=1,nptt
150 foff => elbuf_str%BUFLY(il)%FAIL(ir,is,ipt)%FLOC(ifl)%OFF
151 IF (foff(iel) < one) THEN
152 ipos = (ipt-1)*nel + iel
153 thfact = thfact + thkly(ipos)
154 ENDIF
155 IF (thfact >= pthkf(il,ifl)) THEN ! delete current PG in the layer
156 offpg(iel) = 0
157 ENDIF
158 ENDDO ! IPT=1,NPTT
159 ENDDO ! IFL = 1,NFAIL
160 ENDDO ! IEL=1,NEL
161c------------------
162 nindxpg = 0
163 DO iel=1,nel
164 IF (offpg(iel) == 0) THEN
165 nindxpg = nindxpg + 1
166 indxpg(nindxpg) = iel
167 ENDIF
168 ENDDO
169c------------------
170 IF (ipg == npg) THEN
171 IF (dmg_flag == 0) THEN ! element is deleted immediately after fail crit is reached
172 DO iel=1,nel
173 IF (off(iel) == one) THEN
174 countpg = 0
175 DO ig=1,ipg
176 jpg = (ig-1)*nel
177 countpg = countpg + elbuf_str%BUFLY(il)%OFFPG(jpg+iel)
178 ENDDO
179 IF (countpg == 0) THEN ! all Gauss pts have failed
180 off(iel) = four_over_5
181 ENDIF
182 ENDIF
183 ENDDO ! IEL=1,NEL
184 ELSE ! DMG_FLAG = 1 => Add relaxation time with exp damage before deleting element
185 DO iel=1,nel
186 IF (off(iel) == one) THEN
187 countpg = 0
188 DO ig=1,ipg
189 jpg = (ig-1)*nel
190 countpg = countpg + elbuf_str%BUFLY(il)%OFFPG(jpg+iel)
191 ENDDO
192 IF (countpg == 0) THEN ! all Gauss pts have failed
193 off(iel) = one - em6
194 tfail(iel) = time
195 ENDIF
196 ENDIF
197 ENDDO ! IEL=1,NEL
198 DO iel=1,nel
199 IF (tfail(iel) > zero) THEN
200 dmg_scale(iel) = exp(-(time - tfail(iel))/trelax)
201 END IF
202 ENDDO ! IEL=1,NEL
203 END IF ! DMG_FLAG
204 ENDIF ! IPG == NPG
205c----------------------------------------
206 ENDIF ! PROPERTY TYPE
207c-------------------------------
208 2000 FORMAT(1x,'-- FAILURE OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10)
209 2100 FORMAT(1x,'-- FAILURE OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10,
210 . 1x,'AT TIME :',g11.4)
211c-----------
212 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
failwave_mod
Definition failwave_mod.F:61
stack_mod
Definition stack_mod.F:72