OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initwg_tri.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_tri (wd, pm, geo, ixtg, igeo, numeltg, ipm, size_irup, nummat, numgeo, poin_part_tri, mid_pid_tri, ipartg, off, bufmat, mid_old, pid_old, mln_old, recherche, telt_pro, tabmp_l, mat_param)

Function/Subroutine Documentation

◆ initwg_tri()

subroutine initwg_tri ( real, dimension(*) wd,
pm,
geo,
integer, dimension(nixtg,*) ixtg,
integer, dimension(npropgi,*) igeo,
integer numeltg,
integer, dimension(npropmi,*) ipm,
integer, intent(in) size_irup,
integer nummat,
integer numgeo,
integer, dimension(2,*), intent(in) poin_part_tri,
type(mid_pid_type), dimension(*), intent(inout) mid_pid_tri,
integer, dimension(*), intent(in) ipartg,
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_tri.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE ddweights_mod
42 USE mid_pid_mod
43 USE matparam_def_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "com01_c.inc"
53#include "tablen_c.inc"
54#include "ddspmd_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER OFF,NUMELTG,TABMP_L,
59 . NUMMAT,NUMGEO, IXTG(NIXTG,*),IGEO(NPROPGI,*),
60 . IPM(NPROPMI,*)
61 INTEGER, INTENT(IN) :: SIZE_IRUP
62
63C REAL OU REAL*8
64 my_real
65 . pm(npropm,*), geo(npropg,*),bufmat(*)
66
67 REAL WD(*)
68 INTEGER MID_OLD,PID_OLD,MLN_OLD,RECHERCHE
69 my_real telt_pro
70
71 INTEGER, DIMENSION(*), INTENT(IN) :: IPARTG
72 INTEGER, DIMENSION(2,*), INTENT(IN) :: POIN_PART_TRI
73 TYPE(MID_PID_TYPE), DIMENSION(*), INTENT(INOUT) :: MID_PID_TRI
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
84 INTEGER :: INDI3,COST_CHECK,POIN_PART,POIN_MID,POIN_PID
85 INTEGER :: FLAG_NICE_NEWTON,FLAG_GURSON,FLAG_NON_LOCAL
86 INTEGER :: SPECIAL_OPTION,SPE_I_1,SPE_I_2,SPE_I_3
87
88 real
89 . wtype(9),fwihbe,fac8,
90 . tabmat(3),tabx(3),timmat,npt,telt,poids,w,
91 . batozmult,tmat,trup,tabrup(3),trup_local,tmatadd,
92 . wd_local,mult_spe,visc_prony
93
94 my_real
95 . cc, a,b,a1,a2
96 my_real
97 . invtref
98 DATA wtype /1.6 ,1. ,1. ,.9 ,1.1 ,1.4 ,0.65 ,.9 ,2.0/
99C-----------------------------------------------
100 CALL bidon()
101 telt = 0
102 nfunc = 0
103! DD_OPTIMIZATION = 0 --> default case, DD optimized for Broadwell processor
104! DD_OPTIMIZATION = 1 --> DD optimized for Skylake processor
105! DD_OPTIMIZATION = 2 --> DD optimized for Sandy Bridge processor
106! DD_OPTIMIZATION = 3 --> default case for ARM processor, DD optimized for ThunderX2 processor (ARM)
107 IF(dd_optimization==1) THEN
108! Skylake processor
109#include "weights_p4linux964_spmd_avx512.inc"
110 ELSEIF(dd_optimization==2) THEN
111! Sandy Bridge processor
112#include "weights_p4linux964_spmd_sse3.inc"
113 ELSEIF(dd_optimization==3) THEN
114! ThunderX2 processor (ARMV8.0)
115#include "weights_p4linuxa964_spmd.inc"
116 ELSE
117! DEFAULT CASE
118#if ARCH_CPU
119! ThunderX2 processor (ARMV8.0)
120#include "weights_p4linuxa964_spmd.inc"
121#elif 1
122! Broadwell processor
123#include "weights_p4linux964_spmd.inc"
124#endif
125 ENDIF
126 invtref = one/tpsref
127 indi3 = 2
128 DO i = 1, numeltg
129 mid= ixtg(1,i)
130 pid= ixtg(5,i)
131 mln = nint(pm(19,abs(mid)))
132 wd_local = wd(i+off)
133 ! -----------------
134 IF(recherche==1) THEN
135 mid = mid_old
136 pid = pid_old
137 mln = mln_old
138 wd_local = zero
139 ENDIF
140 ! -----------------
141 npn = nint(geo(6,pid))
142 ihbe = nint(geo(171,pid))
143 ithk = nint(geo(35,pid))
144 ipla = nint(geo(39,pid))
145 npt = max(abs(npn),1)
146 flag_non_local = 0
147 special_option = 0
148 spe_i_1 = 1
149 spe_i_2 = 1
150 nfail = mat_param(mid)%NFAIL
151 irup_tab = 0
152 IF(nfail/=0) THEN ! up to 6 failure models per material
153 DO j=1,nfail
154 irup_tab(j) = mat_param(mid)%FAIL(j)%IRUPT
155 ENDDO
156 ENDIF
157 timmat = 0.
158 trup = 0.
159 tmatadd = 0.
160 visc_prony = 0.
161 mult = 0
162 IF((mln<28).OR.(mln==32)) THEN
163 irup2 = 0
164 ELSE
165 irup2 = 3
166 ENDIF
167
168 IF (mln==2.OR.mln==3) THEN
169 cc = pm(43,mid)
170 IF (cc/=0) THEN
171 indi = 2
172 ELSE
173 indi = 1
174 ENDIF
175 IF (mat_param(abs(mid))%IVISC > 0) THEN
176 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
177 ENDIF
178 ELSEIF ((mln==25).AND.(abs(npn)>0)) THEN
179 iflag = nint( pm(40,mid))
180 IF (iflag/=0) THEN
181 indi = 2
182 ELSE
183 indi = 1
184 ENDIF
185 IF (mat_param(abs(mid))%IVISC > 0) THEN
186 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
187 ENDIF
188C loi 36+86 en fonction des fct
189 ELSEIF (mln==36.OR.(mln==86).AND.(abs(npn)>0)) THEN
190 nfunc = nint(pm(40,mid))
191 IF (nfunc<=2) THEN
192 indi = 1
193 ELSEIF (nfunc>2.AND.nfunc<=7) THEN
194 indi = 2
195 ELSEIF (nfunc>7) THEN
196 indi = 3
197 ENDIF
198 IF (mat_param(abs(mid))%IVISC > 0) THEN
199 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
200 ENDIF
201 ELSEIF((mln==42).OR.(mln==62).OR.(mln==69)) THEN ! check prony option
202 nfunc = 0 ! NPRONY
203 IF (mln==42) nfunc = mat_param(abs(mid))%IPARAM(2)
204 IF (mln==62) THEN
205 iad=ipm(7,abs(mid))-1
206 nfunc = nint(bufmat(iad+3))
207 END IF
208
209 IF(nfunc==0) THEN
210 indi = 1
211 IF (mat_param(abs(mid))%IVISC > 0) THEN
212 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
213 ENDIF
214 ELSEIF(nfunc==1) THEN
215 indi = 2
216 ELSEIF(nfunc==2) THEN
217 indi = 3
218 ELSEIF(nfunc>2) THEN
219 indi = 3
220 mult = nfunc - 2
221 indi2 = 2
222 ENDIF
223 ELSEIF((mln==82)) THEN
224 iad=ipm(7,abs(mid))-1
225 nfunc=nint(bufmat(iad+1))
226 IF(nfunc<=1) THEN
227 indi = 1
228 IF (mat_param(abs(mid))%IVISC > 0) THEN
229 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
230 ENDIF
231 ELSEIF(nfunc==2) THEN
232 indi = 2
233 ELSEIF(nfunc==3) THEN
234 indi = 3
235 ELSEIF(nfunc>3) THEN
236 indi = 3
237 mult = nfunc - 3
238 indi2 = 2
239 ENDIF
240 ELSEIF(mln==104) THEN
241 iad=ipm(7,abs(mid))-1
242 flag_nice_newton=nint(bufmat(iad+11))
243 IF(flag_nice_newton==2) THEN ! Newtow algo
244 indi = 2
245 ELSE ! Nice algo
246 indi = 1
247 ENDIF
248 flag_gurson=nint(bufmat(iad+30))
249 IF(flag_gurson/=0) THEN
250 special_option=1
251 spe_i_1 = 1
252 spe_i_2 = 1
253 ENDIF
254 IF(flag_gurson==1) THEN
255 spe_i_2 = 1
256 ELSEIF(flag_gurson==2) THEN
257 spe_i_2 = 2
258 ELSEIF(flag_gurson==3) THEN
259 spe_i_2 = 3
260 ENDIF
261 flag_non_local = mat_param(abs(mid))%NLOC
262 ELSE
263 indi = 1
264 IF (mat_param(abs(mid))%IVISC > 0) THEN
265 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
266 ENDIF
267 ENDIF
268
269 mult_spe = 0.
270 spe_i_3 = 1
271 IF(flag_non_local/=0) THEN
272 spe_i_3 = 2
273 mult_spe = npt
274 ENDIF
275
276 cost_check = 0
277!****************************************
278! ---------------------------
279! SHELL3N ELEMENT
280! ---------------------------
281 ! check if the (mid,pid) cost must be initialized from a previous run
282 IF(recherche==0.AND.test_poids/=0) THEN
283 poin_part = ipartg(i)
284 poin_mid = poin_part_tri(1,poin_part)
285 poin_pid = poin_part_tri(2,poin_part)
286 ! if POIN_MID==0 and POIN_PID == 0, the element cost in the .ddw file is 0 --> must be initialized
287 ! from the .inc file
288 IF(poin_mid/=0.AND.poin_pid/=0) THEN
289 IF(mid_pid_tri(poin_mid)%COST1D(poin_pid)/=zero) THEN
290 cost_check = 1
291 telt = mid_pid_tri(poin_mid)%COST1D(poin_pid)
292 ENDIF
293 ENDIF
294 ENDIF
295 ! the (mid,pid) cost must be initialized from .inc file
296 IF(cost_check==0) THEN
297 IF( ddweights(1,2,mid)/=zero)THEN
298! Compute time according to integration points:
299 a1 = ddweights(1,2,mid) * tpsref
300 a2 = ddweights(2,2,mid) * tpsref
301
302 IF (a2 /=zero)THEN
303! Compute line function A1 ="Time for 1 int Point" - A2="time for 5 int points"
304 a = (a2-a1)/4
305 b = a1-a
306 timmat = a*npt + b
307 ELSE
308 timmat = a1*npt
309 ENDIF
310! --------------
311! Failure
312 IF(nfail/=0) THEN
313 DO j=1,nfail
314 a1 = rupture_shell(irup_tab(j),irup2+1)
315 a2 = rupture_shell(irup_tab(j),irup2+3)
316 IF (a2 /=zero)THEN
317 a = (a2-a1)/4
318 b = a1-a
319 trup = trup + a*npt + b
320 ELSE
321 trup = trup + a1*npt
322 ENDIF
323 ENDDO
324 ENDIF
325! --------------
326 ELSE
327 IF(ithk==2)THEN
328 ithk = 0
329 ELSEIF(mln==32)THEN
330 ithk = 1
331 ENDIF
332 istrain = nint(geo(11,pid))
333 IF(mln==19.OR.mln>=25)istrain = 1
334 issn = nint(geo(3,pid))
335! ow test elem delete
336 IF (wd_local==0.) THEN
337 IF(abs(npn)>0) THEN
338 tabx(1) = 1.
339 tabx(2) = 3.
340 tabx(3) = 5.
341 ! *******--------*******
342 DO j=1,3
343 IF(mult/=0) tmatadd = mult *
344 . (tritnl(min(mln,maxlaw),j,indi) - tritnl(min(mln,maxlaw),j,indi2) )
345 IF(special_option/=0) tmatadd = tmatadd + shtnl_option(spe_i_1,spe_i_2)
346 tabmat(j) = tritnl(min(mln,maxlaw),j,indi) + tmatadd
347 ENDDO
348 ! *******--------*******
349 npt = abs(npn)
350 CALL interlagran(tabmat,tabx,3,npt,timmat)
351! ----------------
352! Failure
353 IF(nfail/=0) THEN
354 DO j=1,nfail
355 DO ii=1,3
356 tabrup(ii) = rupture_shell(irup_tab(j),irup2+ii)
357 ENDDO
358 CALL interlagran(tabrup,tabx,3,npt,trup_local)
359 trup = trup + trup_local
360 ENDDO
361 ENDIF ! <--- fin NFAIL/=0
362! ----------------
363
364 ELSE
365! 0pt d integration doit etre traite a part
366 ! *******--------*******
367 IF(mult/=0) tmatadd = mult *
368 . (tritnl(min(mln,maxlaw),0,indi) - tritnl(min(mln,maxlaw),0,indi2) )
369 timmat = tritnl(min(mln,maxlaw),0,indi) + tmatadd
370 ! *******--------*******
371! ----------------
372! failure incompatible n=0
373 IF(nfail/=0) THEN
374 trup = 0.
375 ENDIF ! <--- fin NFAIL/=0
376! ----------------
377 ENDIF
378 ENDIF
379 ENDIF
380 IF(mln/=0)THEN
381 telt = tritelt(1)
382 ENDIF
383 ENDIF ! fin TRITNL_OLD(MID,PID)
384!****************************************
385
386 ! --------------------
387 IF(recherche==0) THEN
388 IF((wd_local==0.).AND.(mln/=0))THEN
389 poids = (telt + timmat + trup + mult_spe*nlocal_option(spe_i_3) + visc_prony) * invtref
390 wd(i+off) = poids
391
392 poin_part = ipartg(i)
393 poin_mid = poin_part_tri(1,poin_part)
394 poin_pid = poin_part_tri(2,poin_part)
395 IF(poin_mid/=0.AND.poin_pid/=0)
396 . mid_pid_tri(poin_mid)%COST1D(poin_pid) = telt + timmat + trup +
397 . mult_spe*nlocal_option(spe_i_3)
398 ELSE
399 wd(i+off) = 0.0001
400 END IF
401 ELSE
402 telt_pro = telt + timmat + trup + mult_spe*nlocal_option(spe_i_3)
403 ENDIF
404 ! --------------------
405 ENDDO
406 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
max
#define max(a, b)
Definition macros.h:21
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