OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initwg_tri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| initwg_tri ../starter/source/spmd/domain_decomposition/initwg_tri.F
25!||--- called by ------------------------------------------------------
26!|| initwg ../starter/source/spmd/domain_decomposition/initwg.F
27!||--- calls -----------------------------------------------------
28!|| bidon ../starter/source/system/machine.F
29!|| interlagran ../starter/source/spmd/domain_decomposition/grid2mat.F
30!||--- uses -----------------------------------------------------
31!|| ddweights_mod ../starter/share/modules1/ddweights_mod.F
32!|| mid_pid_mod ../starter/share/modules1/mid_pid_mod.F
33!||====================================================================
34 SUBROUTINE initwg_tri(WD,PM,GEO,IXTG,IGEO,NUMELTG,IPM ,SIZE_IRUP,
35 . NUMMAT,NUMGEO,POIN_PART_TRI,MID_PID_TRI,IPARTG,
36 . OFF,BUFMAT,MID_OLD,PID_OLD,MLN_OLD,RECHERCHE,TELT_PRO,
37 . TABMP_L,MAT_PARAM)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE ddweights_mod
42 USE mid_pid_mod
43 USE matparam_def_mod
44 use element_mod , only : nixtg
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 OFF,NUMELTG,TABMP_L,
60 . NUMMAT,NUMGEO, IXTG(NIXTG,*),IGEO(NPROPGI,*),
61 . IPM(NPROPMI,*)
62 INTEGER, INTENT(IN) :: SIZE_IRUP
63
64C REAL OR REAL*8
65 my_real
66 . pm(npropm,*), geo(npropg,*),bufmat(*)
67
68 REAL WD(*)
69 INTEGER MID_OLD,PID_OLD,MLN_OLD,RECHERCHE
70 my_real TELT_PRO
71
72 INTEGER, DIMENSION(*), INTENT(IN) :: IPARTG
73 INTEGER, DIMENSION(2,*), INTENT(IN) :: POIN_PART_TRI
74 TYPE(MID_PID_TYPE), DIMENSION(*), INTENT(INOUT) :: MID_PID_TRI
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,iflag,
80 .
81 .
82 .
83 . nfail,irup2,ii,irup_tab(size_irup),
84 . indi,iad,indi2,mult
85 INTEGER :: INDI3,COST_CHECK,POIN_PART,POIN_MID,POIN_PID
86 INTEGER :: FLAG_NICE_NEWTON,FLAG_GURSON,FLAG_NON_LOCAL
87 INTEGER :: SPECIAL_OPTION,SPE_I_1,SPE_I_2,SPE_I_3
88
89 real
90 . wtype(9),
91 . tabmat(3),tabx(3),timmat,npt,telt,poids,
92 . batozmult,trup,tabrup(3),trup_local,tmatadd,
93 . wd_local,mult_spe,visc_prony
94
95 my_real
96 . cc, a,b,a1,a2
97 my_real
98 . invtref
99 DATA wtype /1.6 ,1. ,1. ,.9 ,1.1 ,1.4 ,0.65 ,.9 ,2.0/
100C-----------------------------------------------
101 CALL bidon()
102 telt = 0
103 nfunc = 0
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 = 2
129 DO i = 1, numeltg
130 mid= ixtg(1,i)
131 pid= ixtg(5,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 ihbe = nint(geo(171,pid))
144 ithk = nint(geo(35,pid))
145 ipla = nint(geo(39,pid))
146 npt = max(abs(npn),1)
147 flag_non_local = 0
148 special_option = 0
149 spe_i_1 = 1
150 spe_i_2 = 1
151 nfail = mat_param(mid)%NFAIL
152 irup_tab = 0
153 IF(nfail/=0) THEN ! up to 6 failure models per material
154 DO j=1,nfail
155 irup_tab(j) = mat_param(mid)%FAIL(j)%IRUPT
156 ENDDO
157 ENDIF
158 timmat = 0.
159 trup = 0.
160 tmatadd = 0.
161 visc_prony = 0.
162 mult = 0
163 IF((mln<28).OR.(mln==32)) THEN
164 irup2 = 0
165 ELSE
166 irup2 = 3
167 ENDIF
168
169 IF (mln==2.OR.mln==3) THEN
170 cc = pm(43,mid)
171 IF (cc/=0) THEN
172 indi = 2
173 ELSE
174 indi = 1
175 ENDIF
176 IF (mat_param(abs(mid))%IVISC > 0) THEN
177 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
178 ENDIF
179 ELSEIF ((mln==25).AND.(abs(npn)>0)) THEN
180 iflag = nint( pm(40,mid))
181 IF (iflag/=0) THEN
182 indi = 2
183 ELSE
184 indi = 1
185 ENDIF
186 IF (mat_param(abs(mid))%IVISC > 0) THEN
187 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
188 ENDIF
189C Law 36+86 Depending on the FCT
190 ELSEIF (mln==36.OR.(mln==86).AND.(abs(npn)>0)) THEN
191 nfunc = nint(pm(40,mid))
192 IF (nfunc<=2) THEN
193 indi = 1
194 ELSEIF (nfunc>2.AND.nfunc<=7) THEN
195 indi = 2
196 ELSEIF (nfunc>7) THEN
197 indi = 3
198 ENDIF
199 IF (mat_param(abs(mid))%IVISC > 0) THEN
200 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
201 ENDIF
202 ELSEIF((mln==42).OR.(mln==62).OR.(mln==69)) THEN ! check prony option
203 nfunc = 0 ! NPRONY
204 IF (mln==42) nfunc = mat_param(abs(mid))%IPARAM(2)
205 IF (mln==62) THEN
206 iad=ipm(7,abs(mid))-1
207 nfunc = nint(bufmat(iad+3))
208 END IF
209
210 IF(nfunc==0) THEN
211 indi = 1
212 IF (mat_param(abs(mid))%IVISC > 0) THEN
213 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
214 ENDIF
215 ELSEIF(nfunc==1) THEN
216 indi = 2
217 ELSEIF(nfunc==2) THEN
218 indi = 3
219 ELSEIF(nfunc>2) THEN
220 indi = 3
221 mult = nfunc - 2
222 indi2 = 2
223 ENDIF
224 ELSEIF((mln==82)) THEN
225 iad=ipm(7,abs(mid))-1
226 nfunc=nint(bufmat(iad+1))
227 IF(nfunc<=1) THEN
228 indi = 1
229 IF (mat_param(abs(mid))%IVISC > 0) THEN
230 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
231 ENDIF
232 ELSEIF(nfunc==2) THEN
233 indi = 2
234 ELSEIF(nfunc==3) THEN
235 indi = 3
236 ELSEIF(nfunc>3) THEN
237 indi = 3
238 mult = nfunc - 3
239 indi2 = 2
240 ENDIF
241 ELSEIF(mln==104) THEN
242 iad=ipm(7,abs(mid))-1
243 flag_nice_newton=nint(bufmat(iad+11))
244 IF(flag_nice_newton==2) THEN ! Newtow algo
245 indi = 2
246 ELSE ! Nice algo
247 indi = 1
248 ENDIF
249 flag_gurson=nint(bufmat(iad+30))
250 IF(flag_gurson/=0) THEN
251 special_option=1
252 spe_i_1 = 1
253 spe_i_2 = 1
254 ENDIF
255 IF(flag_gurson==1) THEN
256 spe_i_2 = 1
257 ELSEIF(flag_gurson==2) THEN
258 spe_i_2 = 2
259 ELSEIF(flag_gurson==3) THEN
260 spe_i_2 = 3
261 ENDIF
262 flag_non_local = mat_param(abs(mid))%NLOC
263 ELSE
264 indi = 1
265 IF (mat_param(abs(mid))%IVISC > 0) THEN
266 visc_prony = visc_prony_cost * mat_param(abs(mid))%VISC%IPARAM(1)
267 ENDIF
268 ENDIF
269
270 mult_spe = 0.
271 spe_i_3 = 1
272 IF(flag_non_local/=0) THEN
273 spe_i_3 = 2
274 mult_spe = npt
275 ENDIF
276
277 cost_check = 0
278!****************************************
279! ---------------------------
280! SHELL3N ELEMENT
281! ---------------------------
282 ! check if the (mid,pid) cost must be initialized from a previous run
283 IF(recherche==0.AND.test_poids/=0) THEN
284 poin_part = ipartg(i)
285 poin_mid = poin_part_tri(1,poin_part)
286 poin_pid = poin_part_tri(2,poin_part)
287 ! if POIN_MID==0 and POIN_PID == 0, the element cost in the .ddw file is 0 --> must be initialized
288 ! from the .inc file
289 IF(poin_mid/=0.AND.poin_pid/=0) THEN
290 IF(mid_pid_tri(poin_mid)%COST1D(poin_pid)/=zero) THEN
291 cost_check = 1
292 telt = mid_pid_tri(poin_mid)%COST1D(poin_pid)
293 ENDIF
294 ENDIF
295 ENDIF
296 ! the (mid,pid) cost must be initialized from .inc file
297 IF(cost_check==0) THEN
298 IF( ddweights(1,2,mid)/=zero)THEN
299! Compute time according to integration points:
300 a1 = ddweights(1,2,mid) * tpsref
301 a2 = ddweights(2,2,mid) * tpsref
302
303 IF (a2 /=zero)THEN
304! Compute line function A1 ="Time for 1 int Point" - A2="time for 5 int points"
305 a = (a2-a1)/4
306 b = a1-a
307 timmat = a*npt + b
308 ELSE
309 timmat = a1*npt
310 ENDIF
311! --------------
312! Failure
313 IF(nfail/=0) THEN
314 DO j=1,nfail
315 a1 = rupture_shell(irup_tab(j),irup2+1)
316 a2 = rupture_shell(irup_tab(j),irup2+3)
317 IF (a2 /=zero)THEN
318 a = (a2-a1)/4
319 b = a1-a
320 trup = trup + a*npt + b
321 ELSE
322 trup = trup + a1*npt
323 ENDIF
324 ENDDO
325 ENDIF
326! --------------
327 ELSE
328 IF(ithk==2)THEN
329 ithk = 0
330 ELSEIF(mln==32)THEN
331 ithk = 1
332 ENDIF
333 istrain = nint(geo(11,pid))
334 IF(mln==19.OR.mln>=25)istrain = 1
335 issn = nint(geo(3,pid))
336! ow test elem delete
337 IF (wd_local==0.) THEN
338 IF(abs(npn)>0) THEN
339 tabx(1) = 1.
340 tabx(2) = 3.
341 tabx(3) = 5.
342 ! *******--------*******
343 DO j=1,3
344 IF(mult/=0) tmatadd = mult *
345 . (tritnl(min(mln,maxlaw),j,indi) - tritnl(min(mln,maxlaw),j,indi2) )
346 IF(special_option/=0) tmatadd = tmatadd + shtnl_option(spe_i_1,spe_i_2)
347 tabmat(j) = tritnl(min(mln,maxlaw),j,indi) + tmatadd
348 ENDDO
349 ! *******--------*******
350 npt = abs(npn)
351 CALL interlagran(tabmat,tabx,3,npt,timmat)
352! ----------------
353! Failure
354 IF(nfail/=0) THEN
355 DO j=1,nfail
356 DO ii=1,3
357 tabrup(ii) = rupture_shell(irup_tab(j),irup2+ii)
358 ENDDO
359 CALL interlagran(tabrup,tabx,3,npt,trup_local)
360 trup = trup + trup_local
361 ENDDO
362 ENDIF ! <--- fin NFAIL/=0
363! ----------------
364
365 ELSE
366! 0pt d integration doit etre traite a part
367 ! *******--------*******
368 IF(mult/=0) tmatadd = mult *
369 . (tritnl(min(mln,maxlaw),0,indi) - tritnl(min(mln,maxlaw),0,indi2) )
370 timmat = tritnl(min(mln,maxlaw),0,indi) + tmatadd
371 ! *******--------*******
372! ----------------
373! Incompatible failure n = 0
374 IF(nfail/=0) THEN
375 trup = 0.
376 ENDIF ! <--- fin NFAIL/=0
377! ----------------
378 ENDIF
379 ENDIF
380 ENDIF
381 IF(mln/=0)THEN
382 telt = tritelt(1)
383 ENDIF
384 ENDIF ! fin TRITNL_OLD(MID,PID)
385!****************************************
386
387 ! --------------------
388 IF(recherche==0) THEN
389 IF((wd_local==0.).AND.(mln/=0))THEN
390 poids = (telt + timmat + trup + mult_spe*nlocal_option(spe_i_3) + visc_prony) * invtref
391 wd(i+off) = poids
392
393 poin_part = ipartg(i)
394 poin_mid = poin_part_tri(1,poin_part)
395 poin_pid = poin_part_tri(2,poin_part)
396 IF(poin_mid/=0.AND.poin_pid/=0)
397 . mid_pid_tri(poin_mid)%COST1D(poin_pid) = telt + timmat + trup +
398 . mult_spe*nlocal_option(spe_i_3)
399 ELSE
400 wd(i+off) = 0.0001
401 END IF
402 ELSE
403 telt_pro = telt + timmat + trup + mult_spe*nlocal_option(spe_i_3)
404 ENDIF
405 ! --------------------
406 ENDDO
407 RETURN
408 END
my_real
#define my_real
Definition cppsort.cpp:32
interlagran
subroutine interlagran(tab, lx, ltab, x, y)
Definition grid2mat.F:2896
initwg_tri
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)
Definition initwg_tri.F:38
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