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