OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initwg.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "scr17_c.inc"
#include "tablen_c.inc"
#include "scr23_c.inc"
#include "ddspmd_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ initwg()

subroutine initwg ( real, dimension(*) wd,
pm,
geo,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(nixc,*) ixc,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(nixx,*) kxx,
integer, dimension(npropgi,*) igeo,
integer, dimension(*) isolnod,
integer idarch,
integer numels,
integer numelq,
integer numelc,
integer numelt,
integer numelp,
integer numelr,
integer numeltg,
integer numelx,
integer, dimension(npropmi,*) ipm,
bufmat,
integer nummat,
integer numgeo,
integer taille,
integer, dimension(nummat) poin_ump,
integer, dimension(7,taille) tab_ump,
integer, dimension(nummat_old) poin_ump_old,
integer, dimension(7,taille_old) tab_ump_old,
dimension(taille_old) cputime_mp_old,
integer tabmp_l,
integer, dimension(lipart1,*), intent(in) ipart,
integer, dimension(*), intent(in) ipartc,
integer, dimension(*), intent(in) ipartg,
integer, dimension(*), intent(in) iparts,
integer npart,
integer, dimension(2,npart), intent(inout) poin_part_shell,
integer, dimension(2,npart), intent(inout) poin_part_tri,
integer, dimension(2,npart,7), intent(inout) poin_part_sol,
type(mid_pid_type), dimension(nummat), intent(inout) mid_pid_shell,
type(mid_pid_type), dimension(nummat), intent(inout) mid_pid_tri,
type(mid_pid_type), dimension(nummat,7), intent(inout) mid_pid_sol,
integer iddlevel,
type(matparam_struct_), dimension(nummat), intent(in) mat_param )

Definition at line 42 of file initwg.F.

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
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_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