OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initwg_shell.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "tablen_c.inc"
#include "ddspmd_c.inc"
#include "weights_p4linux964_spmd_avx512.inc"
#include "weights_p4linux964_spmd_sse3.inc"
#include "weights_p4linuxa964_spmd.inc"
#include "weights_p4linux964_spmd.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine initwg_shell (wd, pm, geo, ixc, igeo, size_irup, numelc, ipm, nummat, numgeo, poin_part_shell, mid_pid_shell, ipartc, off, bufmat, mid_old, pid_old, mln_old, recherche, telt_pro, tabmp_l, mat_param)

Function/Subroutine Documentation

◆ initwg_shell()

subroutine initwg_shell ( real, dimension(*) wd,
pm,
geo,
integer, dimension(nixc,*) ixc,
integer, dimension(npropgi,numgeo) igeo,
integer, intent(in) size_irup,
integer numelc,
integer, dimension(npropmi,nummat) ipm,
integer nummat,
integer numgeo,
integer, dimension(2,*), intent(in) poin_part_shell,
type(mid_pid_type), dimension(*), intent(inout) mid_pid_shell,
integer, dimension(*), intent(in) ipartc,
integer off,
bufmat,
integer mid_old,
integer pid_old,
integer mln_old,
integer recherche,
telt_pro,
integer tabmp_l,
type(matparam_struct_), dimension(nummat), intent(in) mat_param )

Definition at line 34 of file initwg_shell.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE ddweights_mod
43 USE mid_pid_mod
44 USE matparam_def_mod
45 use element_mod , only : nixc
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "com01_c.inc"
55#include "tablen_c.inc"
56#include "ddspmd_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NUMELC,OFF,
61 . NUMMAT,NUMGEO,IXC(NIXC,*),
62 . IGEO(NPROPGI,NUMGEO),IPM(NPROPMI,NUMMAT),TABMP_L
63 INTEGER, INTENT(IN) :: SIZE_IRUP ! maximum number of rupture criteria
64
65C REAL OR REAL*8
66 my_real
67 . pm(npropm,nummat), geo(npropg,numgeo),bufmat(*)
68 REAL WD(*)
69 INTEGER MID_OLD,PID_OLD,MLN_OLD,RECHERCHE
70 my_real telt_pro
71
72 INTEGER, DIMENSION(*), INTENT(IN) :: IPARTC
73 INTEGER, DIMENSION(2,*), INTENT(IN) :: POIN_PART_SHELL
74 TYPE(MID_PID_TYPE), DIMENSION(*), INTENT(INOUT) :: MID_PID_SHELL
75 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT), INTENT(IN) :: MAT_PARAM
76C-----------------------------------------------
77 INTEGER NPN, MID, PID, MLN,
78 . ISTRAIN, ITHK, IHBE, IPLA, ISSN, I, J,
79 . NFUNC,
80 .
81 .
82 .
83 . NFAIL,IRUP2,II,IRUP_TAB(SIZE_IRUP),
84 . INDI,IAD,INDI2,MULT,IDRIL
85 INTEGER :: INDI3,IGTYP,INDI4,INDI5
86
87 INTEGER :: POIN_PID,POIN_MID,POIN_PART,COST_CHECK
88 INTEGER :: FLAG_NICE_NEWTON,FLAG_GURSON,FLAG_NON_LOCAL
89 INTEGER :: SPECIAL_OPTION,SPE_I_1,SPE_I_2,SPE_I_3
90
91 real
92 . wtype(9),
93 . tabmat(3),tabx(3),timmat,npt,telt,poids,
94 . batozmult,trup,tabrup(3),trup_local,tmatadd,
95 . wd_local,mult_spe,visc_prony
96
97 my_real
98 . cc,a,b,a1,a2
99 my_real
100 . invtref
101 DATA wtype /1.6 ,1. ,1. ,.9 ,1.1 ,1.4 ,0.65 ,.9 ,2.0/
102C-----------------------------------------------
103 nfunc = zero
104 CALL bidon()
105! DD_OPTIMIZATION = 0 --> default case, DD optimized for Broadwell processor
106! DD_OPTIMIZATION = 1 --> DD optimized for Skylake processor
107! DD_OPTIMIZATION = 2 --> DD optimized for Sandy Bridge processor
108! DD_OPTIMIZATION = 3 --> default case for ARM processor, DD optimized for ThunderX2 processor (ARM)
109 IF(dd_optimization==1) THEN
110! Skylake processor
111#include "weights_p4linux964_spmd_avx512.inc"
112 ELSEIF(dd_optimization==2) THEN
113! Sandy Bridge processor
114#include "weights_p4linux964_spmd_sse3.inc"
115 ELSEIF(dd_optimization==3) THEN
116! ThunderX2 processor (ARMV8.0)
117#include "weights_p4linuxa964_spmd.inc"
118 ELSE
119! DEFAULT CASE
120#if ARCH_CPU
121! ThunderX2 processor (ARMV8.0)
122#include "weights_p4linuxa964_spmd.inc"
123#elif 1
124! Broadwell processor
125#include "weights_p4linux964_spmd.inc"
126#endif
127 ENDIF
128 invtref = one/tpsref
129 indi3 = 1
130 DO i = 1, numelc
131 mid= ixc(1,i)
132 pid= ixc(6,i)
133 mln = nint(pm(19,abs(mid)))
134 wd_local = wd(i+off)
135 ! -----------------
136 IF(recherche==1) THEN
137 mid = mid_old
138 pid = pid_old
139 mln = mln_old
140 wd_local = zero
141 ENDIF
142 ! -----------------
143 npn = nint(geo(6,pid))
144 npt = abs(npn)
145 ihbe = nint(geo(171,pid))
146 ithk = nint(geo(35,pid))
147 ipla = nint(geo(39,pid))
148 igtyp = igeo(11,pid)
149 nfail = mat_param(mid)%NFAIL
150 idril = igeo(20,pid)
151 flag_non_local = 0
152 special_option = 0
153 spe_i_1 = 1
154 spe_i_2 = 1
155 irup_tab = 0
156 IF (nfail > 0) THEN ! up to 6 failure models per material
157 DO j=1,nfail
158 irup_tab(j) = mat_param(mid)%FAIL(j)%IRUPT
159 ENDDO
160 ENDIF
161 timmat = 0.
162 trup = 0.
163 tmatadd = 0.
164 visc_prony = 0.
165 mult = 0
166 IF((mln<28).OR.(mln==32)) THEN
167 irup2 = 0
168 ELSE
169 irup2 = 3
170 ENDIF
171 ! ----------------
172 ! law 2 : 2 sub-option
173 IF (mln==2) THEN
174 cc = pm(43,mid)
175 IF (cc/=0) THEN
176 indi = 2
177 ELSE
178 indi = 1
179 ENDIF
180 IF (mat_param(abs(mid))%IVISC > 0) THEN
181 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
182 ENDIF
183 ! ----------------
184 ! law 25 : 2 sub-option
185 ELSEIF(mln==25) THEN
186 IF (igtyp/=9) THEN
187 indi = 2
188 ELSE
189 indi = 1
190 ENDIF
191 IF (mat_param(abs(mid))%IVISC > 0) THEN
192 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
193 ENDIF
194 ! ----------------
195 ! law 36 : the number of function is taken into account
196 ELSEIF ((mln==36)) THEN
197 IF(abs(npn)>0) THEN
198 nfunc = ipm(10,mid)
199 ELSE
200 nfunc = nint(pm(40,mid))
201 ENDIF
202 IF (nfunc<=2) THEN
203 indi = 1
204 ELSEIF (nfunc>2.AND.nfunc<=7) THEN
205 indi = 2
206 ELSEIF (nfunc>7) THEN
207 indi = 3
208 ENDIF
209 IF (mat_param(abs(mid))%IVISC > 0) THEN
210 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
211 ENDIF
212 ! ----------------
213 ! law 86 : prony option
214 ELSEIF((mln==86).AND.(abs(npn)==0)) THEN
215 nfunc = nint(pm(40,mid))
216 IF (nfunc<=2) THEN
217 indi = 1
218 ELSEIF (nfunc>2.AND.nfunc<=7) THEN
219 indi = 2
220 ELSEIF (nfunc>7) THEN
221 indi = 3
222 ENDIF
223
224 IF (nfunc == 0) THEN
225 IF (mat_param(abs(mid))%IVISC > 0) THEN
226 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
227 ENDIF
228 ENDIF
229 ! ----------------
230 ! law 42,62 and 69 : prony option
231 ELSEIF((mln==42).OR.(mln==62).OR.(mln==69)) THEN
232! check the NPRONY model
233 nfunc = 0 ! NPRONY
234 IF (mln==42) nfunc = mat_param(abs(mid))%IPARAM(2)
235 IF (mln==62) THEN
236 iad=ipm(7,abs(mid))-1
237 nfunc = nint(bufmat(iad+3))
238 END IF
239
240 IF(nfunc==0) THEN
241 indi = 1
242 IF (mat_param(abs(mid))%IVISC > 0) THEN
243 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
244 ENDIF
245 ELSEIF(nfunc==1) THEN
246 indi = 2
247 ELSEIF(nfunc==2) THEN
248 indi = 3
249 ELSEIF(nfunc>2) THEN
250 indi = 3
251 mult = nfunc - 2
252 indi2 = 2
253 ENDIF
254 ! ----------------
255 ! law 82 : prony option
256 ELSEIF((mln==82)) THEN
257 iad=ipm(7,abs(mid))-1
258 nfunc=nint(bufmat(iad+1))
259 IF(nfunc<=1) THEN
260 indi = 1
261 IF (mat_param(abs(mid))%IVISC > 0) THEN
262 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
263 ENDIF
264 ELSEIF(nfunc==2) THEN
265 indi = 2
266 ELSEIF(nfunc==3) THEN
267 indi = 3
268 ELSEIF(nfunc>3) THEN
269 indi = 3
270 mult = nfunc - 3
271 indi2 = 2
272 ENDIF
273 ! ----------------
274 ! law 104 : 2 different algo + sub-option
275 ELSEIF(mln==104) THEN
276 iad=ipm(7,abs(mid))-1
277 flag_nice_newton=nint(bufmat(iad+11))
278 IF(flag_nice_newton==2) THEN ! Newtow algo
279 indi = 2
280 ELSE ! Nice algo
281 indi = 1
282 ENDIF
283 flag_gurson=nint(bufmat(iad+30))
284 IF(flag_gurson/=0) THEN
285 special_option=1
286 spe_i_1 = 1
287 spe_i_2 = 1
288 ENDIF
289 IF(flag_gurson==1) THEN
290 spe_i_2 = 1
291 ELSEIF(flag_gurson==2) THEN
292 spe_i_2 = 2
293 ELSEIF(flag_gurson==3) THEN
294 spe_i_2 = 3
295 ENDIF
296 flag_non_local = mat_param(abs(mid))%NLOC
297 ! ----------------
298 ! other laws
299 ELSE
300 indi = 1
301 IF (mat_param(abs(mid))%IVISC > 0) THEN
302 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
303 ENDIF
304 ENDIF
305 ! ----------------
306 mult_spe = 0.
307 spe_i_3 = 1
308 IF(flag_non_local/=0) THEN
309 spe_i_3 = 2
310 mult_spe = npt
311 ENDIF
312 cost_check = 0
313!****************************************
314! ---------------------------
315! SHELL ELEMENT
316! ---------------------------
317 ! check if the (mid,pid) cost must be initialized from a previous run
318 IF(recherche==0.AND.test_poids/=0) THEN
319 poin_part = ipartc(i)
320 poin_mid = poin_part_shell(1,poin_part)
321 poin_pid = poin_part_shell(2,poin_part)
322 ! if POIN_MID==0 and POIN_PID == 0, the element cost in the .ddw file is 0 --> must be initialized
323 ! from the .inc file
324 IF(poin_mid/=0.AND.poin_pid/=0) THEN
325 IF(mid_pid_shell(poin_mid)%COST1D(poin_pid)/=zero) THEN
326 cost_check = 1
327 telt = mid_pid_shell(poin_mid)%COST1D(poin_pid)
328 ENDIF
329 ENDIF
330 ENDIF
331 ! the (mid,pid) cost must be initialized from .inc file
332 IF(cost_check==0) THEN
333! ----------------------------------------
334! user material cost
335! ----------------------------------------
336 IF(ddweights(1,2,mid)/=zero)THEN
337C Compute time according to integration points:
338 a1 = ddweights(1,2,mid) * tpsref
339 a2 = ddweights(2,2,mid) * tpsref
340
341 IF (a2 /=zero)THEN
342C Compute line function A1 ="Time for 1 int Point" - A2="time for 5 int points"
343 a = (a2-a1)/4
344 b = a1-a
345 timmat = a*npt + b
346 ELSE
347 timmat = a1*npt
348 ENDIF
349! --------------
350! Failure
351 IF(nfail/=0) THEN
352 DO j=1,nfail
353 a1 = rupture_shell(irup_tab(j),irup2+1)
354 a2 = rupture_shell(irup_tab(j),irup2+3)
355 IF (a2 /=zero)THEN
356 a = (a2-a1)/4
357 b = a1-a
358 trup = trup + a*npt + b
359 ELSE
360 trup = trup + a1*npt
361 ENDIF
362 ENDDO
363 ENDIF
364! --------------
365 ELSE
366! ----------------------------------------
367! Radioss material cost
368! ----------------------------------------
369 IF(ithk==2)THEN
370 ithk = 0
371 ELSEIF(mln==32)THEN
372 ithk = 1
373 ENDIF
374 istrain = nint(geo(11,pid))
375 IF(mln==19.OR.mln>=25)istrain = 1
376 issn = nint(geo(3,pid))
377C ow test elem delete
378 IF (wd_local==0.) THEN
379 IF(abs(npn)>0) THEN
380 tabx(1) = 1.
381 tabx(2) = 3.
382 tabx(3) = 5.
383 ! *******--------*******
384 DO j = 1,3
385 IF(mult/=0) tmatadd = mult *
386 . (shtnl(min(mln,maxlaw),j,indi) - shtnl(min(mln,maxlaw),j,indi2) )
387 IF(special_option/=0) tmatadd = tmatadd + shtnl_option(spe_i_1,spe_i_2)
388 tabmat(j) = shtnl(min(mln,maxlaw),j,indi) + tmatadd
389 ENDDO
390 ! *******--------*******
391 npt = abs(npn)
392 CALL interlagran(tabmat,tabx,3,npt,timmat)
393! ----------------
394! Failure
395 IF(nfail/=0) THEN
396 DO j=1,nfail
397 DO ii=1,3
398 tabrup(ii) = rupture_shell(irup_tab(j),irup2+ii)
399 ENDDO
400 trup_local = 0.
401 CALL interlagran(tabrup,tabx,3,npt,trup_local)
402 trup = trup + trup_local
403 ENDDO
404 ENDIF ! <--- fin NFAIL/=0
405! ----------------
406 ELSE
407C 0pt d integration doit etre traite a part
408 ! *******--------*******
409 IF(mult/=0) tmatadd = mult *
410 . (shtnl(min(mln,maxlaw),0,indi) - shtnl(min(mln,maxlaw),0,indi2) )
411 timmat = shtnl(min(mln,maxlaw),0,indi) + tmatadd
412 ! *******--------*******
413! ----------------
414! Incompatible failure n = 0
415 IF(nfail/=0) THEN
416 trup = 0.
417 ENDIF ! <--- fin NFAIL/=0
418! ----------------
419 ENDIF
420 ENDIF
421 ENDIF
422
423 IF(igtyp==10) THEN
424 indi4 = 1
425 ELSEIF(igtyp==11) THEN
426 indi4 = 2
427 ELSEIF(igtyp==9) THEN
428 indi4 = 3
429 ELSEIF(igtyp==16) THEN
430 indi4 = 4
431 ELSEIF(igtyp==51) THEN
432 indi4 = 5
433 ELSE
434 indi4 = 0
435 ENDIF
436
437 indi5 = 0
438 IF(idril==1) indi5=2
439
440 IF(mln/=0)THEN
441 IF (ihbe>=11.AND.ihbe<=19) THEN
442C ow BATOZ
443 telt = shtelt(indi4*5+3+indi5)+batozmult*(timmat + trup) + mult_spe*nlocal_option(spe_i_3) + visc_prony
444 ELSEIF (ihbe>=21.AND.ihbe<=29) THEN
445C ow QEPH
446 telt = shtelt(indi4*5+2+indi5) + timmat + trup + mult_spe*nlocal_option(spe_i_3) + visc_prony
447 ELSE
448C ow Q4
449 telt = shtelt(indi4*5+1) + timmat + trup + mult_spe*nlocal_option(spe_i_3) + visc_prony
450 ENDIF
451 ENDIF
452 ENDIF ! fin SHTNL_OLD
453!****************************************
454
455 ! --------------------
456 IF(recherche==0) THEN
457 IF((wd_local==0.).AND.(mln/=0)) THEN
458 poids = telt * invtref
459 wd(i+off) = poids
460 poin_part = ipartc(i)
461 poin_mid = poin_part_shell(1,poin_part)
462 poin_pid = poin_part_shell(2,poin_part)
463 IF(poin_mid/=0.AND.poin_pid/=0) mid_pid_shell(poin_mid)%COST1D(poin_pid) = telt
464 ELSEIF((wd_local==0.).AND.(mln==0)) THEN
465 wd(i+off) = 0.0001
466 ENDIF
467 ELSE
468 telt_pro = telt
469 ENDIF
470 ! --------------------
471 ENDDO
472
473 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
interlagran
subroutine interlagran(tab, lx, ltab, x, y)
Definition grid2mat.F:2896
min
#define min(a, b)
Definition macros.h:20
ddweights_mod
Definition ddweights_mod.F:40
mid_pid_mod
Definition mid_pid_mod.F:36
bidon
subroutine bidon
Definition machine.F:41
visc_prony
subroutine visc_prony(visc, nprony, nel, nvarvis, uvarvis, epspxx, epspyy, epspzz, epspxy, epspyz, epspzx, sv1, sv2, sv3, sv4, sv5, sv6, timestep, rho, viscmax, soundsp, nvar_damp)
Definition visc_prony.F:34