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