OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initwg.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/.
23C NEW ROUTINE TO FILL THE WEIGHT TABLE
24!||====================================================================
25!|| initwg ../starter/source/spmd/domain_decomposition/initwg.F
26!||--- called by ------------------------------------------------------
27!|| dometis ../starter/source/spmd/domain_decomposition/grid2mat.F
28!||--- calls -----------------------------------------------------
29!|| init_mid_pid_array ../starter/source/spmd/tools/init_mid_pid_array.F
30!|| initwg_poutre ../starter/source/spmd/domain_decomposition/initwg_poutre.F
31!|| initwg_quad ../starter/source/spmd/domain_decomposition/initwg_quad.F
32!|| initwg_ressort ../starter/source/spmd/domain_decomposition/initwg_ressort.F
33!|| initwg_shell ../starter/source/spmd/domain_decomposition/initwg_shell.F
34!|| initwg_solid ../starter/source/spmd/domain_decomposition/initwg_solid.F
35!|| initwg_tri ../starter/source/spmd/domain_decomposition/initwg_tri.F
36!|| initwg_truss ../starter/source/spmd/domain_decomposition/initwg_truss.F
37!|| initwg_x ../starter/source/spmd/domain_decomposition/initwg_x.F
38!||--- uses -----------------------------------------------------
39!|| ddweights_mod ../starter/share/modules1/ddweights_mod.F
40!|| mid_pid_mod ../starter/share/modules1/mid_pid_mod.F
41!||====================================================================
42 SUBROUTINE initwg(WD,PM,GEO,IXS,IXQ,
43 . IXC,IXT,IXP,IXR,IXTG,
44 . KXX,IGEO,ISOLNOD,IDARCH,
45 . NUMELS,NUMELQ,NUMELC,NUMELT,NUMELP,
46 . NUMELR,NUMELTG,NUMELX,IPM ,
47 . BUFMAT,NUMMAT,NUMGEO,TAILLE,POIN_UMP,
48 . TAB_UMP,POIN_UMP_OLD,TAB_UMP_OLD,CPUTIME_MP_OLD,
49 . TABMP_L,IPART,IPARTC,IPARTG,
50 . IPARTS,NPART,POIN_PART_SHELL,POIN_PART_TRI,POIN_PART_SOL,
51 . MID_PID_SHELL,MID_PID_TRI,MID_PID_SOL,IDDLEVEL,
52 . MAT_PARAM)
53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
56 USE ddweights_mod
57 USE mid_pid_mod
58 USE matparam_def_mod
59 use element_mod , only : nixs,nixq,nixc,nixp,nixt,nixr,nixtg
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "param_c.inc"
68#include "com01_c.inc"
69#include "scr17_c.inc"
70#include "tablen_c.inc"
71#include "scr23_c.inc"
72#include "ddspmd_c.inc"
73#include "units_c.inc"
74C-----------------------------------------------
75C D u m m y A r g u m e n t s
76C-----------------------------------------------
77 INTEGER IDARCH,
78 . NUMELS,NUMELQ,NUMELC,NUMELT,NUMELP,
79 . NUMELR,NUMELTG,NUMELX,
80 . NUMMAT,NUMGEO,TAILLE,
81 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),
82 . IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),
83 . KXX(NIXX,*),IGEO(NPROPGI,*),ISOLNOD(*),
84 . IPM(NPROPMI,*),TABMP_L,NPART,IDDLEVEL
85 INTEGER, DIMENSION(NUMMAT_OLD) :: POIN_UMP_OLD
86 INTEGER, DIMENSION(7,TAILLE_OLD) :: TAB_UMP_OLD
87 INTEGER, DIMENSION(NUMMAT) :: POIN_UMP
88 INTEGER, DIMENSION(7,TAILLE) :: TAB_UMP
89 INTEGER, DIMENSION(LIPART1,*), INTENT(IN) :: IPART
90 INTEGER, DIMENSION(*), INTENT(IN) :: IPARTC,IPARTG,IPARTS
91
92 INTEGER, DIMENSION(2,NPART), INTENT(INOUT) :: POIN_PART_SHELL,POIN_PART_TRI
93 INTEGER, DIMENSION(2,NPART,7), INTENT(INOUT) :: POIN_PART_SOL
94 TYPE(MID_PID_TYPE), DIMENSION(NUMMAT), INTENT(INOUT) :: MID_PID_SHELL,MID_PID_TRI
95 TYPE(mid_pid_type), DIMENSION(NUMMAT,7), INTENT(INOUT) :: MID_PID_SOL
96
97C REAL OR REAL*8
98 my_real
99 . pm(npropm,*), geo(npropg,*),bufmat(*)
100 my_real, DIMENSION(TAILLE_OLD) :: cputime_mp_old
101 REAL WD(*)
102 TYPE(matparam_struct_) ,DIMENSION(NUMMAT), INTENT(IN) :: MAT_PARAM
103C-----------------------------------------------
104 INTEGER OFF, NPN, MID, PID, JHBE, IGT, MLN,
105 . istrain, ithk, ihbe, ipla, issn, mtn, i, j, k,l,
106 . nfunc,mpt,npts,nptt,nptr,nptot,iflag,jsrot,
107 . nfunc1,nfunc2,irup,ii,irup2,irup_tab(6),
108 . i_mid,i_pid,i_mid_old,i_pid_old,puid,muid,
109 . elm_typ,elm_typ_old,ilaw,ilaw_old,test_mat,
110 . i_pro,isol,mid_old,pid_old,muid_old,puid_old,
111 . test,recherche,numel_re,iad,indi,
112 . max_elm_old,max_elm,max_elm_old_36_2,max_elm_36_2,
113 . k_36_2,i_pro_36_2,nbr_elm
114
115 INTEGER, DIMENSION(TAILLE) :: CONCORDANCE_MAT
116 REAL
117 . WTYPE(9),FWIHBE,FAC8,
118 . TABMAT(3),TABX(3),TIMMAT,NPT,TELT,POIDS,W,
119 . BATOZMULT,TMAT,TABRUP(3),TRUP_LOCAL,TRUP
120 my_real INVTELT_PRO,TELT_PRO
121
122 INTEGER, DIMENSION(NUMMAT) :: PID_SHELL,PID_TRI
123 INTEGER, DIMENSION(NUMMAT,7) :: PID_SOL
124 INTEGER :: IPID,ID,IGTYP,MODE
125
126 my_real
127 . cc, invtref,a,b,a1,a2
128 my_real, DIMENSION(TAILLE_OLD) :: cputime_mp_old_2
129 INTEGER :: SIZE_IRUP !Maximum number of rupture criteria
130
131
132 DATA wtype /1.6 ,1. ,1. ,.9 ,1.1 ,1.4 ,0.65 ,.9 ,2.0/
133! ---------------------------------------------------------------------
134
135
136 size_irup = 0
137 DO i = 1, nummat
138 size_irup = max(size_irup, mat_param(i)%NFAIL)
139 ENDDO
140
141 IF(iddlevel==0) THEN
142 poin_part_shell(1:2,1:npart) = 0
143 poin_part_tri(1:2,1:npart) = 0
144 poin_part_sol(1:2,1:npart,1:7) = 0
145 pid_shell(1:nummat) = 0
146 pid_tri(1:nummat) = 0
147 pid_sol(1:nummat,1:7) = 0
148
149
150 mode = 0
151 CALL init_mid_pid_array(mode ,taille ,nummat ,npart ,concordance_mat,
152 1 tab_ump ,pid_shell ,pid_tri ,pid_sol,
153 2 mid_pid_shell ,mid_pid_tri ,mid_pid_sol,
154 3 ipart ,ipm ,geo ,cputime_mp_old_2,
155 4 poin_part_shell,poin_part_tri,poin_part_sol)
156 ENDIF
157 concordance_mat(1:taille) = 0
158C-----------------------------------------------
159 IF(domdec_tuning/=0) WRITE(iout,'(A)')
160 . ' DOMAIN DECOMPOSITION : MANUAL TUNING'
161 IF(dd_optimization==1) THEN
162! Skylake processor
163 WRITE(iout,'(A)')
164 . ' DOMAIN DECOMPOSITION : OPTIMIZED FOR SKYLAKE PROCESSOR'
165 ELSEIF(dd_optimization==2) THEN
166! Sandy Bridge processor
167 WRITE(iout,'(A)')
168 . ' DOMAIN DECOMPOSITION : OPTIMIZED FOR SANDY BRIDGE PROCESSOR'
169 ELSEIF(dd_optimization==3) THEN
170! ThunderX2 processor (ARMV8.0)
171 WRITE(iout,'(A)')
172 . ' DOMAIN DECOMPOSITION : OPTIMIZED FOR ARM64 PROCESSOR'
173 ELSEIF(dd_optimization==0.OR.dd_optimization==4) THEN
174! Win64 machine --> AVX-2 Broadwell processor
175 dd_optimization = 0
176 WRITE(iout,'(A)')
177 . ' DOMAIN DECOMPOSITION : OPTIMIZED FOR BROADWELL PROCESSOR'
178 ENDIF
179C-----------------------------------------------
180 i_pro = 0
181 i_pro_36_2 = 0
182 IF( (test_poids==1).AND.
183 . (nummat_old/=0).AND.
184 . (numgeo_old/=0).AND.
185 . (taille_old/=0) ) THEN
186
187
188 max_elm = -1
189 max_elm_old = -1
190 max_elm_36_2 = -1
191 max_elm_old_36_2 = -1
192 DO i=1,taille_old
193 ilaw_old = tab_ump_old(6,i)
194 muid_old = tab_ump_old(1,i)
195 mid_old = tab_ump_old(3,i)
196 puid_old = tab_ump_old(2,i)
197 elm_typ_old = tab_ump_old(7,i)
198 pid_old = tab_ump_old(4,i)
199
200 IF(cputime_mp_old(i)>zero) THEN
201 DO j=1,taille
202 ilaw = tab_ump(6,j)
203 muid = tab_ump(1,j)
204 mid = tab_ump(3,j)
205 puid = tab_ump(2,j)
206 elm_typ = tab_ump(7,j)
207 pid = tab_ump(4,j)
208
209 IF((ilaw==ilaw_old).AND.(muid_old==muid).AND.
210 . (puid_old==puid).AND.(elm_typ==elm_typ_old) ) THEN
211 concordance_mat(j) = i
212 ! Check the material/property couple with the higher number of element
213 ! ILAW must be different from 0, 29, 30, 31 and 99 (user routines)
214 IF((ilaw/=0).OR.(ilaw/=29).OR.(ilaw/=30).OR.
215 . (ilaw/=31).OR.(ilaw<99)) THEN
216 max_elm_old = max_elm
217 max_elm = max(max_elm,tab_ump_old(5,i))
218 ! Material 2 or 36 are favoured
219 IF((ilaw==2).OR.(ilaw==36)) THEN
220 max_elm_old_36_2 = max_elm_36_2
221 max_elm_36_2 = max(max_elm_36_2,tab_ump_old(5,i))
222 IF( (max_elm_old_36_2<max_elm_36_2) ) i_pro_36_2 = j
223 ENDIF
224 IF( (max_elm_old<max_elm) ) i_pro = j
225 ENDIF
226 ENDIF
227 ENDDO
228 ENDIF
229 ENDDO
230
231 ! --------------------------
232 ! find the weight reference TELT_PRO
233 i=0
234 test_mat = 0
235 recherche = 1
236 numel_re = 1
237 k = 0
238 off = 0
239 IF(i_pro_36_2>0) THEN
240 k_36_2 = concordance_mat(i_pro_36_2)
241 nbr_elm = tab_ump_old(5,k_36_2)
242 IF(nbr_elm>1024) i_pro = i_pro_36_2
243 ENDIF
244 IF(i_pro>0) k = concordance_mat(i_pro)
245 IF(k/=0) THEN
246 elm_typ_old = tab_ump_old(7,k)
247 mln = tab_ump_old(6,k)
248 mid = tab_ump_old(3,k)
249 pid = tab_ump_old(4,k)
250! --------------------------
251! SHELL
252 IF(elm_typ_old==3) THEN
253 test_mat = 1
254 CALL initwg_shell(wd,pm,geo,ixc,igeo,size_irup,
255 . numel_re,ipm,nummat,numgeo,poin_part_shell,
256 . mid_pid_shell,ipartc,off,bufmat,
257 . mid,pid,mln,recherche,telt_pro,
258 . tabmp_l,mat_param)
259! --------------------------
260! TRI
261 ELSEIF(elm_typ_old==7) THEN
262 test_mat = 1
263 CALL initwg_tri(wd,pm,geo,ixtg,igeo,numel_re,ipm ,size_irup,
264 . nummat,numgeo,poin_part_tri,mid_pid_tri,ipartg,
265 . off,bufmat,mid,pid,mln,recherche,telt_pro,
266 . tabmp_l,mat_param)
267
268! --------------------------
269! OTHER
270 ELSEIF((elm_typ_old==1004).OR.(elm_typ_old==1010).OR.
271 . (elm_typ_old==1) .OR.(elm_typ_old==1006).OR.
272 . (elm_typ_old==1008).OR.(elm_typ_old==1016).OR.
273 . (elm_typ_old==1020)) THEN
274 test_mat = 1
275 IF(elm_typ_old>1000) THEN
276 isol = elm_typ_old - 1000
277 ELSE
278 isol = 1
279 ENDIF
280 CALL initwg_solid(wd,pm,geo,ixs,igeo,isolnod,
281 . numel_re,ipm ,size_irup,
282 . nummat,numgeo,
283 . poin_part_sol,mid_pid_sol,iparts,bufmat,
284 . mid,pid,mln,recherche,isol,
285 . telt_pro,tabmp_l,npart,mat_param)
286 ENDIF
287 ! --------------------------
288 ! Convert the old weight : new_weight = old_weight*reference_weight/reference_old_weight
289 ! weight = 0 if new material/property couple
290 ! --------------------------
291 invtelt_pro = telt_pro/cputime_mp_old(k)
292 DO i=1,taille_old
293 IF(cputime_mp_old(i)>zero) THEN
294 cputime_mp_old_2(i) = cputime_mp_old(i) * invtelt_pro
295 ELSE
296 cputime_mp_old_2(i) = zero
297 ENDIF
298 ENDDO
299 mode = 1
300 CALL init_mid_pid_array(mode ,taille ,nummat ,npart ,concordance_mat,
301 1 tab_ump ,pid_shell ,pid_tri ,pid_sol,
302 2 mid_pid_shell ,mid_pid_tri ,mid_pid_sol,
303 3 ipart ,ipm ,geo ,cputime_mp_old_2,
304 4 poin_part_shell,poin_part_tri,poin_part_sol)
305 ! --------------------------
306 ENDIF ! K/=0
307 ! --------------------------
308 ENDIF ! (TEST_POIDS==1).AND. ...
309C-----------------------------------------------
310 recherche = 0
311 mid = 0
312 pid = 0
313 mln = 0
314 isol = 0
315C -------------------------------
316C Element Property initialization
317C -------------------------------
318 CALL initwg_solid(wd,pm,geo,ixs,igeo,isolnod,
319 . numels,ipm ,size_irup,
320 . nummat,numgeo,
321 . poin_part_sol,mid_pid_sol,iparts,bufmat,
322 . mid,pid,mln,recherche,isol,
323 . telt_pro,tabmp_l,npart,mat_param)
324C
325 off = numels
326! --------------------
327 CALL initwg_quad(wd,pm,geo,ixq,igeo,
328 . numelq,ipm,off)
329C
330 off = off + numelq
331! --------------------
332 CALL initwg_shell(wd,pm,geo,ixc,igeo,size_irup,
333 . numelc,ipm,nummat,numgeo,poin_part_shell,
334 . mid_pid_shell,ipartc,off,bufmat,
335 . mid,pid,mln,recherche,telt_pro,
336 . tabmp_l,mat_param)
337C
338 off = off + numelc
339! --------------------
340 CALL initwg_truss(wd,pm,geo,ixt,igeo,
341 . numelt,ipm,nummat,numgeo,off)
342C
343 off = off + numelt
344! --------------------
345 CALL initwg_poutre(wd,pm,geo,ixp,igeo,
346 . numelp,ipm,nummat,numgeo,off)
347C
348 off = off + numelp
349! --------------------
350 CALL initwg_ressort(wd,pm,geo,ixr,igeo,
351 . numelr,ipm,nummat,numgeo,off)
352C
353 off = off + numelr
354! --------------------
355 CALL initwg_tri(wd,pm,geo,ixtg,igeo,numeltg,ipm , size_irup,
356 . nummat,numgeo,poin_part_tri,mid_pid_tri,ipartg,
357 . off,bufmat,mid,pid,mln,recherche,telt_pro,
358 . tabmp_l,mat_param)
359C
360 off = off + numeltg
361! --------------------
362 CALL initwg_x(wd,pm,geo,kxx,igeo,
363 . numelx,ipm,nummat,numgeo,off)
364C
365 off = off + numelx
366! --------------------
367
368 RETURN
369 END
my_real
#define my_real
Definition cppsort.cpp:32
init_mid_pid_array
subroutine init_mid_pid_array(mode, taille, nummat, npart, concordance_mat, tab_ump, pid_shell, pid_tri, pid_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, ipart, ipm, geo, cputime_mp_old_2, poin_part_shell, poin_part_tri, poin_part_sol)
Definition init_mid_pid_array.F:36
initwg
subroutine initwg(wd, pm, geo, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, kxx, igeo, isolnod, idarch, numels, numelq, numelc, numelt, numelp, numelr, numeltg, numelx, ipm, bufmat, nummat, numgeo, taille, poin_ump, tab_ump, poin_ump_old, tab_ump_old, cputime_mp_old, tabmp_l, ipart, ipartc, ipartg, iparts, npart, poin_part_shell, poin_part_tri, poin_part_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, iddlevel, mat_param)
Definition initwg.F:53
initwg_poutre
subroutine initwg_poutre(wd, pm, geo, ixp, igeo, numelp, ipm, nummat, numgeo, off)
Definition initwg_poutre.F:32
initwg_quad
subroutine initwg_quad(wd, pm, geo, ixq, igeo, numelq, ipm, off)
Definition initwg_quad.F:32
initwg_ressort
subroutine initwg_ressort(wd, pm, geo, ixr, igeo, numelr, ipm, nummat, numgeo, off)
Definition initwg_ressort.F:32
initwg_shell
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)
Definition initwg_shell.F:39
initwg_solid
subroutine initwg_solid(wd, pm, geo, ixs, igeo, isolnod, numels, ipm, size_irup, nummat, numgeo, poin_part_sol, mid_pid_sol, iparts, bufmat, mid_old, pid_old, mln_old, recherche, isol_old, telt_pro, tabmp_l, npart, mat_param)
Definition initwg_solid.F:39
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
initwg_truss
subroutine initwg_truss(wd, pm, geo, ixt, igeo, numelt, ipm, nummat, numgeo, off)
Definition initwg_truss.F:32
initwg_x
subroutine initwg_x(wd, pm, geo, kxx, igeo, numelx, ipm, nummat, numgeo, off)
Definition initwg_x.F:32
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
mid_pid_mod::mid_pid_type
Definition mid_pid_mod.F:44