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