40
41
42
43 USE mat_elem_mod
47 USE elbufdef_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "param_c.inc"
56#include "com08_c.inc"
57#include "units_c.inc"
58#include "comlock.inc"
59
60
61
62 TYPE(ELBUF_STRUCT_), INTENT(INOUT), TARGET :: ELBUF_STR
63 my_real,
DIMENSION(NPROPG,NUMGEO),
INTENT(IN) :: geo
64 INTEGER, DIMENSION(NPROPGI,NUMGEO),INTENT(IN) :: IGEO
65 INTEGER,INTENT(IN) :: PID,NEL,NLAY,NPTTOT,IGTYP,ISUBSTACK,
66 . NLAY_MAX,LAYNPT_MAX,NUMGEO,NUMSTACK
67 INTEGER, DIMENSION(NEL), INTENT(IN) :: NGL
68 my_real,
DIMENSION(NEL,NLAY_MAX*LAYNPT_MAX),
INTENT(IN) :: thk_ly
69 my_real,
DIMENSION(NPTTOT*NEL),
INTENT(IN) :: thkly
70 my_real,
DIMENSION(NEL),
INTENT(INOUT) :: off
71 TYPE (STACK_PLY), INTENT(IN) :: STACK
72 TYPE (FAILWAVE_STR_), INTENT(IN), TARGET :: FAILWAVE
73 INTEGER, DIMENSION(NEL), INTENT(INOUT) :: FWAVE_EL
74 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
75 LOGICAL, DIMENSION(NEL), INTENT(INOUT) :: PRINT_FAIL
76
77
78
79 INTEGER I,II,IEL,IPOS,IL,IFL,IPT,NPTT,
80 . NINDXLY,NFAIL,IPWEIGHT,IPTHKLY,IMAT,ID_PLY
82 . p_thickg,fail_exp,dfail
83 INTEGER, DIMENSION(NEL) :: INDXLY
84 INTEGER, DIMENSION(:), POINTER :: FOFF,LAY_OFF
85 my_real,
DIMENSION(NLAY) :: weight,p_thkly
86 my_real,
DIMENSION(NLAY,100) :: pthkf
88 TYPE(L_BUFEL_) ,POINTER :: LBUF
89 CHARACTER(LEN=NCHARTITLE), DIMENSION(NEL) :: FAIL_NAME
90
91
92
93
94
95
96
97
98
99
100 p_thickg = geo(42,pid)
101 fail_exp = geo(43,pid)
102 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
103
104 ipweight = ipthkly + nlay
105 ELSE
106 ipthkly = 700
107 ipweight = 900
108 ENDIF
109
110 DO il=1,nlay
111 nfail = elbuf_str%BUFLY(il)%NFAIL
112 imat = elbuf_str%BUFLY(il)%IMAT
113 DO ifl = 1,nfail
114 pthkf(il,ifl) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%PTHK
115 END DO
116 END DO
117
118
119
120 IF (nlay == 1) THEN
121
122
123 il = 1
124
125
126 imat = elbuf_str%BUFLY(il)%IMAT
127
128
129 nfail = elbuf_str%BUFLY(il)%NFAIL
130 DO ifl = 1,nfail
131
132 IF (pthkf(il,ifl) > zero) THEN
133 pthkf(il,ifl) =
min(pthkf(il,ifl),abs(p_thickg))
134 pthkf(il,ifl) =
max(
min(pthkf(il,ifl),one-em06),em06)
135
136 ELSEIF (pthkf(il,ifl) < zero) THEN
137 pthkf(il,ifl) =
max(pthkf(il,ifl),-abs(p_thickg))
138 pthkf(il,ifl) =
min(
max(pthkf(il,ifl),-one+em6),-em06)
139
140 ELSE
141 pthkf(il,ifl) = p_thickg
142 ENDIF
143 ENDDO
144
145
146 DO ifl = 1,nfail
147 thfact(1:nel) = zero
148 npfail(1:nel) = zero
149 nptt = elbuf_str%BUFLY(il)%NPTT
150
151
152 DO ipt=1,nptt
153 foff => elbuf_str%BUFLY(il)%FAIL(1,1,ipt)%FLOC(ifl)%OFF
154 DO iel=1,nel
155 IF (off(iel) == one) THEN
156 IF (foff(iel) < one) THEN
157 ipos = (ipt-1)*nel + iel
158
159 npfail(iel) = npfail(iel) + one/nptt
160 ENDIF
161 ENDIF
162 ENDDO
163 ENDDO
164
165 DO iel=1,nel
166 IF (off(iel) == one) THEN
167 IF (((thfact(iel) >= pthkf(il,ifl)).AND.(pthkf(il,ifl) > zero)).OR.
168 . ((npfail(iel) >= abs(pthkf(il,ifl))).AND.(pthkf(il,ifl) < zero))) THEN
169 off(iel) = four_over_5
170 print_fail(iel) = .false.
171 fail_name(iel) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%KEYWORD
172#include "lockon.inc"
173 WRITE(iout, 1000) trim(fail_name(iel)),ngl(iel)
174 WRITE(istdo,1100) trim(fail_name(iel)),ngl(iel),tt
175#include "lockoff.inc"
176 IF (failwave%WAVE_MOD > 0) fwave_el(iel) = -1
177 ENDIF
178 ENDIF
179 ENDDO
180 ENDDO
181
182
183
184
185 ELSEIF (nlay == npttot) THEN
186
187
188 ipt = 1
189
190
191 DO il=1,nlay
192 nindxly = 0
193 nfail = elbuf_str%BUFLY(il)%NFAIL
194 lay_off => elbuf_str%BUFLY(il)%OFF
195 imat = elbuf_str%BUFLY(il)%IMAT
196 DO ifl = 1,nfail
197 foff => elbuf_str%BUFLY(il)%FAIL(1,1,ipt)%FLOC(ifl)%OFF
198 DO iel=1,nel
199 IF (off(iel) == one .AND. lay_off(iel) == 1) THEN
200 IF (foff(iel) < 1) THEN
201 nindxly = nindxly + 1
202 indxly(nindxly) = iel
203 lay_off(iel) = 0
204 fail_name(iel) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%KEYWORD
205 ENDIF
206 ENDIF
207 ENDDO
208 ENDDO
209
210 IF (nindxly > 0) THEN
211
212 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
213 IF (igtyp == 17 .OR. igtyp == 51) THEN
214 id_ply = igeo(1,stack%IGEO(2+il,isubstack))
215 ELSE
216 id_ply =
ply_info(1,stack%IGEO(2+il,isubstack)-numstack)
217 ENDIF
218 DO i = 1,nindxly
219#include "lockon.inc"
220 WRITE(iout, 3000) trim(fail_name(indxly(i))),id_ply,ngl(indxly(i))
221 WRITE(istdo,3100) trim(fail_name(indxly(i))),id_ply,ngl(indxly(i)),tt
222#include "lockoff.inc"
223 ENDDO
224
225 ELSE
226 DO i = 1,nindxly
227#include "lockon.inc"
228 WRITE(iout, 2000) trim(fail_name(indxly(i))),il,ngl(indxly(i))
229 WRITE(istdo,2100) trim(fail_name(indxly(i))),il,ngl(indxly(i)),tt
230#include "lockoff.inc"
231 ENDDO
232 ENDIF
233 ENDIF
234 ENDDO
235
236
237 thfact(1:nel) = zero
239 npfail(1:nel) = zero
240
241 DO il=1,nlay
242 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
243 weight(il) = stack%GEO(ipweight+ il,isubstack)
244 ELSE
245 weight(il) = geo(ipweight + il,pid)
246 ENDIF
247 lay_off => elbuf_str%BUFLY(il)%OFF
248 ii = (il-1)*nel
249 DO iel=1,nel
250 IF (off(iel) == one) THEN
251 ipos = ii + iel
252 dfail = thkly(ipos)*weight(il)
254 IF (lay_off(iel) == 0) THEN
255 thfact(iel) = thfact(iel) + thkly(ipos)*weight(il)
256 npfail(iel) = npfail(iel) + one/nlay
257 ENDIF
258 ENDIF
259 ENDDO
260 ENDDO
261
262 DO iel=1,nel
263 IF (off(iel) == one) THEN
264 IF (((thfact(iel) >= p_thickg*
norm(iel)).AND.(p_thickg > zero)).OR.
265 . ((npfail(iel) >= abs(p_thickg)).AND.(p_thickg < zero))) THEN
266 off(iel) = four_over_5
267 IF (failwave%WAVE_MOD > 0) fwave_el
268 ENDIF
269 ENDIF
270 ENDDO
271
272
273
274
275 ELSE
276
277
278 DO il = 1,nlay
279 nfail = elbuf_str%BUFLY(il)%NFAIL
280 p_thkly(il) = stack%GEO(ipthkly + il,isubstack)
281 DO ifl = 1,nfail
282
283 IF (pthkf(il,ifl) > zero) THEN
284 pthkf(il,ifl) =
min(pthkf
285 pthkf(il,ifl) =
max(
min(pthkf(il,ifl),one-em06),em06)
286
287 ELSEIF (pthkf(il,ifl) < zero) THEN
288 pthkf(il,ifl) =
max(pthkf(il,ifl),-abs(p_thkly(il)))
289 pthkf(il,ifl) =
min(
max(pthkf(il,ifl),-one+em6),-em06)
290
291 ELSE
292 pthkf(il,ifl) = p_thkly(il)
293 ENDIF
294 ENDDO
295 ENDDO
296
297
298 DO il=1,nlay
299 nptt = elbuf_str%BUFLY(il)%NPTT
300 nindxly = 0
301 nfail = elbuf_str%BUFLY(il)%NFAIL
302 lay_off => elbuf_str%BUFLY(il)%OFF
303 imat = elbuf_str%BUFLY(il)%IMAT
304 ii = (il-1)*nel
305
306 DO ifl = 1,nfail
307 thfact(1:nel) = zero
308 npfail(1:nel) = zero
309 DO ipt = 1,nptt
310 foff => elbuf_str%BUFLY(il)%FAIL(1,1,ipt)%FLOC(ifl)%OFF
311 DO iel=1,nel
312 IF (off(iel) == one) THEN
313 IF (lay_off(iel) == 1) THEN
314 IF (foff(iel) < one) THEN
315 ipos = ii + iel
316 thfact(iel) = thfact(iel) + thkly(ipos)/thk_ly(iel,il)
317 npfail(iel) = npfail(iel) + one/nptt
318 ENDIF
319 ENDIF
320 ENDIF
321 ENDDO
322 ENDDO
323
324 DO iel=1,nel
325 IF (off(iel) == one) THEN
326 IF (((thfact
327 . ((npfail(iel) >= abs(pthkf(il,iflTHEN
328 nindxly = nindxly + 1
329 indxly(nindxly) = iel
330 lay_off(iel) = 0
331 fail_name(iel) = mat_elem%MAT_PARAM(imat)%FAIL(ifl)%KEYWORD
332 DO ipt=1,nptt
333 foff => elbuf_str%BUFLY(il)%FAIL(1,1
334 foff(iel) = 0
335 ENDDO
336 ENDIF
337 ENDIF
338 ENDDO
339 ENDDO
340
341 IF (nindxly > 0) THEN
342 IF (igtyp == 51) THEN
343 id_ply = igeo(1,stack%IGEO(2+il,isubstack))
344 ELSE
345 id_ply =
ply_info(1,stack%IGEO(2+il,isubstack)-numstack)
346 ENDIF
347 DO i = 1,nindxly
348#include "lockon.inc"
349 WRITE(iout, 3000) trim(fail_name(indxly(i))),id_ply,ngl(indxly
350 WRITE(istdo,3100) trim(fail_name(indxly(i))),id_ply,ngl(indxly(i)),tt
351#include "lockoff.inc"
352 ENDDO
353 ENDIF
354 ENDDO ! |-> il
355
356
357 thfact(1:nel) = zero
358 npfail(1:nel) = zero
360
361 DO il=1,nlay
362 weight(il) = stack%GEO(ipweight + il,isubstack)
363 lay_off => elbuf_str%BUFLY(il)%OFF
364 DO iel=1,nel
365 IF (off(iel) == one) THEN
366 dfail = (thk_ly(iel,il)*weight(il))**fail_exp
368 IF (lay_off(iel) == 0) THEN
369 thfact(iel) = thfact(iel) + dfail
370 npfail(iel) = npfail(iel) + one/nlay
371 ENDIF
372 ENDIF
373 ENDDO
374 ENDDO
375
376 DO iel=1,nel
377 IF (off(iel) == one) THEN
378 thfact(iel) = thfact(iel)**(one/fail_exp)
379 norm(iel) =
norm(iel)**(one/fail_exp)
380 IF (((thfact(iel) >= p_thickg*
norm(iel)).AND.(p_thickg > zero)).OR.
381 . ((npfail(iel) >= abs(p_thickg)).AND.(p_thickg < zero))) THEN
382 off(iel) = four_over_5
383 IF (failwave%WAVE_MOD > 0) fwave_el(iel) = -1
384 ENDIF
385 ENDIF
386 ENDDO
387
388 ENDIF
389
390
391
392
393
394 1000 FORMAT(1x,'-- RUPTURE (',a,') OF SHELL ELEMENT NUMBER ',i10)
395 1100 FORMAT(1x,'-- RUPTURE (',a,') OF SHELL ELEMENT :',i10,' AT TIME :'
396 2000 FORMAT(1x,'-- FAILURE (',a,') OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10)
397 2100 FORMAT(1x,'-- FAILURE (',a,') OF LAYER',i3, ' ,SHELL ELEMENT NUMBER ',i10,
398 . 1x,'AT TIME :',g11.4)
399 3000 FORMAT(1x,'-- FAILURE (',a,') OF PLY ID ',i10, ' ,SHELL ELEMENT NUMBER ',i10)
400 3100 FORMAT(1x,'-- FAILURE (',a,') OF PLY ID ',i10, ' ,SHELL ELEMENT NUMBER ',i10,
401 . 1x,'AT TIME :',g11.4)
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
integer, dimension(:,:), allocatable ply_info