OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
initia.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!|| initia ../starter/source/elements/initia/initia.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| addmaspart ../starter/source/tools/admas/addmaspart.F
29!|| ancmsg ../starter/source/output/message/message.F
30!|| arret ../starter/source/system/arret.F
31!|| asstifi ../starter/source/interfaces/inter3d1/asstifi.F
32!|| binit2 ../starter/source/ale/bimat/binit2.F
33!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
34!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
35!|| cdkinit3 ../starter/source/elements/sh3n/coquedk/cdkinit3.F
36!|| checkmp ../starter/source/elements/initia/initia.F
37!|| chekmp2 ../starter/source/elements/initia/initia.F
38!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
39!|| damping_range_init ../starter/source/general_controls/damping/damping_range_init.F90
40!|| detonation_times_printout ../starter/source/initial_conditions/detonation/detonation_times_printout.F90
41!|| dtnoda_stifint ../starter/source/interfaces/inter3d1/dtnoda_stifint.F
42!|| eikonal_solver ../starter/source/initial_conditions/detonation/eikonal_solver.F90
43!|| eporin3 ../starter/source/ale/ale3d/eporin3.F
44!|| fretitl2 ../starter/source/starter/freform.F
45!|| fxbsini ../starter/source/constraints/fxbody/fxbsini.F
46!|| ig3dinit3 ../starter/source/elements/ige3d/ig3dinit3.F
47!|| ini_fvminivel ../starter/source/elements/initia/ini_fvminivel.F
48!|| ini_fxbody ../starter/source/constraints/fxbody/ini_fxbody.F
49!|| ini_inimap1d ../starter/source/initial_conditions/inimap/ini_inimap1d.F
50!|| ini_inimap2d ../starter/stub/ini_inimap2d.F
51!|| ini_seatbelt ../starter/source/tools/seatbelts/ini_seatbelt.F
52!|| iniboltprel ../starter/source/loads/bolt/iniboltprel.f
53!|| inigrav_load ../starter/source/initial_conditions/inigrav/inigrav_load.F
54!|| ininode_rm ../starter/source/materials/mat/mat019/ininode_rm.F
55!|| inintmass ../starter/source/interfaces/inter3d1/inintmass.F
56!|| inirbe2 ../starter/source/constraints/general/rbe2/hm_read_rbe2.F
57!|| inirby ../starter/source/constraints/general/rbody/inirby.F
58!|| inirbys ../starter/source/constraints/general/rbody/inirby.F
59!|| inirig_mat ../starter/source/elements/initia/inirig_mat.F
60!|| inisrf ../starter/source/constraints/general/rbody/inisrf.F
61!|| init_bcs_nrf ../starter/source/boundary_conditions/init_bcs_nrf.F90
62!|| init_bcs_wall ../starter/source/boundary_conditions/init_bcs_wall.F90
63!|| init_inivol ../starter/source/initial_conditions/inivol/init_inivol.F90
64!|| init_rwall_penalty ../starter/source/constraints/general/rwall/init_rwall_penalty.F90
65!|| init_seatbelt_rbodies ../starter/source/tools/seatbelts/init_seatbelt_rbodies.F90
66!|| inivoid ../starter/source/elements/initia/inivoid.F
67!|| inspcnd ../starter/source/elements/sph/inspcnd.f
68!|| laser10 ../starter/source/loads/laser/laser10.F
69!|| lgmini_rby ../starter/source/tools/lagmul/lgmini_rby.F
70!|| modbufel ../starter/source/constraints/fxbody/modbufel.F
71!|| moddepl ../starter/source/constraints/fxbody/moddepl.F
72!|| multifluid_global_tdet ../starter/source/multifluid/multifluid_global_tdet.F
73!|| multifluid_init2 ../starter/source/multifluid/multifluid_init2.F
74!|| multifluid_init2t ../starter/source/multifluid/multifluid_init2t.F
75!|| multifluid_init3 ../starter/source/multifluid/multifluid_init3.F
76!|| multifluid_init3t ../starter/source/multifluid/multifluid_init3t.F
77!|| nloc_dmg_init ../starter/source/materials/fail/nloc_dmg_init.F
78!|| outpart ../starter/source/elements/initia/initia.F
79!|| outpart5 ../starter/source/elements/initia/initia.F
80!|| pinit3 ../starter/source/elements/beam/pinit3.F
81!|| q4init2 ../starter/source/elements/solid_2d/quad4/q4init2.f
82!|| qinit2 ../starter/source/elements/solid_2d/quad/qinit2.F
83!|| rcheckmass ../starter/source/elements/spring/rcheckmass.F
84!|| retrirby ../starter/source/constraints/general/merge/hm_read_merge.F
85!|| rini33_rb ../starter/source/elements/joint/rjoint/rini33_rb.F
86!|| rini45_rb ../starter/source/elements/joint/rjoint/rini45_rb.F
87!|| rinit3 ../starter/source/elements/spring/rinit3.F
88!|| s10init3 ../starter/source/elements/solid/solide10/s10init3.F
89!|| s10jaci3 ../starter/source/elements/solid/solide10/s10jaci3.F
90!|| s16init3 ../starter/source/elements/thickshell/solide16/s16init3.F
91!|| s20init3 ../starter/source/elements/solid/solide20/s20init3.F
92!|| s4init3 ../starter/source/elements/solid/solide4/s4init3.F
93!|| s4refsta3 ../starter/source/elements/solid/solide4/s4refsta3.F
94!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
95!|| s6zinit3 ../starter/source/elements/solid/solide6z/s6zinit3.F90
96!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
97!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
98!|| scaleini ../starter/source/elements/initia/scaleini.F
99!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
100!|| sgsavini ../starter/source/elements/solid/solide/scoor3.F
101!|| sgsavinieref ../starter/source/elements/initia/initia.F
102!|| sgsavinierefq ../starter/source/elements/initia/initia.F
103!|| sgsavref ../starter/source/elements/initia/initia.F
104!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
105!|| sms_auto_dt ../starter/source/ams/sms_auto_dt.F
106!|| spinit3 ../starter/source/elements/sph/spinit3.F
107!|| spmd_msin ../starter/source/elements/initia/spmd_msin.F
108!|| spmd_msin_addmass ../starter/source/elements/initia/spmd_msin_addmass.F
109!|| spmd_partsav_pon ../starter/source/elements/initia/spmd_msin_addmass.F
110!|| srefsta3 ../starter/source/elements/solid/solide/srefsta3.F
111!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
112!|| tinit3 ../starter/source/elements/truss/tinit3.F
113!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
114!|| xinit3 ../starter/source/elements/xelem/xinit3.F
115!||--- uses -----------------------------------------------------
116!|| bpreload_mod ../starter/share/modules1/bpreload_mod.F
117!|| damping_range_init_mod ../starter/source/general_controls/damping/damping_range_init.F90
118!|| defaults_mod ../starter/source/modules/defaults_mod.F90
119!|| detonation_times_printout_mod ../starter/source/initial_conditions/detonation/detonation_times_printout.F90
120!|| detonators_mod ../starter/share/modules1/detonators_mod.F
121!|| drape_mod ../starter/share/modules1/drape_mod.F
122!|| eikonal_solver_mod ../starter/source/initial_conditions/detonation/eikonal_solver.F90
123!|| func2d_mod ../starter/share/modules1/func2d_mod.F
124!|| inimap1d_mod ../starter/share/modules1/inimap1d_mod.F
125!|| inimap2d_mod ../starter/share/modules1/inimap2d_mod.f
126!|| init_bcs_nrf_mod ../starter/source/boundary_conditions/init_bcs_nrf.F90
127!|| init_bcs_wall_mod ../starter/source/boundary_conditions/init_bcs_wall.F90
128!|| init_inivol_mod ../starter/source/initial_conditions/inivol/init_inivol.F90
129!|| init_rwall_penalty_mod ../starter/source/constraints/general/rwall/init_rwall_penalty.F90
130!|| init_seatbelt_rbodies_mod ../starter/source/tools/seatbelts/init_seatbelt_rbodies.F90
131!|| inivol_def_mod ../starter/share/modules1/inivol_mod.F
132!|| message_mod ../starter/share/message_module/message_mod.F
133!|| s6zinit3_mod ../starter/source/elements/solid/solide6z/s6zinit3.F90
134!|| stack_mod ../starter/share/modules1/stack_mod.F
135!|| submodel_mod ../starter/share/modules1/submodel_mod.F
136!||====================================================================
137 SUBROUTINE initia(IPARG ,ELBUF ,MS ,IN ,V ,
138 1 X ,IXS ,IXQ ,IXC ,IXT ,
139 2 IXP ,IXR ,DETONATORS ,GEO ,PM ,
140 3 RBY ,NPBY ,LPBY ,NPC ,NPTS ,
141 4 PLD ,VEUL ,ALE_CONNECTIVITY ,SKEW ,FILL ,
142 5 IPART ,ITAB ,SENSORS ,SKVOL ,
143 6 IXTG ,THK ,NLOC_DMG ,GROUP_PARAM_TAB,GLOB_THERM,
144 7 IGRNOD ,IGRSURF ,BUFSF ,VR ,
145 8 BUFMAT ,XLAS ,LAS ,DTELEM ,MSS ,
146 9 MSQ ,MSC ,MST ,MSP ,MSR ,
147 A MSTG ,PTG ,INC ,NOD2ELTG ,KNOD2ELTG ,
148 B INP ,INR ,INTG ,INDEX ,
149 C ITRI ,KXX ,IXX ,XELEMWA ,
150 E IWA ,NOD2ELQ ,KNOD2ELQ ,NOD2ELS ,KNOD2ELS ,
151 F KXSP ,IXSP ,NOD2SP ,ISPCOND ,ICODE ,
152 G ISKEW ,ISKN ,ISPSYM ,XFRAME ,ISPTAG ,
153 H SPBUF ,MSSX ,NSIGI ,
154 I NPBYL ,LPBYL ,RBYL ,MSNF ,MSSF ,
155 J NSIGSH ,IGEO ,IPM ,NSIGS ,
156 K NSIGSPH ,VNS ,VNSX ,STC ,STT ,
157 L STP ,STR ,STTG ,STUR ,BNS ,
158 M BNSX ,VOLNOD ,BVOLNOD ,ETNOD ,NSHNOD ,
159 N STIFINT ,FXBDEP ,FXBVIT ,FXBACC ,FXBIPM ,
160 O FXBRPM ,FXBELM ,FXBSIG ,FXBMOD ,INS ,
161 P PTSHEL ,PTSH3N ,PTSOL ,PTQUAD ,
162 Q WMA ,PTSPH ,FXBNOD ,MBUFEL ,MDEPL ,
163 R FXANI ,NUMEL ,NSIGRS ,
164 T SH4TREE ,SH3TREE ,MCP ,TEMP ,
165 U IMERGE2 ,IADMERGE2 ,
166 V SLNRBM ,NSLNRBM ,RMSTIFN ,RMSTIFR ,
167 U MS_LAYER ,ZI_LAYER ,ITAG ,ITAGEL ,MCPC ,
168 W MCPTG ,XREFC ,XREFTG ,XREFS ,MSSA ,
169 X MSRT ,IRBE2 ,LRBE2 ,INIVOL ,KVOL , NBSUBMAT,
170 Y IXS10 ,IXS16 ,IXS20 ,TOTADDMAS ,
171 Z IPMAS ,STIFN ,MSZ2 ,ITAGN ,SITAGE ,
172 1 ITAGE ,IXR_KJ ,ELBUF_TAB,
173 2 NOM_OPT ,PTR_NOPT_RBE2 ,PTR_NOPT_ADM ,PTR_NOPT_FUN ,
174 3 SOL2SPH ,IRST ,SH3TRIM ,XFEM_TAB ,
175 4 KXIG3D ,IXIG3D ,MSIG3D ,KNOT ,NCTRLMAX ,
176 5 WIGE ,STACK ,
177 7 RNOISE ,DRAPE ,SH4ANG ,SH3ANG ,
178 8 GEO_STACK ,IGEO_STACK ,STIFINTR ,STRC ,STRP ,
179 8 STRR ,STRTG ,PERTURB ,ITAGND ,NATIV_SMS ,
180 9 ILOADP ,FACLOAD ,PTSPRI ,NSIGBEAM ,
181 A PTBEAM ,NSIGTRUSS ,PTTRUSS ,
182 B MULTI_FVM ,SIGI ,SIGSH ,SIGSP ,
183 C SIGSPH ,SIGRS ,SIGBEAM ,SIGTRUSS ,STRSGLOB ,
184 D STRAGLOB ,ORTHOGLOB ,ISIGSH ,IYLDINI ,KSIGSH3 ,
185 E FAIL_INI ,IUSOLYLD ,IUSER ,IDDLEVEL ,INIMAP1D ,
186 F INIMAP2D ,FUNC2D ,FVM_INIVEL ,TAGPRT_SMS ,IGRBRIC ,
187 G IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRPART ,TOTMAS ,
188 H KNOTLOCPC ,KNOTLOCEL ,VNIGE ,BNIGE ,FXBGLM ,
189 I FXBCPM ,FXBCPS ,FXBLM ,FXBFLS ,FXBDLS ,
190 J FXB_MATRIX ,FXB_MATRIX_ADD,FXB_LAST_ADRESS ,PTR_NOPT_FXB ,R_SKEW ,
191 K KNOD2EL1D ,NOD2EL1D ,EBCS_TAB ,RBY_INIAXIS ,ALEA ,
192 L KNOD2ELC ,NOD2ELC ,DR ,SLRBODY ,DRAPEG ,
193 M IPARI ,INTBUF_TAB ,INTERFACES ,MAT_PARAM ,NPRELOAD_A,
194 N PRELOAD_A ,FAIL_FRACTAL ,FAIL_BROKMANN ,DEFAULTS ,NDAMP_FREQ_RANGE,
195 O DAMPR ,IBEAM_VECTOR ,RBEAM_VECTOR ,IKINE ,LSIGI ,
196 P LSIGSP ,SRNOISE ,NPRW ,LPRW , RWSTIF_PEN,
197 M SLN_PEN )
198C-----------------------------------------------
199C M o d u l e s
200C-----------------------------------------------
201 USE submodel_mod
202 USE matparam_def_mod
203 USE message_mod
204 USE stack_mod
205 USE multi_fvm_mod
206 USE bpreload_mod
207 USE inimap1d_mod
208 USE inimap2d_mod
209 USE func2d_mod
210 USE groupdef_mod
211 USE optiondef_mod
212 USE nlocal_reg_mod
213 USE group_param_mod
214 USE detonators_mod
215 USE drape_mod
216 USE inivol_def_mod , ONLY : inivol_struct_, num_inivol
217 USE ebcs_mod
218 USE ale_connectivity_mod
219 USE array_mod
220 USE interfaces_mod
221 USE intbufdef_mod
222 USE init_seatbelt_rbodies_mod
223 USE bcs_mod
224 USE sensor_mod
225 USE random_walk_def_mod
226 USE defaults_mod
227 USE names_and_titles_mod , ONLY : nchartitle
228 USE elbufdef_mod
229 USE multimat_param_mod , ONLY : m51_lc0max, m51_ssp0max, m51_tcp_ref, m51_lset_iflg6, m51_iflg6, m51_iloop_nrf
230 USE brokmann_random_def_mod
231 USE glob_therm_mod
232 USE damping_range_init_mod
233 USE eikonal_solver_mod, ONLY : eikonal_solver
234 USE detonation_times_printout_mod , ONLY : detonation_times_printout
235 USE s6zinit3_mod
236 USE init_bcs_wall_mod , ONLY : init_bcs_wall
237 USE init_bcs_nrf_mod , ONLY : init_bcs_nrf
238 use init_inivol_mod , only : init_inivol
239 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
240 use init_rwall_penalty_mod , only : init_rwall_penalty
241C-----------------------------------------------
242C I m p l i c i t T y p e s
243C-----------------------------------------------
244#include "implicit_f.inc"
245C-----------------------------------------------
246C G l o b a l P a r a m e t e r s
247C-----------------------------------------------
248#include "mvsiz_p.inc"
249C-----------------------------------------------
250C C o m m o n B l o c k s
251C-----------------------------------------------
252#include "com01_c.inc"
253#include "com08_c.inc"
254#include "com04_c.inc"
255#include "com_xfem1.inc"
256#include "sphcom.inc"
257#include "vect01_c.inc"
258#include "units_c.inc"
259#include "param_c.inc"
260#include "scr03_c.inc"
261#include "scr14_c.inc"
262#include "scr17_c.inc"
263#include "scr23_c.inc"
264#include "tablen_c.inc"
265#include "lagmult.inc"
266#include "scr12_c.inc"
267#include "fxbcom.inc"
268#include "userlib.inc"
269#include "sms_c.inc"
270#include "boltpr_c.inc"
271#include "titr_c.inc"
272#include "tabsiz_c.inc"
273#include "scry_c.inc"
274C-----------------------------------------------
275C D u m m y A r g u m e n t s
276C-----------------------------------------------
277 INTEGER,INTENT(IN) :: SKVOL
278 INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,*), IXQ(NIXQ,*),IXC(NIXC,*),
279 . igeo(npropgi,*), ixt(nixt,*),ixp(nixp,*), ixr(nixr,*),
280 . npby(nnpby,*),lpby(*),npbyl(nnpby,*),lpbyl(*),npc(*),
281 . itab(*), ipart(*),
282 . las(*),
283 . ixtg(nixtg,*),index(*),itri(*),iwa(*),kxx(nixx,*),ixx(*),
284 . kxsp(*) ,ixsp(*) ,nod2sp(*),ispcond(*),ispsym(*),isptag(*),
285 . icode(*),iskew(*),iskn(liskn,*), ipm(npropmi,*), nshnod(*),
286 . ptshel(*),ptsh3n(*),ptsol(*),ptquad(*),ptsph(*),
287 . ixs10(*) ,ixs20(*) ,ixs16(*), sh4tree(*), sh3tree(*),
288 . imerge2(numnod+1),iadmerge2(numnod+1),
289 . slnrbm(*) ,nslnrbm(*),itag(*),itagel(*),irbe2(*) ,lrbe2(*),
290 . itagn(*),
291 . ixr_kj(5,*), sol2sph(*), irst(*),sh3trim(*),kxig3d(nixig3d,*),
292 . ixig3d(*),igeo_stack(*),perturb(nperturb),
293 . nativ_sms(*),ptspri(*),ptbeam(*),pttruss(*),strsglob(*),
294 . straglob(*),orthoglob(*),isigsh,iyldini,ksigsh3,fail_ini(5),
295 . iusolyld,iuser,iddlevel,nbsubmat, tagprt_sms(*),sitage,fxb_matrix_add(4,*),
296 . fxb_last_adress(*),ptr_nopt_fxb,r_skew(*), npts,knod2el1d(*) ,nod2el1d(*),
297 . knod2elc(*),nod2elc(*)
298 TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
299 INTEGER,TARGET :: ITAGE(*)
300 INTEGER,POINTER :: ptr_ITAGE
301 INTEGER NSIGI,NSIGSH,
302 . NSIGS, NSIGSPH, FXBIPM(NBIPM,*), FXBELM(*),NSIGRS,
303 . NUMEL,STAT,
304 . NCTRLMAX,NSIGBEAM,NSIGTRUSS
305 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*),SLRBODY
306 INTEGER,INTENT(IN) :: IPARI(NPARI,NINTER)
307 my_real,INTENT(IN) :: FACLOAD(LFACLOAD,*)
308 my_real
309 . ELBUF(*), MS(*), IN(*), V(*), X(*), GEO(*),PM(NPROPM,*),
310 . RBY(NRBY,*),PLD(*),VEUL(*),SKEW(LSKEW,*),FILL(*),
311 . THK(*),BUFSF(*), VR(3,*),BUFMAT(*),PTG(3,*),XLAS(*),
312 . DTELEM(*),MSS(*), MSQ(*),MSC(*),MST(*),MSP(*),MSR(*),
313 . MSTG(*),INC(*),RBYL(NRBY,*),
314 . INP(*),INR(*),INTG(*),
315 . XELEMWA(*),
316 . XFRAME(NXFRAME,*),SPBUF(*),MSSX(*),MSNF(*),
317 . MSSF(*), WMA(*),
318 . VNS(*) ,VNSX(*) ,STC(*) ,STT(*) ,STP(*) ,STR(*) ,
319 . STTG(*) ,STUR(*) ,BNS(*) ,BNSX(*) ,
320 . VOLNOD(*) ,BVOLNOD(*) , ETNOD(*), STIFINT(*), FXBDEP(*),
321 . FXBVIT(*), FXBACC(*), FXBRPM(*), FXBSIG(*), FXBMOD(*),
322 . INS(*), MCP(*),TEMP(*),RMSTIFN(*), RMSTIFR(*),
323 . MS_LAYER(*),ZI_LAYER(*), MCPC(*), MCPTG(*),
324 . MBUFEL(LBUFEL,*), MDEPL(3*NUMNOD,*),
325 . XREFC(4,3,*),XREFTG(3,3,*),XREFS(8,3,*), MSSA(*), MSRT(*),
326 . KVOL(NBSUBMAT,*),TOTADDMAS,MSZ2(*),
327 . MSIG3D(*),KNOT(*),WIGE(*),RNOISE(*),
328 . SH4ANG(*),SH3ANG(*),GEO_STACK(*),STIFINTR(*),
329 . STRC(*),STRR(*),STRP(*),STRTG(*),SIGI(NSIGS,*),SIGSH(MAX(1,NSIGSH),*),
330 . SIGSP(NSIGI,*),SIGSPH(NSIGSPH,*),SIGRS(NSIGRS,*),SIGBEAM(NSIGBEAM,*),
331 . SIGTRUSS(NSIGTRUSS,*),TOTMAS, KNOTLOCPC(*),KNOTLOCEL(*),VNIGE(*),BNIGE(*),
332 . FXBGLM(*),FXBCPM(*),FXBCPS(*),FXBLM(*),FXBFLS(*),FXBDLS(*),FXB_MATRIX(*),
333 . RBY_INIAXIS(7,*),ALEA(*),DR(SDR)
334
335 my_real, DIMENSION(NUMNOD*2), TARGET :: STIFN
336 my_real , DIMENSION(:), POINTER :: STIFR
337C
338 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_RBE2,PTR_NOPT_ADM,PTR_NOPT_FUN,IOPT
339 INTEGER FXBNOD(*), FXANI(2,*),ITAGND(*)
340 INTEGER,INTENT(IN) :: NPRELOAD_A
341 INTEGER,INTENT(IN) :: NDAMP_FREQ_RANGE
342 my_real,INTENT(IN) :: DAMPR(NRDAMP,NDAMP)
343 INTEGER,INTENT(IN) :: IBEAM_VECTOR(NUMELP)
344 my_real,INTENT(IN) :: RBEAM_VECTOR(3,NUMELP)
345 INTEGER,INTENT(IN) :: IKINE(3*NUMNOD)
346 INTEGER,INTENT(IN) :: LSIGI
347 INTEGER,INTENT(IN) :: LSIGSP
348 INTEGER,INTENT(IN) :: SRNOISE
349!
350 INTEGER,INTENT(IN) :: SLN_PEN
351 INTEGER, DIMENSION(NNPRW*NRWALL),INTENT(IN) :: NPRW
352 INTEGER, DIMENSION(SLPRW),INTENT(IN) :: LPRW
353 my_real, DIMENSION(SLN_PEN), INTENT(INOUT) :: RWSTIF_PEN
354C
355 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
356 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP,NXEL) :: XFEM_TAB
357 TYPE (STACK_PLY) :: STACK
358 TYPE (MULTI_FVM_STRUCT) :: MULTI_FVM
359 TYPE (INIMAP1D_STRUCT), DIMENSION(NINIMAP1D), INTENT(INOUT) :: INIMAP1D
360 TYPE (INIMAP2D_STRUCT), DIMENSION(NINIMAP2D), INTENT(INOUT) :: INIMAP2D
361 TYPE (FUNC2D_STRUCT), DIMENSION(NFUNC2D), INTENT(IN) :: FUNC2D
362 TYPE (FVM_INIVEL_STRUCT), INTENT(IN) :: FVM_INIVEL(*)
363 TYPE (NLOCAL_STR_) :: NLOC_DMG
364 TYPE (GROUP_PARAM_), DIMENSION(NGROUP) :: GROUP_PARAM_TAB
365 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
366C-----------------------------------------------
367 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
368 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
369 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
370 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
371 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
372 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
373 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
374 TYPE (ADMAS_) , DIMENSION(NODMAS) :: IPMAS
375 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
376 TYPE (DETONATORS_STRUCT_) :: DETONATORS
377 TYPE (DRAPE_) , DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE):: DRAPE
378 TYPE (DRAPEG_) :: DRAPEG
379 TYPE (t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
380 TYPE (INTBUF_STRUCT_) , INTENT(IN ) :: INTBUF_TAB(NINTER)
381 TYPE (INTERFACES_) , INTENT(INOUT ) :: INTERFACES
382 TYPE (PREL1D_) , INTENT(IN) ,DIMENSION(NPRELOAD_A) :: PRELOAD_A
383 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
384 TYPE (FAIL_FRACTAL_) ,INTENT(IN) :: FAIL_FRACTAL
385 TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
386 TYPE (DEFAULTS_) ,INTENT(IN) :: DEFAULTS
387 type (glob_therm_) ,intent(inout) :: glob_therm
388C-----------------------------------------------
389C L o c a l V a r i a b l e s
390C-----------------------------------------------
391C remove automatic allocation to reduce stack consumption
392C INTEGER *8 I8MI(6,NUMNOD)
393 INTEGER (KIND=8), DIMENSION(:,:), ALLOCATABLE :: I8MI
394 INTEGER NG, NEL, NVC, K, N, M, NSL, NN1, NN2, NN3, I, K0,NV46,
395 . isph, j, ig, offset,isolnod,iprop,igtyp,
396 . i15a,i15b,i15c,i15d,i15e,i15f,i15g,i15h,i15i,i15j,i15k,i15ath,
397 . i15l,nc1_old, nc2_old, nc3_old, nc4_old,
398 . nc5_old, nc6_old, nc7_old, nc8_old,
399 . nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8,
400 . iint, isens,ithk, ihbe, jhbe, ilev,ish3n,
401 . kk1, kk2, kk3,iaduix,iadux ,iaduv ,iaduvr,iadums,
402 . iaduin,iadusm,iadusr,iadumv,iadurv, nuvar,icnod, rbyid,
403 . adrrpm,alm,asig,nels,nelc,neltg,amod,nbno,nme,nml,arpm,lvsig,
404 . ifile,ircs,nelt,nelp,fxbid, anod, ircm, nsni, nsn, nmani, imin, imax,
405 . nelemr,cpt_eltens,ixfem,itg,isubstack,nctrl, itetra10, kk,px,py,pz,ipid
406
407 INTEGER SOLMAT(0:MAXLAW), COQMAT(0:MAXLAW), TRUMAT(0:MAXLAW),
408 . poumat(0:maxlaw),sphmat(0:maxlaw),
409 . resmat(0:maxlaw),respid(0:50), sphpid(0:50),
410 . solpid(0:50), coqpid(0:52), trupid(0:50), poupid(0:50)
411 INTEGER II,NINDX,FLAG_KJ
412
413 INTEGER IBOLTP !Bolt preloading
414 my_real DT2S, B1, B2, B3, B6, B5, B9, XG, YG, ZG, XX, YY, ZZ, XY, XZ, YZ,DTNODA,FILL_RATIO
415 my_real, DIMENSION(:), ALLOCATABLE ::
416 . mbufel_tmp, mdepl_tmp,partsav,mcps,mcpsx,
417 . ms_layerc,zi_layerc, msz2c,zply,partsav1_pon,mcpp
418
419 INTEGER, DIMENSION(:), ALLOCATABLE :: IRIG_NODE, CONNEC
420 my_real, DIMENSION(:), ALLOCATABLE :: part_area,ele_area
421
422 my_real addedms(npart)
423 INTEGER ID,ISTOT, NF1,NNOD,NSROT,IDRAPE,ICPRE
424 CHARACTER(LEN=NCHARTITLE)::TITR
425 LOGICAL :: ERROR_THROWN
426 INTEGER,INTENT(IN) :: NOD2ELTG(3*NUMELTG)
427 INTEGER,INTENT(IN) :: NOD2ELQ(3*NUMELQ)
428 INTEGER,INTENT(IN) :: NOD2ELS(3*NUMELS)
429 INTEGER,INTENT(IN) :: KNOD2ELTG(NUMNOD+1)
430 INTEGER,INTENT(IN) :: KNOD2ELQ(NUMNOD+1)
431 INTEGER,INTENT(IN) :: KNOD2ELS(NUMNOD+1)
432C-----------------------------------------------
433C D e r i v e d T y p e D e f i n i t i o n s
434C-----------------------------------------------
435 TYPE(g_bufel_) ,POINTER :: GBUF
436 TYPE(BUF_MAT_) ,POINTER :: MBUF
437C-----------------------------------------------
438 EXTERNAL uel2sys
439 INTEGER UEL2SYS
440c___________________________________________________
441 my_real r8_deuxm43
442 integer*8 i8_deuxp43
443 data i8_deuxp43 /'80000000000'x/
444 r8_deuxm43 = 1.d00 / i8_deuxp43
445c___________________________________________________
446C 1 2 3 4 5 6 7 8 9 10
447 DATA solpid/1,0,0,0,0,0,1,0,0,0,0,
448 1 0,0,0,1,1,0,0,0,0,1,
449 2 1,1,0,0,0,0,0,0,1,0,
450 3 0,0,0,0,0,0,0,0,0,0,
451 4 0,0,1,0,0,0,0,0,0,0/
452 DATA coqpid/1,1,0,0,0,0,0,1,0,1,1,
453 1 1,0,0,0,0,1,1,0,1,0,
454 2 0,0,0,0,0,0,0,0,0,0,
455 3 0,0,0,0,0,0,0,0,0,0,
456 4 0,0,0,0,0,0,0,0,0,0,
457 5 1,1/
458 DATA trupid/0,0,1,0,0,0,0,0,0,0,0,
459 1 0,0,0,0,0,0,0,0,0,0,
460 2 0,0,0,0,0,0,0,0,0,0,
461 3 0,0,0,0,0,0,0,0,0,0,
462 4 0,0,0,0,0,0,0,0,0,0/
463 DATA poupid/0,0,0,1,0,0,0,0,0,0,0,
464 1 0,0,0,0,0,0,0,1,0,0,
465 2 0,0,0,0,0,0,0,0,0,0,
466 3 0,0,0,0,0,0,0,0,0,0,
467 4 0,0,0,0,0,0,0,0,0,0/
468 DATA respid/0,0,0,0,1,0,0,0,1,0,0,
469 1 0,1,1,0,0,0,0,0,0,0,
470 2 0,0,1,0,1,1,1,0,1,1,
471 3 1,1,1,0,1,1,0,0,0,0,
472 4 0,0,0,1,1,1,0,0,0,0/
473 DATA sphpid/0,0,0,0,0,0,0,0,0,0,0,
474 1 0,0,0,0,0,0,0,0,0,0,
475 2 0,0,0,0,0,0,0,0,0,0,
476 3 0,0,0,1,0,0,0,0,0,0,
477 4 0,0,0,0,0,0,0,0,0,0/
478C=======================================================================
479
480 m51_iloop_nrf = 0
481 nvc = 0
482 stat = 0
483
484 IF(ipari0==3)THEN
485 ALLOCATE (i8mi(6,numnod) ,stat=stat)
486 ELSE
487 ALLOCATE (i8mi(6,1) ,stat=stat)
488 ENDIF
489
490 ALLOCATE (partsav(20*npart) ,stat=stat)
491
492 stifr => stifn(numnod+1:numnod*2)
493 ALLOCATE (partsav1_pon(npart) ,stat=stat)
494C
495 IF(npreload > 0) THEN
496 ALLOCATE (vpreload(7*numels) ,stat=stat)
497 ENDIF
498C
499 IF (npart > 0) partsav= zero
500 IF (npart > 0) partsav1_pon=zero
501 IF (npreload > 0 .AND. numels > 0) vpreload = zero
502C xfem
503 itg = 0
504 IF(icrack3d > 0)itg = 1 + numelc
505
506 ! To avoid thwrowing ngroup times the same error
507 error_thrown = .false.
508
509 anim_m=0
510 DO i=1,mx_ani
511 anim_n(i)=0
512 anim_v(i)=0
513 anim_ce(i)=0
514 anim_ct(i)=0
515 anim_se(i)=0
516 anim_st(i)=0
517 anim_fe(i)=0
518 anim_ft(i)=0
519 ENDDO
520 nn_ani=0
521 nv_ani=0
522 nce_ani=0
523 nct_ani=0
524 nse_ani=0
525 nst_ani=0
526 nfe_ani=0
527 nindx = 0
528C ---
529 IF(irigid_mat > 0 ) THEN
530 nelemr = numelc + numels10 + numels8 + numeltg
531 ALLOCATE(irig_node(numnod))
532 ALLOCATE(connec(nelemr*10))
533 irig_node = 0
534 connec = 0
535 ELSE
536 ALLOCATE(connec(0),irig_node(0))
537 ENDIF
538C
539C ply xfem
540C
541 IF(iplyxfem> 0 ) THEN
542 ALLOCATE(ms_layerc(nplymax*numelc))
543 ALLOCATE(zi_layerc(nplymax*numelc))
544 ALLOCATE(msz2c(numelc))
545 ALLOCATE(zply(nplymax))
546 ms_layerc = zero
547 zi_layerc = zero
548 msz2c = zero
549 zply = zero
550 ELSE
551 ALLOCATE(ms_layerc(0))
552 ALLOCATE(zi_layerc(0))
553 ALLOCATE(msz2c(0))
554 ALLOCATE(zply(0))
555 ENDIF
556C-------------------------------------
557C MASS + INERTIA IPARITH = 4
558C-------------------------------------
559 IF(ipari0 == 3)THEN
560 DO n=1,numnod
561 i8mi(1,n) = 0
562 i8mi(2,n) = 0
563 i8mi(3,n) = 0
564 i8mi(4,n) = 0
565 i8mi(5,n) = 0
566 i8mi(6,n) = 0
567 ENDDO
568 ENDIF
569 DO n=0,maxlaw
570 solmat(n) = 1
571 coqmat(n) = 0
572 trumat(n) = 0
573 poumat(n) = 0
574 sphmat(n) = 0
575 resmat(n) = 0
576 ENDDO
577 DO n=51,maxlaw
578 solmat(n) = 0
579 ENDDO
580 solmat(15) = 0
581 solmat(19) = 0
582 solmat(25) = 1
583 solmat(27) = 0
584 solmat(32) = 0
585 solmat(43) = 0
586C
587C solids
588 solmat(53) = 1
589 solmat(51) = 1
590 solmat(52) = 1
591 solmat(56) = 1
592 solmat(59) = 1
593 solmat(60) = 1
594 solmat(61) = 0
595 solmat(62) = 1
596 solmat(65) = 1
597 solmat(66) = 1
598 solmat(67) = 1
599 solmat(68) = 1
600 solmat(69) = 1
601 solmat(70) = 1
602 solmat(71) = 1
603 solmat(72) = 1
604 solmat(74) = 1
605 solmat(75) = 1
606 solmat(76) = 1
607 solmat(77) = 1
608 solmat(78) = 1
609 solmat(79) = 1
610 solmat(80) = 1
611 solmat(81) = 1
612 solmat(82) = 1
613 solmat(83) = 1
614 solmat(84) = 1
615 solmat(88) = 1
616 solmat(92) = 1
617 solmat(90) = 1
618 solmat(93) = 1
619 solmat(94) = 1
620 solmat(95) = 1
621 solmat(96) = 1
622 solmat(97) = 1
623 solmat(99) = 1
624 solmat(100)= 1
625 solmat(101)= 1
626 solmat(102)= 1
627 solmat(103)= 1
628 solmat(104)= 1
629 solmat(105)= 1
630 solmat(106)= 1
631 solmat(107)= 1
632 solmat(109)= 1
633 solmat(111)= 1
634 solmat(112)= 1
635 solmat(115)= 1
636 solmat(116)= 1
637 solmat(117)= 1
638 solmat(120)= 1
639 solmat(121)= 1
640 solmat(122)= 1
641 solmat(124)= 1
642 solmat(125)= 1
643 solmat(127)= 1
644 solmat(134)= 1
645 solmat(151)= 1
646 solmat(187)= 1
647 solmat(190)= 1
648 solmat(200)= 1
649C shells
650 coqmat(0) = 1
651 coqmat(1) = 1
652 coqmat(2) = 1
653 coqmat(7 ) = 1
654 coqmat(13) = 1
655 coqmat(15) = 1
656 coqmat(19) = 1
657 coqmat(22) = 1
658 coqmat(25) = 1
659 coqmat(27) = 1
660 coqmat(29) = 1
661 coqmat(30) = 1
662 coqmat(31) = 1
663 coqmat(32) = 1
664 coqmat(34) = 1
665 coqmat(35) = 1
666 coqmat(36) = 1
667 coqmat(42) = 1
668 coqmat(43) = 1
669 coqmat(44) = 1
670 coqmat(45) = 1
671 coqmat(48) = 1
672 coqmat(52) = 1
673 coqmat(55) = 1
674 coqmat(56) = 1
675 coqmat(57) = 1
676 coqmat(58) = 1
677 coqmat(60) = 1
678 coqmat(62) = 1
679 coqmat(63) = 1
680 coqmat(64) = 1
681 coqmat(65) = 1
682 coqmat(66) = 1
683 coqmat(69) = 1
684 coqmat(71) = 1
685 coqmat(72) = 1
686 coqmat(73) = 1
687 coqmat(76) = 1
688 coqmat(78) = 1
689 coqmat(80) = 1
690 coqmat(82) = 1
691 coqmat(85) = 1
692 coqmat(86) = 1
693 coqmat(87) = 1
694 coqmat(88) = 1
695 coqmat(91) = 1
696 coqmat(92) = 0 ! is not available
697 coqmat(93) = 1
698 coqmat(94) = 0 ! is not available
699 coqmat(96) = 1
700 coqmat(98) = 1
701 coqmat(99) = 1
702 coqmat(104) = 1
703 coqmat(107) = 1
704 coqmat(109) = 1
705 coqmat(110) = 1
706 coqmat(112) = 1
707 coqmat(119) = 1
708 coqmat(121) = 1
709 coqmat(122) = 1
710 coqmat(125) = 1
711 coqmat(151) = 1
712 coqmat(158) = 1
713 coqmat(200) = 1
714C truss
715 trumat(0) = 1
716 trumat(1) = 1
717 trumat(2) = 1
718 trumat(34) = 1
719 trumat(44) = 1
720C beam
721 poumat(0) = 1
722 poumat(1) = 1
723 poumat(2) = 1
724 poumat(34) = 1
725 poumat(36) = 1
726 poumat(44) = 1
727 poumat(71) = 1
728C sph
729 sphmat(1) = 1
730 sphmat(2) = 1
731 sphmat(3) = 1
732 sphmat(4) = 1
733 sphmat(5) = 1
734 sphmat(6) = 1
735 sphmat(10) = 1
736 sphmat(12) = 1
737 sphmat(18) = 1
738 sphmat(21) = 1
739 sphmat(22) = 1
740 sphmat(23) = 1
741 sphmat(24) = 1
742 sphmat(28) = 1
743 sphmat(29) = 1
744 sphmat(30) = 1
745 sphmat(31) = 1
746 sphmat(32) = 1
747 sphmat(33) = 1
748 sphmat(34) = 1
749 sphmat(35) = 1
750 sphmat(36) = 1
751 sphmat(38) = 1
752 sphmat(40) = 1
753 sphmat(41) = 1
754 sphmat(42) = 1
755 sphmat(49) = 1
756 sphmat(50) = 1
757 sphmat(53) = 1
758
759 sphmat(66) = 1
760 sphmat(70) = 1
761 sphmat(72) = 1
762 sphmat(75) = 1
763 sphmat(76) = 1
764 sphmat(79) = 1
765 sphmat(81) = 1
766 sphmat(88) = 1
767 sphmat(90) = 1 ! not tested
768 sphmat(92) = 1 ! not tested
769 sphmat(93) = 1 ! not tested
770 sphmat(94) = 1 ! not tested
771 sphmat(97) = 1
772 sphmat(102)= 1
773 sphmat(103)= 1
774 sphmat(111)= 1 ! is not tested
775 sphmat(105)= 1
776 resmat(54) = 1
777
778 i15ath = 1+lipart1*npart+lipart1*nthpart
779 i15a = i15ath+2*9*npart+2*9*nthpart
780 i15b = i15a+numels
781 i15c = i15b+numelq
782 i15d = i15c+numelc
783 i15e = i15d+numelt
784 i15f = i15e+numelp
785 i15g = i15f+numelr
786 i15h = i15g
787 i15i = i15h+numeltg
788 i15j = i15i+numelx
789 i15k = i15j+numsph
790 i15l = i15k+numelig3d
791
792C-----------------------------------------------------
793C VERIFICATION DES MATERIAUX ET PID
794C-----------------------------------------------------
795 CALL checkmp(numels,ixs,nixs,nixs-1,nixs,solmat,solpid,ipm,igeo,'BRICK' ,ipart(i15a))
796 CALL checkmp(numelq,ixq,nixq,nixq-1,nixq,solmat,solpid,ipm,igeo,'QUAD' ,ipart(i15b))
797 CALL checkmp(numelc,ixc,nixc,nixc-1,nixc,coqmat,coqpid,ipm,igeo,'SHELL' ,ipart(i15c))
798 CALL checkmp(numeltg,ixtg,nixtg,nixtg-1,nixtg,coqmat,coqpid,ipm,igeo,'SHELL3N',ipart(i15h))
799 CALL checkmp(numelt,ixt,nixt,nixt-1,nixt,trumat,trupid,ipm,igeo,'TRUSS' ,ipart(i15d))
800 CALL checkmp(numelp,ixp,nixp,nixp-1,nixp,poumat,poupid,ipm,igeo,'BEAM' ,ipart(i15e))
801 CALL checkmp(numelr,ixr,nixr, 1,nixr,-1 ,respid,ipm,igeo,'SPRING' ,ipart(i15f))
802 CALL chekmp2(numsph,ipart ,ipart(i15j),kxsp,nisp,nisp,sphmat,sphpid,ipm,igeo,'SPHCEL')
803
804C--------------------------------------------
805C Initialisation of Wall_Boundary Conditions
806C--------------------------------------------
807 IF(bcs%NUM_WALL > 0)THEN
808 CALL init_bcs_wall(igrnod,ngrnod,numnod,ale_connectivity,multi_fvm,
809 . ixs,nixs,numels, ixq,nixq,numelq, ixtg,nixtg,numeltg, n2d,
810 . ngroup,nparg,iparg,ipri)
811 ENDIF
812C------------------------------------------------------
813C Initialisation of Non Reflecting BOundary Conditions
814C------------------------------------------------------
815 IF(bcs%NUM_NRF > 0)THEN
816 CALL init_bcs_nrf(igrnod,ngrnod,numnod,multi_fvm,
817 . ixs,nixs,numels, ixq,nixq,numelq, ixtg,nixtg,numeltg, n2d,
818 . ngroup,nparg,iparg,ipri,itab,nummat, mat_param)
819 ENDIF
820C---------------------------------------------------------
821C Sorting of the bolt preloading vector
822C---------------------------------------------------------
823 IF (npreload > 0) THEN
824 CALL iniboltprel(ixs,ipreload ,preload ,vpreload, iflag_bpreload)
825 ENDIF
826C-----------------------------------------------------
827C PREPARATION OF THE CALCULATION OF MASSES BY PARTICLE IF CONDITION(S) OF
828C SYMETRIE
829C-----------------------------------------------------
830 IF (numsph/=0.AND.nspcond/=0)
831 . CALL inspcnd(ispcond ,igrnod ,kxsp ,ixsp ,
832 . nod2sp ,itab ,icode ,iskew ,iskn ,
833 . skew ,xframe ,x ,ispsym ,isptag ,
834 . pm ,geo ,ipart ,ipart(i15j))
835C--------------------------------------------
836C Seat belts initialization :
837C--------------------------------------------
838 IF (n_seatbelt > 0) CALL ini_seatbelt(iparg,elbuf_tab,knod2el1d,nod2el1d,ixr,
839 . x,itab,ipm,alea,knod2elc,
840 . nod2elc,ixc)
841C-----------------------------------------------------
842C INITIALIZATION OF ELEMENT BUFFERS
843C INITIALIZATION OF MASSES AND INERTIAS
844C-----------------------------------------------------
845C
846C for heat transfer
847C
848 IF (glob_therm%ITHERM_FE > 0 ) THEN
849 ALLOCATE(mcps(8*numels))
850 mcps = zero
851 IF(numels10 > 0.OR.numels16 > 0 .OR.numels20 > 0)THEN
852 ALLOCATE(mcpsx(12*numels))
853 mcpsx = zero
854 ENDIF
855 ALLOCATE(mcpp(numelp))
856 mcpp = zero
857 ELSE
858 ALLOCATE(mcpsx(0), mcps(0), mcpp(0))
859 ENDIF
860C---
861 IF ((imasadd > 0).OR.(nloc_dmg%IMOD > 0)) THEN
862 ALLOCATE(part_area(npart) ,stat=stat)
863 part_area(1:npart) = zero
864 ALLOCATE(ele_area(numelc+numeltg) ,stat=stat)
865 ele_area(1:numelc+numeltg) = zero
866 ELSE
867 ALLOCATE(part_area(1),ele_area(1))
868 END IF
869C---
870 WRITE(iout,'(//)')
871 dt2s=1.e6
872 cpt_eltens = 0
873C
874 DO ng=1,ngroup
875 mtn=iparg(1,ng)
876 nel=iparg(2,ng)
877 nft=iparg(3,ng)
878 iad=iparg(4,ng)
879 ity=iparg(5,ng)
880 npt=iparg(6,ng)
881 jale=iparg(7,ng)
882 ismstr=iparg(9,ng)
883 jeul =iparg(11,ng)
884 jtur =iparg(12,ng)
885 jthe =iparg(13,ng)
886 jlag =iparg(14,ng)
887 ish3n =iparg(23,ng)
888 jmult =iparg(20,ng)
889 jpor =iparg(27,ng)
890 isolnod = iparg(28,ng)
891 user_grp_domain = iparg(32,ng)+1
892 igtyp = iparg(38,ng)
893 israt = iparg(40,ng)
894 isorth = iparg(42,ng)
895 isrot = iparg(41,ng)
896 idrape = iparg(92,ng)
897 IF(isolnod == 10) isrot = iparg(74,ng)
898 iexpan = iparg(49,ng)
899 ishxfem_ply = iparg(50,ng)
900 IF (icrack3d == 0) THEN
901 iparg(54,ng) = 0
902 END IF
903 ixfem = iparg(54,ng)
904 isubstack = iparg(71,ng)
905 iboltp = iparg(72,ng)
906 iformdt = iparg(73,ng)
907 jclos=0
908 istot = 0
909 IF (ity==1.AND.(ismstr>=10.AND.ismstr<=12)) istot = 1
910 IF (ity == 3.OR.ity == 7) THEN
911C Initialize vectorization flags to zero for 3 and 4 nodes shell
912 nc1_old = 0
913 nc2_old = 0
914 nc3_old = 0
915 nc4_old = 0
916 ELSEIF (ity == 1) THEN
917C Initialize vectorization flags to zero for solid elements
918 nc1_old = 0
919 nc2_old = 0
920 nc3_old = 0
921 nc4_old = 0
922 nc5_old = 0
923 nc6_old = 0
924 nc7_old = 0
925 nc8_old = 0
926 IF((isolnod == 4 .AND.isrot==2).OR.
927 . (isolnod == 10.AND.isrot==1).OR.
928 . (isolnod == 10.AND.isrot==3))THEN
929 isrot = 0
930 iparg(41,ng) = 0
931 ENDIF
932 ENDIF
933 IF((numels/=0) .AND. (n2d/=0))THEN
934 CALL ancmsg(msgid=603, msgtype=msgerror, anmode=aninfo_blind_2)
935 END IF
936C------------------------------------------------------------------------------
937C Warning : for a new element type perform the computation of mass and inertia
938C in parallel arithmetic in subroutine SPMD_MSIN
939C------------------------------------------------------------------------------
940C
941 IF ((mtn == 0 .AND. igtyp /= 52 .AND. igtyp /= 51) .or.
942 . (igtyp == 0 .and. (ity == 1 .or. ity == 3 .or. ity == 7)) ) THEN
943 lft=1
944 llt=nel
945 nft = iparg(3,ng)
946 ihbe=iparg(23,ng)
947 isolnod = iparg(28,ng)
948 ilev=iparg(45,ng)
949C
950 CALL inivoid(elbuf_tab(ng),
951 1 ixc ,ixs ,ixtg ,x ,v ,
952 2 pm ,geo ,ms ,in ,ptg ,
953 3 msc ,mss ,mstg ,inc ,intg ,
954 4 thk(1+nft) ,thk(1+nft+numelc),partsav,ipart(i15a),
955 5 ipart(i15c),ipart(i15h),veul ,dtelem ,ihbe ,
956 6 isolnod ,nvc ,i8mi ,msnf ,mssf ,
957 7 igeo ,etnod ,nshnod ,stc ,sttg ,
958 8 wma ,sh4tree ,sh3tree ,mcp ,mcpc ,
959 9 temp ,mcps ,xrefc ,xreftg ,xrefs ,
960 a mssa ,volnod ,bvolnod ,vns ,bns ,
961 b sh3trim ,isubstack ,stack ,rnoise ,perturb ,
962 c ele_area ,part_area ,ipart(i15d),ixt ,ipart(i15e),
963 d ixp ,mst ,msp ,stt ,stp ,
964 e strp ,inp ,stifint ,mcpp ,inr ,
965 f msr ,msrt ,str ,ipart(i15f),itab ,
966 g ixr , imerge2 ,iadmerge2 ,nel ,defaults ,
967 h glob_therm,ibeam_vector,rbeam_vector)
968C
969 ELSEIF( mtn == 13) THEN
970C Rigid material
971 lft=1
972 llt=nel
973 nft = iparg(3,ng)
974 ihbe=iparg(23,ng)
975 isolnod = iparg(28,ng)
976 ilev=iparg(45,ng)
977C
978 CALL inirig_mat(
979 1 ixc ,ixs ,ixtg ,ixs10 ,x ,
980 2 v ,pm ,geo ,ms ,in ,
981 3 ptg ,msc ,mss ,mstg ,inc ,
982 4 intg ,thk(1+nft) ,thk(1+nft+numelc),partsav,ipart(i15a),
983 5 ipart(i15c),ipart(i15h),veul ,dtelem ,ihbe ,
984 6 isolnod ,nvc ,i8mi ,msnf ,mssf ,
985 7 igeo ,etnod ,nshnod ,stc ,sttg ,
986 8 wma ,sh4tree ,sh3tree ,mcp ,mcpc ,
987 9 temp ,mcps ,mssx ,mcpsx ,ins ,
988 a stifn ,stifr ,connec ,irig_node ,nelemr ,
989 b nindx ,xrefc ,xreftg ,xrefs ,mssa ,
990 c sh3trim ,isubstack ,bufmat ,ipm ,stack ,
991 d rnoise ,strc ,strtg ,perturb ,nel ,
992 e group_param_tab(ng) ,igtyp ,defaults ,glob_therm)
993C
994 ELSE
995C Type element
996 lft=1
997 llt=nel
998 offset=0
999 nft = iparg(3,ng)
1000 jsph=0
1001 jcvt=0
1002 nf1 = nft + 1
1003 !----------------------------------------!
1004 ! ITY == 1 3D-SOLIDS !
1005 !----------------------------------------!
1006 IF (ity == 1) THEN
1007 gbuf => elbuf_tab(ng)%GBUF
1008 IF (iusolyld == 1 ) THEN
1009 CALL scaleini(
1010 . elbuf_tab(ng), ixs , sigsp ,sigi , nsigi,
1011 . nel ,lft , llt ,nft , nsigs,
1012 . ptsol ,igeo )
1013 ENDIF
1014 IF (isolnod == 4.AND.(isrot==0.OR.isrot==3))THEN
1015 IF (multi_fvm%IS_USED) THEN
1016 CALL multifluid_init3t(elbuf_tab(ng),
1017 . nel, nsigs, nsigi, ixs, igeo, ipm, iparg, ale_connectivity, ipart(i15a), ptsol,
1018 . npc, ipart, iloadp,
1019 . xrefs, geo, pm, facload, pld, skew, sigi, bufmat, x,
1020 . wma, partsav, ms, v, mss, mssf, mssa, msnf, mcps, error_thrown, detonators,
1021 . defaults, mat_param,glob_therm%NINTEMP)
1022 ELSE
1023 IF (istot == 1) THEN
1024 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1025 IF (nsigi > 0 ) THEN
1026 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1027 . gbuf%SMSTR,gbuf%OFF,nel)
1028 END IF
1029 ENDIF
1030 CALL s4init3(
1031 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1032 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1033 3 dtelem ,sigi ,nel ,skew ,igeo ,
1034 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1035 5 ipart ,msnf ,iparg ,
1036 6 mssf ,ipm ,nsigs ,volnod ,bvolnod ,
1037 7 vns ,bns ,wma ,ptsol ,bufmat ,
1038 8 mcp ,mcps ,temp ,npc ,pld ,
1039 9 iuser ,sigsp ,nsigi ,mssa ,xrefs ,
1040 a strsglob(nf1),straglob(nf1),fail_ini ,spbuf ,sol2sph ,
1041 b iloadp ,facload ,rnoise ,perturb ,mat_param ,
1042 c defaults%SOLID,glob_therm%NINTEMP )
1043 IF (nxref > 0 .AND. jlag/=0 .AND. jsph==0)THEN
1044 CALL s4refsta3(
1045 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1046 2 ipm ,igeo ,skew ,x ,xrefs ,
1047 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param ,
1048 4 npc ,pld ,nummat )
1049C Case total strain
1050 IF (istot == 1) THEN
1051 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1052 END IF
1053 ENDIF
1054 IF (nsigi > 0 ) THEN
1055 IF (nxref > 0 .OR. ismstr == 1)
1056 . CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1057 . gbuf%SMSTR,gbuf%OFF,nel)
1058 END IF
1059 ENDIF
1060
1061 ELSEIF( (isolnod == 6) .AND. (igtyp == 14 .OR. igtyp == 6))THEN
1062 !for the moment, there is no orthotropic penta solid element (IGTYP == 6)
1063 jhbe = iparg(23,ng)
1064 nft = iparg(3,ng)
1065 iprop = ixs(10,nft+1)
1066 IF (jhbe /= 24) THEN
1067 CALL ancmsg(
1068 . msgid=3107,
1069 . msgtype=msgerror,
1070 . anmode=aninfo_blind_1,
1071 . i1=igeo(1,iprop),
1072 . i2=ipart(lipart1*(ipart(i15a)-1)+4),
1073 . prmod=msg_cumu)
1074 ENDIF
1075 CALL s6zinit3(
1076 . elbuf_tab(ng),nixs ,numels ,ixs ,numnod ,ms ,
1077 . npropm ,nummat ,pm ,x ,detonators,npropg ,
1078 . numgeo ,geo ,ale_connectivity ,nparg ,
1079 . iparg(1,ng),nel ,dtelem ,nsigs ,lsigi ,sigi ,
1080 . lskew ,numskw ,skew ,npropgi ,igeo ,stifn ,
1081 . npsav ,npart ,partsav ,v ,ipart(i15a),mss ,
1082 . lipart1 ,ipart ,glob_therm,nsigi ,lsigsp ,sigsp ,
1083 . npropmi ,ipm ,iuser ,volnod ,bvolnod ,vns ,
1084 . bns ,ptsol ,sbufmat ,bufmat ,mcp ,mcps ,
1085 . temp ,snpc ,npc ,stf ,pld ,strsglob(nf1),
1086 . straglob(nf1),mssa ,fail_ini ,sizloadp ,nloadp ,iloadp ,
1087 . lfacload ,facload ,nperturb ,srnoise ,rnoise ,perturb ,
1088 . mat_param,defaults%SOLID ,numsol ,i7stifs ,isorth ,
1089 . istrain ,jthe ,mtn ,nft )
1090 ELSEIF(isolnod == 10 .OR.(isolnod == 4 .AND.isrot == 1))THEN
1091 kk1=1+numels*nixs
1092 CALL s10init3(elbuf_tab(ng),
1093 1 ms ,ixs ,pm ,x ,
1094 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1095 3 dtelem ,sigi ,nel ,skew ,igeo ,
1096 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1097 5 ixs10 ,ipart ,glob_therm,
1098 7 mssx ,sigsp ,nsigi ,ipm ,
1099 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1100 9 bns ,vnsx ,bnsx ,ptsol ,bufmat ,
1101 a mcp ,mcps ,mcpsx ,temp ,npc ,
1102 b pld ,in ,stifr ,ins ,mssa ,
1103 c strsglob(nf1),straglob(nf1),fail_ini,iloadp ,facload ,
1104 d perturb ,rnoise ,mat_param,defaults%SOLID)
1105 IF (nsigi > 0 ) THEN
1106 nnod = 10
1107 nsrot = 0
1108 IF(isolnod == 4 .AND.isrot == 1) nsrot = 4
1109 CALL sgsavinierefq(nnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1110 . gbuf%SMSTR,gbuf%OFF,ixs(1,nf1),dr,nsrot,nel)
1111 IF (ismstr==10.OR.ismstr==12)
1112 . CALL s10jaci3(elbuf_tab(ng),gbuf%SMSTR,npt,nel)
1113 END IF
1114 ELSEIF(ity==1.AND.isolnod==20)THEN
1115 kk1=1+numels*nixs+numels10*6
1116 CALL s20init3(
1117 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1118 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1119 3 dtelem ,sigi ,nel ,skew ,igeo ,
1120 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1121 5 ixs20 ,ipart ,mssx ,sigsp ,nsigi ,
1122 7 ipm , iuser ,nsigs ,volnod ,bvolnod ,
1123 8 vns ,bns ,vnsx ,bnsx ,ptsol ,
1124 9 bufmat ,mcp ,mcps ,mcpsx ,temp ,
1125 a npc ,pld ,strsglob(nf1),straglob(nf1),fail_ini ,
1126 b iloadp ,facload ,perturb,rnoise ,mat_param ,
1127 c glob_therm )
1128 ELSEIF(ity==1.AND.isolnod==16)THEN
1129 kk1=1+numels*nixs+numels10*6+numels20*12
1130 CALL s16init3(
1131 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1132 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1133 3 dtelem ,sigi ,nel ,skew ,igeo ,
1134 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1135 5 ixs16 ,ipart ,mssx ,sigsp ,nsigi ,
1136 6 ipm ,iuser ,nsigs ,volnod ,bvolnod ,
1137 7 vns ,bns ,vnsx ,bnsx ,ptsol ,
1138 8 bufmat ,mcp ,mcps ,mcpsx ,temp ,
1139 9 npc ,pld ,strsglob(nf1),straglob(nf1),fail_ini ,
1140 a iloadp ,facload ,perturb ,rnoise ,mat_param ,
1141 b glob_therm )
1142 ELSE
1143 jhbe=iparg(23,ng)
1144 jclos=iparg(33,ng)
1145 iint =iparg(36,ng)
1146 IF (jhbe==1.OR.jhbe==2.OR.jhbe==12.OR.jhbe==16) THEN
1147 jcvt=0
1148 ELSE
1149 jcvt=1
1150 ENDIF
1151 iprop = ixs(10,nft+1)
1152 igtyp = nint(geo(npropg*(iprop-1)+12))
1153 nuvar = nint(geo(npropg*(iprop-1)+25))
1154 istrain = iparg(44,ng)
1155 IF (jhbe == 15) THEN
1156 !Thick shells PA6 / HQEPH
1157 IF (isolnod == 6)THEN
1158 CALL s6cinit3(
1159 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1160 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1161 . dtelem ,sigi ,nel ,skew ,igeo ,
1162 . stifn ,partsav ,v ,ipart(i15a),mss,
1163 . ipart ,glob_therm,
1164 . sigsp ,nsigi ,ipm ,iuser ,nsigs ,
1165 . volnod ,bvolnod ,vns ,bns ,ptsol ,
1166 . bufmat ,mcp ,mcps ,mcpsx ,temp ,
1167 . npc ,pld ,strsglob(nf1),straglob(nf1),mssa ,
1168 . orthoglob ,fail_ini ,iloadp ,facload ,perturb ,
1169 . rnoise ,mat_param,defaults%SOLID)
1170 ELSE
1171 CALL scinit3(elbuf_tab(ng),
1172 . ms ,ixs ,pm ,x ,mss ,
1173 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1174 . dtelem ,sigi ,nel ,skew ,igeo ,
1175 . stifn ,partsav ,v ,ipart(i15a) ,ipart ,
1176 . sigsp ,nsigi ,msnf ,mssf ,ipm ,
1177 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1178 . bns ,wma ,ptsol ,bufmat ,mcp ,
1179 . mcps ,temp ,npc ,pld ,mssa ,
1180 . strsglob(nf1),straglob(nf1),orthoglob ,fail_ini ,iloadp ,
1181 . facload ,rnoise ,perturb ,glob_therm, mat_param)
1182 ENDIF
1183 ELSEIF (jhbe == 14 .AND.
1184 . (igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22)) THEN
1185 !HA8 thick shell
1186 gbuf => elbuf_tab(ng)%GBUF
1187 CALL s8cinit3(
1188 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1189 . detonators,geo ,veul ,ale_connectivity,iparg(1,ng),
1190 . dtelem ,sigi ,nel ,skew ,igeo ,
1191 . stifn ,partsav ,v ,ipart(i15a),mss,
1192 . ipart ,sigsp ,nsigi ,msnf ,mssf ,ipm ,
1193 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1194 . bns ,wma ,ptsol ,bufmat ,mcp ,
1195 . mcps ,temp ,npc ,pld ,xrefs ,
1196 . mssa ,strsglob,strsglob(nf1),straglob(nf1),fail_ini,
1197 . iloadp ,facload ,perturb ,rnoise ,mat_param,glob_therm)
1198 IF (istot == 1) THEN
1199 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1200 ENDIF
1201 IF (nsigi > 0 ) THEN
1202 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1203 . gbuf%SMSTR,gbuf%OFF,nel)
1204 END IF
1205 ELSEIF (jhbe == 14 .OR. jhbe == 222 .OR. jhbe == 17) THEN
1206 !HA8 and H8E solid
1207 gbuf => elbuf_tab(ng)%GBUF
1208 IF (istot == 1) THEN
1209 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1210 IF (nsigi > 0 ) THEN
1211 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1212 . gbuf%SMSTR,gbuf%OFF,nel)
1213 END IF
1214 IF (nxref > 0 .AND. jhbe == 17 ) THEN
1215 CALL srefsta3(
1216 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1217 2 ipm ,igeo ,skew ,x ,xrefs ,
1218 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param,
1219 6 npc ,pld ,nummat )
1220 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1221 END IF
1222 END IF
1223 CALL s8zinit3(
1224 . elbuf_tab(ng),ms ,ixs ,pm ,x ,
1225 . detonators,geo ,veul ,ale_connectivity,iparg(1,ng),
1226 . dtelem,sigi ,nel ,skew ,igeo ,
1227 . stifn ,partsav ,v ,ipart(i15a),mss,
1228 . ipart ,glob_therm,
1229 . sigsp ,nsigi ,msnf ,mssf ,ipm ,
1230 . iuser ,nsigs ,volnod ,bvolnod ,vns ,
1231 . bns ,wma ,ptsol ,bufmat ,mcp ,
1232 . mcps ,temp ,npc ,pld ,xrefs ,
1233 . mssa ,strsglob(nf1),straglob(nf1),fail_ini,spbuf ,
1234 . kxsp ,ipart(i15j) ,nod2sp ,sol2sph ,irst,
1235 . iloadp ,facload ,perturb ,rnoise ,mat_param)
1236 IF (nsigi > 0 .AND. ismstr == 1) THEN
1237 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1238 . gbuf%SMSTR,gbuf%OFF,nel)
1239 END IF
1240 ELSEIF (igtyp>=29) THEN
1241 CALL suinit3(elbuf_tab(ng),ms ,ixs ,pm ,x ,
1242 . detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1243 . dtelem,sigi ,nel ,skew ,igeo ,
1244 . stifn ,partsav ,v ,ipart(i15a),mss,
1245 . ipart ,sigsp ,glob_therm,temp ,
1246 . nsigi ,in ,vr ,ipm ,nsigs ,
1247 . volnod ,bvolnod ,vns ,bns ,ptsol ,
1248 . bufmat ,npc ,pld ,fail_ini ,ins ,
1249 . iloadp ,facload ,perturb,rnoise ,mat_param)
1250 ELSE
1251 gbuf => elbuf_tab(ng)%GBUF
1252 IF (npt == 1 .AND. istot == 1) THEN
1253 CALL sgsavini(isolnod,x,ixs(1,nft+1),gbuf%SMSTR,nel)
1254 IF (nsigi > 0 ) THEN
1255 CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1256 . gbuf%SMSTR,gbuf%OFF,nel)
1257 END IF
1258 ENDIF
1259 IF (jmult == 0) THEN
1260 CALL sinit3(
1261 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1262 2 detonators ,geo ,veul ,ale_connectivity ,iparg(1,ng),
1263 3 dtelem ,sigi ,nel ,skew ,igeo ,
1264 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1265 5 ipart ,sigsp ,ng ,iparg ,
1266 7 nsigi ,msnf ,nvc ,mssf ,ipm ,
1267 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1268 9 bns ,in ,vr ,ins ,wma ,
1269 a ptsol ,bufmat ,mcp ,mcps ,temp ,
1270 b xrefs ,npc ,pld ,mssa ,strsglob(nf1),
1271 c straglob(nf1),fail_ini ,spbuf ,kxsp ,ipart(i15j),
1272 d nod2sp ,sol2sph ,irst ,iloadp ,facload ,
1273 e rnoise ,perturb ,mat_param,glob_therm)
1274 ELSE IF (jmult > 0 .AND. mtn == 151) THEN
1275 !Multifluid law
1276 CALL multifluid_init3 (
1277 1 elbuf_tab(ng),ms ,ixs ,pm ,x ,
1278 2 geo ,ale_connectivity ,iparg(1,ng),
1279 3 dtelem ,sigi ,nel ,skew ,igeo ,
1280 4 stifn ,partsav ,v ,ipart(i15a),mss ,
1281 5 ipart ,sigsp ,ng ,iparg ,glob_therm ,
1282 7 nsigi ,msnf ,nvc ,mssf ,ipm ,
1283 8 iuser ,nsigs ,volnod ,bvolnod ,vns ,
1284 9 bns ,in ,vr ,ins ,wma ,
1285 a ptsol ,bufmat ,mcp ,mcps ,temp ,
1286 b xrefs ,npc ,pld ,mssa ,strsglob(nf1),
1287 c straglob(nf1),fail_ini ,spbuf ,kxsp ,ipart(i15j),
1288 d nod2sp ,sol2sph ,irst ,iloadp ,facload ,
1289 e multi_fvm, error_thrown,detonators, mat_param)
1290 ENDIF
1291
1292 CALL srefsta3(
1293 1 elbuf_tab(ng),ixs ,pm ,geo ,iparg(1,ng),
1294 2 ipm ,igeo ,skew ,x ,xrefs ,
1295 3 nel ,ipart(i15a),ipart ,bufmat ,mat_param,
1296 6 npc ,pld ,nummat )
1297C
1298C Case total strain: conf_ref <- XREF
1299 IF (nxref > 0 .AND. (npt == 1 .AND. istot == 1) ) THEN
1300 CALL sgsavref(isolnod,xrefs(1,1,nft+1),gbuf%SMSTR,nel)
1301 END IF
1302 IF (nsigi > 0 ) THEN
1303 IF (nxref > 0 .OR. ismstr == 1 )
1304 . CALL sgsavinieref(isolnod,straglob(nf1),sigsp,nsigi,ptsol(nf1),
1305 . gbuf%SMSTR,gbuf%OFF,nel)
1306 END IF
1307 nc1 = nvc / 128
1308 nc2 = (nvc-nc1*128) / 64
1309 nc3 = (nvc-nc1*128-nc2*64) / 32
1310 nc4 = (nvc-nc1*128-nc2*64-nc3*32)/16
1311 nc5 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16)/8
1312 nc6 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8)/4
1313 nc7 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8-nc6*4)/2
1314 nc8 = (nvc-nc1*128-nc2*64-nc3*32-nc4*16-nc5*8-nc6*4-nc7*2)
1315 IF (nc1 == 1) nc1_old = 1
1316 IF (nc2 == 1) nc2_old = 1
1317 IF (nc3 == 1) nc3_old = 1
1318 IF (nc4 == 1) nc4_old = 1
1319 IF (nc5 == 1) nc5_old = 1
1320 IF (nc6 == 1) nc6_old = 1
1321 IF (nc7 == 1) nc7_old = 1
1322 IF (nc8 == 1) nc8_old = 1
1323 iparg(19,ng) = nc1_old*128+nc2_old*64+nc3_old*32+nc4_old*16+nc5_old*8+nc6_old*4+nc7_old*2+nc8
1324 ENDIF
1325 ENDIF
1326 !----------------------------------------!
1327 ! ity == 2 quad !
1328 !----------------------------------------!
1329 ELSEIF(ity == 2)THEN
1330 ihbe =iparg(23,ng)
1331 IF (jmult == 0) THEN
1332 IF (ihbe == 17 .OR. (n2d == 1.AND.ihbe == 22)) THEN
1333 CALL q4init2(elbuf_tab(ng),ms ,ixq,pm,x,
1334 2 detonators,geo,veul,ale_connectivity,iparg(1,ng),
1335 3 dtelem,sigi,igeo ,
1336 4 nel ,skew , msq ,ipart ,ipart(i15b),
1337 5 ipm ,nsigs ,wma ,ptquad ,bufmat ,
1338 6 npc ,pld ,iparg ,iloadp ,facload ,
1339 7 partsav,v ,mat_param)
1340 ELSE
1341 CALL qinit2(
1342 . elbuf_tab(ng),ms,ixq ,pm ,x ,
1343 . detonators,geo,veul,ale_connectivity,iparg(1,ng),
1344 . dtelem,sigi,igeo ,
1345 . nel ,skew, msq, ipart, ipart(i15b),
1346 . ipm ,nsigs ,
1347 . wma ,ptquad ,bufmat ,npc ,pld,
1348 . iparg ,iloadp ,facload ,partsav,v, mat_param)
1349 ENDIF
1350 ELSE ! JMULT > 0
1351 IF (mtn == 20) THEN
1352 CALL binit2(
1353 . elbuf_tab(ng),ms ,ixq ,pm ,x ,
1354 . detonators ,veul ,ale_connectivity ,iparg(1,ng) ,fill ,
1355 . sigi ,bufmat ,nel ,mat_param ,
1356 . skew ,msq ,ipart ,ipart(i15b) ,
1357 . geo ,igeo ,ipm ,
1358 . nsigs ,wma ,ptquad ,npc ,pld ,
1359 . iparg ,iloadp ,facload ,partsav ,v )
1360 ELSE IF (mtn == 151) THEN
1361C 2D multifluid law
1362 CALL multifluid_init2(nel, nsigs,
1363 . iparg, ixq, ipm, ale_connectivity, igeo, ipart, ipart(i15b), npc,
1364 . ptquad, iloadp, x, pm,
1365 . geo, sigi, skew, pld, bufmat, facload, elbuf_tab(ng), error_thrown,detonators,
1366 . mat_param)
1367 ELSE
1368 CALL arret(2)
1369 ENDIF
1370 ENDIF
1371 !----------------------------------------!
1372 ! ITY == 3 SHELL !
1373 !----------------------------------------!
1374 ELSEIF (ity == 3)THEN
1375 istrain =iparg(44,ng)
1376 ihbe =iparg(23,ng)
1377 ithk =iparg(28,ng)
1378 ilev =iparg(45,ng)
1379 ixfem =iparg(54,ng)
1380 dt2=dt2s
1381 IF (ihbe>10.AND.ihbe<29) THEN
1382 NULLIFY(ptr_itage)
1383 IF (sitage>0) ptr_itage=>itage(1)
1384 CALL cbainit3(elbuf_tab(ng),
1385 1 ixc,pm ,x ,geo ,
1386 2 ms ,in ,nvc ,dtelem,igrsh4n ,
1387 3 xrefc ,nel ,ithk ,ihbe ,igrsh3n ,
1388 4 thk(1+nft),isigsh,sigsh ,stifn ,stifr ,
1389 5 partsav ,v ,ipart(i15c) ,msc,inc ,
1390 6 skew ,i8mi ,nsigsh ,igeo ,
1391 7 ipm ,iuser ,etnod ,nshnod ,stc ,
1392 8 ptshel ,bufmat ,sh4tree ,mcp ,mcpc ,
1393 9 temp ,ms_layer, zi_layer ,itag ,itagel ,
1394 a iparg(1,ng),ms_layerc,zi_layerc,part_area,cpt_eltens,
1395 b msz2c ,zply ,itagn ,ptr_itage ,ixfem ,
1396 c npc ,pld ,xfem_tab,isubstack ,stack ,
1397 d rnoise ,drape ,sh4ang ,iddlevel,geo_stack,
1398 e igeo_stack ,strc ,perturb ,iyldini ,ele_area,
1399 f nloc_dmg ,ng ,group_param_tab(ng),idrape,drapeg,
1400 g mat_param ,fail_fractal,fail_brokmann,glob_therm)
1401 ELSE
1402 NULLIFY(ptr_itage)
1403 IF (sitage>0) ptr_itage => itage(1)
1404 CALL cinit3(elbuf_tab(ng),
1405 1 ixc ,pm ,x ,geo ,
1406 2 ms ,in ,nvc ,dtelem ,igrsh4n ,
1407 3 xrefc ,nel ,ithk ,ihbe ,igrsh3n ,
1408 4 thk(1+nft),isigsh ,sigsh ,stifn ,stifr ,
1409 5 partsav ,v ,ipart(i15c),msc ,inc ,
1410 8 skew ,iparg(1,ng),i8mi ,nsigsh ,igeo ,
1411 9 iuser ,etnod ,nshnod ,stc ,ptshel ,
1412 a ipm ,bufmat ,sh4tree ,mcp ,mcpc ,
1413 b temp ,cpt_eltens ,part_area ,itagn ,ptr_itage ,
1414 c ixfem ,npc ,pld ,xfem_tab,isubstack,
1415 d stack ,rnoise ,drape ,sh4ang ,iddlevel ,
1416 e geo_stack,igeo_stack ,strc ,perturb ,iyldini ,
1417 f ele_area ,ng ,group_param_tab(ng) ,nloc_dmg ,
1418 g idrape ,drapeg ,mat_param ,fail_fractal,fail_brokmann,
1419 h glob_therm)
1420 ENDIF
1421 nc1 = nvc / 8
1422 nc2 = (nvc-nc1*8) / 4
1423 nc3 = (nvc-nc1*8-nc2*4) / 2
1424 nc4 = nvc-nc1*8-nc2*4-nc3*2
1425 IF (nc1 == 1) nc1_old = 1
1426 IF (nc2 == 1) nc2_old = 1
1427 IF (nc3 == 1) nc3_old = 1
1428 IF (nc4 == 1) nc4_old = 1
1429 iparg(19,ng)=nc1_old*8+nc2_old*4+nc3_old*2+nc4_old
1430 dt2s=dt2
1431 dt2=0.
1432 !----------------------------------------!
1433 ! ITY == 4 TRUSS !
1434 !----------------------------------------!
1435 ELSEIF (ity == 4) THEN
1436 CALL tinit3(elbuf_tab(ng),
1437 1 ixt ,pm ,x ,geo ,ms ,
1438 2 dtelem ,nft ,nel ,stifn ,partsav,
1439 3 v ,ipart(i15d),mst ,stifint,stt ,
1440 4 igeo ,nsigtruss ,sigtruss ,pttruss,
1441 5 preload_a,iboltp ,npreload_a )
1442 !----------------------------------------!
1443 ! ITY == 5 BEAM !
1444 !----------------------------------------!
1445 ELSEIF (ity == 5) THEN
1446 CALL pinit3(elbuf_tab(ng),
1447 1 stp ,ixp ,pm ,x ,geo ,
1448 2 dtelem ,nft ,nel ,
1449 3 stifn ,stifr ,partsav ,v ,ipart(i15e),
1450 4 msp ,inp ,igeo ,strp ,
1451 5 nsigbeam ,sigbeam ,ptbeam ,iuser ,
1452 6 mcpp ,temp ,preload_a,iboltp ,npreload_a ,
1453 7 glob_therm ,ibeam_vector,rbeam_vector)
1454 !----------------------------------------!
1455 ! ITY == 6 SPRING !
1456 !----------------------------------------!
1457 ELSEIF (ity == 6) THEN
1458 iopt = ptr_nopt_fun + 1
1459 CALL rinit3(elbuf_tab(ng),
1460 1 ixr ,x ,geo ,ms ,npc ,
1461 2 pld ,in ,skew ,dtelem ,nel ,
1462 3 stifn ,stifr ,partsav ,v ,ipart(i15f),
1463 4 itab ,msr ,
1464 5 inr ,stifint ,str(nft+1),igeo ,sigrs ,
1465 6 nsigrs ,imerge2 ,iadmerge2 ,msrt(nft+1),ixr_kj ,
1466 7 nom_opt(1,iopt),strr ,ptspri ,ipm , pm ,
1467 8 bufmat ,r_skew ,preload_a ,iboltp ,npreload_a,
1468 9 ikine)
1469 !----------------------------------------!
1470 ! ITY == 7 SH3N or TRIA !
1471 !----------------------------------------!
1472 ELSEIF(ity == 7 .OR. ity == 8)THEN
1473 istrain =iparg(44,ng)
1474 ithk =iparg(28,ng)
1475 ish3n =iparg(23,ng)
1476 icnod =iparg(11,ng)
1477 IF (ish3n == 30 .AND. icnod == 6) ish3n = 0
1478 ilev =iparg(45,ng)
1479 dt2=dt2s
1480 IF (ish3n == 30) THEN
1481 CALL cdkinit3(elbuf_tab(ng),group_param_tab(ng),
1482 1 ixtg ,pm ,x ,geo ,
1483 2 ms ,in ,nvc ,dtelem,
1484 3 xreftg ,offset,nel ,ithk ,thk(1+nft+numelc),
1485 4 isigsh ,sigsh(1,ksigsh3),stifn,stifr, partsav ,
1486 5 v ,ipart(i15h) ,mstg ,intg , ptg ,
1487 8 skew ,ish3n ,nsigsh ,igeo ,ipm ,
1488 9 iuser ,etnod ,nshnod ,sttg ,ptsh3n ,
1489 a bufmat ,sh3tree,mcp ,mcptg , temp ,
1490 b iparg(1,ng),cpt_eltens,part_area ,npc ,pld ,
1491 c sh3trim ,isubstack,stack ,rnoise,
1492 d drape,sh3ang ,geo_stack,igeo_stack,strtg,
1493 e perturb,iyldini ,ele_area,nloc_dmg,
1494 f idrape, drapeg,mat_param,glob_therm)
1495 ELSEIF (mtn == 151 .OR. n2d > 0) THEN
1496 CALL multifluid_init2t(elbuf_tab(ng), nel, nsigs, nvc, iparg, ixtg, ale_connectivity,
1497 . igeo, ipart, ipart(i15h), ipm, ptsh3n, npc, iloadp,
1498 . x, pm, geo, sigi, skew, pld, bufmat, facload, multi_fvm, error_thrown, detonators,
1499 . mat_param)
1500 ELSE
1501 NULLIFY(ptr_itage)
1502 IF (sitage > 0) ptr_itage => itage(numelc+1)
1503 CALL c3init3(elbuf_tab(ng),
1504 1 ixtg ,pm ,x ,geo ,igrsh4n,
1505 2 ms ,in ,nvc ,dtelem,igrsh3n ,
1506 3 xreftg ,offset,nel ,ithk ,thk(1+nft+numelc),
1507 4 isigsh ,sigsh(1,ksigsh3),stifn,stifr,partsav ,
1508 5 v ,ipart(i15h),mstg,intg ,ptg ,
1509 8 skew,iparg(1,ng) , nsigsh ,igeo,iuser ,
1510 9 etnod ,nshnod ,sttg ,ptsh3n ,ipm ,
1511 a bufmat ,sh3tree ,mcp ,mcptg , temp ,
1512 b cpt_eltens,part_area,ptr_itage,itagn,ixfem ,
1513 c npc ,pld ,sh3trim ,xfem_tab,
1514 d isubstack , stack,rnoise ,
1515 e drape ,sh3ang,iddlevel,geo_stack,igeo_stack,strtg,
1516 f perturb ,ish3n,iyldini ,ele_area,
1517 g nloc_dmg,ng,group_param_tab(ng),idrape,
1518 h drapeg,mat_param,fail_fractal,fail_brokmann,glob_therm)
1519 ENDIF
1520 nc1 = nvc / 8
1521 nc2 = (nvc-nc1*8) / 4
1522 nc3 = (nvc-nc1*8-nc2*4) / 2
1523 IF (nc1 == 1) nc1_old = 1
1524 IF (nc2 == 1) nc2_old = 1
1525 IF (nc3 == 1) nc3_old = 1
1526 iparg(19,ng)=nc1_old*8+nc2_old*4+nc3_old*2
1527 dt2s=dt2
1528 dt2=0.
1529 !----------------------------------------!
1530 ! ITY == 51 SPH !
1531 !----------------------------------------!
1532 ELSEIF(ity == 51)THEN
1533C SPH cells
1534 jsph=1
1535 isph2sol=iparg(69,ng)
1536 CALL spinit3(ity ,spbuf ,kxsp ,x ,geo ,
1537 2 ms ,npc ,pld ,in ,skew ,
1538 3 dtelem ,nel ,stifn ,stifr ,igeo ,
1539 4 partsav ,v ,ipart(i15j),bufmat,
1540 5 pm ,itab ,msr ,inr ,ixsp ,
1541 6 nod2sp ,iparg(1,ng),ale_connectivity ,detonators ,
1542 7 sigsph ,isptag ,ipart ,
1543 8 ipm ,nsigsph ,ptsph ,npc ,
1544 9 pld ,elbuf_tab(ng),mcp,temp ,iloadp,
1545 a facload ,stifint ,i7stifs,glob_therm , mat_param)
1546 !----------------------------------------------------------!
1547 ! ITY == 100 Pulley PID28 + User elements PID 29-30-31 !
1548 !----------------------------------------------------------!
1549 ELSEIF(ity == 100)THEN
1550 iaduix=1
1551 iadux =iaduix+maxnx
1552 iaduv =iadux +3*maxnx
1553 iaduvr=iaduv +3*maxnx
1554 iadums=iaduvr+3*maxnx
1555 iaduin=iadums+maxnx
1556 iadusm=iaduin+maxnx
1557 iadusr=iadusm+maxnx
1558 iadumv=iadusr+maxnx
1559 iadurv=iadumv+maxnx
1560 CALL xinit3(elbuf_tab(ng),kxx,ixx ,x ,v ,
1561 2 vr ,ms ,in ,
1562 3 skew ,dtelem ,nel ,stifn ,stifr ,
1563 4 partsav ,ipart(i15i),geo ,
1564 5 itab ,xelemwa(iaduix) ,xelemwa(iadux) ,xelemwa(iaduv) ,
1565 6 xelemwa(iaduvr) ,xelemwa(iadums) ,xelemwa(iaduin) ,
1566 7 xelemwa(iadusm) ,xelemwa(iadusr) ,xelemwa(iadumv) ,
1567 8 xelemwa(iadurv) ,igeo, nft)
1568c
1569 !----------------------------------------!
1570 ! ITY == 101 IGE3D !
1571 !----------------------------------------!
1572 ELSEIF (ity == 101) THEN
1573 nctrl = iparg(75,ng)
1574 px = igeo(41,iparg(62,ng))
1575 py = igeo(42,iparg(62,ng))
1576 pz = igeo(43,iparg(62,ng))
1577 CALL ig3dinit3(elbuf_tab(ng),ms ,kxig3d ,ixig3d ,pm ,x,
1578 . detonators ,geo ,veul ,ale_connectivity,iparg(1,ng),
1579 . dtelem,sigi ,nel ,skew ,igeo ,
1580 . stifn ,partsav ,v ,ipart(i15k),mss,
1581 . ipart ,sigsp ,
1582 . nsigi ,in ,vr ,ipm ,nsigs ,
1583 . vnige ,bnige ,ptsol ,
1584 . bufmat ,npc ,pld ,fail_ini,nctrl,
1585 . msig3d ,knot ,nctrlmax,wige ,px,py,pz,
1586 . knotlocpc,knotlocel,mat_param)
1587 ENDIF
1588C
1589 IF (ity == 3) THEN
1590 WRITE(iout,'(A,I10,A,I5)')' SHELL GROUP',ng, ' VECTORIZATION CODE =',iparg(19,ng)
1591 ELSEIF (ity == 7) THEN
1592 WRITE(iout,'(A,I10,A,I5)')' TRIANGULAR SHELL GROUP',ng, ' VECTORIZATION CODE =',iparg(19,ng)
1593 ELSEIF (ity == 1) THEN
1594 WRITE(iout,'(A,I10,A,I5)')' BRICK GROUP',ng,' VECTORIZATION CODE =',iparg(19,ng)
1595 ENDIF
1596C
1597 ENDIF
1598 END DO ! End loop on element group NG
1599!
1600 !<-----------------------------------------------------------------------
1601 !< Print /PENTA6 error message if any
1602 !<-----------------------------------------------------------------------
1603 CALL ancmsg(msgid=3107,
1604 . msgtype=msgerror,
1605 . anmode=aninfo_blind_1,
1606 . prmod=msg_print)
1607 !<-----------------------------------------------------------------------
1608!
1609C-----------
1610!DETONATION TIMES WITH SHADOWING EFFECTS
1611!FAST MARCHING METHOD
1612 CALL eikonal_solver(ixq , nixq , numelq ,
1613 . ixs , nixs , numels ,
1614 . ixtg , nixtg , numeltg ,
1615 . x , numnod , titre(55),
1616 . elbuf_tab, ngroup , nparg ,
1617 . nod2eltg , knod2eltg,
1618 . nod2elq , knod2elq ,
1619 . nod2els , knod2els ,
1620 . iparg , ale_connectivity, npropm, nummat, pm, n2d, detonators,
1621 . npropmi , ipm )
1622C---------------------------------------------------
1623C Initialization of global detonation times (Law151)
1624 CALL multifluid_global_tdet(iparg,elbuf_tab,multi_fvm,ipm)
1625! DETONATION TIMES PRINTOUT
1626C---------------------------------------------------
1627! + DEFAULT INITIALIZATION TO 0.0 IN CASE OF NO DETONATOR
1628 CALL detonation_times_printout(nparg,ngroup,iparg,n2d,ipri,elbuf_tab,
1629 . nixs,nixq,nixtg,numels,numelq,numeltg,ixs,ixq,ixtg)
1630C-----------
1631 !loop over material initialisation done.
1632 !IF NRF outlet, print its automatic characteristic
1633 IF(m51_iflg6==1 .AND. m51_lset_iflg6==1)THEN
1634 !first initialization of group whose MAT=51 + iform=6
1635 WRITE (iout,1001)m51_lc0max,m51_ssp0max,m51_tcp_ref
1636 ENDIF
1637
1638 1001 FORMAT(
1639 .//
1640 .' NON REFLECTING FRONTIERS (/MAT/LAW51) '/
1641 .' ------------------------------------- '/
1642 & 5x,'INITIALIZATION OF GLOBAL PARAMETERS ',/
1643 & 5x,'CHARACTERISTIC LENGTH. . . . . . . . . .=',e12.4/
1644 & 5x,'REFERENCE SOUND SPEED. . . . . . . . . =',e12.4/
1645 & 5x,'CHARACTERISTIC TIME. . . . . . . . . . .=',e12.4//)
1646
1647C Add error message when y < zero and N2D=1
1648 CALL ancmsg(msgid=1228,msgtype=msgerror,anmode=aninfo_blind_1,prmod=msg_print)
1649
1650 user_grp_domain = 0
1651C-------------------------------------------------
1652C Tetrahedron : Smooth finite element formulations
1653C Option ITETRA==3 - set general Flag
1654C-------------------------------------------------
1655 isfem=0
1656 DO ng = 1, ngroup
1657 ity =iparg(5,ng)
1658 isolnod = iparg(28,ng)
1659 isrot = iparg(41,ng)
1660 icpre = iparg(10,ng)
1661 IF(ity /= 1)cycle
1662 IF(iparg(8, ng) == 1) cycle
1663 IF(isolnod /= 4 .AND. isolnod /= 10) cycle
1664 IF(isolnod==4.AND.isrot == 3) isfem=1
1665 IF(icpre>0.AND.(isolnod==10.OR.(isolnod==4.AND.isrot == 1))) isfem=1
1666 ENDDO
1667C--------------------------------------------
1668C Warning : Elements initially in tension
1669C--------------------------------------------
1670 IF (cpt_eltens /= 0) THEN
1671 CALL ancmsg(msgid=863,msgtype=msgwarning,anmode=aninfo_blind_1,i1=cpt_eltens)
1672 ENDIF
1673C---------------------------------------------------------------
1674C Additional nodal mass from added part mass : /ADMAS option
1675C---------------------------------------------------------------
1676 addedms(1:npart) = zero
1677 IF(imasadd > 0)THEN
1678 CALL spmd_partsav_pon(
1679 1 ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
1680 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
1681 3 mss ,mssx ,msq ,msc ,
1682 4 mst ,msp ,msr ,mstg ,
1683 5 index ,itri ,geo ,partsav1_pon ,ipart(i15a) ,
1684 6 ipart(i15b),ipart(i15c),ipart(i15d),ipart(i15e) ,ipart(i15f) ,
1685 7 ipart(i15h),ipart )
1686 CALL addmaspart(ipart,ipmas,partsav,
1687 . part_area,pm,addedms,nom_opt(1,ptr_nopt_adm+1),
1688 . partsav1_pon)
1689 CALL spmd_msin_addmass(
1690 1 ixs ,ixs10 ,ixs20 ,ixs16 ,ixq ,
1691 2 ixc ,ixt ,ixp ,ixr ,ixtg ,
1692 3 mss ,mssx ,msq ,msc ,
1693 4 mst ,msp ,msr ,mstg ,
1694 5 ptg ,ms ,index ,itri ,
1695 6 geo ,sh4tree ,sh3tree ,partsav ,ipmas ,
1696 7 ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
1697 8 ipart(i15e),ipart(i15f),ipart(i15h),totaddmas ,
1698 9 ipart ,thk ,pm ,part_area ,
1699 a addedms ,itab ,partsav1_pon,ele_area )
1700 END IF
1701C---------------------------------------------------------------
1702C Parallel arithmetic : initialisation of nodal mass and inertia
1703C---------------------------------------------------------------
1704 kk1=1+numels*nixs
1705 kk2=kk1+numels10*6
1706 kk3=kk2+numels20*12
1707 CALL spmd_msin(
1708 1 ixs ,ixq ,ixc ,ixt ,ixp ,
1709 2 ixr ,ixtg ,mss ,msq ,
1710 3 msc ,mst ,msp ,msr ,mstg ,
1711 4 inc ,inp ,inr ,intg ,
1712 5 index ,itri ,ms ,in ,
1713 6 ptg ,geo ,ixs10 ,ixs20 ,
1714 7 ixs16 ,mssx ,msnf ,mssf ,vns ,
1715 8 vnsx ,stc ,stt ,stp ,str ,
1716 9 sttg ,stur ,bns ,bnsx ,volnod ,
1717 a bvolnod ,etnod ,stifint ,ins ,mcpc ,
1718 b mcp ,mcps ,mcpsx ,mcptg,sh4tree,
1719 c sh3tree ,ms_layerc, zi_layerc , ms_layer,
1720 d zi_layer,msz2c, msz2,zply ,
1721 e kxig3d ,ixig3d ,msig3d,nctrlmax,strc ,
1722 f strp,strr,strtg,stifintr,nshnod,vnige,bnige,
1723 g mcpp ,glob_therm%ITHERM_FE)
1724 IF(i7stifs/=0)CALL asstifi(volnod,bvolnod,etnod,nshnod,stifint)
1725C---------------------------------------------------------------
1726C Contact Stiffness based on mass and time step :
1727C Initial time step estimation in starter
1728C---------------------------------------------------------------
1729 IF(interfaces%PARAMETERS%ISTIF_DT > 0) THEN
1730 CALL inintmass( ipari, intbuf_tab,ms , interfaces%PARAMETERS%ISTIF_DT )
1731 ENDIF
1732 interfaces%PARAMETERS%DT_STIFINT = zero
1733 IF(interfaces%PARAMETERS%ISTIF_DT > 0) THEN
1734 CALL dtnoda_stifint( ms ,stifn ,interfaces%PARAMETERS%DT_STIFINT)
1735 ENDIF
1736!--------------------------------------------
1737! RWALL penalty stiffness initialization
1738!--------------------------------------------
1739 IF (sln_pen>0) THEN
1740 CALL init_rwall_penalty(elbuf_tab,
1741 1 numnod, nparg, ngroup, iparg, nummat,
1742 2 nrwall, nnprw, nprw, lprw, slprw,
1743 3 numelc,numeltg, numels,numels8, numels10,
1744 4 numels16,numels20, ixc, ixtg, ixs,
1745 5 ixs10, ixs16, ixs20, ixt, ixp,
1746 6 ixr, numelt, numelp, numelr, stifn,
1747 7 mat_param,sln_pen,rwstif_pen)
1748 END IF
1749C--------------------------------------------
1750C Laser impact
1751C--------------------------------------------
1752 IF(nlaser/=0)THEN
1753 CALL laser10(las,xlas,x,ixq,iparg)
1754 ENDIF
1755C-----------------------------------------------------
1756C Porous elements
1757C Modification of volumes and normals
1758C-----------------------------------------------------
1759 IF(n2d == 0 .AND. imulti_fvm /= 1)THEN
1760 DO ng=1,ngroup
1761 ity=iparg(5,ng)
1762 jeul =iparg(11,ng)
1763 IF(ity == 1 .AND. jeul /= 0 )THEN
1764 mtn=iparg(1,ng)
1765 nel=iparg(2,ng)
1766 nft=iparg(3,ng)
1767 iad=iparg(4,ng)
1768 npt=iparg(6,ng)
1769 jale=iparg(7,ng)
1770 ismstr=iparg(9,ng)
1771 jtur=iparg(12,ng)
1772 jthe=iparg(13,ng)
1773 jlag=iparg(14,ng)
1774 jmult=iparg(20,ng)
1775 jpor=iparg(27,ng)
1776 CALL eporin3(ixs,veul,ale_connectivity,geo,nft,nel)
1777 ENDIF
1778 ENDDO ! next element group NG
1779 ENDIF
1780C-----------------------------------------------------
1781C Option /INIVOL
1782C-----------------------------------------------------
1783 CALL init_inivol( num_inivol, inivol, nsurf, igrsurf,
1784 . nparg , ngroup, iparg, numnod, npart,
1785 . numels , nixs, ixs, igrnod, ngrnod,
1786 . numeltg , nixtg, ixtg,
1787 . numelq , nixq, ixq,
1788 . x , nbsubmat, kvol,
1789 . elbuf_tab, numels8, xrefs, glob_therm,
1790 . n2d ,multi_fvm, sipart, ipart ,
1791 . i15a ,i15b , i15h, sbufmat, bufmat,
1792 . npropmi ,nummat , ipm, sbufsf, bufsf,
1793 . npropg ,numgeo , geo, mvsiz , skvol,
1794 . itab ,mat_param)
1795C---------------------------------
1796C Gravity (after INIVOL)
1797C---------------------------------
1798 IF (ninigrav>0)THEN
1799 nv46=4
1800 IF(n2d==0)nv46 = 6
1801 CALL inigrav_load(
1802 1 elbuf_tab , ipart , igrpart , iparg , ipart(i15h),
1803 2 ipart(i15a) , ipart(i15b), x , ixs , ixq ,
1804 3 ixtg , pm , ipm , bufmat , multi_fvm ,
1805 4 ale_connectivity, nv46 , igrsurf , itab , ebcs_tab ,
1806 5 npc , pld , mat_param)
1807 ENDIF
1808C---------------------------------
1809C Initialization on 1D curves
1810C---------------------------------
1811 IF (ninimap1d > 0) THEN
1812 WRITE(istdo, '(A)') titre(53)
1813 CALL ini_inimap1d(inimap1d ,elbuf_tab ,ipart ,iparg ,ipart(i15a),
1814 . ipart(i15b) ,x ,v ,ixs ,ixq ,
1815 . ixtg ,pm ,ipm ,bufmat ,multi_fvm ,
1816 . pld ,npc ,igrbric ,igrquad ,igrsh3n ,
1817 . npts ,mat_param ,snpc ,stf)
1818 ENDIF
1819C---------------------------------
1820C Initialization on 2D functions
1821C---------------------------------
1822 IF (ninimap2d > 0) THEN
1823 WRITE(istdo, '(A)') titre(53)
1824 CALL ini_inimap2d(inimap2d ,elbuf_tab ,ipart ,iparg ,ipart(i15a),
1825 . ipart(i15b) ,x ,v ,ixs ,ixq ,
1826 . ixtg ,pm ,ipm ,bufmat ,multi_fvm ,
1827 . func2d ,igrbric ,igrquad ,igrsh3n ,npc,
1828 . pld ,mat_param)
1829 ENDIF
1830C---------------------------------
1831C Initialization of FVM velocities
1832C---------------------------------
1833 IF (multi_fvm%IS_USED .AND. ninvel > 0) THEN
1834 CALL ini_fvminivel(fvm_inivel ,multi_fvm ,igrbric ,igrquad ,igrsh3n)
1835 ENDIF
1836C------------------------------------------------------------------
1837C SMS : Initialization of GBUF%ISMS and automatic element selection
1838C------------------------------------------------------------------
1839 IF (isms_selec >= 1) THEN
1840 CALL sms_auto_dt(dtelem,nativ_sms,
1841 . ixs ,ixq ,ixc ,ixt ,ixp ,
1842 . ixr ,ixtg ,ixs10 ,ixs16 ,ixs20 ,
1843 . ipart(i15a) ,ipart(i15b) ,ipart(i15c) ,ipart(i15d) ,ipart(i15e),
1844 . ipart(i15f) ,ipart(i15h) ,ipart(i15i) ,ipart ,
1845 . iparg ,elbuf_tab ,igeo ,iddlevel ,tagprt_sms )
1846 ENDIF
1847C
1848 IF(ilag+iale+ieuler == 0)THEN
1849 DEALLOCATE(i8mi)
1850 RETURN
1851 ENDIF
1852C-------------------------------------
1853C Initialization of rigid bodies
1854C-------------------------------------
1855 b1=zero
1856 b2=zero
1857 b3=zero
1858 b6=zero
1859 b5=zero
1860 b9=zero
1861 totmas=zero
1862 xg=zero
1863 yg=zero
1864 zg=zero
1865C
1866 IF(nrbykin>0)THEN
1867 rbyid=0
1868 DO i=1,numnod
1869 iwa(i)=0
1870 ENDDO
1871 DO n=1,nrbykin
1872 m=npby(1,n)
1873 nsl=npby(2,n)
1874 isph=npby(5,n)
1875 rbyid= npby(6,n)
1876 isens=npby(4,n)
1877 id=nom_opt(1,n)
1878 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
1879 IF(isens == 0)THEN
1880 CALL inirby(n ,rby ,m ,lpby ,
1881 . ms,in ,x ,itab ,skew ,
1882 . b1,b2 ,b3 ,b5 ,b6 ,
1883 . b9,isph ,totmas ,xg ,yg ,
1884 . zg,stifn ,stifr ,npby ,rbyid ,
1885 . v ,vr ,id ,titr ,itagnd,
1886 . rby_iniaxis)
1887 iwa(m)=n
1888 ENDIF
1889 ENDDO
1890C
1891C-------------------------------------------
1892C Initialization of rigid bodies with sensor
1893C-------------------------------------------
1894 DO n=1,nrbykin
1895 m=npby(1,n)
1896 nsl=npby(2,n)
1897 isph=npby(5,n)
1898 isens=npby(4,n)
1899 rbyid= npby(6,n)
1900 id=nom_opt(1,n)
1901 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,n),ltitr)
1902 IF(isens/=0)THEN
1903 CALL inirbys(n ,rby ,m ,lpby ,
1904 . ms,in ,x ,itab ,skew,
1905 . b1,b2 ,b3 ,b5 ,b6 ,
1906 . b9,isph ,totmas ,xg ,yg ,
1907 . zg,npby ,iwa ,v ,vr ,
1908 . rbyid,id ,titr ,itagnd,rby_iniaxis)
1909 ENDIF
1910 ENDDO
1911 ENDIF
1912C----------------------------------------------------------
1913C Initialization of rigid bodies using Lagrange multipliers
1914C----------------------------------------------------------
1915 IF(nrbylag/=0)
1916 . CALL lgmini_rby(npbyl ,lpbyl ,rbyl ,ms ,in ,x ,v ,vr ,itab ,nom_opt)
1917C-------------------------------------
1918C Sorting of rigid bodies structures
1919C-------------------------------------
1920 IF (nrbmerge > 0) THEN
1921 CALL retrirby(npby ,lpby ,rby ,nom_opt)
1922 ENDIF
1923C--------------------------------------------
1924C Seat belts initialization :
1925C--------------------------------------------
1926 IF (n_seatbelt > 0) CALL init_seatbelt_rbodies(nnpby,nrbody,npby,slrbody,lpby,sicode,icode,nslipring)
1927C-------------------------------------
1928C Initialization of rigid materials
1929C-------------------------------------
1930 IF(irigid_mat > 0)THEN
1931 CALL ininode_rm(connec ,irig_node, slnrbm , nslnrbm ,nrbym ,
1932 . ngslnrbym,stifn ,stifr,rmstifn, rmstifr ,
1933 . nelemr,nindx )
1934 ENDIF
1935C-----------------------------------------------------------
1936C Verification of imposed motion to surfaces by rigid bodies
1937C-----------------------------------------------------------
1938 CALL inisrf(x,v,vr,npby,rby,igrsurf,bufsf)
1939C-----------------------------------------------------
1940C Check for springs with stiffness but no nodal mass
1941C-----------------------------------------------------
1942 CALL rcheckmass(ixr ,geo ,pm ,msr ,inr ,
1943 . ms ,in ,itab ,igeo ,ipm ,
1944 . bufmat ,ipart ,ipart(i15f),npby ,lpby )
1945C-------------------------------------
1946C Initialization of flexible bodies
1947C-------------------------------------
1948 IF (nfxbody>0) THEN
1949C
1950C-- Automatic setting of fxbody from pch files
1951C
1952 CALL ini_fxbody(fxbipm, fxbrpm, fxbnod, fxbglm,fxbcpm,
1953 . fxbcps, fxblm, fxbfls, fxbdls,fxbmod,
1954 . itab, x ,ms, in, fxb_matrix,
1955 . fxb_matrix_add,fxb_last_adress,icode,nom_opt(1,ptr_nopt_fxb+1))
1956C
1957 ALLOCATE(mbufel_tmp(lbufel), mdepl_tmp(3*numnod))
1958C
1959 nmani=0
1960 DO i=1,lenvar
1961 fxbdep(i)=zero
1962 fxbvit(i)=zero
1963 fxbacc(i)=zero
1964 ENDDO
1965 CALL fxbvini(fxbipm, fxbvit, fxbrpm, v, vr)
1966 ircs=0
1967 DO i=1,nfxbody
1968 alm=fxbipm(19,i)
1969 asig=fxbipm(20,i)
1970 amod=fxbipm(7,i)
1971 arpm=fxbipm(14,i)
1972 nbno=fxbipm(3,i)
1973 nme=fxbipm(17,i)
1974 nml=fxbipm(4,i)
1975 nels=fxbipm(21,i)
1976 nelc=fxbipm(22,i)
1977 nelt=fxbipm(34,i)
1978 nelp=fxbipm(35,i)
1979 neltg=fxbipm(23,i)
1980 lvsig=nels*7+nelc*10+nelt*2+nelp*8+neltg*10
1981 ifile=fxbipm(29,i)
1982 IF (ifile == 0) THEN
1983 amod=amod+nme*nbno*6
1984 ELSEIF (ifile == 1) THEN
1985 amod=amod+nme*fxbipm(18,i)*6
1986 ENDIF
1987 fxbipm(31,i)=ircs
1988 CALL fxbsini(
1989 . fxbelm(alm) , fxbsig(asig), nels, nelc, neltg,
1990 . x , iparg , pm , fxbmod(amod), nml ,
1991 . nbno , ixs , ixc , ixtg , geo ,
1992 . fxbrpm(arpm), i , fxbipm(29,i), lvsig ,fxbipm(18,i),
1993 . nme , ircs, fxbipm(30,i), nelt, nelp ,
1994 . ixt , ixp ,ibeam_vector,rbeam_vector)
1995C
1996 fxbipm(33,i)=ircs
1997 adrrpm=fxbipm(14,i)
1998 fxbrpm(adrrpm+10)=zero
1999 fxbrpm(adrrpm+11)=zero
2000C
2001C Animation output of flexible body local modes
2002 IF (fxbipm(36,i) == 1) THEN
2003 fxbid=fxbipm(1,i)
2004 anod=fxbipm(6,i)
2005 ifile=fxbipm(29,i)
2006 ircm=fxbipm(30,i)
2007 ircs=fxbipm(31,i)
2008 nsni=fxbipm(18,i)
2009 nsn=fxbipm(3,i)
2010 ircm=ircm+(nsn-nsni)*fxbipm(17,i)
2011 imin=fxbipm(37,i)
2012 imax=fxbipm(38,i)
2013C
2014 DO j=1,fxbipm(4,i)
2015 DO k=1,3*numnod
2016 mdepl_tmp(k)=zero
2017 ENDDO
2018 DO k=1,lbufel
2019 mbufel_tmp(k)=elbuf(k)
2020 ENDDO
2021C
2022 CALL moddepl(
2023 . fxbnod(anod), fxbmod(amod), mdepl_tmp , ifile, ircm,
2024 . nsni, nsn, amod )
2025C
2026 CALL modbufel(
2027 . fxbelm(alm), fxbsig(asig), mbufel_tmp, nels, nelc,
2028 . nelt, nelp, neltg, fxbrpm(arpm), lbufel,
2029 . asig , ifile, ircs , lvsig )
2030C
2031 IF (j>=imin.AND.j<=imax) THEN
2032 nmani=nmani+1
2033 fxani(1,nmani)=fxbid
2034 fxani(2,nmani)=j
2035 DO k=1,3*numnod
2036 mdepl(k,nmani)=mdepl_tmp(k)
2037 ENDDO
2038 DO k=1,lbufel
2039 mbufel(k,nmani)=mbufel_tmp(k)
2040 ENDDO
2041 ENDIF
2042 ENDDO
2043 ENDIF
2044 ENDDO
2045C
2046 DEALLOCATE(mbufel_tmp, mdepl_tmp)
2047 ENDIF ! end flexible bodies
2048C-----------------------------------------------------
2049C Initialization and check of rigid bodies type /RBE2 :
2050C-----------------------------------------------------
2051 CALL inirbe2(irbe2 ,lrbe2 ,itab ,x ,ms ,
2052 . in ,stifn ,stifr ,totmas,xg ,
2053 . yg ,zg ,b1 ,b2 ,b3 ,
2054 . b5 ,b6 ,b9 ,
2055 . nom_opt(1,ptr_nopt_rbe2+1),itagnd)
2056C------------------------------------------------------
2057C Initialization of joint type spring (PID33 and PID45)
2058C------------------------------------------------------
2059 flag_kj = 0
2060 DO ng=1,ngroup
2061 nel = iparg(2,ng)
2062 ity = iparg(5,ng)
2063 nft = iparg(3,ng)
2064 iad = iparg(4,ng)
2065 lft = 1
2066 llt = nel
2067 IF (ity == 6) THEN
2068 iprop=ixr(1,1+nft)
2069 igtyp = nint(geo(npropg*(iprop-1)+12))
2070 gbuf => elbuf_tab(ng)%GBUF
2071 IF (igtyp==33) THEN
2072 nuvar = nint(geo(npropg*(iprop-1)+25))
2073 CALL rini33_rb(nel,nuvar,iprop,ixr,npby,
2074 . lpby,rby,stifr,gbuf%VAR,itab,
2075 . igeo(1,iprop),ixr_kj,gbuf%MASS)
2076 ELSEIF (igtyp==45) THEN
2077 IF (flag_kj==0) WRITE(iout,1500)
2078 flag_kj = 1
2079 nuvar = nint(geo(npropg*(iprop-1)+25))
2080 CALL rini45_rb(nel,nuvar,iprop,ixr,npby,
2081 . lpby,rby,stifr,gbuf%VAR,itab,
2082 . igeo(1,iprop),ixr_kj,gbuf%MASS,ms,in)
2083 ENDIF
2084 ENDIF
2085 ENDDO
2086C------------------------------------------------------
2087C Initialization of joint type spring (PID33 and PID45)
2088C------------------------------------------------------
2089 IF (ndamp_freq_range > 0) THEN
2090 call damping_range_init(ndamp,nrdamp,dampr,ngroup,nparg,iparg,elbuf_tab)
2091 ENDIF
2092C
2093C----------------------------------------------------------------
2094 IF(ipri>=2) THEN
2095 WRITE(iout,1000)
2096 WRITE(iout,'(5(I10,1X,1PG20.13))') (itab(i),ms(i),i=1,numnod)
2097 IF (glob_therm%ITHERM_FE > 0) THEN
2098 WRITE(iout,1600)
2099 WRITE(iout,'(5(I10,1X,1PG20.13))') (itab(i),temp(i),i=1,numnod)
2100 WRITE(iout,1700)
2101 WRITE(iout,'(5(I10,1X,1PG20.13))') (itab(i),mcp(i),i=1,numnod)
2102 ENDIF
2103 ENDIF
2104C-------------------------------------
2105C Mass and Inertia by parts
2106C-------------------------------------
2107 CALL outpart(partsav,ipart,npart)
2108C-------------------------------------
2109C INFO supp in PROP&MAT / PARTS
2110C-------------------------------------
2111 CALL outpart5(group_param_tab,ipart,ipart(i15a),iparg,igeo,geo ,pm )
2112C-------------------------------------
2113C Mass and inertia parallel arithmetic
2114C-------------------------------------
2115 IF(ipari0 == 3)THEN
2116 DO n=1,numnod
2117 ms(n) = ms(n) +
2118 . i8mi(1,n) + r8_deuxm43 * (
2119 . i8mi(2,n) + r8_deuxm43 * i8mi(3,n))
2120 ENDDO
2121 IF(iroddl/=0)THEN
2122 DO n=1,numnod
2123 in(n) = in(n) +
2124 . i8mi(4,n) + r8_deuxm43 * (
2125 . i8mi(5,n) + r8_deuxm43 * i8mi(6,n))
2126 ENDDO
2127 ENDIF
2128 ENDIF
2129C-------------------------------------
2130C Total mass and total inertia
2131C-------------------------------------
2132 IF (ns10e >0) THEN
2133 DO n=1,numnod
2134 IF (itagnd(n)/=0) cycle
2135 nn3=3*n
2136 nn2=nn3-1
2137 nn1=nn2-1
2138 totmas=totmas+ms(n)
2139 xg=xg+ms(n)*x(nn1)
2140 yg=yg+ms(n)*x(nn2)
2141 zg=zg+ms(n)*x(nn3)
2142c
2143 xx=(x(nn1))**2
2144 yy=(x(nn2))**2
2145 zz=(x(nn3))**2
2146 xy=(x(nn1))*(x(nn2))
2147 xz=(x(nn1))*(x(nn3))
2148 yz=(x(nn2))*(x(nn3))
2149C
2150 b1=b1+(yy+zz)*ms(n)
2151 b5=b5+(xx+zz)*ms(n)
2152 b9=b9+(xx+yy)*ms(n)
2153 b2=b2-xy*ms(n)
2154 b6=b6-yz*ms(n)
2155 b3=b3-xz*ms(n)
2156 ENDDO
2157 ELSE
2158 DO n=1,numnod
2159 nn3=3*n
2160 nn2=nn3-1
2161 nn1=nn2-1
2162 totmas=totmas+ms(n)
2163 xg=xg+ms(n)*x(nn1)
2164 yg=yg+ms(n)*x(nn2)
2165 zg=zg+ms(n)*x(nn3)
2166c
2167 xx=(x(nn1))**2
2168 yy=(x(nn2))**2
2169 zz=(x(nn3))**2
2170 xy=(x(nn1))*(x(nn2))
2171 xz=(x(nn1))*(x(nn3))
2172 yz=(x(nn2))*(x(nn3))
2173C
2174 b1=b1+(yy+zz)*ms(n)
2175 b5=b5+(xx+zz)*ms(n)
2176 b9=b9+(xx+yy)*ms(n)
2177 b2=b2-xy*ms(n)
2178 b6=b6-yz*ms(n)
2179 b3=b3-xz*ms(n)
2180 ENDDO
2181 END IF
2182C
2183 IF(iroddl/=0)THEN
2184 DO n=1,numnod
2185 b1=b1+in(n)
2186 b5=b5+in(n)
2187 b9=b9+in(n)
2188 ENDDO
2189 ENDIF
2190C----- substraction of middle node S10+Itet=2
2191 xg=xg/max(totmas,em20)
2192 yg=yg/max(totmas,em20)
2193 zg=zg/max(totmas,em20)
2194 WRITE(iout,1100)
2195 WRITE(iout,'(5X,1PG20.13,3(1X,G20.13))')
2196 . totmas,xg,yg,zg
2197C
2198 xx=xg**2
2199 yy=yg**2
2200 zz=zg**2
2201 xy=xg*yg
2202 xz=xg*zg
2203 yz=yg*zg
2204C
2205 b1=b1-(yy+zz)*totmas
2206 b5=b5-(xx+zz)*totmas
2207 b9=b9-(xx+yy)*totmas
2208 b2=b2+xy*totmas
2209 b6=b6+yz*totmas
2210 b3=b3+xz*totmas
2211 WRITE(iout,1200)
2212 WRITE(iout,'(4X,3(1X,1PG20.13),3(1X,G20.13))')
2213 . b1,b5,b9,b2,b6,b3
2214C
2215C Print out the total additional nonstructural nodal mass
2216C
2217 WRITE(iout,'(//)')
2218 WRITE(iout,1300)
2219 WRITE(iout,1400) totaddmas
2220C
2221C-----------------------------------------------------------------------------------
2222C Initialization of non-local variable regularization structure for damage models
2223C-----------------------------------------------------------------------------------
2224 CALL nloc_dmg_init(elbuf_tab,nloc_dmg ,iparg ,ixc ,
2225 . ixs ,ixtg ,ele_area ,dtelem ,
2226 . numel ,ipm ,x ,xrefs ,
2227 . xrefc ,xreftg ,mat_param)
2228c
2229c-----------------------------------------------------------------------------------
2230
2231 IF (glob_therm%ITHERM_FE > 0 ) THEN
2232 DEALLOCATE(mcps,mcpp)
2233 IF(numels10 > 0.OR.numels16 > 0 .OR.numels20 > 0)
2234 . DEALLOCATE(mcpsx)
2235 ENDIF
2236C
2237 DEALLOCATE (partsav)
2238
2239 DEALLOCATE(ms_layerc,zi_layerc,msz2c,zply)
2240 DEALLOCATE (partsav1_pon)
2241C
2242 DEALLOCATE(connec,irig_node)
2243 IF(ALLOCATED(part_area))DEALLOCATE(part_area)
2244 DEALLOCATE(i8mi)
2245 IF(ALLOCATED(vpreload)) DEALLOCATE (vpreload)
2246 IF(ALLOCATED(ele_area))DEALLOCATE(ele_area)
2247c-----------
2248 RETURN
2249c-----------
2250 1000 FORMAT(//
2251 . 5x,'NODAL MASSES',/
2252 . 5x,'------------',/
2253 . 5x,' NODE MASS',22x,'NODE MASS',22x,'NODE MASS',22x,'NODE MASS',
2254 .22x,'NODE MASS'/)
2255 1100 FORMAT(//
2256 . 5x,'TOTAL MASS AND MASS CENTER',/
2257 . 5x,'--------------------------',/
2258 . 5X,' mass',20X,'x',20X,'y',20X,'z'/)
2259 1200 FORMAT(//
2260 . 5X,'total inertia',/
2261 . 5X,'-------------',/
2262 .22X,'ixx',18X,'iyy',18X,'izz',18X,'ixy',18X,'iyz',18X,'izx')
2263 1300 FORMAT(
2264 . 5X,' added nodal non-structural masses ' /
2265 . 5X,'-----------------------------------' /)
2266 1400 FORMAT(5X,' total added mass = ',1PG20.13//)
2267 1500 FORMAT(//
2268 . 5X,'kjoint2 spring definition',/
2269 . 5X,'------------------------'/)
2270 1600 FORMAT(//
2271 . 5X,'initial nodal temperatures',/
2272 . 5X,'--------------------------',/
2273 . 6X,5('node temperature',15X),'node temperature'/)
2274 1700 FORMAT(//
2275 . 5X,'initial nodal mcp ',/
2276 . 5X,'--------------------------',/
2277 . 6X,5('node mcp ',15X),'node mcp '/)
2278 RETURN
2279 END
2280C
2281!||====================================================================
2282!|| chekmp2 ../starter/source/elements/initia/initia.F
2283!||--- called by ------------------------------------------------------
2284!|| initia ../starter/source/elements/initia/initia.F
2285!||--- calls -----------------------------------------------------
2286!|| ancmsg ../starter/source/output/message/message.F
2287!|| fretitl2 ../starter/source/starter/freform.F
2288!||--- uses -----------------------------------------------------
2289!|| message_mod ../starter/share/message_module/message_mod.F
2290!||====================================================================
2291 SUBROUTINE CHEKMP2(NUMEL ,IPART ,IPARTEL ,IX ,NIX ,
2292 1 NE ,EMAT ,EPID ,IPM ,IGEO ,
2293 2 ELEM )
2294C-----------------------------------------------
2295C M o d u l e s
2296C-----------------------------------------------
2297 USE MESSAGE_MOD
2298 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
2299C-----------------------------------------------
2300C I m p l i c i t T y p e s
2301C-----------------------------------------------
2302#include "implicit_f.inc"
2303C-----------------------------------------------
2304C C o m m o n B l o c k s
2305C-----------------------------------------------
2306#include "param_c.inc"
2307#include "scr17_c.inc"
2308C-----------------------------------------------
2309C D u m m y A r g u m e n t s
2310C-----------------------------------------------
2311 INTEGER NUMEL,NIX,NE
2312 INTEGER IPART(LIPART1,*),IPARTEL(*),IX(NIX,*),EMAT(0:*),EPID(0:*),
2313 . IGEO(NPROPGI,*), IPM(NPROPMI,*)
2314C REAL
2315c my_real
2316c . PM(NPROPM,*)
2317 CHARACTER *(*) ELEM
2318 CHARACTER(LEN=NCHARTITLE)::TITR2
2319C-----------------------------------------------
2320C L o c a l V a r i a b l e s
2321C-----------------------------------------------
2322 INTEGER I, MT, IG, IPRT
2323C
2324 IF(ELEM == 'spring')THEN
2325 DO I=1,NUMEL
2326 IPRT=IPARTEL(I)
2327 IG =IPART(2,IPRT)
2328 IF(IG<=0)THEN
2329C
2330C WRITE(IOUT,*)' **ERROR INVALID PROPERTY NUMBER',IG
2331C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2332 CALL ANCMSG(MSGID=59, MSGTYPE=MSGERROR,ANMODE=ANINFO_BLIND_2,
2333 . I1=IG,
2334 . C1=ELEM,
2335 . I2=IX(NE,I),
2336 . PRMOD=MSG_CUMU)
2337 ELSEIF(EPID(IGEO(11,IG)) == 0)THEN
2338C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2339C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2340 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2341 CALL ANCMSG(MSGID=60,
2342 . MSGTYPE=MSGERROR,
2343 . ANMODE=ANINFO_BLIND_2,
2344 . I1=IGEO(1,IG),
2345 . C1=ELEM,
2346 . I2=IGEO(11,IG),
2347 . I3=IX(NE,I),
2348 . PRMOD=MSG_CUMU)
2349 ENDIF
2350 ENDDO
2351 CALL ANCMSG(MSGID=59,
2352 . MSGTYPE=MSGERROR,
2353 . ANMODE=ANINFO_BLIND_2,
2354 . C1=ELEM,
2355 . PRMOD=MSG_PRINT)
2356 CALL ANCMSG(MSGID=60,
2357 . MSGTYPE=MSGERROR,
2358 . ANMODE=ANINFO_BLIND_2,
2359 . C1=ELEM,
2360 . PRMOD=MSG_PRINT)
2361
2362 ELSEIF(ELEM == 'brick.OR.'ELEM == 'quad')THEN
2363 DO I=1,NUMEL
2364 IPRT=IPARTEL(I)
2365 MT =IPART(1,IPRT)
2366 IG =IPART(2,IPRT)
2367 IF(MT<=0)THEN
2368C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2369C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2370 CALL ANCMSG(MSGID=61,
2371 . MSGTYPE=MSGERROR,
2372 . ANMODE=ANINFO_BLIND_2,
2373 . I1=MT,
2374 . C1=ELEM,
2375 . I2=IX(NE,I),
2376 . PRMOD=MSG_CUMU)
2377 ENDIF
2378 IF (IG<=0) THEN
2379 CALL ANCMSG(MSGID=59,
2380 . MSGTYPE=MSGERROR,
2381 . ANMODE=ANINFO_BLIND_2,
2382 . I1=IG,
2383 . C1=ELEM,
2384 . I2=IX(NE,I),
2385 . PRMOD=MSG_CUMU)
2386.AND. ELSEIF(IG/=0EPID(IGEO(11,IG)) == 0)THEN
2387 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2388 CALL ANCMSG(MSGID=60,
2389 . MSGTYPE=MSGERROR,
2390 . ANMODE=ANINFO_BLIND_2,
2391 . I1=IGEO(1,IG),
2392 . C1=ELEM,
2393 . I2=IGEO(11,IG),
2394 . I3=IX(NE,I),
2395 . PRMOD=MSG_CUMU)
2396 ENDIF
2397 ENDDO
2398 CALL ANCMSG(MSGID=59,
2399 . MSGTYPE=MSGERROR,
2400 . ANMODE=ANINFO_BLIND_2,
2401 . C1=ELEM,
2402 . PRMOD=MSG_PRINT)
2403 CALL ANCMSG(MSGID=60,
2404 . MSGTYPE=MSGERROR,
2405 . ANMODE=ANINFO_BLIND_2,
2406 . C1=ELEM,
2407 . PRMOD=MSG_PRINT)
2408 CALL ANCMSG(MSGID=61,
2409 . MSGTYPE=MSGERROR,
2410 . ANMODE=ANINFO_BLIND_2,
2411 . C1=ELEM,
2412 . PRMOD=MSG_PRINT)
2413C
2414 ELSEIF(ELEM == 'sphcel')THEN
2415 DO I=1,NUMEL
2416 IPRT=IPARTEL(I)
2417 MT =IPART(1,IPRT)
2418 IG =IPART(2,IPRT)
2419 IF(MT<=0)THEN
2420C IERR = IERR + 1
2421C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2422C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2423 CALL ANCMSG(MSGID=61,
2424 . MSGTYPE=MSGERROR,
2425 . ANMODE=ANINFO_BLIND_2,
2426 . I1=MT,
2427 . C1=ELEM,
2428 . I2=IX(NE,I),
2429 . PRMOD=MSG_CUMU)
2430 ENDIF
2431.AND. IF(IG/=0EPID(IGEO(11,IG)) == 0)THEN
2432C IERR = IERR + 1
2433C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2434C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2435 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2436 CALL ANCMSG(MSGID=60,
2437 . MSGTYPE=MSGERROR,
2438 . ANMODE=ANINFO_BLIND_2,
2439 . I1=IGEO(1,IG),
2440 . C1=ELEM,
2441 . I2=IGEO(11,IG),
2442 . I3=IX(NE,I),
2443 . PRMOD=MSG_CUMU)
2444 ENDIF
2445 ENDDO
2446 CALL ANCMSG(MSGID=60,
2447 . MSGTYPE=MSGERROR,
2448 . ANMODE=ANINFO_BLIND_2,
2449 . C1=ELEM,
2450 . PRMOD=MSG_PRINT)
2451 CALL ANCMSG(MSGID=61,
2452 . MSGTYPE=MSGERROR,
2453 . ANMODE=ANINFO_BLIND_2,
2454 . C1=ELEM,
2455 . PRMOD=MSG_PRINT)
2456 ELSE
2457 DO I=1,NUMEL
2458 IPRT=IPARTEL(I)
2459 MT =IPART(1,IPRT)
2460 IG =IPART(2,IPRT)
2461 IF(MT<=0)THEN
2462C
2463C WRITE(IOUT,*)' **ERROR INVALID MATERIAL NUMBER',MT
2464C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2465 CALL ANCMSG(MSGID=61,
2466 . MSGTYPE=MSGERROR,
2467 . ANMODE=ANINFO_BLIND_2,
2468 . I1=MT,
2469 . C1=ELEM,
2470 . I2=IX(NE,I),
2471 . PRMOD=MSG_CUMU)
2472 ENDIF
2473 IF(IG<=0)THEN
2474C
2475C WRITE(IOUT,*)' **ERROR INVALID PROPERTY NUMBER',IG
2476C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2477 CALL ANCMSG(MSGID=59,
2478 . MSGTYPE=MSGERROR,
2479 . ANMODE=ANINFO_BLIND_2,
2480 . I1=IG,
2481 . C1=ELEM,
2482 . I2=IX(NE,I),
2483 . PRMOD=MSG_CUMU)
2484 ELSEIF(EPID(IGEO(11,IG)) == 0)THEN
2485C
2486C WRITE(IOUT,*)' **ERROR INVALID PROPERTY TYPE',IGEO(11,IG)
2487C WRITE(IOUT,*)' FOR ',ELEM,IX(NE,I)
2488 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2489 CALL ANCMSG(MSGID=60,
2490 . MSGTYPE=MSGERROR,
2491 . ANMODE=ANINFO_BLIND_2,
2492 . I1=IGEO(1,IG),
2493 . C1=ELEM,
2494 . I2=IGEO(11,IG),
2495 . I3=IX(NE,I),
2496 . PRMOD=MSG_CUMU)
2497 ENDIF
2498 ENDDO
2499 CALL ANCMSG(MSGID=59,
2500 . MSGTYPE=MSGERROR,
2501 . ANMODE=ANINFO_BLIND_2,
2502 . C1=ELEM,
2503 . PRMOD=MSG_PRINT)
2504 CALL ANCMSG(MSGID=60,
2505 . MSGTYPE=MSGERROR,
2506 . ANMODE=ANINFO_BLIND_2,
2507 . C1=ELEM,
2508 . PRMOD=MSG_PRINT)
2509 CALL ANCMSG(MSGID=61,
2510 . MSGTYPE=MSGERROR,
2511 . ANMODE=ANINFO_BLIND_2,
2512 . C1=ELEM,
2513 . PRMOD=MSG_PRINT)
2514 ENDIF
2515C
2516 RETURN
2517 END
2518C
2519!||====================================================================
2520!|| checkmp ../starter/source/elements/initia/initia.F
2521!||--- called by ------------------------------------------------------
2522!|| initia ../starter/source/elements/initia/initia.F
2523!||--- calls -----------------------------------------------------
2524!|| ancmsg ../starter/source/output/message/message.F
2525!|| fretitl2 ../starter/source/starter/freform.F
2526!||--- uses -----------------------------------------------------
2527!|| message_mod ../starter/share/message_module/message_mod.F
2528!||====================================================================
2529 SUBROUTINE CHECKMP(NUMEL,IX,NIX,NG,NE,EMAT,EPID,IPM,IGEO,ELEM,IPARTEL)
2530C-----------------------------------------------
2531C M o d u l e s
2532C-----------------------------------------------
2533 USE MESSAGE_MOD
2534 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
2535C-----------------------------------------------
2536C I m p l i c i t T y p e s
2537C-----------------------------------------------
2538#include "implicit_f.inc"
2539C-----------------------------------------------
2540C C o m m o n B l o c k s
2541C-----------------------------------------------
2542#include "param_c.inc"
2543#include "scr17_c.inc"
2544#include "com01_c.inc"
2545C-----------------------------------------------
2546C D u m m y A r g u m e n t s
2547C-----------------------------------------------
2548 INTEGER NUMEL,NIX,NG,NE,CPT
2549 INTEGER IX(NIX,*),EMAT(0:*),EPID(0:*), IGEO(NPROPGI,*),IPM(NPROPMI,*),IPARTEL(*)
2550 CHARACTER *(*) ELEM
2551C-----------------------------------------------
2552C L o c a l V a r i a b l e s
2553C-----------------------------------------------
2554 INTEGER I, MT, IG
2555 CHARACTER(LEN=NCHARTITLE)::TITR,TITR2
2556C-----------------------------------------------
2557C P r e - C o n d i t i o n s
2558C-----------------------------------------------
2559 IF(ELEM=='shell3n.AND.' N2D>0)RETURN
2560 IF(ELEM=='tria.AND.' N2D==0)RETURN
2561C-----------------------------------------------
2562C S o u r c e L i n e s
2563C-----------------------------------------------
2564 IF(ELEM == 'spring')THEN
2565 DO I=1,NUMEL
2566 IG=IX(NG,I)
2567 IF(IG<=0)THEN
2568 CALL ANCMSG(MSGID=59,
2569 . MSGTYPE=MSGERROR,
2570 . ANMODE=ANINFO_BLIND_2,
2571 . I1=IG,
2572 . C1=ELEM,
2573 . I2=IX(NE,I),
2574 . PRMOD=MSG_CUMU)
2575 ELSEIF(EPID(IGEO(11,IG)) == 0)THEN
2576 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2577 CALL ANCMSG(MSGID=60,
2578 . MSGTYPE=MSGERROR,
2579 . ANMODE=ANINFO_BLIND_2,
2580 . I1=IGEO(1,IG),
2581 . C1=ELEM,
2582 . I2=IGEO(11,IG),
2583 . I3=IX(NE,I),
2584 . PRMOD=MSG_CUMU)
2585 ENDIF
2586 ENDDO
2587 CALL ANCMSG(MSGID=59,
2588 . MSGTYPE=MSGERROR,
2589 . ANMODE=ANINFO_BLIND_2,
2590 . C1=ELEM,
2591 . PRMOD=MSG_PRINT)
2592 CALL ANCMSG(MSGID=60,
2593 . MSGTYPE=MSGERROR,
2594 . ANMODE=ANINFO_BLIND_2,
2595 . C1=ELEM,
2596 . PRMOD=MSG_PRINT)
2597 ELSEIF(ELEM == 'brick.OR.'ELEM == 'quad.OR.'ELEM == 'tria')THEN
2598 DO I=1,NUMEL
2599 MT=IX(1,I)
2600 IG=IX(NG,I)
2601 IF(MT<=0)THEN
2602 CALL ANCMSG(MSGID=61,
2603 . MSGTYPE=MSGERROR,
2604 . ANMODE=ANINFO,
2605 . I1=MT,
2606 . C1=ELEM,
2607 . I2=IX(NE,I),
2608 . PRMOD=MSG_CUMU)
2609 ENDIF
2610 IF (IG<=0) THEN
2611 CALL ANCMSG(MSGID=59,
2612 . MSGTYPE=MSGERROR,
2613 . ANMODE=ANINFO_BLIND_2,
2614 . I1=IG,
2615 . C1=ELEM,
2616 . I2=IX(NE,I),
2617 . PRMOD=MSG_CUMU)
2618 ELSEIF(IG/=0) THEN
2619 IF (EPID(IGEO(11,IG)) == 0)THEN
2620 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2621 CALL ANCMSG(MSGID=60,
2622 . MSGTYPE=MSGERROR,
2623 . ANMODE=ANINFO_BLIND_2,
2624 . I1=IGEO(1,IG),
2625 . C1=ELEM,
2626 . I2=IGEO(11,IG),
2627 . I3=IX(NE,I),
2628 . PRMOD=MSG_CUMU)
2629 ENDIF
2630 ENDIF
2631 ENDDO
2632 CALL ANCMSG(MSGID=59,
2633 . MSGTYPE=MSGERROR,
2634 . ANMODE=ANINFO_BLIND_2,
2635 . C1=ELEM,
2636 . PRMOD=MSG_PRINT)
2637 CALL ANCMSG(MSGID=60,
2638 . MSGTYPE=MSGERROR,
2639 . ANMODE=ANINFO_BLIND_2,
2640 . C1=ELEM,
2641 . PRMOD=MSG_PRINT)
2642 CALL ANCMSG(MSGID=61,
2643 . MSGTYPE=MSGERROR,
2644 . ANMODE=ANINFO_BLIND_2,
2645 . C1=ELEM,
2646 . PRMOD=MSG_PRINT)
2647
2648 ELSEIF(ELEM == 'sphcel')THEN
2649 DO I=1,NUMEL
2650 MT=IX(1,I)
2651 IG=IX(NG,I)
2652 IF(MT<=0)THEN
2653 CALL ANCMSG(MSGID=61,
2654 . MSGTYPE=MSGERROR,
2655 . ANMODE=ANINFO,
2656 . I1=MT,
2657 . C1=ELEM,
2658 . I2=IX(NE,I),
2659 . PRMOD=MSG_CUMU)
2660 ENDIF
2661.AND. IF(IG/=0EPID(IGEO(11,IG)) == 0)THEN
2662 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2663 CALL ANCMSG(MSGID=60,
2664 . MSGTYPE=MSGERROR,
2665 . ANMODE=ANINFO_BLIND_2,
2666 . I1=IGEO(1,IG),
2667 . C1=ELEM,
2668 . I2=IGEO(11,IG),
2669 . I3=IX(NE,I),
2670 . PRMOD=MSG_CUMU)
2671 ENDIF
2672 ENDDO
2673 CALL ANCMSG(MSGID=60,
2674 . MSGTYPE=MSGERROR,
2675 . ANMODE=ANINFO_BLIND_2,
2676 . C1=ELEM,
2677 . PRMOD=MSG_PRINT)
2678 CALL ANCMSG(MSGID=61,
2679 . MSGTYPE=MSGERROR,
2680 . ANMODE=ANINFO_BLIND_2,
2681 . C1=ELEM,
2682 . PRMOD=MSG_PRINT)
2683 ELSEIF(ELEM == 'beam')THEN
2684 DO I=1,NUMEL
2685 MT=IX(1,I)
2686 IG=IX(NG,I)
2687c IGTYP=IGEO(11,IG)
2688 IF(MT<=0)THEN
2689 CALL ANCMSG(MSGID=61,
2690 . MSGTYPE=MSGERROR,
2691 . ANMODE=ANINFO,
2692 . I1=MT,
2693 . C1=ELEM,
2694 . I2=IX(NE,I),
2695 . PRMOD=MSG_CUMU)
2696 ENDIF
2697 IF(IG<=0)THEN
2698 CALL ANCMSG(MSGID=59,
2699 . MSGTYPE=MSGERROR,
2700 . ANMODE=ANINFO_BLIND_2,
2701 . I1=IG,
2702 . C1=ELEM,
2703 . I2=IX(NE,I),
2704 . PRMOD=MSG_CUMU)
2705 ELSEIF(EPID(IGEO(11,IG)) == 0)THEN
2706 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2707 CALL ANCMSG(MSGID=60,
2708 . MSGTYPE=MSGERROR,
2709 . ANMODE=ANINFO_BLIND_2,
2710 . I1=IGEO(1,IG),
2711 . C1=ELEM,
2712 . I2=IGEO(11,IG),
2713 . I3=IX(NE,I),
2714 . PRMOD=MSG_CUMU)
2715 ENDIF
2716
2717.AND..OR. IF((IGEO(11,IG) == 3IPM(2,MT) == 36)
2718.AND. . (IGEO(11,IG) == 18IPM(2,MT) == 1)) THEN
2719 CALL FRETITL2(TITR,
2720 . IGEO(NPROPGI-LTITR+1,IG),LTITR)
2721 CALL ANCMSG(MSGID=745,
2722 . MSGTYPE=MSGERROR,
2723 . ANMODE=ANINFO_BLIND_2,
2724 . I1=IX(NE,I),
2725 . C1=TITR,
2726 . I2=IGEO(1,IG),
2727 . I3=IPM(2,MT))
2728 ENDIF
2729 ENDDO
2730 CALL ANCMSG(MSGID=59,
2731 . MSGTYPE=MSGERROR,
2732 . ANMODE=ANINFO_BLIND_2,
2733 . C1=ELEM,
2734 . PRMOD=MSG_PRINT)
2735 CALL ANCMSG(MSGID=60,
2736 . MSGTYPE=MSGERROR,
2737 . ANMODE=ANINFO_BLIND_2,
2738 . C1=ELEM,
2739 . PRMOD=MSG_PRINT)
2740 CALL ANCMSG(MSGID=61,
2741 . MSGTYPE=MSGERROR,
2742 . ANMODE=ANINFO_BLIND_2,
2743 . C1=ELEM,
2744 . PRMOD=MSG_PRINT)
2745 ELSE
2746 DO I=1,NUMEL
2747 MT=IX(1,I)
2748 IG=IX(NG,I)
2749
2750 IF(IPARTEL(I) == 0)THEN
2751 CALL ANCMSG(MSGID=1125,
2752 . MSGTYPE=MSGERROR,
2753 . ANMODE=ANINFO_BLIND,
2754 . C1=ELEM,
2755 . I1=IX(NE,I),
2756 . PRMOD=MSG_CUMU)
2757 ELSEIF(MT<=0)THEN
2758 CALL ANCMSG(MSGID=61,
2759 . MSGTYPE=MSGERROR,
2760 . ANMODE=ANINFO,
2761 . I1=MT,
2762 . C1=ELEM,
2763 . I2=IX(NE,I),
2764 . PRMOD=MSG_CUMU)
2765 ENDIF
2766 IF(IPARTEL(I) == 0)THEN
2767 CONTINUE
2768 ELSEIF(IG<=0)THEN
2769 CALL ANCMSG(MSGID=59,
2770 . MSGTYPE=MSGERROR,
2771 . ANMODE=ANINFO_BLIND_2,
2772 . I1=IG,
2773 . C1=ELEM,
2774 . I2=IX(NE,I),
2775 . PRMOD=MSG_CUMU)
2776 ELSEIF(EPID(IGEO(11,IG)) == 0)THEN
2777 CALL FRETITL2(TITR2,IGEO(NPROPGI-LTITR+1,IG),LTITR)
2778 CALL ANCMSG(MSGID=60,
2779 . MSGTYPE=MSGERROR,
2780 . ANMODE=ANINFO_BLIND_2,
2781 . I1=IGEO(1,IG),
2782 . C1=ELEM,
2783 . I2=IGEO(11,IG),
2784 . I3=IX(NE,I),
2785 . PRMOD=MSG_CUMU)
2786 ENDIF
2787.AND..AND. IF((IGEO(11,IG) == 9)(IPM(2,MT) == 25)
2788 . (IPM(10,MT) == 1)) THEN
2789 CALL ANCMSG(MSGID=561,
2790 . MSGTYPE=MSGERROR,
2791 . ANMODE=ANINFO_BLIND_2,
2792 . C1=ELEM,
2793 . I1=IX(NE,I))
2794 ENDIF
2795 ENDDO
2796 CALL ANCMSG(MSGID=59,
2797 . MSGTYPE=MSGERROR,
2798 . ANMODE=ANINFO_BLIND_2,
2799 . C1=ELEM,
2800 . PRMOD=MSG_PRINT)
2801 CALL ANCMSG(MSGID=60,
2802 . MSGTYPE=MSGERROR,
2803 . ANMODE=ANINFO_BLIND_2,
2804 . C1=ELEM,
2805 . PRMOD=MSG_PRINT)
2806 CALL ANCMSG(MSGID=61,
2807 . MSGTYPE=MSGERROR,
2808 . ANMODE=ANINFO_BLIND_2,
2809 . C1=ELEM,
2810 . PRMOD=MSG_PRINT)
2811 CALL ANCMSG(MSGID=1125,
2812 . MSGTYPE=MSGERROR,
2813 . ANMODE=ANINFO_BLIND,
2814 . C1=ELEM,
2815 . PRMOD=MSG_PRINT)
2816 ENDIF
2817C
2818 RETURN
2819 END
2820C
2821!||====================================================================
2822!|| outpart ../starter/source/elements/initia/initia.F
2823!||--- called by ------------------------------------------------------
2824!|| initia ../starter/source/elements/initia/initia.F
2825!||--- calls -----------------------------------------------------
2826!|| fretitl2 ../starter/source/starter/freform.F
2827!||--- uses -----------------------------------------------------
2828!||====================================================================
2829 SUBROUTINE OUTPART(PARTSAV,IPART,NPART)
2830C-----------------------------------------------
2831C M o d u l e s
2832C-----------------------------------------------
2833 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
2834C-----------------------------------------------
2835C I m p l i c i t T y p e s
2836C-----------------------------------------------
2837#include "implicit_f.inc"
2838C-----------------------------------------------
2839C C o m m o n B l o c k s
2840C-----------------------------------------------
2841#include "units_c.inc"
2842#include "scr17_c.inc"
2843C-----------------------------------------------
2844C D u m m y A r g u m e n t s
2845C-----------------------------------------------
2846 INTEGER NPART,IPART(LIPART1,*)
2847 my_real PARTSAV(20,*)
2848C-----------------------------------------------
2849C L o c a l V a r i a b l e s
2850C-----------------------------------------------
2851 INTEGER I,J
2852 my_real MAS,SM,XX,YY,ZZ,XY,YZ,ZX,XG,YG,ZG,IXX,IXY,IYY,IYZ,IZZ,IZX,EK,VX,VY,VZ
2853 CHARACTER(LEN=NCHARTITLE) :: TEXT
2854C======================================================================|
2855C
2856 WRITE(IOUT,'(//,a)')'part mass & inertia'
2857 WRITE(iout,'(A,/)') '-------------------'
2858C
2859 DO i=1,npart
2860 mas = partsav(1,i)
2861 sm = 1./max(mas,em20)
2862 xg = partsav(2,i) * sm
2863 yg = partsav(3,i) * sm
2864 zg = partsav(4,i) * sm
2865 xx = xg*xg
2866 xy = xg*yg
2867 yy = yg*yg
2868 yz = yg*zg
2869 zz = zg*zg
2870 zx = zg*xg
2871 ixx = partsav(5,i) - (yy+zz)*mas
2872 iyy = partsav(6,i) - (zz+xx)*mas
2873 izz = partsav(7,i) - (xx+yy)*mas
2874 ixy = partsav(8,i) + xy*mas
2875 iyz = partsav(9,i) + yz*mas
2876 izx = partsav(10,i)+ zx*mas
2877 vx = partsav(11,i) * sm
2878 vy = partsav(12,i) * sm
2879 vz = partsav(13,i) * sm
2880 ek = partsav(14,i)
2881 CALL fretitl2(text,ipart(lipart1-ltitr+1,i),ltitr)
2882 WRITE(iout,'(/,A,I10,A,A)')'PART : ',ipart(4,i),', ',trim(text)
2883C WRITE(IOUT,'(A)') '----'
2884 WRITE(iout,'(2A)')
2885 . ' Mass Ixx Iyy Izz',
2886 . ' Ixy Iyz Izx'
2887 WRITE(iout,'(1P7ES16.8)')mas,ixx,iyy,izz,ixy,iyz,izx
2888 WRITE(iout,'(2A)')
2889 . ' X Y Z Kin. Energy',
2890 . ' Vx Vy Vz'
2891 WRITE(iout,'(1P7ES16.8)')xg,yg,zg,ek,vx,vy,vz
2892 ENDDO
2893C
2894 RETURN
2895 END
2896!||====================================================================
2897!|| sgsavref ../starter/source/elements/initia/initia.F
2898!||--- called by ------------------------------------------------------
2899!|| initia ../starter/source/elements/initia/initia.F
2900!||====================================================================
2901 SUBROUTINE sgsavref(NPE,XREF,SAV,NEL)
2902C-----------------------------------------------
2903C I m p l i c i t T y p e s
2904C-----------------------------------------------
2905#include "implicit_f.inc"
2906C-----------------------------------------------
2907C G l o b a l P a r a m e t e r s
2908C-----------------------------------------------
2909#include "mvsiz_p.inc"
2910C-----------------------------------------------
2911C C o m m o n B l o c k s
2912C-----------------------------------------------
2913#include "vect01_c.inc"
2914C-----------------------------------------------
2915C D u m m y A r g u m e n t s
2916C-----------------------------------------------
2917 INTEGER NPE,NEL
2918C REAL
2919 my_real
2920 . xref(8,3,*)
2921 double precision
2922 . sav(nel,3*(npe-1))
2923C-----------------------------------------------
2924C L o c a l V a r i a b l e s
2925C-----------------------------------------------
2926 INTEGER I,NPE1,N
2927C REAL
2928 my_real
2929 . xl(mvsiz),yl(mvsiz),zl(mvsiz)
2930C-----------------------------------------------
2931 npe1=npe-1
2932C
2933 DO i=lft,llt
2934 xl(i)=xref(npe,1,i)
2935 yl(i)=xref(npe,2,i)
2936 zl(i)=xref(npe,3,i)
2937 ENDDO
2938 DO n=1,npe1
2939 DO i=lft,llt
2940 sav(i,n) = xref(n,1,i)-xl(i)
2941 sav(i,n+npe1) = xref(n,2,i)-yl(i)
2942 sav(i,n+2*npe1) = xref(n,3,i)-zl(i)
2943 ENDDO
2944 ENDDO
2945C
2946 RETURN
2947 END
2948!||====================================================================
2949!|| sgsavinieref ../starter/source/elements/initia/initia.F
2950!||--- called by ------------------------------------------------------
2951!|| initia ../starter/source/elements/initia/initia.F
2952!||====================================================================
2953 SUBROUTINE sgsavinieref(NPE,STRAGLOB,SIGSP,NSIGI,PTSOL,SAV,OFFG,NEL)
2954C-----------------------------------------------
2955C I m p l i c i t T y p e s
2956C-----------------------------------------------
2957#include "implicit_f.inc"
2958C-----------------------------------------------
2959C C o m m o n B l o c k s
2960C-----------------------------------------------
2961#include "vect01_c.inc"
2962#include "com01_c.inc"
2963C-----------------------------------------------
2964C D u m m y A r g u m e n t s
2965C-----------------------------------------------
2966 INTEGER NPE,NEL,STRAGLOB(*),PTSOL(*),NSIGI
2967C
2968C-------!!!!! uniforme SAV between Ismstr>=10 and Ismstr=1
2969 DOUBLE PRECISION
2970 . SAV(NEL,3*(NPE-1))
2971C
2972 my_real
2973 . SIGSP(NSIGI,*),OFFG(*)
2974C-----------------------------------------------
2975C L o c a l V a r i a b l e s
2976C-----------------------------------------------
2977 INTEGER I,NPE1,N,JJ,IIS,IIS0,N2
2978C
2979 double precision
2980 . xl(npe),yl(npe),zl(npe)
2981C-----------------------------------------------
2982 npe1=npe-1
2983C
2984 iis0= nusolid+4+nvsolid1 + nvsolid2 + nvsolid3 + nvsolid4 + nvsolid5
2985 DO i=lft,llt
2986 jj=ptsol(i)
2987 IF(straglob(i) == 10.AND.jj>0) THEN
2988 DO n=1,npe
2989 iis= iis0 + (n-1)*3
2990 xl(n)=sigsp(iis+1,jj)
2991 yl(n)=sigsp(iis+2,jj)
2992 zl(n)=sigsp(iis+3,jj)
2993 END DO
2994 IF (ismstr==1) THEN
2995 DO n=1,npe1
2996 n2 = 3*(n -1) +1
2997 sav(i,n2) = xl(n)-xl(npe)
2998 sav(i,n2+1) = yl(n)-yl(npe)
2999 sav(i,n2+2) = zl(n)-zl(npe)
3000 END DO
3001 offg(i) =two
3002 ELSE
3003 DO n=1,npe1
3004 sav(i,n) = xl(n)-xl(npe)
3005 sav(i,n+npe1) = yl(n)-yl(npe)
3006 sav(i,n+2*npe1) = zl(n)-zl(npe)
3007 END DO
3008 END IF
3009 ENDIF
3010 ENDDO
3011C
3012 RETURN
3013 END
3014!||====================================================================
3015!|| sgsavinierefq ../starter/source/elements/initia/initia.F
3016!||--- called by ------------------------------------------------------
3017!|| initia ../starter/source/elements/initia/initia.F
3018!||--- uses -----------------------------------------------------
3019!||====================================================================
3020 SUBROUTINE sgsavinierefq(NPE,STRAGLOB,SIGSP,NSIGI,PTSOL,SAV,OFFG,
3021 . IXS,DR,NDR,NEL)
3022 use element_mod , only : nixs
3023C-----------------------------------------------
3024C I m p l i c i t T y p e s
3025C-----------------------------------------------
3026#include "implicit_f.inc"
3027C-----------------------------------------------
3028C C o m m o n B l o c k s
3029C-----------------------------------------------
3030#include "vect01_c.inc"
3031#include "com01_c.inc"
3032#include "tabsiz_c.inc"
3033C-----------------------------------------------
3034C D u m m y A r g u m e n t s
3035C-----------------------------------------------
3036 INTEGER NPE,NEL,STRAGLOB(*),PTSOL(*),NSIGI,NDR
3037 INTEGER IXS(NIXS,NEL)
3038C REAL
3039C-------dim different for quadratic element(historic)
3040 double precision
3041 . sav(nel,3*npe)
3042C REAL
3043 my_real
3044 . sigsp(nsigi,*),offg(*),dr(sdr)
3045C-----------------------------------------------
3046C L o c a l V a r i a b l e s
3047C-----------------------------------------------
3048 INTEGER I,NPE1,N,JJ,IIS,IIS0,NN,NC(NEL,4)
3049C REAL
3050C-----------------------------------------------
3051 iis0= nusolid+4+nvsolid1 + nvsolid2 + nvsolid3 + nvsolid4 + nvsolid5
3052 IF (ndr>0) THEN
3053 DO i=1,nel
3054 nc(i,1) =ixs(2,i)
3055 nc(i,2) =ixs(4,i)
3056 nc(i,3) =ixs(7,i)
3057 nc(i,4) =ixs(6,i)
3058 END DO
3059 END IF
3060 DO i=lft,llt
3061 jj=ptsol(i)
3062 IF(straglob(i) == 10.AND.jj>0) THEN
3063 DO n=1,npe
3064 iis= iis0 + (n-1)*3
3065 sav(i,n) = sigsp(iis+1,jj)
3066 sav(i,n+npe) = sigsp(iis+2,jj)
3067 sav(i,n+2*npe) = sigsp(iis+3,jj)
3068 END DO
3069 DO n=1,ndr
3070 iis= iis0 +(npe+n-1)*3
3071 nn = 3*(nc(i,n)-1)
3072 dr(nn+1) = sigsp(iis+1,jj)
3073 dr(nn+2) = sigsp(iis+2,jj)
3074 dr(nn+3) = sigsp(iis+3,jj)
3075 END DO
3076 IF (ismstr==1) offg(i) =two
3077 ENDIF
3078 ENDDO
3079C
3080 RETURN
3081 END
3082!||====================================================================
3083!|| outpart5 ../starter/source/elements/initia/initia.F
3084!||--- called by ------------------------------------------------------
3085!|| initia ../starter/source/elements/initia/initia.F
3086!||--- calls -----------------------------------------------------
3087!|| fretitl2 ../starter/source/starter/freform.F
3088!||--- uses -----------------------------------------------------
3089!||====================================================================
3090 SUBROUTINE outpart5(GROUP_PARAM_TAB,IPART,IPARTS,IPARG,IGEO, GEO ,PM )
3091C-----------------------------------------------
3092C M o d u l e s
3093C-----------------------------------------------
3094 USE group_param_mod
3095 USE names_and_titles_mod , ONLY : nchartitle
3096C-----------------------------------------------
3097C I m p l i c i t T y p e s
3098C-----------------------------------------------
3099#include "implicit_f.inc"
3100C-----------------------------------------------
3101C C o m m o n B l o c k s
3102C-----------------------------------------------
3103#include "units_c.inc"
3104#include "scr17_c.inc"
3105#include "param_c.inc"
3106#include "com01_c.inc"
3107#include "com04_c.inc"
3108C-----------------------------------------------
3109C D u m m y A r g u m e n t s
3110C-----------------------------------------------
3111 INTEGER , DIMENSION(NUMELS), INTENT(IN) :: IPARTS
3112 INTEGER IPART(LIPART1,*),IPARG(NPARG,*),IGEO(NPROPGI,*)
3113 my_real
3114 . geo(npropg,*),pm(npropm,*)
3115 TYPE(group_param_) , DIMENSION(NGROUP) :: GROUP_PARAM_TAB
3116C-----------------------------------------------
3117C L o c a l V a r i a b l e s
3118C-----------------------------------------------
3119 INTEGER I,J,NG,IPID,IMID,MID,PID,ITY,IGTYP,ETY,N_NOD,ISOLNOD,
3120 . ihbe,ismstr,icpre,jcvt,iint,ihkt,itet4,itet10,imatvis,npt,nly,
3121 . icstr,idril,ithk,iplas,i2geo(numgeo),ng2,ng1,ng0,jg,etye,
3122 . ih4,ih3,igmat,i2geo1(numgeo),i2geo2(numgeo),ihbe0,
3123 . ip,nft,ip2ng1(npart),ip2ng2(npart),lst,icontrol,ipos
3124 my_real
3125 . mas,sm,xx,yy,zz,xy,yz,zx,xg,yg,zg,
3126 . ixx,ixy,iyy,iyz,izz,izx,ek,vx,vy,vz,hm,hr,hf,dn,qa,qb,qh,
3127 . ns_a,ns_b,dm,qf,qm,qr,df
3128 CHARACTER(LEN=NCHARTITLE) TEXT
3129 CHARACTER(LEN=23), DIMENSION(27) :: EL_TYP
3130 DATA el_typ / 'SOLID-HEXA ',
3131 . 'TETRA4 ',
3132 . 'TETRA10 ',
3133 . 'BRIC20 ',
3134 . 'ELEM-USER ',
3135 . 'SOLID-IGE ',
3136 . 'THICK-SHELL HEXA ' ,
3137 . 'THICK-SHELL PENTA ' ,
3138 . 'THICK-SHELL SHEL16' ,
3139 . 'THICK-SHELL BRIC20' ,
3140 . 'SHELL-4nodes ' ,
3141 . 'SHELL-3nodes ' ,
3142 . 'QUAD-2D ' ,
3143 . 'TRUSS ' ,
3144 . 'BEAM ' ,
3145 . 'SPRING ' ,
3146 . 'SPH ' ,
3147 . 'SHELL-(3nodes+4nodes)' ,
3148 . 'THICK-SHELL HEXA+PENTA ',
3149 . 'THICK-SHELL S16+S20 ' ,
3150 . 'SOLID-(HEXA+TETRA4)' ,
3151 . 'SOLID-(HEXA+TETRA10)' ,
3152 . 'TETRA4+TETRA10 ' ,
3153 . 'HEXA+TETRA4+TETRA10 ' ,
3154 . 'MULTI-STRAND ' ,
3155 . 'KJOINT ' ,
3156 . 'N/A ' /
3157C======================================================================|
3158c IPART(1,I)=IMID id sys
3159c IPART(2,I)=IPID id sys
3160c IPART(3,I)=ISID
3161c IPART(4,I)=ID
3162c IPART(5,I)=MID id user
3163c IPART(6,I)=PID id user
3164c IPART(7,I)=SID
3165c IPART(8,I)=ITH
3166C
3167 etye =27
3168 i2geo(1:numgeo) = 0
3169 i2geo1(1:numgeo) = 0
3170 i2geo2(1:numgeo) = 0
3171 ip2ng1(1:npart) = 0
3172 ip2ng2(1:npart) = 0
3173C Up to 3 different elements using same PID (tetra4,tetra10,hexa)
3174C Only solid and shell have initialized surely IPARG(62,NG)
3175 DO ng=1,ngroup
3176 IF (iparg(8,ng)==1.OR.iparg(62,ng)==0) cycle
3177 ity = iparg(5,ng)
3178 IF (ity ==1) THEN
3179 isolnod = iparg(28,ng)
3180 nft=iparg(3,ng)+1
3181 lst=iparg(3,ng)+iparg(2,ng)
3182 ip = iparts(nft)
3183 IF (ip2ng1(ip)==0) THEN
3184 ip2ng1(ip) = ng
3185 ELSEIF (ip2ng2(ip)==0.AND.iparg(28,ip2ng1(ip)) /= isolnod) THEN
3186 ip2ng2(ip) = ng
3187 ELSEIF(ip2ng2(ip)>0) THEN
3188C-------3 elem types in the same part 4+10+8
3189 n_nod = isolnod+iparg(28,ip2ng1(ip))+iparg(28,ip2ng2(ip))
3190 IF(n_nod==22) THEN
3191 IF (iparg(28,ip2ng1(ip))==8) THEN
3192 ip2ng2(ip) = -ip2ng1(ip)
3193 ELSEIF (iparg(28,ip2ng2(ip))==8) THEN
3194 ip2ng2(ip) = -ip2ng2(ip)
3195 ELSE
3196 ip2ng2(ip) = -ng
3197 END IF
3198 END IF
3199 END IF
3200C-----case 2 parts in same groupe
3201 IF (iparts(lst)/=ip) THEN
3202 ip = iparts(lst)
3203 IF (ip2ng1(ip)==0) THEN
3204 ip2ng1(ip) = ng
3205 ELSEIF (ip2ng2(ip)==0.AND.iparg(28,ip2ng1(ip)) /= isolnod) THEN
3206 ip2ng2(ip) = ng
3207 ELSEIF(ip2ng2(ip)>0) THEN
3208 n_nod = isolnod+iparg(28,ip2ng1(ip))+iparg(28,ip2ng2(ip))
3209 IF(n_nod==22) THEN
3210 IF (iparg(28,ip2ng1(ip))==8) THEN
3211 ip2ng2(ip) = -ip2ng1(ip)
3212 ELSEIF (iparg(28,ip2ng2(ip))==8) THEN
3213 ip2ng2(ip) = -ip2ng2(ip)
3214 ELSE
3215 ip2ng2(ip) = -ng
3216 END IF
3217 END IF
3218 END IF
3219 END IF
3220 END IF
3221 ipid=iparg(62,ng)
3222 IF (i2geo(ipid)==0) THEN
3223 i2geo(ipid) = ng
3224 ELSE
3225C---- check if ITY, ISOLNOD are the same
3226 ng0 = i2geo(ipid)
3227 IF (ng0>2*ngroup) cycle
3228 IF (ng0>ngroup) ng0 =-i2geo1(ipid)
3229 ity = iparg(5,ng0)
3230 igtyp= iparg(38,ng0)
3231 isolnod = iparg(28,ng0)
3232C-------ITY : shell
3233 IF (iparg(5,ng)/= ity) THEN
3234 i2geo(ipid) = i2geo(ipid) + ngroup
3235 IF (i2geo1(ipid)==0.AND.i2geo(ipid)>ngroup) i2geo1(ipid) = -ng
3236C-------ITY=1 : solid
3237 ELSEIF (ity==1.AND.iparg(5,ng)==1) THEN
3238 IF (iparg(28,ng)/=isolnod) i2geo(ipid) = i2geo(ipid) + ngroup
3239 IF (i2geo1(ipid)==0.AND.i2geo(ipid)>ngroup) i2geo1(ipid) = -ng
3240 IF (i2geo2(ipid)==0.AND.i2geo(ipid)>2*ngroup) i2geo2(ipid) = -ng
3241C-------ITY=1 : thick-shell
3242 ELSEIF (igtyp>=20.AND.igtyp<=22.AND.iparg(38,ng)==igtyp) THEN
3243 IF (iparg(28,ng)/=isolnod) i2geo(ipid) = i2geo(ipid) + ngroup
3244 IF (i2geo1(ipid)==0.AND.i2geo(ipid)>ngroup) i2geo1(ipid) = -ng
3245 END IF
3246 END IF
3247 END DO
3248C
3249 WRITE(iout,'(//,A)')'PART ELEMENT/MATERIAL PARAMETER REVIEW:'
3250 WRITE(iout,'(A,/)') '-----------------------'
3251C-------We suppose the orders of IPART/IPARG are the same
3252 DO i=1,npart
3253 CALL fretitl2(text,ipart(lipart1-ltitr+1,i),ltitr)
3254 imid=ipart(1,i)
3255 ipid=ipart(2,i)
3256 IF(ipid == 0) cycle
3257 igtyp= igeo(11,ipid)
3258 IF(imid == 0) cycle
3259 mid = nint(pm(19,imid))
3260 npt =igeo(4,ipid)
3261 ihbe0 =igeo(10,ipid)
3262 icontrol = igeo(97,ipid)
3263 ipos = igeo(99,ipid)
3264c MID = IPM(2,IMID)
3265 ng0 = i2geo(ipid)
3266 ng2=0
3267 ng1=0
3268 ng = ng0
3269C---- case 2 elem use same pid 1): shell 3n,4n 2): thick-shell hexa-penda 3): S16-S20
3270C---- 4): solid hexa-tetra4, 5): solid hexa-tetra10,6): solid tetra4-tetra10,
3271C---- case 3 elem use same pid 1): solid hexa-tetra4-tetra10
3272C-----case not-considered : thick-shell hexa-S16 hexa-S20, hexa-S16-S20
3273 ety=etye
3274 IF(ip2ng1(i)>0)THEN
3275 IF (ip2ng2(i)<0) THEN
3276 ng = -ip2ng2(i)
3277 ELSEIF (ip2ng2(i)>0) THEN
3278 IF (iparg(28,ip2ng2(i))==8) THEN
3279 ng = ip2ng2(i)
3280 ELSE
3281 ng = ip2ng1(i)
3282 END IF
3283 ELSE
3284 ng = ip2ng1(i)
3285 END IF
3286 ELSE
3287 IF (ng0>2*ngroup) THEN
3288 IF (i2geo2(ipid)>0) THEN
3289 ng = i2geo2(ipid)
3290 ELSEIF (i2geo1(ipid)>0) THEN
3291 ng = i2geo1(ipid)
3292 i2geo2(ipid)= -i2geo2(ipid)
3293 ELSE
3294 ng = ng-2*ngroup
3295 i2geo1(ipid)= -i2geo1(ipid)
3296 END IF
3297 ELSEIF (ng0>ngroup) THEN
3298 IF (i2geo1(ipid)>0) THEN
3299 ng = i2geo1(ipid)
3300 ELSE
3301 ng = ng-ngroup
3302 i2geo1(ipid)= -i2geo1(ipid)
3303 END IF
3304 END IF
3305 END if!(IP2NG1(I)>0)
3306C-----
3307 IF (ng >0) THEN
3308 ity = iparg(5,ng)
3309 isolnod = iparg(28,ng)
3310 ihbe=iparg(23,ng)
3311 npt =max(npt,iparg(6,ng))
3312 ELSE
3313 ity =0
3314 END IF
3315C------- set ele_type(ETY)
3316 SELECT CASE (igtyp)
3317C-------thick-shell
3318 CASE(20,21,22)
3319 IF (ng0>ngroup.AND.ip2ng2(i)>0) THEN
3320 ng1 = iabs(i2geo1(ipid))
3321 n_nod = iparg(28,ip2ng1(i))+iparg(28,ip2ng2(i))
3322 IF(n_nod==14) THEN
3323 ety = 17+2
3324 ELSEIF(n_nod==36) THEN
3325 ety = 17+3
3326 END IF
3327 ELSEIF (isolnod==8) THEN
3328 ety=7
3329 ELSEIF (isolnod==6) THEN
3330 ety=8
3331 ELSEIF (isolnod==16) THEN
3332 ety=9
3333 ELSEIF (isolnod==20) THEN
3334 ety=10
3335 ELSE
3336 ety=etye
3337 END IF
3338 CASE(2)
3339 ety=14
3340 CASE(3,18)
3341 ety=15
3342 CASE(4,8,12,13,23,25,26,32,35,36,44,45,46)
3343 ety=16
3344 mid = -1
3345 CASE(28)
3346 ety=25
3347 mid = -1
3348 CASE(29,30,31)
3349 ety=5
3350 CASE(33)
3351 ety=26
3352 mid = -1
3353 CASE(34)
3354 ety=17
3355 CASE DEFAULT
3356C---- solid
3357 IF(ity==1)THEN
3358 IF (ng0>2*ngroup.AND.ip2ng2(i)<0) THEN
3359 ety = 17+7
3360 ELSEIF (ng0>ngroup.AND.ip2ng2(i)>0) THEN
3361 ng1 = iabs(i2geo1(ipid))
3362 n_nod = iparg(28,ip2ng1(i))+iparg(28,ip2ng2(i))
3363 IF(n_nod==12) THEN
3364 ety = 17+4
3365 ELSEIF(n_nod==18) THEN
3366 ety = 17+5
3367 ELSEIF(n_nod==14) THEN
3368 ety = 17+6
3369 END IF
3370 ELSEIF (isolnod==8) THEN
3371 ety=1
3372 ELSEIF (isolnod==4) THEN
3373 ety=2
3374 ELSEIF (isolnod==10) THEN
3375 ety=3
3376 ELSEIF (isolnod==20) THEN
3377 ety=4
3378 ELSE
3379 ety=etye
3380 END IF
3381 ELSEIF(ity==2.AND.n2d>0)THEN
3382 ety=13
3383C------ shell
3384 ELSEIF(ity==3.OR.ity==7)THEN
3385 IF (ng0>ngroup) THEN
3386 ety = 17+1
3387 ELSEIF(ity==3)THEN
3388 ety=11
3389 ELSE
3390 ety=12
3391 END IF
3392 ELSEIF(ity==4)THEN
3393 ety=14
3394 ELSEIF(ity==5)THEN
3395 ety=15
3396 ELSEIF(ity==6)THEN
3397 ety=16
3398 ELSEIF(ity==51)THEN
3399 ety=17
3400 ELSEIF(ity==101)THEN
3401 ety=6
3402 ELSE
3403 ety=etye
3404 END IF
3405 END SELECT
3406 IF (mid>0) THEN
3407 WRITE(iout,'(A,I10,1X,A,3X,A,I4,2A)')'Part id,name:',ipart(4,i),text(1:20),'Mat type:',mid,' Elm type: ',el_typ(ety)
3408 ELSEIF (mid==0) THEN
3409 WRITE(iout,'(A,I10,1X,A,3X,A,2A)')'Part id,name:',ipart(4,i),text(1:20),'Mat type: VOID',' Elm type: ',el_typ(ety)
3410C----- spring, KJOINT -----
3411 ELSE
3412 WRITE(iout,'(A,I10,1X,A,16X,2A)')'Part id,name:',ipart(4,i),text(1:20),' Elm type: ',el_typ(ety)
3413 END IF
3414 WRITE(iout,'(A)') '----'
3415C-print in fonction of elem types ITY
3416 SELECT CASE (ity)
3417 CASE(1)
3418 qh =zero
3419 SELECT CASE (isolnod)
3420 CASE(4,10)
3421 ihbe=1
3422 CASE(6)
3423 ihbe=15
3424 CASE(20)
3425 ihbe=16
3426 END SELECT
3427 IF (ihbe<=2.AND.isolnod==8) qh = geo(13,ipid)
3428 qa = geo(14,ipid)
3429 qb = geo(15,ipid)
3430C-------this is done in ENGINE, should be done in Starter
3431 IF (mid==70 .AND.igeo(31,ipid) == 1) THEN
3432 qa = zero
3433 qb = zero
3434 END IF
3435 dn = zero
3436 IF (isolnod==8.AND.(ihbe==24.OR.ihbe==15)) dn = geo(13,ipid)
3437 ns_a = geo(16,ipid)
3438 ns_b = geo(17,ipid)
3439 npt =iparg(6,ng)
3440 iint = iparg(36,ng)
3441 IF (ihbe==17.AND.iint==2) ihbe=18
3442 IF (ihbe==1.AND.iint==3) ihbe=5
3443 ismstr=iparg(9,ng)
3444 icpre = iparg(10,ng)
3445 IF (icpre==0.AND.isolnod==8) icpre=3
3446 jcvt = iparg(37,ng)+1
3447 ihkt = 0
3448 IF (ihbe==24.AND.isolnod==8) ihkt = iint
3449 IF(mid == 68)THEN
3450 itet4 = 0
3451 ELSE
3452 itet4 = iparg(41,ng)
3453 ENDIF
3454 itet10 = iparg(74,ng)
3455 imatvis = iparg(45,ng)
3456 IF (igtyp>=20.AND.igtyp<=22) THEN
3457 IF (ihbe==14 .OR. ihbe==16) THEN
3458 nly = mod(abs(npt)/10,10)
3459 ELSE
3460 nly = npt
3461 ENDIF
3462 IF (icpre==0) icpre=3
3463c-----
3464 IF (igtyp==22.AND.ihbe==14 ) THEN
3465C------ IPARG(6,NG)= NPG after elbuf_ini
3466 npt =max(npt,igeo(4,ipid))
3467 icstr = iparg(17,ng)
3468 SELECT CASE (icstr)
3469 CASE(100)
3470 nly = abs(npt)/100
3471 IF (nly ==0) nly =iint
3472 CASE(10)
3473 nly = mod(abs(npt)/10,10)
3474 IF (nly ==0) nly =iint
3475 CASE(1)
3476 nly = mod(abs(npt),10)
3477 IF (nly ==0) nly =iint
3478 END SELECT
3479 ENDIF
3480 WRITE(iout,'(A)') ' Isolid Ismstr Icpre NPT ICONTROL'
3481 WRITE(iout,'(5I8)')ihbe,ismstr,icpre, nly,icontrol
3482 ELSE
3483c2345678+-------+-------+-------+-------+-------+-------+-------+-------+-------+
3484c---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|
3485 WRITE(iout,'(A)')' Isolid Ismstr Icpre Iframe IHKT Itetra4 Itetra10 IMATVIS ICONTROL'
3486 WRITE(iout,'(9I8)')ihbe,ismstr, icpre, jcvt, ihkt ,itet4, itet10,imatvis,icontrol
3487 END IF
3488 WRITE(iout,'(A)') '-- qa qb lamda_v mu_v h dn'
3489 WRITE(iout,'(6F10.4,/)')qa,qb,ns_a,ns_b,qh,dn
3490C
3491 CASE(2)
3492C----------
3493 jcvt = iparg(37,ng)+1
3494 WRITE(iout,'(A)') ' Isolid Iframe N2D(1:ASY;2:STR-PLANE)'
3495 WRITE(iout,'(3I8,/)')ihbe,jcvt, n2d
3496c--------
3497 CASE(3,7)
3498C-------- shell
3499 ismstr=iparg(9,ng)
3500 idril =iparg(41,ng)
3501 ithk =iparg(28,ng)
3502 iplas =iparg(29,ng)
3503 igmat =igeo(98,ipid)
3504 IF (npt>1 .AND.(mid==1 .OR. mid==91)) npt =0
3505 qf = zero
3506 qm = zero
3507 qr = zero
3508 dn = zero
3509C Ishell Ismstr Ish3n Idril
3510C------ just consisting with manuel
3511 IF (idril==0) idril=2
3512 ih3= 0
3513 ih4= 0
3514 IF (ng0>ngroup) THEN
3515 ng1 = iabs(i2geo1(ipid))
3516C IF(ITY==3)THEN
3517CC------ Ishel=2 -> 0 Ishel=3 -> 2
3518C IH4 = IPARG(23,NG)
3519C IH3 = IPARG(23,NG1)
3520C ELSE
3521C IH3 = IPARG(23,NG)
3522C IH4 = IPARG(23,NG1)
3523C END IF
3524C IF (IH4>4.OR.IH4==2) IH4 =IH4 +1
3525C IF (IH4==0) IH4 =2
3526C MIXED CASE take directly defining in pid
3527 ih3 = igeo(18,ipid)
3528 ih4 = igeo(10,ipid)
3529 WRITE(iout,'(A)') ' Ishell Ish3n Ismstr Idril NPT ITHK IPLAS IPOS'
3530 WRITE(iout,'(8I8)')ih4,ih3,ismstr,idril,npt,ithk,iplas,ipos
3531 ELSEIF(ity==3)THEN
3532 ih4 = iparg(23,ng)
3533 IF (ih4>4.OR.ih4==2) ih4 =ih4 +1
3534 IF (ih4==0) ih4 =2
3535 WRITE(iout,'(A)') ' Ishell Ismstr Idril NPT ITHK IPLAS IPOS'
3536 WRITE(iout,'(7I8)')ih4,ismstr,idril,npt,ithk,iplas,ipos
3537 ELSE
3538 ih3 = iparg(23,ng)
3539 WRITE(iout,'(A)') ' Ish3n Ismstr Idril NPT ITHK IPLAS IPOS'
3540 WRITE(iout,'(7I8)')ih3,ismstr,idril,npt,ithk,iplas,ipos
3541 END IF
3542 IF (ih4>0.AND.ih4<=4) THEN
3543 qf = geo(13,ipid)
3544 qm = geo(14,ipid)
3545 qr = geo(15,ipid)
3546 END IF
3547C--------verify dm in Engine
3548 dm = group_param_tab(ng)%VISC_DM
3549c DM = GEO(16,IPID)
3550C--------verify dn 12, dkt...
3551 IF (ih4==24) dn = geo(13,ipid)
3552 IF (dn==zero.AND.ih4==12) THEN
3553 dn = em03
3554 END IF
3555 IF (dn==zero.AND.ih3==30) dn = em4
3556c DN = GROUP_PARAM_TAB(NG)%VISC_DN
3557 WRITE(iout,'(A)') '-- hm hf hr dm dn'
3558 WRITE(iout,'(5F10.4,/)')qm,qf,qr,dm,dn
3559c
3560 CASE(6)
3561 WRITE(iout,'(A,I5/)') 'Spring type:',igtyp
3562c
3563 CASE DEFAULT
3564c
3565 IF(igtyp==2)THEN
3566C---------- truss, nothing
3567 WRITE(iout,*)
3568 ELSEIF(igtyp==3.OR.igtyp==18)THEN
3569 ismstr=igeo(5,ipid)
3570 dm = geo(16,ipid)
3571 df = geo(17,ipid)
3572 WRITE(iout,'(A)') ' Ismstr dm df'
3573 WRITE(iout,'(I8,2F10.4/)')ismstr,dm,df
3574C----------spring w/ NG=0
3575 ELSEIF(igtyp==4.OR.igtyp==8.OR.igtyp==12.OR.igtyp==13.OR.
3576 . igtyp==32.OR.igtyp==35.OR.igtyp==36 .OR. igtyp == 23)THEN
3577 WRITE(iout,'(A,I5/)') 'Spring type:',igtyp
3578 END IF
3579 END SELECT
3580
3581 ENDDO
3582C
3583 RETURN
3584 END
3585
addmaspart
subroutine addmaspart(ipart, ipmas, partsav, part_area, pm, addedms, nom_opt, partsav_pon)
Definition addmaspart.F:35
asstifi
subroutine asstifi(volnod, bvolnod, etnod, nshnod, stifint)
Definition asstifi.F:29
binit2
subroutine binit2(elbuf_str, ms, ixq, pm, x, detonators, veul, ale_connectivity, iparg, fill, sigi, bufmat, nel, mat_param, skew, msq, ipart, ipartq, geo, igeo, ipm, nsigs, wma, ptquad, npf, tf, ipargg, iloadp, facload, partsav, v)
Definition binit2.F:48
c3init3
subroutine c3init3(elbuf_str, ixtg, pm, x, geo, igrsh4n, xmas, in, nvc, dtelem, igrsh3n, xreftg, offset, nel, ithk, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, mstg, intg, ptg, skew, iparg, nsigsh, igeo, iuser, etnod, nshnod, sttg, ptsh3n, ipm, bufmat, sh3tree, mcp, mcptg, temp, cpt_eltens, part_area, itage, itagn, ixfem, npf, tf, sh3trim, xfem_str, isubstack, stack, rnoise, drape, sh3ang, iddlevel, geo_stack, igeo_stack, strtg, perturb, ish3n, iyldini, ele_area, nloc_dmg, ng, group_param, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition c3init3.F:81
cbainit3
subroutine cbainit3(elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thke, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, i8mi, nsigsh, igeo, ipm, iuser, etnod, nshnod, stc, ptshel, bufmat, sh4tree, mcp, mcps, temp, ms_layer, zi_layer, itag, itagel, iparg, ms_layerc, zi_layerc, part_area, cpt_eltens, msz2c, zply, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, nloc_dmg, ng, group_param, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition cbainit3.F:81
cdkinit3
subroutine cdkinit3(elbuf_str, group_param, ixtg, pm, x, geo, xmas, in, nvc, dtelem, xreftg, offset, nel, ithk, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, mstg, intg, ptg, skew, ish3n, nsigsh, igeo, ipm, iuser, etnod, nshnod, sttg, ptsh3n, bufmat, sh3tree, mcp, mcps, temp, iparg, cpt_eltens, part_area, npf, tf, sh3trim, isubstack, stack, rnoise, drape, sh3ang, geo_stack, igeo_stack, strtg, perturb, iyldini, ele_area, nloc_dmg, idrape, drapeg, mat_param, glob_therm)
Definition cdkinit3.F:67
cinit3
subroutine cinit3(elbuf_str, ixc, pm, x, geo, xmas, in, nvc, dtelem, igrsh4n, xrefc, nel, ithk, ihbe, igrsh3n, thk, isigsh, sigsh, stifn, stifr, partsav, v, ipart, msc, inc, skew, iparg, i8mi, nsigsh, igeo, iuser, etnod, nshnod, stc, ptshel, ipm, bufmat, sh4tree, mcp, mcps, temp, cpt_eltens, part_area, itagn, itage, ixfem, npf, tf, xfem_str, isubstack, stack, rnoise, drape, sh4ang, iddlevel, geo_stack, igeo_stack, strc, perturb, iyldini, ele_area, ng, group_param, nloc_dmg, idrape, drapeg, mat_param, fail_fractal, fail_brokmann, glob_therm)
Definition cinit3.F:81
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
dtnoda_stifint
subroutine dtnoda_stifint(ms, stifn, dt_stifint)
Definition dtnoda_stifint.F:31
eporin3
subroutine eporin3(ixs, veul, ale_connectivity, geo, nft, nel)
Definition eporin3.F:30
fxbsini
subroutine fxbsini(fxbelm, fxbsig, nels, nelc, neltg, x, iparg, pm, fxbmod, nml, nsn, ixs, ixc, ixtg, geo, fxbrpm, nfx, ifile, lvsig, nsni, nme, ircs, ircm0, nelt, nelp, ixt, ixp, ibeam_vector, rbeam_vector)
Definition fxbsini.F:41
fxbvini
subroutine fxbvini(fxbipm, fxbvit, fxbrpm, v, vr)
Definition fxbvini.F:30
retrirby
subroutine retrirby(npby, lpby, rby, nom_opt)
Definition hm_read_merge.F:1047
inirbe2
subroutine inirbe2(irbe2, lrbe2, itab, x, ms, in, stifn, stifr, totmas, xgt, ygt, zgt, b1, b2, b3, b5, b6, b9, nom_opt, itagnd)
Definition hm_read_rbe2.F:726
ig3dinit3
subroutine ig3dinit3(elbuf_str, ms, kxig3d, ixig3d, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, ipartig3d, mss, ipart, sigsp, nsigi, in, vr, ipm, nsigs, vnige, bnige, ptsol, bufmat, npf, tf, fail_ini, nctrl, msig3d, knot, nctrlmax, wige, px, py, pz, knotlocpc, knotlocel, mat_param)
Definition ig3dinit3.F:49
ini_fvminivel
subroutine ini_fvminivel(fvm_inivel, multi_fvm, igrbric, igrquad, igrsh3n)
Definition ini_fvminivel.F:30
ini_fxbody
subroutine ini_fxbody(fxbipm, fxbrpm, fxbnod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbmod, itab, x, ms, in, fxb_matrix, fxb_matrix_add, fxb_last_adress, icode, nom_opt)
Definition ini_fxbody.F:43
ini_inimap1d
subroutine ini_inimap1d(inimap1d, elbuf_tab, ipart, iparg, iparts, ipartq, xgrid, vel, ixs, ixq, ixtg, pm, ipm, bufmat, multi_fvm, pld, npc, igrbric, igrquad, igrsh3n, npts, mat_param, snpc, stf)
Definition ini_inimap1d.F:40
ini_inimap2d
subroutine ini_inimap2d(inimap2d, elbuf_tab, ipart, iparg, iparts, ipartq, xgrid, vel, ixs, ixq, ixtg, pm, ipm, bufmat, multi_fvm, func2d, igrbric, igrquad, igrsh3n, npc, pld, mat_param)
Definition ini_inimap2d.F:38
ini_seatbelt
subroutine ini_seatbelt(iparg, elbuf_tab, knod2el1d, nod2el1d, ixr, x, itab, ipm, alea, knod2elc, nod2elc, ixc)
Definition ini_seatbelt.F:38
iniboltprel
subroutine iniboltprel(ixs, ipreload, preload, vpreload, iflag_bpreload)
Definition iniboltprel.F:34
inigrav_load
subroutine inigrav_load(elbuf_tab, ipart, igrpart, iparg, iparttg, iparts, ipartq, x, ixs, ixq, ixtg, pm, ipm, bufmat, multi_fvm, ale_connectivity, nv46, igrsurf, itab, ebcs_tab, npf, tf, mat_param)
Definition inigrav_load.F:43
ininode_rm
subroutine ininode_rm(connec, irig_node, irby, sln, nrb, nrsln, stifn, stifr, rmstifn, rmstifr, numel, ner)
Definition ininode_rm.F:31
inintmass
subroutine inintmass(ipari, intbuf_tab, ms, istif_dt)
Definition inintmass.F:31
inirbys
subroutine inirbys(nrb, rby, m, lpby, ms, in, x, itab, skew, b1, b2, b3, b5, b6, b9, isph, totmas, xgt, ygt, zgt, npby, iwa, v, vr, rbyid, id, titr, itagnd, rby_iniaxis)
Definition inirby.F:1122
inirby
subroutine inirby(nrb, rby, m, lpby, ms, in, x, itab, skew, b1, b2, b3, b5, b6, b9, isph, totmas, xgt, ygt, zgt, stifn, stifr, npby, rbyid, v, vr, id, titr, itagnd, rby_iniaxis)
Definition inirby.F:42
inirig_mat
subroutine inirig_mat(ixc, ixs, ixtg, ixs10, x, v, pm, geo, ms, in, ptg, msc, mss, mstg, inc, intg, thkc, thkt, partsav, iparts, ipartc, ipartt, veul, dtelem, ihbe, isolnod, nvc, i8mi, msnf, mssf, igeo, etnod, nshnod, stc, sttg, wma, sh4tree, sh3tree, mcp, mcpc, temp, mcps, mssx, mcpsx, ins, stifn, stifr, connec, irig_node, numel, nindx, xrefc, xreftg, xrefs, mssa, sh3trim, isubstack, bufmat, ipm, stack, rnoise, strc, strtg, perturb, nel, group_param, igtyp, defaults, glob_therm)
Definition inirig_mat.F:69
inisrf
subroutine inisrf(x, v, vr, npby, rby, igrsurf, bufsf)
Definition inisrf.F:35
sgsavinieref
subroutine sgsavinieref(npe, straglob, sigsp, nsigi, ptsol, sav, offg, nel)
Definition initia.F:2954
sgsavref
subroutine sgsavref(npe, xref, sav, nel)
Definition initia.F:2902
sgsavinierefq
subroutine sgsavinierefq(npe, straglob, sigsp, nsigi, ptsol, sav, offg, ixs, dr, ndr, nel)
Definition initia.F:3022
outpart
subroutine outpart(partsav, ipart, npart)
Definition initia.F:2830
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine, lsigi, lsigsp, srnoise, nprw, lprw, rwstif_pen, sln_pen)
Definition initia.F:198
outpart5
subroutine outpart5(group_param_tab, ipart, iparts, iparg, igeo, geo, pm)
Definition initia.F:3091
checkmp
subroutine checkmp(numel, ix, nix, ng, ne, emat, epid, ipm, igeo, elem, ipartel)
Definition initia.F:2530
chekmp2
subroutine chekmp2(numel, ipart, ipartel, ix, nix, ne, emat, epid, ipm, igeo, elem)
Definition initia.F:2294
inivoid
subroutine inivoid(elbuf_str, ixc, ixs, ixtg, x, v, pm, geo, ms, in, ptg, msc, mss, mstg, inc, intg, thkc, thkt, partsav, iparts, ipartc, ipartt, veul, dtelem, ihbe, isolnod, nvc, i8mi, msnf, mssf, igeo, etnod, nshnod, stc, sttg, wma, sh4tree, sh3tree, mcp, mcpc, temp, mcps, xrefc, xreftg, xrefs, mssa, volnod, bvolnod, vns, bns, sh3trim, isubstack, stack, rnoise, perturb, ele_area, part_area, iparttr, ixt, ipartp, ixp, mst, msp, stt, stp, strp, inp, stifint, mcpp, inr, msr, msrt, str, ipartr, itab, ixr, imerge2, iadmerge2, nel, defaults, glob_therm, ibeam_vector, rbeam_vector)
Definition inivoid.F:76
inspcnd
subroutine inspcnd(ispcond, igrnod, kxsp, ixsp, nod2sp, itab, icode, iskew, iskn, skew, xframe, x, ispsym, isptag, pm, geo, ipart, ipartsp)
Definition inspcnd.F:39
laser10
subroutine laser10(las, xlas, x, ixq, iparg)
Definition laser10.F:31
lgmini_rby
subroutine lgmini_rby(npbyl, lpbyl, rbyl, mass, iner, x, v, vr, itab, nom_opt)
Definition lgmini_rby.F:35
max
#define max(a, b)
Definition macros.h:21
modbufel
subroutine modbufel(fxbelm, fxbsig, bufel, nels, nelc, nelt, nelp, neltg, fxbrpm, lbufel, asig, ifile, ircs, lvsig)
Definition modbufel.F:33
moddepl
subroutine moddepl(ibuf, mod, mdepl, ifile, ircm, nsni, nsn, amod)
Definition moddepl.F:30
multifluid_global_tdet
subroutine multifluid_global_tdet(iparg, elbuf_tab, multi_fvm, ipm)
Definition multifluid_global_tdet.F:31
multifluid_init2
subroutine multifluid_init2(nel, nsigs, iparg, ixq, ipm, ale_connectivity, igeo, ipart, ipartq, npf, ptquad, iloadp, x, pm, geo, sigi, skew, tf, bufmat, facload, elbuf_str, error_thrown, detonators, mat_param)
Definition multifluid_init2.F:43
multifluid_init2t
subroutine multifluid_init2t(elbuf_str, nel, nsigs, nvc, iparg, ixtg, ale_connectivity, igeo, ipart, iparttg, ipm, ptsh3n, npf, iloadp, xgrid, pm, geo, sigi, skew, tf, bufmat, facload, multi_fvm, error_thrown, detonators, mat_param)
Definition multifluid_init2t.F:40
multifluid_init3
subroutine multifluid_init3(elbuf_str, mas, ixs, pm, x, geo, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, glob_therm, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, multi_fvm, error_thrown, detonators, mat_param)
Definition multifluid_init3.F:60
multifluid_init3t
subroutine multifluid_init3t(elbuf_str, nel, nsigs, nsigi, ixs, igeo, ipm, iparg, ale_connectivity, iparts, ptsol, npf, ipart, iloadp, xrefs, geo, pm, facload, tf, skew, sigi, bufmat, x, wma, partsav, mas, v, mss, mssf, mssa, msnf, mcps, error_thrown, detonators, defaults, mat_param, nintemp)
Definition multifluid_init3t.F:44
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
array_mod
Definition array_mod.F:51
bpreload_mod
Definition bpreload_mod.F:40
bpreload_mod::iflag_bpreload
integer, dimension(:), allocatable iflag_bpreload
Definition bpreload_mod.F:48
bpreload_mod::ipreload
integer, dimension(:), allocatable ipreload
Definition bpreload_mod.F:46
detonators_mod
Definition detonators_mod.F:80
drape_mod
Definition drape_mod.F:54
func2d_mod
Definition func2d_mod.F:35
groupdef_mod
Definition groupdef_mod.F:668
inimap1d_mod
Definition inimap1d_mod.F:35
inimap2d_mod
Definition inimap2d_mod.F:35
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
nlocal_reg_mod
Definition nlocal_reg_mod.F:119
optiondef_mod
Definition optiondef_mod.F:90
stack_mod
Definition stack_mod.F:75
submodel_mod
Definition submodel_mod.F:717
nloc_dmg_init
subroutine nloc_dmg_init(elbuf_tab, nloc_dmg, iparg, ixc, ixs, ixtg, area, dtelem, numel, ipm, x, xrefs, xrefc, xreftg, matparam)
Definition nloc_dmg_init.F:37
pinit3
subroutine pinit3(elbuf_str, stp, ic, pm, x, geo, dtelem, nft, nel, stifn, stifr, partsav, v, ipart, msp, inp, igeo, strp, nsigbeam, sigbeam, ptbeam, iuser, mcpp, temp, preload_a, ipreld, npreload_a, glob_therm, ibeam_vector, rbeam_vector)
Definition pinit3.F:48
q4init2
subroutine q4init2(elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v, mat_param)
Definition q4init2.F:53
qinit2
subroutine qinit2(elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v, mat_param)
Definition qinit2.F:52
rcheckmass
subroutine rcheckmass(ixr, geo, pm, msr, inr, ms, in, itab, igeo, ipm, uparam, ipart, ipartr, npby, lpby)
Definition rcheckmass.F:37
rini33_rb
subroutine rini33_rb(nel, nuvar, iprop, ixr, npby, lpby, rby, stifr, uvar, itab, igeo, ixr_kj, gmass)
Definition rini33_rb.F:40
rini45_rb
subroutine rini45_rb(nel, nuvar, iprop, ixr, npby, lpby, rby, stifr, uvar, itab, igeo, ixr_kj, gmass, ms, in)
Definition rini45_rb.F:40
rinit3
subroutine rinit3(elbuf_str, ixr, x, geo, xmas, npc, pld, xin, skew, dtelem, nel, stifn, stifr, partsav, v, ipart, itab, msr, inr, stifint, str, igeo, sigrs, nsigrs, imerge2, iadmerge2, msrt, ixr_kj, nom_opt, strr, ptspri, ipm, pm, uparam, r_skew, preload_a, ipreld, npreload_a, ikine)
Definition rinit3.F:67
s10init3
subroutine s10init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs10, ipart, glob_therm, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, in, stifr, ins, mssa, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
Definition s10init3.F:63
s10jaci3
subroutine s10jaci3(elbuf_str, sav, npt, nel)
Definition s10jaci3.F:33
s16init3
subroutine s16init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs16, ipart, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s16init3.F:59
s20init3
subroutine s20init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs20, ipart, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s20init3.F:59
s4init3
subroutine s4init3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, msnf, iparg, mssf, ipm, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, iuser, sigsp, nsigi, mssa, xrefs, strsglob, straglob, fail_ini, spbuf, sol2sph, iloadp, facload, rnoise, perturb, mat_param, defaults_solid, nintemp)
Definition s4init3.F:66
s4refsta3
subroutine s4refsta3(elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
Definition s4refsta3.F:49
s6cinit3
subroutine s6cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, mssa, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
Definition s6cinit3.F:60
s8cinit3
subroutine s8cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s8cinit3.F:60
s8zinit3
subroutine s8zinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, perturb, rnoise, mat_param)
Definition s8zinit3.F:70
scaleini
subroutine scaleini(elbuf_str, ixs, sigsp, sigi, nsigi, nel, lft, llt, nft, nsigs, pt, igeo)
Definition scaleini.F:37
scinit3
subroutine scinit3(elbuf_str, mas, ixs, pm, x, mss, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, glob_therm, mat_param)
Definition scinit3.F:59
sinit3
subroutine sinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition sinit3.F:75
sms_auto_dt
subroutine sms_auto_dt(dtelem, nativ_sms, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs16, ixs20, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartx, ipart, iparg, elbuf_tab, igeo, iddlevel, tagprt_sms)
Definition sms_auto_dt.F:38
spinit3
subroutine spinit3(igrtyp, spbuf, kxsp, x, geo, xmas, npc, pld, xin, skew, dtelem, nel, stifn, stifr, igeo, partsav, v, ipartsp, bufmat, pm, itab, msr, inr, ixsp, nod2sp, iparg, ale_connectivity, detonators, sigsph, isptag, ipart, ipm, nsigsph, ptsph, npf, tf, elbuf_str, mcp, temp, iloadp, facload, stifint, i7stifs, glob_therm, mat_param)
Definition spinit3.F:52
spmd_msin
subroutine spmd_msin(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, mss, msq, msc, mst, msp, msr, mstg, inc, inp, inr, intg, index, itri, ms, in, ptg, geo, ixs10, ixs20, ixs16, mssx, msnf, mssf, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, stifint, ins, mcpc, mcp, mcps, mcpsx, mcptg, sh4tree, sh3tree, ms_layerc, zi_layerc, ms_layer, zi_layer, msz2c, msz2, zply, kxig3d, ixig3d, msig3d, nctrlmax, strc, strp, strr, strtg, stifintr, nshnod, vnige, bnige, mcpp, itherm_fe)
Definition spmd_msin.F:47
spmd_partsav_pon
subroutine spmd_partsav_pon(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, index, itri, geo, partsav1_pon, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipart)
Definition spmd_msin_addmass.F:503
spmd_msin_addmass
subroutine spmd_msin_addmass(ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, mss, mssx, msq, msc, mst, msp, msr, mstg, ptg, ms, index, itri, geo, sh4tree, sh3tree, partsav, ipmas, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, totaddmas, ipart, thk, pm, part_area, addedms, itab, partsav1_pon, ele_area)
Definition spmd_msin_addmass.F:41
srefsta3
subroutine srefsta3(elbuf_str, ixs, pm, geo, iparg, ipm, igeo, skew, x, xrefs, nel, iparts, ipart, bufmat, mat_param, npf, tf, nummat)
Definition srefsta3.F:49
sgsavini
subroutine sgsavini(npe, x, ixs, sav, nel)
Definition scoor3.F:365
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
arret
subroutine arret(nn)
Definition arret.F:86
starter
program starter
Definition starter.F:39
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70
suinit3
subroutine suinit3(elbuf_str, ms, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, glob_therm, temp, nsigi, in, vr, ipm, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, npf, tf, fail_ini, ins, iloadp, facload, rnoise, perturb, mat_param)
Definition suinit3.F:54
tinit3
subroutine tinit3(elbuf_str, ic, pm, x, geo, xmas, dtelem, nft, nel, stifn, partsav, v, ipart, mst, stifint, stt, igeo, nsigtruss, sigtruss, pttruss, preload_a, ipreld, npreload_a)
Definition tinit3.F:45
xinit3
subroutine xinit3(elbuf_str, kxx, ixx, x, v, vr, xmas, xin, skew, dtelem, nel, stifn, stifr, partsav, ipartx, geo, itab, uix, xusr, vusr, vrusr, umass, uiner, ustifm, ustifr, uvism, uvisr, igeo, nft)
Definition xinit3.F:46
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:407