OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
resol.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!|| resol ../engine/source/engine/resol.F
25!||--- called by ------------------------------------------------------
26!|| resol_head ../engine/source/engine/resol_head.F
27!||--- calls -----------------------------------------------------
28!|| accdtdc ../engine/source/elements/thickshell/solidec/accdtdc.F
29!|| accel1 ../engine/source/tools/accele/accel1.F
30!|| accele ../engine/source/assembly/accele.F
31!|| accelepinch ../engine/source/assembly/accelepinch.F
32!|| add_elapsed_time_mon_off ../engine/source/system/timer.F
33!|| admdiv ../engine/source/model/remesh/admdiv.F
34!|| admerr ../engine/source/model/remesh/admerr.F
35!|| admfor0 ../engine/source/model/remesh/admfor0.F
36!|| admgvid ../engine/source/model/remesh/admgvid.F
37!|| admordr ../engine/source/model/remesh/admordr.F
38!|| admregul ../engine/source/model/remesh/admregul.F
39!|| admvit ../engine/source/model/remesh/admvit.F
40!|| agauge0 ../engine/source/ale/agauge.F
41!|| alefvm_accele ../engine/source/ale/alefvm/alefvm_accele.F
42!|| alefvm_main ../engine/source/ale/alefvm/alefvm_main.F
43!|| alemain ../engine/source/ale/alemain.f
44!|| alemuscl_deallocate ../engine/source/ale/alemuscl/alemuscl_deallocate.F
45!|| alesub2 ../engine/source/ale/subcycling/alesub2.F
46!|| alewdx ../engine/source/ale/grid/alewdx.F
47!|| alloc_elbuf_imp ../engine/source/elements/elbuf/alloc_elbuf_imp.F
48!|| allocate_sph_work ../common_source/modules/mat_elem/sph_work.f90
49!|| ams_prepare_poff_assembly ../engine/source/mpi/ams/spmd_sms.F
50!|| ancmsg ../engine/source/output/message/message.F
51!|| arret ../engine/source/system/arret.F
52!|| assign_ptrx ../common_source/modules/nodal_arrays.F90
53!|| assinit ../engine/source/assembly/assadd2.F
54!|| assinit_crkxfem ../engine/source/assembly/assadd2.F
55!|| assinit_pxfem ../engine/source/assembly/assadd2.F
56!|| asspar ../engine/source/assembly/asspar.F
57!|| asspar3 ../engine/source/assembly/asspar3.f
58!|| asspar4 ../engine/source/assembly/asspar4.F
59!|| asspar5 ../engine/source/assembly/asspar5.F
60!|| asspar_crk ../engine/source/elements/xfem/asspar_crk.F
61!|| asspar_sub ../engine/source/assembly/asspar_sub.F
62!|| asspar_sub_poff ../engine/source/assembly/asspar_sub_poff.F
63!|| asspart ../engine/source/assembly/asspart.F
64!|| assparxx ../engine/source/assembly/assparxx.F
65!|| bcs10 ../engine/source/constraints/general/bcs/bcs10.F
66!|| bcscyc ../engine/source/constraints/general/bcs/bcscyc.F
67!|| bcsdtth_copy ../engine/source/constraints/general/bcs/bcsdtth.F
68!|| bcsn ../engine/source/constraints/general/bcs/bcsn.F
69!|| bmultn ../engine/source/ale/bimat/bmultn.F
70!|| cfield_1 ../engine/source/loads/general/load_centri/cfield.F
71!|| check_ale_comm ../engine/source/ale/check_ale_comm.F
72!|| check_edge_state ../engine/source/interfaces/interf/check_edge_state.F
73!|| check_nan_acc ../engine/source/output/outfile/check_nan_acc.F
74!|| check_nodal_state ../engine/source/interfaces/interf/check_nodal_state.F
75!|| check_remote_surface_state ../engine/source/interfaces/interf/check_remote_surface_state.F
76!|| check_surface_state ../engine/source/interfaces/interf/check_surface_state.F
77!|| chkload ../engine/source/interfaces/chkload.F
78!|| chkmsin ../engine/source/output/outfile/chkmsin.F
79!|| chkstfn3n ../engine/source/interfaces/interf/chkstfn3.f
80!|| chkstifn ../engine/source/interfaces/inter2d/chkstifn.F
81!|| cjoint ../engine/source/constraints/general/cyl_joint/cjoint.f
82!|| close_sock_c ../engine/source/coupling/rad2rad/rad2rad_c.c
83!|| clusterf ../engine/source/output/cluster/clusterf.F
84!|| cnd_dmasi2 ../engine/source/elements/solid/solide10/s10cndf.F
85!|| cndint ../engine/source/model/remesh/cndint.F
86!|| cndordr ../engine/source/model/remesh/cndordr.F
87!|| collect ../engine/source/output/outfile/collect.F
88!|| collectm ../engine/source/output/outfile/collect.f
89!|| collectt ../engine/source/output/outfile/collect.F
90!|| convec ../engine/source/constraints/thermic/convec.F
91!|| coupling_advance ../engine/source/coupling/coupling_adapter.F90
92!|| coupling_finalize ../engine/source/coupling/coupling_adapter.F90
93!|| coupling_initialize ../engine/source/coupling/coupling_adapter.F90
94!|| coupling_ongoing ../engine/source/coupling/coupling_adapter.F90
95!|| coupling_set_interface ../engine/source/coupling/coupling_adapter.F90
96!|| coupling_sync ../engine/source/coupling/coupling_adapter.f90
97!|| cp_dm ../engine/source/implicit/produt_v.F
98!|| crk_accele ../engine/source/elements/xfem/accele_crk.F
99!|| crk_coord_ini ../engine/source/elements/xfem/crk_coord_ini.F
100!|| crk_vitesse ../engine/source/elements/xfem/crk_vitesse.F
101!|| crk_vitesse2 ../engine/source/elements/xfem/crk_vitesse2.F
102!|| crk_zero_accel ../engine/source/elements/xfem/crk_vitesse.F
103!|| crk_zero_fsky ../engine/source/elements/xfem/crk_vitesse.F
104!|| cumultime_mp ../engine/source/system/timer.f
105!|| damping ../engine/source/assembly/damping.F
106!|| damping44 ../engine/source/assembly/damping.F
107!|| damping51 ../engine/source/assembly/damping.f
108!|| damping_funct_ini ../engine/source/assembly/damping_funct_ini.F90
109!|| damping_vref_compute_dampa ../engine/source/assembly/damping_vref_compute_dampa.F90
110!|| dealloc_impbuf ../engine/source/implicit/imp_solv.F
111!|| dealloc_shoot_inter ../engine/source/interfaces/interf/dealloc_shoot_inter.F
112!|| deallocate_joint ../engine/source/constraints/general/cyl_joint/deallocate_joint.F
113!|| deallocm_imp ../engine/source/implicit/imp_solv.F
114!|| depla ../engine/source/assembly/depla.F
115!|| deplafakeige ../engine/source/assembly/deplafakeige.F
116!|| deplapinch ../engine/source/assembly/deplapinch.F
117!|| desacti ../engine/source/elements/desacti.F
118!|| disp_vel_saved_cload ../engine/source/assembly/disp_vel_saved_cload.F
119!|| dtnoda ../engine/source/time_step/dtnoda.F
120!|| dtnodamp ../engine/source/time_step/dtnodamp.F
121!|| dtnodams ../engine/source/time_step/dtnodams.F
122!|| dtnodarayl ../engine/source/time_step/dtnodarayl.F
123!|| ebcclap ../engine/source/boundary_conditions/ebcs/ebcclap.f
124!|| ebcs_extrapol ../engine/source/boundary_conditions/ebcs/ebcs_extrapol.F
125!|| elapstime ../engine/source/system/timer.F
126!|| ener_w0 ../engine/source/general_controls/damping/static.F
127!|| err_thk ../engine/source/elements/shell/err_thk.F
128!|| euldx ../engine/source/ale/grid/euldx.F
129!|| fail_wind_frwave_init ../engine/source/materials/fail/alter/fail_wind_frwave_init.F
130!|| fequilibre ../engine/source/elements/shell/fequilibre.F
131!|| find_dt_for_targeted_added_mass ../engine/source/time_step/find_dt_for_targeted_added_mass.F
132!|| find_edge_inter ../engine/source/interfaces/interf/find_edge_inter.f
133!|| find_surface_inter ../engine/source/interfaces/interf/find_surface_inter.F
134!|| fixfingeo ../engine/source/constraints/general/impvel/fixfingeo.F
135!|| fixflux ../engine/source/constraints/thermic/fixflux.f
136!|| fixtemp ../engine/source/constraints/thermic/fixtemp.F
137!|| fixvel ../engine/source/constraints/general/impvel/fixvel.F
138!|| flow0 ../engine/source/fluid/flow0.F
139!|| flow1 ../engine/source/fluid/flow1.F
140!|| flow_accele ../engine/source/assembly/flow_accele.F
141!|| flow_depla ../engine/source/assembly/flow_depla.F
142!|| flow_vitesse ../engine/source/assembly/flow_vitesse.f
143!|| forani1 ../engine/source/output/anim/generate/forani1.F
144!|| forani2 ../engine/source/output/anim/generate/forani2.F
145!|| forani3 ../engine/source/output/anim/generate/forani3.F
146!|| force ../engine/source/loads/general/force.F90
147!|| forcefingeo ../engine/source/loads/general/forcefingeo.F
148!|| forcepinch ../engine/source/loads/general/forcepinch.F
149!|| forint ../engine/source/elements/forint.F
150!|| forintc ../engine/source/elements/forintc.F
151!|| forintp ../engine/source/elements/forintp.F
152!|| forints ../engine/source/elements/forints.F
153!|| free_pinch ../common_source/modules/pinchtype_mod.f
154!|| funct_python_update_elements ../engine/source/tools/curve/funct_python_update_elements.f90
155!|| fv_switch_crit ../engine/source/airbag/fvdim.F
156!|| fvbag0 ../engine/source/airbag/fvbag0.F
157!|| fvcopy ../engine/source/airbag/fvcopy.F
158!|| fvdim ../engine/source/airbag/fvdim.F
159!|| fvmesh0 ../engine/source/airbag/fvmesh0.F
160!|| fvrezone0 ../engine/source/airbag/fvrezone.F
161!|| fvstats ../engine/source/airbag/fvstats.F
162!|| fvupd0 ../engine/source/airbag/fvupd.F
163!|| fxbyfor ../engine/source/constraints/fxbody/fxbyfor.F
164!|| fxbypid ../engine/source/constraints/fxbody/fxbypid.F
165!|| fxbyvit ../engine/source/constraints/fxbody/fxbyvit.F
166!|| fxgrvcor ../engine/source/constraints/fxbody/fxgrvcor.F
167!|| get_fbuf_c ../engine/source/coupling/rad2rad/rad2rad_c.c
168!|| get_fbufdp_c ../engine/source/coupling/rad2rad/rad2rad_c.c
169!|| get_ibuf_c ../engine/source/coupling/rad2rad/rad2rad_c.c
170!|| get_neighbour_surface ../engine/source/interfaces/interf/get_neighbour_surface.F90
171!|| get_shmbuf_c ../engine/source/coupling/rad2rad/rad2rad_c.c
172!|| gravit ../engine/source/loads/general/grav/gravit.F
173!|| gravit_fvm_fem ../engine/source/loads/general/grav/gravit_fvm_fem.F
174!|| i14ist ../engine/source/interfaces/int14/i14ist.F
175!|| i14wfs ../engine/source/interfaces/int14/i14wfs.F
176!|| i18main_kine_1 ../engine/source/interfaces/int18/i18main_kine.F
177!|| i18main_kine_2 ../engine/source/interfaces/int18/i18main_kine.F
178!|| i24e2e_fictive_nodes_update ../engine/source/interfaces/int24/i24for3e.F
179!|| i24nitschfor3 ../engine/source/interfaces/int24/i24nitschfor3.f
180!|| i24pxfem ../engine/source/interfaces/int24/i24pxfem.F
181!|| imp_buck ../engine/source/implicit/imp_buck.F
182!|| imp_chkm ../engine/source/implicit/imp_solv.F
183!|| imp_dt2 ../engine/source/implicit/imp_dt.F
184!|| imp_fanie ../engine/source/implicit/imp_solv.F
185!|| imp_fanii ../engine/source/implicit/imp_solv.F
186!|| imp_fout ../engine/source/implicit/imp_solv.F
187!|| imp_restarcp ../engine/source/implicit/imp_sol_init.F
188!|| imp_sol_init ../engine/source/implicit/imp_sol_init.F
189!|| imp_solv ../engine/source/implicit/imp_solv.F
190!|| init_ghost_shells ../engine/source/engine/node_spliting/ghost_shells.F90
191!|| init_global_frontier_monvol ../engine/source/airbag/init_global_monvol_frontier.F90
192!|| init_i25_edge ../engine/source/interfaces/int25/init_i25_edge.F
193!|| init_interf_sorting_strategy ../engine/source/interfaces/init_interf_sorting_strategy.F
194!|| init_monvol_omp_structure ../engine/source/airbag/init_monvol_omp_structure.F90
195!|| init_nodal_state ../engine/source/interfaces/interf/init_nodal_state.F
196!|| init_trim ../engine/source/interfaces/intsort/init_trim.F
197!|| inivel_dt2 ../engine/source/loads/general/inivel/inivel_dt2.F90
198!|| inivel_start ../engine/source/loads/general/inivel/inivel_start.F90
199!|| inixfem ../engine/source/elements/xfem/inixfem.f
200!|| int18_alloc ../engine/source/interfaces/int18/int18_alloc.F
201!|| int18_law151_init ../engine/source/interfaces/int18/int18_law151_init.F
202!|| int18_law151_omp_accumulation ../engine/source/interfaces/int18/int18_law151_omp_accumulation.F
203!|| int18_law151_update ../engine/source/interfaces/int18/int18_law151_update.F
204!|| intal1 ../engine/source/ale/inter/intal1.F
205!|| inter_init_component ../engine/source/interfaces/generic/inter_init_component.F90
206!|| inter_nodal_areas ../engine/source/output/inter_nodal_areas.F
207!|| inter_struct_init ../engine/source/interfaces/generic/inter_struct_init.F
208!|| intfop1 ../engine/source/interfaces/interf/intfop1.F
209!|| intfop2 ../engine/source/interfaces/interf/intfop2.F
210!|| intfop8 ../engine/source/interfaces/interf/intfop8.F
211!|| intstamp_ass ../engine/source/interfaces/int21/intstamp_ass.F
212!|| intstamp_dt ../engine/source/interfaces/int21/intstamp_dt.F
213!|| intstamp_init ../engine/source/interfaces/int21/intstamp_init.F
214!|| intstamp_move ../engine/source/interfaces/int21/intstamp_move.F
215!|| intti1 ../engine/source/interfaces/interf/intti1.F
216!|| intti2 ../engine/source/interfaces/interf/intti2.F
217!|| inttri ../engine/source/interfaces/intsort/inttri.F
218!|| joint_block_stiffness ../engine/source/elements/joint/joint_block_stiffness.F
219!|| joint_elem_timestep ../engine/source/elements/joint/joint_elem_timestep.F
220!|| kine_seatbelt_force ../engine/source/tools/seatbelts/kine_seatbelt_force.F
221!|| kine_seatbelt_vel ../engine/source/tools/seatbelts/kine_seatbelt_vel.F
222!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
223!|| lag_multp ../engine/source/tools/lagmul/lag_mult.F
224!|| load_pressure ../engine/source/loads/general/load_pressure/load_pressure.F
225!|| manctr ../engine/source/input/manctr.F
226!|| modsti ../engine/source/time_step/modsti.F
227!|| monvol0 ../engine/source/airbag/monvol0.F
228!|| movfra1 ../engine/source/tools/skew/movfram.F
229!|| movfra2 ../engine/source/tools/skew/movfram.F
230!|| movfra_imp ../engine/source/tools/skew/movfram.F
231!|| mpi_min_real_begin ../engine/share/modules/mpi_tools_mod.F
232!|| mpi_min_real_end ../engine/share/modules/mpi_tools_mod.F
233!|| multi_deallocate ../engine/source/multifluid/multi_deallocate.F
234!|| multi_velocity_backup ../engine/source/multifluid/multi_velocity_backup.F
235!|| mvoludt ../engine/source/airbag/mvoludt.F
236!|| my_barrier ../engine/source/system/machine.F
237!|| newskw ../engine/source/tools/skew/newskw.F
238!|| newskw_init ../engine/source/tools/skew/newskw.F
239!|| nlocal_acc ../engine/source/assembly/nlocal_acc.F
240!|| nlocal_dtnoda ../engine/source/time_step/nlocal_dtnoda.F
241!|| nlocal_incr ../engine/source/assembly/nlocal_incr.F
242!|| nlocal_vel ../engine/source/assembly/nlocal_vel.F
243!|| offset_nproj ../engine/source/interfaces/shell_offset/offset_nproj.F90
244!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
245!|| omp_set_num_threads ../engine/source/engine/openmp_stub.F90
246!|| output_allocate_noda_pext ../common_source/modules/output/output_mod.F90
247!|| output_deallocate_noda_pext ../common_source/modules/output/output_mod.F90
248!|| pblast_deallocate ../common_source/modules/loads/pblast_mod.F90
249!|| pblast_load_computation ../engine/source/loads/pblast/pblast.F
250!|| pfluid ../engine/source/loads/general/pfluid/pfluid.F
251!|| ply_accele ../engine/source/assembly/ply_accele.F
252!|| ply_bcs ../engine/source/constraints/general/bcs/ply_bcs.F
253!|| ply_vitesse ../engine/source/assembly/ply_vitesse.F
254!|| poro ../engine/source/ale/porous/poro.F
255!|| prepare_debug ../engine/share/modules/debug_mod.F
256!|| prerbe3p0 ../engine/source/constraints/general/rbe3/rbe3f.F
257!|| pressure_cyl ../engine/source/loads/general/load_pcyl/pressure_cyl.F
258!|| printime ../engine/source/system/timer.F
259!|| printime_interf ../engine/source/system/timer_interf.F
260!|| printimeg ../engine/source/system/timer.F
261!|| python_monvol ../engine/source/coupling/python/python_monvol.F90
262!|| python_register ../engine/source/tools/curve/python_register.F90
263!|| python_share_memory ../engine/source/coupling/python/python_share_memory.F90
264!|| python_update_nodal_entities ../common_source/modules/python_mod.F90
265!|| r2r_block_c ../engine/source/coupling/rad2rad/rad2rad_c.c
266!|| r2r_exchange ../engine/source/coupling/rad2rad/r2r_exchange.F
267!|| r2r_getdata ../engine/source/coupling/rad2rad/r2r_getdata.f
268!|| r2r_sem_c ../engine/source/coupling/rad2rad/rad2rad_c.c
269!|| r2r_sendkine ../engine/source/coupling/rad2rad/r2r_getdata.F
270!|| r2r_unlock_threads_c ../engine/source/coupling/rad2rad/rad2rad_c.c
271!|| radiation ../engine/source/constraints/thermic/radiation.F
272!|| radiossviper_receiveaccelerations ../engine/source/coupling/viper/viper_interface_mod.f90
273!|| radiossviper_receivesenddt ../engine/source/coupling/viper/viper_interface_mod.F90
274!|| radiossviper_sendkill ../engine/source/coupling/viper/viper_interface_mod.F90
275!|| radiossviper_sendxve ../engine/source/coupling/viper/viper_interface_mod.F90
276!|| rbagdt ../engine/source/airbag/rbagdt.F
277!|| rbe2cor ../engine/source/constraints/general/rbody/rgbcor.F
278!|| rbe2t1 ../engine/source/constraints/general/rbe2/rbe2f.F
279!|| rbe2v ../engine/source/constraints/general/rbe2/rbe2v.F
280!|| rbe3t1 ../engine/source/constraints/general/rbe3/rbe3f.f
281!|| rbe3v ../engine/source/constraints/general/rbe3/rbe3v.F
282!|| rbycor ../engine/source/constraints/general/rbody/rbycor.f
283!|| rbyfor ../engine/source/constraints/general/rbody/rbyfor.F
284!|| rbysens ../engine/source/constraints/general/rbody/rbyonf.F
285!|| rbyvit ../engine/source/constraints/general/rbody/rbyvit.F
286!|| re2int5 ../engine/source/implicit/imp_solv.f
287!|| re2int7 ../engine/source/implicit/imp_solv.F
288!|| reaction_forces_1 ../engine/source/output/reactions.F
289!|| reaction_forces_2 ../engine/source/output/reactions.F
290!|| reaction_forces_3 ../engine/source/output/reactions.F
291!|| reaction_forces_check_for_requested_output ../engine/source/output/reactions.F
292!|| reaction_forces_th ../engine/source/output/reaction_forces_th.F
293!|| reallocate_i_skyline ../engine/source/system/reallocate_skyline.F
294!|| renum_siz ../engine/source/interfaces/interf/renum_siz.F
295!|| resol_init ../engine/source/engine/resol_init.f
296!|| rgwal0 ../engine/source/constraints/general/rwall/rgwal0.F
297!|| rgwalf ../engine/source/constraints/general/rwall/rgwal0.f
298!|| rivet1 ../engine/source/elements/rivet/rivet1.F
299!|| rlink10 ../engine/source/constraints/general/rlink/rlink10.F
300!|| rlink11 ../engine/source/constraints/general/rlink/rlink10.F
301!|| rmatacce ../engine/source/materials/mat/mat013/rmatacce.F
302!|| rmatforp ../engine/source/materials/mat/mat013/rmatforp.F
303!|| s10cndf1 ../engine/source/elements/solid/solide10/s10cndf.F
304!|| s10cndf2 ../engine/source/elements/solid/solide10/s10cndf.F
305!|| s10cndfnd ../engine/source/elements/solid/solide10/s10cndf.F
306!|| s10cndi2a ../engine/source/elements/solid/solide10/s10cndv.f
307!|| s10cndi2a1 ../engine/source/elements/solid/solide10/s10cndv.F
308!|| s10cndv ../engine/source/elements/solid/solide10/s10cndv.F
309!|| s10getvdm ../engine/source/elements/solid/solide10/s10cndv.F
310!|| s10stfe_poff ../engine/source/elements/solid/solide10/s10cndf.F
311!|| s4lagsfem ../engine/source/elements/solid/solide4_sfem/s4lagsfem.F
312!|| sav_buf_point ../engine/source/user_interface/eng_callback_c.c
313!|| section_fio ../engine/source/tools/sect/section_fio.F
314!|| section_io ../engine/source/tools/sect/section_io.F
315!|| send_fbuf_c ../engine/source/coupling/rad2rad/rad2rad_c.c
316!|| send_fbufdp_c ../engine/source/coupling/rad2rad/rad2rad_c.c
317!|| send_ibuf_c ../engine/source/coupling/rad2rad/rad2rad_c.c
318!|| sensor_base ../engine/source/tools/sensor/sensor_base.F
319!|| sensor_dist_surf0 ../engine/source/tools/sensor/sensor_dist_surf0.F
320!|| sensor_ener_sav ../engine/source/tools/sensor/sensor_ener_sav.F
321!|| sensor_init ../engine/source/tools/sensor/sensor_init.F
322!|| sensor_logical ../engine/source/tools/sensor/sensor_logical.f
323!|| sensor_spmd ../engine/source/tools/sensor/sensor_spmd.F
324!|| sensor_temp0 ../engine/source/tools/sensor/sensor_temp0.F
325!|| smp_init ../engine/source/engine/resol_init.F
326!|| sms_build_mat_2 ../engine/source/ams/sms_build_mat_2.F
327!|| sms_encin_2 ../engine/source/ams/sms_encin_2.F
328!|| sms_ini_err ../engine/source/ams/sms_init.F
329!|| sms_ini_int ../engine/source/ams/sms_init.F
330!|| sms_ini_jad_1 ../engine/source/ams/sms_init.F
331!|| sms_ini_jad_2 ../engine/source/ams/sms_init.F
332!|| sms_ini_jad_3 ../engine/source/ams/sms_init.F
333!|| sms_ini_kad ../engine/source/ams/sms_init.F
334!|| sms_ini_kdi ../engine/source/ams/sms_init.F
335!|| sms_ini_kin_2 ../engine/source/ams/sms_init.F
336!|| sms_ini_part ../engine/source/ams/sms_init.F
337!|| sms_ini_rby ../engine/source/ams/sms_init.F
338!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
339!|| soltospha ../engine/source/elements/sph/soltospha.F
340!|| soltosphf ../engine/source/elements/sph/soltosph.F
341!|| sortie_error ../engine/source/output/sortie_error.F
342!|| sortie_main ../engine/source/output/sortie_main.f
343!|| spgauge_f ../engine/source/elements/sph/spgauge.F
344!|| sphprep ../engine/source/elements/sph/sphprep.f
345!|| sphres44b ../engine/source/elements/sph/sphres44b.F
346!|| splissv ../engine/source/elements/sph/splissv.F
347!|| split_asspar4 ../engine/source/assembly/split_asspar4.F
348!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.f
349!|| spmd_barrier ../engine/source/mpi/spmd_mod.F90
350!|| spmd_chkw ../engine/source/mpi/generic/spmd_chkw.F
351!|| spmd_collect ../engine/source/mpi/output/spmd_collect.F
352!|| spmd_collect_multi_fvm ../engine/source/mpi/output/spmd_collect_multi_fvm.F
353!|| spmd_collect_nlocal ../engine/source/mpi/output/spmd_collect_nlocal.F
354!|| spmd_collectm ../engine/source/mpi/output/spmd_collectm.F
355!|| spmd_collectt ../engine/source/mpi/output/spmd_collectt.F
356!|| spmd_crk_adv ../engine/source/elements/xfem/xfemfsky.F
357!|| spmd_exch2_a_pon ../engine/source/mpi/forces/spmd_exch2_a_pon.F
358!|| spmd_exch_a ../engine/source/mpi/forces/spmd_exch_a.F
359!|| spmd_exch_a_ams_poff ../engine/source/mpi/forces/spmd_exch_a_ams_poff.F
360!|| spmd_exch_crkvel ../engine/source/mpi/elements/spmd_xfem.F
361!|| spmd_exch_da20 ../engine/source/mpi/interfaces/spmd_exch_da20.F
362!|| spmd_exch_deleted_surf_edge ../engine/source/mpi/interfaces/spmd_exch_deleted_surf_edge.F
363!|| spmd_exch_efric ../engine/source/mpi/interfaces/spmd_exch_efric.F
364!|| spmd_exch_fa ../engine/source/mpi/elements/spmd_exch_dttsh.F
365!|| spmd_exch_i24 ../engine/source/mpi/interfaces/spmd_exch_i24.F
366!|| spmd_exch_i25 ../engine/source/mpi/interfaces/spmd_exch_i25.F
367!|| spmd_exch_icodt ../engine/source/mpi/nodes/spmd_exch_icodt.F
368!|| spmd_exch_icont ../engine/source/mpi/nodes/spmd_exch_icont.F
369!|| spmd_exch_inter_18 ../engine/source/mpi/interfaces/spmd_exch_inter_18.F
370!|| spmd_exch_press ../engine/source/mpi/interfaces/spmd_exch_press.F
371!|| spmd_exch_r2r_sph ../engine/source/mpi/r2r/spmd_r2r.F
372!|| spmd_exch_r2r_sphoff ../engine/source/mpi/r2r/spmd_r2r.F
373!|| spmd_exch_sec ../engine/source/mpi/sections/spmd_section.F
374!|| spmd_exch_sub_poff ../engine/source/mpi/spmd_exch_sub.F
375!|| spmd_exch_sub_pon ../engine/source/mpi/spmd_exch_sub.F
376!|| spmd_exch_tagncont ../engine/source/mpi/forces/spmd_exch_tagncont.F
377!|| spmd_exch_thknod ../engine/source/mpi/nodes/spmd_exch_thknod.F
378!|| spmd_exch_vmax ../engine/source/mpi/elements/spmd_exch_dttsh.F
379!|| spmd_exch_wave ../engine/source/mpi/nodes/spmd_exch_wave.F
380!|| spmd_exsum_fb6 ../engine/source/mpi/generic/spmd_exsum_fb6.F
381!|| spmd_flush_accel ../engine/source/mpi/output/spmd_flush_accel.F
382!|| spmd_fvb_switch ../engine/source/mpi/airbags/spmd_fvb_switch.F
383!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
384!|| spmd_glob_min5 ../engine/source/mpi/generic/spmd_glob_min5.F
385!|| spmd_glob_minv ../engine/source/mpi/generic/spmd_glob_minv.F
386!|| spmd_i21fthecom ../engine/source/mpi/interfaces/send_cand.F
387!|| spmd_i21tempcom ../engine/source/mpi/interfaces/send_cand.F
388!|| spmd_i24_prepare ../engine/source/interfaces/int24/i24_prepare.F
389!|| spmd_i25_prepare ../engine/source/interfaces/int25/i25_prepare.F
390!|| spmd_i25front_init ../engine/source/mpi/interfaces/spmd_i25front.F
391!|| spmd_i7fcom_poff ../engine/source/mpi/forces/spmd_i7fcom_poff.F
392!|| spmd_i7fcom_pon ../engine/source/mpi/forces/spmd_i7fcom_pon.F
393!|| spmd_i7xvcom2 ../engine/source/mpi/interfaces/spmd_i7xvcom2.F
394!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
395!|| spmd_int18_law151_pon ../engine/source/mpi/forces/spmd_int18_law151_pon.F
396!|| spmd_max_xfe_i ../engine/source/mpi/elements/spmd_xfem.F
397!|| spmd_mumps_ini ../engine/source/mpi/implicit/imp_spmd.F
398!|| spmd_nlist_sms ../engine/source/mpi/ams/spmd_sms.F
399!|| spmd_rbcast ../engine/source/mpi/generic/spmd_rbcast.F
400!|| spmd_sd_xv ../engine/source/mpi/nodes/spmd_sd_xv.F
401!|| spmd_sort_sms ../engine/source/mpi/ams/spmd_sms.F
402!|| spmd_wiout ../engine/source/mpi/generic/spmd_wiout.F
403!|| spmd_xv_inter_type1 ../engine/source/mpi/nodes/spmd_sd_xv_inter1.F90
404!|| sponfv ../engine/source/elements/sph/sponfv.F
405!|| spwfvis ../engine/source/elements/sph/spwfvis.F
406!|| srfvit ../engine/source/constraints/general/rbody/srfvit.F
407!|| startime ../engine/source/system/timer_mod.F90
408!|| static ../engine/source/general_controls/damping/static.F
409!|| stop_sensor ../engine/source/tools/sensor/stop_sensor.F
410!|| stoptime ../engine/source/system/timer_mod.F90
411!|| tagoff3n ../engine/source/interfaces/interf/chkstfn3.F
412!|| tempur ../engine/source/constraints/thermic/tempur.F
413!|| th_time_output ../engine/source/output/th/th_time_output.F
414!|| thbcs ../engine/source/output/th/thbcs.F
415!|| thbcs_imp ../engine/source/output/th/thbcs_imp.F
416!|| thermbilan ../engine/source/constraints/thermic/thermbilan.F
417!|| thickvar ../engine/source/elements/shell/coque/thickvar.F
418!|| timfun ../engine/source/tools/curve/timfun.F
419!|| trace_in ../engine/source/system/trace_back.F
420!|| trace_out ../engine/source/system/trace_back.F
421!|| upd_tmax ../engine/source/output/upd_outmax.F
422!|| update_failwave ../engine/source/materials/fail/failwave/update_failwave.F
423!|| update_slipring ../engine/source/tools/seatbelts/update_slipring.F
424!|| upenr_crk ../engine/source/elements/xfem/upenr_crk.F
425!|| upgrade_rem_2ry ../engine/source/mpi/interfaces/spmd_i7tool.F
426!|| upxfem1 ../engine/source/elements/xfem/upxfem1.F
427!|| upxfem2 ../engine/source/elements/xfem/upxfem2.F
428!|| upxfem_tagxp ../engine/source/elements/xfem/upxfem_tagxp.F
429!|| user_windows_routine ../engine/source/user_interface/user_windows.F
430!|| viper_coupling_initialize ../engine/source/coupling/viper/viper_interface_mod.F90
431!|| vitesse ../engine/source/assembly/vitesse.F
432!|| vitessepinch ../engine/source/assembly/vitessepinch.F
433!|| wrrestp ../engine/source/output/restart/wrrestp.F
434!|| xfeoff ../engine/source/elements/xfem/xfeoff.F
435!|| zero1 ../engine/source/system/zero.F
436!|| zeror ../engine/source/system/zero.f
437!||--- uses -----------------------------------------------------
438!|| acceleration_dp_mod ../engine/share/modules/acceleration_dp_mod.F
439!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
440!|| ale_mod ../common_source/modules/ale/ale_mod.F
441!|| aleanim_mod ../engine/share/modules/aleanim_mod.F
442!|| aleflow_mod ../engine/share/modules/aleflow_mod.F
443!|| alefvm_mod ../common_source/modules/ale/alefvm_mod.F
444!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
445!|| ams_work_mod ../engine/source/modules/ams_work_mod.F90
446!|| anim_mod ../common_source/modules/output/anim_mod.F
447!|| array_mod ../common_source/modules/array_mod.F
448!|| bcs_mod ../common_source/modules/boundary_conditions/bcs_mod.F90
449!|| check_mod ../common_source/modules/check_mod.F
450!|| cluster_mod ../engine/share/modules/cluster_mod.F
451!|| connectivity_mod ../common_source/modules/connectivity.F90
452!|| coupling_adapter_mod ../engine/source/coupling/coupling_adapter.F90
453!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
454!|| damping_funct_ini_mod ../engine/source/assembly/damping_funct_ini.F90
455!|| damping_vref_compute_dampa_mod ../engine/source/assembly/damping_vref_compute_dampa.F90
456!|| debug_chksm_mod ../engine/source/mpi/output/spmd_flush_accel.F
457!|| debug_mod ../engine/share/modules/debug_mod.F
458!|| detach_node_mod ../engine/source/engine/node_spliting/detach_node.F90
459!|| diffusion_mod ../engine/share/modules/diffusion_mod.F
460!|| drape_mod ../engine/share/modules/drape_mod.F
461!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
462!|| dt_mod ../engine/source/modules/dt_mod.F
463!|| dtdc_mod ../engine/share/modules/dtdc_mod.F
464!|| dynlib_mod ../engine/share/modules/dynlib_mod.F
465!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
466!|| ecnd_mod ../engine/share/modules/ecdn_mod.F
467!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
468!|| error_mod ../engine/share/modules/error_mod.F
469!|| failwave_mod ../common_source/modules/failwave_mod.F
470!|| force_mod ../engine/source/loads/general/force.F90
471!|| funct_python_update_elements_mod ../engine/source/tools/curve/funct_python_update_elements.F90
472!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
473!|| get_neighbour_surface_mod ../engine/source/interfaces/interf/get_neighbour_surface.F90
474!|| ghost_shells_mod ../engine/source/engine/node_spliting/ghost_shells.F90
475!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
476!|| groupdef_mod ../common_source/modules/groupdef_mod.F
477!|| h3d_mod ../engine/share/modules/h3d_mod.F
478!|| heat_mod ../engine/share/modules/heat_mod.F
479!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
480!|| i22edge_mod ../common_source/modules/interfaces/cut-cell-buffer_mod.F
481!|| i22tri_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
482!|| icontact_mod ../engine/share/modules/icontact_mod.F
483!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
484!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
485!|| init_global_frontier_monvol_mod ../engine/source/airbag/init_global_monvol_frontier.F90
486!|| init_monvol_omp_structure_mod ../engine/source/airbag/init_monvol_omp_structure.F90
487!|| inivel_dt2_mod ../engine/source/loads/general/inivel/inivel_dt2.F90
488!|| inivel_start_mod ../engine/source/loads/general/inivel/inivel_start.F90
489!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
490!|| inter_init_component_mod ../engine/source/interfaces/generic/inter_init_component.F90
491!|| inter_sh_offset_mod ../engine/source/modules/interfaces/sh_offset_mod.F90
492!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
493!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
494!|| interface_table_mod ../engine/share/modules/table_mod.F
495!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
496!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
497!|| loads_mod ../common_source/modules/loads/loads_mod.F90
498!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
499!|| mds_restart_mod ../common_source/modules/mds_rest.mod.F
500!|| message_mod ../engine/share/message_module/message_mod.F
501!|| monvol_struct_mod ../engine/share/modules/monvol_struct_mod.F
502!|| mpi_tools_mod ../engine/share/modules/mpi_tools_mod.F
503!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
504!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
505!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
506!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.f
507!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
508!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
509!|| offset_nproj_mod ../engine/source/interfaces/shell_offset/offset_nproj.F90
510!|| outmax_mod ../common_source/modules/outmax_mod.F
511!|| output_mod ../common_source/modules/output/output_mod.F90
512!|| outputs_mod ../common_source/modules/outputs_mod.F
513!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
514!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
515!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
516!|| python_funct_mod ../common_source/modules/python_mod.F90
517!|| python_monvol_mod ../engine/source/coupling/python/python_monvol.F90
518!|| python_register_mod ../engine/source/tools/curve/python_register.F90
519!|| python_share_memory_mod ../engine/source/coupling/python/python_share_memory.F90
520!|| rad2r_mod ../engine/share/modules/rad2r.F
521!|| rbe3_mod ../common_source/modules/constraints/rbe3_mod.F90
522!|| remesh_mod ../engine/share/modules/remesh_mod.F
523!|| resolsav_mod ../engine/share/modules/resol_mod.F
524!|| rigmat_mod ../engine/share/modules/rigmat_mod.F
525!|| seatbelt_mod ../common_source/modules/seatbelt_mod.F
526!|| segvar_mod ../engine/share/modules/segvar_mod.F
527!|| sensor_mod ../common_source/modules/sensor_mod.F90
528!|| shooting_node_mod ../engine/share/modules/shooting_node_mod.F
529!|| skew_mod ../common_source/modules/skew_mod.F90
530!|| sms_mod ../engine/share/modules/sms_mod.F
531!|| sms_pcg_proj ../engine/share/modules/sms_mod.F
532!|| sph_work_mod ../common_source/modules/mat_elem/sph_work.F90
533!|| spmd_mod ../engine/source/mpi/spmd_mod.F90
534!|| spmd_xv_inter_type1_mod ../engine/source/mpi/nodes/spmd_sd_xv_inter1.F90
535!|| stack_mod ../engine/share/modules/stack_mod.F
536!|| state_mod ../common_source/modules/state_mod.F
537!|| table_mod ../engine/share/modules/table_mod.F
538!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
539!|| thgrelem_mod ../engine/share/modules/thgrelem_mod.F
540!|| thk_mod ../engine/share/modules/thk_mod.F
541!|| threac_mod ../engine/share/modules/threac_mod.F
542!|| time_mod ../engine/share/modules/time_mod.F
543!|| timer_mod ../engine/source/system/timer_mod.F90
544!|| unitab_mod ../common_source/modules/unitab_mod.f
545!|| update_pon_mod ../engine/source/engine/node_spliting/update_pon.F90
546!|| user_windows_mod ../common_source/modules/user_windows_mod.F
547!|| viper_mod ../engine/source/coupling/viper/viper_interface_mod.F90
548!|| xfem2vars_mod ../engine/share/modules/xfem2vars_mod.F
549!||====================================================================
550 SUBROUTINE resol(TIMERS, ELEMENT, NODES, coupling, AF,IAF,
551 1 ISKWN ,NETH ,IPART ,NOM_OPT,KXX ,IXX ,
552 2 IXTG ,IXS ,IXQ ,IXT ,IXP ,IXR ,
553 3 IFILL ,MAT_ELEM,
554 4 IMS ,NPC ,IBCL ,
555 5 IBFV ,IDUM ,LAS ,LACCELM,NNLINK ,LNLINK ,
556 6 IPARG ,DD_IAD ,IGRV ,IEXLNK ,KINET ,
557 7 IPARI , NPRW ,ICONX ,NPBY ,
558 8 LPBY ,LRIVET ,NSTRF ,LJOINT ,NODPOR ,MONVOL ,
559 9 ILINK ,
560 A LLINK ,LINALE ,NEFLSW ,NNFLSW ,ICUT ,CLUSTER,
561 B ITASK ,INOISE ,
562 C THKE ,DAMP ,
563 D PM ,SKEWS ,GEO ,EANI ,BUFMAT ,BUFGEO ,BUFSF ,
564 E W ,VEUL ,FILL ,DFILL ,ALPH ,WB ,DSAVE ,ASAVE ,
565 . MSNF ,
566 F TF ,FORC ,VEL ,FSAV ,FZERO ,XLAS ,ACCELM ,
567 G AGRV ,FR_WAVE,FAILWAVE,PARTS0 ,ELBUF ,RWBUF ,SENSORS,
568 H RWSAV ,RBY ,RIVET ,SECBUF ,VOLMON ,LAMBDA ,
569 I WA ,FV ,PARTSAV
570 J ,UWA ,VAL2 ,PHI ,SEGVAR ,R ,CRFLSW ,
571 K FLSW ,FANI ,XCUT ,ANIN ,TANI ,SECFCUM,BUFNOIS,
572 L IDATA ,RDATA ,
573 M IFRAME ,KXSP ,IXSP ,NOD2SP ,ISPSYM ,ISPCOND,
574 N XFRAME ,SPBUF ,XSPSYM ,VSPSYM ,PV ,
575 O FSAVD ,IBVEL ,LBVEL ,WASPH ,W16 ,
576 P ISPHIO ,LPRTSPH,LONFSPH ,VSPHIO ,FBVEL ,LAGBUF ,IBCSLAG,
577 Q IACTIV ,DAMPR ,GJBUFI ,GJBUFR , RBMPC , IBMPC ,SPHVELN,
578 T NBRCVOIS,NBSDVOIS,LNRCVOIS,LNSDVOIS,NERCVOIS,NESDVOIS,LERCVOIS,
579 U LESDVOIS,NPSEGCOM,LSEGCOM ,NPORGEO ,
580 V IXTG1 ,NPBYL ,LPBYL ,RBYL ,IGEO ,IPM ,
581 W MADPRT ,MADSH4 ,MADSH3 ,MADSOL ,MADNOD ,MADFAIL ,
582 X IAD_RBY ,FR_RBY ,FR_WALL ,IAD_RBY2,
583 Y FR_RBY2 ,IAD_I2M ,FR_I2M ,ADDCNI2 ,PROCNI2 ,IADI2 ,FR_MV ,
584 Z IADMV2 ,FR_LL ,FR_RL ,IADCJ ,
585 a FR_CJ ,FR_SEC ,
586 b IAD_SEC ,IAD_CUT ,FR_CUT ,RG_CUT ,NEWFRONT,FR_MAD ,
587 c FXBIPM ,FXBRPM ,FXBNOD ,FXBMOD ,FXBGLM ,FXBCPM ,FXBCPS ,
588 d FXBLM ,FXBFLS ,FXBDLS ,FXBDEP ,FXBVIT ,FXBACC ,FXBELM ,
589 e FXBSIG ,FXBGRVI ,FXBGRVR ,EIGIPM ,EIGIBUF ,EIGRPM ,
590 f LNODPOR ,
591 g FR_I18 ,GRAPHE ,IFLOW ,RFLOW ,
592 h LGRAV ,DD_R2R ,FASOLFR ,FR_LAGF ,
593 j LLAGF ,LPRW ,ICONTACT,RCONTACT,SH4TREE ,SH3TREE ,
594 k IPADMESH,PADMESH ,MSC ,MSTG ,INC ,INTG ,PTG ,
595 l ISKWP ,NSKWP ,ISENSP ,NSENSP ,IACCP ,NACCP,IPART_STATE,
596 m ACONTACT,PCONTACT,FACTIV
597 p ,SH4TRIM ,SH3TRIM ,MSCND ,INCND ,
598 q IBFFLUX ,FBFFLUX ,RBYM ,IRBYM ,LNRBYM ,ICODRBYM,
599 r IBCV ,FCONV ,IBFTEMP ,FBFTEMP ,IAD_RBYM,FR_RBYM,
600 t WEIGHT_RM,MS_PLY,ZI_PLY,INOD_PXFEM,IEL_PXFEM,IADC_PXFEM,
601 u ADSKY_PXFEM,ICODE_PLY,ICODT_PLY,ISKEW_PLY ,ADMSMS ,
602 v MADCLNOD,NOM_SECT,MCPC ,MCPTG ,DMELC ,DMELTG ,MSSA ,
603 w DMELS ,MSTR ,DMELTR ,MSP ,DMELP ,MSRT ,DMELRT ,
604 x IBCR ,FRADIA ,RES_SMS ,TABLE ,IRBE2 ,LRBE2 ,IAD_RBE2 ,
605 y FR_RBE2 ,PHIE ,MSF ,
606 z PROCNE_PXFEM ,IADSDP_PXFEM,IADRCP_PXFEM,ICFIELD,LCFIELD,CFIELD,
607 1 MSZ2 ,DIAG_SMS,ILOADP ,LLOADP ,LOADP ,
608 2 INOD_CRK,IEL_CRK ,IADC_CRK,ADSKY_CRK,
609 3 CNE_CRK,PROCNE_CRK,IADSDP_CRK,IADRCP_CRK, IBUFSSG_IO,
610 4 IBC_PLY ,DMINT2 ,IBORDNODE,
611 5 ELBUF_TAB,POR ,NODEDGE ,IAD_EDGE,
612 6 FR_EDGE ,FR_NBEDGE,CRKNODIAD,LGAUGE ,GAUGE ,
613 7 IGAUP ,NGAUP ,NODLEVXF,DD_R2R_ELEM,
614 8 NODGLOBXFE,SPH2SOL ,SOL2SPH ,IRST ,
615 9 DMSPH ,WAGAP ,XFEM_TAB,ELCUTC ,NODENR ,
616 A KXFENOD2ELC,ENRTAG,
617 B RTHBU F,KXIG3D ,IXIG3D ,KNOT, WIGE,
618 C WSMCOMP,STACK,
619 D CPUTIME_MP_GLOB, CPUTIME_MP ,TAB_UMP,POIN_UMP ,SOL2SPH_TYP,
620 E IRUNN_BIS,ADDCSRECT, IAD_FRNOR,FR_NOR ,PROCNOR,
621 F IAD_FREDG,FR_EDG ,DRAPE_SH4N , DRAPE_SH3N ,TAB_MAT,
622 G NATIV0_SMS,MULTI_FVM,SEGQUADFR,MS_2D ,
623 H H3D_DATA ,SUBSETS,IGRNOD,IGRBRIC,
624 I IGRQUAD,IGRSH4N,IGRSH3N,IGRTRUSS,IGRBEAM,
625 J IGRSPRING,IGRPART,IGRSURF,FORNEQS,
626 K NLOC_DMG ,ISKWP_L,KNOTLOCPC,KNOTLOCEL,PINCH_DATA,TAG_SKINS6, ALE_CONNECTIVITY,
627 L XCELL, XFACE, NE_NERCVOIS, NE_NESDVOIS, NE_LERCVOIS, NE_LESDVOIS,IBCSCYC ,LBCSCYC,
628 M T_MONVOL,ID_GLOBAL_VOIS,FACE_VOIS,DYNAIN_DATA,FCONT_MAX,EBCS_TAB,DIFFUSION,
629 N KLOADPINTER,LOADPINTER,DGAPLOADINT,DRAPEG,USER_WINDOWS,OUTPUT,INTERFACES,
630 O DT ,LOADS , PYTHON, DPL0CLD,VEL0CLD,
631 P NDAMP_VREL,ID_DAMP_VREL,FR_DAMP_VREL,NDAMP_VREL_RBYG,NAMES_AND_TITLES,UNITAB,LIFLOW,LRFLOW ,
632 R GLOB_THERM ,PBLAST,RBE3)
633C-----------------------------------------------
634C M o d u l e s
635C-----------------------------------------------
636 USE ghost_shells_mod
637 USE connectivity_mod
638 USE nodal_arrays_mod
639 USE detach_node_mod
640 USE dsgraph_mod
641 USE error_mod
642 USE resolsav_mod
643 USE icontact_mod
644 USE remesh_mod
645 USE heat_mod
646 USE sms_mod
647 USE sms_pcg_proj
648 USE thk_mod
649 USE intstamp_glob_mod
650 USE rigmat_mod
651 USE plyxfem_mod
652 USE threac_mod
653 USE thgrelem_mod
654 USE table_mod
655 USE interface_table_mod
656 USE aleflow_mod
657 USE rad2r_mod
658 USE imp_intbuf
659 USE message_mod
660 USE crackxfem_mod
661 USE i22bufbric_mod
662 USE i22edge_mod
663 USE cluster_mod
664 USE intbufdef_mod
665 USE xfem2vars_mod
666 USE stack_mod
667 USE alefvm_mod
668 USE i22tri_mod
669 USE fvbag_mod
670 USE mpi_tools_mod
671 USE alemuscl_mod
672 USE ecnd_mod
673 USE multi_fvm_mod
674 USE h3d_mod
675 USE pblast_mod
676 USE groupdef_mod
677 USE failwave_mod
678 USE nlocal_reg_mod
679 USE mat_elem_mod
680 USE time_mod
681 USE pinchtype_mod
682 USE check_mod
683 USE acceleration_dp_mod
684 USE ale_connectivity_mod
685 USE aleanim_mod
686 USE dynlib_mod
687 USE monvol_struct_mod
688 USE drape_mod
689 USE sensor_mod
690 USE mds_restart_mod
691 USE ebcs_mod
692 USE seatbelt_mod
693 USE diffusion_mod
694 USE segvar_mod
695 USE dtdc_mod
696 USE impbufdef_mod
697 USE inter_struct_mod
698 USE inter_sorting_mod
699 USE shooting_node_mod
700 USE anim_mod
701 USE outputs_mod
702 USE loads_mod
703 USE state_mod
704 USE user_windows_mod
705 USE ale_mod
706 USE output_mod , ONLY : output_
707 USE output_mod , ONLY : noda_pext, noda_surf, output_allocate_noda_pext, output_deallocate_noda_pext
708 USE interfaces_mod
709 USE debug_chksm_mod , ONLY : spmd_flush_accel
710 USE dt_mod
711 USE python_funct_mod
712 USE python_share_memory_mod
713 USE python_register_mod, ONLY : python_register
714 USE funct_python_update_elements_mod, ONLY : funct_python_update_elements
715 USE python_monvol_mod , ONLY : python_monvol
716 USE outmax_mod
717 USE force_mod , ONLY : force
718 USE array_mod , ONLY : array_type
719 USE names_and_titles_mod
720 USE unitab_mod, ONLY : unit_type_
721 USE bcs_mod , ONLY : bcs
722 USE inter_sh_offset_mod , only:sh_offset_
723 USE offset_nproj_mod, only : offset_nproj
724 USE get_neighbour_surface_mod , only : get_neighbour_surface
725 USE spmd_mod , only : spmd_max,spmd_allreduce,spmd_barrier
726 USE skew_mod
727 USE elbufdef_mod
728 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
729 use init_global_frontier_monvol_mod , only : init_global_frontier_monvol
730 use init_monvol_omp_structure_mod , only : init_monvol_omp_structure
731 USE inivel_dt2_mod , only : inivel_dt2
732 USE inivel_start_mod , only : inivel_start
733 use glob_therm_mod
734 USE my_alloc_mod
735 USE sph_work_mod
736 USE pblast_mod
737 USE spmd_xv_inter_type1_mod, only : spmd_xv_inter_type1
738 USE timer_mod
739 USE rbe3_mod
740 USE th_surf_mod , ONLY : th_surf_num_channel
741 USE ams_work_mod
742 USE update_pon_mod
743 USE debug_mod
744 use inter_init_component_mod , only : inter_init_component
745 use damping_vref_compute_dampa_mod
746 use coupling_adapter_mod
747 use damping_funct_ini_mod , only : damping_funct_ini
748 USE viper_mod
749C-----------------------------------------------
750C I m p l i c i t T y p e s
751C-----------------------------------------------
752#include "implicit_f.inc"
753#include "comlock.inc"
754C-----------------------------------------------
755C G l o b a l P a r a m e t e r s
756C-----------------------------------------------
757#include "mvsiz_p.inc"
758C-----------------------------------------------
759C C o m m o n B l o c k s
760C-----------------------------------------------
761#include "macro.inc"
762#include "com01_c.inc"
763#include "com04_c.inc"
764#include "com06_c.inc"
765#include "com08_c.inc"
766#include "com09_c.inc"
767#include "intstamp_c.inc"
768#include "sphcom.inc"
769#include "param_c.inc"
770#include "scr02_c.inc"
771#include "scr03_c.inc"
772#include "scr05_c.inc"
773#include "scr06_c.inc"
774#include "scr07_c.inc"
775#include "scr11_c.inc"
776#include "scr12_c.inc"
777#include "scr14_c.inc"
778#include "scr16_c.inc"
779#include "scr17_c.inc"
780#include "scr18_c.inc"
781#include "scr23_c.inc"
782#include "units_c.inc"
783#include "stati_c.inc"
784#include "statr_c.inc"
785#include "cong2_c.inc"
786#include "task_c.inc"
787#include "parit_c.inc"
788#include "timeri_c.inc"
789#include "couple_c.inc"
790#include "rad2r_c.inc"
791#include "chara_c.inc"
792#include "lagmult.inc"
793#include "warn_c.inc"
794#include "impl1_c.inc"
795#include "fxbcom.inc"
796#include "eigcom.inc"
797#include "spmd_c.inc"
798#include "remesh_c.inc"
799#include "com_xfem1.inc"
800#include "tabsiz_c.inc"
801#include "sms_c.inc"
802#include "filescount_c.inc"
803#include "inter22.inc"
804#include "userlib.inc"
805#include "drape_c.inc"
806C-----------------------------------------------
807 COMMON /vglob/dmas,diner
808 my_real dmas,diner
809C-----------------------------------------------
810C D u m m y A r g u m e n t s
811C-----------------------------------------------
812 INTEGER ITASK
813 INTEGER ISKWN(LISKN,*), NETH(*),
814 . ipart(*),nom_opt(lnopt1,*),ixs(*),
815 . ixq(nixq,*), ixt(nixt,*), ixp(nixp,*),
816 . ixr(nixr,*),ixtg(nixtg,*), ixtg1(4,*),
817 . kinet(*),
818 . ifill(numnod,*), ims(*), npc(*), ibcl(*), ibfv(*),
819 . idum(*), las(*),iparg(nparg,*),
820 . nprw(*), lprw(*), iconx(*), npby(nnpby,*),
821 . lpby(*),
822 . lrivet(*), nstrf(*), ljoint(*), ilink(*),
823 . llink(*), linale(*), neflsw(*), nnflsw(*),
824 . nodpor(*),icut(*) , inoise(*),monvol(*),
825 . laccelm(3,*),dd_iad(nspmd+1,*),
826 . iad_rby(*),fr_rby(*),nnlink(10,*),lnlink(*),
827 . iaf(*),igrv(*),
828 . kxx(nixx,*),ixx(*),iexlnk(nr2r,*),
829 . iframe(liskn,*),kxsp(nisp,*),ixsp(*),nod2sp(*),
830 . ispcond(nispcond,*),ispsym(nspcond,*),ibvel(nbvelp,*),lbvel(*),
831 . isphio(nisphio,*),lprtsph(*),lonfsph(*),lagbuf(*),ibcslag(*),
832 . iactiv(*),gjbufi(lkjni,*) ,ibmpc(*),npbyl(nnpby,*), lpbyl(*),
833 . nbrcvois(*),nbsdvois(*),lnrcvois(*),lnsdvois(*),
834 . nercvois(*),nesdvois(*),lercvois(*),lesdvois(*), nporgeo(*),
835 . npsegcom(*), lsegcom(*), igeo(npropgi,*),
836 . ipm(npropmi,*),madprt(*), madsh4(*), madsh3(*), madsol(*),
837 . madnod(*),madfail(*),
838 . fr_wall(*),iad_rby2(*),
839 . fr_rby2(*),iad_i2m(*),fr_i2m(*),addcni2(*),procni2(*),iadi2(*),
840 . fr_mv(*), iadmv2(*), fr_ll(*), fr_rl(*),
841 . iadcj(*), fr_cj(*),
842 . fr_sec(*), iad_sec(4,*),
843 . iad_cut(nspmd+2,*), fr_cut(*), rg_cut(*), newfront(*),
844 . fr_mad(5,*), lnodpor(*), fr_i18(*),
845 . fxbipm(nbipm,*),fxbnod(*),fxbelm(*), fxbgrvi(*),
846 . eigipm(neipm,*), eigibuf(*), iflow(*), fasolfr(*),
847 . dd_r2r(nspmd+1,*), lgrav(*), fr_lagf(3,*), llagf(*),
848 . icontact(*), sh4tree(*), sh3tree(*), ipadmesh(*),
849 . iskwp(*), nskwp(*), isensp(2,*), nsensp(*), iaccp(*), naccp(*),
850 . ipart_state(*),sh4trim(*), sh3trim(*),irbym(*) ,lnrbym(*),
851 . icodrbym(*),iad_rbym(*),
852 . fr_rbym(*),nom_sect(*), ibcr(*),irbe2(*),lrbe2(*),
853 . iad_rbe2(*),fr_rbe2(*),iadsdp_pxfem(*),
854 . iadrcp_pxfem(*),icfield(*),lcfield(*),iloadp(*),lloadp(*),
855 . iadsdp_crk(*),iadrcp_crk(*),inod_crk(*),iel_crk(*),iadc_crk(*),
856 . adsky_crk(*),procne_crk(*),cne_crk(*),ibordnode(*),
857 . nodedge(*),iad_edge(*),fr_edge(*),fr_nbedge(*),
858 . crknodiad(*), lgauge(3,*), igaup(*), ngaup(*),nodlevxf(*),
859 . nodglobxfe(*),elcutc(2,*),nodenr(*),kxfenod2elc(*),
860 . enrtag(numnod,*),kxig3d(*),ixig3d(*),
861 . nativ0_sms(*), segquadfr(*),
862 . kloadpinter(ninter+1) ,loadpinter(ninter*nloadp_hyd)
863 INTEGER IDATA(*), IBFTEMP(*), IBCV(*), IBFFLUX(*), WEIGHT_RM(*),
864 . ICODT_PLY(*), ISKEW_PLY(*),INOD_PXFEM(*),IEL_PXFEM(*),
865 . IADC_PXFEM(*),ADSKY_PXFEM(*),ICODE_PLY(*),MADCLNOD(*),
866 . PROCNE_PXFEM(*),
867 . IBUFSSG_IO(*),IBC_PLY(*),DD_R2R_ELEM(*),
868 . SPH2SOL(*), SOL2SPH(2,*), IRST(3,*), SOL2SPH_TYP(*),IRUNN_BIS,
869 . ADDCSRECT(*), IAD_FRNOR(*), FR_NOR(*), PROCNOR(*),
870 . IAD_FREDG(*), FR_EDG(*),TAG_SKINS6(*),IBCSCYC(*),LBCSCYC(*)
871 integer :: IPARI(NPARI,ninter)
872 INTEGER, DIMENSION(NUMSKW), INTENT(IN) :: ISKWP_L
873 INTEGER, DIMENSION(*), INTENT(in) :: ID_GLOBAL_VOIS,FACE_VOIS
874 my_real
875 . DAMP(*),
876 . PM(NPROPM,*),GEO(NPROPG,*),
877 . BUFMAT(*) ,W(3,*) ,VEUL(*),FILL(NUMNOD,*),DFILL(NUMNOD,*),
878 . ALPH(*) ,WB(3,*) ,TF(*) ,FORC(*) ,VEL(*),
879 . FSAV(NTHVKI,*) ,FZERO(3,*),XLAS(*) ,ELBUF(*) ,
880 . RWBUF(NRWLP,*),RWSAV(*),RBY(NRBY,*),RIVET(*),WA(*),
881 . FV(*) ,VAL2(*) ,PHI(*),
882 . R(3,*) ,CRFLSW(*),FLSW(*),
883 . FANI(3,*) ,UWA(*) ,PARTSAV(*) ,
884 . DSAVE(3,*),ASAVE(3,*),XCUT(*) ,ANIN(*) ,BUFNOIS(*),
885 . ACCELM(LLACCELM,*),
886 . TANI(*),VOLMON(*),EANI(*),AGRV(*), THKE(*), BUFSF(*),AF(*),
887 . SECBUF(*),SECFCUM(7,NUMNOD,NSECT),LAMBDA(*),
888 . FR_WAVE(*),PARTS0(*),BUFGEO(*),
889 . spbuf(nspbuf,*),xframe(nxframe,*),
890 . wasph(*),w16(*),vsphio(*),fbvel(*),dampr(nrdamp,*),
891 . rdata(*),pv(*),fsavd(nthvki,*),gjbufr(lkjnr,*),rbmpc(*),
892 . sphveln(*),rbyl(nrby,*), msnf(*),
893 . fxbrpm(*), fxbmod(*), fxbglm(*), fxbcpm(*), fxbcps(*),
894 . fxblm(*), fxbfls(*), fxbdls(*), fxbdep(*), fxbvit(*),
895 . fxbacc(*), fxbsig(*), fxbgrvr(*), eigrpm(nerpm,*),
896 . dmsph(*),knot(*),wige(*),ms_2d(*),
897 . knotlocpc(*),knotlocel(*),xcell(*),xface(*),fcont_max(3,*)
898 my_real
899 . rflow(*), rcontact(*),
900 . padmesh(*), msc(*), mstg(*), inc(*) , intg(*), ptg(3,*),
901 . acontact(*), pcontact(*), factiv(*),
902 . mscnd(*), incnd(*), rbym(*), fbfflux(*),
903 . fconv(*), fbftemp(*), ms_ply(*), zi_ply(*), admsms(*),
904 . mcpc(*), mcptg(*), dmelc(*), dmeltg(*), mssa(*), dmels(*),
905 . mstr(*), dmeltr(*), msp(*), dmelp(*), msrt(*), dmelrt(*),
906 . fradia(*), res_sms(*), phie(*),msf(*),
907 . cfield(*),msz2(*), diag_sms(*),loadp(*), dmint2(*),por(*),
908 . gauge(llgauge,*),wagap(2,*),rthbuf(*),forneqs(3,*),
909 . dpl0cld(*),vel0cld(*)
910 my_real , INTENT(IN) :: dgaploadint(ninter*nloadp_hyd)
911 TYPE(timer_) :: TIMERS
912 TYPE(connectivity_), INTENT(INOUT) :: ELEMENT
913 TYPE(NODAL_ARRAYS_), INTENT(INOUT) :: NODES
914 TYPE (CLUSTER_) ,DIMENSION(*) :: CLUSTER
915 TYPE(PRGRAPH) :: GRAPHE(*)
916 TYPE(TTABLE) :: TABLE(*)
917 TYPE(ELBUF_STRUCT_),DIMENSION(NGROUP) :: ELBUF_TAB
918 TYPE(ELBUF_STRUCT_),DIMENSION(:),ALLOCATABLE :: ELBUF_IMP
919 TYPE(ELBUF_STRUCT_),DIMENSION(NGROUP,NXEL) :: XFEM_TAB
920 TYPE SPSYM_STRUCT
921 my_real, DIMENSION(:) , POINTER :: BUF
922 END TYPE SPSYM_STRUCT
923 TYPE (SPSYM_STRUCT) :: XSPSYM,VSPSYM,WSMCOMP
924 TYPE (STACK_PLY) :: STACK
925 TYPE (MPI_MIN_REAL_STRUCT) :: MPI_BUF
926 TYPE(UNIT_TYPE_) :: UNITAB !structure containing units conversion ratios
927 INTEGER MIN_TAB(4)
928 my_real :: DT2R
929 TYPE(coupling_type), intent(inout) :: coupling
930C
931C Mat + Prop timers
932 INTEGER, DIMENSION(NUMMAT) :: POIN_UMP
933 my_real, DIMENSION(NBR_GPMP,NSPMD+1) :: CPUTIME_MP_GLOB
934 my_real, DIMENSION(TAILLE) :: CPUTIME_MP
935 INTEGER, DIMENSION(7,TAILLE) :: TAB_UMP
936 my_real TAB_MAT(NGROUP)
937 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
938 TYPE(H3D_DATABASE) :: H3D_DATA
939 TYPE (FAILWAVE_STR_) :: FAILWAVE
940!
941 TYPE(SUBSET_) ,DIMENSION(NSUBS) :: SUBSETS
942 TYPE(GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
943 TYPE(GROUP_) ,DIMENSION(NGRBRIC) :: IGRBRIC
944 TYPE(GROUP_) ,DIMENSION(NGRQUAD) :: IGRQUAD
945 TYPE(group_) ,DIMENSION(NGRSHEL) :: IGRSH4N
946 TYPE(GROUP_) ,DIMENSION(NGRSH3N) :: IGRSH3N
947 TYPE(GROUP_) ,DIMENSION(NGRTRUS) :: IGRTRUSS
948 TYPE(GROUP_) ,DIMENSION(NGRBEAM) :: IGRBEAM
949 TYPE(GROUP_) ,DIMENSION(NGRSPRI) :: IGRSPRING
950 TYPE(GROUP_) ,DIMENSION(NGRPART) :: IGRPART
951 TYPE(SURF_) ,DIMENSION(NSURF) :: IGRSURF
952c
953 TYPE(nlocal_str_) :: NLOC_DMG
954 TYPE(pinch) :: PINCH_DATA
955 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
956 INTEGER, INTENT(IN) :: NE_NERCVOIS(*), NE_NESDVOIS(*), NE_LERCVOIS(*), NE_LESDVOIS(*)
957 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL
958 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE) , DRAPE_SH3N(NUMELTG_DRAPE)
959 TYPE(DRAPEG_) :: DRAPEG
960 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
961 TYPE(t_ebcs_tab) ,INTENT(INOUT) :: EBCS_TAB
962 TYPE(T_DIFFUSION) ,INTENT(INOUT) :: DIFFUSION
963 TYPE(t_segvar) :: SEGVAR
964 TYPE(inter_struct_type), DIMENSION(:), ALLOCATABLE :: INTER_STRUCT ! structure for interface
965 TYPE(sorting_comm_type), DIMENSION(:), ALLOCATABLE :: SORT_COMM ! structure for interface sorting comm
966 TYPE (LOADS_) ,INTENT(INOUT) :: LOADS
967 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
968 TYPE(USER_WINDOWS_),INTENT(INOUT) :: USER_WINDOWS
969 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
970 TYPE (INTERFACES_) ,INTENT(INOUT) :: INTERFACES
971 TYPE (DT_) ,INTENT(INOUT) :: DT
972 TYPE(MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
973 TYPE(PYTHON_) ,INTENT(INOUT) :: PYTHON
974 TYPE(NAMES_AND_TITLES_),INTENT(INOUT) :: NAMES_AND_TITLES !< NAMES_AND_TITLES host the input deck names and titles for outputs
975 type (glob_therm_) ,intent(inout) :: glob_therm
976 type (PBLAST_) ,intent(inout) :: PBLAST
977 type (rbe3_) ,intent(inout) :: RBE3
978C
979 INTEGER ,INTENT(IN) :: NDAMP_VREL,NDAMP_VREL_RBYG
980 INTEGER ,INTENT(IN) :: ID_DAMP_VREL(NDAMP_VREL),FR_DAMP_VREL(NSPMD+2,NDAMP_VREL)
981 TYPE(SKEW_),INTENT(INOUT) :: SKEWS
982 INTEGER, INTENT(IN) :: LIFLOW !< Size of IFLOW
983 INTEGER, INTENT(IN) :: LRFLOW !< Size of RFLOW
984C-----------------------------------------------
985C L o c a l V a r i a b l e s
986C-----------------------------------------------
987 LOGICAL LOUT
988 CHARACTER FILNAM*100
989 INTEGER NODFT, NODLT, I,J, N,
990 . K1, K2, K3, K4, K5, K6, K7, K8, K9, K10, K11, K, ISK, KK1,
991 . N0, N1, N2, NN, NNOD, NSENSOR,
992 . isync, two_ints(2),
993 . neltst,ityptst,nwaft, nbncl, nbikl,
994 . nbnodl, nbnodlr,greftsk,greltsk,
995 . istop, nfia, nfea, nfoa, ndma, ndin,
996 . nfnca, nftca,ndma2, nfnca2, nftca2,
997 . l1,l2,l3,ll1,ll2,ll3,nft2,lisendp_pxfem,
998 . lirecvp_pxfem,ndama2,flg_kj2,ncont,bid,k12,ivad,iad_grel,
999 . flg_kj2_raz,i_exch_flg_raz
1000 INTEGER :: LISENDP_CRK,LIRECVP_CRK
1001 INTEGER :: I13A,I13B,I13C,I13D,I13E,I13F,I13G,I13H,I13I
1002 INTEGER :: I15A,I15B,I15C,I15D,I15E,I15F,I15G,I15H,I15I,I15J,I15K
1003 INTEGER :: I15ATH,I35ATH
1004 INTEGER :: I87A,I87B,I87C,I87D,I87E,I87F,I87G,I87H,I87I,I87J,I87K,
1005 . i87l,i87m,i87n,imsch,iad1b,iad1,iad2,i2msch, ismsch, onofp
1006 INTEGER CPLXIT, ADRNOD, ONOF, ONFELT, ICH,IFLGADM, MADENDREQUEST
1007 CHARACTER*13 CDUM
1008 INTEGER IDUM1, DIM6, DIM_EXCH
1009
1010 my_real
1011 . rdum1,maduf,rbuf(10)
1012 INTEGER LLT1,IWIOUT
1013 INTEGER KSPH1,KSPH21,KSPH22,KSPH23,IUN,
1014 . kspactiv,ksp2sort,neltsa,ityptsa,idtnod
1015 INTEGER NEGMAS
1016 INTEGER :: LENGTH
1017 INTEGER NBINTC, LENR, LENS, LENI, SIZI, ISIZXV ,ILENXV,
1018 . i2size, lsend1, lrecv1, lsend2, lrecv2, npartl,
1019 . islen7, irlen7, islen11, irlen11, lisendp, lirecvp,
1020 . islen17, irlen17,irlen7t,islen7t,lindidel,lbufidel,lbufseglo,
1021 . islen20, irlen20, islen20t, irlen20t, nbint20,
1022 . islen20e, irlen20e,lag_sec,lens1,lenr1,int18kine,
1023 . nrbykin_l, int24use, neleml,i24maxnsne,int24e2euse
1024 INTEGER :: INT7ITIED
1025 INTEGER, DIMENSION(:,:),ALLOCATABLE ::
1026 . isendto,ircvfrom,fr_nbcc,fr_nbcci2,fr_nbcc1
1027 INTEGER, DIMENSION(:),ALLOCATABLE ::
1028 . intlist,niskyfi,isendp,irecvp, irbkin_l,
1029 . ipartl, niskyfie, tagel,
1030 . isendp_pxfem,irecvp_pxfem,count_remslv,count_remslve,
1031 . intlist25
1032 INTEGER, DIMENSION(:), ALLOCATABLE, TARGET :: CNEL,ADDCNEL,ADDTMPL
1033 INTEGER, DIMENSION(:),ALLOCATABLE ::
1034 . ISENDP_CRK,IRECVP_CRK
1035 INTEGER NSPHACTG,SPH_IORD1
1036 INTEGER, DIMENSION(1), TARGET :: IMP_DUM
1037C----
1038 my_real,DIMENSION(:),ALLOCATABLE :: dretri, xsec,qfricint,icodr0,icodt0,
1039 . stifn_tmp,stifr_tmp
1040 SAVE isendto, ircvfrom, intlist, fr_nbcc, niskyfi, fr_nbcci2,
1041 . nbintc, i2size, islen7 ,irlen7 ,islen11 ,irlen11,
1042 . ilenxv, isizxv, islen17, irlen17,irlen7t,islen7t,
1043 . islen20, irlen20, islen20t, irlen20t, nbint20, niskyfie,
1044 . islen20e, irlen20e, nrbykin_l, irbkin_l, qfricint,
1045 . intlist25
1046 SAVE dretri, xsec, lisendp, lirecvp, isendp, irecvp,
1047 . cnel, addcnel, addtmpl, ipartl, npartl, lindidel, lbufidel,
1048 . lbufseglo
1049 my_real dt2t,
1050 . dt2save, mas, bb, wfexc,trest,dtrest,
1051 . dmast, dinert, factb,dampt,
1052 . xsens(12,sensors%NSENSOR),dampa3
1053 my_real fxbmvn(lencp),fxbsv(lenlm),fxbse(15*nfxbody),
1054 . fxbmcd(lenmcd),fxbfp(lenvar),fxbfc(lenlm),fxbefw(nfxbody),
1055 . fxbedp(nfxbody),fxbgrp(lenvar),fxbgrw(nfxbody)
1056 my_real, DIMENSION(:,:), ALLOCATABLE :: dxancg
1057 my_real dt2prev, dtmin1_save, target_dt
1058 SAVE imsch, i2msch, ismsch
1059 SAVE dt2prev
1060 SAVE nfia, nfea, nfoa, ndma, ndin, ndma2,
1061 . i13a,i13b,i13c,i13d,i13e,i13f,i13g,i13h,i13i,
1062 . i15a,i15b,i15c,i15d,i15e,i15f,i15g,i15h,i15i,i15j,i15k,
1063 . i87a,i87b,i87c,i87d,i87e,i87f,i87g,i87h,i87i,i87j,i87k,i87l,
1064 . i87m,i87n,i15ath,i35ath,lag_sec,nft2,ndama2
1065 INTEGER NDDL0,NNZK0,LENQMV,NV46,NUM_IMP(NINTER),NINT7,NT_IMP,
1066 . NNDL,IT,NMC2,LI13,DIRUL(NFXVEL),NUM_IMP1(NINTER),
1067 . FR_RBE2M(SFR_RBE2),R2SIZE,
1068 . NUM_IMPL(NINTER,NTHREAD), I_OPT_STOK(NINTER),IT_T,NTMP
1069 INTEGER IER1,NDS,IBUCK,NMRBE2,NTHOLD
1070 SAVE nmrbe2,r2size,nint7
1071 INTEGER, DIMENSION(:),POINTER :: NS_IMP,NE_IMP,IND_IMP
1072 TYPE (IMPBUF_STRUCT_), TARGET :: IMPBUF_TAB
1073 my_real, DIMENSION(:) , POINTER :: FEXT_IMP,R_IMP
1074 my_real TTMP,DMCP(NUMGEO)
1075 data TTMP /0.0/
1076 INTEGER LWIBEM, LWRBEM, IERROR, IERROR2, INTER_ERRORS
1077 INTEGER, DIMENSION(:), ALLOCATABLE :: WIBEM
1078 my_real, DIMENSION(:), ALLOCATABLE :: WRBEM
1079 SAVE LWIBEM, LWRBEM, WIBEM, WRBEM
1080 INTEGER NKCOND, NDDLG, NRP, NCP, NKCOND_INI, NT_IMP_OLD
1081 INTEGER LWIFLOW, LWRFLOW
1082 INTEGER, DIMENSION(:), ALLOCATABLE :: WIFLOW
1083 my_real, DIMENSION(:), ALLOCATABLE :: wrflow
1084 SAVE lwiflow, lwrflow, wiflow, wrflow
1085 INTEGER SIZ, R2R_ON
1086 INTEGER, DIMENSION(:), ALLOCATABLE :: CDDLP
1087#if defined(MUMPS5)
1088 TYPE(dmumps_struc) MUMPS_PAR
1089#endif
1090 INTEGER IFVMESH
1091C
1092 my_real, DIMENSION(:,:), ALLOCATABLE :: madclfrecv,partsav2
1093C
1094 INTEGER MADYMO_DEL,MADYMO_DEL_GLOBAL
1095 INTEGER, DIMENSION(:), ALLOCATABLE ::MAD_TAG_SOL, MAD_TAG_SH,MAD_TAG_TG,MAD_FAIL_ELEMENTS
1096C
1097C OpenMP specific
1098 INTEGER ITSK, NODFTSK, NODLTSK, NUMNTSK, NDTSK, IPMTSK,
1099 . partftsk, partltsk, nwaftsk, i16tsk,
1100 . neltstt, ityptstt,igmtsk,ngrouc, ngrounc,
1101 . nsnfiold(nspmd),
1102 . kindrby(nrbykin), nindex1(ninter), nindex2(ninter),
1103 . nindex3(ninter), nindex4(ninter), kindrbym(nrbym),
1104 . omp_get_thread_num,iadisk,rnum_siz,rns,nindexp,ni,lenc,ithout
1105 integer :: omp_address
1106 INTEGER, DIMENSION(:),ALLOCATABLE :: IGROUC
1107 INTEGER, DIMENSION(:),ALLOCATABLE :: IGROUNC
1108! INTEGER, DIMENSION(:), ALLOCATABLE :: ADSKYI !(0:NUMNOD+1),
1109 EXTERNAL omp_get_thread_num
1110 INTEGER, DIMENSION(:), ALLOCATABLE :: IBUFIDEL, INDIDEL,RENUM,IBUFSEGLO,
1111 . INDSEGLO
1112 my_real DT2TT,D_TSTART,D_TSTOP
1113 my_real XSLV(18,NINTER),XMSR(12,NINTER),
1114 . vslv(6,ninter),vmsr(6,ninter),
1115 . size_t(ninter)
1116C End OpenMP specific
1117C Parith/ON specific
1118 INTEGER FR_RBY6(SFR_RBY)
1119 DOUBLE PRECISION
1120 . frl6(15,6,nrlink),fnl6(15,6,nlink),
1121 . frwl6(7,6,nrwall),rbym6(6,6,nrbym),sphg_f6(4,6,nbgauge)
1122 DOUBLE PRECISION,DIMENSION(:,:,:),ALLOCATABLE :: RBY6
1123 my_real FRL(4,NRLINK), FNL(4,NLINK)
1124 INTEGER NGRTH,NELEM
1125 INTEGER RESTSIZE
1126C End Parith/ON specific
1127 INTEGER FR_SMS(NSPMD+1), FR_RMS(NSPMD+1)
1128 INTEGER, POINTER, DIMENSION(:) :: PTR_SMS
1129 INTEGER NMT0
1130 INTEGER, DIMENSION(:), ALLOCATABLE :: IKINE
1131 my_real, DIMENSION(:), ALLOCATABLE :: stk_sn,stk_sr,fcluster,mcluster
1132 my_real, DIMENSION(:), ALLOCATABLE :: noda_fext
1133 INTEGER LNZM
1134 INTEGER, DIMENSION(:),ALLOCATABLE :: INT18ADD,TAGPENE
1135 INTEGER, DIMENSION(:),ALLOCATABLE :: IDAMP_RDOF_TAB
1136 my_real, DIMENSION(:,:),ALLOCATABLE :: MTF, CAND_SAV
1137 INTEGER FLG_DTNODAMP,FLG_DAMP_FUNCT
1138 my_real dt3
1139 INTEGER IGROUPFLG(2)
1140 INTEGER, DIMENSION(:),ALLOCATABLE :: IGROUPC,IGROUPTG,IGROUPS
1141 INTEGER IOLDSECT
1142
1143 ! TETRA4 : SMOOTH FINITE ELEMENT FORMULATIONS
1144 my_real, DIMENSION(:),ALLOCATABLE :: sfem_nodvar !lagrange framework
1145 my_real, DIMENSION(:),ALLOCATABLE :: sfem_nodvar_ale !ALE framework
1146 INTEGER S_SFEM_NODVAR ! same size for ALE and Lagrange frameworks
1147C-----------------------------------------------------------------------------------
1148C Parith/OFF + AMS
1149 INTEGER, DIMENSION(:),ALLOCATABLE :: UNCOMP_FR,FR_LOC,
1150 * UNCOMP_FRI2M,FR_LOCI2M
1151 INTEGER NB_FR,NB_FRI2M
1152C-----------------------------------------------------------------------------------
1153C ADDITIVE MANUFACTURING
1154 my_real, DIMENSION(:), ALLOCATABLE :: mcp_off
1155C-----------------------------------------------------------------------------------
1156C TEMPI I24
1157 INTEGER SFR_I24
1158 INTEGER, DIMENSION(:), ALLOCATABLE :: FR_I24
1159 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_I24
1160 my_real
1161 . delta_pmax_gap(ninter)
1162 INTEGER DELTA_PMAX_GAP_NODE(NINTER)
1163 INTEGER S_LOADPINTER, NPRESLOAD
1164 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAGNCONT
1165 INTEGER, DIMENSION(:), ALLOCATABLE :: LOADP_HYD_INTER, LOADP_TAGDEL
1166C-----------------------------------------------------------------------------------
1167C Debug CAND INTERFACE TYPE25
1168 INTEGER,DIMENSION(:),ALLOCATABLE :: NB25_CANDT
1169 INTEGER,DIMENSION(:),ALLOCATABLE :: NB25_IMPCT
1170 INTEGER,DIMENSION(:),ALLOCATABLE :: NB25_DST1
1171 INTEGER,DIMENSION(:),ALLOCATABLE :: NB25_DST2
1172 SAVE nb25_candt,nb25_impct,nb25_dst1,nb25_dst2
1173C-----------------------------------------------------------------------------------
1174C Communication INTERFACE TYPE25
1175 INTEGER SFR_I25
1176 INTEGER, DIMENSION(:), ALLOCATABLE :: FR_I25
1177 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_I25
1178C Assembling normals INTERFACE TYPE25
1179 REAL(kind=4), DIMENSION(:,:), ALLOCATABLE :: FSKYN25
1180C time varying gap T25
1181 my_real maxdgap(ninter)
1182 INTEGER :: FLAG_SLIPRING_UPDATE,FLAG_RETRACTOR_UPDATE
1183C-----------------------------------------------------------------------------------
1184C Multidomains
1185 INTEGER IDEL7NOK_R2R,IDEL7NOK_SAV,NUMSPH_GLO_R2R,FLG_SPHINOUT_R2R
1186 INTEGER, DIMENSION(:),ALLOCATABLE :: OFF_SPH_R2R
1187C-----------------------------------------------------------------------------------
1188C Sensors inter
1189 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ISENSINT
1190 INTEGER NISUBMAX
1191
1192 INTEGER, ALLOCATABLE, DIMENSION(:) :: ICONTACT_OLD
1193C-----------------------------------------------------------------------------------
1194 my_real
1195 . , DIMENSION(:),ALLOCATABLE :: waspsym
1196C AMS
1197 INTEGER LSKYI_SMS_NEW
1198 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: T2MAIN_SMS
1199 my_real, DIMENSION(:),ALLOCATABLE :: T2FAC_SMS
1200 my_real, DIMENSION(:), ALLOCATABLE :: mskyi_fi_sms
1201 INTEGER, DIMENSION(:),ALLOCATABLE :: LIST_SMS
1202 INTEGER, DIMENSION(:),ALLOCATABLE :: LIST_RMS
1203 my_real, DIMENSION(:,:), ALLOCATABLE :: CJWORK
1204 my_real, DIMENSION(:,:), ALLOCATABLE :: frea
1205 INTEGER, DIMENSION(:), ALLOCATABLE :: IRWL_WORK
1206 my_real, DIMENSION(:,:), ALLOCATABLE :: sms_vfi
1207 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: MW6
1208 integer sz_mw6
1209C-----------------------------------------------------------------------------------
1210C FVMBAG: switch to UP
1211 INTEGER :: NFVBAG0
1212 LOGICAL :: CHECK_NPOLH
1213C---ADMESH + TRIMING----
1214 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGTRIMC,TAGTRIMTG
1215
1216
1217 INTEGER :: IFTHE, ICONDN, IDX_FTHE, IDX_CONDN, IDX_PINCH,MSTOP_DT_THERM
1218C---Nitsche Method----
1219 INTEGER NFACNIT
1220 my_real, DIMENSION(:,:),ALLOCATABLE :: stressmean
1221 my_real, DIMENSION(:),ALLOCATABLE :: forneqsky
1222
1223 INTEGER :: NUMSKW_L,NUMSKW_L_SEND,NODFTSK_2,NODLTSK_2
1224 INTEGER, DIMENSION(NUMSKW) :: ISKWP_L_SEND
1225 INTEGER, DIMENSION(NSPMD) :: RECVCOUNT
1226 INTEGER, DIMENSION(NTHREAD) :: NODFT_ASSPAR, NODLT_ASSPAR
1227 INTEGER NODFT_NL,NODLT_NL
1228 REAL(kind=8) :: secs
1229 REAL(kind=8) :: tt_double
1230 my_real
1231 . dtnod_nlocal,t_kin
1232 INTEGER, DIMENSION(:),ALLOCATABLE ::IBUFPDEL, NINDEXPDEL
1233
1234 DOUBLE PRECISION :: argin,argout
1235 DOUBLE PRECISION, DIMENSION(:,:,:),ALLOCATABLE :: RBY6_C
1236C----------------------------------------------------------------------------------
1237C IMPVEL/FGEO
1238 INTEGER FXVEL_FGEO
1239C----------------------------------------------------------------------------------
1240C /DAMP/VREL
1241 INTEGER SIZE_RBY6_C,FL_VREL
1242 my_real damp_a(3)
1243C----------------------------------------------------------------------------------
1244C /VIPER/ON
1245 type(viper_coupling_) :: VIPER
1246C----------------------------------------------------------------------------------
1247C Type2 output - PCONT2
1248 INTEGER :: SZ_NPCONT2
1249 my_real, DIMENSION(:,:),ALLOCATABLE :: NPCONT2
1250C----------------------------------------------------------------------------------
1251! contact w/ offset
1252 my_real, TARGET, DIMENSION(:,:),ALLOCATABLE :: xyz
1253 my_real, POINTER, DIMENSION(:,:), contiguous :: ptrx, ptrx_offset
1254 TYPE(sh_offset_) :: SH_OFFSET_TAB
1255C-----------------------------------------------------------------------------------
1256 INTEGER IFLAG, COMPTREAC ! Flag for computing reaction forces
1257! 1. Storing Freac=Fint+Fext+Fcont
1258! 2. Add acceleration fields (gravity, etc) to Freac
1259! Downloading velocities (cf so-called main/secnd formulation)
1260! In RD, accelerations are computed so that the resulting velocity after integration
1261! will correspond to the expected velocity
1262! because sortie_main (output) is done before integration of accelerations
1263! 3. Finalize Freac=MS*A-Freac
1264C----------------------------------------------------------------------------------
1265! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1266! NSKWP : integer ; dimension = NSPMD
1267! number of skew per processor
1268! ISKWP : integer ; dimension=NUMSKW+1
1269! gives the ID processir of the current i SKEW
1270! ISKWP < 0 --> the SKEW is local on a processor
1271! and we don't need to communicate the data
1272! ISKWP > 0 --> the SKEW is global and the data must be
1273! communicated
1274! NUMSKW_L : integer
1275! number of local SKEW
1276! NUMSKW_L_SEND : integer
1277! number of sent SKEW
1278! ISKWP_L_SEND : integer ; dimension=NUMSKW_L_SEND
1279! index of sent SKEW
1280! RECVCOUNT : integer ; dimension=NSPMD
1281! number of received SKEW
1282! NODFT_ASSPAR : integer ; dimension=NTHREADS
1283! lower bound for asspar4 splitting
1284! NODLT_ASSPAR : integer ; dimension=NTHREADS
1285! upper bound for asspar4 splitting
1286! TT_DOUBLE : real(kind8)
1287! current time in double precision --> with simple precision version,
1288! the current time can be wrong (due to error's accumulation) if the
1289! number of cycle is huge AND the time step is small
1290! (ie. when NCYCLE > 300 000 and DT = 10^-7)
1291! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
1292 INTEGER :: STATE_H3D, STATE_ANIM
1293 LOGICAL :: BOOL_RESTART
1294
1295 INTEGER :: NATIV_SMS_SIZ ! size of NATIV_SMS array
1296 INTEGER :: TEMP_SIZ ! size of TEMP
1297
1298 TYPE(shooting_node_type) :: SHOOT_STRUCT
1299 INTEGER :: S_ELEM_STATE ! size of ELEM_STATE array
1300 LOGICAL, DIMENSION(:), ALLOCATABLE :: ELEM_STATE ! boolean : true if element is ON, false if element is OFF
1301 INTEGER :: SIZE_ADDCNEL ! size of addcnel array
1302 INTEGER :: SIZE_CNEL ! size of cnel array
1303 LOGICAL :: GLOBAL_ACTIVE_ALE_ELEMENT
1304
1305 INTEGER :: SIZE_NPBY
1306
1307 ! ----------
1308 LOGICAL :: NEED_COMM_INTER18 !< true if the mpi comm "exchange of remote XCELL data" is mandatory
1309 INTEGER :: NUMBER_INTER18 ! number of interface 18
1310 INTEGER, DIMENSION(NINTER) :: INTER18_LIST ! list of interface 18
1311 TYPE(array_type), DIMENSION(:), ALLOCATABLE :: XCELL_REMOTE ! remote data structure for interface 18
1312 ! ----------
1313 my_real, DIMENSION(:), ALLOCATABLE :: fsky_l
1314 LOGICAL :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
1315 INTEGER :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
1316
1317 INTEGER :: CHECK_NEIGH_FLAG,CHECK_NEIGH_FLAG_RES
1318
1319 integer, dimension(nspmd+2) :: frontier_global_mv !< frontier fo monitored volume
1320 integer :: sporo
1321 ! Restart File Writing
1322 INTEGER STOP_OR_ADD_CYCLE !< Check if additional cycle must be done after restart at termination
1323 DATA iun/1/
1324 INTEGER MAXFUNC
1325 PARAMETER (MAXFUNC = 100)
1326 integer :: numnod_old,numnodm_old
1327 integer :: new_crack
1328C-----------------------------------------------------------------------------------
1329C Err THK
1330C-----------------------------------------------------------------------------------
1331 my_real, DIMENSION(:), ALLOCATABLE :: thick_sh4
1332 my_real, DIMENSION(:), ALLOCATABLE :: thick_sh3
1333 my_real, DIMENSION(:), ALLOCATABLE :: thick_nod
1334 my_real, DIMENSION(:), ALLOCATABLE :: area_nod
1335 my_real, DIMENSION(:), ALLOCATABLE :: area_sh4
1336 my_real, DIMENSION(:), ALLOCATABLE :: area_sh3
1337C-----------------------------------------------------------------------------------
1338C admerr
1339C-----------------------------------------------------------------------------------
1340 my_real, DIMENSION(:), ALLOCATABLE :: admerr_thick_sh4
1341 my_real, DIMENSION(:), ALLOCATABLE :: admerr_thick_sh3
1342 my_real, DIMENSION(:), ALLOCATABLE :: admerr_thick_nod
1343 my_real, DIMENSION(:), ALLOCATABLE :: admerr_area_nod
1344 my_real, DIMENSION(:), ALLOCATABLE :: admerr_area_sh4
1345 my_real, DIMENSION(:), ALLOCATABLE :: admerr_area_sh3
1346C-----------------------------------------------------------------------------------
1347 type(sph_work_) :: SPH_WORK !< working Areas for SPLISSV and SPHPREP
1348 type (ams_work_) :: ams_work !< Working areas for AMS
1349
1350 type(component_), dimension(:), allocatable :: component
1351C-----------------------------------------------------------------------------------
1352C coupling coupling
1353 logical :: ongoing
1354 double precision :: dt2max_coupling
1355C-----------------------------------------------------------------------------------
1356 ELEMENT%SHELL%OFFSET = numels + numelq
1357 CALL prepare_debug(nodes%ITAB,numnod)
1358 interfaces%NINTER = ninter
1359 interfaces%npari = npari
1360c
1361 CALL my_alloc(rby6,8,6,nrbykin)
1362 CALL my_alloc(dxancg,3,numnod)
1363 CALL my_alloc(nb25_candt,parasiz)
1364 CALL my_alloc(nb25_impct,parasiz)
1365 CALL my_alloc(nb25_dst1,parasiz)
1366 CALL my_alloc(nb25_dst2,parasiz)
1367 CALL my_alloc(igrouc,ngroup)
1368 CALL my_alloc(igrounc,ngroup)
1369c
1370 ALLOCATE(interfaces%PON%ADSKYI(0:numnod+1))
1371 bool_restart = .true.
1372 state_h3d = 0
1373 state_anim = 0
1374 ALLOCATE(int18add(ninter+1))
1375 int18add(1) = 1
1376 int18add(ninter+1) = 0
1377 ninter22 = int22
1378 ALLOCATE (idamp_rdof_tab(sicontact))
1379 ALLOCATE( icontact_old(sicontact))
1380 idamp_rdof_tab = 0
1381 flg_dtnodamp = 0
1382 IF ((nodadt==1).AND.
1383 . (idamp_rdof==ndamp .OR. ndamp>0 .OR. istat==3)) THEN
1384 flg_dtnodamp = 1
1385 ENDIF
1386 flg_damp_funct = 0
1387 IF (ndamp>0) THEN
1388 DO i=1,ndamp
1389 IF(nint(dampr(21,i))==4) flg_damp_funct=1
1390 END DO
1391 END IF
1392 flg_kj2 = 0
1393 i_exch_flg_raz = 0
1394 neltst = 0
1395 ityptst = 0
1396 dt2t = 0
1397 mstop_dt_therm = 0
1398 nsensor = sensors%NSENSOR
1399
1400 IF(glob_therm%ITHERM_FE>0) THEN
1401 temp_siz = numnod
1402 ELSE
1403 temp_siz = 0
1404 ENDIF
1405
1406C initialize int24 presence flag
1407 int24use = 0
1408 int24e2euse = 0
1409C-----------------------------------------------
1410C exit flag for MaDyMo coupling
1411 cplxit=0
1412 ilastanim=0
1413 ilasth3d=0
1414 ioldsect = -1
1415 ilastdynain=0
1416 nodft = 1
1417 nodlt = numnod
1418 nwaft = 1
1419 lout = ispmd==0
1420 iwiout = 0
1421 lmpc = 0
1422 tt_double = tt
1423 lskyi_count = 0
1424 flag_slipring_update = 0
1425 flag_retractor_update = 0
1426 IF (ndamp_vrel_rbyg > 0) THEN
1427 size_rby6_c = nrbykin
1428 ELSE
1429 size_rby6_c = 0
1430 ENDIF
1431 ALLOCATE(rby6_c(2,6,size_rby6_c))
1432c
1433 IF(ispmd==0)THEN
1434 DO i = 1,nummpc
1435 lmpc = lmpc + ibmpc(i)
1436 ENDDO
1437 END IF
1438C-----------------------------------------------
1439C I N I T I A L I S A T I O N S
1440C----------------------------------------------
1441 size_npby = snpby/nnpby
1442C -------------------------------------------------------------------
1443C User Libraries get the possibility to use GET_U_NOD_X & GET_U_NOD_V in user elements properties (Solids & Springs)
1444 getunod_nocom=0
1445
1446C========================================================================================
1447C NON PARALLEL SECTION (SMP)
1448C========================================================================================
1449
1450 !initialisation timer resol
1451 IF (imon>0) THEN
1452 CALL startime(timers,timer_resol)
1453 ENDIF
1454C----------------------------------------------
1455C Allocations Phase1
1456C----------------------------------------------
1457 imsch = 0
1458 i2msch = 0
1459 dt2prev= zero
1460 lisendp_pxfem = 0
1461 lirecvp_pxfem = 0
1462C
1463 lisendp_crk = 0
1464 lirecvp_crk = 0
1465C
1466 pblast%PBLAST_DT%IDT = 0
1467C
1468 numsph_glo_r2r = 0
1469 flg_sphinout_r2r = 0
1470
1471 CALL assinit(element%PON%ADSKY,nodes%BOUNDARY_ADD,nodes%BOUNDARY,element%PON%PROCNE,lisendp,lirecvp)
1472 IF(iplyxfem > 0 )
1473 . CALL assinit_pxfem(adsky_pxfem,inod_pxfem,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
1474 . procne_pxfem,lisendp_pxfem,lirecvp_pxfem)
1475 IF (icrack3d > 0 .AND. nspmd > 1)
1476 . CALL assinit_crkxfem(adsky_crk,inod_crk,nodes%BOUNDARY_ADD,
1477 . nodes%BOUNDARY,procne_crk,lisendp_crk,
1478 . lirecvp_crk)
1479 ALLOCATE(isendto(ninter+1,nspmd+1))
1480 ALLOCATE(ircvfrom(ninter+1,nspmd+1))
1481 isendto(1:ninter+1, 1:nspmd+1) = 0
1482 ircvfrom(1:ninter+1, 1:nspmd+1) = 0
1483
1484 ALLOCATE(intlist(2*ninter))
1485 ALLOCATE(intlist25(ninter25))
1486 ALLOCATE(niskyfi(ninter))
1487 ALLOCATE(niskyfie(ninter))
1488 ALLOCATE(count_remslv(ninter))
1489 ALLOCATE(count_remslve(ninter))
1490 count_remslv(1:ninter)=0
1491 count_remslve(1:ninter)=0
1492 ALLOCATE(fr_nbcc(2,nspmd+1))
1493 ALLOCATE(fr_nbcci2(2,nspmd+1))
1494 ALLOCATE(dretri(5*ninter))
1495 ALLOCATE(xsec(3*4*nsect))
1496 ALLOCATE(irbkin_l(nrbykin))
1497 ALLOCATE(element%PON%ISENDP(min(lisendp,1):lisendp))
1498 ALLOCATE(element%PON%IRECVP(min(lirecvp,1):lirecvp))
1499 ALLOCATE(isendp_pxfem(min(lisendp_pxfem,1):lisendp_pxfem))
1500 ALLOCATE(irecvp_pxfem(min(lirecvp_pxfem,1):lirecvp_pxfem))
1501 ALLOCATE(isendp_crk(min(lisendp_crk,1):lisendp_crk))
1502 ALLOCATE(irecvp_crk(min(lirecvp_crk,1):lirecvp_crk))
1503 ALLOCATE(fr_nbcc1(2,nspmd+1))
1504C----------------------------------------------------------
1505C Allocation of tables for /LOAD/PRESSURE
1506C-----------------------------------------------------------
1507 nloadp_hyd_inter = 0
1508 ierror = 0
1509 IF(nintloadp > 0 ) THEN
1510 ALLOCATE(loadp_hyd_inter(nloadp_hyd),stat=ierror2)
1511 ierror = ierror + ierror2
1512 DO k=1,nloadp_hyd
1513 IF(iloadp(sizloadp*(k-1)+5) > 0 ) THEN
1514 nloadp_hyd_inter = nloadp_hyd_inter + 1
1515 loadp_hyd_inter(k) = nloadp_hyd_inter
1516 ENDIF
1517 ENDDO
1518 ENDIF
1519
1520 IF(nloadp_hyd_inter > 0) THEN
1521 ALLOCATE(tagncont(nloadp_hyd_inter,numnod),stat=ierror2)
1522 ierror = ierror + ierror2
1523 IF(ierror/=0)THEN
1524 CALL ancmsg(msgid=158,anmode=aninfo,
1525 . i1=ierror)
1526 CALL arret(2)
1527 END IF
1528 tagncont = 0
1529 ELSE
1530 ALLOCATE(tagncont(0,0))
1531 ENDIF
1532C
1533 s_loadpinter = ninter*nloadp_hyd
1534C
1535 npresload = 0
1536 IF(nloadp_hyd > 0 ) THEN
1537 DO k=1,nloadp_hyd
1538 npresload = npresload + iloadp(sizloadp*(k-1)+1)/4
1539 ENDDO
1540 ALLOCATE(loadp_tagdel(npresload),stat=ierror2)
1541 loadp_tagdel(1:npresload) =0
1542 ELSE
1543 ALLOCATE(loadp_tagdel(0))
1544 ENDIF
1545C----------------------------------------------------------
1546 IF(interfaces%PARAMETERS%INTCAREA>0) THEN
1547 ALLOCATE(interfaces%PARAMETERS%INTAREAN(numnod))
1548 ELSE
1549 ALLOCATE(interfaces%PARAMETERS%INTAREAN(0))
1550 ENDIF
1551C
1552C ! /TH/SURF output
1553
1554 IF(nsurf > 0) THEN
1555 ALLOCATE(output%TH%TH_SURF%CHANNELS(th_surf_num_channel,nsurf))
1556 output%TH%TH_SURF%CHANNELS(1:th_surf_num_channel,1:nsurf)=zero
1557 ELSE
1558 ALLOCATE(output%TH%TH_SURF%CHANNELS(0,0))
1559 ENDIF
1560C
1561 IF(output%TH%TH_SURF%IOK > 0 ) THEN
1562 IF(output%TH%TH_SURF%LOADP_FLAG > 0 ) THEN
1563 output%TH%TH_SURF%NSEGLOADPF = 0
1564 DO k=1,nloadp_f
1565 output%TH%TH_SURF%NSEGLOADPF = output%TH%TH_SURF%NSEGLOADPF + iloadp(sizloadp*(k-1)+1)/4
1566 ENDDO
1567 output%TH%TH_SURF%NSEGLOADPB = 0
1568 DO k=nloadp_f+1,pblast%NLOADP_B
1569 output%TH%TH_SURF%NSEGLOADPB = output%TH%TH_SURF%NSEGLOADPB + iloadp(sizloadp*(k-1)+1)/4
1570 ENDDO
1571 output%TH%TH_SURF%NSEGLOADP = 0
1572 DO k=nloadp_f+pblast%NLOADP_B+1,nloadp
1573 output%TH%TH_SURF%NSEGLOADP = output%TH%TH_SURF%NSEGLOADP + iloadp(sizloadp*(k-1)+1)/4
1574 ENDDO
1575 ENDIF
1576 ENDIF
1577
1578C
1579 IF((idel7ng>0).OR.(irad2r/=0).OR.(alemuscl_param%IALEMUSCL>0).OR.(pdel>0))THEN
1580 size_addcnel = numnod+1
1581 size_cnel = lcnel
1582 neleml = numels+numelq+numelc+numelt+numelp+
1583 . numelr+numeltg
1584 s_elem_state = neleml
1585 ELSE
1586 size_addcnel = 0
1587 size_cnel = 0
1588 s_elem_state = 0
1589 ENDIF
1590 ierror = 0
1591 ALLOCATE(cnel(0:size_cnel))
1592 ALLOCATE(addcnel(0:size_addcnel))
1593 IF((idel7ng>0).OR.(irad2r/=0).OR.(alemuscl_param%IALEMUSCL>0).OR.(pdel>0))THEN
1594C Allocation of inverse connectivity array
1595 ALLOCATE(addtmpl(0:numnod+1))
1596 ierror = ierror + ierror2
1597 neleml = numels+numelq+numelc+numelt+numelp+
1598 . numelr+numeltg
1599 ALLOCATE(tagel(1:neleml))
1600 tagel(:) = 0
1601 alemuscl_buffer%pCNEL => cnel
1602 alemuscl_buffer%pADDCNEL => addcnel
1603 alemuscl_buffer%pADDTMPL => addtmpl
1604 ELSE
1605 ALLOCATE(addtmpl(0),tagel(0))
1606 END IF
1607 ALLOCATE(ipartl(npart))
1608 ALLOCATE(partsav2(2,npart))
1609 ALLOCATE( elem_state(s_elem_state) )
1610 elem_state(1:s_elem_state) = .true.
1611C
1612C Working arrays for thermal analysis
1613C
1614 glob_therm%NODADT_THERM = 0
1615 IF(glob_therm%IDT_THERM == 1) THEN
1616 IF(ninter>0.OR.nodadt>0) glob_therm%NODADT_THERM = 1 ! Flag for nodal thermal time step
1617 ENDIF
1618 IF(glob_therm%IDT_THERM == 1) THEN
1619 ALLOCATE(icodt0(numnod)) ! Tabs for storing initial kinimatic when thermal time step
1620 ALLOCATE(icodr0(numnod))
1621 ELSE
1622 ALLOCATE(icodt0(0))
1623 ALLOCATE(icodr0(0))
1624 ENDIF
1625
1626 ALLOCATE(mcp_off(numnod))
1627 mcp_off(1:numnod) = 1.0
1628
1629 ifthe = 1
1630 icondn = 1
1631 IF(glob_therm%ITHERM_FE > 0 ) THEN
1632 IF(iparit == 3 ) THEN
1633 ifthe = numnod+3*numnod*nthread
1634 ALLOCATE(fthe(ifthe), fthesky(lsky))
1635 ELSEIF(iparit /= 0 ) THEN
1636 ifthe = numnod
1637 ALLOCATE(fthe(ifthe), fthesky(lsky))
1638 ELSE
1639 ifthe = numnod*nthread
1640 ALLOCATE(fthe(ifthe), fthesky(0))
1641 ENDIF
1642 ALLOCATE(qfricint(ninter))
1643 qfricint(1:ninter) = zero
1644 IF (glob_therm%NODADT_THERM == 1) THEN
1645 IF(iparit == 0 ) THEN
1646 icondn = numnod*nthread
1647 ALLOCATE (condn(icondn), condnsky(0))
1648 ELSE
1649 icondn = numnod
1650 ALLOCATE (condn(icondn),stat=ierr)
1651 ALLOCATE (condnsky(lsky),stat=ierr)
1652 ENDIF
1653 ENDIF
1654 ELSE
1655 ifthe = 1
1656 icondn = 1
1657 ALLOCATE(fthe(ifthe), fthesky(0))
1658 ALLOCATE(qfricint(ninter))
1659 qfricint(1:ninter) = zero
1660 ALLOCATE(condn(icondn),condnsky(0))
1661 ENDIF
1662C
1663 IF (glob_therm%INTHEAT > 0 ) THEN
1664 IF(iparit /= 0 )THEN
1665 ALLOCATE(ftheskyi(lskyi))
1666 ftheskyi(1:lskyi) = 0
1667 ELSE
1668 ALLOCATE(ftheskyi(0))
1669 ENDIF
1670 IF (glob_therm%NODADT_THERM == 1) THEN
1671 IF(iparit /= 0 )THEN
1672 ALLOCATE(condnskyi(lskyi))
1673 ELSE
1674 ALLOCATE(condnskyi(0))
1675 ENDIF
1676 ELSE
1677 ALLOCATE(condnskyi(0))
1678 ENDIF
1679 ELSE
1680 ALLOCATE(ftheskyi(0))
1681 ALLOCATE(condnskyi(0))
1682 ENDIF
1683C
1684C ply xfem for composite shell
1685C
1686 IF(iplyxfem > 0 ) THEN
1687 IF(iparit /= 0 ) THEN
1688 ALLOCATE(plysky(nplymax))
1689cc ALLOCATE(PLYSKYI)
1690 DO i=1,nplymax
1691 NULLIFY(ply(i)%A,plysky(i)%FSKY)
1692 ALLOCATE(ply(i)%A(4,nplyxfe),
1693 . plysky(i)%FSKY(4,lskypxfem))
1694 plysky(i)%FSKY = zero
1695 ply(i)%A = zero
1696 NULLIFY(ply(i)%ITAG)
1697 ALLOCATE(ply(i)%ITAG(nplyxfe))
1698 ply(i)%ITAG = 0
1699 ENDDO
1700 ELSE
1701C is not available iparit = 0
1702 DO i=1,nplymax
1703 NULLIFY(ply(i)%A)
1704 ALLOCATE(ply(i)%A(4,nplyxfe*nthread))
1705 ply(i)%A = zero
1706 ENDDO
1707 ALLOCATE(plysky(0))
1708 ENDIF
1709 IF(anim_ply > 0) THEN
1710 ALLOCATE(vn_nod(3,nplyxfe))
1711 vn_nod = zero
1712 ELSE
1713 ALLOCATE(vn_nod(0,0))
1714 ENDIF
1715 ELSE
1716 ALLOCATE(ply(0),plysky(0))
1717 ENDIF
1718C for interface type 24 + pxfem
1719 IF(intplyxfem > 0 ) THEN
1720 IF(iparit /= 0 ) THEN
1721 ALLOCATE(plyskyi)
1722 NULLIFY(plyskyi%FSKYI)
1723 ALLOCATE(plyskyi%FSKYI(lskyi,5))
1724 plyskyi%FSKYI = zero
1725 ELSE
1726 ALLOCATE(plyskyi)
1727 ENDIF
1728 ELSE
1729 ENDIF
1730C
1731 IF(irigid_mat > 0 ) THEN
1732 ALLOCATE(vrbym(3*nrbym),vrrbym(3*nrbym),
1733 . arbym(3*nrbym),arrbym(3*nrbym))
1734 vrbym = zero
1735 vrrbym = zero
1736 arbym = zero
1737 arrbym = zero
1738 ELSE
1739 ALLOCATE(vrbym(0),vrrbym(0),arbym(0),arrbym(0))
1740 ENDIF
1741
1742C ----------------------------------------------
1743C SIMPLIFIED ALE FORMULATION
1744C ----------------------------------------------
1745 IF( ialelag > 0) THEN
1746 IF(iparit == 0) THEN
1747 ALLOCATE (aflow(3*numnod*nthread))
1748 ALLOCATE(ffsky(0))
1749 ALLOCATE(ifoam(numnod*nthread))
1750 ALLOCATE(ifoam_cont(numnod*nthread))
1751 ELSE
1752 ALLOCATE (aflow(3*numnod))
1753 ALLOCATE(ffsky(3*lsky))
1754 ALLOCATE(ifoam(numnod))
1755 ALLOCATE(ifoam_cont(numnod))
1756 ffsky = zero
1757 ENDIF
1758 aflow = zero
1759 ifoam = 0
1760 ifoam_cont =0
1761 DO i=1,numnod
1762 msf(i) = msnf(i)
1763 ENDDO
1764 ELSE
1765 ALLOCATE(aflow(0),vflow(0),
1766 . dflow(0),wflow(0),
1767 . ffsky(0),ifoam(0),
1768 . ifoam_cont(0) )
1769 ENDIF
1770C
1771 IF(nadmesh/=0)THEN
1772 ALLOCATE(lsh4act(numelc),lsh4kin(numelc),
1773 . psh4act(0:levelmax+1),psh4kin(0:levelmax+1),
1774 . lsh3act(numeltg),lsh3kin(numeltg),
1775 . psh3act(0:levelmax+1),psh3kin(0:levelmax+1),
1776 . stat=ierror)
1777C
1778 IF(ierror/=0) THEN
1779 CALL ancmsg(msgid=153,anmode=aninfo,
1780 . i1=ierror)
1781 CALL arret(2)
1782 END IF
1783
1784 IF (iparit/=0) THEN
1785 ALLOCATE(msh4sky(numelc),msh3sky(numeltg),
1786 . stat=ierror)
1787 IF(ierror/=0) THEN
1788 CALL ancmsg(msgid=153,anmode=aninfo,
1789 . i1=ierror)
1790 CALL arret(2)
1791 END IF
1792 ELSE
1793 ALLOCATE(msh4sky(0),msh3sky(0))
1794 END IF
1795 ALLOCATE(ilevnod(0:numnod),stat=ierr)
1796 IF(ierr/=0) THEN
1797 CALL ancmsg(msgid=20,anmode=aninfo)
1798 CALL arret(2)
1799 END IF
1800 END IF
1801C
1802 IF(istatcnd /= 0)THEN
1803 ALLOCATE(lsh4upl(numelc),lsh3upl(numeltg),
1804 . psh4upl(0:levelmax),psh3upl(0:levelmax),
1805 . stat=ierror)
1806 IF(ierror/=0) THEN
1807 CALL ancmsg(msgid=159,anmode=aninfo,
1808 . i1=ierror)
1809 CALL arret(2)
1810 END IF
1811 ALLOCATE(acnd(3,numnod),arcnd(3,numnod),
1812 . stcnd(nthread*numnod) ,strcnd(numnod),
1813 . stat=ierror)
1814 IF(ierror/=0) THEN
1815 CALL ancmsg(msgid=159,anmode=aninfo,
1816 . i1=ierror)
1817 CALL arret(2)
1818 END IF
1819 ELSE
1820 ALLOCATE(lsh4upl(0),lsh3upl(0),psh4upl(0),psh3upl(0))
1821 ALLOCATE(acnd(0,0),arcnd(0,0),
1822 . stcnd(0) ,strcnd(0) )
1823 END IF
1824c
1825 IF( (anim_n(18) /= 0 .OR. h3d_data%N_SCAL_STIFR /= 0) .AND. iroddl /= 0) THEN
1826 ALLOCATE(stifr_tmp(numnod))
1827 ELSE
1828 ALLOCATE(stifr_tmp(0))
1829 ENDIF
1830 IF( anim_n(19) /= 0 .OR. h3d_data%N_SCAL_STIFN /= 0) THEN
1831 ALLOCATE(stifn_tmp(numnod))
1832 ELSE
1833 ALLOCATE(stifn_tmp(0))
1834 ENDIF
1835C--------------------------------------------
1836C Error estimation / not on Restart file.
1837C--------------------------------------------
1838 IF(anim_ce(2156)/=0 .OR. iadmerrt/=0 .OR.
1839 . h3d_data%SH_SCAL_ERR_THK /= 0)THEN
1840 ALLOCATE(err_thk_sh4(numelc))
1841 ALLOCATE(err_thk_sh3(numeltg))
1842 err_thk_sh4(1:numelc) = zero
1843 err_thk_sh3(1:numeltg) = zero
1844 ELSE
1845 ALLOCATE(err_thk_sh4(0))
1846 ALLOCATE(err_thk_sh3(0))
1847 END IF
1848C
1849 IF(inter_ithknod/=0)THEN
1850 ALLOCATE(thksh4(numelc),thksh3(numeltg),
1851 . thknod(numnod),
1852 . stat=ierror)
1853 IF(ierror/=0) THEN
1854 CALL ancmsg(msgid=20,anmode=aninfo)
1855 CALL arret(2)
1856 END IF
1857 ELSE
1858 ALLOCATE(thksh4(0))
1859 ALLOCATE(thksh3(0))
1860 ALLOCATE(thknod(0))
1861 END IF
1862
1863 IF( anim_ce(2156)/=0 .OR. h3d_data%SH_SCAL_ERR_THK /=0) THEN
1864 CALL my_alloc(area_sh4,numelc)
1865 CALL my_alloc(area_sh3,numeltg)
1866 CALL my_alloc(area_nod,numnod)
1867 CALL my_alloc(thick_sh4,numelc)
1868 CALL my_alloc(thick_sh3,numeltg)
1869 CALL my_alloc(thick_nod,numnod)
1870 ENDIF
1871
1872 IF (iadmerrt/=0) THEN
1873 CALL my_alloc(admerr_area_sh4,numelc)
1874 CALL my_alloc(admerr_area_sh3,numeltg)
1875 CALL my_alloc(admerr_area_nod,numnod)
1876 CALL my_alloc(admerr_thick_sh4,numelc)
1877 CALL my_alloc(admerr_thick_sh3,numeltg)
1878 CALL my_alloc(admerr_thick_nod,numnod)
1879 ENDIF
1880C----------------------------------------------------------
1881C SELECTIVE MASS SCALING
1882C----------------------------------------------------------
1883C for chkpt :: ISMSCH=1
1884 ismsch =1
1885 IF(idtmins /= 0)THEN
1886 ALLOCATE(tagnod_sms(numnod),nativ_sms(numnod),
1887 . tagprt_sms(npart),tagrel_sms(ngroup),
1888 . indx1_sms(numnod),indx2_sms(numnod),
1889 . tagslv_rby_sms(numnod),tagmsr_rby_sms(numnod),
1890 . kad_sms(numnod+1), jad_sms(numnod+1), iad_sms(numnod+1), lad_sms(numnod+1),
1891 . jadc_sms(4*numelc),
1892 . jads_sms(8*numels), jads10_sms(6*numels10),
1893 . jadt_sms(2*numelt),
1894 . jadp_sms(2*numelp),
1895 . jadr_sms(3*numelr),
1896 . jadtg_sms(3*numeltg),
1897 . x_sms(3,numnod), p_sms(3,numnod),
1898 . y_sms(3,numnod), z_sms(3,numnod),
1899 . prec_sms(numnod), xmom_sms(3,numnod),
1900 . prec_sms3(3,numnod),diag_sms3(3,numnod),
1901 . t2main_sms(6,numnod),
1902 . t2fac_sms(numnod),
1903 . stat=ierror)
1904 IF(ierror/=0) THEN
1905 CALL ancmsg(msgid=19,anmode=aninfo,
1906 . c1='(/DT/.../AMS)')
1907 CALL arret(2)
1908 ENDIF
1909 fr_rms(1:nspmd+1)=0
1910 fr_sms(1:nspmd+1)=0
1911 t2main_sms = 0
1912 t2fac_sms = one
1913 ELSEIF(idtmins_int/=0)THEN
1914 ALLOCATE(tagnod_sms(numnod),nativ_sms(0),
1915 . tagprt_sms(0),tagrel_sms(0),
1916 . indx1_sms(numnod),indx2_sms(numnod),
1917 . tagslv_rby_sms(numnod),tagmsr_rby_sms(numnod),
1918 . kad_sms(0), jad_sms(0), lad_sms(0),
1919 . jadc_sms(0),
1920 . jads_sms(0), jads10_sms(0),
1921 . jadt_sms(0),
1922 . jadp_sms(0),
1923 . jadr_sms(0),
1924 . jadtg_sms(0),
1925 . x_sms(3,numnod), p_sms(3,numnod),
1926 . y_sms(3,numnod), z_sms(3,numnod),
1927 . prec_sms(numnod), xmom_sms(3,numnod),
1928 . prec_sms3(3,numnod),diag_sms3(3,numnod),
1929 . t2main_sms(6,numnod),
1930 . t2fac_sms(numnod),
1931 . stat=ierror)
1932 IF(ierror/=0) THEN
1933 CALL ancmsg(msgid=19,anmode=aninfo,
1934 . c1='(/DT/.../AMS)')
1935 CALL arret(2)
1936 ENDIF
1937 tagnod_sms(1:numnod)=0
1938 fr_rms(1:nspmd+1)=0
1939 fr_sms(1:nspmd+1)=0
1940 t2main_sms = 0
1941 t2fac_sms = one
1942 ELSE
1943 ALLOCATE(tagnod_sms(0),nativ_sms(0),
1944 . tagprt_sms(0),tagrel_sms(0),
1945 . indx1_sms(0),indx2_sms(0),
1946 . tagslv_rby_sms(0),tagmsr_rby_sms(0),
1947 . kad_sms(0), jad_sms(0), lad_sms(0),
1948 . jadc_sms(0),
1949 . jads_sms(0), jads10_sms(0),
1950 . jadt_sms(0),
1951 . jadp_sms(0),
1952 . jadr_sms(0),
1953 . jadtg_sms(0),
1954 . x_sms(0,0), p_sms(0,0),
1955 . y_sms(0,0), z_sms(0,0), prec_sms(0),
1956 . xmom_sms(0,0), prec_sms3(0,0),diag_sms3(0,0),
1957 . t2main_sms(0,0),
1958 . t2fac_sms(0))
1959C init pointer
1960 ptr_sms => nativ_sms
1961 END IF
1962 IF(idtmins == 2 .AND. nintstamp /=0)THEN
1963 ALLOCATE(jadi21_sms(nintstamp),
1964 . tagslv_i21_sms(numnod),tagmsr_i21_sms(numnod),
1965 . stat=ierror)
1966 IF(ierror/=0) THEN
1967 CALL ancmsg(msgid=19,anmode=aninfo,
1968 . c1='(/DT/.../AMS)')
1969 CALL arret(2)
1970 ENDIF
1971 ELSE
1972 ALLOCATE(jadi21_sms(0),
1973 . tagslv_i21_sms(0),tagmsr_i21_sms(0))
1974 END IF
1975C --
1976 IF(idtmins /= 0 .OR. idtmins_int /= 0)THEN
1977 ALLOCATE(nodxi_sms(numnod),nodii_sms(numnod),
1978 . stat=ierror)
1979 IF(ierror/=0) THEN
1980 CALL ancmsg(msgid=19,anmode=aninfo,
1981 . c1='(/DT/.../AMS)')
1982 CALL arret(2)
1983 ENDIF
1984 ELSE
1985 ALLOCATE(nodxi_sms(0),nodii_sms(0))
1986 END IF
1987C --
1988 IF(idtmins == 2 .OR. idtmins_int /= 0)THEN
1989 ALLOCATE(mskyi_sms(lskyi_sms),iskyi_sms(lskyi_sms,3),
1990 . jadi_sms(numnod+1),jdii_sms(2*lskyi_sms),
1991 . lti_sms(2*lskyi_sms),
1992 . stat=ierror)
1993 IF(ierror/=0) THEN
1994 CALL ancmsg(msgid=19,anmode=aninfo,
1995 . c1='(/DT/.../AMS)')
1996 CALL arret(2)
1997 ENDIF
1998 ELSE
1999 ALLOCATE(mskyi_sms(0),iskyi_sms(0,0),
2000 . jadi_sms(0),jdii_sms(0),lti_sms(0))
2001 END IF
2002
2003 IF (ireac == 1 ) THEN
2004 ALLOCATE(nodreac(numnod))
2005 ELSE
2006 ALLOCATE(nodreac(0))
2007 ENDIF
2008
2009 IF (igrelem == 1) THEN
2010 ngpe = nthpart
2011 ngrth = nthpart
2012 nelem=numelsg+3*numels16g+numsphg+
2013 . numelcg+numeltgg+numelqg+
2014 . numeltg + numelpg + 2*numelrg
2015 ELSE
2016 ngpe = 0
2017 ngrth = 0
2018 nelem = 0
2019 ENDIF
2020C
2021 IF (igrelem == 1 ) THEN
2022 ALLOCATE(grth(nelem+ngrth+1))
2023 ALLOCATE(igrth(nelem+1))
2024 ELSE
2025 ALLOCATE(grth(1))
2026 ALLOCATE(igrth(1))
2027 ENDIF
2028 igrth = 0
2029 grth = 0
2030 dxancg = zero
2031C------------------------------------------
2032C ALLOCATION IGROUPC AND IGROUPTG
2033C TABLE GIVING GROUP NUMBER FOR SHELLS
2034C ALLOCATION IGROUPS FOR BRICKS
2035C------------------------------------------
2036 igroupflg(1:2)=0
2037 IF(nvolu > 0) igroupflg(1) = 1
2038 DO i=1,nummat
2039 IF(ipm(2,i)/=19.AND.ipm(2,i)/=58) cycle
2040 IF(ipm(4,i) >= 4) igroupflg(1)=1
2041 ENDDO
2042 IF(igroupflg(1) == 1) THEN
2043 ALLOCATE(igroupc(numelc))
2044 ALLOCATE(igrouptg(numeltg))
2045 ELSE
2046 ALLOCATE(igroupc(0))
2047 ALLOCATE(igrouptg(0))
2048 ENDIF
2049 igroupflg(2)=1
2050 ALLOCATE(igroups(numels))
2051C-----------------------------------------------
2052C /IMPDISP/FGEO
2053 fxvel_fgeo = 0
2054C-----------------------------------------------
2055C End Allocations Phase 1
2056C-----------------------------------------------
2057C INTERFACES RENUM
2058 rnum_siz=numnod
2059 ALLOCATE(renum(rnum_siz))
2060C-----------------------------------------------
2061C Sensor Inter
2062C-----------------------------------------------
2063 nisubmax = 0
2064 DO i=1,ninter
2065 nisubmax = max(nisubmax,ipari(36,i))
2066 ENDDO
2067 ALLOCATE(isensint(nisubmax+1,ninter))
2068 isensint(1:nisubmax+1,1:ninter) = 0
2069C-----------------------------------------------
2070 idel7nok_sav=idel7nok
2071C-----------------------------------------------
2072
2073 CALL trace_in(6,0,zero)
2074
2075C-----------------------------------------------
2076C Initialisations
2077C-----------------------------------------------
2078
2079 l1 = 1+nixs*numels + nsvois*nixs
2080 l2 = l1+6*numels10
2081 l3 = l2+12*numels20
2082 ll1 = 1+8*numels
2083 ll2 = ll1+6*numels10
2084 ll3 = ll2+12*numels20
2085 IF(nadmesh/=0.AND.idel7ng>=1)THEN
2086 ALLOCATE(tagtrimc(numelc))
2087 ALLOCATE(tagtrimtg(numeltg))
2088 ELSE
2089 ALLOCATE(tagtrimc(0))
2090 ALLOCATE(tagtrimtg(0))
2091 ENDIF
2092
2093C NITSCHE METHOD
2094 nfacnit =0
2095 IF (nitsche > 0 ) THEN
2096
2097c Element mean stress
2098 ALLOCATE(stressmean(6,numels))
2099
2100c Equivalent nodal force
2101 IF(iparit /= 0 ) THEN
2102 IF(numels10g ==0) THEN
2103 nfacnit = 6
2104 ALLOCATE(forneqsky(18*lsky))
2105 forneqsky(1:18*lsky) = zero
2106 ELSE
2107 nfacnit = 16
2108 ALLOCATE(forneqsky(48*lsky))
2109 forneqsky(1:48*lsky) = zero
2110 ENDIF
2111 ELSE
2112 ALLOCATE(forneqsky(0))
2113 ENDIF
2114 stressmean(1:6,1:numels)=zero
2115 ELSE
2116 ALLOCATE(stressmean(0,0))
2117 ALLOCATE( forneqsky(0))
2118 ENDIF
2119
2120 CALL newskw_init(iskwp,numskw_l,nskwp,numskw_l_send,iskwp_l_send,recvcount)
2121 partsav2(1:2,1:npart) = zero
2122
2123 ! Initialization of INTER_STRUCT structure + allocation
2124 ALLOCATE( inter_struct(ninter) )
2125 ALLOCATE( sort_comm(ninter) )
2126 CALL inter_struct_init(inter_struct,sort_comm)
2127
2128
2129C========================================================================================
2130
2131C save the Python functions into the Python interpreter dictionarry
2132 CALL python_register(python,nodes,numnod,
2133 . ixs, nixs, numels,
2134 . element%SHELL%IXC, nixc, numelc,
2135 . ixp, nixp, numelp,
2136 . ixt, nixt, numelt,
2137 . ixq, nixq, numelq,
2138 . ixtg, nixtg, numeltg,
2139 . ixr, nixr, numelr,
2140 . iparg, ngroup, nparg, mvsiz)
2141
2142 IF(python%NB_FUNCTS > 0) CALL python_share_memory(python,nodes,numnod,
2143 . ixs, nixs, numels,
2144 . element%SHELL%IXC, nixc, numelc,
2145 . ixp, nixp, numelp,
2146 . ixt, nixt, numelt,
2147 . ixq, nixq, numelq,
2148 . ixtg, nixtg, numeltg,
2149 . ixr, nixr, numelr,
2150 . iparg, ngroup, nparg)
2151
2152
2153
2154 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
2155 k2=k1+numels
2156 k3=k2+numelq
2157 k4=k3+numelc
2158 k5=k4+numelt
2159 k6=k5+numelp
2160 k7=k6+numelr
2161 k8=k7
2162 k9=k8+numeltg
2163 CALL funct_python_update_elements(python, ispmd,
2164 . n2d, ngroup, nixc, nixtg, nixs,nixq,
2165 . numgeo, numelc, numeltg, numels, numelq, nummat, numnod,
2166 . nparg, npropg, npropm, npropmi, npropgi,
2167 . snercvois, snesdvois, slercvois, slesdvois,
2168 . sthke, seani, npart,
2169 . elbuf_tab ,iparg ,geo ,
2170 . element%SHELL%IXC ,ixtg , ixs, ixq, pm ,bufmat ,
2171 . eani,
2172 . ipm ,igeo ,thke ,err_thk_sh4 ,err_thk_sh3,
2173 . nodes ,w ,ale_connectivity,
2174 . nercvois ,nesdvois ,lercvois ,lesdvois,
2175 . m51_n0phas, m51_nvphas, stack ,
2176 . ipart(k3:k4-1),ipart(k1:k2-1),ipart(k8:k9-1), ipart(k2:k3-1),
2177 . multi_fvm ,
2178 . mat_elem%MAT_PARAM , fani_cell,glob_therm%ITHERM)
2179
2180C========================================================================================
2181C Initialize SENSORS & communication buffers.
2182C Play Time & Logical sensors.
2183C Reinitialise sensor variables defined in /SENS/RESET
2184
2185 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
2186 k2=k1+numels
2187 k3=k2+numelq
2188 k4=k3+numelc
2189 k5=k4+numelt
2190 k6=k5+numelp
2191 k7=k6+numelr
2192 k8=k7
2193 k9=k8+numeltg
2194 k10=k9+numelx
2195 k11=k10+numsph
2196 k12=k11+numelig3d
2197 CALL sensor_init(subsets,iparg,ngrouc,
2198 . ipart(k3),ipart(k8),ipart(k1),ipart(k2),ipart(k4),
2199 . ipart(k5) ,ipart(k6),sensors,tt ,dt2 ,iout, python ,nthread)
2200
2201
2202C========================================================================================
2203C PARALLEL SECTION (SMP)
2204C========================================================================================
2205
2206 need_comm_int25_solid_erosion = .false.
2207 comm_int25_solid_erosion = 0
2208
2209!$OMP PARALLEL
2210!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
2211!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,N1,GREFTSK,GRELTSK)
2212C Init var parallel SMP
2213 CALL smp_init(
2214 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk,
2215 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
2216 3 greftsk,greltsk)
2217C
2218 CALL resol_init(
2219 1 itsk ,fr_nbcc ,
2220 2 isendto ,ircvfrom ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nodes%ITABM1 ,
2221 3 ipari ,iparg ,nodes%ITAB ,ixs(l1) ,ixs(l2) ,
2222 4 i13a ,i13b ,i13c ,i13d ,i13e ,
2223 5 i13f ,i13g ,i13h ,i13i ,i15a ,
2224 6 i15b ,i15c ,i15d ,i15e ,i15f ,
2225 7 i15g ,i15h ,i15i ,i87a ,i87b ,
2226 8 i87c ,i87d ,i87e ,i87f ,i87g ,
2227 9 nfia ,nfea ,nfoa ,ndma ,ndma2 ,
2228 a nodftsk ,nodltsk ,ndtsk ,numntsk ,ixs(l3) ,
2229 b ixs ,ixq ,element%SHELL%IXC ,ixt ,ixp ,
2230 c ixr ,ixtg ,element%PON, nodes%IKINE ,
2231 d nodes%A ,nodes%AR ,nodes%V ,nodes%VR ,
2232 e nodes%X ,nodes%D ,nodes%MS ,nodes%IN ,nodes%STIFN ,
2233 f nodes%STIFR ,dmas ,diner ,fani ,anin ,
2234 g wa ,uwa ,pm ,geo ,
2235 h partsav ,parts0 ,monvol ,
2236 i i87h ,i87i ,i87j ,i87k ,
2237 j i15j ,kxx ,
2238 k secbuf ,secfcum ,nstrf ,igrnod ,iexlnk ,
2239 l xframe ,
2240 m ixtg1 ,ibcl ,nodes%VISCN ,dd_r2r ,
2241 o elbuf ,ipart ,madprt ,madsh4 ,
2242 p madsh3 ,madsol ,madnod ,madfail ,igeo ,
2243 q intlist ,nbintc ,element%PON%PROCNE ,niskyfi ,nodes%WEIGHT ,
2244 r isizxv ,ilenxv ,addcni2 ,procni2 ,iad_i2m ,
2245 s fr_i2m ,fr_nbcci2,i2size ,fr_mad ,lwibem ,
2246 t lwrbem ,fxbfp ,fxbefw ,fxbedp ,fxbgrp ,
2247 u fxbgrw ,ndin ,
2248 v islen7 ,irlen7 ,islen11 ,irlen11 ,
2249 w lwiflow ,lwrflow ,iflow ,addcnel ,cnel ,
2250 x addtmpl ,ipartl ,npartl ,nfnca ,nftca ,
2251 y i15ath ,i35ath ,ipm ,sh4tree ,ipadmesh ,
2252 z msc ,inc ,sh3tree ,mstg ,intg ,
2253 a ptg ,fthe ,fthesky ,ftheskyi ,nme17 ,
2254 b islen17 ,irlen17 ,irlen7t ,islen7t ,lindidel ,
2255 c lbufidel ,sh4trim ,sh3trim ,mscnd ,incnd ,
2256 d irlen20 ,islen20 ,irlen20t ,islen20t ,nbint20 ,
2257 e irlen20e ,islen20e ,niskyfie ,
2258 f nodes%MCP ,nodes%MS0 ,inod_pxfem,iel_pxfem,iadc_pxfem,
2259 g adsky_pxfem,nodes%ICODT ,nodes%ICODR ,ibfv ,admsms ,
2260 h nodreac ,igrouc ,ngrouc ,igrounc ,ngrounc ,
2261 i fr_rby ,fr_rby6 ,npby ,
2262 j nom_sect ,mcpc ,mcptg ,grth ,igrth ,
2263 k nelem ,lag_sec ,nprw ,diag_sms ,dmelc ,
2264 l dmeltg ,ngrth ,nft2 ,dmels ,dmeltr ,
2265 m dmelp ,dmelrt ,res_sms ,i87l ,irbe2 ,
2266 n lrbe2 ,nmrbe2 ,iad_rbe2 ,fr_rbe2 ,fr_rbe2m ,
2267 o r2size ,lpby ,procne_pxfem,isendp_pxfem,irecvp_pxfem ,
2268 p iadsdp_pxfem,iadrcp_pxfem,fr_nbcc1,rby ,int18kine ,
2269 q nodes%XDP ,i87m ,inod_crk ,iel_crk ,iadc_crk,
2270 r adsky_crk,procne_crk,isendp_crk,irecvp_crk,
2271 s iadsdp_crk,iadrcp_crk ,int24use,ndama2 ,
2272 t igroupc ,igrouptg ,igroups ,igroupflg ,dmint2 ,irbkin_l ,
2273 u nrbykin_l,kindrby ,elbuf_tab ,sensors ,dd_r2r_elem,
2274 v sdd_r2r_elem,kinet, nodes%WEIGHT_MD ,dmsph ,ioldsect,lbufseglo,
2275 w interfaces%INTBUF_TAB ,numsph_glo_r2r, flg_sphinout_r2r,i15k,
2276 y condn ,condnsky,kxfenod2elc ,elcutc ,nodedge,
2277 z iad_edge ,crknodiad,fr_edge ,fr_nbedge ,nodlevxf,
2278 x crkedge ,xfem_tab ,isensint ,nisubmax ,
2279 1 intlist25 ,int24e2euse,tabmp_l ,
2280 2 i87n ,tab_mat,h3d_data,tagtrimc,tagtrimtg ,
2281 3 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
2282 4 igrbeam ,igrspring,igrpart ,forneqs ,int7itied,
2283 5 fxvel_fgeo,failwave,nloc_dmg,pinch_data ,slloadp,
2284 6 nodes%TAG_S_RBY,nfnca2 ,nftca2 ,nodes%IN0 ,sort_comm,stack,output,
2285 7 thke ,nodes%BOUNDARY_SIZE ,sh_offset_tab,
2286 8 need_comm_int25_solid_erosion,comm_int25_solid_erosion ,
2287 9 iskwn ,iframe ,loads ,glob_therm,pblast,rbe3)
2288
2289!$OMP END PARALLEL
2290 IF (alemuscl_param%IALEMUSCL == 0) DEALLOCATE(addtmpl)
2291C========================================================================================
2292C NON PARALLEL SECTION (SMP)
2293C========================================================================================
2294 CALL split_asspar4(element%PON%ADSKY,numnod,nthread,nodft_asspar,nodlt_asspar,element%PON%SADSKY)
2295! shell offset for contact (penalty), should use XYZ instead of X to take into account the offset
2296 IF (sh_offset_tab%NNSH_OSET > 0 .AND. impl_s==0) THEN
2297 ALLOCATE(xyz(3,numnod))
2298 xyz(1:3,1:numnod) = nodes%X(1:3,1:numnod)
2299 CALL offset_nproj(nspmd,numnod,xyz,sh_offset_tab,iparit)
2300 ELSE
2301 ALLOCATE(xyz(3,1))
2302!--- deactivate contact w/ offset
2303 sh_offset_tab%NNSH_OSET = 0
2304 ENDIF
2305
2306 IF (sh_offset_tab%NNSH_OSET > 0) THEN
2307 CALL assign_ptrx(ptrx,xyz,numnod)
2308 ELSE
2309 CALL assign_ptrx(ptrx,nodes%X,numnod)
2310 ENDIF
2311
2312
2313 ! Allocation and initialization of /INT18 + LAW151
2314 ALLOCATE( xcell_remote(ninter) )
2315 CALL int18_alloc(number_inter18,inter18_list,multi_fvm,ipari,xcell_remote,nspmd)
2316 CALL int18_law151_init(multi_fvm,igrbric,ipari ,ixs,
2317 1 igroups ,iparg ,elbuf_tab,multi_fvm%FORCE_INT ,
2318 2 ptrx , nodes%V , nodes%MS , kinet ,
2319 3 multi_fvm%X_APPEND,multi_fvm%V_APPEND,multi_fvm%MASS_APPEND,multi_fvm%KINET_APPEND,
2320 4 multi_fvm%FORCE_INT_PON)
2321
2322
2323 ! allocation & initialization for /FAIL/ALTER
2324 CALL fail_wind_frwave_init(ngroup)
2325 ! Check if ALE elements are deactivated to avoid some mpi comm. in the ALE solver
2326 global_active_ale_element = .false.
2327 CALL check_ale_comm(iparg,elbuf_tab,global_active_ale_element,glob_therm%ITHERM)
2328C End Initialisations //
2329 IF(nadmesh/=0.AND.idel7ng>=1) idel7nok = 0
2330C THERMAL TIME STEP : we don t check incompatible kinematic conditions anymore
2331c we constraint all DDLs
2332 IF (glob_therm%IDT_THERM == 1) THEN
2333 CALL bcsdtth_copy(nodes%ICODT, nodes%ICODR, icodt0, icodr0 ,1 )
2334 ENDIF
2335
2336 ! -----------------
2337 ! Monitored volume : initialization of global frontier array for mpi comm
2338 if(nvolu/=0) then
2339 call init_global_frontier_monvol(ispmd,nspmd,nvolu,nsurf,monvol,
2340 . nimv,volmon,nrvolu,
2341 . fr_mv,frontier_global_mv, t_monvol,igrsurf )
2342 else
2343 frontier_global_mv(1:nspmd+2) = 0
2344 endif
2345 ! Monitored volume : initialization of omp array
2346 call init_monvol_omp_structure(ispmd,nspmd,nvolu,nsurf,monvol,
2347 . nimv,numnod,
2348 . fr_mv,t_monvol,igrsurf )
2349 ! -----------------
2350 i24maxnsne=0
2351 IF (int24use == 1)THEN
2352 ALLOCATE(iad_i24(nbintc+1,nspmd))
2353 sfr_i24=0
2354 CALL spmd_i24_prepare(1,ipari, interfaces%INTBUF_TAB,
2355 * nodes%BOUNDARY_ADD, nodes%BOUNDARY,intlist,nbintc,
2356 * iad_i24 , sfr_i24, idum,i24maxnsne)
2357 ALLOCATE(fr_i24(sfr_i24))
2358 CALL spmd_i24_prepare(2,ipari, interfaces%INTBUF_TAB,
2359 * nodes%BOUNDARY_ADD, nodes%BOUNDARY,intlist,nbintc,
2360 * iad_i24 , sfr_i24, fr_i24,i24maxnsne)
2361C E2E Fictive Node Position, Velocity, Mass
2362 CALL i24e2e_fictive_nodes_update(intlist,nbintc,ipari,interfaces%INTBUF_TAB,
2363 * nodes%X,nodes%V,nodes%MS,nodes%ITAB,xyz,numnod,sh_offset_tab%NNSH_OSET)
2364
2365 ELSE
2366 ALLOCATE(iad_i24(1,1))
2367 ENDIF
2368
2369 CALL init_i25_edge(nledge,ninter,npari,ipari,interfaces%INTBUF_TAB )
2370 IF(ninter25 /= 0)THEN
2371 ALLOCATE(iad_i25(nbintc+1,nspmd))
2372 CALL spmd_i25_prepare(1,ipari, interfaces%INTBUF_TAB,
2373 * nodes%BOUNDARY_ADD, nodes%BOUNDARY,intlist,nbintc,
2374 * iad_i25 , sfr_i25, idum)
2375
2376 ALLOCATE(fr_i25(sfr_i25))
2377 CALL spmd_i25_prepare(2,ipari, interfaces%INTBUF_TAB,
2378 * nodes%BOUNDARY_ADD, nodes%BOUNDARY,intlist,nbintc,
2379 * iad_i25 , sfr_i25, fr_i25)
2380
2381 ELSE
2382 ALLOCATE(iad_i25(1,1))
2383 ENDIF
2384 ALLOCATE(fskyn25(3,nbccnor))
2385 fskyn25=0.
2386C Multidomains + SPH
2387 IF ((numsph_glo_r2r>0).AND.(flg_sphinout_r2r==1)) THEN
2388 ALLOCATE(off_sph_r2r(numnod))
2389 off_sph_r2r(:) = 0
2390 ENDIF
2391
2392C THERMAL EXPANSION and IMPTEMP : Initialisation of nodal temperatures
2393 IF (glob_therm%NFXTEMP > 0 .AND. glob_therm%ITHERM_FE > 0.AND.tt==zero) THEN
2394 CALL fixtemp(python,ibftemp ,fbftemp ,nodes%TEMP ,npc ,tf ,
2395 . nsensor ,sensors%SENSOR_TAB,glob_therm,snpc )
2396 ENDIF
2397C ---------------------
2398C Allocating Array for PCONT2 - average normal
2399C ---------------------
2400 IF (anim_v(27)+h3d_data%N_VECT_PCONT2 > 0) THEN
2401 sz_npcont2 = numnod
2402 ALLOCATE(npcont2(3,numnod))
2403 npcont2 = zero
2404 ELSE
2405 sz_npcont2 = 0
2406 ALLOCATE(npcont2(3,0))
2407 ENDIF
2408C ---------------------
2409C Allocating FEXT Array
2410C ---------------------
2411 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT+
2412 . anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT >0 .or. vipercoupling) THEN
2413 ALLOCATE(noda_fext(3*numnod))
2414 noda_fext(1:3*numnod)=zero
2415 ELSE
2416 ALLOCATE(noda_fext(3))
2417 noda_fext(1:3)=zero
2418 ENDIF
2419C ---------------------
2420C Allocating PEXT Array
2421C ---------------------
2422 CALL output_allocate_noda_pext(numnod, numnodg)
2423C ---------------------
2424 IF (anim_v(19) + h3d_data%N_VECT_CLUST_FORCE > 0) THEN
2425 ALLOCATE(fcluster(3*numnod))
2426 fcluster(1:3*numnod)=zero
2427 ELSE
2428 ALLOCATE(fcluster(3))
2429 fcluster(1:3)=zero
2430 ENDIF
2431 IF (anim_v(20) + h3d_data%N_VECT_CLUST_MOM > 0) THEN
2432 ALLOCATE(mcluster(3*numnod))
2433 mcluster(1:3*numnod)=0
2434 ELSE
2435 ALLOCATE(mcluster(3))
2436 mcluster(1:3)=0
2437 ENDIF
2438!
2439 ! -------------------------
2440 ! initialization of SHOOT_STRUCT for
2441 ! the deactivation node algo
2442 CALL init_nodal_state( ipari,shoot_struct,interfaces%INTBUF_TAB,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
2443 . nodes%ITAB,nodes,geo,addcnel,cnel,
2444 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,
2445 . size_addcnel,size_cnel ,
2446 . numelsg,numelqg,numelcg,numeltrg,numelpg,
2447 . numelrg,numeltgg ,ixs(l1))
2448 ! -------------------------
2449
2450 ! -------------------------
2451 allocate(component(ninter))
2452 call inter_init_component(ninter,npari,numnod,ispmd,nspmd,ipari,nodes%x,interfaces%intbuf_tab,component)
2453 ! -------------------------
2454
2455 ! -------------------------
2456 ! initialization of SPH_WORK
2457 call allocate_sph_work(sph_work,
2458 * numsph,numsph, ! Flag & size for WREDUCE
2459 * sol2sph_flag, numnod, ! Flag for other arrays
2460 * nsphact,numnod,nsphact ) ! Size of as6, a6, as
2461C========================================================================================
2462C NON PARALLEL SECTION (SMP)
2463C========================================================================================
2464
2465 CALL trace_out(6)
2466c-----------------------------------------------
2467c INITIALISATION XFEM
2468c-----------------------------------------------
2469 IF (icrack3d > 0 .and. tt == zero) THEN
2470 CALL inixfem(elbuf_tab ,xfem_tab ,
2471 . iparg ,element%SHELL%IXC ,ixtg ,ngrouc ,igrouc ,
2472 . elcutc ,iadc_crk ,iel_crk ,inod_crk ,adsky_crk ,
2473 . nodes%X ,kxfenod2elc ,nodedge ,crknodiad ,iad_edge ,
2474 . fr_edge ,fr_nbedge ,nodlevxf ,crkedge ,xedge4n ,
2475 . xedge3n )
2476 END IF
2477C-----------------------------------------------
2478C Allocations Phase 2
2479C-----------------------------------------------
2480 ALLOCATE(fthreac(6*cptreac))
2481 IF (impl_s==1) THEN
2482 ALLOCATE(fthdtm(6*cptreac))
2483 ELSE
2484 ALLOCATE(fthdtm(0))
2485 ENDIF
2486C
2487 ! OUTPUT (ANIM,OUTP,H3D,TH) set COMPTREAC TO 1 IF REQUESTED
2488 comptreac = 0
2489 CALL reaction_forces_check_for_requested_output(npby,h3d_data,comptreac) ! Look for options for anim, ... and rbody with failure
2490 IF(comptreac == 1)THEN
2491 ALLOCATE(freac(6*numnod))
2492 freac(1:6*numnod)=zero
2493 ELSE
2494 ALLOCATE(freac(0))
2495 ENDIF
2496C
2497 fthreac = zero
2498 fthdtm = zero
2499 IF (nthpart > 0) THEN
2500 ALLOCATE(gresav(npsav*ngpe*nthread))
2501 ELSE
2502 ALLOCATE(gresav(1))
2503 ENDIF
2504 gresav = zero
2505C ALLOCATION Flying Nodes if IDEL
2506 IF(idel7ng>0)THEN
2507 ierror = 0
2508 ALLOCATE(ibufidel(lbufidel),stat=ierror2)
2509 ierror = ierror + ierror2
2510 ALLOCATE(indidel(lindidel),stat=ierror2)
2511 ierror = ierror + ierror2
2512 IF(int24use==1.OR.ninter25/=0)THEN
2513 ALLOCATE (ibufseglo(lbufseglo),stat=ierror2)
2514 ALLOCATE (indseglo(ninter+1),stat=ierror2)
2515 ENDIF
2516 IF(ierror/=0)THEN
2517 CALL ancmsg(msgid=158,anmode=aninfo,
2518 . i1=ierror)
2519 CALL arret(2)
2520 ENDIF
2521 ELSE
2522 ALLOCATE(ibufidel(0) ,stat=ierror2)
2523 ALLOCATE(indidel(0) ,stat=ierror2)
2524 END IF
2525
2526 IF(nspmd > 1.AND.pdel > 0) THEN
2527 ALLOCATE(ibufpdel(4*nconld+4*npresload),stat=ierr)
2528 ALLOCATE(nindexpdel(nconld+npresload),stat=ierr)
2529 ENDIF
2530
2531C========================================================================================
2532C PARALLEL SECTION (SMP)
2533C========================================================================================
2534
2535C------------IF adaptive Mesh : check if there are elements eroded after trimming to remove nodes from interface------
2536 IF(nadmesh/=0.AND.idel7ng>=1)THEN
2537
2538 l1 = 1+nixs*numels + nsvois*nixs
2539 l2 = l1+6*numels10
2540 l3 = l2+12*numels20
2541 IF((int24use==1.OR.ninter25/=0).AND.idel7nok==1)THEN
2542 indseglo(2:ninter+1)=0
2543 indseglo(1)=1
2544 ENDIF
2545 check_neigh_flag_res = 0
2546 IF (sh_offset_tab%NNSH_OSET > 0) THEN
2547 CALL assign_ptrx(ptrx,xyz,numnod)
2548 ELSE
2549 CALL assign_ptrx(ptrx,nodes%X,numnod)
2550 ENDIF
2551c allocate(nodes%deleted_node(2*numnod)) ! working array to mark nodes connected to deleted element
2552c allocate(nodes%work_array_node(nthread*numnod)) ! working array to mark nodes (connected to active element or deleted element)
2553!$omp parallel
2554!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
2555!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,N1,GREFTSK,GRELTSK,omp_address)
2556C Init var parallel SMP
2557 CALL smp_init(
2558 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk,
2559 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
2560 3 greftsk,greltsk)
2561 omp_address = 1 + itsk * numnod
2562 CALL tagoff3n(nodes,
2563 1 geo ,ixs ,ixs(l1) ,ixs(l1) ,ixs(l3) ,ixq ,
2564 2 element%SHELL%IXC ,ixt ,ixp ,ixr ,ixtg ,
2565 3 nodes%deleted_node,nodftsk ,nodltsk ,iparg ,elbuf ,itsk ,
2566 4 ixtg1 ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nodes%ITAB ,
2567 5 addcnel ,cnel ,kxsp ,elbuf_tab ,tagel ,iexlnk ,
2568 6 igrnod ,dd_r2r ,dd_r2r_elem,sdd_r2r_elem,idel7nok_sav ,
2569 7 idel7nok_r2r,tagtrimc,tagtrimtg,s_elem_state,elem_state,
2570 8 shoot_struct,shoot_struct%GLOBAL_NB_ELEM_OFF)
2571 ! ---------------------
2572 ! check if a node is deactivated and deactivate all the corresponding secondary nodes
2573 CALL check_nodal_state( itsk,nodes%deleted_node,newfront,interfaces%INTBUF_TAB,shoot_struct%SIZE_SEC_NODE,
2574 . shoot_struct%SHIFT_S_NODE,shoot_struct%INTER_SEC_NODE,shoot_struct%SEC_NODE_ID)
2575 ! ---------------------
2576
2577 ! ---------------------
2578 ! check if a surface/edge must be deactivated and save the surface/edge id
2579 IF(itsk==0) THEN
2580 CALL find_surface_inter( nodes%ITAB ,shoot_struct ,ixs ,ixs(l1) ,element%SHELL%IXC ,
2581 . ixtg ,
2582 . ngroup,nparg,igroups,iparg )
2583
2584 CALL find_edge_inter( nodes%ITAB,shoot_struct,ixs,ixs(l1),
2585 1 element%SHELL%IXC,ixtg,ixq,ixt,ixp,
2586 2 ixr,geo,ngroup,igroups,iparg )
2587 ENDIF
2588 CALL my_barrier( )
2589 ! ---------------------
2590
2591 ! ---------------------
2592 ! exchange of surfaces (ie. 4 nodes) to deactivate and deactivation
2593 ! ONLY FOR LOCAL SURFACE / REMOTE ELEMENT
2594 IF(nspmd>1) THEN
2595 IF(itsk==0) CALL spmd_exch_deleted_surf_edge( nodes%BOUNDARY_ADD,nodes,shoot_struct,
2596 . interfaces%INTBUF_TAB,newfront,
2597 . ipari,geo,
2598 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
2599 . addcnel,cnel,nodes%work_array_node(omp_address),tagel )
2600 CALL my_barrier()
2601 ENDIF
2602 ! ---------------------
2603
2604 ! ---------------------
2605 ! loop over the surface id and deactivate the surface
2606 ! ONLY FOR LOCAL SURFACE / LOCAL ELEMENT
2607 CALL check_surface_state( itsk,shoot_struct%SAVE_SURFACE_NB,shoot_struct%SAVE_SURFACE,
2608 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,
2609 . ipari,geo,
2610 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
2611 . addcnel,cnel,nodes%work_array_node(omp_address),tagel,shoot_struct )
2612
2613 ! loop over the edge id and deactivate the edge
2614 ! ONLY FOR LOCAL EDGE / LOCAL ELEMENT
2615 CALL check_edge_state( itsk,shoot_struct%SAVE_M_EDGE_NB,shoot_struct%SAVE_S_EDGE_NB,
2616 . shoot_struct%SAVE_M_EDGE,shoot_struct%SAVE_S_EDGE,
2617 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,newfront,ipari,geo,
2618 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
2619 . addcnel,cnel,nodes%work_array_node(omp_address),tagel,shoot_struct )
2620 ! ---------------------
2621
2622 ! ---------------------
2623 ! exchange of deactivated surfaces (ie. 4 nodes) to deactivate to deactivate the neighbourhood
2624 ! ONLY FOR REMOTE SURFACE + interface type 24 or 25
2625 IF(int24use>0.OR.ninter25/=0) THEN
2626 IF(itsk==0) CALL check_remote_surface_state( shoot_struct%NUMBER_REMOTE_SURF,shoot_struct%REMOTE_SURF,
2627 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,
2628 . ipari,nodes%BOUNDARY_ADD,shoot_struct )
2629 CALL my_barrier()
2630 IF(ninter25/=0.AND.interfaces%PARAMETERS%INT25_EROSION_SOLID > 0) THEN
2631 IF(itsk==0) THEN
2632 check_neigh_flag = shoot_struct%NUMBER_NEW_SURF + shoot_struct%NUMBER_REMOTE_SURF
2633 IF(need_comm_int25_solid_erosion) THEN
2634 CALL spmd_allreduce(check_neigh_flag,check_neigh_flag_res,1,spmd_max,comm_int25_solid_erosion)
2635 ELSEIF(nspmd==1) THEN
2636 check_neigh_flag_res = check_neigh_flag
2637 ENDIF
2638 IF(check_neigh_flag_res > 0 ) THEN
2639 CALL get_neighbour_surface( ispmd,nspmd,ninter25,npari,ninter,
2640 . nbintc,nixs,nixc,nixtg,numnod,
2641 . numels,numelc,numeltg,s_elem_state,
2642 . nbddedgt,nbddedg_max,
2643 . elem_state,ipari,intlist,nodes,
2644 . newfront,ixs,element%SHELL%IXC,ixtg,
2645 . nodes%BOUNDARY_ADD,ptrx,
2646 . interfaces%INTBUF_TAB,interfaces%SPMD_ARRAYS,shoot_struct )
2647 ENDIF
2648 ENDIF
2649 CALL my_barrier()
2650 ENDIF
2651 ENDIF
2652 ! ---------------------
2653
2654 CALL chkstfn3n(nodes,
2655 1 ipari ,geo ,ixs ,ixq ,element%SHELL%IXC ,ixt ,
2656 2 ixp ,ixr ,ixtg ,nodes%deleted_node,iparg ,itsk ,
2657 3 newfront,nodes%work_array_node(omp_address) ,nodes%MS ,nodes%IN ,anin(ndma+1),nodes%ITAB ,
2658 4 nodes%ITABM1 ,addcnel , cnel ,indidel ,nindex1 ,nindex2 ,
2659 5 nindex3 ,nindex4 ,tagel ,int24use ,ibufseglo ,indseglo,
2660 6 ibufidel ,interfaces%INTBUF_TAB,nodes%BOUNDARY_ADD)
2661
2662
2663!$OMP END PARALLEL
2664 CALL dealloc_shoot_inter( shoot_struct )
2665 ENDIF
2666
2667
2668 ! TETRA4 : SMOOTH FINITE ELEMENT FORMULATIONS
2669 IF(isfem >= 1) THEN
2670 s_sfem_nodvar = 2*numnod
2671 ELSE
2672 s_sfem_nodvar = 1
2673 ENDIF
2674 ALLOCATE(sfem_nodvar(s_sfem_nodvar))
2675 ALLOCATE(sfem_nodvar_ale(s_sfem_nodvar))
2676
2677C========================================================================================
2678C NON PARALLEL SECTION (SMP)
2679C========================================================================================
2680
2681C----------------------------------------------------------
2682C SELECTIVE MASS SCALING
2683C----------------------------------------------------------
2684 IF(idtmins_int /= 0)THEN
2685C
2686C /DT/INTER/AMS
2687 CALL sms_ini_err(nprw ,lprw ,kinet )
2688C
2689 END IF
2690C----------------------------------------------------------
2691 IF(idtmins /= 0)THEN
2692 l1 = 1+nixs*numels + nsvois*nixs
2693 l2 = l1+6*numels10
2694 l3 = l2+12*numels20
2695
2696C NATIV_SMS read from starter state
2697 nativ_sms(1:numnod) = nativ0_sms(1:numnod)
2698C
2699 CALL sms_ini_part(igrpart ,tagprt_sms)
2700
2701 IF(idtmins_int==0)
2702 . CALL sms_ini_rby(
2703 1 kinet ,nprw ,lprw ,npby , lpby ,
2704 2 tagmsr_rby_sms,tagslv_rby_sms)
2705
2706 CALL sms_ini_kad(
2707 1 ixs ,ixq ,element%SHELL%IXC ,ixt ,ixp ,
2708 2 ixr ,ixtg ,ixtg1 ,ixs(l1) ,ixs(l3) ,
2709 3 ixs(l2) ,iparg ,nodes%MS ,nodes%MS0 ,tagnod_sms,
2710 4 nodes%ICODT ,nodes%ICODR ,kinet ,indx1_sms,
2711 5 kad_sms ,ipart(i15a),ipart(i15b),
2712 6 ipart(i15c),ipart(i15d),ipart(i15e),ipart(i15f),ipart(i15g),
2713 7 ipart(i15h),ipart(i15i),tagprt_sms ,tagrel_sms ,nodes%ITAB ,
2714 8 nodes%WEIGHT ,irbe2 ,rbe3%IRBE3 ,lrbe2 ,rbe3%LRBE3 ,
2715 9 nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nprw ,lprw ,ipart ,
2716 a igeo ,nativ_sms )
2717
2718 ALLOCATE(kdi_sms(knz_sms),pk_sms(knz_sms),stat=ierror)
2719 IF(ierror/=0) THEN
2720 CALL ancmsg(msgid=19,anmode=aninfo,
2721 . c1='(/DT/.../AMS)')
2722 CALL arret(2)
2723 ENDIF
2724
2725 nsgdone=1
2726 CALL sms_ini_kdi(
2727 2 element%SHELL%IXC ,iparg ,ixs ,ixt ,ixp ,
2728 3 ixr ,ixtg ,ixs(l1) ,tagnod_sms,kad_sms ,
2729 4 kdi_sms ,jadc_sms,jads_sms ,jads10_sms ,
2730 5 jadt_sms ,jadp_sms,
2731 6 jadr_sms,jadtg_sms,indx1_sms,tagprt_sms,iad_sms ,
2732 7 tagrel_sms,ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
2733 8 ipart(i15e),ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),
2734 9 nodes%BOUNDARY_ADD ,nodes%BOUNDARY,npby ,lpby ,kinet ,
2735 a tagslv_rby_sms,ipari ,interfaces%INTBUF_TAB,iadi2,
2736 b lad_sms ,ipart,igeo ,nodes%WEIGHT ,
2737 c nativ_sms)
2738
2739 ALLOCATE(idi_sms(nnz_sms),jdi_sms(nnz_sms),stat=ierror)
2740 IF(ierror/=0) THEN
2741 CALL ancmsg(msgid=19,anmode=aninfo,
2742 . c1='(/DT/.../AMS)')
2743 CALL arret(2)
2744 ENDIF
2745
2746 nsgdone=1
2747 CALL sms_ini_jad_1(
2748 2 element%SHELL%IXC ,iparg ,ixs ,ixt ,ixp ,
2749 3 ixr ,ixtg ,ixs(l1) ,tagnod_sms,jadc_sms ,
2750 4 jads_sms ,jads10_sms,jadt_sms,jadp_sms ,jadr_sms ,
2751 5 jadtg_sms,indx1_sms,tagprt_sms,
2752 6 kad_sms,kdi_sms ,pk_sms ,
2753 7 tagrel_sms,ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
2754 8 ipart(i15e),ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),
2755 9 nodes%BOUNDARY_ADD ,nodes%BOUNDARY,npby ,lpby ,kinet ,
2756 a tagslv_rby_sms,ipari ,interfaces%INTBUF_TAB,iadi2,
2757 b lad_sms ,ipart ,igeo ,nodes%WEIGHT ,nativ_sms,
2758 c iad_sms ,idi_sms,jad_sms ,jdi_sms ,t2main_sms)
2759 DEALLOCATE(jdi_sms)
2760
2761 ALLOCATE(jdi_sms(nnz_sms),stat=ierror)
2762 IF(ierror/=0) THEN
2763 CALL ancmsg(msgid=19,anmode=aninfo,
2764 . c1='(/DT/.../AMS)')
2765 CALL arret(2)
2766 ENDIF
2767
2768 nsgdone=1
2769 CALL sms_ini_jad_2(
2770 2 element%SHELL%IXC ,iparg ,ixs ,ixt ,ixp ,
2771 3 ixr ,ixtg ,ixs(l1) ,tagnod_sms,jadc_sms ,
2772 4 jads_sms ,jads10_sms,jadt_sms ,jadp_sms,jadr_sms ,
2773 5 jadtg_sms,indx1_sms,tagprt_sms,kad_sms ,kdi_sms ,
2774 6 tagrel_sms,ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
2775 7 ipart(i15e),ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),
2776 8 nodes%BOUNDARY_ADD ,nodes%BOUNDARY,npby ,lpby ,kinet ,
2777 9 tagslv_rby_sms,ipari ,interfaces%INTBUF_TAB,iadi2 ,
2778 a lad_sms ,nprw ,lprw,tagmsr_rby_sms,
2779 b tagslv_i21_sms ,tagmsr_i21_sms, jadi21_sms,intstamp ,
2780 . ipart ,
2781 c igeo ,nodes%WEIGHT ,nativ_sms,irbe2 ,lrbe2 ,
2782 d iad_sms ,idi_sms ,jad_sms ,jdi_sms ,t2main_sms)
2783 DEALLOCATE(jdi_sms)
2784 ALLOCATE(jdi_sms(nnz_sms),stat=ierror)
2785 IF(ierror/=0) THEN
2786 CALL ancmsg(msgid=19,anmode=aninfo,
2787 . c1='(/DT/.../AMS)')
2788 CALL arret(2)
2789 ENDIF
2790 ALLOCATE(jsm_sms(nnz_sms),stat=ierror)
2791 IF(ierror/=0) THEN
2792 CALL ancmsg(msgid=19,anmode=aninfo,
2793 . c1='(/DT/.../AMS)')
2794 CALL arret(2)
2795 ENDIF
2796
2797 nsgdone=1
2798 CALL sms_ini_jad_3(
2799 2 element%SHELL%IXC ,iparg ,ixs ,ixt ,ixp ,
2800 3 ixr ,ixtg ,ixs(l1) ,tagnod_sms,jadc_sms,
2801 4 jads_sms ,jads10_sms,jadt_sms,jadp_sms,jadr_sms ,
2802 5 jadtg_sms,indx1_sms,tagprt_sms,kad_sms,kdi_sms ,
2803 6 tagrel_sms,ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
2804 7 ipart(i15e),ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),
2805 8 nodes%BOUNDARY_ADD ,nodes%BOUNDARY,npby ,lpby ,kinet ,
2806 9 tagslv_rby_sms,ipari ,interfaces%INTBUF_TAB,iadi2 ,
2807 a lad_sms ,jsm_sms ,tagslv_i21_sms,intstamp ,ipart ,
2808 b igeo ,tagmsr_rby_sms,nodes%WEIGHT,nativ_sms,
2809 c iad_sms ,idi_sms ,jad_sms ,jdi_sms ,t2main_sms)
2810
2811 DEALLOCATE(iad_sms,idi_sms)
2812
2813 ALLOCATE(ltk_sms(knz_sms),lt_sms(nnz_sms),stat=ierror)
2814 IF(ierror/=0) THEN
2815 CALL ancmsg(msgid=19,anmode=aninfo,
2816 . c1='(/DT/.../AMS)')
2817 CALL arret(2)
2818 ENDIF
2819
2820 ALLOCATE(tag_lnk_sms(nrlink+nlink+njoint),
2821 . nrwl_sms(slprw),
2822 . stat=ierror)
2823 IF(ierror/=0) THEN
2824 CALL ancmsg(msgid=19,anmode=aninfo,
2825 . c1='(/DT/.../AMS)')
2826 CALL arret(2)
2827 ENDIF
2828
2829 IF(idtmins==1)THEN
2830C Obsolete
2831 ELSE
2832 CALL sms_ini_kin_2(
2833 1 ilink ,llink ,nnlink ,lnlink ,tag_lnk_sms,
2834 2 fr_ll ,fr_rl ,nodes%WEIGHT ,nodes%ITAB ,ljoint ,
2835 3 iadcj ,fr_cj ,nprw ,lprw ,fr_wall ,
2836 4 nrwl_sms ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY )
2837 END IF
2838
2839 IF(idtmins_int/=0)THEN
2840C re-tag rigid bodies (all nodes)
2841 CALL sms_ini_rby(
2842 1 kinet ,nprw ,lprw ,npby , lpby ,
2843 2 tagmsr_rby_sms,tagslv_rby_sms)
2844 END IF
2845
2846 CALL sms_ini_int(
2847 1 ipari ,interfaces%INTBUF_TAB ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist,
2848 2 nbintc)
2849
2850 ELSEIF(idtmins_int/=0)THEN
2851C
2852C /DT/INTER/AMS
2853 ALLOCATE(kdi_sms(0),jdi_sms(0),pk_sms(0),lt_sms(0),ltk_sms(0),
2854 . jsm_sms(0),
2855 . tag_lnk_sms(nrlink+nlink+njoint),nrwl_sms(slprw),
2856 . stat=ierror)
2857 IF(ierror/=0) THEN
2858 CALL ancmsg(msgid=19,anmode=aninfo,
2859 . c1='(/DT/.../AMS)')
2860 CALL arret(2)
2861 ENDIF
2862
2863 nindx1_sms=0
2864 nsmspcg=min(nsmspcg,numnodg)
2865
2866 CALL sms_ini_kin_2(
2867 1 ilink ,llink ,nnlink ,lnlink ,tag_lnk_sms,
2868 2 fr_ll ,fr_rl ,nodes%WEIGHT ,nodes%ITAB ,ljoint ,
2869 3 iadcj ,fr_cj ,nprw ,lprw ,fr_wall ,
2870 4 nrwl_sms ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY )
2871
2872 CALL sms_ini_rby(
2873 1 kinet ,nprw ,lprw ,npby , lpby ,
2874 2 tagmsr_rby_sms,tagslv_rby_sms)
2875
2876 CALL sms_ini_int(
2877 1 ipari ,interfaces%INTBUF_TAB ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist,
2878 2 nbintc)
2879
2880 ELSE
2881 ALLOCATE(kdi_sms(0),jdi_sms(0),pk_sms(0),lt_sms(0),ltk_sms(0),
2882 . jsm_sms(0),
2883 . tag_lnk_sms(0),nrwl_sms(0))
2884 END IF
2885
2886C
2887 IF (m_vs_sms>0) THEN
2888 lnzm=m_vs_sms+3
2889 ALLOCATE(proj_s(numnod,lnzm),proj_t(numnod,lnzm),
2890 . proj_la_1(lnzm),
2891 . proj_w(3*lnzm),proj_k(lnzm,lnzm),
2892 . stat=ierr)
2893 IF (ierr/=0) THEN
2894 CALL ancmsg(msgid=19,anmode=aninfo,
2895 . c1='(/DT/.../AMS)')
2896 CALL arret(2)
2897 ENDIF
2898 proj_s = zero
2899 ncg_run_sms = 0
2900 ELSE
2901 ALLOCATE(proj_s(0,0),proj_t(0,0),
2902 . proj_la_1(0),
2903 . proj_w(0),proj_k(0,0))
2904 END IF
2905C---------------------------------------------------------------------
2906C DEBUG MATRIX AMS
2907C---------------------------------------------------------------------
2908 IF (idtmins/=0.AND.debug(macro_debug_ams)==1) THEN
2909 IF(nspmd > 1) THEN
2910 IF (ispmd==0) THEN
2911 siz = numnodg
2912 ELSE
2913 siz = 0
2914 END IF
2915 CALL spmd_collectm(tagnod_sms,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB,siz)
2916 ELSE
2917 CALL collectm(tagnod_sms,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB)
2918 END IF
2919 END IF
2920C---------------------------------------------------------------------
2921C AMS + POFF
2922C---------------------------------------------------------------------
2923 IF(idtmins/=0.AND.iparit==0)THEN
2924 ALLOCATE(uncomp_fr(numnod))
2925 ALLOCATE(uncomp_fri2m(numnod))
2926
2927 CALL ams_prepare_poff_assembly(
2928 * nodes%BOUNDARY_ADD,nodes%BOUNDARY,nb_fr,uncomp_fr,
2929 * iad_i2m,fr_i2m,nb_fri2m,uncomp_fri2m)
2930
2931 ALLOCATE(fr_loc(nb_fr))
2932 fr_loc(1:nb_fr) = uncomp_fr(1:nb_fr)
2933
2934 ALLOCATE(fr_loci2m(nb_fri2m))
2935 fr_loci2m(1:nb_fri2m) = uncomp_fri2m(1:nb_fri2m)
2936
2937
2938 DEALLOCATE(uncomp_fr)
2939 DEALLOCATE(uncomp_fri2m)
2940
2941 ELSE
2942 ALLOCATE(fr_loc(1))
2943 ALLOCATE(fr_loci2m(1))
2944 ENDIF
2945
2946C========================================================================================
2947C NON PARALLEL SECTION (SMP)
2948C========================================================================================
2949
2950C ALLOCATION OF WORKING ARRAYS FOR AIRBAG BEM
2951C
2952 ALLOCATE(wibem(lwibem), wrbem(lwrbem), stat=ierror)
2953 IF (ierror/=0) THEN
2954 CALL ancmsg(msgid=160,anmode=aninfo,
2955 . i1=ierror)
2956 CALL arret(2)
2957 ENDIF
2958 DO i=1,lwibem
2959 wibem(i)=0
2960 ENDDO
2961 ALLOCATE(wiflow(lwiflow), wrflow(lwrflow), stat=ierror)
2962 IF (ierror/=0) THEN
2963 CALL ancmsg(msgid=160,anmode=aninfo,
2964 . i1=ierror)
2965 CALL arret(2)
2966 ENDIF
2967 DO i=1,lwiflow
2968 wiflow(i)=0
2969 ENDDO
2970C
2971C Allocation interface 17
2972C
2973 ALLOCATE(eminx(nme17*6))
2974C
2975 IF (nfxbody>0) THEN
2976 DO n=1,nfxbody
2977 adrnod=fxbipm(6,n)
2978 onof=1
2979 onfelt=0
2980 CALL fxbypid(
2981 . iparg , ixs , ixq , element%SHELL%IXC ,
2982 . ixt , ixp , ixr , ixtg , fxbipm(1,n),
2983 . fxbnod(adrnod), onof , wa , onfelt ,elbuf_tab )
2984 ENDDO
2985 END IF
2986C
2987
2988C dt2s=0 => shells computation at 1st cycle next to restart
2989 IF(mcheck==0) dt2s=0.0
2990 IF(mcheck/=0) dt2save = dt2
2991C------------RBE3----allocation-------------
2992 IF(nrbe3>0)THEN
2993 nmt0 = rbe3%lrbe3_sz/2
2994 IF (nmt0>0) THEN
2995 CALL prerbe3p0(rbe3)
2996 END IF
2997 END IF
2998C----------------------------------
2999C IMPLICIT SIZES [MONO THREAD]
3000C Double precision only
3001C----------------------------------
3002 IF (impl_s==1.OR.neig>0) THEN
3003#if defined(MYREAL8) && !defined(WITHOUT_LINALG)
3004 ALLOCATE (elbuf_imp(ngroup))
3005 CALL alloc_elbuf_imp(elbuf_tab,elbuf_imp,ngroup, iparg)
3006 IF (imon>0) CALL startime(timers,34)
3007 IF (imon>0) CALL startime(timers,31)
3008 l1 = 1+nixs*numels + nsvois*nixs
3009 l2 = l1+6*numels10
3010 l3 = l2+12*numels20
3011 CALL imp_sol_init(
3012 1 geo ,npby ,lpby ,nodes%ITAB ,
3013 2 ipari ,ixs ,ixq ,element%SHELL%IXC ,ixt ,
3014 4 ixp ,ixr ,ixtg ,ixtg1 ,ixs(l1) ,
3015 5 ixs(l2) ,ixs(l3) ,iparg ,
3016 6 elbuf ,nint7 ,nbintc ,nodes%X ,dmcp ,
3017 7 nodes%BOUNDARY ,nodes%BOUNDARY_ADD ,fr_i2m ,iad_i2m ,
3018 8 nprw ,num_imp1 ,num_impl ,monvol ,igrsurf ,
3019 9 fr_mv ,ipm ,igeo ,iad_rby ,
3020 a fr_rby ,sh4tree ,sh3tree ,rbe3%IRBE3 ,rbe3%LRBE3 ,
3021 b rbe3%mpi%FR_RBE3 ,rbe3%mpi%IAD_RBE3 ,irbe2 ,lrbe2 ,ibfv ,
3022 c vel ,elbuf_tab ,iframe ,interfaces%INTBUF_TAB,
3023 d nddl0 ,nnzk0 ,impbuf_tab)
3024 IF (imon>0) CALL stoptime(timers,31)
3025 IF (imon>0) CALL stoptime(timers,34)
3026C
3027 ns_imp=>impbuf_tab%CAND_N
3028 ne_imp=>impbuf_tab%CAND_E
3029 ind_imp=>impbuf_tab%INDSUBT
3030 fext_imp=>impbuf_tab%AC
3031 r_imp=>impbuf_tab%R_IMP
3032 ALLOCATE(fac_k(0), ipiv_k(0))
3033 IF (imumpsv >0.OR.(isolv==7.AND.nspmd>1)) THEN
3034#if defined(MUMPS5)
3035 CALL spmd_mumps_ini(mumps_par, 1)
3036#else
3037 WRITE(6,*) __line__,"Fatal error: MUMPS required"
3038 CALL flush(6)
3039 CALL arret(5)
3040#endif
3041 ALLOCATE(cddlp(nddl0))
3042 ENDIF
3043 ibuck= ibuckl
3044C----------------------------------
3045C EIGENSOLVER [MONO THREAD]
3046C----------------------------------
3047C------ one routine for EIG
3048 IF (neig>0) THEN
3049 CALL trace_in(3,ncycle,zero)
3050#ifdef DNC
3051 CALL imp_eigsol(
3052 1 eigipm , eigrpm , nodes%MS ,nodes%IN , eigibuf ,
3053 2 nodes%X ,ixtg1 ,tf , npc , fr_wave ,
3054 3 w16 , wa ,
3055 4 nodes%ICODT , nodes%ICODR , nodes%ISKEW ,ibfv , vel ,
3056 4 nodes%V , nodes%A , elbuf , ixs , ixq ,
3057 5 element%SHELL%IXC , ixt , ixp , ixr , ixtg ,
3058 6 pm , geo , fani , icut , skews%SKEW ,
3059 7 xcut ,fani(1,1+nfia), nodes%ITAB ,fani(1,1+nfea),fani(1,1+nfoa),
3060 8 anin , lpby , npby , nstrf , rwbuf ,
3061 9 nprw , tani , elbuf_tab ,mat_elem%MAT_PARAM, dd_iad ,
3062 a nodes%BOUNDARY_ADD , nodes%BOUNDARY , nodes%WEIGHT , eani , ipart ,
3063 b rby , nom_opt , igrsurf ,
3064 c bufsf , idata , rdata , bufmat , bufgeo ,
3065 d kxx , ixx , kxsp , ixsp , nod2sp ,
3066 e spbuf , ixs(l1) , ixs(l2) , ixs(l3) , nodes%VR ,
3067 f monvol , volmon , ipm , igeo , iparg ,
3068 g nodes%NODGLOB , nodes%BOUNDARY_ADD , nodes%BOUNDARY , fr_sec , fr_rby2 ,
3069 h iad_rby2 , fr_wall , ipari ,
3070 i interfaces%INTBUF_TAB , nodes%D ,partsav ,
3071 j fsav(1,nfnca+1),fsav(1,nftca+1), nodes%TEMP , thke ,
3072 k err_thk_sh4 , err_thk_sh3 , irbe2 , rbe3%IRBE3 ,lrbe2 ,
3073 l rbe3%LRBE3 , rbe3%FRBE3 ,fr_rbe2 , rbe3%mpi%fr_rbe3 , iad_rbe2,
3074 m nodes%WEIGHT_MD , cluster , fcluster , mcluster , xfem_tab,
3075 o w , nv46 , nercvois , nesdvois,
3076 p lercvois , lesdvois ,crkedge , indx_crk , xedge4n ,
3077 q xedge3n ,stack ,sph2sol ,nodes%STIFN ,nodes%STIFR ,
3078 r drape_sh4n , drape_sh3n ,h3d_data ,subsets ,igrnod ,
3079 s fcont_max ,fani(1,nfnca2+1),fani(1,nftca2+1), ale_connectivity ,
3080 t itask ,nddl0 ,nnzk0 ,impbuf_tab , drapeg,
3081 u glob_therm, output ,multi_fvm)
3082#endif
3083 dt2 = max(em20,tstop-tt)
3084 mstop=2
3085 GOTO 300
3086 END IF !IF (NEIG>0) THEN
3087#endif
3088 ELSE
3089 impl_s0 = 0
3090 imp_dum(1)=0
3091 ns_imp => imp_dum
3092 ne_imp => imp_dum
3093 ind_imp=> imp_dum
3094 num_imp=0
3095 ismdisp=0
3096 END IF !IF (IMPL_S==1.OR.NEIG>0) THEN
3097C------------------------------------------------------
3098C Fin Implicit [MONO THREAD]
3099C------------------------------------------------------
3100C------------------------------------------------------
3101C other initializations [MONO THREAD]
3102C------------------------------------------------------
3103 onofp=0
3104 iad1 = 0
3105 iad2 = 0
3106 iad1b= 0
3107 IF (iparit>0) THEN
3108 iad1 = 1
3109 IF(ivector==1)THEN
3110 iad1b = iad1+numnod+1
3111 iad2 = iad1b+numnod
3112 ELSE
3113 iad1b = iad1
3114 iad2 = iad1b+numnod+1
3115 ENDIF
3116 ENDIF
3117 IF(numsph/=0)THEN
3118 IF(scodver>=44.AND.sminver<3)
3119 . CALL sphres44b(kxsp ,ixsp ,nod2sp ,iparg ,spbuf )
3120 ENDIF
3121C------------------------------------------------------
3122C SPH pointers
3123C------------------------------------------------------
3124 ksph1 =1+3*numsph
3125 ksph21 =numsph+1
3126 ksph22 =ksph21+16*numsph
3127 ksph23 =ksph22+min(iun,nsphio)*3*numsph
3128 kspactiv=1
3129 IF(nsphsol==0)THEN
3130C pointer to list of particles to be sorted (to be sorted == active)
3131 ksp2sort=1
3132 ELSE
3133C to be sorted > active
3134 ksp2sort=ksph23
3135 END IF
3136
3137C-------------------------------
3138C POINTERS FOR USER ROUTINES
3139C-------------------------------
3140 CALL sav_buf_point(pm,1)
3141 CALL sav_buf_point(bufmat,2)
3142 CALL sav_buf_point(geo,3)
3143 CALL sav_buf_point(bufgeo,4)
3144 CALL sav_buf_point(npc,5)
3145 CALL sav_buf_point(tf,6)
3146 CALL sav_buf_point(iskwn,9)
3147 CALL sav_buf_point(skews%SKEW,10)
3148 CALL sav_buf_point(laccelm,11)
3149 CALL sav_buf_point(accelm,12)
3150 CALL sav_buf_point(nodes%ITABM1,13)
3151 CALL sav_buf_point(nodes%X,14)
3152 CALL sav_buf_point(nodes%D,15)
3153 CALL sav_buf_point(nodes%V,16)
3154 CALL sav_buf_point(nodes%A,17)
3155 CALL sav_buf_point(nodes%V,16)
3156 CALL sav_buf_point(nodes%A,17)
3157 CALL sav_buf_point(nodes%WEIGHT,18)
3158 CALL sav_buf_point(ipm,19)
3159 CALL sav_buf_point(igeo,20)
3160
3161C ----------------------------------------------
3162C Specific Initializations
3163C ----------------------------------------------
3164
3165#ifdef DNC
3166 madymo_del_global=0
3167 madymo_del=0
3168 IF(imadcpl==1)THEN
3169
3170 ALLOCATE(mad_tag_sol(numels))
3171 ALLOCATE(mad_tag_sh(numelc))
3172 ALLOCATE(mad_tag_tg(numeltg))
3173 ALLOCATE(mad_fail_elements(nmadsol+nmadsh4+nmadsh3))
3174 mad_tag_sol(1:numels)=0
3175 mad_tag_sh(1:numelc)=0
3176 mad_tag_tg(1:numeltg)=0
3177 mad_fail_elements(1:nmadsol+nmadsh4+nmadsh3) = 0
3178
3179 ALLOCATE(madclfrecv(3,madclnods))
3180
3181 CALL initial_data_exch_madcpl(nodes%X,nodes%A,nodes%V,nodes%MS,madclnod)
3182
3183C Implementing a dummy Madymo cycle
3184 CALL dummy_cycle_madcpl(nodes%X,madclnod)
3185
3186 ENDIF
3187#endif
3188
3189 IF(ninter25 /= 0) THEN
3190 CALL spmd_i25front_init(nodes%ITAB,nodes%MAIN_PROC,interfaces%INTBUF_TAB,ipari)
3191 ELSE
3192 ninter25e = 0
3193 ENDIF
3194
3195 nfvbag = 0
3196 check_npolh = .false.
3197 IF(nvolu>0)THEN
3198 CALL fvdim(monvol)
3199 CALL fv_switch_crit(monvol,check_npolh)
3200 ENDIF
3201C Save the number of FVMBAG before switches to UP
3202 nfvbag0 = nfvbag
3203
3204
3205 IF( ninter /= 0 ) THEN
3206C Bucket or voxel, depending on /PERF/ in 1.rad
3207 CALL init_interf_sorting_strategy(interfaces%INTBUF_TAB,ninter)
3208C First: try with reduced bounding box
3209 CALL init_trim(ninter)
3210 ENDIF
3211
3212 ! ----------------------
3213 ! user library : initialization
3214 IF(dlib_struct(id_engine_user_initialize)%DLIB_BOOL) THEN
3215 nspmd_user = nspmd
3216 ntask_user = nthread
3217 ispmd_user = ispmd
3218 CALL engine_user_initialize(nspmd_user,ntask_user,ispmd_user)
3219 ENDIF
3220 ! ----------------------
3221 CALL python_update_time(tt,dt2)
3222 CALL python_update_nodal_entities(numnod, nodes, x=nodes%X,a=nodes%A,v=nodes%V,d=nodes%D,dr=nodes%DR,vr=nodes%VR)
3223 CALL python_sync(python%CONTEXT)
3224 IF(nvolu > 0)THEN
3225 IF(python%NB_FUNCTS > 0) THEN
3226 k1 = 1
3227 kk1 = 0
3228 DO i=1,nvolu
3229 t_monvol(i)%pressure = volmon(kk1+12)
3230 t_monvol(i)%temperature = volmon(kk1+13)
3231 t_monvol(i)%area = volmon(kk1+18)
3232 t_monvol(i)%volume = volmon(kk1+16)
3233 k1 = k1 + nimv
3234 kk1 = kk1 + nrvolu
3235 END DO
3236 CALL python_monvol(t_monvol)
3237 ENDIF
3238 ENDIF
3239C
3240
3241 IF(coupling%active) THEN
3242 ! ALLOCATION AND INITIALIZATION OF COUPLING COUPLING
3243 ALLOCATE(nodes%FORCES(3,numnod))
3244 nodes%FORCES = zero
3245 call coupling_set_interface(coupling, igrnod, ngrnod, igrsurf, nsurf, nodes)
3246 CALL coupling_initialize(coupling,nodes%X,numnod,ispmd,nspmd)
3247 CALL coupling_ongoing(coupling,ongoing)
3248 ENDIF
3249
3250 ! Node Splitting
3251 CALL init_ghost_shells(nodes, element,ispmd,nspmd,nodes%boundary_add,nodes%boundary_size,nodes%boundary)
3252
3253 ! ----------------------
3254 ! Initialize coupling to Viper
3255 IF (vipercoupling) THEN
3256 call viper_coupling_initialize(viper, nodes, element, numnod,
3257 . nixs, numels, ixs, nixc, numelc,nixtg, numeltg,ixtg,
3258 . istdo, neleml, numelq, numelt, numelp, numelr,
3259 . dtmin, tstop, dtanim, tt, nparg, ngroup, iparg, elbuf_tab,
3260 . tt_double, tanim)
3261 ENDIF
3262
3263C===========================================================================
3264C BEGINNING OF EXPLICIT ITERATION LOOP
3265C===========================================================================
3266 100 CONTINUE
3267
3268 nc_debug = ncycle
3269
3270C========================================================================================
3271C NON PARALLEL SECTION (SMP)
3272C========================================================================================
3273
3274C INTERFACE
3275C Reallocate RENUM array
3276 rns = 0
3277 CALL renum_siz(ipari,rns)
3278 IF (rns > rnum_siz)THEN
3279 DEALLOCATE(renum)
3280 rnum_siz=rns
3281 ALLOCATE(renum(rnum_siz))
3282 ENDIF
3283
3284#ifdef DNC
3285 IF (imadcpl>0)THEN
3286
3287 CALL data_send_madcpl(nodes%X,madclnod,
3288 * madymo_del_global,mad_fail_elements)
3289 ENDIF
3290#endif
3291
3292C-----------------------------------------------
3293C TRACE BACK
3294C-----------------------------------------------
3295 CALL trace_in(3,ncycle,zero)
3296
3297 IF(imon>0) CALL startime(timers,6)
3298 IF(imonm > 0) CALL startime(timers,47)
3299C
3300 CALL manctr(sensors,h3d_data)
3301C----------------------------
3302C MOVING SKEW [MONO THREAD]
3303C----------------------------------
3304 IF(numskw/=0) CALL newskw(skews%SKEW ,iskwn ,nodes%X ,iskwp_l ,nskwp,
3305 1 numskw_l,numskw_l_send,iskwp_l_send,recvcount,iskwp)
3306C----------------------------------
3307 econt=zero
3308 edamp=zero
3309 enint=zero
3310 xmass=zero
3311 xmomt=zero
3312 ymomt=zero
3313 zmomt=zero
3314 def=zero
3315 dmf=zero
3316 wplast=zero
3317C
3318 dt1=dt2
3319 dt2=ep06
3320 glob_therm%DT_THERM = ep06
3321 nt_imp=0
3322!
3323 IF(impl_s>0) THEN
3324 IF(ncycle>0) THEN
3325 IF (imon>0) CALL startime(timers,timer_integ)
3326 CALL imp_fanie(fani ,fext_imp,nfia ,nfea ,nodft ,nodlt,
3327 . h3d_data )
3328 IF (imon>0) CALL stoptime(timers,timer_integ)
3329 ENDIF
3330 END IF
3331
3332
3333 IF(ncycle==1.AND.interfaces%PARAMETERS%ISTIF_DT>0)
3334 . interfaces%PARAMETERS%DT_STIFINT = dt1
3335C----------------------------------
3336 IF(imonm > 0) CALL stoptime(timers,47)
3337 IF(imon>0) CALL stoptime(timers,6)
3338
3339 imadfsh4=0
3340
3341C----------------------------------
3342C Gather actual thickness of shells
3343C----------------------------------
3344 IF(inter_ithknod/=0)THEN
3345 nsgdone=1
3346 thknod(nodft:nodlt)=zero
3347C /---------------/
3348C /---------------/
3349 CALL thickvar(iparg,elbuf_tab,element%SHELL%IXC,ixtg,thksh4,
3350 . thksh3,thknod,thke,sh4tree,sh3tree)
3351
3352 IF(nspmd>1) THEN
3353 length = 1
3354 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
3355 CALL spmd_exch_thknod(
3356 + thknod,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,length,lenr)
3357 ENDIF
3358 END IF
3359
3360C-----------------------------
3361C Not pure thermal case
3362C-----------------------------
3363
3364 IF(ilag+iale+ieuler/=0)THEN
3365C--- // N/3 -------------------------------------
3366C CANCEL Mass matrix in 2D
3367C------------------------------------------------
3368 isync = 0
3369 IF(n2d/=0) THEN
3370
3371C========================================================================================
3372C PARALLEL SECTION (SMP)
3373C========================================================================================
3374
3375!$OMP PARALLEL
3376!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
3377!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK)
3378
3379C Init var parallel SMP
3380 CALL smp_init(
3381 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
3382 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
3383 3 greftsk,greltsk)
3384 CALL zero1(nodes%MS(nodftsk),numntsk)
3385!$OMP END PARALLEL
3386
3387 ENDIF
3388 ENDIF
3389
3390C========================================================================================
3391C NON PARALLEL SECTION (SMP)
3392C========================================================================================
3393 DO i=1+nfoa,nfoa+2*(nsect+nrbody+nrwall)
3394 fani(1,i) = zero
3395 fani(2,i) = zero
3396 fani(3,i) = zero
3397 ENDDO
3398 IF(anim_v(13)+h3d_data%N_VECT_CONT2 > 0)THEN
3399 DO i=1+nft2,nft2 + numnod*min(1,anim_v(13)+h3d_data%N_VECT_CONT2)
3400 fani(1,i) = zero
3401 fani(2,i) = zero
3402 fani(3,i) = zero
3403 ENDDO
3404 ENDIF
3405 IF(h3d_data%N_VECT_CONT2M==1)THEN
3406 DO i=1,numnod
3407 mcont2(1,i) = zero
3408 mcont2(2,i) = zero
3409 mcont2(3,i) = zero
3410 ENDDO
3411 ENDIF
3412 ngdone = 1
3413 nsgdone = 1
3414C------------------------
3415C INTERFACES 14 & 15 :
3416C Initialisation buffers: forces, moments, stifness of surfaces.
3417C--- //0 ----------------
3418 IF (ispmd==0) THEN
3419 IF (ninter/=0) THEN
3420 IF (imon>0) CALL startime(timers,timer_contsort)
3421 CALL i14ist(ipari,interfaces%INTBUF_TAB,igrsurf,bufsf)
3422 IF (imon>0) CALL stoptime(timers,timer_contsort)
3423 ENDIF
3424 ENDIF
3425
3426C========================================================================================
3427C NON PARALLEL SECTION (SMP)
3428C========================================================================================
3429
3430C--------------------------------------------------------
3431 dt2t = dt2
3432C--------------------------------------------------------
3433 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
3434 k2=k1+numels
3435 k3=k2+numelq
3436 k4=k3+numelc
3437 k5=k4+numelt
3438 k6=k5+numelp
3439 k7=k6+numelr
3440 k8=k7
3441 k9=k8+numeltg
3442 k10=k9+numelx
3443 k11=k10+numsph
3444 k12=k11+numelig3d
3445C-----------------------------------------------
3446C pressure gauges, position calculation
3447C-----------------------------------------------
3448 IF (iale+ieuler+glob_therm%ITHERM+numsph/=0) THEN
3449 IF(nbgauge/=0)CALL agauge0(lgauge,gauge,nodes%X,element%SHELL%IXC,igaup,ngaup)
3450 END IF
3451C----------------------------------------
3452C
3453 IF (imon>0) CALL startime(timers,6)
3454 IF (imonm > 0) CALL startime(timers,49)
3455C----------------------------
3456 IF(numgeo>0.AND.nodadt==0)THEN
3457 DO i=1,numgeo
3458 IF(geo(5,i)>zero.AND.dtfac1(3)*geo(5,i)<dt2t)THEN
3459 dt2t= dtfac1(3)*geo(5,i)
3460 neltst = 0
3461 ityptst= 3
3462 ENDIF
3463 ENDDO
3464 ENDIF
3465C------------------------
3466C USER WINDOW
3467C------------------------
3468 IF(user_windows%HAS_USER_WINDOW /= 0 ) THEN
3469 CALL trace_in(9,2,zero)
3470
3471 CALL user_windows_routine( ispmd ,nspmd ,userl_avail ,
3472 1 user_windows ,rad_inputname ,len_rad_inputname,
3473 2 numnod ,ncycle ,nodes%ITAB ,
3474 3 tt ,dt1 ,output%TH%WFEXT ,
3475 4 nodes%D ,nodes%X ,nodes%V ,
3476 5 nodes%VR ,nodes%MS ,nodes%IN ,
3477 6 nodes%STIFN ,nodes%STIFR ,nodes%A ,
3478 7 nodes%AR ,dt2)
3479
3480 CALL trace_out(9)
3481
3482 ENDIF
3483C----------------------------------
3484C FUNCTIONS
3485C----------------------------------
3486
3487 IF(nfunct /= 0.AND.iale+ieuler+glob_therm%ITHERM+nebcs>0) THEN
3488 CALL timfun(python,fv, npc, tf)
3489 IF(ebcs_tab%nebcs_loc/=0) THEN
3490 !!! Need to "extrapolate values" whenever current time
3491 !!! is lower than minimum defined time function or greater than
3492 !!! maximum defined time function
3493 CALL ebcs_extrapol(fv, npc, tf, ebcs_tab)
3494 ENDIF
3495 ENDIF
3496C----------------------------------
3497c /STOP/LSENSOR
3498C-----------------------------------------------
3499 CALL stop_sensor(sensors,h3d_data,dynain_data,output)
3500C
3501C-------------------------------------------------------------------
3502C ACTIVATION-DEACTIVATION of groups of elements
3503C-------------------------------------------------------------------
3504 IF (nactiv>0) THEN
3505 IF(glob_therm%ITHERM_FE > 0 .AND. nspmd > 1 ) THEN
3506 DO i = 1,numnod
3507 nodes%MCP(i) = nodes%MCP(i) * nodes%WEIGHT(i)
3508 nodes%STIFN(i) = nodes%STIFN(i) * nodes%WEIGHT(i)
3509 ENDDO
3510 ENDIF
3511 CALL desacti(ixs ,ixq ,element%SHELL%IXC ,ixp ,ixt ,
3512 . ixr ,ixtg ,iparg ,iactiv ,
3513 . nsensor ,sensors%SENSOR_TAB,element%PON%FSKY ,nodes%X ,elbuf_tab,
3514 . ibcv ,fconv ,ibcr ,fradia ,igroups ,
3515 . factiv ,nodes%TEMP ,nodes%MCP ,pm ,mcp_off ,
3516 . igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss ,
3517 . igrbeam ,igrspring,glob_therm)
3518 ELSE
3519 IF(glob_therm%ITHERM_FE > 0 .AND. nspmd > 1 .AND. iparit == 0) THEN
3520 DO i = 1,numnod
3521 nodes%MCP(i) = nodes%MCP(i) * nodes%WEIGHT(i)
3522 ENDDO
3523 ENDIF
3524 ENDIF
3525 IF (imonm > 0) CALL stoptime(timers,49)
3526
3527C-------------------------------------------------------------------
3528C EXTERNAL FORCES
3529C-------------------------------------------------------------------
3530 IF (nconld/=0 .AND. impl_s/=1) THEN
3531 CALL trace_in(10,0,zero)
3532 IF (imon>0) CALL startime(timers,timer_kin)
3533 IF (imonm > 0) CALL startime(timers,41)
3534 CALL force(
3535 1 nibcld ,ibcl ,lfaccld ,forc ,snpc ,
3536 2 npc ,stf ,tf ,nodes%A ,nodes%V ,
3537 3 nodes%X ,skews ,nodes%AR ,
3538 4 nodes%VR ,nsensor ,sensors%SENSOR_TAB ,wfexc ,element%PON%IAD_CONLD ,
3539 5 lsky ,element%PON%FSKY ,noda_fext ,h3d_data ,cptreac ,
3540 6 fthreac ,nodreac ,output%TH%TH_SURF ,
3541 7 dpl0cld ,vel0cld ,nodes%D ,nodes%DR ,nconld ,
3542 8 numnod ,nfunct ,anim_v ,outp_v ,
3543 9 iparit ,tt ,dt1 ,n2d ,output%TH%WFEXT ,
3544 a impl_s ,python=python, nodes=nodes)
3545C
3546 IF (npinch > 0) THEN
3547 CALL forcepinch(ibcl ,forc ,npc ,tf ,nodes%A ,
3548 2 nodes%V ,nodes%X ,skews%SKEW ,nodes%AR ,nodes%VR ,
3549 3 nsensor,sensors%SENSOR_TAB ,nodes%WEIGHT ,wfexc ,element%PON%IAD_CONLD,
3550 4 element%PON%FSKY , element%PON%FSKY ,noda_fext ,h3d_data,
3551 5 pinch_data%APINCH, pinch_data%VPINCH, python, output%TH%WFEXT)
3552 ENDIF
3553C
3554 IF (imonm > 0) CALL stoptime(timers,41)
3555 IF (imon>0) CALL stoptime(timers,timer_kin)
3556 CALL trace_out(10)
3557 ENDIF
3558C
3559 IF(nfxvel/=0.AND.impl_s/=1) THEN
3560 IF(imon>0) THEN
3561 CALL startime(timers,6)
3562 CALL startime(timers,timer_kin)
3563 IF(imonm > 0) CALL startime(timers,44)
3564 ENDIF
3565 CALL forcefingeo(ibfv ,npc ,tf ,nodes%A ,nodes%V ,nodes%X ,
3566 2 vel ,sensors%SENSOR_TAB ,element%PON%FSKY ,noda_fext ,nodes%ITABM1,
3567 3 h3d_data,nsensor,python,output%TH%WFEXT,nodes)
3568 IF(imon>0) THEN
3569 IF(imonm > 0) CALL stoptime(timers,44)
3570 CALL stoptime(timers,timer_kin)
3571 CALL stoptime(timers,6)
3572 ENDIF
3573 ENDIF
3574C-------------------------------------------------------------------
3575C LOAD PFLUID
3576C-------------------------------------------------------------------
3577 IF(nloadp_f/=0.AND.impl_s/=1) THEN
3578 CALL trace_in(10,0,zero)
3579 IF (imon>0) CALL startime(timers,timer_kin)
3580 IF (imonm > 0) CALL startime(timers,41)
3581!$OMP PARALLEL
3582 CALL pfluid(iloadp ,loadp ,npc ,tf ,nodes%A ,
3583 2 nodes%V ,nodes%X ,xframe ,nodes%MS ,
3584 3 nsensor ,sensors%SENSOR_TAB,wfexc ,output%TH%WFEXT,element%PON%IAD_LOADP ,
3585 4 element%PON%FSKY , element%PON%FSKY ,lloadp ,noda_fext ,h3d_data ,
3586 5 output%TH%TH_SURF, python)
3587!$OMP END PARALLEL
3588 IF (imonm > 0) CALL stoptime(timers,41)
3589 IF (imon>0) CALL stoptime(timers,timer_kin)
3590 CALL trace_out(10)
3591 ENDIF
3592
3593C-------------------------------------------------------------------
3594C LOAD PBLAST
3595C----------------------------------
3596 IF(pblast%NLOADP_B/=0.AND.impl_s/=1) THEN
3597 CALL trace_in(10,0,zero)
3598 IF (imon>0) CALL startime(timers,timer_kin)
3599 IF (imonm > 0) CALL startime(timers,41)
3600 CALL pblast_load_computation(
3601 1 pblast ,iloadp ,loadp ,nodes%A ,nodes%V ,nodes%X,
3602 2 element%PON%IAD_LOADP ,element%PON%FSKY ,lloadp ,noda_fext ,noda_surf ,noda_pext,
3603 3 nodes%ITAB ,h3d_data ,output%TH%TH_SURF ,output%TH%WFEXT)
3604 IF (imonm > 0) CALL stoptime(timers,41)
3605 IF (imon>0) CALL stoptime(timers,timer_kin)
3606 CALL trace_out(10)
3607 IF(pblast%PBLAST_DT%DT<dt2t)THEN
3608 !inter22 kinematic time step
3609 dt2t = pblast%PBLAST_DT%DT
3610 ityptst = 12
3611 neltst = pblast%PBLAST_DT%IDT
3612 pblast%PBLAST_DT%DT = ep20
3613 ENDIF
3614 ENDIF
3615C-------------------------------------------------------------------
3616C LOAD PCYL
3617C----------------------------------
3618 IF (loads%NLOAD_CYL > 0) THEN
3619 CALL pressure_cyl(
3620 . loads ,table ,sensors%NSENSOR,sensors%SENSOR_TAB,iframe ,
3621 . dt1 ,nodes%X ,nodes%V ,nodes%A ,noda_fext ,
3622 . h3d_data ,cptreac ,fthreac ,nodreac ,element%PON%FSKY ,output%TH%WFEXT )
3623 ENDIF
3624!-------------------------------------------------------------------
3625! offset projection for contact ! add smp // after
3626!----------------------------------
3627 IF (sh_offset_tab%NNSH_OSET > 0) THEN
3628 xyz(1:3,1:numnod) = nodes%X(1:3,1:numnod)
3629 CALL offset_nproj(nspmd,numnod,xyz,sh_offset_tab,iparit)
3630 ENDIF
3631!
3632 IF( glob_therm%NUMCONV + glob_therm%NUMRADIA > 0 .AND. glob_therm%ITHERM_FE > 0 )THEN
3633
3634C========================================================================================
3635C PARALLEL SECTION (SMP)
3636C========================================================================================
3637
3638!$OMP PARALLEL
3639C-------------------------------------------------------------------
3640C BC -- CONVECTION for heat_transfert by FEM
3641C----------------------------------------------
3642 IF (glob_therm%NUMCONV > 0 .AND. glob_therm%ITHERM_FE > 0) THEN
3643 IF (imon>0) CALL startime(timers,timer_kin)
3644 IF (imonm > 0) CALL startime(timers,41)
3645 CALL convec(ibcv ,fconv ,npc ,tf , nodes%X ,
3646 1 nodes%TEMP ,nsensor,sensors%SENSOR_TAB,fthe, element%PON%IAD_CONV,
3647 2 fthesky, python,glob_therm)
3648 IF (imonm > 0) CALL stoptime(timers,41)
3649 IF (imon>0) CALL stoptime(timers,timer_kin)
3650 ENDIF
3651C-------------------------------------------------------------------
3652C BC -- RADIATION to environment for heat_transfert by FEM
3653C-----------------------------------------------------------
3654 IF (glob_therm%NUMRADIA > 0 .AND. glob_therm%ITHERM_FE > 0) THEN
3655 IF (imon>0) CALL startime(timers,timer_kin)
3656 IF (imonm > 0) CALL startime(timers,41)
3657 CALL radiation(ibcr, fradia, npc, tf, nodes%X ,
3658 1 nodes%TEMP, nsensor,sensors%SENSOR_TAB, fthe, element%PON%IAD_RADIA,
3659 2 fthesky, python,glob_therm)
3660 IF (imonm > 0) CALL stoptime(timers,41)
3661 IF (imon>0) CALL stoptime(timers,timer_kin)
3662 ENDIF
3663!$OMP END PARALLEL
3664 ENDIF
3665
3666C========================================================================================
3667C NON PARALLEL SECTION (SMP)
3668C========================================================================================
3669
3670C-------------------------------------------------------------------
3671C BC -- THERMAL FLUX for heat_transfert by FEM
3672C-------------------------------------------------
3673 IF (glob_therm%NFXFLUX > 0 .AND. glob_therm%ITHERM_FE > 0) THEN
3674 IF (imon>0) CALL startime(timers,timer_kin)
3675 IF (imonm > 0) CALL startime(timers,41)
3676 CALL fixflux(ibfflux, fbfflux, npc, tf, nodes%X, ixs,
3677 . nsensor,sensors%SENSOR_TAB, fthe, element%PON%IAD_FXFLUX, fthesky, python,
3678 . glob_therm)
3679 IF (imonm > 0) CALL stoptime(timers,41)
3680 IF (imon>0) CALL stoptime(timers,timer_kin)
3681 ENDIF
3682
3683
3684 icontact_old(1:sicontact) = icontact(1:sicontact)
3685 IF(nvolu/=0)THEN
3686 IF (imonm > 0) CALL startime(timers,50)
3687 CALL trace_in(11,0,zero)
3688 nn = numelc+numeltg+ibagsurf
3689 n0 = 1 + 3*nn
3690 IF(intbag/=0)THEN
3691 n1 = n0+ nn
3692 ELSE
3693 n1 = n0
3694 ENDIF
3695 sporo = numelc+numeltg+ibagsurf
3696C
3697 n=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
3698 IF (impl_s > 0 .AND. ismdisp >0) THEN
3699 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
3700 ELSE
3701 CALL assign_ptrx(ptrx,nodes%X,numnod)
3702 ENDIF
3703 CALL monvol0(
3704 1 monvol ,volmon ,ptrx ,nodes%A ,
3705 2 npc ,tf ,nodes%V ,wa ,
3706 3 fsav(1,n) ,nsensor ,sensors%SENSOR_TAB ,igrsurf ,
3707 4 fr_mv ,element%PON%IAD_MV ,sicontact ,sporo ,
3708 5 element%PON%FSKY,icontact ,wa(n0) ,iparg ,
3709 6 elbuf_tab ,geo ,igeo ,
3710 7 pm ,ipm ,ipart ,ipart(k3) ,
3711 8 ipart(k8) ,igroupc ,igrouptg ,noda_fext ,
3712 9 1 ,h3d_data ,t_monvol ,frontier_global_mv,
3713 a output, python )
3714 CALL trace_out(11)
3715 IF (imonm > 0) CALL stoptime(timers,50)
3716 ENDIF
3717 IF (imon>0) CALL stoptime(timers,6)
3718C
3719 IF (nflow>0) THEN
3720 CALL flow0(iflow, rflow, wiflow, wrflow, nodes%X,
3721 . nodes%V, nodes%A, npc, tf, sensors%SENSOR_TAB,
3722 . nbgauge,lgauge, gauge , nsensor,
3723 . igrv, agrv ,nfunct ,python, output%TH%WFEXT)
3724 ENDIF
3725
3726C----------------------------------------
3727C MPI COMMUNICATION BEFORE SORTING
3728C----------------------------------------
3729 IF (imon>0) CALL startime(timers,13)
3730 IF (imonm > 0) CALL startime(timers,24)
3731 IF(nspmd>1)THEN
3732 l1 = 1+nixs*numels + nsvois*nixs
3733 l2 = l1+6*numels10
3734 l3 = l2+12*numels20
3735 CALL spmd_i7xvcom2(
3736 1 ipari ,nodes%X ,nodes%V ,nodes%MS ,
3737 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
3738 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
3739 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
3740 5 igrbric ,nodes%TEMP ,2 ,irlen7t ,islen7t ,
3741 6 irlen20 ,islen20 ,irlen20t,islen20t,irlen20e,
3742 7 islen20e,nodes%IKINE ,diag_sms,sensors%SENSOR_TAB,interfaces%INTBUF_TAB ,int24e2euse,
3743 8 forneqs ,multi_fvm,interfaces)
3744 END IF
3745 IF (imonm > 0) CALL stoptime(timers,24)
3746 IF (imon>0) CALL stoptime(timers,13)
3747
3748
3749C--------------------------------------------------------
3750C INTERFACE 24 - Communication part 4 / 4
3751C--------------------------------------------------------
3752
3753 IF (int24use == 1)THEN
3754 IF (imon>0) CALL startime(timers,timer_contfor)
3755 CALL spmd_exch_i24(ipari ,interfaces%INTBUF_TAB ,nodes%ITAB ,
3756 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
3757 * iad_i24 ,fr_i24 ,sfr_i24,i24maxnsne,4,
3758 * int24e2euse)
3759 IF (imon>0) CALL stoptime(timers,timer_contfor)
3760 ENDIF
3761
3762C
3763C Section processing in SPMD comm before FORINT
3764C
3765 IF(nsect>0.AND.nspmd>1) THEN
3766 lsend1 = iad_sec(1,nspmd+1)
3767 lrecv1 = iad_sec(2,nspmd+1)
3768 lsend2 = iad_sec(3,nspmd+1)
3769 lrecv2 = iad_sec(4,nspmd+1)
3770 CALL spmd_exch_sec(nstrf ,nodes%X ,nodes%MS ,nodes%WEIGHT,xsec ,
3771 2 fr_sec,iad_sec,lsend1,lrecv1,lsend2,
3772 3 lrecv2,nodes%WEIGHT_MD)
3773 END IF
3774C----------------------------------------------------------
3775C INTER/TYPE21 ROTATION
3776C----------------------------------------------------------
3777 IF(nintstamp/=0)THEN
3778 CALL intstamp_init(intstamp,nodes%ICODR)
3779 END IF
3780C---------------------------------------------
3781C TETRA4 : SMOOTH FINITE ELEMENT FORMULATIONS
3782C---------------------------------------------
3783 IF(isfem >= 1) THEN
3784 IF(glob_therm%ITHERM == 0)THEN
3785 l1 = 1+nixs*numels + nsvois*nixs
3786 CALL s4lagsfem(iparg, ixs, nodes%X, nodes%V, elbuf_tab, sfem_nodvar, s_sfem_nodvar,
3787 . nodes%BOUNDARY_ADD, nodes%BOUNDARY, ixs(l1), nodes%XDP, sxdp,
3788 . numnod, nodes%BOUNDARY_SIZE , nspmd, numels, numels8, numels10, nparg, ngroup, iresp)
3789 ENDIF
3790 ENDIF
3791
3792C----------------------------------------
3793C COLLISION DETECTION FOR INTERFACES 7 (CALL BARRIER IN I7BUCE_CRIT)
3794C----------------------------------------
3795 IF(ninter/=0) THEN
3796 CALL trace_in(8,2,zero)
3797 IF (imon > 0) CALL startime(timers,timer_contsort)
3798 l1 = 1+nixs*numels + nsvois*nixs
3799 l2 = l1+6*numels10
3800 l3 = l2+12*numels20
3801 lskyi_count = 0
3802 lskyi_sms_new = 0
3803
3804 IF(idtmins/=0) THEN
3805 nativ_sms_siz = numnod
3806 ELSE
3807 nativ_sms_siz = 0
3808 ENDIF
3809
3810 IF(coupling%active .AND. tt > zero) dt2t = min(dt2t,coupling%DT_LIMIT)
3811
3812C========================================================================================
3813C PARALLEL SECTION (SMP)
3814C========================================================================================
3815 IF (sh_offset_tab%NNSH_OSET > 0) THEN
3816 CALL assign_ptrx(ptrx,xyz,numnod)
3817 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
3818 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
3819 ELSE
3820 CALL assign_ptrx(ptrx,nodes%X,numnod)
3821 ENDIF
3822 inter_errors = 0
3823
3824!$OMP PARALLEL PRIVATE(ITSK,DT2TT,NELTSTT,ITYPTSTT)
3825 dt2tt = dt2t
3826 neltstt = neltst
3827 ityptstt= ityptst
3828 itsk = omp_get_thread_num()
3829 CALL inttri(timers,
3830 1 ipari ,ptrx ,w , inter_errors,
3831 2 nodes%V ,nodes%MS ,nodes%IN ,nodes%BOUNDARY_ADD ,
3832 3 nodes%BOUNDARY ,nodes%VR ,isendto ,ircvfrom ,
3833 4 newfront ,itsk ,wa ,dt2tt ,
3834 5 nodes%ITAB ,neltstt ,ityptstt,nodes%WEIGHT ,
3835 6 intlist ,nbintc ,kinet ,dretri ,
3836 7 islen7 ,irlen7 ,islen11 ,irlen11 ,
3837 8 nodes%TEMP ,igrbric ,igrsh3n ,eminx ,
3838 9 ixs ,ixs(l3) ,ixs(l2) ,islen17 ,
3839 a irlen17 ,irlen7t ,islen7t ,num_imp1 ,
3840 b ind_imp ,intstamp,thknod ,irlen20 ,
3841 c islen20 ,irlen20t,islen20t,irlen20e ,
3842 d islen20e ,renum ,nsnfiold,xslv ,
3843 e xmsr ,vslv ,vmsr ,size_t ,
3844 f nativ_sms ,dxancg ,nodes%IKINE ,diag_sms ,
3845 g count_remslv,count_remslve ,ale_connectivity,
3846 h ixtg ,sensors,delta_pmax_gap,interfaces%INTBUF_TAB,
3847 i delta_pmax_gap_node,iad_frnor,fr_nor,
3848 j nb25_candt,nb25_impct,nb25_dst1,nb25_dst2,intlist25,
3849 k interfaces%SPMD_ARRAYS%IAD_FREDG,interfaces%SPMD_ARRAYS%FR_EDG,nodes%MAIN_PROC,nativ_sms,i_opt_stok ,
3850 l multi_fvm,iparg ,elbuf_tab, h3d_data, t2main_sms,
3851 m lskyi_sms_new ,forneqs ,int7itied,idel7nok_sav,maxdgap,
3852 n t2fac_sms,nodes%ICODT,nodes%ISKEW ,fskyn25 ,addcsrect,procnor,
3853 o inter_struct,sort_comm,rnum_siz,nativ_sms_siz,temp_siz,
3854 p interfaces,glob_therm,component)
3855C
3856#include "lockon.inc"
3857 IF(dt2tt<dt2t)THEN
3858 dt2t = dt2tt
3859 neltst = neltstt
3860 ityptst= ityptstt
3861 ENDIF
3862#include "lockoff.inc"
3863
3864!$OMP END PARALLEL
3865 IF(inter_errors > 0) THEN
3866 mstop = 2
3867 ENDIF
3868
3869
3870C========================================================================================
3871
3872C ----------------------------------------------------
3873C Check if ISKY & FSKYI are sufficiently allocate
3874C If not reallocate them
3875C ----------------------------------------------------
3876
3877 IF(iparit >0)THEN
3878 IF(SIZE(interfaces%PON%ADSKYI,1) < numnod+2) then
3879 deallocate(interfaces%PON%ADSKYI)
3880 allocate(interfaces%PON%ADSKYI(0:numnod+1))
3881 endif
3882 IF ( nisky+lskyi_count > sisky) THEN
3883 CALL reallocate_i_skyline(lskyi_count,1,glob_therm%INTHEAT,glob_therm%nodadt_therm,interfaces%PON)
3884 ENDIF
3885
3886C
3887C Remote Secnd Nodes
3888 IF (nspmd >1)THEN
3889 CALL upgrade_rem_2ry(ipari,count_remslv,count_remslve,glob_therm%nodadt_therm)
3890 count_remslv(1:ninter)= 0
3891 count_remslve(1:ninter)= 0
3892 ENDIF
3893
3894 ENDIF
3895
3896 IF (imon > 0) CALL stoptime(timers,timer_contsort)
3897 CALL trace_out(8)
3898 ENDIF
3899
3900C ----------------------------------------------------
3901C SMS - Check if ISKYI_SMS & MSKYI_SMS are sufficiently allocate
3902C If not reallocate them
3903C ----------------------------------------------------
3904
3905 IF ((idtmins == 2.OR.idtmins_int/=0).AND.(ninter > 0)) THEN
3906C
3907 IF (lskyi_sms_new > lskyi_sms) THEN
3908C
3909 DEALLOCATE(iskyi_sms,mskyi_sms,jdii_sms,lti_sms)
3910C
3911 lskyi_sms = nint(lskyi_sms_new*1.2)
3912 ALLOCATE(mskyi_sms(lskyi_sms),iskyi_sms(lskyi_sms,3),
3913 . jdii_sms(2*lskyi_sms),lti_sms(2*lskyi_sms),
3914 . stat=ierror)
3915C
3916 IF(ierror/=0) THEN
3917 CALL ancmsg(msgid=19,anmode=aninfo,
3918 . c1='LSKYI_SMS RESIZE')
3919 CALL arret(2)
3920 ENDIF
3921C
3922 ENDIF
3923 ENDIF
3924
3925C--------------------------------------------------------
3926C INTERFACE 25 - Communication IRTLM, TIME_S, etc :: send
3927C--------------------------------------------------------
3928 IF(ninter25 /= 0)THEN
3929
3930 IF(nspmd > 1)THEN
3931 IF (imon>0) CALL startime(timers,timer_exfor)
3932 CALL spmd_exch_i25(ipari ,interfaces%INTBUF_TAB ,nodes%ITAB ,
3933 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
3934 * iad_i25 ,fr_i25 ,sfr_i25 ,1 )
3935 CALL spmd_exch_i25(ipari ,interfaces%INTBUF_TAB ,nodes%ITAB ,
3936 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
3937 * iad_i25 ,fr_i25 ,sfr_i25 ,2 )
3938 IF (imon>0) CALL stoptime(timers,timer_exfor)
3939 END IF
3940
3941 END IF
3942
3943C-------------------------------------------------------
3944C ADAPTIVE MESHING
3945C Get ICONTACT After sort, After Contact forces if SPMD
3946C Before Contact forces if SMP
3947C-------------------------------------------------------
3948 IF(nadmesh > 0.AND.impl_s==0)THEN
3949 IF (imon>0) CALL startime(timers,36)
3950C
3951 nsh4old=nsh4act
3952 nsh3old=nsh3act
3953 iadmesh=0
3954 ichkadm=0
3955 IF(tt >= tadmesh+dtadmesh)THEN
3956 tadmesh=tadmesh+dtadmesh
3957 ichkadm=1
3958 END IF
3959C
3960 IF(ichkadm/=0 .AND. iadmerrt/=0)THEN
3961C
3962 CALL admerr(
3963 . element%SHELL%IXC ,ixtg ,nodes%X ,iparg ,elbuf_tab ,
3964 . ipart ,ipart(k3),ipart(k8),err_thk_sh4 ,err_thk_sh3 ,
3965 . nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nodes%WEIGHT ,sh4tree ,sh3tree ,
3966 . admerr_area_sh4, admerr_area_sh3, admerr_area_nod,
3967 . admerr_thick_sh4,admerr_thick_sh3,admerr_thick_nod )
3968 END IF
3969
3970C========================================================================================
3971C PARALLEL SECTION (SMP)
3972C========================================================================================
3973
3974!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
3975 itsk = omp_get_thread_num()
3976 nodftsk = 1+itsk*numnod/ nthread
3977 nodltsk = (itsk+1)*numnod/nthread
3978
3979 CALL admdiv(element%SHELL%IXC ,ipart(k3),ixtg ,ipart(k8),ipart,
3980 . itsk ,icontact ,iparg,nodes%X ,nodes%MS ,
3981 . nodes%IN ,rcontact ,elbuf_tab,nodftsk ,nodltsk,
3982 . igeo ,ipm ,sh4tree,padmesh,msc ,
3983 . inc ,sh3tree ,mstg ,intg ,ptg ,
3984 . acontact,pcontact,err_thk_sh4,err_thk_sh3,mscnd,
3985 . incnd,pm ,nodes%MCP ,mcpc ,mcptg,
3986 . glob_therm%ITHERM_FE)
3987 ngdone = 1
3988C /---------------/
3989 CALL my_barrier
3990C /---------------/
3991 IF(iadmrule /= 0)THEN
3992 IF(iadmesh > 0)THEN
3993 CALL admregul(element%SHELL%IXC ,ipart(k3),ixtg ,ipart(k8),ipart,
3994 . itsk ,iparg ,nodes%X ,nodes%MS ,nodes%IN ,
3995 . elbuf_tab,nodftsk ,nodltsk,igeo ,ipm ,
3996 . sh4tree,msc ,inc ,sh3tree,mstg ,
3997 . intg ,ptg ,mscnd ,incnd ,pm ,
3998 . nodes%MCP ,mcpc ,mcptg ,glob_therm%ITHERM_FE)
3999C /---------------/
4000 CALL my_barrier
4001C /---------------/
4002 END IF
4003 END IF
4004
4005 IF(iadmesh > 0)THEN
4006 IF(itsk==0) THEN
4007 CALL admordr(sh4tree,sh3tree,element%SHELL%IXC,ixtg)
4008 IF(istatcnd /= 0) CALL cndordr(ipart,ipart(k3),ipart(k8),
4009 . sh4tree,sh3tree)
4010 END IF
4011 iflgadm=1
4012 CALL admgvid(
4013 1 iparg ,elbuf_tab ,element%PON%FSKY ,element%PON%FSKY ,fthesky,
4014 2 element%PON%IADC,element%PON%IAD_TG,iflgadm,igrouc,ngrouc ,
4015 3 condnsky ,glob_therm%NODADT_THERM)
4016 CALL my_barrier
4017 ngdone = 1
4018 END IF
4019 rcontact(nodftsk:nodltsk)=ep30
4020 acontact(nodftsk:nodltsk)=ep30
4021 pcontact(nodftsk:nodltsk)=zero
4022!$OMP END PARALLEL
4023
4024 IF (imon>0) CALL stoptime(timers,36)
4025 END IF
4026C--- // N/3 --------------------------------------------------------
4027C EXTERNAL AND INTERNAL FORCES (ANIM)
4028C--------------------------------
4029
4030 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT+
4031 . anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT>0
4032 . .AND.impl_s==0)THEN
4033
4034C========================================================================================
4035C PARALLEL SECTION (SMP)
4036C========================================================================================
4037C--- // ----------------------------------------
4038C EXTERNAL FORCES (ANIM, OUTP, H3D)
4039C-----------------------------------------------
4040!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
4041 itsk = omp_get_thread_num()
4042 nodftsk = 1+itsk*numnod/ nthread
4043 nodltsk = (itsk+1)*numnod/nthread
4044 CALL forani1(fani,nodes%A ,nfia,nfea,nfoa,nodftsk,nodltsk,noda_fext,h3d_data)
4045!$OMP END PARALLEL
4046C
4047 ENDIF
4048C--------------------------------------------------------
4049C ALE flux + forces
4050C--------------------------------------------------------
4051 need_comm_inter18 = .false.
4052 IF (iale+ieuler+glob_therm%ITHERM/=0.AND.global_active_ale_element) THEN
4053 CALL startime(timers,macro_timer_alemain)
4054C-----------------------------
4055C SPMD : MS=0 boundary nodes if weight/=1 (for amas03)
4056C only for PARITH/OFF
4057C-----------------------------
4058 lenqmv = 1
4059 IF(trimat>0)lenqmv = min(1,trimat)*(numels+numelq)
4060 nv46 = 6
4061 IF(n2d /= 0) nv46 = 4
4062 CALL trace_in(12,0,zero)
4063
4064C========================================================================================
4065C PARALLEL SECTION (SMP)
4066C========================================================================================
4067
4068!$OMP PARALLEL
4069!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
4070!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,DT2TT,NELTSTT,ITYPTSTT)
4071!$OMP+ PRIVATE(GREFTSK,GRELTSK)
4072
4073C Init var parallel SMP
4074 CALL smp_init(
4075 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
4076 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4077 3 greftsk,greltsk)
4078 dt2tt = dt2t
4079 neltstt = neltst
4080 ityptstt = ityptst
4081 IF(iparit == 1) ndtsk = 1
4082
4083C
4084 CALL alemain(timers,
4085 1 pm ,geo ,nodes%X ,nodes%A(1,ndtsk) ,nodes%V ,
4086 2 nodes%MS ,wa ,elbuf_tab ,bufmat ,partsav(ipmtsk) ,tf,
4087 3 val2 ,veul ,fv ,nodes%STIFN(ndtsk),element%PON%FSKY,eani,
4088 4 phi ,fill ,dfill ,alph ,skews%SKEW ,w,
4089 5 nodes%D ,dsave ,asave ,dt2tt ,dt2save ,xcell,
4090 6 iparg ,npc ,ixs ,ixq, ixtg ,element%PON%IADS,
4091 7 ifill ,nodes%ICODT,nodes%ISKEW ,ims ,element%PON%IADQ ,
4092 8 neltstt ,ityptstt ,ipart(k1) ,ipart(k2) ,itsk ,
4093 a nodftsk ,nodltsk ,nbrcvois ,nodes%TEMP ,output%TH%TH_SURF%CHANNELS,
4094 b nbsdvois ,lnrcvois ,lnsdvois ,nercvois ,nesdvois ,lercvois ,
4095 c lesdvois ,isizxv ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,element%PON%FSKYM,msnf ,
4096 d ipari ,segvar ,nodes%ITAB ,iskwn ,diffusion ,iresp,
4097 e volmon ,fsav ,igrsurf ,neltsa ,
4098 f ityptsa ,nodes%WEIGHT ,npsegcom ,lsegcom ,ipm ,igeo,
4099 g nodes%ITABM1 ,lenqmv ,nv46 ,nodes%A ,gresav ,
4100 h grth ,igrth ,lgauge ,gauge ,mssa ,
4101 i dmels ,igaup ,ngaup ,table ,nodes%MS0 ,
4102 j nodes%XDP ,igrnod ,sfem_nodvar_ale ,interfaces%PON%FSKYI,interfaces%PON%ISKY, s_sfem_nodvar,
4103 k interfaces%INTBUF_TAB ,ixt ,igrv ,agrv ,sensors ,
4104 l lgrav ,condnsky ,condn ,ms_2d ,multi_fvm ,igrtruss ,
4105 m igrbric ,nloc_dmg ,id_global_vois,face_vois ,ebcs_tab ,ale_connectivity,
4106 n mat_elem ,h3d_data ,dt ,output ,need_comm_inter18 ,idtmins ,
4107 o idtmin ,maxfunc ,imon_mat ,userl_avail ,
4108 p impl_s ,idyna ,python ,mat_elem%MAT_PARAM,glob_therm)
4109
4110 IF(int22 /=0) call my_barrier !INTER22in input files - get also IDT_INT22
4111#include "lockon.inc"
4112 IF(int22 == 0)THEN
4113 IF(dt2tt<dt2t)THEN
4114 dt2t = dt2tt
4115 ityptst= ityptstt
4116 neltst = neltstt
4117 ENDIF
4118 ELSE
4119 IF(idt_int22 /= 0)THEN
4120!inter22 kinematic time step
4121 dt2t = dt22_min
4122 ityptst= 10
4123 neltst = 1
4124 ELSE
4125!cell time step
4126 IF(dt2tt<dt2t)THEN
4127 dt2t = dt2tt
4128 ityptst= ityptstt
4129 neltst = neltstt
4130 ENDIF
4131 ENDIF
4132 ENDIF
4133#include "lockoff.inc"
4134
4135!$OMP END PARALLEL
4136
4137 IF(need_comm_inter18) THEN
4138 CALL spmd_exch_inter_18(ninter,nspmd,number_inter18,sxcell,inter18_list,
4139 . xcell,multi_fvm,xcell_remote,interfaces%INTBUF_TAB,ale_connectivity)
4140 ENDIF
4141 CALL trace_out(12)
4142 CALL stoptime(timers,macro_timer_alemain)
4143 ELSE
4144 ale%SUB%IFSUB=0
4145 ale%SUB%IFSUBM=0
4146 t1s=tt
4147 ENDIF
4148
4149C========================================================================================
4150C NON PARALLEL SECTION (SMP)
4151C========================================================================================
4152
4153 IF(ale%SUB%IALESUB ==2 .AND. ale%SUB%IFSUB==2)GOTO 22
4154 21 CONTINUE
4155C
4156 IF (imon>0) CALL startime(timers,6)
4157 IF (imonm > 0) CALL startime(timers,51)
4158C----------------------------------
4159C INTERNAL FORCES:S8FORC3
4160C----------------------------------
4161 CALL forints(
4162 1 pm ,geo ,nodes%X ,nodes%A ,nodes%AR ,
4163 2 nodes%V ,nodes%VR ,nodes%MS ,nodes%IN ,w ,
4164 3 elbuf ,val2 ,veul ,fv ,
4165 4 nodes%STIFN ,nodes%STIFR ,element%PON%FSKY ,tf ,bufmat ,
4166 5 partsav ,fani(1,nfoa+1),fsav ,
4167 6 skews%SKEW,dt2t ,
4168 7 element%PON%IADS ,iparg ,npc ,ixs ,
4169 8 neltst ,ityptst ,ipart ,ipart(k1) ,nodes%ITAB ,
4170 9 interfaces%PON%FSKYI ,bufgeo ,kxx ,ixx ,interfaces%PON%ISKY ,
4171 a ipart(k9) ,gresav ,grth ,
4172 b igrth ,elbuf_tab )
4173 IF (imonm > 0) CALL stoptime(timers,51)
4174 IF (imon>0) CALL stoptime(timers,6)
4175
4176C========================================================================================
4177C PARALLEL SECTION (SMP)
4178C========================================================================================
4179
4180!$OMP PARALLEL
4181!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
4182!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK)
4183
4184C Init var parallel SMP
4185 CALL smp_init(
4186 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
4187 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4188 3 greftsk,greltsk)
4189
4190C-------------------------------------------------------
4191C RESET ICONTACT(1:NUMNOD)
4192C-------------------------------------------------------
4193 IF(kcontact/=0)THEN
4194 IF(ialelag >0)
4195 . ifoam_cont(nodftsk:nodltsk)= icontact(nodftsk:nodltsk)
4196C
4197 icontact(nodftsk:nodltsk)=0
4198 END IF
4199
4200 IF(istatcnd /= 0)THEN
4201 IF(iparit==0)THEN
4202 DO n=1,numnod
4203 stcnd(ndtsk+n-1) = zero
4204 END DO
4205 ELSE
4206 DO n=nodftsk,nodltsk
4207 stcnd(n) = zero
4208 END DO
4209 END IF
4210 END IF
4211C int 24+pxfem
4212 IF(intplyxfem > 0) THEN
4213 DO n=nodftsk,nodltsk
4214 wagap(1,n) = zero
4215 wagap(2,n) = zero
4216 END DO
4217 ENDIF
4218C
4219!$OMP END PARALLEL
4220
4221 IF(anim_ply > 0) vn_nod = zero
4222
4223
4224C--------------move to here to keep TAGNCONT for output
4225 IF(nloadp_hyd_inter > 0 )THEN
4226
4227C========================================================================================
4228C PARALLEL SECTION (SMP)
4229C========================================================================================
4230
4231!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
4232 itsk = omp_get_thread_num()
4233 nodftsk = 1+itsk*numnod/ nthread
4234 nodltsk = (itsk+1)*numnod/nthread
4235 DO k=1,nloadp_hyd_inter
4236 tagncont(k,nodftsk:nodltsk) = 0
4237 ENDDO
4238
4239!$OMP END PARALLEL
4240
4241 ENDIF
4242C--- // 3N ------------------------------
4243C INTERFACES WITH VOID OPENING
4244C----------------------------------------
4245 IF(ninter/=0) THEN
4246
4247 CALL trace_in(4,1,zero)
4248 IF (imon>0) CALL startime(timers,timer_contsort)
4249
4250 dt2tt = dt2t
4251 neltstt = neltst
4252 ityptstt= ityptst
4253 IF (impl_s>0) THEN
4254 iadisk = 1
4255 ELSE
4256 iadisk = 1
4257 ENDIF
4258 IF (sh_offset_tab%NNSH_OSET > 0) THEN
4259 CALL assign_ptrx(ptrx,xyz,numnod)
4260 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
4261 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
4262 ELSE
4263 CALL assign_ptrx(ptrx,nodes%X,numnod)
4264 ENDIF
4265 CALL intfop8(
4266 1 ipari ,ptrx ,nodes%A ,
4267 2 nodes%ICODT ,fsav ,wa(1),nodes%V ,nodes%MS ,
4268 3 dt2tt ,neltstt ,ityptstt ,nodes%ITAB ,nodes%STIFN ,
4269 4 npc ,tf ,interfaces%PON%FSKYI ,interfaces%PON%ISKY ,nodes%VR ,
4270 5 fani ,nodes%IN ,bufsf ,fani(1,nfnca+1) ,nsensor,
4271 6 fani(1,nftca+1) ,icontact ,rcontact ,num_impl(1,1),
4272 7 ns_imp(iadisk),ne_imp(iadisk),nt_imp ,sensors%SENSOR_TAB,interfaces%INTBUF_TAB ,
4273 8 h3d_data ,pskids ,tagncont,kloadpinter,loadpinter,
4274 9 loadp_hyd_inter)
4275
4276 IF(dt2tt<dt2t)THEN
4277 dt2t = dt2tt
4278 neltst = neltstt
4279 ityptst= ityptstt
4280 ENDIF
4281
4282
4283C=======================================================================================
4284C PARALLEL SECTION (SMP)
4285C========================================================================================
4286
4287!$OMP PARALLEL
4288!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
4289!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,IADISK)
4290!$OMP+ PRIVATE(DT2TT,NELTSTT,ITYPTSTT,GREFTSK,GRELTSK)
4291
4292C Init var parallel SMP
4293 CALL smp_init(
4294 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
4295 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4296 3 greftsk,greltsk)
4297
4298 dt2tt = dt2t
4299 neltstt = neltst
4300 ityptstt= ityptst
4301
4302
4303 IF(istatcnd /= 0 .AND. iparit == 0)THEN
4304 DO n=1,numnod
4305 stcnd(ndtsk+n-1)=-nodes%STIFN (ndtsk+n-1)
4306 END DO
4307 END IF
4308
4309 IF (impl_s>0) THEN
4310 iadisk = 1+itsk*nint7
4311 ELSE
4312 iadisk = 1
4313 ENDIF
4314 IF(iparit == 1) ndtsk = 1
4315
4316 CALL intfop1(output,
4317 1 ipari ,nodes%X ,nodes%A(1,ndtsk) ,
4318 2 nodes%ICODT ,fsav ,wa(nwaftsk),nodes%V ,nodes%MS ,
4319 3 dt2tt ,neltstt ,ityptstt ,nodes%ITAB ,nodes%STIFN(ndtsk) ,
4320 4 npc ,tf ,interfaces%PON%FSKYI ,interfaces%PON%ISKY ,nodes%VR ,
4321 6 fani ,nodes%IN ,igrsurf ,bufsf ,fani(1,nfnca+1) ,
4322 7 fani(1,nftca+1) ,icontact ,rcontact ,num_impl(1,itsk+1),
4323 8 ns_imp(iadisk),ne_imp(iadisk),nt_imp ,sensors%SENSOR_TAB,interfaces%INTBUF_TAB,
4324 9 h3d_data ,nsensor)
4325
4326#include "lockon.inc"
4327 IF(dt2tt<dt2t)THEN
4328 dt2t = dt2tt
4329 neltst = neltstt
4330 ityptst= ityptstt
4331 ENDIF
4332#include "lockoff.inc"
4333
4334!$OMP END PARALLEL
4335
4336 IF(impl_s>0) THEN
4337 CALL re2int5(nt_imp,num_imp,ns_imp,ne_imp,num_impl,ipari,nint7)
4338 nt_imp5=nt_imp
4339 END IF
4340C
4341 IF (imon>0) CALL stoptime(timers,timer_contsort)
4342 CALL trace_out(4)
4343
4344C----------------------------------------
4345C INTERFACES: computation of forces
4346C----------------------------------------
4347 CALL trace_in(4,2,zero)
4348 IF (imon>0) CALL startime(timers,timer_contfor)
4349
4350 l1 = 1+nixs*numels + nsvois*nixs
4351 l2 = l1+6*numels10
4352 l3 = l2+12*numels20
4353
4354C--------------------------------------------------------
4355C INTERFACE 25 - Communication IRTLM, TIME_S, etc :: Reception
4356C--------------------------------------------------------
4357 IF(nspmd > 1)THEN
4358 IF(ninter25 /= 0)THEN
4359 IF (imon>0) CALL startime(timers,timer_exfor)
4360 CALL spmd_exch_i25(ipari ,interfaces%INTBUF_TAB,nodes%ITAB ,
4361 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
4362 * iad_i25 ,fr_i25 ,sfr_i25 ,3 )
4363 CALL spmd_exch_i25(ipari ,interfaces%INTBUF_TAB,nodes%ITAB ,
4364 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
4365 * iad_i25 ,fr_i25 ,sfr_i25 ,4 )
4366 IF (imon>0) CALL stoptime(timers,timer_exfor)
4367 ENDIF
4368 END IF
4369C========================================================================================
4370C PARALLEL SECTION (SMP)
4371C========================================================================================
4372
4373 ncont = 0 ! Initialisation number of nodes tagged for FCONT storage
4374 IF (impl_s>0) THEN
4375 ntmp = nt_imp5 + nt_imp1
4376 ENDIF
4377 IF (sh_offset_tab%NNSH_OSET > 0) THEN
4378 CALL assign_ptrx(ptrx,xyz,numnod)
4379 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
4380 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
4381 ELSE
4382 CALL assign_ptrx(ptrx,nodes%X,numnod)
4383 ENDIF
4384
4385!$OMP PARALLEL
4386!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IADISK,IGMTSK)
4387!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,DT2TT,NELTSTT,ITYPTSTT)
4388!$OMP+ PRIVATE(GREFTSK,GRELTSK)
4389!$OMP+ PRIVATE(IDX_FTHE,IDX_CONDN,IDX_PINCH)
4390C Init var parallel SMP
4391 CALL smp_init(
4392 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
4393 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4394 3 greftsk,greltsk)
4395 dt2tt = dt2t
4396 neltstt = neltst
4397 ityptstt= ityptst
4398
4399 IF (impl_s>0) THEN
4400 iadisk = 1+ntmp+itsk*(nint7-ntmp)
4401 ELSE
4402 iadisk = 1
4403 ENDIF
4404 idx_fthe = ndtsk
4405 IF(ndtsk>ifthe) idx_fthe = 1
4406 idx_condn = ndtsk
4407 IF(ndtsk>icondn)idx_condn = 1
4408 idx_pinch = ndtsk
4409 IF(npinch == 0 )idx_pinch = 1
4410 IF(iparit == 1) ndtsk = 1
4411 CALL intfop2(timers,
4412 1 ipari ,ptrx ,nodes%A(1,ndtsk) ,igroups ,ale_connectivity,
4413 2 nodes%ICODT ,fsav ,nodes%V ,nodes%MS ,dt2tt ,
4414 3 neltstt ,ityptstt ,nodes%ITAB ,nodes%STIFN(ndtsk) ,tf ,
4415 4 interfaces%PON%FSKYI ,interfaces%PON%ISKY ,nodes%VR ,fani,secfcum,
4416 5 itsk+1 ,niskyfi ,kinet ,newfront ,nstrf ,
4417 6 icontact ,nodes%VISCN(ndtsk),xcell ,
4418 8 num_impl(1,itsk+1),ns_imp(iadisk) ,ne_imp(iadisk) ,ind_imp(iadisk) ,nt_imp ,
4419 9 fr_i18 ,igrbric ,eminx ,
4420 a ixs ,ixs(l3) ,ixs(l2) ,fani(1,nfnca+1) ,fani(1,nftca+1) ,
4421 b nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,rcontact ,acontact ,pcontact ,
4422 c nodes%TEMP ,fthe(idx_fthe) ,ftheskyi ,iparg ,nsensor ,
4423 d pm ,intstamp ,nodes%WEIGHT ,niskyfie ,irlen20 ,
4424 e islen20 ,irlen20t ,islen20t ,irlen20e ,islen20e ,
4425 f mskyi_sms ,iskyi_sms ,nativ_sms ,int18add ,fcontg ,
4426 g fncontg ,ftcontg ,nodes%NODGLOB ,nodes%MS0 ,npc ,
4427 h wa ,sensors%SENSOR_TAB,qfricint ,ncont ,indexcont ,
4428 i tagcont ,inod_pxfem ,ms_ply ,wagap ,elbuf_tab ,
4429 j condn(idx_condn) ,condnskyi ,nv46 ,
4430 k sensors%SFSAV ,sensors%FSAV ,glob_therm%NODADT_THERM,glob_therm%THEACCFACT,
4431 l isensint ,nisubmax ,nb25_candt ,nb25_impct ,
4432 m nb25_dst1 ,nb25_dst2 ,ixig3d ,kxig3d ,wige ,
4433 n knot ,igeo ,multi_fvm ,h3d_data ,
4434 p pskids ,t2main_sms ,forneqs ,knotlocpc ,knotlocel ,
4435 q pinch_data%APINCH(1,idx_pinch),pinch_data%STIFPINCH(idx_pinch),t2fac_sms,tagncont ,
4436 r kloadpinter ,loadpinter ,loadp_hyd_inter ,dgaploadint ,s_loadpinter ,
4437 s interfaces ,xcell_remote)
4438
4439 IF(nintstamp/=0.AND.(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0.OR.
4440 . anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0))THEN
4441 CALL my_barrier
4442 IF(ncont/=0) THEN
4443 DO i=itsk+1,ncont,nthread
4444 tagcont(indexcont(i)) = 0
4445 ENDDO
4446 ENDIF
4447 ENDIF
4448
4449#include "lockon.inc"
4450 IF(dt2tt<dt2t)THEN
4451 dt2t = dt2tt
4452 neltst = neltstt
4453 ityptst= ityptstt
4454 END IF
4455#include "lockoff.inc"
4456
4457 IF(istatcnd /= 0 .AND. iparit == 0)THEN
4458 DO n=1,numnod
4459 stcnd(ndtsk+n-1) = stcnd(ndtsk+n-1) + nodes%STIFN (ndtsk+n-1)
4460 END DO
4461 ENDIF
4462 IF (iparit == 0 .AND. nspmd > 1 .AND. nthread > 1) THEN
4463 CALL my_barrier()
4464 CALL assparxx(itsk, intlist,nbintc,ipari,glob_therm%NODADT_THERM)
4465 ENDIF
4466!$OMP END PARALLEL
4467
4468C========================================================================================
4469C NON PARALLEL SECTION (SMP)
4470C========================================================================================
4471
4472 IF(impl_s>0) CALL re2int7(nt_imp,num_imp,ns_imp,ne_imp,
4473 1 ind_imp,num_impl,ipari,nint7 )
4474C
4475 IF (imon>0) THEN
4476 CALL stoptime(timers,timer_contfor)
4477 CALL startime(timers,timer_exfor)
4478 ENDIF
4479 IF (imonm > 0) CALL startime(timers,21)
4480
4481C--------------------------------------------------------
4482C Communication contact forces (SPMD), Part1 : Send
4483C--------------------------------------------------------
4484
4485 IF(nspmd>1)THEN
4486C
4487 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT >0.AND.
4488 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP) .OR.
4489 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))
4490 . .OR.h3d_data%N_VECT_PCONT_MAX >0)THEN ! comm to do before i7fcom
4491 CALL spmd_exch_press(
4492 1 ipari ,intlist ,nbintc ,fani(1,nfnca+1),
4493 2 fani(1,nftca+1),islen7 ,irlen7 ,irlen7t ,islen7t ,
4494 3 irlen20 ,islen20,irlen20t,islen20t,interfaces%INTBUF_TAB ,
4495 4 h3d_data%N_CSE_FRIC_INTER,h3d_data%N_SCAL_CSE_FRIC)
4496 ELSEIF((h3d_data%N_SCAL_CSE_FRIC+ninefric>0.AND.
4497 . ((tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP) .OR.
4498 . h3d_data%MH3D/=0 ))
4499 . .OR.(h3d_data%N_SCAL_CSE_FRIC+ninefric >0.AND.ninter25>0))THEN
4500 CALL spmd_exch_efric(
4501 1 ipari ,intlist ,nbintc ,islen7 ,irlen7 ,
4502 2 irlen7t ,islen7t ,irlen20 ,islen20,irlen20t,
4503 3 islen20t ,interfaces%INTBUF_TAB ,h3d_data)
4504
4505 END IF
4506C
4507 l1 = 1+nixs*numels + nsvois*nixs
4508 l2 = l1+6*numels10
4509 l3 = l2+12*numels20
4510 IF(iparit==0) THEN
4511 CALL spmd_i7fcom_poff(
4512 1 ipari ,nodes%A ,nodes%STIFN ,nodes%VISCN ,
4513 2 intlist ,nbintc ,nodes%ICODT ,secfcum ,nstrf ,
4514 3 icontact ,fani ,islen7 ,irlen7 ,islen11 ,
4515 4 irlen11 ,islen17 ,irlen17,igrbric ,
4516 5 ixs ,ixs(l3) ,fthe ,irlen7t ,
4517 6 islen7t ,irlen20 ,islen20,irlen20t,islen20t,
4518 7 irlen20e ,islen20e,condn ,1, interfaces%INTBUF_TAB ,
4519 8 h3d_data, multi_fvm,tagncont,kloadpinter,loadpinter,
4520 9 loadp_hyd_inter,fsav ,interfaces,glob_therm%NODADT_THERM)
4521 ELSE
4522
4523 CALL spmd_i7fcom_pon(
4524 1 ipari ,intlist ,nbintc ,niskyfi ,nodes%ICODT ,
4525 2 secfcum ,nstrf ,icontact ,fani ,igrbric ,
4526 3 ixs ,ixs(l3) ,niskyfie ,nbint20 ,1 ,
4527 4 interfaces%INTBUF_TAB,sfskyi ,sisky ,h3d_data ,multi_fvm ,
4528 5 tagncont ,kloadpinter,loadpinter,loadp_hyd_inter,fsav,
4529 6 interfaces,glob_therm)
4530
4531 IF(multi_fvm%IS_INT18_LAW151) THEN
4532 IF(nthread>1) CALL int18_law151_omp_accumulation( multi_fvm )
4533 CALL spmd_int18_law151_pon( ipari,islen7,irlen7,1,interfaces%INTBUF_TAB,
4534 1 multi_fvm )
4535 ENDIF
4536 END IF
4537 ENDIF
4538 IF (imon>0) CALL stoptime(timers,timer_exfor)
4539 IF (imonm > 0) CALL stoptime(timers,21)
4540
4541 CALL trace_out(4)
4542 ENDIF ! fin NINTER > 0
4543C--------------------------------------------------------
4544C INTERFACE 24 - Communication part 1 / 4
4545C--------------------------------------------------------
4546 IF (int24use == 1)THEN
4547 IF (imon>0) CALL startime(timers,timer_contfor)
4548 CALL spmd_exch_i24(ipari ,interfaces%INTBUF_TAB,nodes%ITAB ,
4549 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
4550 * iad_i24 ,fr_i24 ,sfr_i24,i24maxnsne,1,
4551 * int24e2euse )
4552
4553 IF (imon>0) CALL stoptime(timers,timer_contfor)
4554 ENDIF
4555C--------------------------------------------------------
4556C INTERFACE 21 - Communication of heat flux
4557C--------------------------------------------------------
4558 IF(nspmd>1)THEN
4559 IF(nintstamp /= 0.AND.ftempvar21==1) THEN
4560 CALL spmd_i21fthecom(ipari ,fthe ,interfaces%INTBUF_TAB,sensors%SENSOR_TAB,niskyfi ,
4561 . ftheskyi,interfaces%PON%ISKY ,interfaces%PON%FSKYI ,condnskyi,nsensor,glob_therm%NODADT_THERM)
4562 ENDIF
4563 ENDIF
4564C--------------------------------------------------------
4565C Itet=2 STIFND <- STIFN part of interface only
4566C--------------------------------------------------------
4567 IF (ns10e > 0.AND.iparit == 0) THEN
4568
4569C========================================================================================
4570C PARALLEL SECTION (SMP)
4571C========================================================================================
4572
4573!$OMP PARALLEL
4574!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,GREFTSK,GRELTSK)
4575 itsk = omp_get_thread_num()
4576 nodftsk = 1+itsk*numnod/ nthread
4577 nodltsk = (itsk+1)*numnod/nthread
4578 greftsk = 1+itsk*ns10e/ nthread
4579 greltsk = (itsk+1)*ns10e/nthread
4580 CALL s10cndfnd(icnds10,nodes%WEIGHT ,iad_cnds,fr_cnds,nodes%ITAB ,
4581 2 nodftsk,nodltsk,greftsk,greltsk,itsk ,
4582 3 nodes%STIFN ,stifnd)
4583!$OMP END PARALLEL
4584 END IF
4585
4586C========================================================================================
4587C NON PARALLEL SECTION (SMP)
4588C========================================================================================
4589
4590C--------------------------------------------------------
4591C VOLUMES MONITORES
4592C--------------------------------------------------------
4593
4594 IF(nvolu/=0)THEN
4595 IF (imonm > 0) CALL startime(timers,50)
4596 CALL trace_in(11,0,zero)
4597 nn = numelc+numeltg+ibagsurf
4598 n0 = 1 + 3*nn
4599 IF(intbag/=0)THEN
4600 n1 = n0+ nn
4601 ELSE
4602 n1 = n0
4603 ENDIF
4604C
4605 CALL fvdim(monvol)
4606 CALL fvcopy(monvol)
4607 CALL fvmesh0(monvol, nodes%X, volmon, ixs)
4608 CALL fvrezone0(monvol, nodes%X)
4609 CALL fvupd0(monvol, nodes%X, nodes%V, volmon, smonvol, svolmon)
4610 n=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
4611 CALL fvbag0(monvol , volmon, nodes%X, sensors%SENSOR_TAB, nodes%V ,
4612 . nodes%A , npc, tf, nsensor ,
4613 . fsav(1,n), ifvmesh, icontact_old, lgauge ,
4614 . gauge , igeo, geo, pm , ipm ,
4615 . iparg , igrouptg, igroupc, elbuf_tab , noda_fext,
4616 . 1 , h3d_data, nodes%ITAB, nodes%WEIGHT , output%TH%WFEXT, python)
4617C
4618 CALL trace_out(11)
4619 IF (imonm > 0) CALL stoptime(timers,50)
4620 ENDIF
4621
4622
4623 IF(nspmd > 1 .AND. nvolu > 0 .AND. nfvbag0 > 0) THEN
4624 ! DT2R : value to be minimized over the processor
4625 dt2r = dt2
4626
4627 ! Fill MIN_TAB with integer
4628 min_tab(1) = nelts
4629 min_tab(2) = itypts
4630 min_tab(3) = 0
4631 min_tab(4) = ispmd
4632 !
4633 ! Begin Asynchronous communication
4634 !
4635 CALL mpi_min_real_begin(dt2r,min_tab,4,mpi_buf)
4636 ! | | | |
4637 !Value to be minimized --* | | |
4638 !Integers array ---------------* | |
4639 !Size of Integers array -------------* |
4640 !Internal Structure ----------------------*
4641 !
4642 ! After this call DT2R and MIN_TAB are unchanged
4643 ! The minimum value of DT2R and the corresponding MIN_TAB
4644 ! Will be received after a call to MPI_MIN_REAL_END
4645 ENDIF
4646
4647 t1sh=tt
4648C
4649C-----------------------------------------------------
4650C UPDATE OF SLIPRING AND RETRACTOR
4651C-----------------------------------------------------
4652
4653 IF (nslipring + nretractor> 0) CALL update_slipring(ixr,element%SHELL%IXC,iparg,elbuf_tab,flag_slipring_update,
4654 . flag_retractor_update,nodes%X,npby)
4655C
4656C---- // GROUPS ----------------
4657C INTERNAL FORCES OF SHELLS, 3-NODE SHELLS
4658C-------------------------------
4659 CALL trace_in(14,0,zero)
4660 IF (imon>0) CALL startime(timers,timer_element)
4661
4662C -------------------------------------------------------------------
4663C User Libraries get the possibility to use GET_U_NOD_X & GET_U_NOD_V in user elements properties (Solids & Springs)
4664 getunod_nocom=1
4665C -------------------------------------------------------------------
4666 llt1 = i87g+3*numeltg
4667!$OMP PARALLEL
4668!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
4669!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,DT2TT,NELTSTT,ITYPTSTT)
4670!$OMP+ PRIVATE(GREFTSK,GRELTSK)
4671!$OMP+ PRIVATE(IDX_FTHE,IDX_CONDN,IDX_PINCH)
4672C Init var parallel SMP
4673 CALL smp_init(
4674 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk,
4675 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4676 3 greftsk,greltsk)
4677 dt2tt = dt2t
4678 neltstt = neltst
4679 ityptstt= ityptst
4680 iad_grel = 1
4681 IF(igrelem == 1)iad_grel = k3-k1+1
4682 idx_fthe = ndtsk
4683 IF(ndtsk>ifthe)idx_fthe=1
4684 idx_condn = ndtsk
4685 IF(ndtsk>icondn)idx_condn=1
4686 idx_pinch = ndtsk
4687 IF(npinch == 0 )idx_pinch = 1
4688 IF(iparit == 1) ndtsk = 1
4689 CALL forintc(timers,
4690 1 pm ,geo ,nodes%X ,nodes%A(1,ndtsk) ,nodes%AR(1,ndtsk) ,
4691 2 nodes%V ,nodes%VR ,nodes%MS ,nodes%IN ,nloc_dmg ,
4692 3 wa(nwaftsk) ,nodes%STIFN(ndtsk) ,nodes%STIFR(ndtsk) ,element%PON%FSKY ,crksky ,
4693 4 tf ,bufmat ,partsav(ipmtsk) ,nodes%D ,mat_elem ,
4694 5 nodes%DR ,eani ,tani ,fani(1,nfoa+1) ,
4695 6 fsav ,sensors ,skews%SKEW ,anin(ndma2+1) ,failwave ,
4696 7 dt2tt ,thke ,bufgeo ,element%PON%IADC ,element%PON%IAD_TG ,
4697 8 iparg ,npc ,element%SHELL%IXC ,ixtg ,neltstt ,
4698 9 ipari ,ityptstt ,nstrf ,
4699 a ipart ,ipart(k3) ,ipart(k8) ,secfcum ,
4700 b fsavd ,mat_elem%GROUP_PARAM ,
4701 e fzero ,ixtg1 ,element%PON%IAD_TG6 ,igeo ,ipm ,
4702 f madfail ,xsec ,itsk ,nodes%MCP ,
4703 g nodes%TEMP ,fthe(idx_fthe) ,fthesky ,
4704 h ms_ply ,zi_ply ,inod_pxfem ,xedge4n ,xedge3n ,
4705 i iel_pxfem ,iadc_pxfem ,igrouc ,ngrouc ,gresav(igmtsk),
4706 j grth ,igrth(iad_grel) ,mstg ,dmeltg ,msc ,
4707 k dmelc ,table ,kxfenod2elc ,ptg ,msz2 ,
4708 l inod_crk ,iel_crk ,iadc_crk ,elcutc ,nodenr ,
4709 m ibordnode ,nodedge ,crknodiad ,elbuf_tab ,
4710 n xfem_tab ,condn(idx_condn),condnsky ,crkedge ,
4711 o stack ,nodes%ITAB ,glob_therm,
4712 q drape_sh4n ,drape_sh3n ,subsets, nodes%XDP ,pinch_data%VPINCH ,
4713 r pinch_data%APINCH(1,idx_pinch),pinch_data%STIFPINCH(idx_pinch),drapeg ,
4714 s output ,dt ,snpc , stf ,userl_avail ,maxfunc ,
4715 s sbufmat )
4716#include "lockon.inc"
4717 IF(dt2tt<dt2t)THEN
4718 dt2t = dt2tt
4719 neltst = neltstt
4720 ityptst= ityptstt
4721 END IF
4722#include "lockoff.inc"
4723!$OMP END PARALLEL
4724 CALL trace_out(14)
4725 IF (imon>0) CALL stoptime(timers,timer_element)
4726
4727
4728
4729
4730C---- // GROUPS ----------------
4731C INTERNAL FORCES OF TRUSSES, POUTRES, RESSORTS,
4732C SOLIDES, QUAD
4733C-------------------------------
4734
4735 CALL trace_in(14,0,zero)
4736 IF (imon>0) CALL startime(timers,timer_element)
4737 l1 = 1+nixs*numels + nsvois*nixs
4738 l2 = l1+6*numels10
4739 l3 = l2+12*numels20
4740 ll1 = 1+8*numels
4741 ll2 = ll1+6*numels10
4742 ll3 = ll2+12*numels20
4743
4744C
4745C========================================================================================
4746C PARALLEL SECTION (SMP)
4747C========================================================================================
4748!$OMP PARALLEL
4749!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK)
4750!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,DT2TT,NELTSTT,ITYPTSTT)
4751!$OMP+ PRIVATE(I16TSK,IGMTSK,GREFTSK,GRELTSK)
4752!$OMP+ PRIVATE(IDX_FTHE,IDX_CONDN)
4753C Init var parallel SMP
4754 CALL smp_init(
4755 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk,
4756 2 ipmtsk,partftsk ,partltsk ,nwaftsk,igmtsk ,
4757 3 greftsk,greltsk)
4758 IF(iparit == 1) ndtsk = 1
4759
4760 dt2tt = dt2t
4761 neltstt = neltst
4762 ityptstt= ityptst
4763 i16tsk = 1+itsk*(sw16/nthread)
4764 idx_fthe = ndtsk
4765 IF(ndtsk>ifthe) idx_fthe = 1
4766 idx_condn = ndtsk
4767 IF(ndtsk>icondn)idx_condn = 1
4768C
4769 CALL forint(timers, python,
4770 1 pm ,geo ,nodes%X ,nodes%A(1,ndtsk) ,nodes%AR(1,ndtsk) ,
4771 2 nodes%V ,nodes%VR ,nodes%MS ,nodes%IN ,w ,
4772 3 elbuf ,wa(nwaftsk) ,val2 ,veul ,fv ,
4773 4 nodes%STIFN(ndtsk) ,nodes%STIFR(ndtsk) ,element%PON%FSKY ,tf ,bufmat ,
4774 5 partsav(ipmtsk),nodes%D ,nodes%DR ,eani ,elbuf_tab ,
4775 6 tani ,fani(1,nfoa+1),fsav ,sensors ,nloc_dmg ,
4776 7 skews%SKEW ,anin(ndma2+1) ,dt2tt ,bufgeo ,nodes%ITAB ,
4777 8 element%PON%IADS ,element%PON%IADQ ,element%PON%IAD_TRUSS ,element%PON%IAD_BEAM ,mat_elem ,
4778 9 element%PON%IAD_SPRING ,iparg ,ale_connectivity,npc ,
4779 a ixs ,ixq ,ixt ,ixp ,
4780 b ixr ,neltstt ,ipari ,
4781 c ityptstt ,nstrf ,ipart ,
4782 d ipart(k1) ,ipart(k2) ,ipart(k4) ,ipart(k5) ,
4783 e ipart(k6) ,ipart(k7) ,fr_wave ,rby ,
4784 f secfcum ,agrv ,igrv ,lgrav ,
4785 g ixs(l1) ,
4786 h ixs(l2) ,element%PON%IADS10 ,element%PON%IADS20 ,ixs(l3) ,element%PON%IADS16 ,
4787 i w16(i16tsk) ,element%PON%FSKYM ,msnf ,igeo ,ipm ,
4788 j xsec ,itsk ,nodes%TEMP ,
4789 k fthe(idx_fthe) ,fthesky ,igrounc ,ngrounc ,
4790 m gresav(igmtsk) ,grth ,igrth ,nodes%XDP ,mssa ,
4791 n dmels ,mstr ,dmeltr ,msp ,dmelp ,
4792 o msrt ,dmelrt ,table ,vflow ,aflow ,
4793 p dflow ,wflow ,ffsky ,aflow ,nbsdvois ,
4794 q nercvois ,nesdvois ,lercvois ,lesdvois ,phi ,
4795 r phie ,msf ,nodftsk ,nodltsk ,
4796 s flg_kj2 ,por ,ifoam_cont ,ifoam ,sfem_nodvar ,
4797 t kxig3d ,ixig3d ,knot ,wige ,condn(idx_condn),
4798 u condnsky ,s_sfem_nodvar,
4799 v tagprt_sms ,itagnd ,ms_2d ,ale_connectivity%NALE ,stressmean ,
4800 w knotlocpc ,knotlocel ,subsets ,flag_slipring_update, flag_retractor_update ,
4801 y h3d_data ,ifthe ,icondn ,dt ,output,
4802 z sbufmat ,snpc ,stf ,nodadt ,dtfac1,
4803 . dtmin1 ,idtmin ,iout ,istdo ,idtmins,dtfacs,nsvois,
4804 . iresp ,maxfunc ,userl_avail ,glob_therm,imon_mat,dtmins,sanin)
4805C
4806#include "lockon.inc"
4807 IF(dt2tt<dt2t)THEN
4808 dt2t = dt2tt
4809 neltst = neltstt
4810 ityptst= ityptstt
4811 END IF
4812#include "lockoff.inc"
4813!$OMP END PARALLEL
4814 CALL trace_out(14)
4815
4816 IF (imon>0) CALL stoptime(timers,timer_element)
4817C-----
4818 IF(numsphg/=0)THEN
4819 IF (imonm > 0) CALL startime(timers,48)
4820 IF (imonm > 0) CALL startime(timers,87)
4821 CALL trace_in(13,0,zero)
4822C-----------------------------------------------
4823C SPH SORT, SYMMETRIZATION AND CSPH PREPARATION & SPH INLETS/OUTLETS (After forint)
4824C-----------------------------------------------
4825C========================================================================================
4826C PARALLEL SECTION (SMP)
4827C========================================================================================
4828!$OMP PARALLEL
4829!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
4830!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK)
4831C Init var parallel SMP
4832 CALL smp_init(
4833 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk,
4834 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4835 3 greftsk,greltsk)
4836
4837
4838 CALL sphprep(timers,
4839 1 pm ,geo ,nodes%X ,nodes%V ,nodes%MS ,
4840 2 elbuf_tab,wa ,tf ,bufmat ,partsav ,
4841 3 iparg ,npc ,ipart ,nodes%ITAB ,bufgeo ,
4842 4 xframe ,kxsp ,ixsp ,nod2sp ,ipart(k10),
4843 5 spbuf ,ispcond ,ispsym ,xspsym ,vspsym ,
4844 6 wasph(ksph21) ,lprtsph ,lonfsph ,wasph(ksp2sort) ,
4845 7 isphio ,vsphio ,igrsurf ,nodes%D ,
4846 8 sphveln ,itsk ,nodes%XDP ,ibufssg_io,lgauge ,
4847 9 gauge ,ngrounc ,igrounc ,sol2sph ,sph2sol ,
4848 a ixs ,element%PON%IADS ,element%PON%ADSKY ,element%PON%FSKYD ,dmsph(ndtsk),
4849 b wasph(kspactiv),icontact_old,off_sph_r2r,wsmcomp,irunn_bis,
4850 c sph_iord1,sph_work,output%TH%WFEXT)
4851!$OMP END PARALLEL
4852
4853 IF (imonm > 0) CALL stoptime(timers,87)
4854C========================================================================================
4855C PARALLEL SECTION (SMP)
4856C========================================================================================
4857 IF (imonm > 0) CALL startime(timers,88)
4858
4859!$OMP PARALLEL
4860!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK)
4861!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK)
4862!$OMP+ PRIVATE(DT2TT,NELTSTT,ITYPTSTT,IGMTSK,GREFTSK,GRELTSK)
4863
4864C Init var parallel SMP
4865 CALL smp_init(
4866 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
4867 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
4868 3 greftsk,greltsk)
4869
4870 dt2tt = dt2t
4871 neltstt = neltst
4872 ityptstt= ityptst
4873
4874 iad_grel = 1
4875 IF(igrelem == 1)iad_grel = k10-k1+1
4876 IF(iparit == 1) ndtsk = 1
4877
4878C----------------------------------
4879C SPH: Internal forces
4880C----------------------------------
4881 CALL forintp(timers,
4882 1 pm ,geo ,nodes%X ,nodes%A(1,ndtsk) ,nodes%V ,
4883 2 nodes%MS ,w ,elbuf_tab ,wa ,fv ,
4884 3 nodes%STIFN(ndtsk) ,tf ,bufmat ,partsav(ipmtsk) ,nloc_dmg ,
4885 4 fsav ,dt2tt ,element%PON%IADS ,iparg ,npc ,
4886 5 neltstt ,ityptstt ,ipart ,nodes%ITAB ,interfaces%PON%ISKY ,
4887 6 bufgeo ,interfaces%PON%FSKYI ,xframe ,kxsp ,ixsp ,
4888 7 nod2sp ,ipart(k10) ,spbuf ,ispcond ,ispsym ,
4889 8 xspsym%BUF ,vspsym%BUF ,
4890 9 wasph(ksph21) ,lprtsph ,lonfsph ,wasph(kspactiv) ,isphio ,
4891 a vsphio ,sphveln ,itsk ,ipm ,gresav(igmtsk),
4892 b grth ,igrth(iad_grel),table ,lgauge ,gauge ,
4893 c ngrounc ,igrounc ,ixs ,irst ,sol2sph ,
4894 d sph2sol ,element%PON%FSKY ,element%PON%FSKY ,igeo ,nodes%TEMP ,
4895 e fthe ,ftheskyi ,sphg_f6 ,wsmcomp%BUF ,sol2sph_typ ,
4896 f mat_elem ,output ,sph_iord1 ,snpc ,stf ,
4897 g sbufmat ,nsvois ,idtmins ,iresp ,maxfunc ,
4898 . imon_mat ,userl_avail ,impl_s ,idyna ,
4899 . dt ,glob_therm ,sph_work ,output%TH%WFEXT ,sensors )
4900#include "lockon.inc"
4901 IF(dt2tt<dt2t)THEN
4902 dt2t = dt2tt
4903 neltst = neltstt
4904 ityptst= ityptstt
4905 END IF
4906#include "lockoff.inc"
4907
4908!$OMP END PARALLEL
4909C -------------------------------------------------------------------
4910C User Libraries get the possibility to use GET_U_NOD_X & GET_U_NOD_V in user elements properties (Solids & Springs)
4911 getunod_nocom=0
4912C -------------------------------------------------------------------
4913
4914C=======================================================================================
4915C NON PARALLEL SECTION (SMP)
4916C========================================================================================
4917
4918 CALL trace_out(13)
4919 IF (imonm > 0) CALL stoptime(timers,88)
4920 IF (imonm > 0) CALL stoptime(timers,48)
4921 ENDIF
4922
4923C-----------------------------------------------
4924C Multidomains : synchro proc of flag_activation
4925C----------------------------------------------
4926 IF (nspmd>1) THEN
4927 IF ((sdd_r2r_elem>0).AND.(flg_sphinout_r2r>0)) THEN
4928 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
4929 CALL spmd_exch_r2r_sphoff(off_sph_r2r,nodes%BOUNDARY_ADD,nodes%BOUNDARY,dd_r2r,dd_r2r_elem,lenr)
4930 CALL spmd_exch_r2r_sph(nodes%X,nodes%BOUNDARY_ADD,nodes%BOUNDARY,dd_r2r,dd_r2r_elem,lenr)
4931 CALL spmd_exch_r2r_sph(nodes%D,nodes%BOUNDARY_ADD,nodes%BOUNDARY,dd_r2r,dd_r2r_elem,lenr)
4932 CALL spmd_exch_r2r_sph(nodes%V,nodes%BOUNDARY_ADD,nodes%BOUNDARY,dd_r2r,dd_r2r_elem,lenr)
4933 ENDIF
4934 ENDIF
4935
4936
4937 IF(nvolu/=0)THEN
4938 IF (imonm > 0) CALL startime(timers,50)
4939 CALL trace_in(11,0,zero)
4940 nn = numelc+numeltg+ibagsurf
4941 n0 = 1 + 3*nn
4942 IF(intbag/=0)THEN
4943 n1 = n0+ nn
4944 ELSE
4945 n1 = n0
4946 ENDIF
4947 sporo = numelc+numeltg+ibagsurf
4948C
4949 n=1+ninter+nrwall+nrbody+nsect+njoint+nrbag
4950 CALL fvbag0(monvol, volmon, nodes%X, sensors%SENSOR_TAB, nodes%V,
4951 . nodes%A, npc, tf, nsensor ,
4952 . fsav(1,n), ifvmesh, icontact_old,lgauge,
4953 . gauge , igeo, geo, pm, ipm,
4954 . iparg , igrouptg,igroupc, elbuf_tab, noda_fext,
4955 . 2 , h3d_data,nodes%ITAB, nodes%WEIGHT, output%TH%WFEXT, python)
4956 IF (impl_s > 0 .AND. ismdisp >0) THEN
4957 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
4958 ELSE
4959 CALL assign_ptrx(ptrx,nodes%X,numnod)
4960 ENDIF
4961 CALL monvol0(
4962 1 monvol ,volmon ,ptrx ,nodes%A ,
4963 2 npc ,tf ,nodes%V ,wa ,
4964 3 fsav(1,n) ,nsensor ,sensors%SENSOR_TAB ,igrsurf ,
4965 4 fr_mv ,element%PON%IAD_MV ,sicontact ,sporo ,
4966 5 element%PON%FSKY ,icontact ,wa(n0) ,iparg ,
4967 6 elbuf_tab ,geo ,igeo ,
4968 7 pm ,ipm ,ipart ,ipart(k3) ,
4969 8 ipart(k8) ,igroupc ,igrouptg ,noda_fext ,
4970 9 2 ,h3d_data ,t_monvol ,frontier_global_mv,
4971 a output, python)
4972
4973 CALL trace_out(11)
4974 IF (imonm > 0) CALL stoptime(timers,50)
4975 ENDIF
4976
4977C========================================================================================
4978C PARALLEL SECTION (SMP)
4979C========================================================================================
4980
4981 IF (ns10e > 0 .AND. iparit==0) THEN
4982C must be done before the reception of remote contact stif
4983!$OMP PARALLEL
4984!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,GREFTSK,GRELTSK)
4985 itsk = omp_get_thread_num()
4986 nodftsk = 1+itsk*numnod/ nthread
4987 nodltsk = (itsk+1)*numnod/nthread
4988 greftsk = 1+itsk*ns10e/ nthread
4989 greltsk = (itsk+1)*ns10e/nthread
4990 CALL s10stfe_poff(icnds10,nodes%WEIGHT ,iad_cnds,fr_cnds,nodes%ITAB ,
4991 2 nodftsk,nodltsk,greftsk,greltsk,itsk ,
4992 3 nodes%STIFN ,stifnd)
4993!$OMP END PARALLEL
4994 END IF
4995
4996C========================================================================================
4997C NON PARALLEL SECTION (SMP)
4998C========================================================================================
4999
5000C----------------------------------------
5001C Communication of interface forces (SPMD), Part2 : Reception
5002C----------------------------------------
5003 IF(ninter/=0) THEN
5004 IF(nspmd>1)THEN
5005 IF(imonm == 2)THEN
5006 CALL startime(timers,59)
5007 CALL spmd_barrier()
5008 CALL stoptime(timers,59)
5009 ENDIF
5010 IF (imon>0) CALL startime(timers,timer_exfor)
5011 IF (imonm > 0) CALL startime(timers,22)
5012C
5013 l1 = 1+nixs*numels + nsvois*nixs
5014 l2 = l1+6*numels10
5015 l3 = l2+12*numels20
5016 IF(iparit==0)THEN
5017
5018 CALL spmd_i7fcom_poff(
5019 1 ipari ,nodes%A ,nodes%STIFN ,nodes%VISCN ,
5020 2 intlist ,nbintc ,nodes%ICODT ,secfcum ,nstrf ,
5021 3 icontact ,fani ,islen7 ,irlen7 ,islen11 ,
5022 4 irlen11 ,islen17 ,irlen17 ,igrbric ,
5023 5 ixs ,ixs(l3) ,fthe ,irlen7t ,
5024 6 islen7t ,irlen20 ,islen20 ,irlen20t,islen20t,
5025 7 irlen20e ,islen20e,condn ,2, interfaces%INTBUF_TAB,
5026 8 h3d_data, multi_fvm,tagncont,kloadpinter,loadpinter,
5027 9 loadp_hyd_inter,fsav ,interfaces,glob_therm%nodadt_therm)
5028 ELSE
5029
5030 CALL spmd_i7fcom_pon(
5031 1 ipari ,intlist ,nbintc ,niskyfi ,nodes%ICODT ,
5032 2 secfcum ,nstrf ,icontact ,fani ,igrbric ,
5033 3 ixs ,ixs(l3) ,niskyfie ,nbint20 ,2 ,
5034 4 interfaces%INTBUF_TAB,sfskyi ,sisky ,h3d_data ,multi_fvm ,
5035 5 tagncont ,kloadpinter,loadpinter,loadp_hyd_inter,fsav,
5036 6 interfaces,glob_therm)
5037 END IF
5038
5039C
5040 IF (imon>0) THEN
5041 CALL stoptime(timers,timer_exfor)
5042 IF (imonm > 0) CALL stoptime(timers,22)
5043 ENDIF
5044 ENDIF
5045 ENDIF
5046
5047 22 CONTINUE
5048
5049! Mpi communication for Nlocal option : parith/off
5050 IF(iparit /= 0.AND.nspmd > 1.AND. nloc_dmg%IMOD > 0)THEN
5051 CALL spmd_exch_sub_pon(nloc_dmg)
5052 ENDIF
5053 IF(nspmd > 1.AND. nintloadp > 0)THEN
5054 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5055 CALL spmd_exch_tagncont(tagncont,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,lenr )
5056 ENDIF
5057! ----------------------------------
5058
5059 IF(nloadp_hyd/=0.AND.impl_s/=1) THEN
5060 noda_fext = zero
5061 CALL trace_in(10,0,zero)
5062 IF (imon>0) CALL startime(timers,timer_kin)
5063 IF (imonm > 0) CALL startime(timers,41)
5064 CALL load_pressure (iloadp ,loadp ,lloadp ,npc ,tf ,
5065 2 nodes%A ,nodes%V ,nodes%X ,skews%SKEW ,sensors%SENSOR_TAB,
5066 3 element%PON%IAD_LOADP,element%PON%FSKY ,fani(1,1+nfea),tagncont ,nsensor ,
5067 4 loadp_hyd_inter,h3d_data , python,
5068 5 npresload ,loadp_tagdel,output%TH%TH_SURF,pblast,output%TH%WFEXT)
5069
5070
5071 IF (imonm > 0) CALL stoptime(timers,41)
5072 IF (imon>0) CALL stoptime(timers,timer_kin)
5073 CALL trace_out(10)
5074 ENDIF
5075C--- //------------------------------
5076C FORCE ASSEMBLY
5077C-------------------------------------
5078 IF(coupling%active) THEN
5079 nodes%FORCES(1:3,1:numnod) = nodes%A(1:3,1:numnod)
5080 ENDIF
5081C========================================================================================
5082C PARALLEL SECTION (SMP)
5083C========================================================================================
5084 dtnod_nlocal = ep20
5085 IF(iparit == 0 .AND. nthread > 1)THEN
5086 IF (imon>0) CALL startime(timers,timer_asm)
5087
5088!$OMP PARALLEL
5089!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,PARTFTSK,PARTLTSK,GREFTSK,GRELTSK,NODFT_NL,NODLT_NL)
5090 itsk = omp_get_thread_num()
5091 nodftsk = 1+itsk*numnod/ nthread
5092 nodltsk = (itsk+1)*numnod/nthread
5093 partftsk = 1+itsk*npsav*npart/nthread
5094 partltsk = (itsk+1)*npsav*npart/nthread
5095 greftsk = 1+itsk*npsav*ngpe/nthread
5096 greltsk = (itsk+1)*npsav*ngpe/nthread
5097
5098C Parith/OFF assembly necessary before boundary communication if multi-thread
5099
5100 CALL asspar(
5101 1 nthread ,numnod,nodftsk,nodltsk,iroddl,
5102 2 npart ,partftsk,partltsk ,nodes%A ,nodes%AR ,
5103 3 partsav ,nodes%STIFN ,nodes%STIFR ,nodes%VISCN , fthe ,
5104 4 glob_therm%ITHERM_FE,glob_therm%NODADT_THERM,stcnd ,greftsk,greltsk ,
5105 5 gresav ,ngpe ,nthpart ,ialelag, aflow,
5106 6 dmsph ,condn ,
5107 7 pinch_data%APINCH,pinch_data%STIFPINCH)
5108
5109
5110! ----------------------------------
5111! Accumulation of acceleration for Nlocal option : parith/off
5112 IF (nloc_dmg%IMOD > 0) THEN
5113 nodft_nl = 1+ itsk*nloc_dmg%NNOD/nthread
5114 nodlt_nl = (itsk+1)*nloc_dmg%NNOD/nthread
5115 CALL asspar_sub_poff(nloc_dmg%FNL ,nodft_nl,nodlt_nl,
5116 . nloc_dmg%POSI,nloc_dmg%L_NLOC,nthread )
5117 ! Non-local nodal stiffness
5118 IF (nodadt > 0) THEN
5119 CALL asspar_sub_poff(nloc_dmg%STIFNL,nodft_nl,nodlt_nl,
5120 . nloc_dmg%POSI,nloc_dmg%L_NLOC,nthread )
5121 CALL nlocal_dtnoda(nodft_nl,nodlt_nl,nloc_dmg,dtnod_nlocal,dt2t)
5122 ENDIF
5123 ENDIF
5124!$OMP END PARALLEL
5125 IF (imon>0) CALL stoptime(timers,timer_asm)
5126 ENDIF
5127C Transfer of contact force from sleeping particles to solid nodes
5128C========================================================================================
5129C PARALLEL SECTION (SMP)
5130C========================================================================================
5131 IF(numsph /= 0 .AND. nsphsol /= 0 )THEN
5132 IF (imonm > 0) CALL startime(timers,48)
5133 IF (imonm > 0) CALL startime(timers,89)
5134
5135!$OMP PARALLEL
5136!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK)
5137 itsk = omp_get_thread_num()
5138 nodftsk = 1+itsk*numnod/ nthread
5139 nodltsk = (itsk+1)*numnod/nthread
5140
5141 CALL soltosphf(
5142 1 nodes%A ,spbuf ,ixs ,kxsp ,ipart(k10),
5143 2 nod2sp ,irst ,ngrounc ,igrounc ,iparg ,
5144 3 nodes%STIFN ,sol2sph,sph2sol ,elbuf_tab,itsk ,
5145 4 nodftsk,nodltsk,interfaces%PON%ISKY ,interfaces%PON%FSKYI ,igeo ,
5146 5 sol2sph_typ)
5147
5148!$OMP END PARALLEL
5149
5150 IF (imonm > 0) CALL stoptime(timers,89)
5151 IF (imonm > 0) CALL stoptime(timers,48)
5152 ENDIF
5153
5154C===== Nitsche Method Reinit FORNEQS every cycle
5155
5156 IF(nitsche/=0) THEN
5157!$OMP PARALLEL
5158!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK)
5159
5160C Init var parallel SMP
5161 CALL smp_init(
5162 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
5163 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
5164 3 greftsk,greltsk)
5165
5166 CALL zeror(forneqs(1,nodftsk),numntsk)
5167
5168!$OMP END PARALLEL
5169
5170C====== Nitsche equivalent nodal force computation FORNEQS ===========
5171
5172 IF (int24use == 1)THEN
5173 IF (sh_offset_tab%NNSH_OSET > 0) THEN
5174 CALL assign_ptrx(ptrx,xyz,numnod)
5175 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
5176 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
5177 ELSE
5178 CALL assign_ptrx(ptrx,nodes%X,numnod)
5179 ENDIF
5180 CALL i24nitschfor3 (ipari ,interfaces%INTBUF_TAB,iparit ,stressmean ,
5181 2 intlist ,nbintc ,ptrx,element%PON%IADS,
5182 3 forneqs ,forneqsky ,nodes%ITAB ,ixs ,
5183 4 element%PON%IADS10,element%PON%IADS20 ,element%PON%IADS16,nfacnit )
5184 ENDIF
5185 ENDIF
5186
5187C========================================================================================
5188C NON PARALLEL SECTION (SMP)
5189C========================================================================================
5190
5191 IF(int18kine== 1)THEN
5192 ALLOCATE(mtf(14,numnod))
5193 ALLOCATE(cand_sav(8,int18add(ninter+1)-1))
5194 IF (nspmd > 1)THEN
5195 ALLOCATE(tagpene(numnod))
5196 ELSE
5197 ALLOCATE(tagpene(1))
5198 ENDIF
5199 ENDIF
5200 int18add(ninter+1) = -iabs(int18add(ninter+1))
5201 int18kine=-iabs(int18kine)
5202
5203 IF(nspmd>1)THEN
5204 IF (imon>0) CALL startime(timers,timer_exfor)
5205 IF (iparit==0) THEN
5206 length = 4 + iroddl*4
5207 IF (n2d/=0) THEN
5208 length = length + 1
5209 IF(ale%SUB%IFSUBM == 1) length = length + 1
5210 ELSEIF(ale%SUB%IFSUBM==1)THEN
5211 length = length + 2
5212 ENDIF
5213C
5214 IF(glob_therm%ITHERM_FE > 0 )THEN
5215 length = length + 3
5216 IF (glob_therm%NODADT_THERM == 1 ) length = length + 1
5217 ENDIF
5218C
5219 IF(ialelag > 0 )THEN
5220 length = length + 4
5221 ENDIF
5222C
5223 IF(sol2sph_flag/=0) length = length + 1
5224C
5225 IF(nitsche > 0 )THEN
5226 nfacnit = 3
5227 ENDIF
5228C
5229 lenc = 0
5230 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) lenc = 3
5231 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) lenc = lenc+6
5232C
5233 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5234 IF(idtmins /= 0)THEN
5235
5236 CALL spmd_exch_a_ams_poff(
5237 1 nodes%A ,nodes%AR ,nodes%STIFN, nodes%STIFR ,nodes%MS ,
5238 2 nodes%BOUNDARY_ADD,nodes%BOUNDARY,msnf ,ale%SUB%IFSUBM,length ,
5239 3 lenr ,fthe , nodes%MCP,fr_loc,nb_fr ,
5240 4 ms_2d ,mcp_off,forneqs ,nfacnit ,
5241 5 lenc ,fani ,h3d_data,fani(1,nfnca+1),
5242 6 fani(1,nftca+1) ,glob_therm)
5243 ELSE
5244 CALL spmd_exch_a(
5245 1 nodes%A , nodes%ACC_DP ,nodes%AR ,nodes%STIFN,nodes%STIFR ,nodes%MS ,
5246 2 nodes%BOUNDARY_ADD,nodes%BOUNDARY,msnf ,ale%SUB%IFSUBM,length ,
5247 3 lenr ,fthe , nodes%MCP, dmsph,condn,
5248 4 ms_2d,mcp_off,
5249 5 forneqs ,nfacnit,lenc ,fani ,h3d_data,
5250 6 fani(1,nfnca+1) ,fani(1,nftca+1) ,glob_therm)
5251
5252 ENDIF
5253C
5254 ELSE
5255 length = 4 + iroddl*4
5256 IF(ale%SUB%IFSUBM==1)THEN
5257 length = length + 1
5258 ENDIF
5259 IF(n2d /= 0.AND.ale%SUB%IFSUBM == 1) length = length + 1
5260 sizi = nfskyi+1
5261C
5262 IF (glob_therm%ITHERM_FE > 0 )THEN
5263 length = length + 1
5264 sizi = sizi + 1
5265 IF (glob_therm%NODADT_THERM == 1 ) THEN
5266 length = length + 1
5267 sizi = sizi + 1
5268 ENDIF
5269 ENDIF
5270 IF(intplyxfem > 0) sizi = sizi + 5
5271C
5272 IF(ialelag > 0 )THEN
5273 length = length + 4
5274 ENDIF
5275C
5276 lens = fr_nbcc(1,nspmd+1)
5277 lenr = fr_nbcc(2,nspmd+1)
5278 leni = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5279C
5280 lens1 = 0
5281 lenr1 = 0
5282C
5283 IF(iplyxfem > 0) THEN
5284 lens1 = fr_nbcc1(1,nspmd+1)
5285 lenr1 = fr_nbcc1(2,nspmd+1)
5286 ENDIF
5287C
5288 IF(icrack3d > 0) THEN
5289 lens1 = fr_nbcc1(1,nspmd+1)
5290 lenr1 = fr_nbcc1(2,nspmd+1)
5291 ENDIF
5292C
5293 IF(sol2sph_flag/=0)THEN
5294 length = length + 1
5295 ENDIF
5296C
5297 lenc = 0
5298 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX /=0.AND.nintstamp==0) lenc = 3*leni
5299 IF(h3d_data%N_VECT_PCONT_MAX /=0.AND.nintstamp==0) lenc = lenc+6*leni
5300
5301 CALL spmd_exch2_a_pon(interfaces,
5302 1 nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,element%PON%ADSKY ,element%PON%PROCNE ,fr_nbcc ,
5303 2 length ,lenr ,lens ,element%PON%FSKY ,element%PON%FSKY ,
5304 3 element%PON%FSKYM ,ale%SUB%IFSUBM ,sizi ,leni ,element%PON%IADSDP ,
5305 4 element%PON%IADRCP ,element%PON%ISENDP ,element%PON%IRECVP ,ffsky ,procne_pxfem,
5306 5 fr_nbcc1 ,iadsdp_pxfem,iadrcp_pxfem ,isendp_pxfem,
5307 6 irecvp_pxfem,lenr1 ,lens1 ,iadsdp_crk,iadrcp_crk ,
5308 7 isendp_crk ,irecvp_crk,element%PON%FSKYD ,crknodiad ,crksky ,
5309 8 forneqsky ,nfacnit ,lenc , fani ,h3d_data ,
5310 9 fani(1,nfnca+1),fani(1,nftca+1) ,glob_therm)
5311C
5312 ENDIF
5313 IF (imon>0) CALL stoptime(timers,timer_exfor)
5314 ENDIF
5315
5316C--- //------------------------------
5317C PARITH/ON ASSEMBLY OF FORCES AFTER COMMUNICATION
5318C-------------------------------------
5319 CALL trace_in(15,0,zero)
5320
5321 IF (imon>0) CALL startime(timers,timer_asm)
5322c Parallel update of crack
5323 IF(icrack3d > 0 .AND. nspmd > 1) CALL spmd_max_xfe_i(nlevset)
5324
5325C========================================================================================
5326C PARALLEL SECTION (SMP)
5327C========================================================================================
5328 IF(iparit==1) ALLOCATE( fsky_l(nisky) )
5329 dtnod_nlocal = ep20
5330!$OMP PARALLEL
5331!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,PARTFTSK,PARTLTSK,GREFTSK,GRELTSK,NODFTSK_2,NODLTSK_2,NODFT_NL,NODLT_NL)
5332 itsk = omp_get_thread_num()
5333
5334 nodftsk = 1+itsk*numnod/ nthread
5335 nodltsk = (itsk+1)*numnod/nthread
5336 partftsk = 1+itsk*npsav*npart/nthread
5337 partltsk = (itsk+1)*npsav*npart/nthread
5338 greftsk = 1+itsk*npsav*ngpe/nthread
5339 greltsk = (itsk+1)*npsav*ngpe/nthread
5340 nodftsk_2 = nodft_asspar(itsk+1)
5341 nodltsk_2 = nodlt_asspar(itsk+1)
5342
5343 IF(iparit==1)THEN
5344
5345C------------------------
5346C Assembly Parith/ON spmd+multi-thread
5347C------------------------
5348 CALL asspar4(nodes,
5349 2 element%PON%FSKY ,element%PON%FSKY ,element%PON%ADSKY ,element%PON%FSKYM ,
5350 3 msnf ,interfaces%PON%ISKY ,interfaces%PON%FSKYI ,fthe ,
5351 4 fthesky,ftheskyi,nodftsk,nodltsk ,interfaces%PON%ADSKYI,
5352 5 partsav,partftsk ,partltsk ,itsk ,greftsk ,
5353 6 greltsk ,gresav ,aflow ,ffsky ,msf ,
5354 7 adsky_pxfem, inod_pxfem ,element%PON%FSKYD ,
5355 8 dmsph ,condn ,condnsky ,condnskyi,
5356 9 ms_2d,icnds10 ,
5357 a stifnd ,forneqs ,forneqsky ,nfacnit,nodftsk_2,
5358 b nodltsk_2,fsky_l,glob_therm)
5359
5360! ----------------------------------
5361! Accumulation of acceleration for Nlocal option : parith/on
5362 IF (nloc_dmg%IMOD>0) THEN
5363 nodft_nl = 1+ itsk*nloc_dmg%NNOD/nthread
5364 nodlt_nl = (itsk+1)*nloc_dmg%NNOD/nthread
5365 CALL asspar_sub(nloc_dmg%FNL(:,1) ,nloc_dmg%FSKY,nloc_dmg%ADDCNE,nodft_nl ,
5366 . nodlt_nl ,nloc_dmg%POSI ,nloc_dmg%NNOD, nloc_dmg%L_NLOC)
5367 ! Non-local nodal stiffness
5368 IF (nodadt > 0) THEN
5369 CALL asspar_sub(nloc_dmg%STIFNL(:,1),nloc_dmg%STSKY,nloc_dmg%ADDCNE,nodft_nl,
5370 . nodlt_nl,nloc_dmg%POSI,nloc_dmg%NNOD,nloc_dmg%L_NLOC)
5371 CALL nlocal_dtnoda(nodft_nl,nodlt_nl,nloc_dmg,dtnod_nlocal,dt2t)
5372 ENDIF
5373 ENDIF
5374C------------------------
5375C Assembly of Parith/ON forces on Phantom Xfem
5376C------------------------
5377 IF(icrack3d > 0)THEN
5378C /---------------/
5379 CALL my_barrier
5380C /---------------/
5381 CALL asspar_crk(
5382 . adsky_crk,inod_crk ,crksky ,nodftsk ,nodltsk ,
5383 . nodenr ,nodlevxf ,nodes%ITAB )
5384 ENDIF
5385 ELSEIF(iparit==2)THEN
5386
5387 IF(kdtint/=0)THEN
5388
5389!$OMP SINGLE
5390 CALL ancmsg(msgid=165,anmode=aninfo)
5391!$OMP END SINGLE
5392
5393 CALL arret(1)
5394 ENDIF
5395C
5396 CALL asspar3(
5397 2 nodes%A ,nodes%AR ,itsk ,nodftsk ,
5398 3 nodltsk ,nodes%STIFN ,nodes%STIFR ,nodes%ITAB ,element%PON%FSKY ,
5399 4 element%PON%FSKY ,interfaces%PON%ISKY ,element%PON%ADSKY ,interfaces%PON%FSKYI ,
5400 5 wa ,partftsk ,partltsk ,partsav ,nodes%MS ,
5401 6 fthe ,fthesky ,ftheskyi ,greftsk ,greltsk ,
5402 7 gresav ,glob_therm%ITHERM_FE ,glob_therm%INTHEAT )
5403
5404 ELSEIF(iparit==3)THEN
5405
5406C Assemblage Parith/ON
5407 n1 = 1 + numnod
5408 CALL asspar5(
5409 1 nthread ,numnod ,nodftsk ,nodltsk ,iroddl ,
5410 2 npart ,partftsk ,partltsk ,nodes%A ,nodes%AR ,
5411 3 partsav ,nodes%STIFN ,nodes%STIFR ,nodes%A(1,n1) ,nodes%AR(1,n1) ,
5412 4 nodes%STIFN(n1) ,nodes%STIFR(n1) ,nodes%VISCN ,nodes%VISCN(n1),greftsk ,
5413 5 greltsk ,gresav ,ngpe ,nthpart)
5414C
5415 ENDIF
5416
5417 IF(kdtint/=0) CALL modsti(nodftsk,nodltsk,nodes%STIFN,nodes%VISCN,nodes%MS)
5418
5419!$OMP END PARALLEL
5420C
5421 IF(iparit==1) DEALLOCATE( fsky_l )
5422 IF (imon>0) CALL stoptime(timers,timer_asm)
5423 CALL trace_out(15)
5424C========================================================================================
5425C NON PARALLEL SECTION (SMP)
5426C========================================================================================
5427
5428! -------------------------------------------
5429! check if a NaN appears in acc vectors (only available with /DEBUG/NAN option)
5430 IF( debug(macro_debug_nan)/=0 )CALL check_nan_acc(ncycle,nodes)
5431! write *.adb files for NON-LOCAL option
5432 IF (debug(macro_debug_acc)==1.AND.(nloc_dmg%IMOD>0)) THEN
5433 IF (ispmd==0) THEN
5434 siz = numnodg
5435 ELSE
5436 siz = 0
5437 END IF
5438 IF ( ncycle>=debstart .AND.
5439 . mod(ncycle-debstart,rstfreq)==0 ) THEN
5440 CALL spmd_collect_nlocal(nloc_dmg%FNL(:,1),nloc_dmg%L_NLOC ,nloc_dmg%NNOD,
5441 . nloc_dmg%POSI ,nloc_dmg,siz,nodes%NODGLOB,nodes%ITAB )
5442 ENDIF
5443 ENDIF
5444
5445C----------------------------------
5446C ITET2 of S10 Forces condensation; pass 1
5447C----------------------------------
5448
5449C========================================================================================
5450C PARALLEL SECTION (SMP)
5451C========================================================================================
5452
5453 IF (ns10e > 0) THEN
5454!$OMP PARALLEL
5455!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,GREFTSK,GRELTSK)
5456 itsk = omp_get_thread_num()
5457 nodftsk = 1+itsk*numnod/ nthread
5458 nodltsk = (itsk+1)*numnod/nthread
5459 greftsk = 1+itsk*ns10e/ nthread
5460 greltsk = (itsk+1)*ns10e/nthread
5461 CALL s10cndf1(icnds10,nodes%WEIGHT ,iad_cndm1,fr_cndm1,fr_nbcccnd1,
5462 1 addcncnd,procncnd,nodes%A ,iadcnd,fskycnd,
5463 2 itagnd ,nodftsk,nodltsk,greftsk,greltsk,
5464 3 itsk ,nodes%ITAB ,nodes%STIFN, stifnd)
5465!$omp END parallel
5466 END IF
5467c--------------------------------------
5468 IF(sol2sph_flag/=0)THEN
5469C========================================================================================
5470C PARALLEL SECTION (SMP)
5471C========================================================================================
5472
5473!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
5474 itsk = omp_get_thread_num()
5475 nodftsk = 1+itsk*numnod/ nthread
5476 nodltsk = (itsk+1)*numnod/nthread
5477 DO i=nodftsk,nodltsk
5478 IF(nodes%MS(i)/=zero)THEN
5479 IF(nodes%MS(i)-dmsph(i) < em03*nodes%MS(i))THEN
5480 nodes%MS(i)=zero
5481 ELSE
5482 nodes%MS(i)=max(zero,nodes%MS(i)-dmsph(i))
5483 END IF
5484 END IF
5485 dmsph(i)=zero
5486 ENDDO
5487!$OMP END PARALLEL
5488 ENDIF
5489
5490C========================================================================================
5491C NON PARALLEL SECTION (SMP)
5492C========================================================================================
5493
5494 IF (int24use == 1)THEN
5495 IF (imon>0) CALL startime(timers,timer_contfor)
5496 CALL spmd_exch_i24(ipari ,interfaces%INTBUF_TAB,nodes%ITAB ,
5497 * nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,intlist ,nbintc,
5498 * iad_i24 ,fr_i24 ,sfr_i24,i24maxnsne,2,
5499 * int24e2euse )
5500 IF (imon>0) CALL stoptime(timers,timer_contfor)
5501 ENDIF
5502
5503C
5504C Communication Interface type20 DAANC6
5505C
5506 IF(nbint20>0.AND.nspmd>1) THEN
5507 length = 21
5508 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5509 CALL spmd_exch_da20(
5510 1 interfaces%INTBUF_TAB,ipari,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
5511 2 length ,nbint20,lenr ,intlist ,nbintc )
5512 ENDIF
5513C
5514C Communication ICONTACT AIRBAG
5515C
5516 IF(kcontact/=0.AND.nspmd>1) THEN
5517 length = 1
5518 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5519 CALL spmd_exch_icont(icontact
5520 + ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,length,lenr)
5521 ENDIF
5522C
5523C Communication IFOAM
5524C
5525 IF(ialelag > 0.AND.nspmd>1) THEN
5526 length = 1
5527 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5528 CALL spmd_exch_icont(ifoam,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,length,lenr)
5529 ENDIF
5530C
5531#ifdef DNC
5532 IF (imadcpl>0)THEN
5533C at every cycle except cycle 0, send the Nodes coordinates
5534 CALL data_recv_madcpl(nodes%X,nodes%A,nodes%V,nodes%MS,fani,madclnod,madclfrecv,h3d_data)
5535 ENDIF
5536#endif
5537
5538 IF (vipercoupling) THEN
5539C Viper's contribution to force
5540 CALL radiossviper_receiveaccelerations(numnod,nodes%A,noda_fext,viper%ITABM1)
5541 endif
5542
5543CFP SKIP KINEMATIC FORCES
5544 IF(ale%SUB%IALESUB==2 .AND. ale%SUB%IFSUB==2) GOTO 23
5545
5546C
5547C POROUS MEDIA (not parallel)
5548C---------------------------------------------------------------------
5549 IF(numpor>0) THEN
5550 CALL poro(
5551 1 geo ,nodpor ,nodes%MS,nodes%X ,nodes%V ,
5552 2 w ,nodes%A ,nodes%AR,skews%SKEW,nodes%WEIGHT,
5553 3 nporgeo)
5554 ENDIF
5555C---------------------------------------------------------------------
5556C DEBUG OUTPUT ACCELERATION
5557C---------------------------------------------------------------------
5558 IF (debug(macro_debug_acc)==1) THEN
5559 IF (ncycle>=debstart .AND.
5560 . mod(ncycle-debstart,rstfreq)==0) THEN
5561
5562 IF(nspmd > 1) THEN
5563 IF (ispmd==0) THEN
5564 siz = numnodg
5565 ELSE
5566 siz = 0
5567 END IF
5568 CALL spmd_collect(nodes%A,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB,siz)
5569 ELSE
5570 CALL collect(nodes%A,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB)
5571 END IF
5572 END IF
5573 END IF
5574
5575C-----------------------------------------------
5576C COMMUNICATION BETWEEN BOUNDARY ELEMENTS AFTER ASSEMBLY
5577C-----------------------------------------------
5578 IF (ifrwv > 0) THEN
5579 IF (nspmd > 1) THEN
5580 length = 1
5581 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
5582C FR_WAVE boundary exchange
5583 CALL spmd_exch_wave(fr_wave,nodes%BOUNDARY_ADD ,nodes%BOUNDARY,length,lenr)
5584 END IF
5585
5586C========================================================================================
5587C PARALLEL SECTION (SMP)
5588C========================================================================================
5589
5590!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
5591 itsk = omp_get_thread_num()
5592 nodftsk = 1+itsk*numnod/ nthread
5593 nodltsk = (itsk+1)*numnod/nthread
5594 DO i=nodftsk,nodltsk
5595 fr_wave(i)=abs(fr_wave(i))
5596 ENDDO
5597
5598!$OMP END PARALLEL
5599
5600 ENDIF
5601
5602C========================================================================================
5603C NON PARALLEL SECTION (SMP)
5604C========================================================================================
5605C Failure front wave
5606C-----------------------------------------------
5607 IF (failwave%WAVE_MOD > 0) THEN
5608 CALL update_failwave(failwave)
5609 ENDIF
5610C----------------------------------
5611C TRAITEMENT SHOOTING NODES
5612C----------------------------------
5613 IF (imon>0) CALL startime(timers,timer_contfor)
5614 IF (n2d/=0.AND.idel7==2) THEN
5615 IF (imon>0) CALL startime(timers,6)
5616 CALL chkstifn(ipari,nodes%MS,interfaces%INTBUF_TAB)
5617 IF (imon>0) CALL stoptime(timers,6)
5618C
5619C IDEL7NG : global flag deleted segments/nodes int. type7, type2
5620C IDEL7NG = 0 => nothing
5621C IDEL7NG = 1 | 2 => deleted segments/nodes (for at least 1 interface)
5622C IDEL7NOK = 1 : need all interface such as IPARI(17)= 1 | 2
5623 ELSEIF(idel7ng>=1.OR.pdel>0) THEN
5624C IF (NCYCLE==97) IDEL7NOK = 1
5625C IF (NCYCLE==98) IDEL7NOK = 1
5626 IF (nspmd>1.AND.(idel7ng>=1.OR.pdel>0)) THEN
5627C recuperation IDEL7NOK global
5628 IF (imonm > 0 ) CALL startime(timers,76)
5629 CALL spmd_allglob_isum9(idel7nok,1)
5630 IF (imonm > 0 ) CALL stoptime(timers,76)
5631 idel7nok = min(1,idel7nok)
5632 ENDIF
5633 idel7nok_sav = idel7nok
5634 IF (r2r_siu==1.AND.idel7ng>=1) THEN
5635 CALL get_shmbuf_c(idel7nok_r2r,2)
5636 idel7nok = idel7nok+idel7nok_r2r
5637 idel7nok = min(1,idel7nok)
5638 ENDIF
5639C Warning WA used on 2*NUMNOD (NUMNOD + NUMNOD SPECIFIC SPMD)
5640 IF ((idel7ng>=1.AND.idel7nok==1).OR.(pdel>0.AND.idel7nok==1)) THEN
5641 l1 = 1+nixs*numels + nsvois*nixs
5642 l2 = l1+6*numels10
5643 l3 = l2+12*numels20
5644 IF((int24use==1.OR.ninter25/=0).AND.(idel7ng>=1.AND.idel7nok==1))THEN
5645 indseglo(2:ninter+1)=0
5646 indseglo(1)=1
5647 ENDIF
5648
5649
5650C========================================================================================
5651C PARALLEL SECTION (SMP)
5652C========================================================================================
5653 IF (imonm > 0 ) CALL startime(timers,29)
5654 nindexp = 0
5655 check_neigh_flag_res = 0
5656
5657c allocate(nodes%deleted_node(2*numnod)) ! working array to mark nodes connected to deleted element
5658c allocate(nodes%work_array_node(nthread*numnod)) ! working array to mark nodes (connected to active element or deleted element)
5659!$OMP PARALLEL
5660!$omp+ private(itsk,nodftsk,nodltsk,numntsk,ndtsk,ipmtsk,igmtsk)
5661!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK,omp_address)
5662C Init var parallel SMP
5663 CALL smp_init(
5664 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
5665 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
5666 3 greftsk,greltsk)
5667 omp_address = 1 + itsk*numnod
5668
5669 IF ((idel7ng>=1.AND.idel7nok==1).OR.(pdel>0.AND.idel7nok==1)) THEN
5670 CALL tagoff3n(nodes,
5671 1 geo ,ixs ,ixs(l1) ,ixs(l1) ,ixs(l3) ,ixq ,
5672 2 element%SHELL%IXC ,ixt ,ixp ,ixr ,ixtg ,
5673 3 nodes%deleted_node,nodftsk ,nodltsk ,iparg ,elbuf ,itsk ,
5674 4 ixtg1 ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nodes%ITAB ,
5675 5 addcnel ,cnel ,kxsp ,elbuf_tab ,tagel ,iexlnk ,
5676 6 igrnod ,dd_r2r ,dd_r2r_elem,sdd_r2r_elem,idel7nok_sav ,
5677 7 idel7nok_r2r,tagtrimc,tagtrimtg,s_elem_state,elem_state,
5678 8 shoot_struct,shoot_struct%GLOBAL_NB_ELEM_OFF)
5679 ! ---------------------
5680 ! check if a node is deactivated and deactivate all the corresponding secondary nodes
5681 CALL check_nodal_state( itsk,nodes%deleted_node,newfront,interfaces%INTBUF_TAB,shoot_struct%SIZE_SEC_NODE,
5682 . shoot_struct%SHIFT_S_NODE,shoot_struct%INTER_SEC_NODE,shoot_struct%SEC_NODE_ID)
5683 ! ---------------------
5684
5685 ! ---------------------
5686 ! check if a surface/edge must be deactivated and save the surface/edge id
5687
5688 IF(itsk==0) THEN
5689 CALL find_surface_inter( nodes%ITAB ,shoot_struct ,ixs ,ixs(l1) ,element%SHELL%IXC ,
5690 . ixtg ,
5691 . ngroup,nparg,igroups,iparg )
5692 CALL find_edge_inter( nodes%ITAB,shoot_struct,ixs,ixs(l1),
5693 1 element%SHELL%IXC,ixtg,ixq,ixt,ixp,
5694 2 ixr,geo,ngroup,igroups,iparg )
5695 ENDIF
5696 CALL my_barrier( )
5697 ! ---------------------
5698
5699 ! ---------------------
5700 ! exchange of surfaces(ie. 4 nodes) to deactivate and deactivation
5701 ! ONLY FOR LOCAL SURFACE / REMOTE ELEMENT
5702 IF(nspmd>1) THEN
5703 IF(itsk==0) CALL spmd_exch_deleted_surf_edge( nodes%BOUNDARY_ADD,nodes,shoot_struct,
5704 . interfaces%INTBUF_TAB,newfront,
5705 . ipari,geo,
5706 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
5707 . addcnel,cnel,nodes%work_array_node(omp_address),tagel )
5708 CALL my_barrier()
5709 ENDIF
5710 ! ---------------------
5711
5712 ! ---------------------
5713 ! loop over the surface id and deactivate the surface
5714 ! ONLY FOR LOCAL SURFACE / LOCAL ELEMENT
5715
5716 CALL check_surface_state( itsk,shoot_struct%SAVE_SURFACE_NB,shoot_struct%SAVE_SURFACE,
5717 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,
5718 . ipari,geo,
5719 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
5720 . addcnel,cnel,nodes%work_array_node(omp_address),tagel,shoot_struct )
5721
5722 ! loop over the edge id and deactivate the edge
5723 ! ONLY FOR LOCAL EDGE / LOCAL ELEMENT
5724 CALL check_edge_state( itsk,shoot_struct%SAVE_M_EDGE_NB,shoot_struct%SAVE_S_EDGE_NB,
5725 . shoot_struct%SAVE_M_EDGE,shoot_struct%SAVE_S_EDGE,
5726 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,newfront,ipari,geo,
5727 . ixs,element%SHELL%IXC,ixt,ixp,ixr,ixtg,ixs(l1),
5728 . addcnel,cnel,nodes%work_array_node(omp_address),tagel,shoot_struct )
5729 ! ---------------------
5730
5731 ! ---------------------
5732 ! exchange of deactivated surfaces (ie. 4 nodes) to deactivate to the neighbourhood
5733 ! ONLY FOR REMOTE SURFACE + interface type 24 or 25
5734 IF(int24use>0.OR.ninter25/=0) THEN
5735 IF(itsk==0) CALL check_remote_surface_state( shoot_struct%NUMBER_REMOTE_SURF,shoot_struct%REMOTE_SURF,
5736 . shoot_struct%SHIFT_INTERFACE,interfaces%INTBUF_TAB,
5737 . ipari,nodes%BOUNDARY_ADD,shoot_struct )
5738 CALL my_barrier()
5739 IF(ninter25/=0.AND.interfaces%PARAMETERS%INT25_EROSION_SOLID > 0) THEN
5740 IF(itsk==0) THEN
5741 check_neigh_flag = shoot_struct%NUMBER_NEW_SURF + shoot_struct%NUMBER_REMOTE_SURF
5742 IF(need_comm_int25_solid_erosion) THEN
5743 check_neigh_flag = shoot_struct%NUMBER_NEW_SURF + shoot_struct%NUMBER_REMOTE_SURF
5744 CALL spmd_allreduce(check_neigh_flag,check_neigh_flag_res,1,spmd_max,comm_int25_solid_erosion)
5745 ELSEIF(nspmd==1) THEN
5746 check_neigh_flag_res = check_neigh_flag
5747 ENDIF
5748 IF(check_neigh_flag_res > 0 ) THEN
5749 CALL get_neighbour_surface( ispmd,nspmd,ninter25,npari,ninter,
5750 . nbintc,nixs,nixc,nixtg,numnod,
5751 . numels,numelc,numeltg,s_elem_state,
5752 . nbddedgt,nbddedg_max,
5753 . elem_state,ipari,intlist,nodes,
5754 . newfront,ixs,element%SHELL%IXC,ixtg,
5755 . nodes%BOUNDARY_ADD,nodes%X,
5756 . interfaces%INTBUF_TAB,interfaces%SPMD_ARRAYS,shoot_struct )
5757 ENDIF
5758 ENDIF
5759 CALL my_barrier()
5760 ENDIF
5761 ENDIF
5762 ! ---------------------
5763 ENDIF
5764
5765 IF (idel7ng>=1.AND.idel7nok==1) THEN
5766 CALL chkstfn3n(nodes,
5767 1 ipari ,geo ,ixs ,ixq ,element%SHELL%IXC ,ixt ,
5768 2 ixp ,ixr ,ixtg ,nodes%deleted_node,iparg ,itsk ,
5769 3 newfront,nodes%work_array_node(omp_address) ,nodes%MS ,nodes%IN ,anin(ndma+1),nodes%ITAB ,
5770 4 nodes%ITABM1 ,addcnel , cnel ,indidel ,nindex1 ,nindex2 ,
5771 5 nindex3 ,nindex4 ,tagel ,int24use ,ibufseglo ,indseglo,
5772 6 ibufidel ,interfaces%INTBUF_TAB,nodes%BOUNDARY_ADD)
5773
5774 ENDIF
5775
5776 IF (pdel>0.AND.idel7nok==1) THEN
5777 CALL chkload(
5778 1 ibcl ,ixs ,ixq ,element%SHELL%IXC ,ixt ,ixp ,
5779 2 ixr ,ixtg ,nodes%deleted_node,itsk ,nodes%work_array_node(omp_address),nodes%ITAB ,
5780 3 nodes ,addcnel ,cnel ,tagel ,iparg ,geo ,
5781 4 ibufpdel,nindexpdel,nindexp ,npresload,loadp_tagdel ,
5782 5 iloadp ,lloadp ,nodes%BOUNDARY_ADD)
5783
5784 ENDIF
5785
5786!$OMP END PARALLEL
5787 IF (imonm > 0 ) CALL stoptime(timers,29)
5788 CALL dealloc_shoot_inter( shoot_struct )
5789 ENDIF
5790 ENDIF
5791
5792
5793c ========================================================================================
5794C node splitting
5795C uncomment the following code for an example of node splitting (using non-physical deformation critera)
5796
5797! numnod_old = numnod
5798! numnodm_old = numnodm
5799! call test_jc_shell_detach(nodes, element, interfaces, npari, ninter, ipari, numnod,
5800! . numnodg, elbuf_tab, ngroup, ngrouc, nparg, iparg, igrouc, numelc, ispmd, nspmd,
5801! . new_crack)
5802!
5803!
5804! if(new_crack > 0) then
5805! ! if at least 1 node has been detached, some data must be re-initialized
5806! numnodm = numnodm_old + new_crack
5807! CALL INIT_NODAL_STATE( IPARI,SHOOT_STRUCT,INTERFACES%INTBUF_TAB,NODES%BOUNDARY_ADD,NODES%BOUNDARY,
5808! . NODES%ITAB,NODES,GEO,ADDCNEL,CNEL,
5809! . IXS,ELEMENT%SHELL%IXC,IXT,IXP,IXR,IXTG,
5810! . SIZE_ADDCNEL,SIZE_CNEL ,
5811! . numelsg,numelqg,numelcg,numeltrg,numelpg,
5812! . numelrg,numeltgg , IXS(L1))
5813!
5814!
5815! IF(IDEL7NG>0.OR.IRAD2R>0.OR.ALEMUSCL_Param%IALEMUSCL>0.OR.PDEL>0) THEN
5816! SIZE_ADDCNEL = NUMNOD+1
5817! SIZE_CNEL = LCNEL
5818! NELEML = NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG
5819! S_ELEM_STATE = NELEML
5820! DEALLOCATE(CNEL)
5821! ALLOCATE(CNEL(0:SIZE_CNEL))
5822! DEALLOCATE(ADDCNEL)
5823! ALLOCATE(ADDCNEL(0:SIZE_ADDCNEL))
5824! DEALLOCATE(ADDTMPL)
5825! ALLOCATE(ADDTMPL(0:NUMNOD+1))
5826! NELEML = NUMELS+NUMELQ+NUMELC+NUMELT+NUMELP+NUMELR+NUMELTG
5827! ALEMUSCL_Buffer%pCNEL => CNEL
5828! ALEMUSCL_Buffer%pADDCNEL => ADDCNEL
5829! ALEMUSCL_Buffer%pADDTMPL => ADDTMPL
5830! L1 = 1+NIXS*NUMELS + NSVOIS*NIXS
5831! L2 = L1+6*NUMELS10
5832! L3 = L2+12*NUMELS20
5833!
5834! CALL CHKINIT(
5835! 2 IXS ,IXQ ,ELEMENT%SHELL%IXC ,IXT ,IXP ,
5836! 3 IXR ,IXTG ,IXS(L1) ,IXS(L2) ,
5837! 4 IXS(L3) ,IXTG1 ,GEO ,ADDCNEL ,CNEL ,
5838! 5 ADDTMPL ,IPARG )
5839!
5840! ENDIF
5841! LCNE0 = SIZE(ELEMENT%PON%PROCNE)
5842! endif
5843
5844C========================================================================================
5845C NON PARALLEL SECTION (SMP)
5846C========================================================================================
5847
5848C elt deletion => need to rebuild ams mass matrix ...
5849 IF(idtmins>=1.OR.idtmins_int/=0)THEN
5850 IF(mcheck==0)THEN
5851 ismsnok=0
5852 IF(idel7ng==0)THEN
5853 IF (nspmd>1) THEN
5854C Get IDEL7NOK global
5855 IF (imonm > 0 ) CALL startime(timers,76)
5856 CALL spmd_allglob_isum9(idel7nok,1)
5857 IF (imonm > 0 ) CALL stoptime(timers,76)
5858 idel7nok = min(1,idel7nok)
5859 ENDIF
5860 ENDIF
5861 ismsnok=idel7nok
5862 ELSE
5863 ismsnok=1
5864 END IF
5865 END IF
5866
5867#ifdef DNC
5868 IF(imadcpl /=0)THEN
5869C ---------------------------------------------------------
5870C Radioss Madymo Coupling
5871C ---------------------------------------------------------
5872C IF IDEL7NOK is > Deleted elements were found
5873C MAD_FAIL_ELEMENTS is upgraded
5874C
5875C If one domain has new deleted elements, MADYMO_DEL is set to 1
5876C MADYMO_DEL is globalized with SPMD_ALLGLOB_ISUM9
5877C if Positive, all domains send the info during Time Step exchange
5878C
5879C --------------------------------------------------------
5880C Do not communicate IDEL7NOK if already done. (IDEL7NG >0)
5881C ---------------------------------------------------------
5882
5883 madymo_del_global=0
5884 madymo_del=0
5885
5886 IF (idel7nok > 0 ) THEN
5887 CALL mad_elfail( elbuf_tab,iparg,
5888 * madsol,madsh3,madsh4,
5889 * mad_tag_sol, mad_tag_sh,mad_tag_tg,
5890 * madymo_del,
5891 * mad_fail_elements)
5892
5893 ENDIF
5894
5895 madymo_del_global = madymo_del
5896
5897 CALL spmd_allglob_isum9(madymo_del_global,1)
5898 ENDIF
5899#endif
5900C ---------------------------------------------------------
5901 idel7nok=0
5902 IF (imon>0) CALL stoptime(timers,timer_contfor)
5903C
5904C========================================================================================
5905C NON PARALLEL SECTION (SMP)
5906C========================================================================================
5907
5908C----------------------------------
5909C EXTERNAL FORCES FROM SECTIONS
5910C----------------------------------
5911 IF(isecut/=0)CALL section_fio (
5912 1 nstrf ,nodes%V,nodes%VR,
5913 2 nodes%A ,nodes%AR ,secbuf,nodes%MS,nodes%IN,
5914 3 nodes%WEIGHT,iad_cut,fr_cut, output%TH%WFEXT)
5915C-----------------------------------------------------
5916C SPOTWELD ELEMENT CLUSTERS
5917C-----------------------------------------------------
5918 IF (ncluster > 0) THEN
5919 CALL clusterf(cluster ,elbuf_tab,nodes%X ,nodes%A ,nodes%AR ,
5920 . skews%SKEW ,ixs ,iparg ,fcluster,mcluster,
5921 . h3d_data,geo )
5922 ENDIF
5923
5924C-----------------------------------------------------
5925C KINEMATIC CONDITIONS FOR SEATBELTS
5926C-----------------------------------------------------
5927
5928 IF (nslipring + nretractor + n_anchor_remote > 0) THEN
5929 CALL kine_seatbelt_force(nodes%A,nodes%STIFN,flag_slipring_update,flag_retractor_update)
5930 ENDIF
5931
5932C-----------------------------------------------------
5933C INTERFACES 18 KINE
5934C-----------------------------------------------------
5935 IF(ninter /= 0.and.iale+ieuler /= 0.and.
5936 . int18kine == -1)THEN
5937
5938C========================================================================================
5939C PARALLEL SECTION (SMP)
5940C========================================================================================
5941
5942!$OMP PARALLEL PRIVATE(ITSK)
5943 itsk = omp_get_thread_num()
5944
5945C /---------------/
5946 CALL my_barrier
5947C /---------------/
5948 CALL i18main_kine_1(ipari,interfaces%INTBUF_TAB,nodes%X ,nodes%V ,
5949 2 nodes%A ,nodes%ISKEW ,skews%SKEW ,nodes%ICODT ,wa ,
5950 3 nodes%MS ,nodes%ITAB ,itsk+1 ,kinet ,nodes%STIFN ,
5951 4 mtf ,cand_sav ,int18add ,nodes%BOUNDARY_ADD,nodes%BOUNDARY ,
5952 5 tagpene ,h3d_data ,multi_fvm,ale_connectivity%NE_CONNECT,xcell,xcell_remote)
5953!$OMP END PARALLEL
5954 ENDIF
5955C------------------------
5956C INTERFACES TIED
5957C--- //0 ----------------
5958C========================================================================================
5959C NON PARALLEL SECTION (SMP)
5960C========================================================================================
5961 IF(ninter/=0)THEN
5962 IF (imon>0) THEN
5963 CALL startime(timers,6)
5964 CALL startime(timers,timer_contsort)
5965 ENDIF
5966 IF (imonm > 0)CALL startime(timers,28)
5967!0.
5968 DO k=0,nhin2
5969 CALL intti1(
5970 1 ipari ,nodes%X ,nodes%V ,nodes%A ,
5971 2 nodes%VR ,nodes%AR ,wa ,nodes%MS ,nodes%IN ,nodes%WEIGHT ,
5972 3 nodes%STIFN ,nodes%STIFR ,k ,nodes%ITAB ,fr_i2m ,iad_i2m ,
5973 4 addcni2,procni2,iadi2 ,i2msch ,dmas ,anin(ndma+1),
5974 5 skews%SKEW ,i2size ,fr_nbcci2,anin(ndin+1) ,igeo,bufgeo ,
5975 6 fsav ,npc ,tf ,fani(1,nft2+1) ,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
5976 7 nativ_sms,dmint2,anin(ndama2+1),nb_fri2m ,fr_loci2m,
5977 8 dt2t ,neltst ,ityptst ,interfaces%INTBUF_TAB ,nodes%TEMP ,nodes%MCP ,
5978 9 fthe ,condn ,glob_therm,
5979 a h3d_data,t2fac_sms,fani(1,nfnca2+1),npcont2)
5980 ENDDO
5981 IF (imonm > 0) CALL stoptime(timers,28)
5982 IF (imon>0) THEN
5983 CALL stoptime(timers,timer_contsort)
5984 CALL stoptime(timers,6)
5985 ENDIF
5986C
5987 IF((idtmins/=0.OR.idtmins_int/=0).AND.ncycle==0)ismsch=1
5988
5989 ENDIF
5990C
5991C----------------------------------
5992C ITET2 of S10 Forces condensation; pass 2
5993C----------------------------------
5994
5995C========================================================================================
5996C PARALLEL SECTION (SMP)
5997C========================================================================================
5998
5999 IF (ns10e > 0) THEN
6000!$OMP PARALLEL
6001!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,GREFTSK,GRELTSK)
6002 itsk = omp_get_thread_num()
6003 nodftsk = 1+itsk*numnod/ nthread
6004 nodltsk = (itsk+1)*numnod/nthread
6005 greftsk = 1+itsk*ns10e/ nthread
6006 greltsk = (itsk+1)*ns10e/nthread
6007 CALL s10cndf2(icnds10,nodes%WEIGHT ,iad_cndm,fr_cndm,fr_nbcccnd,
6008 1 addcncnd,procncnd,nodes%A ,iadcnd,fskycnd,
6009 2 itagnd ,nodftsk,nodltsk,greftsk,greltsk,
6010 3 itsk ,nodes%ITAB ,nodes%STIFN , stifnd)
6011!$OMP END PARALLEL
6012
6013C========================================================================================
6014C NON PARALLEL SECTION (SMP)
6015C========================================================================================
6016
6017 IF (ncycle==0.OR.mcheck/=0)
6018 1 CALL cnd_dmasi2(icnds10,nkend,imap2nd,masi2nd0,nodes%MS ,nodes%WEIGHT)
6019 END IF
6020C
6021 IF(intplyxfem > 0) THEN
6022 CALL i24pxfem(
6023 1 ipari ,interfaces%INTBUF_TAB ,wagap,nodes%BOUNDARY_ADD,nodes%BOUNDARY)
6024 ENDIF
6025C
6026C----------------------------------------------------------
6027C RBE2 - FORCES and MOMENTS (Torque)
6028C----------------------------------------------------------
6029 IF (nrbe2>0.OR.r2size>0) THEN
6030 CALL my_barrier
6031 IF(itask==0)THEN
6032 IF (imon>0) CALL startime(timers,timer_kin)
6033 CALL rbe2t1(irbe2 ,lrbe2 ,nodes%X ,nodes%A ,nodes%AR ,
6034 1 nodes%MS ,nodes%IN ,skews%SKEW ,nodes%WEIGHT ,iad_rbe2,
6035 2 fr_rbe2m,nmrbe2,nodes%STIFN ,nodes%STIFR ,r2size )
6036 IF (imon>0) CALL stoptime(timers,timer_kin)
6037
6038 END IF
6039 ENDIF
6040C----------------------------------------------------------
6041C RBE3 - FORCES AND MOMENTS
6042C----------------------------------------------------------
6043 IF (nrbe3>0) THEN
6044 IF (imon>0) CALL startime(timers,timer_kin)
6045 IF (imonm > 0) CALL startime(timers,45)
6046
6047 CALL rbe3t1(rbe3 ,nodes ,skews%SKEW,
6048 1 dmas ,anin(ndma+1) ,diner,
6049 2 anin(ndin+1) ,h3d_data , dt1,
6050 3 tt ,impl_s )
6051
6052 IF (imonm > 0) CALL stoptime(timers,45)
6053 IF (imon>0) CALL stoptime(timers,timer_kin)
6054 ENDIF
6055
6056C------------------------
6057C test of mass and inertia on main nodes of interf. type 2
6058C------------------------
6059 IF(tt==zero.AND.iale+ieuler+glob_therm%ITHERM==0)THEN
6060
6061 negmas=0
6062C========================================================================================
6063C PARALLEL SECTION (SMP)
6064C========================================================================================
6065
6066!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
6067 itsk = omp_get_thread_num()
6068 nodftsk = 1+itsk*numnod/ nthread
6069 nodltsk = (itsk+1)*numnod/nthread
6070 CALL chkmsin(nodftsk,nodltsk,nodes%ITAB,nodes%MS,nodes%IN,negmas)
6071!$OMP END PARALLEL
6072C Implicit barrier on NEGMAS
6073 IF(negmas/=0) CALL arret(2)
6074 ENDIF
6075
6076C========================================================================================
6077C NON PARALLEL SECTION (SMP)
6078C========================================================================================
6079C
6080C Assemblage TYPE21
6081C
6082 IF(nintstamp/=0)THEN
6083 CALL intstamp_ass(intstamp,nodes%MS ,nodes%IN ,nodes%A ,nodes%AR ,
6084 . nodes%STIFN ,nodes%STIFR ,nodes%WEIGHT, output%TH%WFEXT)
6085 END IF
6086C-----------------------------------------------------
6087C RIGID BODY: SUM forces, stiff.
6088C-----------------------------------------------------
6089
6090 IF(nrbykin>0)THEN
6091 IF (imon>0) CALL startime(timers,timer_kin)
6092 IF (imonm > 0) CALL startime(timers,40)
6093
6094C========================================================================================
6095C NON PARALLEL SECTION (SMP)
6096C========================================================================================
6097
6098 CALL rbysens(
6099 1 iparg,ipari ,nodes%MS ,nodes%IN ,
6100 2 ixs ,ixq ,element%SHELL%IXC ,ixt ,ixp ,
6101 3 ixr ,skews%SKEW ,nodes%ITAB ,nodes%ITABM1,iskwn,
6102 4 npby ,wa ,lpby ,element%PON%FSKY ,nsensor,
6103 5 rby ,nodes%X ,nodes%V ,nodes%VR ,ixtg ,
6104 6 igrv ,lgrav,sensors%SENSOR_TAB,nodes%A ,nodes%AR ,
6105 7 fsav ,nodes%STIFN ,nodes%STIFR,fani(1,1+nfoa),nodes%WEIGHT,
6106 8 dmas ,diner ,bufsf,fr_rby2,partsav ,
6107 9 ipart ,elbuf_tab,icfield,lcfield,nodes%TAG_S_RBY)
6108
6109C========================================================================================
6110C PARALLEL SECTION (SMP)
6111C========================================================================================
6112!$OMP PARALLEL
6113
6114 CALL rbyfor(timers,
6115 1 rby ,nodes%A ,nodes%AR ,nodes%X ,nodes%VR ,
6116 2 fsav ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,fani(1,1+nfoa) ,
6117 3 lpby ,npby ,nodes%WEIGHT ,nodes%MS ,nodes%V ,
6118 4 igrsurf ,bufsf ,nodes%ICODR ,nodes%ISKEW ,skews%SKEW ,
6119 5 kindrby ,iad_rby ,fr_rby6,rby6 ,irbkin_l ,
6120 6 nrbykin_l ,nativ_sms ,sensors%SFSAV ,sensors%FSAV ,sensors%STABSEN,
6121 7 sensors%TABSENSOR,nodreac ,fthreac ,cptreac ,dampr,
6122 8 sdamp ,damp ,ndamp_vrel ,id_damp_vrel ,igrnod ,
6123 9 nodes%TAG_S_RBY ,iparit ,output%TH%WFEXT ,ndamp_vrel_rbyg ,size_rby6_c ,
6124 a rby6_c)
6125
6126!$OMP END PARALLEL
6127 IF (imon>0) CALL stoptime(timers,timer_kin)
6128 IF (imonm > 0) CALL stoptime(timers,40)
6129C-----------------------------------------------------
6130 ENDIF
6131C========================================================================================
6132C NON PARALLEL SECTION (SMP)
6133C========================================================================================
6134C-----------------------------------------------------
6135C FORCES FLEXIBLE BODIES
6136C-----------------------------------------------------
6137 IF (nfxbody>0) THEN
6138 CALL fxbyfor(fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm,
6139 . fxbcpm, fxbcps, fxblm , fxbfls, fxbdls,
6140 . fxbdep, fxbvit, fxbacc, nodes%A, nodes%AR,
6141 . nodes%X, fxbmvn, fxbmcd, fxbse, fxbsv,
6142 . fxbelm, fxbsig, elbuf, partsav, elbuf_tab,
6143 . fsav, fxbfp, fxbefw, fxbfc, nodes%D,
6144 . dt2t, ityptst, neltst, fxbgrvi, fxbgrvr,
6145 . igrv, npc, tf , fxbgrp, fxbgrw ,
6146 . iparg , nsensor,sensors%SENSOR_TAB,nodes%BOUNDARY_ADD, nodes%BOUNDARY,
6147 . agrv ,python)
6148 END IF
6149
6150C----------------------------------------------------------
6151C ADAPTIVE MESHING : FORCES AND STIFNESS FROM SECND TO MAIN
6152C-----------------------------------------------------
6153 IF(nadmesh/=0)THEN
6154 IF (imon>0) CALL startime(timers,37)
6155 CALL admfor0(element%SHELL%IXC, ipart(k3), ixtg, ipart(k8), ipart,
6156 1 nodes%A , nodes%STIFN , nodes%AR, nodes%STIFR ,nodes%X ,
6157 2 sh4tree,sh3tree,stcnd, fthe,condn,
6158 . glob_therm%NODADT_THERM,glob_therm%ITHERM_FE)
6159 IF (imon>0) CALL stoptime(timers,37)
6160 END IF
6161C----------------------------------------------------------
6162C RIGID MATERIAL
6163C----------------------------------------------------------
6164 IF (irigid_mat > 0) THEN
6165
6166C========================================================================================
6167C PARALLEL SECTION (SMP)
6168C========================================================================================
6169
6170!$OMP PARALLEL
6171 CALL rmatforp(timers,
6172 1 nodes%A ,nodes%AR ,nodes%X ,nodes%VR ,nodes%IN ,
6173 2 nodes%STIFN ,nodes%STIFR ,irbym ,lnrbym ,rbym ,
6174 3 icodrbym ,nodes%WEIGHT ,nodes%MS ,nodes%V ,fr_rbym ,
6175 4 iad_rbym ,arbym ,vrbym ,arrbym ,vrrbym ,
6176 5 kindrbym ,rbym6 )
6177
6178!$OMP END PARALLEL
6179
6180 ENDIF
6181
6182C----------------------------------------------------------
6183C Rigid wall - Force node (moving RWALL)
6184C----------------------------------------------------------
6185 IF(nrwall>0)CALL rgwalf(nodes%A ,rwbuf ,nprw ,nodes%MS )
6186
6187C-----------------------------------------------
6188C SELECTIVE MASS SCALING
6189C-----------------------------------------------
6190 IF( idtmins == 1 .AND.
6191 . (ismsch/=0.OR.ncycle==0.OR.ismsnok/=0.OR.iadmesh/=0))THEN
6192C
6193C Obsolete
6194 ELSEIF(idtmins == 2.OR.idtmins_int/=0)THEN
6195C
6196 nsgdone=1
6197 nrbdone=1
6198
6199 IF (imon>0) CALL startime(timers,39)
6200 IF (imon>0) CALL startime(timers,75)
6201
6202C========================================================================================
6203C PARALLEL SECTION (SMP)
6204C========================================================================================
6205 l1 = 1+nixs*numels + nsvois*nixs
6206
6207C Sorting of ISKYI_SMS and additional connections for TYPE2 + contact
6208 CALL spmd_sort_sms(iskyi_sms,mskyi_sms,fr_sms)
6209C
6210 IF(nspmd > 1)THEN
6211 CALL spmd_nlist_sms(fr_sms,fr_rms)
6212 END IF
6213 IF (ALLOCATED(mskyi_fi_sms)) DEALLOCATE(mskyi_fi_sms)
6214 IF (ALLOCATED(list_sms)) DEALLOCATE(list_sms)
6215 IF (ALLOCATED(list_rms)) DEALLOCATE(list_rms)
6216 IF (ALLOCATED(list_rms)) DEALLOCATE(list_rms)
6217 IF (ALLOCATED(sms_vfi)) DEALLOCATE(sms_vfi)
6218 CALL my_alloc(mskyi_fi_sms,fr_rms(nspmd+1))
6219 CALL my_alloc(list_sms,fr_sms(nspmd+1))
6220 CALL my_alloc(list_rms,fr_rms(nspmd+1))
6221 CALL my_alloc( sms_vfi,3,fr_rms(nspmd+1)+fr_sms(nspmd+1) )
6222
6223 IF (ALLOCATED(mw6)) DEALLOCATE(mw6)
6224 if (iparit /=0) then
6225 sz_mw6 = 3*numnod
6226 CALL my_alloc(mw6,6,sz_mw6)
6227 else
6228 sz_mw6 = 1
6229 CALL my_alloc(mw6,6,1)
6230 endif
6231!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
6232 itsk = omp_get_thread_num()
6233 nodftsk = 1+itsk*numnod/ nthread
6234 nodltsk = (itsk+1)*numnod/nthread
6235C
6236 CALL sms_build_mat_2(
6237 1 itsk ,nodftsk ,nodltsk ,
6238 2 element%SHELL%IXC ,iparg ,ixs ,ixt ,ixp ,
6239 3 ixr ,ixtg ,tagnod_sms,nodes%MS ,nodes%MS0 ,
6240 4 indx1_sms,indx2_sms,jad_sms ,jdi_sms ,lt_sms ,
6241 . kad_sms ,kdi_sms ,ltk_sms ,pk_sms ,nodii_sms ,
6242 5 jadc_sms ,jads_sms ,jadt_sms ,jadp_sms ,jadr_sms ,
6243 6 jadtg_sms,diag_sms ,tagprt_sms,tagrel_sms,
6244 7 ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),ipart(i15e),
6245 8 ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),nodes%BOUNDARY_ADD ,
6246 9 nodes%BOUNDARY ,npby ,lpby ,tagslv_rby_sms ,lad_sms ,
6247 a jsm_sms ,dmeltg ,dmelc ,mskyi_sms,
6248 b iskyi_sms,jadi_sms,jdii_sms ,lti_sms ,nodxi_sms,
6249 c dmels ,dmeltr ,dmelp ,dmelrt ,igeo ,
6250 d fr_sms ,fr_rms ,elbuf ,ipari ,interfaces%INTBUF_TAB,
6251 e kinet ,tagslv_i21_sms,jadi21_sms,intstamp,
6252 f ixs(l1),jads10_sms,ilink ,llink ,nnlink ,
6253 g lnlink ,tag_lnk_sms,ljoint ,iadcj ,fr_cj ,
6254 h nodes%ITAB ,nodes%WEIGHT ,dmint2 ,elbuf_tab,tagmsr_rby_sms,
6255 i nprw ,lprw ,fr_wall ,nrwl_sms ,rby ,
6256 j nodes%X ,nodes%A ,nodes%AR ,nodes%IN ,nodes%V ,
6257 k nodes%VR ,irbe2 ,lrbe2 ,rbe3%IRBE3 ,rbe3%LRBE3 ,
6258 l rbe3%mpi%IAD_RBE3 ,rbe3%mpi%FR_RBE3 ,nativ_sms,t2main_sms,t2fac_sms,
6259 m mskyi_fi_sms, list_sms,list_rms,sz_mw6,mw6)
6260c
6261!$OMP END PARALLEL
6262
6263 ptr_sms => nodxi_sms
6264
6265 ismsch=0
6266 IF (imon>0) CALL stoptime(timers,39)
6267 IF (imon>0) CALL stoptime(timers,75)
6268
6269 ENDIF
6270C----------------------------------------------------------
6271C SCALE TIME STEP
6272C========================================================================================
6273C PARALLEL SECTION (SMP)
6274C========================================================================================
6275C--- COUPLAGE RADIOSS 2 RADIOSS
6276 IF (irad2r /= 0) THEN
6277 IF (nspmd>1) CALL spmd_barrier()
6278 CALL r2r_exchange(
6279 1 iexlnk ,igrnod ,nodes%D ,nodes%V ,nodes%VR ,
6280 2 nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,
6281 3 r2r_on ,dd_r2r ,nodes%WEIGHT ,nodes%BOUNDARY_ADD,nodes%BOUNDARY ,rby ,
6282 4 nodes%XDP ,nodes%X ,dd_r2r_elem, sdd_r2r_elem,off_sph_r2r,
6283 5 numsph_glo_r2r,nloc_dmg)
6284C
6285 IF (flg_sphinout_r2r/=0) THEN
6286 DO i=1,numnod
6287 IF (off_sph_r2r(i)==2) THEN
6288 off_sph_r2r(i) = 1
6289 ELSE
6290 off_sph_r2r(i) = 0
6291 ENDIF
6292 END DO
6293 ENDIF
6294C
6295 ENDIF
6296
6297C========================================================================================
6298C NON PARALLEL SECTION (SMP)
6299C========================================================================================
6300
6301C----------------------------
6302 23 CONTINUE
6303
6304C----------------------------------------------------------
6305C INTER/TYPE21 TIME STEP
6306C----------------------------------------------------------
6307 IF(nintstamp/=0)THEN
6308 CALL intstamp_dt(intstamp,ipari,neltst,ityptst,dt2t,
6309 . ptr_sms ,diag_sms,nodes%MS ,nodes%V ,nodes%STIFN,
6310 . nodes%STIFR )
6311 END IF
6312
6313 imsch=0
6314!
6315 IF (flg_damp_funct==1) THEN
6316 CALL damping_funct_ini(dampr, nrdamp, ndamp, tt,iroddl)
6317 ENDIF
6318 IF (flg_dtnodamp==1) THEN
6319C---------------NODAL TIME STEP FOR DAMPING-----------------
6320 IF (idamp_rdof==ndamp)
6321 + CALL dtnodamp(nodes%ITAB ,nodes%MS ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,dt2t ,
6322 1 nodes%WEIGHT ,igrnod ,dampr ,istop ,
6323 2 idamp_rdof_tab,icontact,element%SHELL%IXC,nodes%X)
6324 IF (ndamp>0 .OR. istat==3)
6325 + CALL dtnodarayl(nodes%MS ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,dt2t ,
6326 1 igrnod ,dampr )
6327 ENDIF
6328C --------------------------
6329
6330 IF (i_exch_flg_raz==0) THEN
6331C--- Flag for reset of stifn and stifr - must be set only at first cycle - ncycle=0 not enough because of chkpt
6332 flg_kj2_raz = flg_kj2
6333 IF (nspmd > 1) CALL spmd_glob_isum9(flg_kj2_raz,1)
6334 i_exch_flg_raz = 1
6335 ENDIF
6336C
6337 IF (flg_kj2==1) THEN
6338C
6339 IF (ncycle==0) THEN
6340 ALLOCATE(stk_sn(numnod),stk_sr(numnod))
6341 stk_sn(1:numnod)=nodes%STIFN(1:numnod)
6342 stk_sr(1:numnod)=nodes%STIFR(1:numnod)
6343 ENDIF
6344C
6345 CALL joint_elem_timestep(nodes%MS,nodes%IN,nodes%STIFN,nodes%STIFR,ixr,ipart,
6346 1 ipart(k6),igeo,geo,npby,iparg,elbuf_tab,
6347 2 dt2t,neltst,ityptst,nrbody,nodes%ITAB)
6348 ENDIF
6349
6350C----------------------------------------------------------
6351C FIND TARGET_DT FOR DEFINED % OF ADDED MASS
6352C----------------------------------------------------------
6353 IF ((ncycle==0).AND.(idt_percent_addmass > 0).AND.(idtmin(11)==3.OR.idtmin(11)==8)) THEN
6354 CALL find_dt_for_targeted_added_mass(nodes%MS,nodes%STIFN,dtfac1(11),idtgr(11),target_dt,
6355 . percent_addmass,percent_addmass_old,mass0_start,nodes%WEIGHT_MD,igrnod,
6356 . icnds10)
6357 dtmin1(11) = max(dtmin1(11),target_dt)
6358 ELSEIF ((idt_percent_addmass == 2).AND.(idtmin(11) == 8)) THEN
6359C-- For /DT/NODA/STOP + % added mass - IDTMIN switch back to 1 after first cycle
6360 IF (idt_percent_addmass == 2) THEN
6361 idtmin(11) = 1
6362 dtmin1(11) = dt_stop_percent_addmass
6363 ENDIF
6364 ENDIF
6365
6366C--------------------------------------------------
6367C UPDATE MINIMUM NODAL DT IF DT IS GIVEN BY FVMBAG
6368C--------------------------------------------------
6369 IF(nspmd > 1 .AND. nvolu > 0 .AND. nfvbag0 > 0) THEN
6370 !
6371 ! End asynchronous communication
6372 ! This is an implicit Barrier
6373 !
6374 CALL mpi_min_real_end(dt2r,min_tab,4,mpi_buf)
6375 ! This call changes DT2R and MIN_TAB the to minimum value of
6376 ! DT2R and the corresponding MIN_TAB.
6377
6378 ! NELTS = MIN_TAB(1)
6379 ! ITYPTS= MIN_TAB(2)
6380 ! ISPMD = MIN_TAB(4) ! ID of the proc. that has the mini. value of DT2R
6381
6382 ! DT2 = DT2R ! Min over the proc. of the value of DT2
6383
6384 dtmin1_save = dtmin1(11)
6385 IF(min_tab(2) == 52) dtmin1(11) = min(dtmin1_save,dt2r,1.1*dt2old)
6386
6387 ELSE
6388
6389 dtmin1_save = dtmin1(11)
6390 IF(itypts == 52) dtmin1(11) = min(dtmin1_save,dt2,1.1*dt2old)
6391
6392 ENDIF
6393
6394C
6395
6396C------------------------------------
6397C THERMAL TIME STEP COMPUTATION
6398C-----------------------------
6399 IF (glob_therm%IDT_THERM == 1)THEN
6400 dt2 = glob_therm%DT_THERM
6401 dt2t = dt2
6402 ENDIF
6403C
6404
6405 IF((anim_n(18) /= 0 .OR. h3d_data%N_SCAL_STIFR /= 0) .AND. iroddl /= 0)
6406 . stifr_tmp(1:numnod)=nodes%STIFR(1:numnod)
6407 IF(anim_n(19) /= 0 .OR. h3d_data%N_SCAL_STIFN /= 0)
6408 . stifn_tmp(1:numnod)=nodes%STIFN(1:numnod)
6409
6410C========================================================================================
6411C PARALLEL SECTION (SMP)
6412C========================================================================================
6413
6414!$OMP PARALLEL
6415!$OMP+PRIVATE(ITSK,DT2TT,NELTSTT,ITYPTSTT,NODFTSK,NODLTSK)
6416!$OMP+PRIVATE(DMAST,DINERT)
6417
6418 dt2tt = dt2t
6419 neltstt = neltst
6420 ityptstt= ityptst
6421 dmast = zero
6422 dinert = zero
6423 itsk = omp_get_thread_num()
6424 nodftsk = 1+itsk*numnod/ nthread
6425 nodltsk = (itsk+1)*numnod/nthread
6426
6427C----------------------------------------------------------
6428C NODAL TIME STEP
6429C----------------------------------------------------------
6430 IF(istatcnd/=0)THEN
6431C additional storage due to reset of stifn stifr
6432 stcnd(nodftsk:nodltsk)=nodes%STIFN(nodftsk:nodltsk)
6433 strcnd(nodftsk:nodltsk)=nodes%STIFR(nodftsk:nodltsk)
6434 ENDIF
6435
6436 IF(idtmins==0)THEN
6437C IF(IDTMINS==0.AND.IDTMINS_INT==0)THEN
6438 CALL dtnoda(
6439 1 nodftsk,nodltsk ,neltstt,ityptstt ,nodes%ITAB ,
6440 2 nodes%MS ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,dt2tt ,
6441 3 dmast,dinert,anin,anin(ndma+1),imsch ,
6442 4 nodes%WEIGHT,nodes%A ,nodes%AR ,igrnod ,glob_therm%nodadt_therm,
6443 5 anin(ndin+1),rbym ,arbym ,arrbym,nodes%WEIGHT_MD,
6444 6 nodes%MCP ,mcp_off,condn ,ale_connectivity%NALE ,h3d_data )
6445 ELSEIF(idtmins/=0)THEN
6446 CALL dtnodams(
6447 1 nodftsk,nodltsk ,neltstt,ityptstt ,nodes%ITAB ,
6448 2 nodes%MS ,nodes%IN ,nodes%STIFN ,nodes%STIFR ,dt2tt ,
6449 3 dmast,dinert,anin,anin(ndma+1),imsch ,
6450 4 nodes%WEIGHT,nodes%A ,nodes%AR ,igrnod ,
6451 5 anin(ndin+1),rbym ,arbym ,arrbym ,ismsch ,
6452 6 nativ_sms ,diag_sms ,npby,tagmsr_rby_sms,
6453 7 h3d_data )
6454 END IF
6455
6456#include "lockon.inc"
6457 dmas = dmas + dmast
6458 diner = diner + dinert
6459 IF (glob_therm%IDT_THERM == 1)THEN
6460 IF(dt2tt<=dt2t)THEN
6461C---------Check remaining time for end simulation and correct time step----
6462C------------Need to stop computation at Tstop for /DT/THERM----------
6463
6464 trest=max(tstop-tt,zero)
6465
6466 dtrest = trest*(one+em10)
6467
6468 dt2t = min(dt2tt,dtrest)
6469 neltst = neltstt
6470 ityptst= ityptstt
6471 ENDIF
6472 ELSE
6473 IF(dt2tt<dt2t)THEN
6474 dt2t = dt2tt
6475 neltst = neltstt
6476 ityptst= ityptstt
6477 END IF
6478 ENDIF
6479#include "lockoff.inc"
6480
6481!$OMP END PARALLEL
6482
6483C ----RAZ of NODES%STIFN AND NODES%STIFR for kjoints with element time step----------------------
6484 IF ((flg_kj2_raz==1).AND.(i7kglo==0).AND.(idtmins==0).AND.(nodadt==0)) THEN
6485 nodes%STIFN(1:numnod) = em20
6486 IF (iroddl > 0) nodes%STIFR(1:numnod) = em20
6487 ENDIF
6488C
6489 dtmin1(11) = dtmin1_save
6490
6491C========================================================================================
6492C NON PARALLEL SECTION (SMP)
6493C========================================================================================
6494C
6495 IF (glob_therm%IDT_THERM == 1)THEN
6496 IF(dt2t<dt2)THEN
6497 nelts = neltst
6498 itypts = ityptst
6499 dt2 = dt2t
6500 ENDIF
6501 ELSE
6502 IF(dt2t<dt2)THEN
6503 nelts = neltst
6504 itypts = ityptst
6505 dt2 = dt2t
6506 ENDIF
6507 ENDIF
6508
6509C----------------------------
6510C IMPLICIT SYNCHRONISATION On DT2 FBIG
6511C----------------------------
6512
6513
6514C-----------------------------
6515 IF(ale%SUB%IALESUB==2 .AND.ale%SUB%IFSUB==2)THEN
6516 IF(nspmd>1) THEN
6517 iwiout = 0
6518 IF (ispmd/=0) CALL spmd_chkw(iwiout,iout)
6519 CALL spmd_glob_min5(dt2 ,itypts,nelts ,nodes%ICODT ,imsch,
6520 . tstop,iwiout,mstop, ismsch,
6521 . int24use,nbintc,intlist,ipari,interfaces%INTBUF_TAB)
6522 IF(iexicodt>0) THEN
6523 length = 1
6524 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
6525 CALL spmd_exch_icodt(nodes%ICODT,nodes%BOUNDARY_ADD,nodes%BOUNDARY,length,lenr)
6526 iexicodt = 0
6527 ENDIF
6528 ENDIF
6529
6530
6531C========================================================================================
6532C PARALLEL SECTION (SMP)
6533C========================================================================================
6534!$OMP PARALLEL
6535!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
6536!$omp+ private(partftsk,partltsk,nwaftsk,dt2tt,neltstt,ityptstt)
6537!$OMP+ PRIVATE(GREFTSK,GRELTSK)
6538C Init var parallel SMP
6539 CALL smp_init(itsk,nodftsk,nodltsk,numntsk,ndtsk,ipmtsk,partftsk,partltsk,nwaftsk,igmtsk,greftsk,greltsk)
6540 dt2tt = dt2t
6541 neltstt = neltst
6542 ityptstt= ityptst
6543 CALL alesub2(
6544 1 ale_connectivity%NALE,nodes%V ,dsave ,nodes%ICODT ,nodes%ISKEW,
6545 2 skews%SKEW ,asave ,nodes%A ,nodes%D ,neltstt,
6546 3 ityptstt ,itsk ,nodftsk ,nodltsk ,dt2save,
6547 4 dt2tt ,neltsa ,ityptsa ,nelts ,
6548 5 nodes%WEIGHT ,element%PON%FSKY ,element%PON%FSKY )
6549#include "lockon.inc"
6550 IF(dt2tt<dt2t)THEN
6551 dt2t = dt2tt
6552 neltst = neltstt
6553 ityptst= ityptstt
6554 END IF
6555#include "lockoff.inc"
6556!$OMP END PARALLEL
6557C========================================================================================
6558C NON PARALLEL SECTION (SMP)
6559C========================================================================================
6560 ale%SUB%IFSUB=0
6561 ale%SUB%IFSUBM=0
6562C-----------------------------
6563C SPMD update restart writing
6564C-----------------------------
6565 IF(nspmd>1.AND.iwiout>0) THEN
6566 CALL spmd_wiout(iout,iwiout)
6567 iwiout = 0
6568 ENDIF
6569 GOTO 21
6570 ENDIF
6571 IF (imon>0) CALL startime(timers,6)
6572C----------------------------------
6573C SCALE TIME STEP FOR OLD AIRBAGS
6574C----------------------------------
6575 IF(nrbag > 0)THEN
6576 IF (imonm > 0) CALL startime(timers,50)
6577 CALL rbagdt(geo,igeo)
6578 IF (imonm > 0) CALL stoptime(timers,50)
6579 ENDIF
6580C----------------------------------
6581C SCALE TIME STEP FOR
6582C - MONITORED VOLUMES
6583C - a M + b K DAMPING
6584C----------------------------------
6585 IF(nvolu > 0)THEN
6586 IF (imonm > 0) CALL startime(timers,50)
6587 IF(nspmd>1)CALL spmd_glob_minv(t_monvol,dt2,itypts,nelts,volmon, fr_mv)
6588 IF(python%NB_FUNCTS > 0) CALL python_monvol(t_monvol)
6589C========================================================================================
6590C DOMAIN 0
6591C========================================================================================
6592 IF(ispmd == 0) CALL mvoludt(monvol,volmon)
6593 IF (imonm > 0) CALL stoptime(timers,50)
6594 ENDIF
6595C----------------------------------
6596 IF (imonm > 0) CALL startime(timers,52)
6597 IF (nodadt==0) THEN
6598 IF (istat==3) THEN
6599 dampa3 = two*betate/(one + betate * dt12)
6600 IF (dt2>=ep06) dampa3=zero
6601 ELSE
6602 dampa3 = zero
6603 END IF
6604
6605 IF(idamp>0)THEN
6606 IF(dampb>=zero)THEN
6607 bb = (min(dampb,dt1,dt2) + half*(dampa+dampa3)*dt2*dt2)
6608C-- IF no node/elemt on proc - dt2=10E6 -> dt2 can be equal to zero
6609 IF (dt2>=ep06) bb = zero
6610 dt2 = sqrt(bb*bb + dt2*dt2) - bb
6611 ELSE
6612 bb = one - dampb - dampb
6613 dt2 = dt2/sqrt(bb)
6614 ENDIF
6615 ELSEIF(ndamp>0) THEN
6616 IF(nrdamp==4)THEN
6617 bb = zero
6618 DO i=1,ndamp
6619 dampa = dampr(3,i)
6620 dampb = dampr(4,i)
6621 d_tstart = dampr(17,i)
6622 d_tstop = dampr(18,i)
6623C-- IF no node/elemt on proc - dt2=10E6 -> dt2 can be equal to zero
6624 IF ((tt>=d_tstart).AND.(tt<=d_tstop).AND.(dt2 < ep06))
6625 . bb=max(bb,(min(dampb,dt1,dt2)+half*(dampa+dampa3)*dt2*dt2))
6626 ENDDO
6627 ELSE
6628 bb = zero
6629 IF (flg_dtnodamp==1) GOTO 600
6630 DO i=1,ndamp
6631 dampa = max(dampr(3,i),dampr(5,i),dampr(7,i))
6632 dampa = max(dampa,dampr(9,i),dampr(11,i),dampr(13,i))
6633 dampb = max(dampr(4,i),dampr(6,i),dampr(8,i))
6634 dampb = max(dampb,dampr(10,i),dampr(12,i),dampr(14,i))
6635C-- /DAMP/VREL - recompute damping parameters at current time
6636 fl_vrel = nint(dampr(21,i))
6637 IF (fl_vrel==2) THEN
6638 call damping_vref_compute_dampa(i,ndamp,nrdamp,dampr,dt1,tt,damp_a)
6639 dampa = max(damp_a(1),damp_a(2),damp_a(3))
6640 dampb = zero
6641 ENDIF
6642 factb = dampr(16,i)
6643 d_tstart = dampr(17,i)
6644 d_tstop = dampr(18,i)
6645C-- IF no node/elemt on proc - dt2=10E6 -> dt2 can be equal to zero
6646 IF ((tt>=d_tstart).AND.(tt<=d_tstop).AND.(dt2 < ep06)) THEN
6647 dampt = min(dt1,dt2)*factb
6648 bb=max(bb,(min(dampb,dampt)+half*(dampa+dampa3)*dt2*dt2))
6649 ENDIF
6650 ENDDO
6651600 CONTINUE
6652 END IF
6653 dt2 = sqrt(bb*bb + dt2*dt2) - bb
6654 ELSEIF(istat==3) THEN
6655 bb = half*dampa3*dt2*dt2
6656 dt2 = sqrt(bb*bb + dt2*dt2) - bb
6657 ENDIF
6658 END IF !(NODADT==0) THEN
6659
6660 IF (imonm > 0) CALL stoptime(timers,52)
6661
6662C-----------------------------
6663C Write L01
6664C-----------------------------
6665
6666 IF (imonm > 0) CALL startime(timers,53)
6667 IF(nspmd>1) THEN
6668 iwiout = 0
6669 IF (ispmd/=0) CALL spmd_chkw(iwiout,iout)
6670 ENDIF
6671
6672 ! ----------------------
6673 ! user library : check out
6674 IF(dlib_struct(id_engine_user_check)%DLIB_BOOL) THEN
6675 tstop_user = tstop
6676 tt_user = tt
6677 mstop_user = 0
6678 ncycle_user = ncycle
6679 CALL engine_user_check(ispmd_user,tstop_user,ncycle_user,tt_user,mstop_user)
6680 IF(mstop_user > 0) THEN
6681 mstop=1
6682 mrest=1
6683 ENDIF
6684 ENDIF
6685 ! ----------------------
6686#ifdef DNC
6687 IF(mds_avail==1) THEN
6688 tstop_user = tstop
6689 tt_user = tt
6690 mstop_user = 0
6691 ncycle_user = ncycle
6692 CALL mds_engine_user_check(ispmd_user,tstop_user,ncycle_user,tt_user,mstop_user)
6693 IF(mstop_user > 0) THEN
6694 mstop=1
6695 mrest=1
6696 ENDIF
6697 ENDIF
6698#endif
6699
6700 ! ----------------------
6701
6702 IF(nspmd>1)THEN
6703 CALL spmd_glob_min5(dt2 ,itypts,nelts ,nodes%ICODT ,imsch,
6704 . tstop,iwiout,mstop ,ismsch,
6705 . int24use,nbintc,intlist,ipari,interfaces%INTBUF_TAB)
6706
6707C If FVMBAGS switch to UP using NPOLH criterion, then
6708C an SPMD communication must be made to warn all processors (only
6709C processes in charge of the FVMBAGS know NPOLH)
6710 IF(nfvbag0 >0 .AND. check_npolh) CALL spmd_fvb_switch(monvol)
6711
6712 IF(iexicodt>0) THEN
6713 length = 1
6714 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
6715 CALL spmd_exch_icodt(nodes%ICODT,nodes%BOUNDARY_ADD,nodes%BOUNDARY,length,lenr)
6716 iexicodt = 0
6717 ENDIF
6718 ENDIF
6719
6720 IF (glob_therm%IDT_THERM == 0) dt2= min(dt2,1.1*dt2old,dtmx)
6721 IF (impl_s==1) CALL imp_dt2(dt2)
6722
6723 IF (imonm > 0) CALL stoptime(timers,53)
6724
6725C --------------------------
6726
6727 IF ((ncycle==0).AND.(flg_kj2==1)) THEN
6728 CALL joint_block_stiffness(nodes%ITAB,nodes%MS,nodes%IN,stk_sn,stk_sr,
6729 1 nodes%WEIGHT,ixr,ipart,nodes%X,ipart(k6),
6730 2 igeo,geo,npby,iparg,elbuf_tab,dmast,dinert)
6731 DEALLOCATE(stk_sn,stk_sr)
6732 ENDIF
6733
6734C--------------------------------------------------------------C
6735C RADIOSS 2 RADIOSS COUPLING
6736C--------------------------------------------------------------C
6737 IF (irad2r /= 0 .AND. r2r_activ == 1) THEN
6738 CALL r2r_sendkine(iexlnk,igrnod,nodes%MS,nodes%IN)
6739 IF (nspmd>1) CALL spmd_barrier()
6740C--------------------------------------------------------------C
6741!$omp parallel private(itsk)
6742!$OMP MASTER
6743C--------------------------------------------------------------C
6744C--------------------------------------------------------------C
6745 IF (imonm > 0) CALL startime(timers,54)
6746 IF (ncycle == zero) tt_dp = tt
6747C--------------------------------------------------------------C
6748 IF(ispmd==0)THEN
6749 CALL r2r_sem_c()
6750 IF (iresp==1) CALL send_fbufdp_c(tt_dp,1)
6751 IF (iresp/=1) CALL send_fbufdp_c(tt,1)
6752 IF ((r2r_siu==1).AND.(iddom/=0)) THEN
6753 CALL get_ibuf_c(r2r_th_main,10)
6754 ENDIF
6755 CALL send_fbuf_c(dt2,1)
6756 CALL send_ibuf_c(r2r_mfilr,1)
6757 CALL send_ibuf_c(r2r_mstop,1)
6758 IF (r2r_mfilr==1) THEN
6759 CALL send_fbuf_c(tman_r2r,1)
6760 CALL send_ibuf_c(r2r_ctr,3)
6761 ENDIF
6762 IF (iresp==1) CALL get_fbufdp_c(tt_dp,1)
6763 IF (iresp/=1) CALL get_fbufdp_c(tt,1)
6764 CALL get_ibuf_c(mrest,1)
6765 CALL get_ibuf_c(r2r_mfilr,1)
6766 CALL get_ibuf_c(r2r_mstop,1)
6767 IF (r2r_mfilr==2) THEN
6768 CALL get_fbuf_c(tman_r2r,1)
6769 CALL get_ibuf_c(r2r_ctr,3)
6770 ENDIF
6771 CALL get_fbuf_c(dt2,1)
6772 END IF
6773C--------------------------------------------------------------C
6774 IF(nspmd>1)THEN
6775 IF(ispmd==0) THEN
6776 rbuf(1) = tt
6777 rbuf(2) = dt2
6778 END IF
6779 CALL spmd_rbcast(rbuf,rbuf,2,1,0,2)
6780 CALL spmd_ibcast(mrest,mrest,1,1,0,2)
6781 CALL spmd_ibcast(r2r_th_main,r2r_th_main,10,1,0,2)
6782 IF(ispmd/=0) THEN
6783 tt = rbuf(1)
6784 dt2 = rbuf(2)
6785 END IF
6786 END IF
6787C--------------------------------------------------------------C
6788 IF ((r2r_siu==1).OR.(nspmd==1)) THEN
6789 CALL r2r_sem_c()
6790 CALL get_ibuf_c(bid,1)
6791 CALL r2r_unlock_threads_c(nthread)
6792 ELSEIF (ispmd==0) THEN
6793 CALL r2r_sem_c()
6794 CALL get_ibuf_c(bid,1)
6795 CALL r2r_unlock_threads_c(nthread*nspmd)
6796 ENDIF
6797!$OMP END MASTER
6798 CALL r2r_block_c()
6799C--------------------------------------------------------------C
6800!$OMP END PARALLEL
6801C--------------------------------------------------------------C
6802C--------------------------------------------------------------C
6803
6804 CALL r2r_getdata(iexlnk ,igrnod ,nodes%X ,nodes%V ,
6805 . nodes%VR ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
6806 . nodes%XDP ,nodes%D ,r2r_on ,dd_r2r ,nodes%WEIGHT ,
6807 . nodes%BOUNDARY_ADD,nodes%BOUNDARY ,nodes%STIFN ,nodes%STIFR ,dd_r2r_elem ,
6808 . sdd_r2r_elem,nloc_dmg, output%TH%WFEXT, output%TH%WFEXT_MD)
6809
6810 IF (imonm > 0) CALL stoptime(timers,54)
6811
6812 ENDIF
6813
6814#ifdef DNC
6815C----------------------------------------------
6816C Radioss Madymo coupling - Exchange Timesteps
6817C----------------------------------------------
6818 IF(imadcpl==1)THEN
6819 madendrequest = 0
6820 IF (imonm > 0) CALL startime(timers,55)
6821C Exchange Time Step
6822 CALL tstp_exch_madcpl(madendrequest,madclnod,madclfrecv,nodes%V,nodes%A,nodes%MS ,madymo_del_global )
6823 IF (madendrequest == -1)THEN
6824 mstop = 2
6825 CALL trace_out(3)
6826 RETURN
6827 ENDIF
6828 IF (imonm > 0) CALL stoptime(timers,55)
6829 ENDIF
6830#endif
6831C-----------------------------------------------------
6832 IF (vipercoupling) THEN
6833C Compare timesteps from Viper and Radioss & select the smallest
6834 CALL radiossviper_receivesenddt(viper%id,tt,dt2)
6835 ENDIF
6836C-----------------------------------------------------
6837! reducing dt2 due to /INIVEL
6838 IF(loads%NINIVELT_G>0) CALL inivel_dt2(loads%NINIVELT,loads%INIVELT,sensors,tt , dt2 ,nspmd)
6839C-----------------------------
6840 IF (imonm > 0) CALL startime(timers,53)
6841 dt2old=dt2
6842 IF (inconv==1) THEN
6843 dt12=half*(dt1+dt2)
6844 dt3=dt1
6845 ENDIF
6846 IF(ale%SUB%IALESUB==0)dt2s=dt2
6847C-----------------------------
6848C L01
6849C-----------------------------
6850 IF(nspmd>1.AND.iwiout>0) THEN
6851 CALL spmd_wiout(iout,iwiout)
6852 iwiout = 0
6853 ENDIF
6854
6855 IF (irad2r /= 0) THEN
6856 IF(ispmd==0)THEN
6857 r2rfx1 = r2rfx1*dt2 + r2rfx2*dt12*dt2
6858 ENDIF
6859 ENDIF
6860C EXTERNAL WORK OF CONCENTRATED LOADS
6861 IF (nconld/=0.AND.impl_s/=1) THEN
6862 output%TH%WFEXT = output%TH%WFEXT + wfexc*dt2
6863 ENDIF
6864
6865 IF (imonm > 0) CALL stoptime(timers,53)
6866 IF (imon>0) CALL stoptime(timers,6)
6867
6868C========================================================================================
6869C PARALLEL SECTION (SMP)
6870C========================================================================================
6871 IF (imon>0) CALL startime(timers,timer_io)
6872
6873!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
6874
6875 itsk = omp_get_thread_num()
6876 nodftsk = 1+itsk*numnod/ nthread
6877 nodltsk = (itsk+1)*numnod/nthread
6878
6879C--- // ---------------------------------------
6880C OUTPUT (ANIM,OUTP,H3D,TH) STEP 1 ON 3 TO GET FREAC/MREAC
6881C adding FEXT+FINT
6882C-----------------------------------------------
6883 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
6884 CALL reaction_forces_1(nodftsk,nodltsk,nodes%A,nodes%AR,freac)
6885 END IF
6886
6887C--- // ----------------------------------------
6888C INTERNAL FORCES (ANIM, OUTP, H3D)
6889C-----------------------------------------------
6890 CALL forani2(fani,nodes%A,nfia,nfea,nodftsk,nodltsk,h3d_data)
6891
6892!$OMP END PARALLEL
6893
6894 IF (imon>0) CALL stoptime(timers,timer_io)
6895C-----------------------------------------------
6896C SELECTIVE MASS SCALING
6897C-----------------------------------------------
6898 IF(idtmins == 1)THEN
6899C
6900C Obsolete
6901 ELSEIF(idtmins == 2.OR.idtmins_int /= 0)THEN
6902
6903 IF (imon>0) CALL startime(timers,39)
6904
6905C========================================================================================
6906C PARALLEL SECTION (SMP)
6907C========================================================================================
6908
6909 CALL my_alloc(cjwork,18,njoint)
6910 CALL my_alloc(frea,3,numnod)
6911 CALL my_alloc(irwl_work,slprw)
6912
6913!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
6914 itsk = omp_get_thread_num()
6915 nodftsk = 1+itsk*numnod/ nthread
6916 nodltsk = (itsk+1)*numnod/nthread
6917 CALL sms_mass_scale_2(timers,python,
6918 1 itsk ,nodftsk ,nodltsk ,nodii_sms ,indx2_sms ,
6919 2 nodxi_sms,nodes%MS ,nodes%MS0 ,nodes%A ,nodes%ICODT ,
6920 3 nodes%ICODR ,nodes%ISKEW ,skews%SKEW,jad_sms ,jdi_sms ,
6921 4 lt_sms ,x_sms ,p_sms ,z_sms ,y_sms ,
6922 5 prec_sms ,indx1_sms ,diag_sms ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,
6923 6 nodes%WEIGHT ,npby ,lpby ,
6924 7 tagslv_rby_sms,lad_sms ,kad_sms ,jsm_sms ,ibfv ,
6925 8 vel ,npc ,tf ,nodes%V ,nodes%X ,
6926 9 nodes%D ,sensors%SENSOR_TAB,nsensor,iframe,xframe,
6927 a jadi_sms ,jdii_sms ,lti_sms ,fr_sms ,fr_rms ,
6928 b iskyi_sms,mskyi_sms,res_sms ,igrv ,agrv ,
6929 c lgrav ,ilink ,llink ,fr_rl ,frl6 ,
6930 d nnlink ,lnlink ,fr_ll ,fnl6 ,tag_lnk_sms,
6931 e nodes%ITAB ,fsav ,ljoint ,iadcj ,fr_cj ,
6932 f nodes%AR ,nodes%VR ,nodes%IN ,frl ,fnl ,
6933 g nprw ,lprw ,rwbuf ,rwsav ,
6934 h fani(1,1+nfoa+2*(nsect+nrbody)),fr_wall ,nrwl_sms ,
6935 i intstamp ,kinet ,element%SHELL%IXC ,ixtg ,sh4tree ,
6936 j sh3tree ,cptreac ,nodreac ,fthreac ,
6937 k frwl6 ,3+iroddl*3,nodes%TAG_S_RBY,dampr , damp ,
6938 l igrnod ,nodes%DR ,rby ,tagmsr_rby_sms,
6939 m jsm_sms ,irbe2 ,lrbe2 ,iad_rbe2 ,fr_rbe2m ,
6940 n nmrbe2 ,r2size ,rbe3%IRBE3 ,rbe3%LRBE3 ,rbe3%FRBE3 ,
6941 o rbe3%mpi%IAD_RBE3 ,rbe3%mpi%FR_RBE3,rbe3%mpi%FR_RBE3MP ,rbe3%RRBE3 ,rbe3%RRBE3_PON,
6942 p prec_sms3 ,diag_sms3,iad_rby ,fr_rby6 ,rby6 ,
6943 q rbe3%irotg_sz ,betate ,ibcscyc ,lbcscyc,
6944 r mskyi_fi_sms, list_sms,list_rms,cjwork,frea,
6945 s irwl_work,sms_vfi,sz_mw6,mw6,output%TH%WFEXT,ams_work)
6946
6947!$OMP END PARALLEL
6948
6949 IF (ALLOCATED(cjwork)) DEALLOCATE(cjwork)
6950 IF (ALLOCATED(frea)) DEALLOCATE(frea)
6951 IF (ALLOCATED(irwl_work)) DEALLOCATE(irwl_work)
6952
6953 IF (imon>0) CALL stoptime(timers,39)
6954
6955 ENDIF
6956
6957 idum1=0
6958 rdum1=zero
6959C
6960 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
6961 k2=k1+numels
6962 k3=k2+numelq
6963 k4=k3+numelc
6964 k5=k4+numelt
6965 k6=k5+numelp
6966 k7=k6+numelr
6967 k8=k7
6968 k9=k8+numeltg
6969 k10=k9+numelx
6970 k11=k10+numsph
6971
6972C-----------------------------------------------------------------
6973C IMPLICIT SYNCHRONIZATION (FORCES), FV(FUNC) AND SKEW(MOVING)
6974C-----------------------------------------------------------------
6975
6976 IF (impl_s == 1) THEN
6977 encin = zero
6978 enrot = zero
6979 encin2 = zero
6980 enrot2 = zero
6981 IF (imon>0) CALL startime(timers,timer_integ)
6982C-----------------------
6983 IF (impl_s==1 .AND. inconv==1) THEN
6984 CALL thbcs_imp(nodft,nodlt ,nodes%A,nodes%AR,
6985 & fthreac,nodreac,cptreac,fthdtm,dt3)
6986 ENDIF
6987C========================================================================================
6988C PARALLEL SECTION (SMP)
6989C========================================================================================
6990
6991!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
6992 itsk = omp_get_thread_num()
6993 nodftsk = 1+itsk*numnod/ nthread
6994 nodltsk = (itsk+1)*numnod/nthread
6995
6996 IF (ilag+iale+ieuler/=0) THEN
6997C-----------------------
6998C MULTIMATERIAL
6999C-----------------------
7000 IF (nmult>0) THEN
7001 CALL bmultn(fill,dfill,ims,nodftsk,nodltsk)
7002 ENDIF
7003 CALL imp_fanii(fani ,nodes%A ,nfia ,nodft ,nodlt ,
7004 . h3d_data )
7005 IF (impdeb==1.AND.imconv==0) THEN
7006 IF (ncycle>=ndeb0.AND.ncycle<=ndeb1) THEN
7007 CALL imp_fout(
7008 1 fani ,nodes%A ,nodes%AR ,nfia ,nfea ,
7009 2 nodftsk ,nodltsk ,h3d_data ,impbuf_tab)
7010 ENDIF
7011 ENDIF
7012C--- // N/3 ---------------------------------------
7013C INTERNAL FORCES (ANIM)
7014C-----------------------------------------------
7015 IF (isecut/=0) THEN
7016 IF (imon>0) CALL startime(timers,timer_io)
7017 CALL section_io (
7018 1 nstrf,nodes%D,nodes%DR,nodes%V,nodes%VR,fsav(1,1+ninter+nrwall+nrbody),
7019 2 secfcum,nodes%A ,nodes%AR ,secbuf,nodes%MS ,nodes%IN ,
7020 3 nodes%X ,fani(1,nfoa+1),nodes%WEIGHT,xsec ,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
7021 4 rg_cut ,iad_cut ,fr_cut,nodes%WEIGHT_MD,ioldsect,
7022 5 sensors%STABSEN,sensors%SFSAV,sensors%TABSENSOR,sensors%FSAV, output%TH%WFEXT)
7023 IF(imon>0) CALL stoptime(timers,timer_io)
7024 ENDIF
7025 ENDIF ! ILAG+IALE+IEULER/=0
7026
7027!$OMP END PARALLEL
7028
7029 IF (imon>0) CALL stoptime(timers,timer_integ)
7030C-----------------------------------------------
7031 IF (ilag+iale+ieuler/=0)THEN
7032 IF(imon>0) CALL startime(timers,timer_kin)
7033 IF(imonm > 0) CALL startime(timers,40)
7034
7035C========================================================================================
7036C PARALLEL SECTION (SMP)
7037C========================================================================================
7038
7039!$OMP PARALLEL
7040
7041 CALL rbycor(
7042 1 rby ,nodes%X ,nodes%V ,nodes%VR ,skews%SKEW ,fsav ,
7043 2 lpby,npby,nodes%ISKEW,nodes%ITAB ,nodes%WEIGHT ,nodes%A ,
7044 3 nodes%AR ,nodes%MS ,nodes%IN ,kindrby,irbkin_l,nrbykin_l ,
7045 4 nodes%WEIGHT_MD,ms_2d)
7046!$OMP END PARALLEL
7047
7048 IF(imon>0) CALL stoptime(timers,timer_kin)
7049 IF(imonm > 0) CALL stoptime(timers,40)
7050 ENDIF ! ILAG+IALE+IEULER/=0
7051C========================================================================================
7052C----- RBE2 Bilan crrection
7053C========================================================================================
7054 IF (nrbe2>0)THEN
7055 IF(imon>0) CALL startime(timers,timer_kin)
7056 IF(imonm > 0) CALL startime(timers,40)
7057C
7058
7059!$OMP PARALLEL
7060 CALL rbe2cor(irbe2 ,lrbe2 ,nodes%X ,nodes%V ,nodes%VR ,
7061 2 skews%SKEW ,nodes%ISKEW ,nodes%ITAB ,nodes%WEIGHT,nodes%A ,
7062 3 nodes%AR ,nodes%MS0 ,nodes%IN ,nodes%WEIGHT_MD)
7063!$OMP END PARALLEL
7064
7065 IF(imon>0) CALL stoptime(timers,timer_kin)
7066 IF(imonm > 0) CALL stoptime(timers,40)
7067 ENDIF
7068C--------------------
7069C SENSOR // NODES%IN IMPLICIT
7070C-----------------------------------------------
7071C Exchange SENSORS%FSAV for sensors 6-13
7072C-----------------------------------------------
7073 IF (nsensor > 0) THEN
7074 IF (nspmd > 1 .AND. sensors%STABSEN > 0) THEN
7075 dim6=12
7076 dim_exch = sensors%SFSAV
7077 CALL spmd_exsum_fb6(dim6,dim_exch,sensors%FSAV)
7078 ENDIF
7079 ENDIF
7080c
7081 IF (nsensor > 0 .AND. inconv == 1) THEN
7082 CALL sensor_ener_sav(nsensor,sensors%SENSOR_TAB ,partsav ,partsav2)
7083 ! -------------------------------
7084 ! pre-computation and mpi communication for type 16 sensor
7085 IF (sensors%COMM_SENS16%BOOL) THEN
7086 CALL sensor_dist_surf0(nsensor,sensors%SENSOR_TAB,nodes%X,
7087 * igrsurf,sensors%COMM_SENS16)
7088 ENDIF
7089 ! -------------------------------
7090 ! pre-computation and mpi communication for type 17 sensor
7091 IF(sensors%COMM_SENS17%BOOL) THEN
7092 CALL sensor_temp0(nsensor,sensors%SENSOR_TAB,igrnod,nodes%TEMP,nodes%WEIGHT,sensors%COMM_SENS17,
7093 * sensors%SENSOR_STRUCT)
7094 ENDIF
7095 ! -------------------------------
7096 IF (nspmd > 1) THEN
7097 CALL sensor_spmd(sensors%SENSOR_TAB,ipari ,nprw ,isensp ,nsensp ,
7098 . xsens ,nodes%X ,accelm ,iaccp ,naccp ,
7099 . gauge ,igaup ,ngaup ,partsav2,nsensor,
7100 . sensors%COMM_SENS14,sensors%SENSOR_STRUCT)
7101 ENDIF
7102c
7103 ! check activation condition of base sensors
7104 CALL sensor_base(sensors ,nsensor ,tt ,dt2 ,
7105 . xsens ,ipari ,partsav2 ,gauge ,fsav ,
7106 . nodes%X ,nodes%V ,nodes%A ,accelm ,nprw ,
7107 . subsets ,igrsurf ,igrnod , python)
7108c
7109 ! check activation condition of logical sensors hierarchy
7110 CALL sensor_logical(sensors)
7111
7112 ENDIF
7113
7114 GOTO 111
7115
7116 ENDIF
7117C-----------------------------
7118C Non pure thermal case
7119C-----------------------------
7120 IF (ilag + iale + ieuler /= 0) THEN
7121
7122 IF (imon>0) CALL startime(timers,timer_integ)
7123
7124C========================================================================================
7125C PARALLEL SECTION (SMP)
7126C========================================================================================
7127
7128!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7129 itsk = omp_get_thread_num()
7130 nodftsk = 1+itsk*numnod/ nthread
7131 nodltsk = (itsk+1)*numnod/nthread
7132
7133C--- // ----------------
7134C MULTIMATERIAL
7135C------- ----------------
7136 IF(nmult>0) THEN
7137 CALL bmultn(fill,dfill,ims,nodftsk,nodltsk)
7138 ENDIF
7139
7140!$OMP END PARALLEL
7141
7142
7143
7144C-----------------------------------------------
7145C SPH SMOOTHING OF VELOCITIES
7146C-----------------------------------------------
7147 IF ((numsph/=0).OR.(sol2sph_flag==1)) THEN
7148C------------------------
7149C Conservative smoothing of velocities
7150C------------------------
7151 IF (imonm > 0) CALL startime(timers,48)
7152 IF (imonm > 0) CALL startime(timers,89)
7153
7154 ALLOCATE(waspsym(3*nsphsym+1),stat=ierror)
7155 IF(ierror/=0)THEN
7156 CALL ancmsg(msgid=19,anmode=aninfo,c1="WASPSYM")
7157 CALL arret(2)
7158 ENDIF
7159C========================================================================================
7160C PARALLEL SECTION (SMP)
7161C========================================================================================
7162
7163!$OMP PARALLEL PRIVATE(ITSK,IPMTSK)
7164 itsk = omp_get_thread_num()
7165 ipmtsk = 1 + itsk*npsav*npart
7166
7167 CALL splissv(
7168 1 nodes%X ,nodes%V ,nodes%MS ,nodes%A ,spbuf ,
7169 2 wa ,nodes%ITAB ,kxsp ,ixsp ,nod2sp ,
7170 3 nodes%D ,ispsym ,xspsym%BUF ,vspsym%BUF ,bufmat ,
7171 4 bufgeo ,npc ,tf ,pm ,geo ,
7172 5 ispcond ,xframe ,waspsym,ipart(k10),partsav(ipmtsk),
7173 6 wasph(ksph21) ,wsmcomp%BUF ,wasph(kspactiv) ,ipart,itsk,
7174 7 sph2sol ,sol2sph ,irst ,ixs ,iparg ,
7175 8 ngrounc ,igrounc ,elbuf_tab,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,
7176 9 igeo ,sol2sph_typ,sph_work)
7177
7178!$OMP END PARALLEL
7179 DEALLOCATE(waspsym)
7180
7181C========================================================================================
7182C NON PARALLEL SECTION (SMP)
7183C========================================================================================
7184
7185 IF (imonm > 0) CALL stoptime(timers,48)
7186 IF (imonm > 0) CALL stoptime(timers,89)
7187C
7188C------------------------
7189C Second Part of artificial forces work.
7190C--- //0 ----------------
7191 IF (imon>0) CALL startime(timers,6)
7192 IF (imonm > 0) CALL startime(timers,48)
7193 CALL spwfvis(spbuf,ipart(k10),partsav,iparg,elbuf_tab,
7194 . kxsp ,wasph(kspactiv))
7195 IF (imonm > 0) CALL stoptime(timers,48)
7196 IF (imon>0) CALL stoptime(timers,6)
7197
7198C========================================================================================
7199C PARALLEL SECTION (SMP)
7200C========================================================================================
7201
7202!$OMP PARALLEL
7203!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
7204!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK)
7205
7206C Init var parallel SMP
7207 CALL smp_init(
7208 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
7209 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
7210 3 greftsk,greltsk)
7211
7212 CALL asspart(
7213 2 partftsk,partltsk,partsav,greftsk,greltsk,gresav)
7214
7215!$OMP END PARALLEL
7216
7217 ENDIF ! (NUMSPH/=0).OR.(SOL2SPH_FLAG==1)
7218C========================================================================================
7219C NON PARALLEL SECTION (SMP)
7220C========================================================================================
7221C BALANCING FORCES COMPUTED AT TT=0 NODES%IN GLOBAL REFERENCE SYSTEM
7222C----------------------------------------------------------------------------------------
7223 IF (tt==zero.AND.iabs(isigi)==5) THEN
7224C--- //0 ----------------
7225 IF (imon>0) CALL startime(timers,6)
7226 IF (imonm > 0) CALL startime(timers,49)
7227 CALL fequilibre(nodes%A,fzero,element%SHELL%IXC,ixtg)
7228 IF (imonm > 0) CALL stoptime(timers,49)
7229 IF (imon>0) CALL stoptime(timers,6)
7230 ENDIF
7231C========================================================================================
7232C MPI communication for NLOC_DMG : parith/off
7233C========================================================================================
7234 IF(iparit == 0.AND.nspmd > 1.AND. nloc_dmg%IMOD > 0)THEN
7235 CALL spmd_exch_sub_poff(nloc_dmg)
7236 ENDIF
7237
7238 IF(coupling%active) THEN
7239 ! FORCES WAS INITIALIZED TO THE ACCELERTION, BEFORE ASSEMBLY
7240 ! BEFORE THE CALL TO ACCELE, A CONTAINS THE FORCES
7241 ! AFTER THE CALL TO ACCELE, A CONTAINS THE ACCELERATION
7242 !NODES%FORCES(1:3,1:NUMNOD) = nodes%A(1:3,1:NUMNOD) - NODES%FORCES(1:3,1:NUMNOD)
7243 CALL coupling_sync(coupling,dt2,nodes,coupling_forces)
7244 ENDIF
7245C========================================================================================
7246C PARALLEL SECTION (SMP)
7247C========================================================================================
7248
7249!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK,NODFT_NL,NODLT_NL)
7250 itsk = omp_get_thread_num()
7251 nodftsk = 1+itsk*numnod/ nthread
7252 nodltsk = (itsk+1)*numnod/nthread
7253
7254C--- // ---------------------------------------
7255C ACCELERATIONS (TRANSLATIONS)
7256C-----------------------------------------------
7257
7258 !-----------------------------
7259 ! FINITE VOLUME METHOD FOR ALE
7260 !-----------------------------
7261 IF(alefvm_param%IEnabled>0)THEN
7262 CALL alefvm_accele(nodes%A, nodes%AR, nodftsk, nodltsk, ale_connectivity%NALE)
7263 ENDIF
7264
7265 CALL accele(nodes%A ,nodes%AR ,nodes%V ,nodes%MS ,nodes%IN ,
7266 2 ale%GLOBAL%SNALE ,ale_connectivity%NALE ,ms_2d ,
7267 3 size_npby,npby )
7268C
7269 IF(iplyxfem > 0 )
7270 . CALL ply_accele(inod_pxfem,ms_ply,zi_ply,nodes%MS,
7271 . nodftsk,nodltsk,nplymax,nplyxfe,numnod,msz2 )
7272
7273C
7274 IF(ialelag > 0) THEN
7275 CALL flow_accele(ale_connectivity%NALE, msf ,aflow ,vflow ,
7276 2 nodftsk,nodltsk)
7277 ENDIF
7278c
7279 IF (nloc_dmg%IMOD > 0) THEN
7280 nodft_nl = 1+ itsk*nloc_dmg%NNOD/nthread
7281 nodlt_nl = (itsk+1)*nloc_dmg%NNOD/nthread
7282 CALL nlocal_acc(nloc_dmg, nodft_nl ,nodlt_nl)
7283 ENDIF
7284c
7285 IF (icrack3d > 0) THEN
7286C /---------------/
7287 CALL my_barrier
7288C /---------------/
7289 CALL crk_accele(adsky_crk,inod_crk,nodlevxf ,nodftsk ,nodltsk ,
7290 . nodenr ,crksky ,nodes%MS ,nodes%IN ,nodes%ITAB )
7291C /---------------/
7292 CALL my_barrier
7293C /---------------/
7294 CALL crk_zero_fsky(crksky,adsky_crk,inod_crk,nodftsk,nodltsk,
7295 . nodlevxf)
7296C /---------------/
7297 CALL my_barrier
7298C /---------------/
7299 ENDIF
7300C
7301 IF(npinch > 0) THEN
7302 CALL accelepinch(
7303 1 pinch_data%APINCH, nodes%MS, pinch_data%MSPINCH,
7304 2 pinch_data%STIFPINCH, nodftsk, nodltsk,
7305 3 dt2t, dtfac)
7306 ENDIF
7307C--- // ---------------------------------------
7308C TEMPERATURES COMPUTATION
7309C-----------------------------------------------
7310 IF (glob_therm%ITHERM_FE > 0 )
7311 . CALL tempur(nodes%TEMP ,nodes%MCP,fthe,nodftsk,nodltsk,nodes%WEIGHT,mcp_off,glob_therm%HEAT_STORED)
7312!$OMP END PARALLEL
7313
7314C------------------------------------------
7315C DT_DC for thick-shell
7316C-----------------------------------------------
7317 IF(ntshegg>0.AND.nspmd > 1)
7318 . CALL spmd_exch_vmax(iad_stsh ,fr_stsh ,iad_rtsh ,fr_rtsh ,alpha_dc )
7319 IF(ntsheg > 0) THEN
7320
7321C========================================================================================
7322C PARALLEL SECTION (SMP)
7323C========================================================================================
7324
7325!$OMP PARALLEL
7326!$OMP+PRIVATE(ITSK,NODFTSK,NODLTSK,GREFTSK,GRELTSK)
7327 itsk = omp_get_thread_num()
7328 greftsk = 1+itsk*ntsheg/ nthread
7329 greltsk = (itsk+1)*ntsheg/nthread
7330 CALL accdtdc(greftsk,greltsk,ienunl ,alpha_dc,nodes%A ,nodes%MS ,nodes%ITAB )
7331!$OMP END PARALLEL
7332 ENDIF
7333
7334 IF(ntshegg>0.AND.nspmd > 1)
7335 . CALL spmd_exch_fa(iad_stsh ,fr_stsh ,iad_rtsh ,fr_rtsh ,nodes%A )
7336C---------------------------------------------------------------------
7337C DEBUG TEMPERATURES OUTPUT
7338C---------------------------------------------------------------------
7339 IF (debug(macro_debug_temp)==1) THEN
7340 IF (ncycle>=tdebstart .AND.
7341 . mod(ncycle-tdebstart,trstfreq)==0) THEN
7342
7343 IF(nspmd > 1) THEN
7344 IF (ispmd==0) THEN
7345 siz = numnodg
7346 ELSE
7347 siz = 0
7348 END IF
7349 CALL spmd_collectt(nodes%TEMP,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB,siz)
7350 ELSE
7351 CALL collectt(nodes%TEMP,nodes%ITAB,nodes%WEIGHT,nodes%NODGLOB)
7352 END IF
7353 END IF
7354 END IF
7355
7356C========================================================================================
7357C NON PARALLEL SECTION (SMP)
7358C========================================================================================
7359
7360 IF (imon>0) CALL stoptime(timers,timer_integ)
7361C-----------------------------------------------
7362C INLETS,OUTLETS.
7363C-----------------------------------------------
7364 IF(nsphio/=0)THEN
7365
7366C globalize NSPHACT in NSPHACTG
7367 nsphactg = nsphact
7368
7369 IF(nspmd>1)THEN
7370 CALL spmd_glob_isum9(nsphactg,1)
7371 CALL spmd_ibcast(nsphactg,nsphactg,1,1,0,2)
7372 END IF
7373
7374 IF(nsphactg/=0)THEN
7375C--- //0 ----------------
7376 IF (imon>0) CALL startime(timers,6)
7377 IF (imonm > 0) CALL startime(timers,48)
7378 IF (imonm > 0) CALL startime(timers,89)
7379
7380 CALL sponfv (nodes%X ,nodes%V ,nodes%A ,nodes%D ,nodes%MS ,
7381 2 spbuf ,nodes%ITAB ,kxsp ,ixsp ,nod2sp ,
7382 3 npc ,tf ,isphio ,vsphio ,ipart ,
7383 4 ipart(k10),wasph(kspactiv) ,wa,wasph(ksph22) ,sph_work, output%TH%WFEXT)
7384
7385 IF (imonm > 0) CALL stoptime(timers,89)
7386 IF (imonm > 0) CALL stoptime(timers,48)
7387 IF (imon>0) CALL stoptime(timers,6)
7388 ENDIF
7389 END IF
7390
7391C========================================================================================
7392C NON PARALLEL SECTION (SMP)
7393C========================================================================================
7394
7395C-----------------------------------------------
7396C INLETS,OUTLETS.
7397C-----------------------------------------------
7398 IF(nsphio/=0.AND.nsphactg/=0)THEN
7399C--- //0 ----------------
7400 IF (imon>0) CALL startime(timers,6)
7401 IF (imonm > 0) CALL startime(timers,48)
7402 IF (imonm > 0) CALL startime(timers,89)
7403
7404 CALL sponfv (nodes%X ,nodes%V ,nodes%A ,nodes%D ,nodes%MS ,
7405 2 spbuf ,nodes%ITAB ,kxsp ,ixsp ,nod2sp ,
7406 3 npc ,tf ,isphio ,vsphio ,ipart ,
7407 4 ipart(k10),wasph(kspactiv),wa,wasph(ksph22) ,sph_work, output%TH%WFEXT)
7408
7409 IF (imonm > 0) CALL stoptime(timers,89)
7410 IF (imonm > 0) CALL stoptime(timers,48)
7411 IF (imon>0) CALL stoptime(timers,6)
7412 ENDIF
7413
7414C-----------------------------------------------
7415C Multidomains : resynchronization of accelerations in SPH
7416C----------------------------------------------
7417 IF (nspmd>1) THEN
7418 IF ((sdd_r2r_elem>0).AND.(numsph_glo_r2r>0)) THEN
7419 lenr = nodes%BOUNDARY_ADD(1,nspmd+1)-nodes%BOUNDARY_ADD(1,1)
7420 CALL spmd_exch_r2r_sph(nodes%A,nodes%BOUNDARY_ADD,nodes%BOUNDARY,dd_r2r,dd_r2r_elem,lenr)
7421 ENDIF
7422 ENDIF
7423
7424C========================================================================================
7425C PARALLEL SECTION (SMP)
7426C========================================================================================
7427 IF (imon>0) CALL startime(timers,timer_io)
7428
7429 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7430
7431!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7432
7433 itsk = omp_get_thread_num()
7434 nodftsk = 1+itsk*numnod/ nthread
7435 nodltsk = (itsk+1)*numnod/nthread
7436
7437C--- // ---------------------------------------
7438C OUTPUT (ANIM,OUTP,H3D,TH) STEP 2 ON 3 TO GET FREAC/MREAC
7439C additional forces
7440C when called with iflag=1 it will add (Fgrav+Fbcs_cyclic+Fcentrif)
7441C-----------------------------------------------
7442 iflag = -1
7443 CALL reaction_forces_2(nodftsk,nodltsk,nodes%A,nodes%AR,nodes%MS,nodes%IN,freac,iflag)
7444
7445!$omp END parallel
7446
7447 END IF
7448
7449 IF (imon>0) CALL stoptime(timers,timer_io)
7450 CALL python_update_nodal_entities(numnod,nodes,a=nodes%A,v=nodes%V,ar=nodes%AR,vr=nodes%VR)
7451
7452C------------------------------
7453C GRAVITE / ACCEL. BASE
7454C------------------------------
7455 IF(ngrav/=0.AND.idtmins==0.AND.idtmins_int==0) THEN
7456 IF (imon>0) CALL startime(timers,timer_kin)
7457 IF (imonm > 0) CALL startime(timers,46)
7458
7459C========================================================================================
7460C PARALLEL SECTION (SMP)
7461C========================================================================================
7462
7463!$OMP PARALLEL PRIVATE(ITSK)
7464 itsk = omp_get_thread_num()
7465 IF(multi_fvm%IS_USED)THEN
7466 CALL gravit_fvm_fem(
7467 1 igrv ,agrv ,npc ,tf ,nodes%A ,
7468 2 nodes%V ,nodes%X ,skews%SKEW ,nodes%MS ,sensors%SENSOR_TAB,
7469 3 nodes%WEIGHT ,lgrav ,itsk ,ale_connectivity%NALE,nsensor, python, output%TH%WFEXT)
7470 ELSE
7471 CALL gravit(
7472 1 igrv ,agrv ,npc ,tf ,nodes%A ,
7473 2 nodes%V ,nodes%X ,skews%SKEW ,nodes%MS ,sensors%SENSOR_TAB,
7474 3 nodes%WEIGHT ,lgrav ,itsk ,nsensor, python, output%TH%WFEXT)
7475 ENDIF
7476!$OMP END PARALLEL
7477
7478C========================================================================================
7479C NON PARALLEL SECTION (SMP)
7480C========================================================================================
7481
7482C----------------------
7483C GRAVITY FLEXIBLE BODIES
7484C----------------------
7485 IF (nfxbody>0) THEN
7486 CALL fxgrvcor(fxbipm, fxbgrvi, nodes%A, igrv, agrv,
7487 . npc, tf, nodes%MS, nodes%V , skews%SKEW,
7488 . fxbgrw, nodes%BOUNDARY_ADD, nodes%BOUNDARY, output%TH%WFEXT, python)
7489 END IF
7490 IF (imon>0) CALL stoptime(timers,46)
7491 IF (imonm > 0) CALL stoptime(timers,timer_kin)
7492 ENDIF
7493C----------------------
7494C /BCS/CYCLIC
7495C----------------------
7496 IF(nbcscyc > 0)THEN
7497 CALL bcscyc(ibcscyc,lbcscyc,skews%SKEW,nodes%X,nodes%V,nodes%A,nodes%ITAB)
7498 ENDIF
7499C----------------------
7500C CENTRIFUGAL FORCES
7501C----------------------
7502 IF (nloadc>0) THEN
7503 IF (imon>0) CALL startime(timers,timer_kin)
7504
7505C========================================================================================
7506C PARALLEL SECTION (SMP)
7507C========================================================================================
7508
7509!$OMP PARALLEL PRIVATE(ITSK)
7510 itsk = omp_get_thread_num()
7511 CALL cfield_1(python,icfield ,cfield,npc ,tf ,nodes%A,
7512 2 nodes%V ,nodes%X ,xframe ,nodes%MS,sensors%SENSOR_TAB,
7513 3 nodes%WEIGHT,lcfield,itsk ,iframe,nsensor, output%TH%WFEXT)
7514!$OMP END PARALLEL
7515
7516 IF (imon>0) CALL stoptime(timers,timer_kin)
7517 ENDIF
7518
7519C========================================================================================
7520C PARALLEL SECTION (SMP)
7521C========================================================================================
7522
7523 IF (imon>0) CALL startime(timers,timer_io)
7524
7525 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7526
7527!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7528
7529 itsk = omp_get_thread_num()
7530 nodftsk = 1+itsk*numnod/ nthread
7531 nodltsk = (itsk+1)*numnod/nthread
7532
7533C--- // ---------------------------------------
7534C OUTPUT (ANIM,OUTP,H3D,TH) STEP 2 ON 3 TO GET FREAC/MREAC
7535C additional forces
7536C FREAC is now : FEXT+FINT + (Fgrav+Fbcs_cyclic+Fcentrif)
7537C-----------------------------------------------
7538 iflag = 1
7539 CALL reaction_forces_2(nodftsk,nodltsk,nodes%A,nodes%AR,nodes%MS,nodes%IN,freac,iflag)
7540
7541!$OMP END PARALLEL
7542
7543 END IF
7544
7545 IF (imon>0) CALL stoptime(timers,timer_io)
7546
7547C========================================================================================
7548C PARALLEL SECTION (SMP)
7549C========================================================================================
7550
7551C-----------------------------------------------
7552C EXTERNAL FORCES ADDITIONAL CONTRIBUTIONS before adding in A other kinematic conditions (BCS, ...)
7553C (ANIM, OUTP, H3D)
7554C-----------------------------------------------
7555 IF (imon>0) CALL startime(timers,timer_io)
7556!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7557 itsk = omp_get_thread_num()
7558 nodftsk = 1+itsk*numnod/ nthread
7559 nodltsk = (itsk+1)*numnod/nthread
7560 CALL forani3(fani,nodes%A,nodes%MS,nfea,nodftsk,nodltsk,h3d_data)
7561!$OMP END PARALLEL
7562 IF (imon>0) CALL stoptime(timers,timer_io)
7563
7564C========================================================================================
7565C NON PARALLEL SECTION (SMP)
7566C========================================================================================
7567
7568C----------------------
7569C INTERFACE ALE
7570C----------------------
7571 ierr=0
7572 IF(ninter/=0.AND.iale/=0)THEN
7573 IF(ispmd==0)THEN
7574 IF (imon>0) THEN
7575 CALL startime(timers,6)
7576 CALL startime(timers,timer_contsort)
7577 ENDIF
7578 CALL intal1(ipari ,nodes%X ,nodes%V ,
7579 2 nodes%A ,nodes%ISKEW ,skews%SKEW ,nodes%ICODT,wa,
7580 3 nodes%MS ,nodes%ITAB ,fsav ,interfaces%INTBUF_TAB ,
7581 4 fani ,fani(1,nfnca+1) ,h3d_data )
7582 IF (imon>0) THEN
7583 CALL stoptime(timers,timer_contsort)
7584 CALL stoptime(timers,6)
7585 ENDIF
7586 ENDIF
7587 IF(nspmd > 1)THEN
7588 ! transmit updated values on domain ispmd=0 to other domains (values may be used by parallelized ebcs options)
7589 call spmd_xv_inter_type1(numnod, nodes%BOUNDARY_SIZE, ispmd, nspmd, nodes%BOUNDARY_ADD, nodes%BOUNDARY,
7590 1 nodes%a, nodes%v, ninter, ipari, npari)
7591 ENDIF
7592 ENDIF
7593 IF(ierr == 1)CALL arret(2)
7594
7595 IF(ninter /= 0 .and. iale+ieuler /= 0 .and. int18kine == -1)THEN
7596C========================================================================================
7597C PARALLEL SECTION (SMP)
7598C========================================================================================
7599!$OMP PARALLEL PRIVATE(ITSK)
7600 itsk = omp_get_thread_num()
7601C /---------------/
7602 CALL my_barrier
7603C /---------------/
7604 CALL i18main_kine_2(ipari,interfaces%INTBUF_TAB,nodes%X ,nodes%V ,
7605 2 nodes%A ,nodes%ISKEW,skews%SKEW ,nodes%ICODT,wa,
7606 3 nodes%MS ,nodes%ITAB ,fsav ,itsk+1,kinet,
7607 4 nodes%STIFN,mtf ,cand_sav,fani,int18add,
7608 5 nodes%BOUNDARY_ADD,nodes%BOUNDARY,h3d_data )
7609!$OMP END PARALLEL
7610 ENDIF
7611C========================================================================================
7612C NON PARALLEL SECTION (SMP)
7613C========================================================================================
7614
7615C----------------------
7616C Activating valve (in/out or imposed velocity)
7617C----------------------
7618
7619 IF(ebcs_tab%nebcs_loc>0)THEN
7620 IF (imon>0) THEN
7621 CALL startime(timers,6)
7622 CALL startime(timers,timer_contsort)
7623 END IF
7624 IF(ispmd == 0)THEN
7625 CALL ebcclap(nodes%V,nodes%A,fv,ebcs_tab)
7626 ENDIF
7627 IF (imon>0) THEN
7628 CALL stoptime(timers,timer_contsort)
7629 CALL stoptime(timers,6)
7630 END IF
7631 ENDIF
7632
7633C----- // ----------------------
7634C BOUNDARY CONDITIONS
7635C-------------------------------
7636 IF (imon>0) CALL startime(timers,timer_kin)
7637 IF (imonm > 0) CALL startime(timers,42)
7638
7639 CALL thbcs(nodft ,nodlt ,nodes%ICODT ,nodes%ICODR,nodes%ISKEW,
7640 2 skews%SKEW ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
7641 3 fthreac,nodreac,cptreac)
7642
7643C========================================================================================
7644C PARALLEL SECTION (SMP)
7645C========================================================================================
7646
7647!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7648 itsk = omp_get_thread_num()
7649 nodftsk = 1+itsk*numnod/ nthread
7650 nodltsk = (itsk+1)*numnod/nthread
7651 CALL bcs10(nodftsk,nodltsk ,nodes%ICODT ,nodes%ICODR,nodes%ISKEW,
7652 2 skews%SKEW ,nodes%A ,nodes%AR ,nodes%MS ,nodes%V ,
7653 3 nodes%VR )
7654C---
7655
7656 IF(iplybcs > 0 .AND. iplyxfem > 0 )
7657 . CALL ply_bcs(nodftsk, nodltsk,icodt_ply,iskew_ply,skews%SKEW,
7658 . inod_pxfem,ms_ply,ibc_ply)
7659!$OMP END PARALLEL
7660
7661 IF (imonm > 0) THEN
7662 CALL stoptime(timers,42)
7663 CALL startime(timers,43)
7664 END IF
7665C========================================================================================
7666C PARALLEL SECTION (SMP)
7667C========================================================================================
7668C-------------------
7669C [RLINK1][RLINK2]... (ON FREE TASK)
7670C [RIVETS] -
7671C [JOINT1][JOINT2]... -
7672
7673!$OMP PARALLEL PRIVATE(ITSK)
7674 itsk = omp_get_thread_num()
7675
7676C-----------------------------------
7677C RIGID LINKS BETWEEN NODES
7678C---- // ----------------------------
7679 IF(nrlink>0)CALL rlink10(
7680 1 nodes%MS ,nodes%IN ,nodes%A ,nodes%AR ,nodes%V ,
7681 2 nodes%VR ,ilink ,llink,skews%SKEW,fr_rl,
7682 3 nodes%WEIGHT,frl6)
7683 IF(nlink>0) CALL rlink11(
7684 1 nodes%MS ,nodes%IN ,nodes%A ,nodes%AR ,nodes%V ,
7685 2 nodes%VR ,nnlink,lnlink,skews%SKEW ,fr_ll,
7686 3 nodes%WEIGHT,fnl6 ,nodes%X ,xframe)
7687C---------------
7688C RIVETS
7689C---------------
7690 IF(nrivet>0) THEN
7691 CALL rivet1(
7692 + nodes%MS ,nodes%IN ,nodes%A ,nodes%AR,nodes%X ,
7693 + lrivet,rivet,geo,nodes%V ,nodes%VR,
7694 + itsk )
7695 ENDIF
7696
7697C-------------
7698C JOINTS
7699C-- // -----------
7700 IF(njoint>0) THEN
7701 CALL cjoint(nodes%A ,nodes%AR ,nodes%V ,nodes%VR,nodes%X ,
7702 2 fsav ,ljoint,nodes%MS,nodes%IN,iadcj,
7703 3 fr_cj,tag_lnk_sms(nrlink+nlink+1),itsk)
7704 ENDIF
7705
7706!$OMP END PARALLEL
7707
7708 IF (imon>0) CALL stoptime(timers,timer_kin)
7709 IF (imonm > 0) CALL stoptime(timers,43)
7710 ENDIF
7711C--------------------------- FIN CAS NON THERMIQUE PURE
7712
7713C========================================================================================
7714C PARALLEL SECTION (SMP)
7715C========================================================================================
7716
7717 IF (imon>0) CALL startime(timers,timer_io)
7718
7719!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7720 itsk = omp_get_thread_num()
7721 nodftsk = 1+itsk*numnod/ nthread
7722 nodltsk = (itsk+1)*numnod/nthread
7723C--- //-----------------------------------------
7724C SAVE FORCES FROM INITIAL STATE
7725C---------------------------------------
7726 IF(tt==zero.AND.(isigi==2.OR.isigi==4)) THEN
7727#include "vectorize.inc"
7728 DO i=nodftsk,nodltsk
7729 fzero(1,i)=-nodes%A(1,i)
7730 nodes%A(1,i)=zero
7731 fzero(2,i)=-nodes%A(2,i)
7732 nodes%A(2,i)=zero
7733 fzero(3,i)=-nodes%A(3,i)
7734 nodes%A(3,i)=zero
7735 ENDDO
7736 ENDIF
7737!$OMP END PARALLEL
7738
7739 IF (imon>0) CALL stoptime(timers,timer_io)
7740
7741C-----------------------------------------------
7742C DAMPING alpha M + beta K
7743C-----------------------------------------------
7744
7745 IF (ns10e>0.AND.(idamp/=0.OR.ndamp>0.OR.istat/=0)) THEN
7746 CALL s10getvdm(icnds10,nodes%V,vnd,vmd)
7747 END IF
7748
7749C========================================================================================
7750C PARALLEL SECTION (SMP)
7751C========================================================================================
7752
7753 IF (imon>0) CALL startime(timers,timer_io)
7754
7755 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7756
7757!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7758
7759 itsk = omp_get_thread_num()
7760 nodftsk = 1+itsk*numnod/ nthread
7761 nodltsk = (itsk+1)*numnod/nthread
7762
7763C--- // ---------------------------------------
7764C OUTPUT (ANIM,OUTP,H3D,TH) STEP 2 ON 3 TO GET FREAC/MREAC
7765C damping forces
7766C when called with iflag=1 it will add Fdamp
7767C-----------------------------------------------
7768 iflag = -1
7769 CALL reaction_forces_2(nodftsk,nodltsk,nodes%A,nodes%AR,nodes%MS,nodes%IN,freac,iflag)
7770
7771!$OMP END PARALLEL
7772
7773 END IF
7774
7775 IF (imon>0) CALL stoptime(timers,timer_io)
7776C-----------------------------------------------
7777 IF (imonm > 0) CALL startime(timers,52)
7778
7779!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7780
7781 itsk = omp_get_thread_num()
7782 nodftsk = 1+itsk*numnod/ nthread
7783 nodltsk = (itsk+1)*numnod/nthread
7784
7785 IF(idamp/=0)THEN
7786 IF (ns10e>0) THEN
7787 CALL damping(nodftsk,nodltsk,vmd,nodes%VR,nodes%A ,nodes%AR ,damp,nodes%MS,nodes%IN,
7788 . igrnod,3+iroddl*3,itsk,nodes%WEIGHT,nodes%TAG_S_RBY,output%TH%WFEXT)
7789 ELSE
7790 CALL damping(nodftsk,nodltsk,nodes%V ,nodes%VR,nodes%A ,nodes%AR ,damp,nodes%MS,nodes%IN,
7791 . igrnod,3+iroddl*3,itsk,nodes%WEIGHT,nodes%TAG_S_RBY,output%TH%WFEXT)
7792 END IF !(NS10E>0) THEN
7793 ELSEIF(ndamp>0)THEN
7794 IF(nrdamp==4)THEN
7795
7796!$OMP SINGLE
7797 CALL damping44(
7798 . 3+iroddl*3,nodes%V ,
7799 . nodes%VR ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
7800 . dampr ,damp ,igrnod ,nodes%WEIGHT ,nodes%TAG_S_RBY ,output%TH%WFEXT)
7801!$OMP END SINGLE
7802
7803 ELSE
7804
7805!$OMP SINGLE
7806 IF (ns10e>0) THEN
7807 CALL damping51(
7808 . 3+iroddl*3,vmd ,
7809 . nodes%VR ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
7810 . dampr ,damp ,igrnod ,nodes%WEIGHT ,nodes%TAG_S_RBY,
7811 . skews%SKEW ,icontact,idamp_rdof_tab ,ndamp_vrel,id_damp_vrel,
7812 . fr_damp_vrel,iparit,ispmd,output%TH%WFEXT)
7813 ELSE
7814 CALL damping51(
7815 . 3+iroddl*3,nodes%V ,
7816 . nodes%VR ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
7817 . dampr ,damp ,igrnod ,nodes%WEIGHT ,nodes%TAG_S_RBY,
7818 . skews%SKEW ,icontact,idamp_rdof_tab ,ndamp_vrel,id_damp_vrel,
7819 . fr_damp_vrel,iparit,ispmd,output%TH%WFEXT)
7820 END IF
7821!$OMP END SINGLE
7822
7823 END IF
7824 END IF
7825
7826!$OMP END PARALLEL
7827
7828 IF(imon>0) CALL stoptime(timers,52)
7829C-----------------------------------------------
7830 IF (imon>0) CALL startime(timers,timer_io)
7831
7832 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7833
7834!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7835
7836 itsk = omp_get_thread_num()
7837 nodftsk = 1+itsk*numnod/ nthread
7838 nodltsk = (itsk+1)*numnod/nthread
7839
7840C--- // ---------------------------------------
7841C OUTPUT (ANIM,OUTP,H3D,TH) STEP 2 ON 3 TO GET FREAC/MREAC
7842C damping forces
7843C FREAC is now : (FEXT+FINT) + (Fgrav+Fbcs_cyclic+Fcentrif) + (Fdamp)
7844C-----------------------------------------------
7845 iflag = 1
7846 CALL reaction_forces_2(nodftsk,nodltsk,nodes%A,nodes%AR,nodes%MS,nodes%IN,freac,iflag)
7847
7848!$OMP END PARALLEL
7849
7850 END IF
7851
7852 IF (imon>0) CALL stoptime(timers,timer_io)
7853
7854C========================================================================================
7855C PARALLEL SECTION (SMP)
7856C========================================================================================
7857
7858 IF (imon>0) CALL startime(timers,timer_io)
7859
7860 IF(cptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7861
7862!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7863
7864 itsk = omp_get_thread_num()
7865 nodftsk = 1+itsk*numnod/ nthread
7866 nodltsk = (itsk+1)*numnod/nthread
7867
7868C--- // ---------------------------------------
7869C /TH/NODE (REAC) FIRST CALL WITH IFLAG=-1
7870C imposed loads
7871C-----------------------------------------------
7872 iflag = -1
7873 CALL reaction_forces_th(nodftsk,nodltsk ,nodes%A ,nodes%AR ,nodes%MS ,
7874 . nodes%IN ,fthreac ,iflag,nodreac)
7875
7876!$OMP END PARALLEL
7877
7878 END IF
7879
7880 IF (imon>0) CALL stoptime(timers,timer_io)
7881
7882C========================================================================================
7883C NON PARALLEL SECTION (SMP)
7884C========================================================================================
7885
7886C--------------------------
7887C STATIC
7888C--------------------------
7889 IF(istat/=0) THEN
7890 IF (imon>0) CALL startime(timers,6)
7891 IF (imonm > 0) CALL startime(timers,49)
7892 IF (ns10e>0) THEN
7893 CALL static(vmd ,nodes%VR,nodes%A,nodes%AR,nodes%MS,nodes%IN,igrnod,nodes%WEIGHT_MD,output%TH%WFEXT)
7894 ELSE
7895 CALL static(nodes%V,nodes%VR,nodes%A,nodes%AR,nodes%MS,nodes%IN,igrnod,nodes%WEIGHT_MD,output%TH%WFEXT)
7896 END IF
7897 IF (imonm > 0) CALL stoptime(timers,49)
7898 IF (imon>0) CALL stoptime(timers,6)
7899 ENDIF
7900 encin = zero
7901 enrot = zero
7902 encin2 = zero
7903 enrot2 = zero
7904C--------------------------
7905C IMPOSED VELOCITIES & DISPLACEMENTS
7906C--------------------------
7907 IF(nfxvel/=0) THEN
7908 IF(imon>0) THEN
7909 CALL startime(timers,6)
7910 CALL startime(timers,timer_kin)
7911 IF(imonm > 0) CALL startime(timers,44)
7912 ENDIF
7913 CALL fixvel(ibfv ,nodes%A ,nodes%V ,npc ,tf ,
7914 2 vel ,nodes%MS ,nodes%X ,skews%SKEW ,nodes%AR ,
7915 3 nodes%VR ,nodes%IN ,nsensor,sensors%SENSOR_TAB,
7916 4 nodes%WEIGHT,nodes%D ,rby ,iframe ,
7917 5 xframe,nodes%DR ,ptr_sms, nodes,
7918 6 tt_double,nodes%DDP,python ,output%TH%WFEXT)
7919
7920 IF (fxvel_fgeo ==1) THEN
7921 CALL fixfingeo(python, nodes, ibfv ,npc ,tf ,
7922 2 vel ,sensors%SENSOR_TAB ,
7923 3 cptreac,nodreac,ptr_sms,nsensor ,
7924 4 fthreac, output%TH%WFEXT )
7925 ENDIF
7926C
7927 IF(imon>0) THEN
7928 IF(imonm > 0) CALL stoptime(timers,44)
7929 CALL stoptime(timers,timer_kin)
7930 CALL stoptime(timers,6)
7931 ENDIF
7932 ENDIF
7933
7934C========================================================================================
7935C PARALLEL SECTION (SMP)
7936C========================================================================================
7937
7938 IF (imon>0) CALL startime(timers,timer_io)
7939
7940 IF(cptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
7941
7942!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
7943
7944 itsk = omp_get_thread_num()
7945 nodftsk = 1+itsk*numnod/ nthread
7946 nodltsk = (itsk+1)*numnod/nthread
7947
7948C--- // ---------------------------------------
7949C /TH/NODE (REAC) SECOND CALL WITH IFLAG=+1
7950C imposed loads
7951C----------------------------------------------
7952 iflag = 1
7953 CALL reaction_forces_th(nodftsk,nodltsk ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,fthreac ,iflag,nodreac)
7954
7955!$OMP END PARALLEL
7956
7957 END IF
7958
7959 IF (imon>0) CALL stoptime(timers,timer_io)
7960
7961C========================================================================================
7962C PARALLEL SECTION (SMP)
7963C========================================================================================
7964
7965 IF (imon>0) CALL startime(timers,timer_kin)
7966 IF (imonm > 0) CALL startime(timers,43)
7967
7968!$OMP PARALLEL
7969
7970C-------------------
7971C RIGID WALL
7972C---- // -----------
7973 IF(nrwall>0.AND.idtmins==1)THEN
7974C
7975C Obsolete
7976 ELSEIF(nrwall>0.AND.(idtmins==2.OR.idtmins_int/=0))THEN
7977 CALL rgwal0(
7978 1 nodes%X ,nodes%A ,nodes%V ,rwbuf ,lprw,
7979 2 nprw ,nodes%MS ,fsav(1,ninter+1),fr_wall ,
7980 3 fani(1,1+nfoa+2*(nsect+nrbody)),
7981 4 rwsav ,nodes%WEIGHT ,frwl6 ,nodxi_sms, nodes%WEIGHT_MD,
7982 5 sensors%SFSAV,sensors%FSAV,sensors%STABSEN,sensors%TABSENSOR, output%TH%WFEXT, output%TH%WFEXT_MD)
7983 ELSE
7984 CALL rgwal0(
7985 1 nodes%X ,nodes%A ,nodes%V ,rwbuf ,lprw,
7986 2 nprw ,nodes%MS ,fsav(1,ninter+1),fr_wall ,
7987 3 fani(1,1+nfoa+2*(nsect+nrbody)),
7988 4 rwsav ,nodes%WEIGHT ,frwl6 ,nativ_sms, nodes%WEIGHT_MD,
7989 5 sensors%SFSAV,sensors%FSAV,sensors%STABSEN,sensors%TABSENSOR, output%TH%WFEXT, output%TH%WFEXT_MD)
7990 ENDIF
7991
7992!$OMP END PARALLEL
7993
7994 IF (imon>0) CALL stoptime(timers,timer_kin)
7995 IF (imonm > 0) CALL stoptime(timers,43)
7996
7997C========================================================================================
7998C NON PARALLEL SECTION (SMP)
7999C========================================================================================
8000
8001C--------------------------
8002C IMPOSED TEMPERATURES
8003C--------------------------
8004 IF (glob_therm%NFXTEMP > 0 .AND. glob_therm%ITHERM_FE > 0) THEN
8005 IF (imon>0) THEN
8006 CALL startime(timers,6)
8007 CALL startime(timers,timer_kin)
8008 IF(imonm > 0) CALL startime(timers,44)
8009 ENDIF
8010 CALL fixtemp(python,ibftemp ,fbftemp ,nodes%TEMP ,npc ,tf ,
8011 1 nsensor ,sensors%SENSOR_TAB,glob_therm,snpc)
8012 IF (imon>0) THEN
8013 IF(imonm > 0) CALL stoptime(timers,44)
8014 CALL stoptime(timers,timer_kin)
8015 CALL stoptime(timers,6)
8016 ENDIF
8017 ENDIF
8018C---------------
8019 IF(isecut/=0)THEN
8020 IF (imon>0) CALL startime(timers,timer_io)
8021 CALL section_io (
8022 1 nstrf,nodes%D,nodes%DR,nodes%V,nodes%VR,fsav(1,1+ninter+nrwall+nrbody),
8023 2 secfcum,nodes%A ,nodes%AR ,secbuf,nodes%MS ,nodes%IN ,
8024 3 nodes%X ,fani(1,nfoa+1),nodes%WEIGHT,xsec ,nodes%BOUNDARY_ADD,nodes%BOUNDARY,
8025 4 rg_cut ,iad_cut ,fr_cut,nodes%WEIGHT_MD,ioldsect,
8026 5 sensors%STABSEN,sensors%SFSAV,sensors%TABSENSOR ,sensors%FSAV ,output%TH%WFEXT )
8027 IF(imon>0) CALL stoptime(timers,timer_io)
8028 ENDIF
8029
8030C-----------------------------------------------------
8031c adaptive meshing + static condensation : velocities on static nodes.
8032C-----------------------------------------------------
8033
8034C========================================================================================
8035C PARALLEL SECTION (SMP)
8036C========================================================================================
8037
8038 IF(istatcnd/=0)THEN
8039 IF (imon>0) CALL startime(timers,38)
8040!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
8041 itsk = omp_get_thread_num()
8042 nodftsk = 1+itsk*numnod/ nthread
8043 nodltsk = (itsk+1)*numnod/nthread
8044 CALL cndint(element%SHELL%IXC, ipart(k3), ixtg, ipart(k8), ipart,
8045 2 itsk ,nodes%A ,nodes%V ,nodes%AR ,nodes%VR ,
8046 3 nodes%MS ,nodes%IN ,nodftsk,nodltsk ,nodes%X ,
8047 4 sh4tree,sh3tree ,nodes%ITAB ,nodes%STIFN ,nodes%STIFR ,
8048 5 mscnd ,incnd )
8049!$OMP END PARALLEL
8050
8051 IF (imon>0) CALL stoptime(timers,38)
8052C
8053C reimpose bcs.
8054 IF (imon>0) CALL startime(timers,timer_kin)
8055 IF (imonm > 0) CALL startime(timers,42)
8056
8057C========================================================================================
8058C PARALLEL SECTION (SMP)
8059C========================================================================================
8060
8061!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
8062
8063 itsk = omp_get_thread_num()
8064 nodftsk = 1+itsk*numnod/ nthread
8065 nodltsk = (itsk+1)*numnod/nthread
8066
8067 CALL bcs10(nodftsk,nodltsk ,nodes%ICODT ,nodes%ICODR,nodes%ISKEW,
8068 2 skews%SKEW ,nodes%A ,nodes%AR ,nodes%MS ,nodes%V ,
8069 3 nodes%VR )
8070
8071!$OMP END PARALLEL
8072
8073 IF (imonm > 0) CALL stoptime(timers,42)
8074 IF (imon>0) CALL stoptime(timers,timer_kin)
8075 END IF
8076
8077
8078C-----------------------------------------------------
8079C adaptive meshing : velocities on secnd nodes
8080C-----------------------------------------------------
8081
8082 IF(nadmesh/=0)THEN
8083 IF (imon>0) CALL startime(timers,38)
8084
8085C========================================================================================
8086C PARALLEL SECTION (SMP)
8087C========================================================================================
8088
8089!$OMP PARALLEL PRIVATE(ITSK)
8090 itsk = omp_get_thread_num()
8091
8092 CALL admvit(element%SHELL%IXC, ipart(k3), ixtg, ipart(k8), ipart,
8093 1 itsk ,nodes%A , nodes%V , nodes%AR , nodes%VR ,
8094 2 sh4tree,sh3tree ,nodes%TEMP ,glob_therm%ITHERM_FE)
8095
8096!$OMP END PARALLEL
8097
8098 IF (imon>0) CALL stoptime(timers,38)
8099 END IF
8100
8101C--------------------------------------------------
8102c rigid bodies velocities on secondary nodes
8103C--------------------------------------------------
8104 IF(nrbykin>0)THEN
8105
8106 IF(imon>0) CALL startime(timers,timer_kin)
8107 IF(imonm > 0) CALL startime(timers,40)
8108
8109C========================================================================================
8110C PARALLEL SECTION (SMP)
8111C========================================================================================
8112
8113C----------------------------
8114C CALCUL //
8115C [NRBODY1][NRBODY2]... (ON FREE TASK)
8116C // --------------------------
8117
8118!$OMP PARALLEL
8119
8120 CALL rbyvit(
8121 1 rby ,nodes%X ,nodes%V ,nodes%VR ,skews%SKEW ,
8122 2 fsav ,lpby ,npby ,nodes%ISKEW,nodes%ITAB ,
8123 3 nodes%WEIGHT ,nodes%A ,nodes%AR ,nodes%MS ,nodes%IN ,
8124 4 kindrby,irbkin_l,nrbykin_l,nodreac,fthreac,
8125 5 freac )
8126
8127!$OMP END PARALLEL
8128
8129C--------------------------------------------------
8130 IF(imon>0) CALL stoptime(timers,timer_kin)
8131 IF(imonm > 0) CALL stoptime(timers,40)
8132
8133 ENDIF
8134C---------------------------------------------------
8135C rigid material
8136C--------------------------------------------------
8137C
8138 IF(irigid_mat > 0 ) THEN
8139
8140C========================================================================================
8141C PARALLEL SECTION (SMP)
8142C========================================================================================
8143
8144!$OMP PARALLEL
8145
8146 CALL rmatacce(rbym , arbym, arrbym, vrbym, vrrbym ,
8147 1 irbym,lnrbym,nodes%X ,nodes%A ,nodes%AR ,
8148 2 nodes%V ,nodes%VR ,kindrbym)
8149
8150!$OMP END PARALLEL
8151
8152 ENDIF
8153
8154C========================================================================================
8155C NON PARALLEL SECTION (SMP)
8156C========================================================================================
8157
8158C--------------------------------------------------
8159C Flexible bodies solution and velocities on secondary nodes
8160C--------------------------------------------------
8161 IF (nfxbody>0) THEN
8162 CALL fxbyvit(fxbipm, fxbnod, fxbmod, fxbglm, fxblm ,
8163 . fxbmvn, fxbmcd, fxbse , fxbsv , fxbvit,
8164 . fxbacc, fxbrpm, nodes%V , nodes%VR , nodes%A ,
8165 . nodes%AR , nodes%MS , nodes%IN , nodes%WEIGHT, fsav ,
8166 . fxbfc , fxbedp, nodes%BOUNDARY_ADD, nodes%BOUNDARY)
8167 END IF
8168C--------------------
8169C RBE3
8170C--------------------
8171 IF (nrbe3>0) THEN
8172 CALL rbe3v(rbe3,nodes,skews%SKEW )
8173 ENDIF
8174C--------------------
8175C RBE2
8176C--------------------
8177 IF (nrbe2>0) THEN
8178 IF (itask==0) THEN
8179 CALL rbe2v(irbe2 ,lrbe2 ,nodes%X ,nodes%A ,nodes%AR ,
8180 1 nodes%V ,nodes%VR ,skews%SKEW )
8181 ENDIF
8182 ENDIF
8183C--------------------------------------------------
8184C DAA normal accelerations
8185C--------------------------------------------------
8186 IF (nflow>0) CALL flow1(iflow, rflow, nbgauge, nodes%A)
8187
8188C========================================================================================
8189C DOMAIN 0
8190C========================================================================================
8191
8192 IF (ispmd==0) THEN
8193C------------------------
8194C INTERFACES 14 & 15
8195C--- //0 ----------------
8196 IF(ninter/=0)THEN
8197 IF (imon>0) THEN
8198 CALL startime(timers,timer_contsort)
8199 ENDIF
8200 CALL i14wfs(output,ipari,interfaces%INTBUF_TAB,igrsurf,fsav)
8201 IF (imon>0) THEN
8202 CALL stoptime(timers,timer_contsort)
8203 ENDIF
8204 ENDIF
8205 ENDIF
8206C----
8207 IF (ns10e>0) CALL s10cndi2a(icnds10 ,itagnd ,nodes%A )
8208C------------------------
8209C INTERFACES TIED
8210C--- //0 ----------------
8211
8212 IF(ninter/=0)THEN
8213 IF (imon>0) THEN
8214 CALL startime(timers,6)
8215 CALL startime(timers,timer_contsort)
8216 ENDIF
8217 IF (imonm > 0) CALL startime(timers,28)
8218 DO k=nhin2,0,-1
8219 CALL intti2(ipari,nodes%X ,nodes%V ,nodes%A ,
8220 2 nodes%VR ,nodes%AR ,k ,nodes%MS ,nodes%IN ,nodes%WEIGHT,wa,skews%SKEW,
8221 3 interfaces%INTBUF_TAB)
8222 ENDDO
8223 IF (imonm > 0) CALL stoptime(timers,28)
8224 IF (imon>0) THEN
8225 CALL stoptime(timers,timer_contsort)
8226 CALL stoptime(timers,6)
8227 ENDIF
8228 ENDIF
8229C
8230C-----------------------------------------------------
8231C KINEMATIC CONDITIONS FOR SEATBELTS
8232C-----------------------------------------------------
8233
8234 IF (nslipring + nretractor > 0) CALL kine_seatbelt_vel(nodes%A,nodes%V,nodes%X,nodes%XDP)
8235C
8236C-----------------------------------------------------
8237
8238 IF (ns10e>0) CALL s10cndi2a1(icnds10 ,itagnd ,nodes%A )
8239
8240 IF(numfram /= 0 .AND. n2d == 0)THEN
8241C----------------------------
8242C MOVING FRAME - RETRIEVE ACCELERATION.
8243C--- //0 ----------------
8244 IF (imon>0)CALL startime(timers,6)
8245 IF (imonm > 0) CALL startime(timers,49)
8246 CALL movfra1(xframe,iframe ,nodes%X, nodes%V ,nodes%A ,nodes%AR)
8247 IF (imonm > 0) CALL stoptime(timers,49)
8248 IF (imon>0)CALL stoptime(timers,6)
8249 ENDIF
8250
8251 IF (imon>0) CALL startime(timers,timer_kin)
8252 IF (imonm > 0) CALL startime(timers,40)
8253
8254 IF(numsph/=0.AND.nsphsol/=0)THEN
8255C------------------------
8256C Solids impose velocity to SPH
8257C--- // ----------------
8258 IF (imonm > 0) CALL startime(timers,48)
8259 IF (imonm > 0) CALL startime(timers,89)
8260
8261C========================================================================================
8262C PARALLEL SECTION (SMP)
8263C========================================================================================
8264
8265!$OMP PARALLEL PRIVATE(ITSK)
8266 itsk = omp_get_thread_num()
8267
8268 CALL soltospha(
8269 1 itsk ,nodes%V ,nodes%A ,nodes%MS ,pm ,
8270 2 ipart ,ixs ,ipart(k1) ,kxsp ,ipart(k10) ,
8271 3 irst ,spbuf ,partsav ,sol2sph ,iparg ,
8272 4 ngrounc ,igrounc ,elbuf_tab ,igeo)
8273
8274!$OMP END PARALLEL
8275
8276 IF (imonm > 0) CALL stoptime(timers,89)
8277 IF (imonm > 0) CALL stoptime(timers,48)
8278 ENDIF
8279
8280C========================================================================================
8281C PARALLEL SECTION (SMP)
8282C========================================================================================
8283
8284C--------------------
8285C ACCELEROMETRE
8286C-- // --------------
8287 IF (naccelm > 0) THEN
8288!$OMP PARALLEL DO PRIVATE(K,N,ISK)
8289 DO k=1,naccelm
8290C check that proc is concerned. Otherwise necessary exchange for sensor, th
8291 IF(iaccp(k)==ispmd+1)THEN
8292 n = laccelm(1,k)
8293 IF(n > 0 .AND. n/=2*numnodg )THEN
8294 isk= laccelm(3,k)
8295 CALL accel1(
8296 . nodes%A(1,n),accelm(1,k),accelm(2,k),accelm(8,k),accelm(14,k),
8297 . accelm(20,k),accelm(23,k),skews%SKEW(1,isk))
8298 END IF
8299 END IF
8300 ENDDO
8301C implicit barrier on end do
8302!$OMP END PARALLEL DO
8303
8304 END IF ! Fin NACCELM > 0
8305
8306C--------------------
8307C SPH Gauges
8308C-- // --------------
8309 IF (nbgauge > 0) THEN
8310!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(N)
8311 DO k=1,nbgauge
8312 IF(igaup(k)==ispmd+1)THEN
8313 n = lgauge(1,k)
8314C
8315C SPH Gauges
8316 IF(n < -(numels+numelq+numeltg))THEN
8317 CALL spgauge_f(
8318 . gauge(10,k),gauge(9,k),gauge(14,k),gauge(22,k),
8319 . gauge(30,k),4)
8320 END IF
8321 END IF
8322 ENDDO
8323C implicit barrier on end do
8324!$OMP END PARALLEL DO
8325
8326 END IF ! Fin NBGAUGE > 0
8327
8328C--------------------
8329C SPH Flow
8330C-- // --------------
8331 IF (nsphio > 0) THEN
8332!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(IVAD)
8333 DO k=1,nsphio
8334 IF (isphio(1,k)>1) THEN
8335 ivad = isphio(4,k)
8336 CALL spgauge_f(
8337 . vsphio(ivad+13),vsphio(ivad+15),vsphio(ivad+18),vsphio(ivad+20),
8338 . vsphio(ivad+16),1)
8339 END IF
8340 ENDDO
8341C implicit barrier on end do
8342!$OMP END PARALLEL DO
8343 END IF
8344
8345!$OMP PARALLEL
8346 IF(nrbykin>0)THEN
8347 CALL rbycor(
8348 1 rby ,nodes%X ,nodes%V ,nodes%VR ,skews%SKEW ,fsav ,
8349 2 lpby,npby,nodes%ISKEW,nodes%ITAB ,nodes%WEIGHT ,nodes%A ,
8350 3 nodes%AR ,nodes%MS ,nodes%IN ,kindrby,irbkin_l,nrbykin_l,
8351 4 nodes%WEIGHT_MD,ms_2d)
8352 ENDIF
8353C---------RBE2
8354 IF(nrbe2>0)THEN
8355C
8356 CALL rbe2cor(irbe2 ,lrbe2 ,nodes%X ,nodes%V ,nodes%VR ,
8357 2 skews%SKEW ,nodes%ISKEW ,nodes%ITAB ,nodes%WEIGHT,nodes%A ,
8358 3 nodes%AR ,nodes%MS0 ,nodes%IN ,nodes%WEIGHT_MD)
8359 ENDIF
8360!$OMP END PARALLEL
8361C========================================================================================
8362C NON PARALLEL SECTION (SMP)
8363C========================================================================================
8364
8365C------------------------------------------
8366C SYNCHRONIZATION: A V (FOR OUTPUTS)
8367C------------------------------------------
8368C SENSORS
8369C-- // --------------
8370C-----------------------------------------------
8371C Exchange SENSORS%FSAV for sensors 6-13
8372C-----------------------------------------------
8373 IF (nsensor> 0 ) THEN
8374 IF (nspmd > 1 .AND. sensors%STABSEN > 0) THEN
8375 dim6=12
8376 dim_exch = sensors%SFSAV
8377 CALL spmd_exsum_fb6(dim6,dim_exch,sensors%FSAV)
8378 ENDIF
8379 ENDIF
8380c
8381 IF (nsensor > 0) THEN
8382
8383 CALL sensor_ener_sav(nsensor,sensors%SENSOR_TAB,partsav ,partsav2)
8384
8385 ! pre-computation and mpi communication for type 16 sensor
8386 IF (sensors%COMM_SENS16%BOOL) THEN
8387 CALL sensor_dist_surf0(nsensor,sensors%SENSOR_TAB,nodes%X,
8388 * igrsurf,sensors%COMM_SENS16)
8389 ENDIF
8390
8391 ! pre-computation and mpi communication for type 17 sensor
8392 IF (sensors%COMM_SENS17%BOOL) THEN
8393 CALL sensor_temp0(nsensor,sensors%SENSOR_TAB,igrnod,nodes%TEMP,nodes%WEIGHT,sensors%COMM_SENS17,
8394 * sensors%SENSOR_STRUCT)
8395 ENDIF
8396
8397 IF (nspmd > 1) THEN
8398 CALL sensor_spmd(sensors%SENSOR_TAB,ipari ,nprw ,isensp ,nsensp ,
8399 . xsens ,nodes%X ,accelm ,iaccp ,naccp ,
8400 . gauge ,igaup ,ngaup ,partsav2 ,nsensor,
8401 . sensors%COMM_SENS14,sensors%SENSOR_STRUCT )
8402 ENDIF
8403c
8404 ! check activation condition of base sensors
8405 CALL sensor_base(sensors ,nsensor ,tt ,dt2 ,
8406 . xsens ,ipari ,partsav2 ,gauge ,fsav ,
8407 . nodes%X ,nodes%V ,nodes%A ,accelm ,nprw ,
8408 . subsets ,igrsurf ,igrnod ,python)
8409c
8410 ! check activation condition of logical sensor hierarchy
8411 CALL sensor_logical(sensors)
8412
8413 ENDIF ! NSENSOR > 0
8414C========================================================================================
8415
8416 IF (imonm > 0) CALL stoptime(timers,40)
8417 IF (imon>0) CALL stoptime(timers,timer_kin)
8418C-------------------------------------------------------
8419C Kinematic conditions by Lagrange Multipliers
8420C-------------------------------------------------------
8421
8422 IF(lag_ncf+lag_ncl>0)THEN
8423 l1 = 1+nixs*numels + nsvois*nixs
8424 l2 = l1+6*numels10
8425 l3 = l2+12*numels20
8426C case NSPMD == 1 and options supported only in SMP
8427 IF(lag_sec == 1 .AND. nspmd == 1)THEN
8428
8429C========================================================================================
8430C PARALLEL SECTION (SMP)
8431C========================================================================================
8432
8433!$OMP PARALLEL
8434!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
8435!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,GREFTSK,GRELTSK)
8436
8437C Init var parallel SMP
8438 CALL smp_init(
8439 1 itsk ,nodftsk ,nodltsk ,numntsk,ndtsk ,
8440 2 ipmtsk,partftsk,partltsk,nwaftsk,igmtsk ,
8441 3 greftsk,greltsk)
8442
8443 CALL lag_mult(
8444 1 ipari ,nodes%X ,nodes%A ,
8445 2 wa(nwaftsk),nodes%V ,nodes%MS ,nodes%IN ,nodes%VR ,
8446 3 itsk ,wa ,nodes%ITAB ,ixs ,ixs(l2) ,
8447 4 ixs(l3) ,igrnod ,fani ,fsav ,
8448 5 skews%SKEW ,nodes%AR ,lambda ,lagbuf ,ibcslag ,
8449 6 ixs(l1) ,gjbufi ,gjbufr ,ibmpc ,rbmpc ,
8450 7 npbyl ,lpbyl ,ibfv ,vel ,npc ,
8451 8 tf ,newfront ,icontact ,rwbuf ,lprw ,
8452 9 nprw ,rbyl ,nodes%D ,nodes%DR ,kinet ,
8453 a nsensor ,sensors%SENSOR_TAB,interfaces%INTBUF_TAB, h3d_data ,igrbric,
8454 b python,nodes)
8455
8456!$OMP END PARALLEL
8457
8458C========================================================================================
8459C NON PARALLEL SECTION (SMP)
8460C========================================================================================
8461
8462 ELSE
8463 IF(ispmd==0) THEN
8464 nbncl = fr_lagf(1,nspmd+1)
8465 nbikl = fr_lagf(2,nspmd+1)
8466 nbnodl = fr_lagf(3,nspmd+1)
8467 nbnodlr= nbnodl*max(1,iroddl)
8468 ELSE
8469 nbncl = fr_lagf(1,ispmd+1)
8470 nbikl = fr_lagf(2,ispmd+1)
8471 nbnodl=0
8472 nbnodlr=0
8473 END IF
8474 CALL lag_multp(
8475 1 ipari ,nodes%X ,nodes%A ,
8476 2 wa ,nodes%V ,nodes%MS ,nodes%IN ,nodes%VR ,
8477 3 wa ,nodes%ITAB ,ixs ,ixs(l2) ,
8478 4 ixs(l3) ,fani ,fsav ,
8479 5 skews%SKEW ,nodes%AR ,lambda ,lagbuf ,ibcslag ,
8480 6 ixs(l1) ,gjbufi ,gjbufr ,ibmpc ,rbmpc ,
8481 7 npbyl ,lpbyl ,ibfv ,vel ,npc ,
8482 8 tf ,newfront ,icontact ,rwbuf ,lprw ,
8483 9 nprw ,rbyl ,nodes%D ,nodes%DR ,kinet ,
8484 a nodes%NODGLOB ,nodes%WEIGHT ,nbncl ,nbikl ,nbnodl ,
8485 b nbnodlr ,fr_lagf ,llagf ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,
8486 c interfaces%INTBUF_TAB ,h3d_data, python, nodes)
8487 END IF
8488 ENDIF
8489c--------------
8490 111 CONTINUE
8491c--------------
8492
8493 ntmp = imconv
8494 IF (impdeb==1.AND.imconv==0) THEN
8495 IF (ncycle>=ndeb0.AND.ncycle<=ndeb1) THEN
8496 ttmp=ttmp+dtanim
8497 IF ((irad2r==1).AND.(iresp==1)) THEN
8498 tt_dp=tt_dp+ttmp
8499 tt = tt_dp
8500 ELSE
8501 ! double precision accumulation and then cast in simple precision
8502 tt_double = tt_double + ttmp
8503 IF (impl_s==1.OR.neig>0) THEN
8504 tt = tt + ttmp
8505 ELSE
8506 IF(iresp == 1)THEN
8507 tt = sngl(tt_double)
8508 ELSE
8509 tt = tt_double
8510 ENDIF
8511 ENDIF
8512 !TT=TT+TTMP
8513 ENDIF
8514 ntmp = 1
8515 ENDIF
8516 ENDIF
8517C--------------------------------------------------
8518 IF( ( anim_ce(2156)/=0 .OR. h3d_data%SH_SCAL_ERR_THK /=0)
8519 . .AND.((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.
8520 . (manim>=4.AND.manim<=15))) THEN
8521
8522C========================================================================================
8523C PARALLEL SECTION (SMP)
8524C========================================================================================
8525
8526!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
8527
8528 itsk = omp_get_thread_num()
8529 nodftsk = 1+itsk*numnod/ nthread
8530 nodltsk = (itsk+1)*numnod/nthread
8531
8532 CALL err_thk(element%SHELL%IXC ,ixtg ,iparg ,nodes%BOUNDARY_ADD,nodes%BOUNDARY ,
8533 . nodes%WEIGHT ,nodes%X ,elbuf_tab,ipart ,ipart(k3) ,
8534 . ipart(k8) ,itsk ,nodftsk ,nodltsk ,err_thk_sh4,
8535 . err_thk_sh3,sh4tree,sh3tree,
8536 . area_sh4, area_sh3, area_nod,
8537 . thick_sh4, thick_sh3, thick_nod)
8538
8539!$OMP END PARALLEL
8540
8541 END IF
8542
8543 k1=1+lipart1*(npart+nthpart)+2*9*(npart+nthpart)
8544 k2=k1+numels
8545 k3=k2+numelq
8546 k4=k3+numelc
8547 k5=k4+numelt
8548 k6=k5+numelp
8549 k7=k6+numelr
8550 k8=k7
8551 k9=k8+numeltg
8552 CALL funct_python_update_elements(python, ispmd,
8553 . n2d, ngroup, nixc, nixtg, nixs,nixq,
8554 . numgeo, numelc, numeltg, numels, numelq, nummat, numnod,
8555 . nparg, npropg, npropm, npropmi, npropgi,
8556 . snercvois, snesdvois, slercvois, slesdvois,
8557 . sthke, seani, npart,
8558 . elbuf_tab ,iparg ,geo ,
8559 . element%SHELL%IXC,ixtg, ixs ,ixq ,pm ,bufmat ,
8560 . eani,
8561 . ipm ,igeo ,thke ,err_thk_sh4 ,err_thk_sh3,
8562 . nodes ,w ,ale_connectivity,
8563 . nercvois ,nesdvois ,lercvois ,lesdvois,
8564 . m51_n0phas, m51_nvphas, stack ,
8565 . ipart(k3:k4-1),ipart(k1:k2-1) ,ipart(k8:k9-1),ipart(k1:k2-1),
8566 . multi_fvm ,
8567 . mat_elem%MAT_PARAM, fani_cell,glob_therm%ITHERM)
8568
8569
8570C
8571C========================================================================================
8572C PARALLEL SECTION (SMP)
8573C========================================================================================
8574 IF(ntmp==1)THEN
8575 IF(idtmins==1)THEN
8576C
8577C Obsolete
8578 ELSEIF(idtmins==2.OR.idtmins_int/=0)THEN
8579C--------------------------------------------------
8580 IF (imon>0) CALL startime(timers,39)
8581
8582!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
8583
8584 itsk = omp_get_thread_num()
8585 nodftsk = 1+itsk*numnod/ nthread
8586 nodltsk = (itsk+1)*numnod/nthread
8587
8588 CALL sms_encin_2(timers,
8589 1 itsk ,nodftsk ,nodltsk ,nodxi_sms ,
8590 2 nodes%MS ,jad_sms ,jdi_sms ,lt_sms ,indx1_sms,
8591 3 diag_sms ,nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nodes%WEIGHT ,nodes%V ,
8592 4 nodes%A ,x_sms ,y_sms ,z_sms ,xmom_sms ,
8593 5 nodes%ICODT ,nodes%ICODR ,nodes%ISKEW ,skews%SKEW ,ibfv ,
8594 6 vel ,npc ,tf ,nodes%X ,nodes%D ,
8595 7 sensors ,iframe ,xframe ,jadi_sms ,
8596 8 jdii_sms ,lti_sms ,iskyi_sms ,mskyi_sms ,fr_sms ,
8597 9 fr_rms ,npby ,tagslv_rby_sms,intstamp,cptreac,
8598 a nodreac ,fthreac ,nodes%AR ,nodes%VR ,
8599 b nodes%DR ,nodes%IN ,rby ,irbe2 ,lrbe2 ,
8600 c iad_rbe2 ,fr_rbe2m ,nmrbe2 ,r2size ,rbe3%IRBE3 ,
8601 d rbe3%LRBE3 ,rbe3%FRBE3 ,rbe3%mpi%IAD_RBE3,rbe3%mpi%FR_RBE3 ,rbe3%mpi%FR_RBE3MP ,
8602 e rbe3%RRBE3 ,rbe3%RRBE3_PON,iad_rby ,fr_rby6 ,rby6 ,
8603 f lpby ,tagmsr_rby_sms,rbe3%irotg_sz,nodii_sms,indx2_sms,
8604 g ibcscyc ,lbcscyc ,output, mskyi_fi_sms,list_sms,
8605 h list_rms ,sms_vfi,sz_mw6,mw6)
8606
8607!$OMP END PARALLEL
8608
8609 IF (imon>0) CALL stoptime(timers,39)
8610
8611 END IF
8612 END IF
8613C---
8614 nisky_sms=0
8615
8616C========================================================================================
8617C NON PARALLEL SECTION (SMP)
8618C========================================================================================
8619
8620 IF (icrack3d > 0 .AND. nlevset > 0) THEN
8621 CALL xfeoff(xfem_tab ,
8622 . iparg ,element%SHELL%IXC ,ngrouc ,igrouc ,iel_crk ,
8623 . elcutc ,ixtg ,iadc_crk ,nodes%BOUNDARY_ADD,iad_edge ,
8624 . fr_edge,fr_nbedge,nodes%BOUNDARY ,nxlaymax,inod_crk ,
8625 . crkedge,xedge4n ,xedge3n )
8626 ENDIF
8627
8628C========================================================================================
8629C PARALLEL SECTION (SMP)
8630C========================================================================================
8631
8632C-----------------------------
8633C FINITE VOLUME METHOD FOR ALE
8634C-----------------------------
8635
8636 IF(alefvm_param%IEnabled>0)THEN
8637!$OMP PARALLEL
8638!$OMP+ PRIVATE(ITSK,NODFTSK,NODLTSK,NUMNTSK,NDTSK,IPMTSK,IGMTSK)
8639!$OMP+ PRIVATE(PARTFTSK,PARTLTSK,NWAFTSK,DT2TT,NELTSTT,ITYPTSTT)
8640!$OMP+ PRIVATE(GREFTSK,GRELTSK)
8641
8642C Init var parallel SMP
8643 CALL smp_init(
8644 1 itsk , nodftsk , nodltsk , numntsk, ndtsk ,
8645 2 ipmtsk , partftsk, partltsk, nwaftsk, igmtsk ,
8646 3 greftsk, greltsk)
8647 dt2tt = dt2t
8648 neltstt = neltst
8649 ityptstt = ityptst
8650 IF(iparit == 1) ndtsk = 1
8651 CALL alefvm_main(
8652 1 nodes%X , nodes%V ,
8653 2 elbuf_tab , nodes%VR ,
8654 3 ale_connectivity , iparg , ixs ,
8655 4 ale_connectivity%NALE ,
8656 5 itsk ,nodftsk , nodltsk ,ipm , nv46 ,msnf )
8657
8658!$OMP END PARALLEL
8659 ENDIF
8660C========================================================================================
8661C PARALLEL SECTION (SMP)
8662C========================================================================================
8663
8664 IF (imon>0) CALL startime(timers,timer_io)
8665
8666 IF(comptreac/=0.AND.(impl_s==0 .OR. inconv==1)) THEN
8667
8668!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
8669
8670 itsk = omp_get_thread_num()
8671 nodftsk = 1+itsk*numnod/ nthread
8672 nodltsk = (itsk+1)*numnod/nthread
8673C--- // ---------------------------------------
8674C OUTPUT (ANIM,OUTP,H3D,TH) STEP 3 ON 3 TO GET FREAC/MREAC
8675C FREAC is now : FTOTAL - (FEXT+FINT) - (Fgrav+Fbcs_cyclic+Fcentrif) - (Fdamp)
8676C-----------------------------------------------
8677 CALL reaction_forces_3(nodftsk,nodltsk,nodes%A,nodes%AR,nodes%MS,nodes%IN,freac)
8678
8679!$OMP END PARALLEL
8680 END IF
8681
8682 IF (imon>0) CALL stoptime(timers,timer_io)
8683C========================================================================================
8684C PARALLEL SECTION (SMP)
8685C========================================================================================
8686 IF(ncycle > 0) THEN
8687
8688 IF (imon>0) CALL startime(timers,macro_timer_genh3d1)
8689 l1 = 1+nixs*numels + nsvois*nixs
8690 l2 = l1+6*numels10
8691 l3 = l2+12*numels20
8692!$omp parallel private(itsk,nodftsk,nodltsk)
8693c
8694 itsk = omp_get_thread_num()
8695C--------------------------------------------------
8696C /H3D/TMAX
8697C--------------------------------------------------
8698 CALL upd_tmax(elbuf_tab,iparg ,geo ,pm ,
8699 . ixs ,ixs(l1) ,ixs(l3) ,ixs(l2) ,ixq ,
8700 . element%SHELL%IXC ,ixtg ,ixt ,ixp ,ixr ,
8701 . nodes%X ,nodes%D ,nodes%V ,nodes%BOUNDARY_ADD,nodes%BOUNDARY ,
8702 . nodes%WEIGHT ,ipm ,igeo ,stack ,itsk )
8703
8704!$OMP END PARALLEL
8705 IF (imon>0) CALL stoptime(timers,macro_timer_genh3d1)
8706 END IF
8707
8708C========================================================================================
8709C NON PARALLEL SECTION (SMP)
8710C========================================================================================
8711C--------------------------------------------------
8712 IF(ntmp==1)THEN
8713C--------------------------------------------------
8714 IF (imon>0) THEN
8715 CALL startime(timers,timer_io)
8716 ENDIF
8717 CALL trace_in(5,0,zero)
8718 l1 = 1+nixs*numels + nsvois*nixs
8719 l2 = l1+6*numels10
8720 l3 = l2+12*numels20
8721C Do not stop yet
8722 IF (tt<=tstop.AND.ilastanim==3) THEN
8723 ilastanim=0
8724 END IF
8725 IF (tt<=tstop.AND.ilastdynain==3) THEN
8726 ilastdynain=0
8727 END IF
8728 IF (tt<=tstop.AND.ilasth3d==3) THEN
8729 ilasth3d=0
8730 END IF
8731C Regular animation
8732 IF ((tt>tanim .AND. tt<=tanim_stop).AND.ilastanim==0) THEN
8733 ilastanim=3
8734 lastanimcycle=ncycle
8735 END IF
8736
8737 IF (tt>tstat.AND.ilastanim==0) THEN
8738 ilastanim=3
8739 laststatcycle=ncycle
8740 END IF
8741 IF (tt>dynain_data%TDYNAIN.AND.ilastdynain==0) THEN
8742 ilastdynain=3
8743 lastdyncycle=ncycle
8744 END IF
8745 IF (tt>h3d_data%TH3D.AND.ilasth3d==0) THEN
8746 ilasth3d=3
8747 lasth3dcycle=ncycle
8748 END IF
8749
8750 IF(debug(macro_debug_chksm) >0) THEN
8751 IF(mod(ncycle,debug(macro_debug_chksm)) == 0 ) THEN
8752 CALL spmd_flush_accel(ncycle, ispmd, nspmd, numnod,
8753 . numnodg, numnodm, nodes%A, nodes%ITAB,
8754 . nodes%WEIGHT, nodes%NODGLOB)
8755 ENDIF
8756 ENDIF
8757
8758 IF(sh_offset_tab%NNSH_OSET > 0) THEN
8759 CALL assign_ptrx(ptrx, nodes%X,numnod)
8760 CALL assign_ptrx(ptrx_offset, xyz,numnod)
8761 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
8762 CALL assign_ptrx(ptrx, impbuf_tab%X_A,numnod)
8763 CALL assign_ptrx(ptrx_offset, xyz ,numnod)
8764 ELSE
8765 CALL assign_ptrx(ptrx, nodes%X,numnod)
8766 CALL assign_ptrx(ptrx_offset, nodes%X,numnod)
8767 ENDIF
8768
8769 CALL sortie_main(timers,
8770 1 pm ,nodes%D ,nodes%V ,ale_connectivity ,w ,
8771 2 elbuf ,iparg ,ixs ,ixq ,element%SHELL%IXC,
8772 3 ixt ,ixp ,ixr ,ixtg ,wa ,
8773 4 nodes%ITAB ,ptrx ,geo ,nodes%MS ,nodes%A ,
8774 5 fani ,partsav ,icut ,xcut ,
8775 6 fani(1,1+nfia),fani(1,1+nfea) ,fani(1,1+nfoa) ,anin ,lpby ,
8776 7 npby ,nstrf ,rwbuf ,nprw ,ebcs_tab ,
8777 8 tani ,inoise ,bufnois ,rby ,neflsw ,
8778 9 nnflsw ,crflsw ,flsw ,lout ,nodes ,
8779 b fsav ,skews%SKEW ,elbuf_tab ,cluster ,
8780 c nodes%VR ,nodes%IN ,nodes%WEIGHT ,fcluster ,mcluster ,
8781 d dd_iad ,dmas ,accelm ,gauge ,
8782 e ipari ,eani ,ipart ,mat_elem%MAT_PARAM ,
8783 f igrnod ,subsets ,
8784 g nom_opt ,nodes%AR ,igrsurf ,bufsf ,idata ,
8785 h rdata ,kxx ,ixx ,bufmat ,bufgeo ,
8786 i kxsp ,ixsp ,nod2sp ,spbuf ,nodes%DR,
8787 j fsavd ,lrivet ,rivet ,iskwn ,iframe ,
8788 m xframe ,ixs(l1) ,ixs(l2) ,ixs(l3) ,ndma ,
8789 n monvol ,volmon ,ipm ,igeo ,nodes%NODGLOB ,
8790 . nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,
8791 u fr_rby2 ,iad_rby2 ,fr_wall ,fr_sec ,fxbipm ,fxbrpm ,
8792 v ndin ,fxbdep ,fxbvit ,fxbacc ,iflow ,
8793 w rflow ,ipartl ,npartl ,iaccp ,naccp ,
8794 x fasolfr ,fani(1,nfnca+1),fani(1,nftca+1),ipart(i15ath) ,
8795 y fr_mv ,ipart_state ,sh4tree ,sh3tree ,nodes%TEMP ,
8796 z thke ,err_thk_sh4 ,err_thk_sh3,
8797 a inod_pxfem ,fthreac ,nodreac ,gresav ,
8798 b diag_sms ,sh4trim ,sh3trim ,fani(1,1+nft2) ,xmom_sms ,
8799 c irbe2 ,rbe3%IRBE3 ,lrbe2 ,rbe3%LRBE3 ,fr_rbe2 ,
8800 d rbe3%mpi%FR_RBE3 ,iad_rbe2 ,dxancg ,iel_pxfem ,zi_ply ,
8801 e vflow ,fcontg ,fncontg ,ftcontg ,freac ,
8802 f inod_crk ,iel_crk ,elcutc ,iadc_crk ,anin(ndama2+1),
8803 g res_sms ,sensors ,
8804 h qfricint ,igaup ,ngaup ,nodes%WEIGHT_MD ,ncont ,
8805 i indexcont ,nodglobxfe ,nodedge ,xfem_tab ,
8806 j nv46 ,rthbuf ,kxig3d ,ixig3d ,knot ,
8807 k wige ,nercvois ,nesdvois ,lercvois ,lesdvois ,
8808 l crkedge ,stack ,isphio ,vsphio ,nodes%ICODE ,
8809 m indx_crk ,xedge4n ,xedge3n ,sph2sol ,stifn_tmp ,
8810 n stifr_tmp ,drape_sh4n ,drape_sh3n ,ms_2d ,multi_fvm ,
8811 o segquadfr ,h3d_data ,nodes%ISKEW ,pskids ,iskwp ,
8812 p knotlocpc ,knotlocel ,pinch_data ,tag_skins6 ,irunn_bis ,
8813 q tf ,npc ,dynain_data ,fcont_max ,mds_matid ,
8814 r fani(1,nfnca2+1),fani(1,nftca2+1),ibcl ,iloadp ,lloadp ,
8815 s loadp ,tagncont ,loadp_hyd_inter,forc ,drapeg ,
8816 t user_windows ,output ,dt ,output%TH%TH_SURF%CHANNELS ,
8817 u table ,loads ,sfani ,iparit ,ptrx_offset ,
8818 v sz_npcont2 ,npcont2 ,glob_therm ,pblast ,output%TH%WFEXT)
8819
8820 IF((mstop == 1 .AND. ictlstop == 0) .OR. mstop == 2 .OR. dt2<=zero)THEN
8821 CALL sortie_error(
8822 1 nodes%V ,nodes%NODGLOB ,nodes%WEIGHT ,nodes%ITAB ,nodes%MS ,
8823 2 nodes%MS0 ,10 ,partsav ,ipart ,pm ,
8824 3 igeo )
8825 END IF
8826C
8827 CALL trace_out(5)
8828C-------ADYREL----
8829 IF (istat==3) CALL ener_w0
8830 IF(coupling%active) CALL coupling_advance(coupling,dt2)
8831C------------
8832C TEMPS
8833C------------
8834C ILASTANIM=0 No additional animation
8835C ILASTANIM=1 One more cycle needed
8836C ILASTANIM=2 Additional cycle done
8837C ILASTANIM=3 regular animation
8838 IF (ilastanim==1) THEN
8839 ilastanim=2
8840 END IF
8841 IF (ilasth3d==1) THEN
8842 ilasth3d=2
8843 END IF
8844 IF(t1s==tt)ncycle=ncycle+1
8845C-------> Multidomain single precision: double precision time scale----
8846 IF ((irad2r==1).AND.(iresp==1)) THEN
8847 tt_dp=tt_dp+dt2
8848 tt=tt_dp
8849 ELSE
8850 ! double precision accumulation and then cast in simple precision
8851 tt_double = tt_double + dt2
8852 IF (impl_s==1.OR.neig>0) THEN
8853 tt = tt + dt2
8854 ELSE
8855 IF(iresp == 1)THEN
8856 tt = sngl(tt_double)
8857 ELSE
8858 tt = tt_double
8859 ENDIF
8860 ENDIF
8861 ENDIF
8862C May do 1 more cycle to write animation if TT = TTANIM - 10%
8863 IF (imadcpl /= 1) THEN
8864 IF (dtanim>zero) THEN
8865 IF (tt>tstop.AND.ilastanim==0
8866 . .AND.abs((tt-tanim)/dtanim)<em03) THEN
8867 ilastanim=1
8868 tanim=tt-em10
8869 END IF
8870 IF (tt>tstop.AND.ilastanim==0.AND.
8871 . (ncycle-lastanimcycle)>=100) THEN
8872 ilastanim=1
8873 tanim=tt-em10
8874 END IF
8875 END IF
8876c
8877 IF (dtstat>zero) THEN
8878 IF (tt>tstop.AND.ilastanim==0
8879 . .AND.abs((tt-tstat)/dtstat)<em03) THEN
8880 ilastanim=1
8881 tstat=tt-em10
8882 END IF
8883 IF (tt>tstop.AND.ilastanim==0.AND.
8884 . (ncycle-laststatcycle)>=100) THEN
8885 ilastanim=1
8886 tstat=tt-em10
8887 END IF
8888 END IF
8889c
8890 IF (dynain_data%DTDYNAIN>zero) THEN
8891 IF (tt>tstop.AND.ilastdynain==0
8892 . .AND.abs((tt-dynain_data%TDYNAIN)/dynain_data%DTDYNAIN)<em03) THEN
8893 ilastdynain=1
8894 dynain_data%TDYNAIN=tt-em10
8895 END IF
8896 IF (tt>tstop.AND.ilastdynain==0.AND.
8897 . (ncycle-lastdyncycle)>=100) THEN
8898 ilastdynain=1
8899 dynain_data%TDYNAIN=tt-em10
8900 END IF
8901 END IF
8902c
8903 IF (h3d_data%DTH3D>zero) THEN
8904 IF (tt>tstop.AND.ilasth3d==0
8905 . .AND.abs((tt-h3d_data%TH3D)/h3d_data%DTH3D)<em03) THEN
8906 ilasth3d=1
8907 h3d_data%TH3D=tt-em10
8908 END IF
8909 IF (tt>tstop.AND.ilasth3d==0.AND.
8910 . (ncycle-lasth3dcycle)>=100) THEN
8911 ilasth3d=1
8912 h3d_data%TH3D=tt-em10
8913 END IF
8914 END IF
8915 ENDIF
8916C------------
8917 IF (imon>0) THEN
8918 CALL stoptime(timers,timer_io)
8919 ENDIF
8920 ENDIF
8921 IF (impdeb==1.AND.imconv==0) THEN
8922 IF (ncycle>=ndeb0.AND.ncycle<=ndeb1) THEN
8923 IF ((irad2r==1).AND.(iresp==1)) THEN
8924 tt_dp=tt_dp-ttmp-dt2
8925 tt=tt_dp
8926 ELSE
8927 ! double precision accumulation and then cast in simple precision
8928 tt_double = tt_double - ttmp - dt2
8929 IF (impl_s==1.OR.neig>0) THEN
8930 tt = tt - ttmp - dt2
8931 ELSE
8932 IF(iresp == 1)THEN
8933 tt = sngl(tt_double)
8934 ELSE
8935 tt = tt_double
8936 ENDIF
8937 ENDIF
8938 !TT=TT-TTMP-DT2
8939 ENDIF
8940 ENDIF
8941 ENDIF
8942C ---------------------------------
8943 CALL python_update_time(tt,dt2)
8944
8945C----------------------------------
8946C IMPLICIT SOLVER
8947C----------------------------------
8948 IF (impl_s==1) THEN
8949 CALL trace_in(3,ncycle,zero)
8950 IF (imon>0) CALL startime(timers,34)
8951
8952C========================================================================================
8953C PARALLEL SECTION (SMP)
8954C========================================================================================
8955
8956 IF (imp_chk > 0) THEN
8957 CALL imp_chkm(timers, python,
8958 1 nodes%ICODE ,nodes%ISKEW ,iskwn ,ipart ,ixtg ,ixs ,ixq ,
8959 2 element%SHELL%IXC,ixt ,ixp ,ixr ,ixtg1 ,nodes%ITAB ,nodes%ITABM1,
8960 3 npc ,ibcl ,ibfv ,sensors%SENSOR_TAB,nnlink ,lnlink ,iparg ,igrv,
8961 4 ipari ,interfaces%INTBUF_TAB,nprw ,iconx ,npby ,lpby ,lrivet ,
8962 5 nstrf ,ljoint,nodes%ICODT ,nodes%ICODR,interfaces%PON%ISKY,element%PON%ADSKY,element%PON%IAD_CONLD,
8963 6 ilink ,llink ,nodes%WEIGHT,itask ,ibvel ,lbvel ,fbvel,
8964 7 nodes%X ,nodes%D ,nodes%V ,nodes%VR ,nodes%DR ,thke ,damp ,nodes%MS,
8965 8 nodes%IN ,pm ,skews%SKEW ,geo ,eani ,bufmat ,bufgeo ,bufsf,
8966 9 tf ,forc ,vel ,fsav ,agrv ,fr_wave,parts0 ,
8967 a elbuf ,rby ,rivet ,nodes%BOUNDARY ,nodes%BOUNDARY_ADD ,nsensor ,
8968 b wa ,nodes%A ,nodes%AR ,nodes%STIFN ,nodes%STIFR,partsav,element%PON%FSKY,
8969 c interfaces%PON%FSKYI,iframe ,xframe ,w16 ,iactiv ,element%PON%FSKYM,igeo,ipm ,
8970 d output%TH%WFEXT ,nodft ,nodlt ,nt_imp ,num_imp ,ns_imp ,ne_imp,ind_imp,
8971 l it ,rwbuf ,lprw ,fr_wall ,nbintc ,intlist ,
8972 m fani(1,1+nfoa+2*(nsect+nrbody)),rwsav ,fsavd ,
8973 n dirul ,lgrav ,rbe3%IRBE3 ,rbe3%LRBE3 ,rbe3%FRBE3 ,
8974 o frwl6 ,irbe2 ,lrbe2 ,icfield ,lcfield ,cfield ,elbuf_tab,
8975 p nodes%WEIGHT_MD ,stack,sensors%SFSAV ,sensors%FSAV,sensors%STABSEN ,sensors%TABSENSOR ,drape_sh4n ,
8976 q drape_sh3n ,h3d_data ,nddl0 ,nnzk0 ,impbuf_tab ,cptreac,fthreac,nodreac ,
8977 r drapeg ,output%TH%TH_SURF ,dpl0cld ,vel0cld ,snpc ,stf , output%TH%WFEXT_MD,igrsurf)
8978 mstop=2
8979 ELSEIF ((tt<=tstop.OR.(tt-tstop)<em10).AND.ibuck==0) THEN
8980C-----integer : 1:IKC,2:IKUD,3:W_DDL,4:IADM,5:JDIM,6:NDOFI,7:IDDLI
8981C-----reel : 1,2,3,4:DIAG_K,LT_K,DIAG_M,LT_M,5,6:LB,DB,7:BKUD,8,9:D_IMP,DR_IMP
8982C---- 10,11,12:ELBUF_C,BUFMAT_C,X_C,13,14:DD,DDR,15,16:X_ac,V_zero,23,24:AC,ACR
8983#if defined(MUMPS5)
8984 CALL imp_solv(timers, python,
8985 1 nodes%ICODE ,nodes%ISKEW ,iskwn ,ipart ,ixtg ,ixs ,ixq ,
8986 2 element%SHELL%IXC ,ixt ,ixp ,ixr ,ixtg1 ,nodes%ITAB ,nodes%ITABM1 ,
8987 3 npc ,ibcl ,ibfv ,sensors%SENSOR_TAB,nnlink ,lnlink ,iparg ,igrv ,
8988 4 ipari ,interfaces%INTBUF_TAB,nprw ,iconx ,npby,lpby ,lrivet ,
8989 5 nstrf ,ljoint ,nodes%ICODT ,nodes%ICODR ,interfaces%PON%ISKY ,element%PON%ADSKY,element%PON%IAD_CONLD,
8990 6 ilink ,llink ,nodes%WEIGHT ,itask ,ibvel ,lbvel ,fbvel ,
8991 7 nodes%X ,nodes%D ,nodes%V ,nodes%VR ,nodes%DR ,thke ,damp ,nodes%MS ,
8992 8 nodes%IN ,pm ,skews ,geo ,eani ,bufmat ,bufgeo ,bufsf ,
8993 9 tf ,forc ,vel ,fsav ,agrv ,fr_wave,parts0 ,
8994 a elbuf ,rby ,rivet,nodes%BOUNDARY,nodes%BOUNDARY_ADD,
8995 b wa ,nodes%A ,nodes%AR ,nodes%STIFN ,nodes%STIFR ,partsav,element%PON%FSKY ,
8996 c interfaces%PON%FSKYI ,iframe ,xframe ,w16 ,iactiv ,element%PON%FSKYM ,igeo ,ipm ,
8997 d output%TH%WFEXT ,nodft ,nodlt ,nt_imp ,num_imp,ns_imp ,ne_imp ,ind_imp,
8998 l it ,rwbuf ,lprw ,fr_wall,nbintc ,intlist,
8999 m fani(1,1+nfoa+2*(nsect+nrbody)),rwsav ,fsavd ,
9000 n graphe , fac_k ,ipiv_k ,nkcond,nsensor,
9001 o monvol ,igrsurf,fr_mv ,volmon ,dirul,
9002 p nodes%NODGLOB,mumps_par,cddlp ,isendto,ircvfrom,newfront,imsch ,
9003 q i2msch ,isizxv,ilenxv ,islen7 ,irlen7 ,islen11,irlen11,islen17,
9004 r irlen17,irlen7t,islen7t,kinet ,num_imp1,nodes%TEMP ,dt2prev,wa ,
9005 s lgrav ,sh4tree,sh3tree,irlen20,islen20,irlen20t,islen20t,
9006 t irlen20e,islen20e,rbe3%IRBE3,rbe3%LRBE3 ,rbe3%FRBE3 ,fr_i2m,iad_i2m,rbe3%mpi%FR_RBE3,
9007 u rbe3%mpi%IAD_RBE3,frwl6,irbe2 ,lrbe2,intbuf_tab_cp,
9008 w nodes%IKINE ,diag_sms,icfield,lcfield,cfield,count_remslv,
9009 x count_remslve,elbuf_tab,elbuf_imp,nodes%XDP,nodes%WEIGHT_MD , stack ,
9010 y sensors%SFSAV,sensors%FSAV,sensors%STABSEN,sensors%TABSENSOR,drape_sh4n , drape_sh3n,
9011 z h3d_data,multi_fvm,igrbric,igrsh4n,igrsh3n,igrbeam,forneqs,maxdgap,
9012 a nddl0 ,nnzk0 ,it_t ,impbuf_tab,cptreac,fthreac,nodreac, drapeg,
9013 b interfaces,output%TH%TH_SURF,dpl0cld,vel0cld,snpc,stf,glob_therm,output%TH%WFEXT_MD)
9014#else
9015 WRITE(6,*) __line__,"Fatal error: MUMPS required"
9016 CALL flush(6)
9017 CALL arret(5)
9018#endif
9019C Modes buckling
9020 IF (nbuck>0) ibuck=1
9021 ELSEIF (ibuck>0) THEN
9022C
9023#if defined(MUMPS5) && defined(DNC)
9024 IF (impl_s > 0 .AND. ismdisp >0) THEN
9025 call assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
9026 ELSE
9027 call assign_ptrx(ptrx,nodes%X,numnod)
9028 ENDIF
9029 CALL imp_buck(
9030 2 pm, geo, ipm, igeo, elbuf,
9031 3 ixs, ixq, element%SHELL%IXC, ixt, ixp,
9032 4 ixr, ixtg, ixtg1, iparg,
9033 5 tf, npc, fr_wave, w16, bufmat,
9034 6 thke, bufgeo, nsensor, sensors%SENSOR_TAB,rby,
9035 7 skews%SKEW, wa, nodes%ICODT, nodes%ICODR, nodes%ISKEW,
9036 9 ibfv, vel, lpby, npby, nodes%ITAB,
9037 a nodes%WEIGHT, nodes%MS, nodes%IN, ipari, interfaces%INTBUF_TAB,
9038 b ptrx, itsk ,
9039 e fani, icut, xcut, fani(1,1+nfia), fani(1,1+nfea),
9040 f fani(1,1+nfoa), anin, nstrf, rwbuf, nprw,
9041 g tani, dd_iad, eani, ipart,
9042 h nom_opt, igrsurf, bufsf, idata,
9043 i rdata, kxx, ixx, kxsp, ixsp,
9044 j nod2sp, spbuf, ixs(l1), ixs(l2), ixs(l3),
9045 k nodes%VR, monvol, volmon, nodes%NODGLOB, nodes%BOUNDARY_ADD,
9046 l nodes%BOUNDARY, fr_sec, fr_rby2, iad_rby2, fr_wall,
9047 m nodes%V, nodes%A, graphe, partsav , xframe ,
9048 n dirul,
9049 o fsav(1,nfnca+1), fsav(1,nftca+1),nodes%TEMP ,sh4tree, sh3tree,
9050 p err_thk_sh4, err_thk_sh3 , iframe ,lprw , elbuf_tab,
9051 q fsav ,fsavd , rwsav ,nodes%AR , rbe3%IRBE3 ,
9052 r rbe3%LRBE3 ,rbe3%FRBE3 , fr_i2m ,iad_i2m , rbe3%mpi%FR_RBE3,
9053 s rbe3%mpi%IAD_RBE3,frwl6 , ibcl ,forc , irbe2 ,
9054 t lrbe2 ,iad_rbe2 , fr_rbe2 ,nodes%WEIGHT_MD,
9055 u cluster ,fcluster , mcluster ,xfem_tab ,
9056 v ale_connectivity ,w , nv46 ,nercvois , nesdvois ,
9057 w lercvois ,lesdvois ,crkedge ,stack ,sensors%SFSAV ,
9058 x sensors%FSAV ,sensors%STABSEN,sensors%TABSENSOR,indx_crk ,xedge4n ,
9059 y xedge3n ,sph2sol ,stifn_tmp ,stifr_tmp , drape_sh4n ,
9060 z drape_sh3n ,h3d_data ,subsets ,igrnod , fcont_max,
9061 a fani(1,nfnca2+1),fani(1,nftca2+1),nddl0 ,nnzk0 ,impbuf_tab ,
9062 b drapeg ,mat_elem%MAT_PARAM ,glob_therm, output )
9063#else
9064 WRITE(6,*) __line__,"Fatal error: MUMPS required"
9065 CALL flush(6)
9066 CALL arret(5)
9067#endif
9068
9069 IF (idyna==0.AND.itsk==0) CALL cp_dm(numgeo,geo,igeo,dmcp,2)
9070 mstop=2
9071 ELSE
9072 IF (ilastanim/=1) THEN
9073 IF (iline/=1.AND.ispmd==0) THEN
9074 WRITE(iout,*)
9075 WRITE(istdo,*)
9076 WRITE(iout,1002)it_t
9077 WRITE(istdo,1002)it_t
9078 WRITE(iout,1003)it_bcs,it_pcg
9079 WRITE(istdo,1003)it_bcs,it_pcg
9080 ENDIF
9081 END IF !(ILASTANIM==2) THEN
9082 tt = min(tt,tstop+em10)
9083 dt2 = dt2t
9084 ENDIF !IF (IMP_CHK>0)
9085 IF (tt>tstop.AND.inconv==1) THEN
9086 CALL imp_restarcp(nodes%X,nodes%V,nodes%VR,geo,igeo,dmcp,impbuf_tab)
9087 ENDIF !IF (TT>TSTOP.AND.INCONV==1)
9088
9089 CALL trace_out(3)
9090 IF (imon>0) CALL stoptime(timers,34)
9091C---------------------------
9092C Not pure thermal case
9093C---------------------------
9094 ELSEIF(ilag+iale+ieuler/=0)THEN
9095
9096C========================================================================================
9097C PARALLEL SECTION (SMP)
9098C========================================================================================
9099
9100!$OMP PARALLEL
9101
9102C----------------------------
9103C RBODIES TO RIGIDE SURFACE.
9104C--- // ----------------
9105 IF (nsurf/=0) THEN
9106
9107C========================================================================================
9108C DOMAIN 0
9109C========================================================================================
9110 IF(ispmd==0) THEN ! traitement int14 sur p0
9111 CALL srfvit(nodes%X,nodes%V,nodes%VR,nodes%A,nodes%AR,
9112 . npby ,rby ,nodes%MS ,nodes%IN ,
9113 . igrsurf ,bufsf)
9114 END IF
9115 ENDIF
9116
9117!$OMP END PARALLEL
9118C----------------------------------------------------------------
9119C CLOAD - Save Displacements and Velocities for concentrated loads and pressure loads
9120C----------------------------------------------------------------
9121 IF (nconld > 0) THEN
9122 CALL disp_vel_saved_cload(nodes%V ,nodes%D ,nodes%VR ,nodes%DR ,ibcl ,
9123 . dpl0cld,vel0cld,nibcld,nconld,iroddl ,
9124 . numnod )
9125 ENDIF
9126C----------------------------------------------------------------
9127C USER WINDOWS - Save Accelerations before reset to zero
9128C----------------------------------------------------------------
9129 IF(user_windows%HAS_USER_WINDOW /= 0)THEN
9130 IF(ispmd == 0) THEN
9131 DO i=1,numnod
9132 user_windows%A_SAV(1,i)=nodes%A(1,i)*nodes%MS(i)
9133 user_windows%A_SAV(2,i)=nodes%A(2,i)*nodes%MS(i)
9134 user_windows%A_SAV(3,i)=nodes%A(3,i)*nodes%MS(i)
9135 ENDDO
9136 IF(iroddl/=0)THEN
9137 DO i=1,numnod
9138 user_windows%AR_SAV(1,i)=nodes%AR(1,i)*nodes%IN(i)
9139 user_windows%AR_SAV(2,i)=nodes%AR(2,i)*nodes%IN(i)
9140 user_windows%AR_SAV(3,i)=nodes%AR(3,i)*nodes%IN(i)
9141 ENDDO
9142 ENDIF
9143 ENDIF
9144 ENDIF
9145C------------------------------------------
9146C SYNCHRONIZATION ON V TT AND NCYCLE (implicit)
9147C----------------------------
9148
9149 IF(imon>0) CALL startime(timers,timer_integ)
9150
9151C========================================================================================
9152C PARALLEL SECTION (SMP)
9153C========================================================================================
9154
9155!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK,NODFT_NL,NODLT_NL)
9156 itsk = omp_get_thread_num()
9157 nodftsk = 1+itsk*numnod/ nthread
9158 nodltsk = (itsk+1)*numnod/nthread
9159C-----------------
9160C VITESSES
9161C-----------------
9162 CALL vitesse(
9163 1 nodes%A , nodes%AR , nodes%V , nodes%VR , fzero,
9164 2 nodes%ITAB,ale_connectivity%NALE )
9165c
9166 IF (nloc_dmg%IMOD > 0) THEN
9167c
9168 nodft_nl = 1+ itsk*nloc_dmg%NNOD/nthread
9169 nodlt_nl = (itsk+1)*nloc_dmg%NNOD/nthread
9170 CALL nlocal_vel(nloc_dmg, nodft_nl ,nodlt_nl)
9171 ENDIF
9172c
9173 IF(ialelag > 0) THEN
9174 CALL flow_vitesse(ale_connectivity%NALE,aflow ,vflow , fzero ,
9175 2 nodftsk,nodltsk ,wflow, nodes%V,ifoam)
9176 ENDIF
9177C
9178 IF(npinch > 0) THEN
9179 CALL vitessepinch(
9180 1 pinch_data%APINCH, pinch_data%VPINCH,
9181 2 nodftsk , nodltsk )
9182 ENDIF
9183C
9184CC
9185!$OMP END PARALLEL
9186
9187! inivel w/ Tstart or sensor
9188 IF (loads%NINIVELT > 0) THEN
9189 IF (n2d == 0) THEN
9190 length = numels + nsvois
9191 ELSE
9192 length = numelq + numeltg
9193 ENDIF
9194 CALL inivel_start(
9195 . ngrnod, ngrbric, ngrquad, ngrsh3n,
9196 . igrnod, igrbric, igrquad, igrsh3n,
9197 . numskw, lskew, numfram, sensors,
9198 . xframe,skews%SKEW, nodes%X, nodes%V,
9199 . nodes%VR, numnod, vflow, wflow,
9200 . w,multi_fvm, iale , ialelag,
9201 . tt, iroddl, loads%NINIVELT,loads%INIVELT,
9202 . nparg, ngroup, length, iparg,
9203 . elbuf_tab, nodes%MS, nodes%IN, nodes%WEIGHT,
9204 . nxframe, t_kin )
9205 output%TH%WFEXT = output%TH%WFEXT + t_kin
9206 END IF
9207!
9208C----------------------------------
9209C ITET2 of S10 Kinematic
9210C----------------------------------
9211 IF (ns10e > 0) CALL s10cndv(icnds10,vnd ,nodes%V )
9212
9213C========================================================================================
9214C PARALLEL SECTION (SMP)
9215C==========================================================================================
9216
9217 IF(iplyxfem > 0) THEN
9218 nthold= nthread
9219 nthread=1
9220 call omp_set_num_threads(nthread)
9221!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
9222 itsk = omp_get_thread_num()
9223 nodftsk = 1+itsk*numnod/ nthread
9224 nodltsk = (itsk+1)*numnod/nthread
9225c for smp parallel is not parit on
9226 CALL ply_vitesse(nodftsk,nodltsk,nplymax,inod_pxfem,numnod)
9227!$OMP END PARALLEL
9228 nthread= nthold
9229 call omp_set_num_threads(nthread)
9230 ENDIF
9231C
9232 IF(imon>0) CALL stoptime(timers,timer_integ)
9233
9234 IF(iale+ieuler==0) THEN
9235C----------------------
9236C LAGRANGE PUR
9237C----------------------
9238
9239 IF(imon>0) CALL startime(timers,timer_integ)
9240
9241C========================================================================================
9242C PARALLEL SECTION (SMP)
9243C========================================================================================
9244
9245!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK,NODFT_NL,NODLT_NL)
9246
9247 itsk = omp_get_thread_num()
9248 nodftsk = 1+itsk*numnod/ nthread
9249 nodltsk = (itsk+1)*numnod/nthread
9250
9251 CALL depla(nodes%V ,nodes%D ,nodes%X ,nodes%VR ,nodes%DR ,
9252 2 nodes%XDP,nodes%DDP,numnod)
9253C
9254 CALL deplafakeige(nodes%X ,nodes%V ,interfaces%INTBUF_TAB, kxig3d,
9255 2 ixig3d,igeo, knot, wige,
9256 3 knotlocpc,knotlocel)
9257
9258c
9259 IF (nloc_dmg%IMOD > 0) THEN
9260c
9261 nodft_nl = 1+ itsk*nloc_dmg%NNOD/nthread
9262 nodlt_nl = (itsk+1)*nloc_dmg%NNOD/nthread
9263 CALL nlocal_incr(nloc_dmg, nodft_nl,nodlt_nl)
9264 ENDIF
9265c
9266 IF(ialelag > 0) THEN
9267 CALL flow_depla(ale_connectivity%NALE, vflow ,dflow ,
9268 2 nodftsk,nodltsk)
9269 ENDIF
9270C
9271 IF(npinch > 0) THEN
9272 CALL deplapinch(pinch_data%VPINCH, pinch_data%DPINCH,
9273 2 pinch_data%XPINCH, nodftsk , nodltsk)
9274 ENDIF
9275C
9276!$OMP END PARALLEL
9277
9278 IF(imon>0) CALL stoptime(timers,timer_integ)
9279C
9280 ELSEIF(iale/=0)THEN
9281C-------------------------------------
9282C -A.L.E.-(+LAGRANGE)(+EULER)
9283C-------------------------------------
9284
9285C========================================================================================
9286C PARALLEL SECTION (SMP)
9287C========================================================================================
9288
9289!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
9290
9291 itsk = omp_get_thread_num()
9292 nodftsk = 1+itsk*numnod/ nthread
9293 nodltsk = (itsk+1)*numnod/nthread
9294 CALL alewdx(timers,
9295 1 geo ,nodes%X ,nodes%D ,nodes%V ,nodes%VR ,
9296 2 w ,wa ,wb ,skews%SKEW ,
9297 3 pm ,xlas ,nodes%MS ,fsav ,
9298 4 nodes%A ,tf ,rwbuf ,
9299 5 dt2save ,python ,
9300 6 iparg ,ixs ,ixq ,nodpor ,
9301 7 nodes%ISKEW ,nodes%ICODT ,elbuf_tab ,
9302 8 npc ,linale ,nprw ,las ,
9303 9 ipari ,nodftsk ,nodltsk ,itsk ,
9304 a nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,nbrcvois ,nbsdvois ,lnrcvois ,
9305 b lnsdvois ,nodes%WEIGHT ,element%PON%ADSKY,element%PON%FSKY,element%PON%IADS,
9306 c fr_wall ,nporgeo ,element%PON%PROCNE ,
9307 d fr_nbcc ,element%PON%IADQ ,nodes%XDP ,igrnod ,
9308 e nodes%DR ,interfaces%INTBUF_TAB ,multi_fvm ,
9309 f ale_connectivity,nodes%DDP ,ne_nercvois ,ne_nesdvois ,
9310 g ne_lercvois ,ne_lesdvois ,xcell ,xface , output%TH%WFEXT)
9311
9312!$OMP END PARALLEL
9313
9314C-------------------------
9315C -EULER+LAGRANGE-
9316C No displacements computed if pure Euler
9317C-------------------------
9318 ELSEIF(ilag==1)THEN
9319C // -----------------------------------
9320 IF(imon>0) CALL startime(timers,timer_integ)
9321
9322C========================================================================================
9323C PARALLEL SECTION (SMP)
9324C========================================================================================
9325
9326!$omp parallel private(itsk,nodftsk,nodltsk)
9327
9328 itsk = omp_get_thread_num()
9329 nodftsk = 1+itsk*numnod/ nthread
9330 nodltsk = (itsk+1)*numnod/nthread
9331
9332 CALL euldx(nodes%V,nodes%D,nodes%X,nodes%DDP,ale_connectivity%NALE,nodftsk,nodltsk)
9333
9334!$OMP END PARALLEL
9335
9336 IF(imon>0) CALL stoptime(timers,timer_integ)
9337 ENDIF
9338 ENDIF
9339 CALL python_sync(python%CONTEXT)
9340 CALL python_update_nodal_entities(numnod,nodes,x=nodes%X, d=nodes%D, dr=nodes%DR)
9341 IF(coupling%active) THEN
9342 dt2max_coupling = dt2
9343 ! Read and write coupling positions
9344 CALL coupling_sync(coupling,dt2,nodes,coupling_positions)
9345 ENDIF
9346
9347 IF (vipercoupling) THEN
9348C Send positions to Viper
9349 CALL radiossviper_sendxve(numnod,neleml,viper%NUMELE,nparg,ngroup,viper%NUMON,viper%ivout,
9350 . nodes%X,nodes%V,viper%ITABM1,viper%IXEM1,iparg,elbuf_tab)
9351 CALL radiossviper_sendkill(mstop,tstop,viper%TSTOP)
9352 ENDIF
9353
9354C========================================================================================
9355C NON PARALLEL SECTION (SMP)
9356C========================================================================================
9357
9358C-------------------------------------
9359C UPDATE XFEM CONFIGURATION
9360C-------------------------------------
9361 IF (icrack3d > 0) THEN
9362 IF (nlevset > 0)THEN
9363c
9364 CALL upxfem1(xfem_tab,
9365 . iparg ,element%SHELL%IXC ,ngrouc ,igrouc ,ixtg ,
9366 . iadc_crk ,iel_crk ,inod_crk ,elcutc ,nodedge ,
9367 . enrtag ,crkedge ,xedge4n ,xedge3n )
9368C
9369 IF (nspmd > 1) ! exchange ENRTAG
9370 . CALL spmd_crk_adv(nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,inod_crk ,enrtag)
9371
9372C========================================================================================
9373C PARALLEL SECTION (SMP)
9374C========================================================================================
9375
9376!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
9377 itsk = omp_get_thread_num()
9378 nodftsk = 1+itsk*numnod/ nthread
9379 nodltsk = (itsk+1)*numnod/nthread
9380c USE ENRTAG => set positive enrichments
9381 CALL upenr_crk(adsky_crk,inod_crk ,nodftsk ,nodltsk ,
9382 . nodenr ,enrtag ,nodlevxf ,procne_crk )
9383!$OMP END PARALLEL
9384
9385c set TAGXP after updating enrichments
9386 CALL upxfem_tagxp(xfem_tab,
9387 . iparg ,element%SHELL%IXC ,ngrouc ,igrouc ,ixtg ,
9388 . iadc_crk ,iel_crk ,inod_crk ,elcutc ,nodedge ,
9389 . enrtag ,crkedge ,xedge4n ,xedge3n ,nodes%ITAB )
9390!$omp parallel private(itsk,nodftsk,nodltsk)
9391 itsk = omp_get_thread_num()
9392 nodftsk = 1+itsk*numnod/ nthread
9393 nodltsk = (itsk+1)*numnod/nthread
9394c update velocities of phantom elements
9395 CALL crk_vitesse(adsky_crk,inod_crk ,nodlevxf ,nodftsk ,nodltsk ,
9396 . nodes%X ,nodes%V ,nodes%VR ,nodes%A ,nodes%AR ,
9397 . nodes%ITAB )
9398!$OMP END PARALLEL
9399
9400C========================================================================================
9401C NON PARALLEL SECTION (SMP)
9402C========================================================================================
9403
9404 CALL crk_vitesse2(iparg ,ngrouc ,igrouc ,elcutc ,crkedge ,
9405 . nodedge ,element%SHELL%IXC ,ixtg ,xedge4n ,xedge3n ,
9406 . iadc_crk ,iel_crk ,inod_crk ,nodes%ITAB )
9407c----------------------------------------------------------------------
9408c spmd xfem velocity exchange
9409c----------------------------------------------------------------------
9410 IF (nspmd > 1) THEN
9411 CALL spmd_exch_crkvel(nodes%BOUNDARY_ADD ,nodes%BOUNDARY ,inod_crk ,nodes%ITAB ,
9412 . nodes%X ,nodes%V ,nodes%VR )
9413 ENDIF
9414C========================================================================================
9415C PARALLEL SECTION (SMP)
9416C========================================================================================
9417
9418!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
9419 itsk = omp_get_thread_num()
9420 nodftsk = 1+itsk*numnod/ nthread
9421 nodltsk = (itsk+1)*numnod/nthread
9422 CALL crk_zero_accel(adsky_crk,inod_crk ,nodftsk ,nodltsk ,nodlevxf )
9423!$OMP END PARALLEL
9424c----------------------------------------------------------------------
9425
9426C========================================================================================
9427C NON PARALLEL SECTION (SMP)
9428C========================================================================================
9429
9430 CALL upxfem2(iparg ,element%SHELL%IXC ,ngrouc ,igrouc ,iadc_crk ,
9431 . iel_crk ,elcutc ,ixtg ,enrtag ,inod_crk ,
9432 . nodes%BOUNDARY_ADD ,nodes%BOUNDARY,iad_edge,fr_edge ,fr_nbedge ,
9433 . crkedge )
9434
9435
9436 ELSE ! NLEVSET = 0
9437
9438C========================================================================================
9439C PARALLEL SECTION (SMP)
9440C========================================================================================
9441
9442!$OMP PARALLEL PRIVATE(ITSK,NODFTSK,NODLTSK)
9443 itsk = omp_get_thread_num()
9444 nodftsk = 1+itsk*numnod/ nthread
9445 nodltsk = (itsk+1)*numnod/nthread
9446 CALL crk_coord_ini(adsky_crk,inod_crk ,nodftsk,nodltsk,nodes%X ,
9447 . nodlevxf )
9448!$OMP END PARALLEL
9449 END IF
9450C---
9451 END IF ! XFEM
9452
9453C========================================================================================
9454C NON PARALLEL SECTION (SMP)
9455C========================================================================================
9456
9457 IF(nintstamp/=0)THEN
9458 CALL intstamp_move(intstamp ,npc ,tf ,skews%SKEW ,ptr_sms,
9459 . nodes%V ,nodes%VR ,nodes%MS ,nodes%X ,nodes%D ,
9460 . npby ,rby )
9461 END IF
9462 ! --------------------------------
9463 ! velocity update for /INT18 + LAW151
9464 IF( multi_fvm%IS_INT18_LAW151 ) THEN
9465 IF(nspmd>1.AND. iparit/=0) THEN
9466 CALL spmd_int18_law151_pon( ipari,islen7,irlen7,2,interfaces%INTBUF_TAB,
9467 1 multi_fvm )
9468 ENDIF
9469
9470C========================================================================================
9471C PARALLEL SECTION (SMP)
9472C========================================================================================
9473
9474!$OMP PARALLEL PRIVATE(ITSK)
9475 itsk = omp_get_thread_num()
9476 CALL int18_law151_update(itsk ,multi_fvm,igrbric ,ipari,ixs,
9477 1 igroups,iparg ,elbuf_tab,multi_fvm%FORCE_INT ,
9478 2 nodes%X , nodes%V , nodes%MS , kinet ,
9479 3 multi_fvm%X_APPEND,multi_fvm%V_APPEND,multi_fvm%MASS_APPEND,multi_fvm%KINET_APPEND)
9480!$OMP END PARALLEL
9481
9482 ENDIF
9483
9484!$OMP PARALLEL PRIVATE(ITSK)
9485 itsk = omp_get_thread_num()
9486 CALL multi_velocity_backup(itsk,multi_fvm,n2d,numels,numelq,numeltg)
9487!$OMP END PARALLEL
9488C========================================================================================
9489C NON PARALLEL SECTION (SMP)
9490C========================================================================================
9491
9492 IF( multi_fvm%IS_USED ) THEN
9493! write *.adb files for FVM solver option
9494 IF (debug(macro_debug_acc)==1) THEN
9495 IF (ispmd==0) THEN
9496 siz = numelsg
9497 ELSE
9498 siz = 0
9499 END IF
9500 IF ( ncycle>=debstart .AND.
9501 . mod(ncycle-debstart,rstfreq)==0 ) THEN
9502 CALL spmd_collect_multi_fvm(ixs,multi_fvm,1)
9503 ENDIF
9504 ENDIF
9505 IF(debug(macro_debug_chksm) >0) THEN
9506 IF(mod(ncycle,debug(macro_debug_chksm)) == 0 ) THEN
9507 CALL spmd_collect_multi_fvm(ixs,multi_fvm,2)
9508
9509 ENDIF
9510 ENDIF
9511 ENDIF
9512C========================================================================================
9513C NON PARALLEL SECTION (SMP)
9514C========================================================================================
9515
9516C---------Computation of node areas for contact area output-----
9517 IF(interfaces%PARAMETERS%INTCAREA > 0) THEN
9518C IOUTPRT for assembly synthesis, not need for spring which call *bilan each cycle
9519 ithout = 0
9520 CALL th_time_output(ithout, sensors,output)
9521 IF(ithout > 0) THEN
9522 CALL inter_nodal_areas(ixs ,element%SHELL%IXC ,ixtg ,fasolfr ,nodes%X ,
9523 . nodes%BOUNDARY_ADD,nodes%BOUNDARY ,nodes%WEIGHT ,ixq ,segquadfr ,
9524 . ixs(l1) ,interfaces%PARAMETERS%INTAREAN)
9525 ENDIF
9526
9527 ENDIF
9528
9529
9530 IF (int24use == 1)THEN
9531C E2E Fictive Node Position, Velocity, Mass
9532C Useful to do it before send back to Remote nodes, E2E Fictive node position,
9533C mass & velocity
9534 CALL i24e2e_fictive_nodes_update(intlist,nbintc,ipari,interfaces%INTBUF_TAB,
9535 . nodes%X,nodes%V,nodes%MS,nodes%ITAB,xyz,numnod,sh_offset_tab%nnsh_oset)
9536 ENDIF
9537
9538 IF (nspmd>1) THEN
9539 IF(imonm == 2)THEN
9540 CALL startime(timers,60)
9541 CALL spmd_barrier()
9542 CALL stoptime(timers,60)
9543 END IF
9544 IF(imon>0) CALL startime(timers,13)
9545 IF(isizxv>0) CALL spmd_sd_xv(
9546 1 nodes%X ,nodes%D ,nodes%V ,nodes%VR ,nodes%MS ,
9547 2 nodes%IN ,nodes%BOUNDARY_ADD,nodes%BOUNDARY,nodes%WEIGHT,imsch,
9548 3 w ,isizxv ,ilenxv ,nodes%XDP)
9549 IF (imonm > 0) CALL startime(timers,23)
9550 l1 = 1+nixs*numels + nsvois*nixs
9551 l2 = l1+6*numels10
9552 l3 = l2+12*numels20
9553
9554 IF (sh_offset_tab%NNSH_OSET > 0) THEN
9555 CALL assign_ptrx(ptrx,xyz,numnod)
9556 ELSEIF (impl_s > 0 .AND. ismdisp >0) THEN
9557 CALL assign_ptrx(ptrx,impbuf_tab%X_A,numnod)
9558 ELSE
9559 CALL assign_ptrx(ptrx,nodes%X,numnod)
9560 ENDIF
9561
9562 CALL spmd_i7xvcom2(
9563 1 ipari ,ptrx ,nodes%V ,nodes%MS ,
9564 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
9565 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
9566 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
9567 5 igrbric ,nodes%TEMP ,1 ,irlen7t ,islen7t ,
9568 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
9569 7 islen20e,nodes%IKINE ,diag_sms,sensors%SENSOR_TAB,interfaces%INTBUF_TAB ,int24e2euse,
9570 8 forneqs ,multi_fvm,interfaces)
9571 IF (imonm > 0) CALL stoptime(timers,23)
9572 IF (imon>0) CALL stoptime(timers,13)
9573 ENDIF
9574
9575 IF (int24use == 1)THEN
9576 IF (imon>0) CALL startime(timers,timer_contfor)
9577 CALL spmd_exch_i24(ipari, interfaces%INTBUF_TAB ,nodes%ITAB ,
9578 * nodes%BOUNDARY_ADD, nodes%BOUNDARY ,intlist ,nbintc,
9579 * iad_i24 ,fr_i24 ,sfr_i24,i24maxnsne,3,
9580 * int24e2euse)
9581 IF (imon>0) CALL stoptime(timers,timer_contfor)
9582 ENDIF
9583
9584 IF(nintstamp /= 0.AND.ftempvar21==1.AND.nspmd>1) THEN
9585 CALL spmd_i21tempcom(ipari,nodes%TEMP,interfaces%INTBUF_TAB,nsensor,sensors%SENSOR_TAB)
9586 ENDIF
9587
9588 IF(numfram/=0.AND.n2d==0)THEN
9589C----------------------------
9590C MOVING FRAME: RETRIEVE POSITION & VELOCITY.
9591C--- //0 ----------------
9592 IF (imon>0)CALL startime(timers,6)
9593 IF (imonm > 0) CALL startime(timers,49)
9594 IF (impl_s >0) THEN
9595 CALL movfra_imp(xframe ,iframe ,nodes%X ,nodes%V ,nodes%A ,
9596 . nodes%VR ,nodes%AR ,nodes%D )
9597 ELSE
9598 CALL movfra2(xframe ,iframe ,nodes%X ,nodes%V ,nodes%VR ,
9599 . nodes%D )
9600 END IF !(IMPL_S >0)
9601 IF (imonm > 0) CALL stoptime(timers,49)
9602 IF (imon>0) CALL stoptime(timers,6)
9603 ENDIF
9604
9605 IF (glob_therm%IDT_THERM == 1.AND.(tstop-tt)<=em20)THEN
9606 mstop_dt_therm = 1
9607 ENDIF
9608
9609#if defined(MYREAL8) && !defined(WITHOUT_LINALG)
9610 300 CONTINUE
9611#endif
9612
9613 ! ---------------------------------------------
9614 ! END OF RUN
9615 ! ---------------------------------------------
9616
9617 ! --------------
9618 ! Restart Files
9619 ! --------------
9620
9621 ! Restart File criteria
9622 stop_or_add_cycle = 0
9623 bool_restart=.false.
9624
9625 ! End of computation
9626 IF (((tt>tstop).OR.(mstop_dt_therm==1)).AND.imconv==1) THEN
9627 stop_or_add_cycle = 1 ! check if additional cycle is need with animation
9628 IF (irad2r==0) THEN ! No Restart writing at end of Run when Rad2rad is active
9629 bool_restart = ((ilastanim==0.OR.ilastanim==1.OR.ilastanim==3).AND. restart_file==1) ! Restart writing criteria
9630 ENDIF
9631 ENDIF
9632
9633 ! Restart within Run
9634 IF (ale%SUB%IFSUB==0.AND.imconv==1 .AND. restart_file==1.AND.
9635 . (ncycle/ncrst)*ncrst==ncycle.AND. irad2r==0 .OR.mrest==1.OR.(wmcheck==1.AND.ncycle/=1) ) THEN
9636 stop_or_add_cycle = 0
9637 bool_restart = .true.
9638 ENDIF
9639
9640 IF(wmcheck==1)THEN ! Checkpoint Restart : write CHECK_DATA File
9641 IF(ispmd==0)THEN
9642 filnam = 'CHECK_DATA'
9643 OPEN(unit=icheckd,file=filnam,access='SEQUENTIAL',form='FORMATTED',status='UNKNOWN')
9644 WRITE(icheckd, fmt='(3A, I1)') '/rerun/',ROOTNAM(1:ROOTLEN),'/',IRUN
9645 CLOSE(ICHECKD)
9646 ENDIF
9647 ENDIF
9648
9649 IF (BOOL_RESTART) THEN
9650 IF(IMON>0) CALL STARTIME(TIMERS,TIMER_IO)
9651
9652 IF (GLOB_THERM%IDT_THERM == 1)CALL BCSDTTH_COPY(NODES%ICODT, NODES%ICODR, ICODT0, ICODR0, 2)
9653
9654 CALL BCSN(NODES%ICODE,NODES%ICODT,NODES%ICODR,PARTS0,PARTSAV)
9655
9656 IF (INT24USE == 1)THEN
9657 ! E2E Update Fictive Node Position, Velocity, Mass
9658 ! To do before SPMD_I7XVCOM2
9659 CALL I24E2E_FICTIVE_NODES_UPDATE(INTLIST,NBINTC,IPARI,INTERFACES%INTBUF_TAB,
9660 . NODES%X,NODES%V,NODES%MS,NODES%ITAB,
9661 . XYZ,NUMNOD,SH_OFFSET_TAB%nnsh_oset)
9662 ENDIF
9663
9664 ! Interface communication : Send updates to remote nodes - finalizatoin
9665 ! Need here for coherent Restart writing
9666 IF(NSPMD>1)THEN
9667 L1 = 1+NIXS*NUMELS + NSVOIS*NIXS
9668 L2 = L1+6*NUMELS10
9669 L3 = L2+12*NUMELS20
9670 CALL SPMD_I7XVCOM2(
9671 1 IPARI ,NODES%X ,NODES%V ,NODES%MS ,
9672 2 IMSCH ,I2MSCH ,DT2PREV ,INTLIST ,NBINTC ,
9673 3 ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,ISLEN17 ,
9674 4 IRLEN17 ,IXS ,IXS(L3) ,NSENSOR ,
9675 5 IGRBRIC ,NODES%TEMP ,2 ,IRLEN7T ,ISLEN7T ,
9676 6 IRLEN20 ,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,
9677 7 ISLEN20E,NODES%IKINE ,DIAG_SMS,SENSORS%SENSOR_TAB,INTERFACES%INTBUF_TAB ,INT24E2EUSE,
9678 8 FORNEQS ,MULTI_FVM,INTERFACES)
9679 END IF
9680
9681 ! Finalize T24 Communication to fill Buffers before restarts
9682 IF (INT24USE == 1)THEN
9683 IF (IMON>0) CALL STARTIME(TIMERS,TIMER_CONTFOR)
9684 CALL SPMD_EXCH_I24(IPARI, INTERFACES%INTBUF_TAB ,NODES%ITAB ,
9685 * NODES%BOUNDARY_ADD, NODES%BOUNDARY ,INTLIST ,NBINTC,
9686 * IAD_I24 ,FR_I24 ,SFR_I24,I24MAXNSNE,3,
9687 * INT24E2EUSE)
9688
9689 CALL SPMD_EXCH_I24(IPARI, INTERFACES%INTBUF_TAB ,NODES%ITAB ,
9690 * NODES%BOUNDARY_ADD, NODES%BOUNDARY ,INTLIST ,NBINTC,
9691 * IAD_I24 ,FR_I24 ,SFR_I24,I24MAXNSNE,4,
9692 * INT24E2EUSE)
9693
9694 IF (IMON>0) CALL STOPTIME(TIMERS,TIMER_CONTFOR)
9695 ENDIF
9696
9697 ! INTERFACE 21 - Communication of nodal temperature
9698.AND..AND. IF(NINTSTAMP /= 0FTEMPVAR21==1NSPMD>1) THEN
9699 CALL SPMD_I21TEMPCOM(IPARI,NODES%TEMP,INTERFACES%INTBUF_TAB,NSENSOR,SENSORS%SENSOR_TAB)
9700 ENDIF
9701 ICH = 0
9702 ! Engine time for restart
9703 CALL ELAPSTIME(TIMERS,SECS)
9704 GLOBAL_COMP_TIME%ENGINE_TIME(GLOBAL_COMP_TIME%RUN_NBR) = SECS
9705
9706 CALL WRRESTP(ELEMENT, NODES, AF ,IAF ,ICH ,ELEMENT%PON%ADSKY ,
9707 . ELBUF_TAB ,XFEM_TAB ,INTERFACES%INTBUF_TAB ,MULTI_FVM ,MAT_ELEM ,
9708 . H3D_DATA ,INTERFACES%INTBUF_FRIC_TAB ,SUBSETS ,PINCH_DATA ,ALE_CONNECTIVITY ,
9709 . T_MONVOL ,SENSORS , EBCS_TAB ,DYNAIN_DATA ,USER_WINDOWS ,
9710 . OUTPUT ,INTERFACES ,LOADS ,PYTHON ,NAMES_AND_TITLES ,
9711 . EIGIPM ,EIGIBUF ,EIGRPM ,NEIPM ,LEIBUF ,
9712 . NERPM ,IFLOW ,RFLOW ,LIFLOW ,LRFLOW ,
9713 . IMPBUF_TAB ,IMPL_S ,IMPL_S0 ,NODES%MCP ,NODES%TEMP ,
9714 . FORNEQS ,UNITAB ,STACK ,NDRAPE ,DRAPE_SH3N ,
9715 . DRAPE_SH4N ,DRAPEG ,RESTSIZE ,SKEWS ,GLOB_THERM ,
9716 . PBLAST ,RBE3)
9717
9718 ! Restart file size
9719 IF (MULTIREST >0)THEN
9720 IF (RESTSIZE > MULTIRESTS(IRPREV))MULTIRESTS(IRPREV)=RESTSIZE
9721 ELSE
9722 IF (RESTSIZE > RESTARTFILESIZE) RESTARTFILESIZE=RESTSIZE
9723 ENDIF
9724
9725.AND..OR. IF((IDDW/=0)(MSTOP/=0TT+DT2>=TSTOP)) THEN
9726 CALL CUMULTIME_MP(
9727 1 TAILLE,IPARG,
9728 2 ELEMENT%SHELL%IXC,IXQ,IXT,IXP,IXTG,
9729 3 IXR,IXS,KXIG3D,IPM,
9730 4 IGEO,GEO,POIN_UMP,CPUTIME_MP,
9731 5 NBR_GPMP,CPUTIME_MP_GLOB,TAB_UMP,PM,
9732 6 BUFMAT,TABMP_L ,TAB_MAT )
9733 IF(IDDWSTAT/=0) THEN
9734 CALL PRINTIMEG(IPARG,PM,IPM,ELEMENT%SHELL%IXC,IXTG,IXS)
9735 ENDIF
9736 ENDIF
9737
9738 IF(IMON>0) CALL STOPTIME(TIMERS,TIMER_IO)
9739 END IF
9740
9741 IF (STOP_OR_ADD_CYCLE==1) THEN
9742
9743 ! End of Run / criteria if additional cycle is need to write Anim or H3D state
9744 !
9745 ! ILASTANIM=0 No additional animation
9746 ! ILASTANIM=1 One more cycle needed
9747 ! ILASTANIM=2 Additional cycle done
9748 ! ILASTANIM=3 regular animation
9749
9750.OR. IF (ILASTANIM==2IRAD2R==1)THEN ! We are done / No magic - No additional Restart with Rad2rad run
9751 MSTOP=2
9752 GOTO 500
9753 ENDIF
9754
9755 STATE_ANIM = 0
9756 IF(MSTOP_DT_THERM==0) THEN
9757 IF (ILASTANIM==1) THEN
9758 STATE_ANIM = 1
9759.OR. ELSEIF (ILASTANIM==0ILASTANIM==3) THEN
9760 STATE_ANIM = 2
9761 END IF
9762 ELSE
9763 STATE_ANIM = 2
9764 ENDIF
9765
9766 STATE_H3D = 0
9767 IF(MSTOP_DT_THERM==0) THEN
9768 IF (ILASTH3D==1) THEN
9769 STATE_H3D = 1
9770.OR. ELSEIF (ILASTH3D==0ILASTH3D==3) THEN
9771 STATE_H3D = 2
9772 END IF
9773 ELSE
9774 STATE_H3D = 2
9775 ENDIF
9776.OR. IF( STATE_ANIM == 1 STATE_H3D == 1 ) THEN
9777 CALL TRACE_OUT(3)
9778 GOTO 100
9779.OR. ELSEIF( STATE_ANIM == 2 STATE_H3D == 2 ) THEN
9780 MSTOP=2
9781 GOTO 500
9782 ENDIF
9783 ENDIF
9784
9785 ! ------------------
9786 ! Negative Timestep
9787 ! ------------------
9788 IF(DT2<=ZERO) THEN
9789 WRITE(IOUT,*)' **error : time step less or equal zero'
9790 WRITE(ISTDO,*)' **error : time step less or equal zero'
9791
9792 IF ( ISTAMPING == 1) THEN
9793 WRITE(ISTDO,'(a)')' the run has gone to divergence.'
9794 WRITE(ISTDO,'(a)')' it could be due to a wrong definition of the interfaces between the tools and the blank.'
9795 WRITE(ISTDO,'(a)')' you may need to check if there is enough clearance between the tools,'
9796 WRITE(ISTDO,'(a)')' and that they do not penetrate each other during their travel.'
9797 WRITE(IOUT, '(a)')' the run has gone to divergence.'
9798 WRITE(IOUT, '(a)')' it could be due to a wrong definition of the interfaces between the tools and the blank.'
9799 WRITE(IOUT, '(a)')' you may need to check if there is enough clearance between the tools,'
9800 WRITE(IOUT, '(a)')' and that they do not penetrate each other during their travel.'
9801 ENDIF
9802
9803 ! Finalize MPI communication for clean exit when dt < 0
9804 IF (int24use == 1) THEN
9805 ! E2E Update Fictive Node Position, Velocity, Mass
9806 ! To do before SPMD_I7XVCOM2
9807 CALL i24e2e_fictive_nodes_update(intlist,nbintc,ipari,interfaces%INTBUF_TAB,
9808 . nodes%X,nodes%V,nodes%MS,nodes%ITAB,
9809 1 xyz,numnod,sh_offset_tab%nnsh_oset)
9810 ENDIF
9811 ! Finalize Interface communication from Node to remote node for coherent restart
9812 IF(nspmd>1)THEN
9813 l1 = 1+nixs*numels + nsvois*nixs
9814 l2 = l1+6*numels10
9815 l3 = l2+12*numels20
9816 CALL spmd_i7xvcom2(
9817 1 ipari ,nodes%X ,nodes%V ,nodes%MS ,
9818 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
9819 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
9820 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
9821 5 igrbric ,nodes%TEMP ,2 ,irlen7t ,islen7t ,
9822 6 irlen20 ,islen20 ,irlen20t,islen20t,irlen20e,
9823 7 islen20e,nodes%IKINE ,diag_sms,sensors%SENSOR_TAB,interfaces%INTBUF_TAB ,int24e2euse ,
9824 8 forneqs ,multi_fvm,interfaces)
9825 END IF
9826
9827 IF(coupling%active) THEN
9828 CALL coupling_ongoing(coupling, ongoing)
9829 ! FAKE TIME STEPS TO FINALIZE COUPLING
9830 DO WHILE (ongoing)
9831 dt2 = huge(dt2)
9832 CALL coupling_advance(coupling,dt2)
9833 CALL coupling_ongoing(coupling, ongoing)
9834 END DO
9835 CALL coupling_finalize(coupling)
9836 ENDIF
9837
9838 IF(ALLOCATED(isendto))DEALLOCATE(isendto)
9839 IF(ALLOCATED(ircvfrom))DEALLOCATE(ircvfrom)
9840 IF(ALLOCATED(intlist))DEALLOCATE(intlist)
9841 IF(ALLOCATED(intlist25))DEALLOCATE(intlist25)
9842 IF(ALLOCATED(niskyfi))DEALLOCATE(niskyfi)
9843 IF(ALLOCATED(niskyfie))DEALLOCATE(niskyfie)
9844 IF(ALLOCATED(fr_nbcc))DEALLOCATE(fr_nbcc)
9845 IF(ALLOCATED(fr_nbcci2))DEALLOCATE(fr_nbcci2)
9846 IF(ALLOCATED(dretri))DEALLOCATE(dretri)
9847 IF(ALLOCATED(xsec))DEALLOCATE(xsec)
9848 IF(ALLOCATED(irbkin_l))DEALLOCATE(irbkin_l)
9849 IF(ALLOCATED(icodt0))DEALLOCATE (icodt0)
9850 IF(ALLOCATED(icodr0))DEALLOCATE(icodr0)
9851 IF(ALLOCATED(element%PON%ISENDP))DEALLOCATE(element%PON%ISENDP)
9852 IF(ALLOCATED(element%PON%IRECVP))DEALLOCATE(element%PON%IRECVP)
9853 IF(ALLOCATED(irecvp_pxfem))DEALLOCATE(irecvp_pxfem)
9854 IF(ALLOCATED(isendp_crk))DEALLOCATE(isendp_crk)
9855 IF(ALLOCATED(irecvp_crk))DEALLOCATE(irecvp_crk)
9856 IF(ALLOCATED(cnel))DEALLOCATE(cnel)
9857 IF(ALLOCATED(addcnel))DEALLOCATE(addcnel)
9858 IF(ALLOCATED(addtmpl))DEALLOCATE(addtmpl)
9859 IF(ALLOCATED(tagel))DEALLOCATE(tagel)
9860 IF(ALLOCATED(ibufidel))DEALLOCATE(ibufidel)
9861 IF(ALLOCATED(indidel))DEALLOCATE(indidel)
9862 IF(ALLOCATED(ipartl))DEALLOCATE(ipartl)
9863 IF(ALLOCATED(eminx))DEALLOCATE(eminx)
9864 IF(nadmesh/=0)THEN
9865 DEALLOCATE(lsh4act,lsh4kin,psh4act,psh4kin,
9866 . lsh3act,lsh3kin,psh3act,psh3kin,
9867 . msh4sky,msh3sky)
9868 IF(idel7ng>=1) DEALLOCATE(tagtrimc,tagtrimtg)
9869 END IF
9870 IF(ALLOCATED(stifn_tmp))DEALLOCATE(stifn_tmp)
9871 IF(ALLOCATED(stifr_tmp))DEALLOCATE(stifr_tmp)
9872 IF(ALLOCATED(acnd))DEALLOCATE(acnd)
9873 IF(ALLOCATED(arcnd))DEALLOCATE(arcnd)
9874 IF(ALLOCATED(stcnd))DEALLOCATE(stcnd)
9875 IF(ALLOCATED(strcnd))DEALLOCATE(strcnd)
9876 IF(ALLOCATED(lsh4upl))DEALLOCATE(lsh4upl)
9877 IF(ALLOCATED(lsh3upl))DEALLOCATE(lsh3upl)
9878 IF(ALLOCATED(psh4upl))DEALLOCATE(psh4upl)
9879 IF(ALLOCATED(psh3upl))DEALLOCATE(psh3upl)
9880 IF(ALLOCATED(fthreac))DEALLOCATE(fthreac)
9881 IF(ALLOCATED(fthdtm))DEALLOCATE(fthdtm)
9882 IF(ALLOCATED(freac))DEALLOCATE(freac)
9883 IF(ALLOCATED(nodreac))DEALLOCATE(nodreac)
9884 IF(ALLOCATED(grth))DEALLOCATE(grth)
9885 IF(ALLOCATED(igrth))DEALLOCATE(igrth)
9886 IF(ALLOCATED(igroupc))DEALLOCATE(igroupc)
9887 IF(ALLOCATED(igrouptg))DEALLOCATE(igrouptg)
9888 IF(ALLOCATED(igroups))DEALLOCATE(igroups)
9889 IF(ALLOCATED(gresav))DEALLOCATE(gresav)
9890 IF(ALLOCATED(sfem_nodvar))DEALLOCATE(sfem_nodvar)
9891 IF(ALLOCATED(sfem_nodvar_ale))DEALLOCATE(sfem_nodvar_ale)
9892 IF(ALLOCATED(partsav2))DEALLOCATE(partsav2)
9893 IF(imon>0) THEN
9894 IF(nvolu > 0) CALL fvstats(monvol)
9895 CALL stoptime(timers,timer_resol)
9896 IF(imonm>0) CALL printime_interf(interfaces%INTBUF_TAB,ipari,intlist,nbintc,timers%REALTIME(1)*0.01d0)
9897 CALL printime(timers,glob_therm%ITHERM,output)
9898 ELSE
9899 CALL add_elapsed_time_mon_off(timers)
9900 ENDIF
9901 CALL trace_out(3)
9902 RETURN
9903 ENDIF
9904C-------------------------------
9905 500 CONTINUE
9906C-------------------------------
9907 IF(mstop/=0) THEN
9908 parallel_section = 0
9909C Multidomain -> close sockets
9910 IF (irad2r==1) THEN
9911 DO itsk=1,nthread
9912 CALL close_sock_c(socket(itsk))
9913 END DO
9914 ENDIF
9915C /KILL
9916 IF((ncycle/ncrst)*ncrst/=ncycle.AND.
9917 2 mrest/=1.AND.wmcheck/=1.AND.nspmd>1)THEN
9918 l1 = 1+nixs*numels + nsvois*nixs
9919 l2 = l1+6*numels10
9920 l3 = l2+12*numels20
9921 CALL spmd_i7xvcom2(
9922 1 ipari ,nodes%X ,nodes%V ,nodes%MS ,
9923 2 imsch ,i2msch ,dt2prev ,intlist ,nbintc ,
9924 3 islen7 ,irlen7 ,islen11 ,irlen11 ,islen17 ,
9925 4 irlen17 ,ixs ,ixs(l3) ,nsensor ,
9926 5 igrbric ,nodes%TEMP ,2 ,irlen7t ,islen7t ,
9927 6 irlen20 ,islen20,irlen20t,islen20t,irlen20e,
9928 7 islen20e,nodes%IKINE ,diag_sms,sensors%SENSOR_TAB,interfaces%INTBUF_TAB,int24e2euse,
9929 8 forneqs ,multi_fvm,interfaces)
9930 ENDIF
9931
9932 IF(ALLOCATED(isendto))DEALLOCATE(isendto)
9933 IF(ALLOCATED(ircvfrom))DEALLOCATE(ircvfrom)
9934 IF(ALLOCATED(intlist25))DEALLOCATE(intlist25)
9935 IF(ALLOCATED(niskyfi))DEALLOCATE(niskyfi)
9936 IF(ALLOCATED(niskyfie))DEALLOCATE(niskyfie)
9937 IF(ALLOCATED(fr_nbcc))DEALLOCATE(fr_nbcc)
9938 IF(ALLOCATED(fr_nbcci2))DEALLOCATE(fr_nbcci2)
9939 IF(ALLOCATED(dretri))DEALLOCATE(dretri)
9940 IF(ALLOCATED(xsec))DEALLOCATE(xsec)
9941 IF(ALLOCATED(irbkin_l))DEALLOCATE(irbkin_l)
9942 IF(ALLOCATED(isendp))DEALLOCATE(isendp)
9943 IF(ALLOCATED(element%PON%ISENDP))DEALLOCATE(element%PON%ISENDP)
9944 IF(ALLOCATED(element%PON%IRECVP))DEALLOCATE(element%PON%IRECVP)
9945 IF(ALLOCATED(irecvp_pxfem))DEALLOCATE(irecvp_pxfem)
9946 IF(ALLOCATED(isendp_crk))DEALLOCATE(isendp_crk)
9947 IF(ALLOCATED(irecvp_crk))DEALLOCATE(irecvp_crk)
9948 !IF(IDEL7NG>0)THEN
9949 IF(ALLOCATED(cnel))DEALLOCATE(cnel)
9950 IF(ALLOCATED(addcnel))DEALLOCATE(addcnel)
9951 IF(ALLOCATED(addtmpl))DEALLOCATE(addtmpl)
9952 IF(ALLOCATED(tagel))DEALLOCATE(tagel)
9953 IF(ALLOCATED(ibufidel))DEALLOCATE(ibufidel)
9954 IF(ALLOCATED(indidel))DEALLOCATE(indidel)
9955 !ENDIF
9956 IF(ALLOCATED(ipartl))DEALLOCATE(ipartl)
9957 IF(ALLOCATED(eminx))DEALLOCATE(eminx)
9958 IF(nadmesh/=0)THEN
9959 DEALLOCATE(lsh4act,lsh4kin,psh4act,psh4kin,
9960 . lsh3act,lsh3kin,psh3act,psh3kin,
9961 . msh4sky,msh3sky)
9962 IF(idel7ng>=1) DEALLOCATE(tagtrimc,tagtrimtg)
9963 END IF
9964C
9965 !interface22
9966 IF(ALLOCATED(brick_list)) DEALLOCATE (brick_list)
9967 IF(ALLOCATED(list_b_old)) DEALLOCATE (list_b_old)
9968 IF(ALLOCATED(nbold)) DEALLOCATE (nbold)
9969 IF(ALLOCATED(edge_list)) DEALLOCATE (edge_list)
9970 IF(ALLOCATED(uvarl)) DEALLOCATE (uvarl)
9971 IF(ALLOCATED(supercellvol_l)) DEALLOCATE (supercellvol_l)
9972 IF(ALLOCATED(eint_l)) DEALLOCATE (eint_l)
9973 IF(ALLOCATED(rho_l)) DEALLOCATE (rho_l)
9974 IF(ALLOCATED(mom_l)) DEALLOCATE (mom_l)
9975 IF(ALLOCATED(sig_l)) DEALLOCATE (sig_l)
9976 IF(ALLOCATED(vold_l)) DEALLOCATE (vold_l)
9977 IF(ALLOCATED(imergel)) DEALLOCATE (imergel)
9978 IF(ALLOCATED(old_secndlist)) DEALLOCATE (old_secndlist)
9979 IF(ALLOCATED(unlinked_cells_l)) DEALLOCATE (unlinked_cells_l)
9980 IF(ALLOCATED(n_unlinked_l)) DEALLOCATE (n_unlinked_l)
9981 IF(ALLOCATED(v22max_l)) DEALLOCATE (v22max_l)
9982 IF(ALLOCATED(dx22min_l)) DEALLOCATE (dx22min_l)
9983 IF(ALLOCATED(int22_fcell_anim)) DEALLOCATE (int22_fcell_anim)
9984
9985 !ALEFVM
9986 IF(ALLOCATED(alefvm_buffer%WFEXT_CELL)) DEALLOCATE (alefvm_buffer%WFEXT_CELL)
9987 IF(ALLOCATED(alefvm_buffer%FEXT_CELL)) DEALLOCATE (alefvm_buffer%FEXT_CELL)
9988 IF(ALLOCATED(alefvm_buffer%FCELL)) DEALLOCATE (alefvm_buffer%FCELL)
9989 IF(ALLOCATED(alefvm_buffer%FINT_CELL)) DEALLOCATE (alefvm_buffer%FINT_CELL)
9990 IF(ALLOCATED(alefvm_buffer%VERTEX)) DEALLOCATE (alefvm_buffer%VERTEX)
9991 IF(ALLOCATED(alefvm_buffer%F_FACE)) DEALLOCATE (alefvm_buffer%F_FACE)
9992
9993 !/LOAD/PBLAST
9994 CALL pblast_deallocate(pblast)
9995
9996C-- Rad2rad deallocation
9997 IF(ALLOCATED(iadd_nl)) DEALLOCATE (iadd_nl)
9998 IF(ALLOCATED(nbdof_nl)) DEALLOCATE (nbdof_nl)
9999 IF(ALLOCATED(nllnk)) DEALLOCATE (nllnk)
10000
10001C-- Seatblet stuctures deallocation
10002 IF (nslipring > 0) THEN
10003 DO i=1,nslipring
10004 DEALLOCATE(slipring(i)%FRAM)
10005 ENDDO
10006 DEALLOCATE(slipring)
10007 ENDIF
10008 IF (nretractor > 0) THEN
10009 DO i=1,nretractor
10010 DEALLOCATE(retractor(i)%INACTI_NODE)
10011 DO k=1,2
10012 IF (retractor(i)%IFUNC(k) > 0) THEN
10013 DEALLOCATE(retractor(i)%TABLE(k)%X(1)%VALUES)
10014 DEALLOCATE(retractor(i)%TABLE(k)%X)
10015 DEALLOCATE(retractor(i)%TABLE(k)%Y%VALUES)
10016 DEALLOCATE(retractor(i)%TABLE(k)%Y)
10017 ENDIF
10018 ENDDO
10019 ENDDO
10020 DEALLOCATE(retractor)
10021 ENDIF
10022
10023 !ALEMUSCL
10024 CALL alemuscl_deallocate()
10025 !Multifluid law
10026 CALL multi_deallocate(multi_fvm)
10027 IF (multi_fvm%NS_DIFF) THEN
10028 CALL diffusion%TERMINATE_DIFFUSION()
10029 ENDIF
10030
10031 !EBCS
10032 IF(nebcs > 0)CALL segvar%destroy()
10033C
10034 IF(ALLOCATED(stifn_tmp))DEALLOCATE(stifn_tmp)
10035 IF(ALLOCATED(stifr_tmp))DEALLOCATE(stifr_tmp)
10036 IF(ALLOCATED(acnd))DEALLOCATE(acnd)
10037 IF(ALLOCATED(arcnd))DEALLOCATE(arcnd)
10038 IF(ALLOCATED(stcnd))DEALLOCATE(stcnd)
10039 IF(ALLOCATED(strcnd))DEALLOCATE(strcnd)
10040 IF(ALLOCATED(lsh4upl))DEALLOCATE(lsh4upl)
10041 IF(ALLOCATED(lsh3upl))DEALLOCATE(lsh3upl)
10042 IF(ALLOCATED(psh4upl))DEALLOCATE(psh4upl)
10043 IF(ALLOCATED(psh3upl))DEALLOCATE(psh3upl)
10044 IF(ALLOCATED(err_thk_sh3))DEALLOCATE(err_thk_sh3)
10045 IF(ALLOCATED(err_thk_sh4))DEALLOCATE(err_thk_sh4)
10046 DEALLOCATE(tagnod_sms,nativ_sms,nodxi_sms,tagprt_sms,tagrel_sms,
10047 . indx1_sms, tagslv_rby_sms, tag_lnk_sms, nrwl_sms,
10048 . jad_sms, jdi_sms, jsm_sms,
10049 . jadc_sms,jads_sms,jads10_sms,jadt_sms,
10050 . jadp_sms,jadr_sms,jadtg_sms,
10051 . x_sms, p_sms,y_sms, z_sms, prec_sms, prec_sms3,
10052 . diag_sms3, lt_sms,
10053 . kad_sms, kdi_sms , pk_sms, ltk_sms,
10054 . jadi_sms, jdii_sms, lti_sms, mskyi_sms, iskyi_sms,
10055 . xmom_sms, tagmsr_rby_sms, t2main_sms)
10056C
10057 IF(ALLOCATED(fthreac))DEALLOCATE(fthreac)
10058 IF(ALLOCATED(fthdtm))DEALLOCATE(fthdtm)
10059 IF(ALLOCATED(freac))DEALLOCATE(freac)
10060 IF(ALLOCATED(nodreac))DEALLOCATE(nodreac)
10061 IF(ALLOCATED(grth))DEALLOCATE(grth)
10062 IF(ALLOCATED(igrth))DEALLOCATE(igrth)
10063 IF(ALLOCATED(gresav))DEALLOCATE(gresav)
10064 IF(nrbe3>0)THEN
10065 DEALLOCATE(rbe3%RRBE3)
10066 IF (iparit>0) DEALLOCATE(rbe3%RRBE3_PON)
10067 END IF
10068 IF(impl_s>0.OR.neig>0)THEN
10069 CALL dealloc_impbuf(impbuf_tab)
10070#if defined(MUMPS5)
10071 CALL deallocm_imp(mumps_par)
10072#endif
10073 END IF
10074 IF(imon>0) THEN
10075 IF(nvolu > 0) CALL fvstats(monvol)
10076 CALL stoptime(timers,timer_resol)
10077 IF(imonm>0) CALL printime_interf(interfaces%INTBUF_TAB,ipari,intlist,nbintc,timers%REALTIME(1)*0.01d0)
10078 CALL printime(timers,glob_therm%ITHERM,output)
10079 ELSE
10080 CALL add_elapsed_time_mon_off(timers)
10081 ENDIF
10082 IF (glob_therm%ITHERM_FE > 0 ) CALL thermbilan(glob_therm)
10083 CALL trace_out(3)
10084
10085 DEALLOCATE(wibem, wrbem)
10086 IF(glob_therm%ITHERM_FE > 0 ) DEALLOCATE(fthe,fthesky)
10087 IF(glob_therm%INTHEAT > 0 ) DEALLOCATE(ftheskyi)
10088 IF(glob_therm%NODADT_THERM > 0 ) DEALLOCATE(condn,condnsky)
10089 IF(glob_therm%NODADT_THERM > 0.AND.glob_therm%INTHEAT > 0) DEALLOCATE(condnskyi)
10090!
10091 DEALLOCATE(vrbym,vrrbym,arbym,arrbym)
10092 IF(iplyxfem > 0) THEN
10093 DO i=1,nplymax
10094 DEALLOCATE(ply(i)%A)
10095 DEALLOCATE(ply(i)%V)
10096 DEALLOCATE(ply(i)%U)
10097 DEALLOCATE(plysky(i)%FSKY)
10098 ENDDO
10099 ENDIF
10100 IF(intplyxfem > 0)DEALLOCATE(plyskyi%FSKYI)
10101 DEALLOCATE(ply, plysky)
10102 IF(ALLOCATED(noda_fext))DEALLOCATE(noda_fext)
10103 CALL output_deallocate_noda_pext()
10104 DEALLOCATE(npcont2)
10105C
10106C Deallocte AMS / POFF
10107 IF(ALLOCATED(fr_loc))DEALLOCATE (fr_loc)
10108 IF(ALLOCATED(fr_loci2m))DEALLOCATE (fr_loci2m)
10109 IF(ALLOCATED(icodt0))DEALLOCATE (icodt0)
10110 IF(ALLOCATED(icodr0))DEALLOCATE (icodr0)
10111 IF(ALLOCATED(isensint))DEALLOCATE(isensint)
10112C
10113 CALL free_pinch(pinch_data)
10114
10115 CALL deallocate_joint()
10116
10117 CALL bcs%DEALLOCATE()
10118
10119 IF (ALLOCATED(rby6)) DEALLOCATE(rby6)
10120 IF (ALLOCATED(dxancg)) DEALLOCATE(dxancg)
10121 IF (ALLOCATED(nb25_candt)) DEALLOCATE(nb25_candt)
10122 IF (ALLOCATED(nb25_impct)) DEALLOCATE(nb25_impct)
10123 IF (ALLOCATED(nb25_dst1)) DEALLOCATE(nb25_dst1)
10124 IF (ALLOCATED(nb25_dst2)) DEALLOCATE(nb25_dst2)
10125 DEALLOCATE(igrouc)
10126 DEALLOCATE(igrounc)
10127
10128 IF (ALLOCATED(sph_work%VOXEL%NNOD)) DEALLOCATE(sph_work%VOXEL%NNOD)
10129 IF (ALLOCATED(sph_work%VOXEL%DXMIN)) DEALLOCATE(sph_work%VOXEL%DXMIN)
10130 IF (ALLOCATED(sph_work%VOXEL%DYMIN)) DEALLOCATE(sph_work%VOXEL%DYMIN)
10131 IF (ALLOCATED(sph_work%VOXEL%DZMIN)) DEALLOCATE(sph_work%VOXEL%DZMIN)
10132 IF (ALLOCATED(sph_work%VOXEL%DXMAX)) DEALLOCATE(sph_work%VOXEL%DXMAX)
10133 IF (ALLOCATED(sph_work%VOXEL%DYMAX)) DEALLOCATE(sph_work%VOXEL%DYMAX)
10134 IF (ALLOCATED(sph_work%VOXEL%DZMAX)) DEALLOCATE(sph_work%VOXEL%DZMAX)
10135
10136 RETURN
10137 ENDIF ! MSTOP/=0
10138
10139 CALL trace_out(3)
10140
10141C=============================
10142C END OF EXPLICIT ITERATIVE LOOP
10143C=============================
10144
10145 GO TO 100
10146C
10147 1002 FORMAT(3x,'* IMPLICIT COMPUTATION TERMINATED WITH ',3x,
10148 . 'TOTAL NONLINEAR ITERATIONS:',i8)
10149 1003 FORMAT(3x,'* TOTAL NUM.OF MATRIX FACTORIZATION AND PCG ITERATION:'
10150 . ,2x,i5,2x,i8)
10151
10152
10153c-----------
10154 IF (vipercoupling) THEN
10155C Deallocate indexing arrays
10156 IF(ALLOCATED(viper%ITABM1))DEALLOCATE(viper%ITABM1)
10157 IF(ALLOCATED(viper%IXEM1))DEALLOCATE(viper%IXEM1)
10158 CLOSE(viper%id)
10159 ENDIF
10160c-----------
10161
10162 RETURN
10163 END
accdtdc
subroutine accdtdc(eftsk, eltsk, ienunl, alpha_dc, a, ms, itab)
Definition accdtdc.F:29
accel1
subroutine accel1(a, ff, a2, a1, a0, as, vs, skew)
Definition accel1.F:29
accele
subroutine accele(a, ar, v, ms, in, size_nale, nale, ms_2d, size_npby, npby)
Definition accele.F:32
crk_accele
subroutine crk_accele(addcne_crk, inod_crk, nodlevxf, nodft, nodlt, nodenr, crksky, ms, in, itab)
Definition accele_crk.F:32
accelepinch
subroutine accelepinch(apinch, ms, mspinch, stifpinch, nodft, nodlt, dtnod, dtfac)
Definition accelepinch.F:34
admdiv
subroutine admdiv(ixc, ipartc, ixtg, iparttg, ipart, itask, icontact, iparg, x, ms, in, rcontact, elbuf_tab, nodft, nodlt, igeo, ipm, sh4tree, padmesh, msc, inc, sh3tree, mstg, intg, ptg, acontact, pcontact, err_thk_sh4, err_thk_sh3, mscnd, incnd, pm, mcp, mcpc, mcptg, itherm_fe)
Definition admdiv.F:47
admerr
subroutine admerr(ixc, ixtg, x, iparg, elbuf_tab, ipart, ipartc, iparttg, err_thk_sh4, err_thk_sh3, iad_elem, fr_elem, weight, sh4tree, sh3tree, area_sh4, area_sh3, area_nod, thick_sh4, thick_sh3, thick_nod)
Definition admerr.F:41
admfor0
subroutine admfor0(ixc, ipartc, ixtg, iparttg, ipart, a, stifn, ar, stifr, x, sh4tree, sh3tree, stcont, fthe, condn, nodadt_therm, itherm_fe)
Definition admfor0.F:36
admgvid
subroutine admgvid(iparg, elbuf_tab, fskyv, fsky, fthesky, iadc, iadtg, iflg, igrouc, ngrouc, condnsky, nodadt_therm)
Definition admgvid.F:35
admordr
subroutine admordr(sh4tree, sh3tree, ixc, ixtg)
Definition admordr.F:35
admregul
subroutine admregul(ixc, ipartc, ixtg, iparttg, ipart, itask, iparg, x, ms, in, elbuf_tab, nodft, nodlt, igeo, ipm, sh4tree, msc, inc, sh3tree, mstg, intg, ptg, mscnd, incnd, pm, mcp, mcpc, mcptg, itherm_fe)
Definition admregul.F:44
admvit
subroutine admvit(ixc, ipartc, ixtg, iparttg, ipart, itask, a, v, ar, vr, sh4tree, sh3tree, temp, itherm_fe)
Definition admvit.F:35
agauge0
subroutine agauge0(lgauge, gauge, x, ixc, igaup, ngaup)
Definition agauge.F:560
alefvm_accele
subroutine alefvm_accele(a, ar, nodft, nodlt, nale)
Definition alefvm_accele.F:29
alefvm_main
subroutine alefvm_main(x, v, elbuf_tab, vr, ale_connect, iparg, ixs, nale, itask, nodft, nodlt, ipm, nv46, msnf)
Definition alefvm_main.F:48
alemain
subroutine alemain(timers, pm, geo, x, a, v, ms, wa, elbuf_tab, bufmat, partsav, tf, val2, veul, fv, stifn, fsky, eani, phi, fill, dfill, alph, skew, w, d, dsave, asave, dt2t, dt2save, xcell, iparg, npc, ixs, ixq, ixtg, iads, ifill, icodt, iskew, ims, iadq, neltst, ityptst, iparts, ipartq, itask, nodft, nodlt, nbrcvois, temp, fsavsurf, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, isizxv, iad_elem, fr_elem, fskym, msnf, ipari, segvar, itab, iskwn, diffusion, iresp, volmon, fsav, igrsurf, neltsa, ityptsa, weight, npsegcom, lsegcom, ipm, igeo, itabm1, lenqmv, nv46, aglob, gresav, grth, igrth, lgauge, gauge, mssa, dmels, igaup, ngaup, table, ms0, xdp, igrnod, sfem_nodvar, fskyi, isky, s_sfem_nodvar, intbuf_tab, ixt, igrv, agrav, sensors, lgrav, condnsky, condn, ms_2d, multi_fvm, igrtruss, igrbric, nloc_dmg, id_global_vois, face_vois, ebcs_tab, ale_connectivity, mat_elem, h3d_data, dt, output, need_comm_inter18, idtmins, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, python, matparam, glob_therm)
Definition alemain.F:116
alemuscl_deallocate
subroutine alemuscl_deallocate()
Definition alemuscl_deallocate.F:31
alesub2
subroutine alesub2(nale, v, dsave, icodt, iskew, skew, asave, a, d, neltst, ityptst, itask, nodft, nodlt, dt2save, dt2t, neltsa, ityptsa, nelts, weight, fsky, fskyv)
Definition alesub2.F:39
alewdx
subroutine alewdx(timers, geo, x, d, v, vr, w, wa, wb, skew, pm, xlas, ms, fsav, a, tf, rwbuf, dt2save, python, iparg, ixs, ixq, nodpor, iskew, icodt, elbuf_tab, npf, linale, nprw, las, ipari, nodft, nodlt, itask, iad_elem, fr_elem, nbrcvois, nbsdvois, lnrcvois, lnsdvois, weight, adsky, fsky, iads, fr_wall, nporgeo, procne, fr_nbcc, iadq, xdp, igrnod, dr, intbuf_tab, multi_fvm, ale_connectivity, ddp, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, xcell, xface, wfext)
Definition alewdx.F:75
alloc_elbuf_imp
subroutine alloc_elbuf_imp(elbuf_tab, elbuf_imp, ngroup, iparg)
Definition alloc_elbuf_imp.F:31
assinit_pxfem
subroutine assinit_pxfem(addcne, inod, iad_elem, fr_elem, procne, lisendp, lirecvp)
Definition assadd2.F:490
assinit_crkxfem
subroutine assinit_crkxfem(addcne_crkxfem, inod_crkxfem, iad_elem, fr_elem, procne, lisendp, lirecvp)
Definition assadd2.F:550
assinit
subroutine assinit(addcne, iad_elem, fr_elem, procne, lisendp, lirecvp)
Definition assadd2.F:433
asspar3
subroutine asspar3(a, ar, itask, nodft, nodlt, stifn, stifr, itab, fsky, fskyv, isky, indsky, fskyi, adskyi, partft, partlt, partsav, ms, fthe, fthesky, ftheskyi, greft, grelt, gresav, itherm_fe, intheat)
Definition asspar3.F:37
asspar4
subroutine asspar4(nodes, fsky, fskyv, adsky, fskym, msnf, isky, fskyi, fthe, fthesky, ftheskyi, nodft, nodlt, adskyi, partsav, partft, partlt, itask, greft, grelt, gresav, af, ffsky, msf, adsky_pxfem, inod_pxfem, fskyd, dmsph, condn, condnsky, condnskyi, ms_2d, icnds10, stifnd, forneqs, forneqsky, nfacnit, nodft_2, nodlt_2, fsky_l, glob_therm)
Definition asspar4.F:48
asspar5
subroutine asspar5(nthread, numnod, nodft, nodlt, iroddl, npart, partft, partlt, a, ar, partsav, stifn, stifr, i8a, i8ar, i8stifn, i8stifr, viscn, i8viscn, greft, grelt, gresav, ngpe, nthpart)
Definition asspar5.F:33
asspar
subroutine asspar(nthread, numnod, nodft, nodlt, iroddl, npart, partft, partlt, a, ar, partsav, stifn, stifr, viscn, fthe, itherm_fe, nodadt_therm, stcnd, greft, grelt, gresav, ngpe, nthpart, ialelag, af, dmsph, condn, apinch, stifpinch)
Definition asspar.F:36
asspar_crk
subroutine asspar_crk(addcne_crk, inod_crk, crksky, nodft, nodlt, nodenr, nodlevxf, itab)
Definition asspar_crk.F:33
asspar_sub
subroutine asspar_sub(a, fsky, addcne, nodft_2, nodlt_2, posi, sizesub, sizea)
Definition asspar_sub.F:30
asspar_sub_poff
subroutine asspar_sub_poff(a, nodft, nodlt, posi, sizea, nthread)
Definition asspar_sub_poff.F:30
asspart
subroutine asspart(partft, partlt, partsav, greft, grelt, gresav)
Definition asspart.F:32
assparxx
subroutine assparxx(itsk, intlist, nbintc, ipari, nodadt_therm)
Definition assparxx.F:31
bcs10
subroutine bcs10(nodft, nodlt, icodt, icodr, iskew, skew, a, ar, ms, v, vr)
Definition bcs10.F:33
bcscyc
subroutine bcscyc(ibcscyc, lbcscyc, skew, x, v, a, itab)
Definition bcscyc.F:32
bcsdtth_copy
subroutine bcsdtth_copy(icodt, icodr, icodt0, icodr0, iflag)
Definition bcsdtth.F:218
bmultn
subroutine bmultn(fill, dfill, ims, nodft, nodlt)
Definition bmultn.F:29
cfield_1
subroutine cfield_1(python, icfield, fac, npc, tf, a, v, x, xframe, ms, sensor_tab, weight, ib, itask, iframe, nsensor, wfext)
Definition cfield.F:38
check_ale_comm
subroutine check_ale_comm(iparg_l, elbuf_tab, global_active_ale_element, itherm)
Definition check_ale_comm.F:33
check_edge_state
subroutine check_edge_state(itask, m_edge_nb, s_edge_nb, m_edge_id, s_edge_id, shift_interface, intbuf_tab, newfront, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem, shoot_struct)
Definition check_edge_state.F:38
check_nan_acc
subroutine check_nan_acc(ncycle, nodes)
Definition check_nan_acc.F:36
check_nodal_state
subroutine check_nodal_state(itask, itag, newfront, intbuf_tab, size_sec_node, shift_s_node, inter_sec_node, sec_node_id)
Definition check_nodal_state.F:32
check_remote_surface_state
subroutine check_remote_surface_state(surfarce_nb, surface_id, shift_interface, intbuf_tab, ipari, iad_elem, shoot_struct)
Definition check_remote_surface_state.F:39
check_surface_state
subroutine check_surface_state(itask, surfarce_nb, surface_id, shift_interface, intbuf_tab, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem, shoot_struct)
Definition check_surface_state.F:39
chkload
subroutine chkload(ib, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, itag, itask, itagl, itab, nodes, addcnel, cnel, tagel, iparg, geo, ibufs, nindex, nindg, npresload, loadp_tagdel, iloadp, lloadp, iad_elem)
Definition chkload.F:41
chkmsin
subroutine chkmsin(nodft, nodlt, itab, ms, in, negmas)
Definition chkmsin.F:29
chkstfn3n
subroutine chkstfn3n(nodes, ipari, geo, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, itag, iparg, itask, newfront, itagl, ms, in, adm, itab, itabm1, addcnel, cnel, ind, nindex1, nindex2, nindex3, nindex4, tagel, int24use, ibufseglo, indseglo, ibufs, intbuf_tab, iad_elem)
Definition chkstfn3.F:1275
tagoff3n
subroutine tagoff3n(nodes, geo, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, ixtg, itag, nodft, nodlt, iparg, ev, itask, ixtg1, iad_elem, fr_elem, itab, addcnel, cnel, kxsp, elbuf_tab, tagel, iexlnk, igrnod, dd_r2r, dd_r2r_elem, sdd_r2r_elem, idel7nok_sav, idel7nok_r2r, tagtrimc, tagtrimtg, s_elem_state, elem_state, shoot_struct, global_nb_elem_off)
Definition chkstfn3.F:573
chkstifn
subroutine chkstifn(ipari, ms, intbuf_tab)
Definition chkstifn.F:33
cjoint
subroutine cjoint(a, ar, v, vr, x, fsav, ljoint, ms, in, iadcj, fr_cj, tag_lnk_sms, itask)
Definition cjoint.F:35
clusterf
subroutine clusterf(cluster, elbuf_tab, x, a, ar, skew, ixs, iparg, fcluster, mcluster, h3d_data, geo)
Definition clusterf.F:35
cndint
subroutine cndint(ixc, ipartc, ixtg, iparttg, ipart, itask, a, v, ar, vr, ms, in, nodft, nodlt, x, sh4tree, sh3tree, itab, stifn, stifr, mscnd, incnd)
Definition cndint.F:37
cndordr
subroutine cndordr(ipart, ipartc, iparttg, sh4tree, sh3tree)
Definition cndordr.F:32
collect
subroutine collect(a, itab, weight, nodglob)
Definition collect.F:31
collectm
subroutine collectm(nodnx_sms, itab, weight, nodglob)
Definition collect.F:282
collectt
subroutine collectt(temp, itab, weight, nodglob)
Definition collect.F:379
convec
subroutine convec(ibcv, fconv, npc, tf, x, temp, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition convec.F:38
my_real
#define my_real
Definition cppsort.cpp:32
crk_coord_ini
subroutine crk_coord_ini(addcne_crk, inod_crk, nodft, nodlt, x, nodlevxf)
Definition crk_coord_ini.F:33
crk_vitesse2
subroutine crk_vitesse2(iparg, ngrouc, igrouc, elcutc, crkedge, nodedge, ixc, ixtg, xedge4n, xedge3n, iadc_crk, iel_crk, inod_crk, itab)
Definition crk_vitesse2.F:38
crk_zero_accel
subroutine crk_zero_accel(addcne_crk, inod_crk, nodft, nodlt, nodlevxf)
Definition crk_vitesse.F:137
crk_zero_fsky
subroutine crk_zero_fsky(crksky, addcne_crk, inod_crk, nodft, nodlt, nodlevxf)
Definition crk_vitesse.F:186
crk_vitesse
subroutine crk_vitesse(addcne_crk, inod_crk, nodlevxf, nodft, nodlt, x, v, vr, a, ar, itab)
Definition crk_vitesse.F:34
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
damping44
subroutine damping44(dim, v, vr, a, ar, ms, in, dampr, damp, igrnod, weight, tagslv_rby, wfext)
Definition damping.F:794
damping51
subroutine damping51(dim, v, vr, a, ar, ms, in, dampr, damp, igrnod, weight, tagslv_rby, skew, icontact, i_damp_rdof_tab, ndamp_vrel, id_damp_vrel, fr_damp_vrel, iparit, ispmd, wfext)
Definition damping.F:41
dealloc_shoot_inter
subroutine dealloc_shoot_inter(shoot_struct)
Definition dealloc_shoot_inter.F:31
prepare_debug
subroutine prepare_debug(itab, numnod)
Definition debug_mod.F:226
depla
subroutine depla(v, d, x, vr, dr, xdp, ddp, numnod)
Definition depla.F:29
deplafakeige
subroutine deplafakeige(x, v, intbuf_tab, kxig3d, ixig3d, igeo, knot, wige, knotlocpc, knotlocel)
Definition deplafakeige.F:35
deplapinch
subroutine deplapinch(vpinch, dpinch, xpinch, nodft, nodlt)
Definition deplapinch.F:32
desacti
subroutine desacti(ixs, ixq, ixc, ixp, ixt, ixr, ixtg, iparg, iactiv, nsensor, sensor_tab, fsky, x, elbuf_tab, ibcv, fconv, ibcr, fradia, igroups, factiv, temp, mcp, pm, mcp_off, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, glob_therm)
Definition desacti.F:44
the
end diagonal values have been computed in the(sparse) matrix id.SOL
disp_vel_saved_cload
subroutine disp_vel_saved_cload(v, d, vr, dr, ib, dpl0cld, vel0cld, nibcld, nconld, iroddl, numnod)
Definition disp_vel_saved_cload.F:31
dtnoda
subroutine dtnoda(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, nodadt_therm, adi, rbym, arby, arrby, weight_md, mcp, mcp_off, condn, nale, h3d_data)
Definition dtnoda.F:42
dtnodamp
subroutine dtnodamp(itab, ms, in, stifn, stifr, dt2t, weight, igrnod, dampr, istop, i_damp_rdof_tab, icontact, ixc, x)
Definition dtnodamp.F:33
dtnodams
subroutine dtnodams(nodft, nodlt, neltst, ityptst, itab, ms, in, stifn, stifr, dt2t, dmast, dinert, adt, adm, imsch, weight, a, ar, igrnod, adi, rbym, arby, arrby, ismsch, nodnx_sms, diag_sms, npby, tagmsr_rby_sms, h3d_data)
Definition dtnodams.F:43
dtnodarayl
subroutine dtnodarayl(ms, in, stifn, stifr, dt2t, igrnod, dampr)
Definition dtnodarayl.F:35
ebcclap
subroutine ebcclap(v, a, fv, ebcs_tab)
Definition ebcclap.F:36
ebcs_extrapol
subroutine ebcs_extrapol(fv, np, tf, ebcs_tab)
Definition ebcs_extrapol.F:33
sav_buf_point
void sav_buf_point(int *buf, int *i)
Definition eng_callback_c.c:58
sms_ini_err
subroutine sms_ini_err(nprw, lprw, kinet)
Definition sms_init.F:2730
sms_ini_rby
subroutine sms_ini_rby(kinet, nprw, lprw, npby, lpby, tagmsr_rby_sms, tagslv_rby_sms)
Definition sms_init.F:103
sms_ini_int
subroutine sms_ini_int(ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc)
Definition sms_init.F:2567
sms_ini_kin_2
subroutine sms_ini_kin_2(ilink, rlink, nnlink, lnlink, tag_lnk_sms, fr_ll, fr_rl, weight, itab, ljoint, iadcj, fr_cj, nprw, lprw, fr_wall, nrwl_sms, iad_elem, fr_elem)
Definition sms_init.F:2468
sms_ini_part
subroutine sms_ini_part(igrpart, tagprt_sms)
Definition sms_init.F:35
soltosphf
subroutine soltosphf(a, spbuf, ixs, kxsp, ipartsp, nod2sp, irst, ngrounc, igrounc, iparg, stifn, sol2sph, sph2sol, elbuf_tab, itask, nodft, nodlt, isky, fskyi, igeo, sol2sph_typ)
Definition soltosph.F:44
cumultime_mp
subroutine cumultime_mp(taille, iparg, ixc, ixq, ixt, ixp, ixtg, ixr, ixs, kxig3d, ipm, igeo, geo, poin_ump, cputime_mp, nbr_gpmp, cputime_mp_glob, tab_ump, pm, bufmat, tabmp_l, tab_mat)
Definition timer.F:2709
add_elapsed_time_mon_off
subroutine add_elapsed_time_mon_off(t)
Definition timer.F:3199
err_thk
subroutine err_thk(ixc, ixtg, iparg, iad_elem, fr_elem, weight, x, elbuf_tab, ipart, ipartc, iparttg, itask, nodft, nodlt, err_thk_sh4, err_thk_sh3, sh4tree, sh3tree, area_sh4, area_sh3, area_nod, thick_sh4, thick_sh3, thick_nod)
Definition err_thk.F:44
euldx
subroutine euldx(v, d, x, ddp, nale, nodft, nodlt)
Definition euldx.F:29
fail_wind_frwave_init
subroutine fail_wind_frwave_init(ngroup)
Definition fail_wind_frwave_init.F:31
fequilibre
subroutine fequilibre(a, fzero, ixc, ixtg)
Definition fequilibre.F:29
find_dt_for_targeted_added_mass
subroutine find_dt_for_targeted_added_mass(ms, stifn, dtsca, igrp_usr, target_dt, percent_addmass, percent_addmass_old, totmas, weight, igrnod, icnds10)
Definition find_dt_for_targeted_added_mass.F:41
find_edge_inter
subroutine find_edge_inter(itab, shoot_struct, ixs, ixs10, ixc, ixtg, ixq, ixt, ixp, ixr, geo, ngroup, igroups, iparg)
Definition find_edge_inter.F:35
find_surface_inter
subroutine find_surface_inter(itab, shoot_struct, ixs, ixs10, ixc, ixtg, ngroup, nparg, igroups, iparg)
Definition find_surface_inter.F:36
fixfingeo
subroutine fixfingeo(python, nodes, ibfv, npc, tf, vel, sensor_tab, cptreac, nodreac, nodnx_sms, nsensor, fthreac, wfext)
Definition fixfingeo.F:40
fixflux
subroutine fixflux(ibfflux, fbfflux, npc, tf, x, ixs, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition fixflux.F:40
fixtemp
subroutine fixtemp(python, ibft, val, temp, npc, tf, nsensor, sensor_tab, glob_therm, snpc)
Definition fixtemp.F:40
fixvel
subroutine fixvel(ibfv, a, v, npc, tf, vel, ms, x, skew, ar, vr, in, nsensor, sensor_tab, weight, depla, rby, iframe, xframe, dr, nodnx_sms, nodes, tt_double, depla_double, python, wfext)
Definition fixvel.F:42
flow0
subroutine flow0(iflow, rflow, wiflow, wrflow, x, v, a, npc, tf, sensor_tab, nbgauge, lgauge, gauge, nsensor, igrv, agrv, nfunct, python, wfext)
Definition flow0.F:40
flow1
subroutine flow1(iflow, rflow, nbgauge, a)
Definition flow1.F:31
flow_accele
subroutine flow_accele(nale, ms, a, v, nodft, nodlt)
Definition flow_accele.F:29
flow_depla
subroutine flow_depla(nale, v, d, nodft, nodlt)
Definition flow_depla.F:30
flow_vitesse
subroutine flow_vitesse(nale, a, v, fzero, nodft, nodlt, w, vs, ifoam)
Definition flow_vitesse.F:30
forani1
subroutine forani1(fani, a, nfia, nfea, nfoa, nodft, nodlt, fext, h3d_data)
Definition forani1.F:31
forani2
subroutine forani2(fani, a, nfia, nfea, nodft, nodlt, h3d_data)
Definition forani2.F:31
forani3
subroutine forani3(fani, a, ms, nfea, nodft, nodlt, h3d_data)
Definition forani3.F:31
forcefingeo
subroutine forcefingeo(ibfv, npc, tf, a, v, x, vel, sensor_tab, fsky, fext, itabm1, h3d_data, nsensor, python, wfext, nodes)
Definition forcefingeo.F:41
forcepinch
subroutine forcepinch(ib, fac, npc, tf, a, v, x, skew, ar, vr, nsensor, sensor_tab, weight, tfexc, iadc, fsky, fskyv, fext, h3d_data, apinch, vpinch, python, wfext)
Definition forcepinch.F:46
forint
subroutine forint(timers, python, pm, geo, x, a, ar, v, vr, ms, in, w, elbuf, wa, val2, veul, fv, stifn, stifr, fsky, tf, bufmat, partsav, d, dr, eani, elbuf_tab, tani, fani, fsav, sensors, nloc_dmg, skew, anin, dt2t, bufgeo, itab, iads, iadq, iadt, iadp, mat_elem, iadr, iparg, ale_connect, npc, ixs, ixq, ixt, ixp, ixr, neltst, ipari, ityptst, nstrf, ipart, iparts, ipartq, ipartt, ipartp, ipartr, ipartur, fr_wave, rby, secfcum, agrav, igrv, lgrav, ixs10, ixs20, iads10, iads20, ixs16, iads16, w16, fskym, msnf, igeo, ipm, xsec, itask, temp, fthe, fthesky, igrounc, ngrounc, gresav, grth, igrth, xdp, mssa, dmels, mstr, dmeltr, msp, dmelp, msrt, dmelrt, table, vf, af, df, wf, ffsky, afglob, nbsdvois, nercvois, nesdvois, lercvois, lesdvois, phi1, phi2, msf, nodft, nodlt, flg_kj2, por, icontact, ifoam, sfem_nodvar, kxig3d, ixig3d, knot, wige, condn, condnsky, s_sfem_nodvar, tagprt_sms, itagnd, ms_2d, nale, stressmean, knotlocpc, knotlocel, subset, flag_slipring_update, flag_retractor_update, h3d_data, ifthe, icondn, dt, output, sbufmat, snpc, stf, nodadt, dtfac1, dtmin1, idtmin, iout, istdo, idtmins, dtfacs, nsvois, iresp, maxfunc, userl_avail, glob_therm, imon_mat, dtmins, sanin)
Definition forint.F:120
forintc
subroutine forintc(timers, pm, geo, x, a, ar, v, vr, ms, in, nloc_dmg, wa, stifn, stifr, fsky, crksky, tf, bufmat, partsav, d, mat_elem, dr, eani, tani, fani, fsav, sensors, skew, anin, failwave, dt2t, thke, bufgeo, iadc, iadtg, iparg, npc, ixc, ixtg, neltst, ipari, ityptst, nstrf, ipart, ipartc, iparttg, secfcum, fsavd, group_param_tab, fzero, ixtg1, iadtg1, igeo, ipm, madfail, xsec, itask, mcp, temp, fthe, fthesky, ms_ply, zi_ply, inod_pxfem, xedge4n, xedge3n, iel_pxfem, iadc_pxfem, igrouc, ngrouc, gresav, grth, igrth, mstg, dmeltg, msc, dmelc, table, knod2elc, ptg, msz2, inod_crk, iel_crk, iadc_crk, elcutc, nodenr, ibordnode, nodedge, crknodiad, elbuf_tab, xfem_tab, condn, condnsky, crkedge, stack, itab, glob_therm, drape_sh4n, drape_sh3n, subset, xdp, vpinch, apinch, stifpinch, drapeg, output, dt, snpc, stf, userl_avail, maxfunc, sbufmat)
Definition forintc.F:89
forintp
subroutine forintp(timers, pm, geo, x, a, v, ms, w, elbuf_tab, wa, fv, stifn, pld, bufmat, partsav, nloc_dmg, fsav, dt2t, iads, iparg, npc, neltst, ityptst, ipart, itab, isky, bufgeo, fskyi, xframe, kxsp, ixsp, nod2sp, ipartsp, spbuf, ispcond, ispsym, xspsym, vspsym, wasph, lprtsph, lonfsph, waspact, isphio, vsphio, sphveln, itask, ipm, gresav, grth, igrth, table, lgauge, gauge, ngrounc, igrounc, ixs, irst, sol2sph, sph2sol, fskyv, fsky, igeo, temp, fthe, ftheskyi, sphg_f6, wsmcomp, sol2sph_typ, mat_elem, output, sph_iord1, snpc, stf, sbufmat, idtmins, nsvois, iresp, maxfunc, imon_mat, userl_avail, impl_s, idyna, dt, glob_therm, sph_work, wfext, sensors)
Definition forintp.F:87
forints
subroutine forints(pm, geo, x, a, ar, v, vr, ms, in, w, elbuf, val2, veul, fv, stifn, stifr, fsky, tf, bufmat, partsav, fani, fsav, skew, dt2t, iads, iparg, npc, ixs, neltst, ityptst, ipart, iparts, itab, fskyi, bufgeo, kxx, ixx, isky, ipartx, gresav, grth, igrth, elbuf_tab)
Definition forints.F:48
fvbag0
subroutine fvbag0(monvol, volmon, x, sensor_tab, v, a, npc, tf, nsensor, fsav, ifvmesh, icontact, lgauge, gauge, igeo, geo, pm, ipm, iparg, igrouptg, igroupc, elbuf_tab, fext, flag, h3d_data, itab, weight, wfext, python)
Definition fvbag0.F:45
fvcopy
subroutine fvcopy(monvol)
Definition fvcopy.F:32
fv_switch_crit
subroutine fv_switch_crit(monvol, check_npolh)
Definition fvdim.F:74
fvrezone0
subroutine fvrezone0(monvol, x)
Definition fvrezone.F:33
fvstats
subroutine fvstats(monvol)
Definition fvstats.F:36
fvupd0
subroutine fvupd0(monvol, x, v, volmon, smonvol, svolmon)
Definition fvupd.F:34
fxbyfor
subroutine fxbyfor(fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, a, ar, x, fxbmvn, fxbmcd, fxbse, fxbsv, fxbelm, fxbsig, elbuf, partsav, elbuf_tab, fsav, fxbfp, fxbefw, fxbfc, d, dt2t, ityptst, neltst, fxbgrvi, fxbgrvr, igrv, npc, tf, fxbgrp, fxbgrw, iparg, nsensor, sensor_tab, iad_elem, fr_elem, agrv, python)
Definition fxbyfor.F:48
fxbypid
subroutine fxbypid(iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, fxbipm, fxbnod, onof, itag, onfelt, elbuf_str)
Definition fxbypid.F:38
fxbyvit
subroutine fxbyvit(fxbipm, fxbnod, fxbmod, fxbglm, fxblm, fxbmvn, fxbmcd, fxbse, fxbsv, fxbvit, fxbacc, fxbrpm, v, vr, a, ar, ms, in, weight, fsav, fxbfc, fxbedp, iad_elem, fr_elem)
Definition fxbyvit.F:39
fxgrvcor
subroutine fxgrvcor(fxbipm, fxbgrvi, a, igrv, agrv, npc, tf, ms, v, skew, fxbgrw, iad_elem, fr_elem, wfext, python)
Definition fxgrvcor.F:36
gravit
subroutine gravit(igrv, agrv, npc, tf, a, v, x, skew, ms, sensor_tab, weight, ib, itask, nsensor, python, wfext)
Definition gravit.F:38
gravit_fvm_fem
subroutine gravit_fvm_fem(igrv, agrv, npc, tf, a, v, x, skew, ms, sensor_tab, weight, ib, itask, nale, nsensor, python, wfext)
Definition gravit_fvm_fem.F:39
zero1
subroutine zero1(r, n)
Definition hm_read_rbe3.F:1481
i14ist
subroutine i14ist(ipari, intbuf_tab, igrsurf, bufsf)
Definition i14ist.F:32
i14wfs
subroutine i14wfs(output, ipari, intbuf_tab, igrsurf, fsav)
Definition i14wfs.F:33
i18main_kine_1
subroutine i18main_kine_1(ipari, intbuf_tab, x, v, a, iskew, skew, lcod, wa, ms, itab, jtask, kinet, stifn, mtf, cand_sav, int18add, iad_elem, fr_elem, tagpene, h3d_data, multi_fvm, ale_ne_connect, xcell, xcell_remote)
Definition i18main_kine.F:51
i18main_kine_2
subroutine i18main_kine_2(ipari, intbuf_tab, x, v, a, iskew, skew, lcod, wa, ms, itab, fsav, jtask, kinet, stifn, mtf, cand_sav, fcont, int18add, iad_elem, fr_elem, h3d_data)
Definition i18main_kine.F:330
spmd_i24_prepare
subroutine spmd_i24_prepare(mode, ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc, iad_i24, sfr_i24, fr_i24, i24maxnsne)
Definition i24_prepare.F:35
i24e2e_fictive_nodes_update
subroutine i24e2e_fictive_nodes_update(intlist, nbintc, ipari, intbuf_tab, x, v, ms, itab, xyz, numnod, nsh_offset)
Definition i24for3e.F:708
i24nitschfor3
subroutine i24nitschfor3(ipari, intbuf_tab, iparit, stressmean, intlist, nbintc, x, iads, forneqs, forneqsky, itab, ixs, iads10, iads20, iads16, nfacnit)
Definition i24nitschfor3.F:37
i24pxfem
subroutine i24pxfem(ipari, intbuf_tab, wagap, iad_elem, fr_elem)
Definition i24pxfem.F:35
spmd_i25_prepare
subroutine spmd_i25_prepare(mode, ipari, intbuf_tab, iad_elem, fr_elem, intlist, nbintc, iad_i25, sfr_i25, fr_i25)
Definition i25_prepare.F:35
imp_buck
subroutine imp_buck(pm, geo, ipm, igeo, elbuf, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, iparg, tf, npc, fr_wave, w16, bufmat, thke, bufgeo, nsensor, sensor_tab, rby, skew, wa, icodt, icodr, iskew, ibfv, vel, lpby, npby, itab, weight, ms, in, ipari, intbuf_tab, x, itask, cont, icut, xcut, fint, fext, fopt, anin, nstrf, rwbuf, nprw, tani, dd_iad, eani, ipart, nom_opt, igrsurf, bufsf, idata, rdata, kxx, ixx, kxsp, ixsp, nod2sp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, v, a, graphe, partsav, xframe, dirul, fncont, ftcont, temp, sh4tree, sh3tree, err_thk_sh4, err_thk_sh3, iframe, lprw, elbuf_tab, fsav, fsavd, rwsav, ar, irbe3, lrbe3, frbe3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, frwl6, ibcl, forc, irbe2, lrbe2, iad_rbe2, fr_rbe2, weight_md, cluster, fcluster, mcluster, xfem_tab, ale_connect, w, nv46, nercvois, nesdvois, lercvois, lesdvois, crkedge, stack, dimfb, fbsav6, stabsen, tabsensor, indx_crk, xedge4n, xedge3n, sph2sol, stifn, stifr, drape_sh4n, drape_sh3n, h3d_data, subset, igrnod, fcont_max, fncontp2, ftcontp2, nddl0, nnzk0, impbuf_tab, drapeg, matparam_tab, glob_therm, output)
Definition imp_buck.F:106
imp_dt2
subroutine imp_dt2(dt_e)
Definition imp_dt.F:29
imp_sol_init
subroutine imp_sol_init(geo, npby, lpby, itab, ipari, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, elbuf, nint7, nbintc, x, dmcp, fr_elem, iad_elem, fr_i2m, iad_i2m, nprw, num_imp1, num_impl, monvol, igrsurf, fr_mv, ipm, igeo, iad_rby, fr_rby, sh4tree, sh3tree, irbe3, lrbe3, fr_rbe3m, iad_rbe3m, irbe2, lrbe2, ibfv, vel, elbuf_tab, iframe, intbuf_tab, nddl0, nnzk0, impbuf_tab)
Definition imp_sol_init.F:62
imp_restarcp
subroutine imp_restarcp(x, v, vr, geo, igeo, dmcp, impbuf_tab)
Definition imp_sol_init.F:507
imp_fanie
subroutine imp_fanie(fani, fext, nfia, nfea, nodft, nodlt, h3d_data)
Definition imp_solv.F:4781
imp_solv
subroutine imp_solv(timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, graphe, fac_k, ipiv_k, nkcond, nsensor, monvol, igrsurf, fr_mv, volmon, dirul, nodglob, mumps_par, cddlp, isendto, irecvfrom, newfront, imsch, i2msch, isizxv, ilenxv, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, kinet, num_imp1, temp, dt2prev, waint, lgrav, sh4tree, sh3tree, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, irbe3, lrbe3, frbe3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, frwl6, irbe2, lrbe2, intbuf_tab_c, ikine, diag_sms, icfield, lcfield, cfield, count_remslv, count_remslve, elbuf_tab, elbuf_imp, xdp, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, multi_fvm, igrbric, igrsh4n, igrsh3n, igrbeam, forneqs, maxdgap, nddl0, nnzk0, it_t, impbuf_tab, cptreac, fthreac, nodreac, drapeg, interfaces, th_surf, dpl0cld, vel0cld, snpc, stf, glob_therm, wfext_md)
Definition imp_solv.F:173
imp_fanii
subroutine imp_fanii(fani, fint, nfia, nodft, nodlt, h3d_data)
Definition imp_solv.F:4734
deallocm_imp
subroutine deallocm_imp(mumps_par)
Definition imp_solv.F:4908
dealloc_impbuf
subroutine dealloc_impbuf(impbuf_tab)
Definition imp_solv.F:9078
re2int5
subroutine re2int5(nt_imp, numimp, ns_imp, ne_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5255
imp_chkm
subroutine imp_chkm(timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, nsensor, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, dirul, lgrav, irbe3, lrbe3, frbe3, frwl6, irbe2, lrbe2, icfield, lcfield, cfield, elbuf_tab, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, nddl0, nnzk0, impbuf_tab, cptreac, fthreac, nodreac, drapeg, th_surf, dpl0cld, vel0cld, snpc, stf, wfext_md, igrsurf)
Definition imp_solv.F:3132
re2int7
subroutine re2int7(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5352
imp_fout
subroutine imp_fout(fani, a, ar, nfia, nfea, nodft, nodlt, h3d_data, impbuf_tab)
Definition imp_solv.F:4676
spmd_mumps_ini
subroutine spmd_mumps_ini(mumps_par, sym)
Definition imp_spmd.F:498
thickvar
subroutine thickvar(elbuf_tab, iparg, thksh4_var, thksh3_var, thknod, ixc, ixtg)
Definition inintr_thkvar.F:31
init_i25_edge
subroutine init_i25_edge(nledge, ninter, npari, ipari, intbuf_tab)
Definition init_i25_edge.F:31
init_interf_sorting_strategy
subroutine init_interf_sorting_strategy(intbuf_tab, ninter)
Definition init_interf_sorting_strategy.F:32
init_nodal_state
subroutine init_nodal_state(ipari, shoot_struct, intbuf_tab, iad_elem, fr_elem, itab, nodes, geo, addcnel, cnel, ixs, ixc, ixt, ixp, ixr, ixtg, size_addcnel, size_cnel, numelsg, numelqg, numelcg, numeltrg, numelpg, numelrg, numeltgg, ixs10)
Definition init_nodal_state.F:44
init_trim
subroutine init_trim(ninter)
Definition init_trim.F:31
inixfem
subroutine inixfem(elbuf_tab, xfem_tab, iparg, ixc, ixtg, ngrouc, igrouc, elcutc, iadc_crk, iel_crk, inod_crk, addcne_crk, x, knod2elc, nodedge, crknodiad, iad_edge, fr_edge, fr_nbedge, nodlevxf, crkedge, xedge4n, xedge3n)
Definition inixfem.F:45
int18_alloc
subroutine int18_alloc(number_inter18, inter18_list, multi_fvm, ipari, xcell_remote, nspmd)
Definition int18_alloc.F:34
int18_law151_omp_accumulation
subroutine int18_law151_omp_accumulation(multi_fvm)
Definition int18_law151_omp_accumulation.F:33
int18_law151_update
subroutine int18_law151_update(itask, multi_fvm, igrbric, ipari, ixs, igroups, iparg, elbuf_tab, force_int, x, v, ms, kinet, x_append, v_append, mass_append, kinet_append)
Definition int18_law151_update.F:38
intal1
subroutine intal1(ipari, x, v, a, iskew, skew, lcod, wa, ms, itab, fsav, intbuf_tab, fcont, fncont, h3d_data)
Definition intal1.F:39
inter_nodal_areas
subroutine inter_nodal_areas(ixs, ixc, ixtg, fasolfr, x, iad_elem, fr_elem, weight, ixq, segquadfr, ixs10, intarean)
Definition inter_nodal_areas.F:33
inter_struct_init
subroutine inter_struct_init(inter_struct, sort_comm)
Definition inter_struct_init.F:33
intfop1
subroutine intfop1(output, ipari, x, a, icodt, fsav, wa, v, ms, dt2t, neltst, ityptst, itab, stifn, npc, tf, fskyi, isky, vr, fcont, in, igrsurf, bufsf, fncont, ftcont, icontact, rcontact, num_imp, ns_imp, ne_imp, nt_imp, sensor_tab, intbuf_tab, h3d_data, nsensor)
Definition intfop1.F:49
intfop2
subroutine intfop2(timers, ipari, x, a, igroups, ale_connectivity, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, tf, fskyi, isky, vr, fcont, secfcum, jtask, niskyfi, kinet, newfront, nstrf, icontact, viscn, xcell, num_imp, ns_imp, ne_imp, ind_imp, nt_imp, fr_i18, igrbric, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, iparg, nsensor, pm, intstamp, weight, niskyfie, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, mskyi_sms, iskyi_sms, nodnx_sms, int18add, fcontg, fncontg, ftcontg, nodglob, ms0, npc, wa, sensor_tab, qfricint, ncont, indexcont, tagcont, inod_pxfem, ms_ply, wagap, elbuf_tab, condn, condnskyi, nv46, sfbsav6, fbsav6, nodadt_therm, theaccfact, isensint, nisubmax, nb25_candt, nb25_impct, nb25_dst1, nb25_dst2, ixig3d, kxig3d, wige, knot, igeo, multi_fvm, h3d_data, pskids, t2main_sms, forneqs, knotlocpc, knotlocel, apinch, stifpinch, t2fac_sms, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, interfaces, xcell_remote)
Definition intfop2.F:85
intfop8
subroutine intfop8(ipari, x, a, icodt, fsav, wa, v, ms, dt2t, neltst, ityptst, itab, stifn, npc, tf, fskyi, isky, vr, fcont, in, bufsf, fncont, nsensor, ftcont, icontact, rcontact, num_imp, ns_imp, ne_imp, nt_imp, sensor_tab, intbuf_tab, h3d_data, pskids, tagncont, kloadpinter, loadpinter, loadp_hyd_inter)
Definition intfop8.F:46
intstamp_ass
subroutine intstamp_ass(intstamp, ms, in, a, ar, stifn, stifr, weight, wfext)
Definition intstamp_ass.F:37
intstamp_dt
subroutine intstamp_dt(intstamp, ipari, neltst, ityptst, dt2t, nodnx_sms, diag_sms, ms, v, stifn, stifr)
Definition intstamp_dt.F:34
intstamp_init
subroutine intstamp_init(intstamp, icodr)
Definition intstamp_init.F:31
intstamp_move
subroutine intstamp_move(intstamp, npc, tf, skew, nodnx_sms, v, vr, ms, x, d, npby, rby)
Definition intstamp_move.F:34
intti1
subroutine intti1(ipari, x, v, a, vr, ar, wa, ms, in, weight, stifn, stifr, khie, itab, fr_i2m, iad_i2m, addcni2, procni2, iadi2, i2msch, dmast, adm, skew, i2size, fr_nbcci2, adi, igeo, bufgeo, fsav, npf, tf, fncont, iad_elem, fr_elem, nodnx_sms, dmint2, pdama2, nb_fri2m, fr_loci2m, dt2t, neltst, ityptst, intbuf_tab, temp, mcp, fthe, condn, glob_therm, h3d_data, t2fac_sms, fncontp, ftcontp)
Definition intti1.F:57
intti2
subroutine intti2(ipari, x, v, a, vr, ar, khie, ms, in, weight, wa, skew, intbuf_tab)
Definition intti2.F:37
inttri
subroutine inttri(timers, ipari, x, w, errors, v, ms, in, iad_elem, fr_elem, vr, isendto, irecvfrom, newfront, itask, wag, dt2t, itab, neltst, ityptst, weight, intlist, nbintc, kinet, dretri, islen7, irlen7, islen11, irlen11, temp, igrbric, igrsh3n, eminx, ixs, ixs16, ixs20, islen17, irlen17, irlen7t, islen7t, num_imp, ind_imp, intstamp, thknod, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, renum, nsnfiold, xslv, xmsr, vslv, vmsr, size_t, nodnx_sms, dxancg, ikine, diag_sms, count_remslv, count_remslve, ale_connectivity, ixtg, sensors, delta_pmax_gap, intbuf_tab, delta_pmax_gap_node, iad_frnor, fr_nor, nb25_candt, nb25_impct, nb25_dst1, nb25_dst2, intlist25, iad_fredg, fr_edg, main_proc, nativ_sms, i_opt_stok, multi_fvm, iparg, elbuf_tab, h3d_data, t2main_sms, lskyi_sms_new, forneqs, int7itied, idel7nok_sav, maxdgap, t2fac_sms, icodt, iskew, fskyn25, addcsrect, procnor, inter_struct, sort_comm, renum_siz, nodnx_sms_siz, temp_siz, interfaces, glob_therm, component)
Definition inttri.F:133
joint_block_stiffness
subroutine joint_block_stiffness(itab, ms, in, stifn, stifr, weight, ixr, ipart, x, ipartr, igeo, geo, npby, iparg, elbuf_tab, dmas, diner)
Definition joint_block_stiffness.F:35
joint_elem_timestep
subroutine joint_elem_timestep(ms, in, stifn, stifr, ixr, ipart, ipartr, igeo, geo, npby, iparg, elbuf_tab, dt2t, neltst, ityptst, nrbody, itab)
Definition joint_elem_timestep.F:33
kine_seatbelt_force
subroutine kine_seatbelt_force(a, stifn, flag_slipring_update, flag_retractor_update)
Definition kine_seatbelt_force.F:34
kine_seatbelt_vel
subroutine kine_seatbelt_vel(a, v, x, xdp)
Definition kine_seatbelt_vel.F:32
lag_mult
subroutine lag_mult(ipari, x, a, wat, v, ms, in, vr, itask, wag, itab, ixs, ixs20, ixs16, igrnod, fani, fsav, skew, ar, lambda, lagbuf, ibcslag, ixs10, gjbufi, gjbufr, ibmpc, rbmpc, npbyl, lpbyl, ibfv, vel, npf, tf, newfront, icontact, rwbuf, lprw, nprw, rbyl, d, dr, kinet, nsensor, sensor_tab, intbuf_tab, h3d_data, igrbric, python, nodes)
Definition lag_mult.F:70
lag_multp
subroutine lag_multp(ipari, x, a, wat, v, ms, in, vr, wag, itab, ixs, ixs20, ixs16, fani, fsav, skew, ar, lambda, lagbuf, ibcslag, ixs10, gjbufi, gjbufr, ibmpc, rbmpc, npbyl, lpbyl, ibfv, vel, npf, tf, newfront, icontact, rwbuf, lprw, nprw, rbyl, d, dr, kinet, nodglob, weight, nbncl, nbikl, nbnodl, nbnodlr, fr_lagf, llagf, iad_elem, fr_elem, intbuf_tab, h3d_data, python, nodes)
Definition lag_mult.F:444
load_pressure
subroutine load_pressure(iloadp, loadp, lloadp, npc, tf, a, v, x, skew, sensor_tab, iadc, fsky, fext, tagncont, nsensor, loadp_hyd_inter, h3d_data, python, npresload, loadp_tagdel, th_surf, pblast, wfext)
Definition load_pressure.F:46
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
manctr
subroutine manctr(sensors, h3d_data)
Definition manctr.F:39
modsti
subroutine modsti(nodft, nodlt, stifn, viscn, ms)
Definition modsti.F:29
monvol0
subroutine monvol0(monvol, volmon, x, a, npc, tf, v, normal, fsav, nsensor, sensor_tab, igrsurf, fr_mv, iadmv, sicontact, sporo, fsky, icontact, poro, iparg, elbuf_tab, geo, igeo, pm, ipm, ipart, ipartc, iparttg, igroupc, igrouptg, fext, flag, h3d_data, t_monvol, frontier_global_mv, output, python)
Definition monvol0.F:61
movfra1
subroutine movfra1(xframe, iframe, x, v, a, ar)
Definition movfram.F:31
movfra_imp
subroutine movfra_imp(xframe, iframe, x, v, a, vr, ar, d)
Definition movfram.F:688
movfra2
subroutine movfra2(xframe, iframe, x, v, vr, d)
Definition movfram.F:371
multi_deallocate
subroutine multi_deallocate(multi_fvm)
Definition multi_deallocate.F:32
multi_velocity_backup
subroutine multi_velocity_backup(itask, multi_fvm, n2d, numels, numelq, numeltg)
Definition multi_velocity_backup.F:31
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
mvoludt
subroutine mvoludt(monvol, volmon)
Definition mvoludt.F:29
acceleration_dp_mod
Definition acceleration_dp_mod.F:28
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
aleanim_mod
Definition aleanim_mod.F:40
aleanim_mod::fani_cell
type(fani_cell_) fani_cell
Definition aleanim_mod.F:55
aleflow_mod
Definition aleflow_mod.F:30
aleflow_mod::ifoam_cont
integer, dimension(:), allocatable ifoam_cont
Definition aleflow_mod.F:40
aleflow_mod::ifoam
integer, dimension(:), allocatable ifoam
Definition aleflow_mod.F:40
alefvm_mod
Definition alefvm_mod.F:88
alemuscl_mod
Definition alemuscl_mod.F:54
alemuscl_mod::alemuscl_param
type(alemuscl_param_) alemuscl_param
Definition alemuscl_mod.F:75
alemuscl_mod::alemuscl_buffer
type(alemuscl_buffer_) alemuscl_buffer
Definition alemuscl_mod.F:74
anim_mod
Definition anim_mod.F:96
array_mod
Definition array_mod.F:51
check_mod
Definition check_mod.F:34
cluster_mod
Definition cluster_mod.F:40
crackxfem_mod
Definition crackxfem_mod.F:121
debug_chksm_mod
Definition spmd_flush_accel.F:28
debug_chksm_mod::spmd_flush_accel
subroutine spmd_flush_accel(ncycle, ispmd, nspmd, numnod, numnodg, numnodm, a, itab, weight, nodglob)
Definition spmd_flush_accel.F:45
debug_mod
Definition debug_mod.F:45
debug_mod::nc_debug
integer nc_debug
Engine Cycle number.
Definition debug_mod.F:49
diffusion_mod
Definition diffusion_mod.F:36
drape_mod
Definition drape_mod.F:54
dsgraph_mod
Definition dsgraph_mod.F:31
dt_mod
Definition dt_mod.F:79
dtdc_mod
Definition dtdc_mod.F:31
dynlib_mod
Definition dynlib_mod.F:31
dynlib_mod::id_engine_user_initialize
integer, parameter id_engine_user_initialize
Definition dynlib_mod.F:86
dynlib_mod::dlib_struct
type(dyn_lib_type), dimension(:), allocatable dlib_struct
Definition dynlib_mod.F:72
dynlib_mod::nspmd_user
integer nspmd_user
Definition dynlib_mod.F:76
dynlib_mod::ispmd_user
integer ispmd_user
Definition dynlib_mod.F:75
dynlib_mod::ntask_user
integer ntask_user
Definition dynlib_mod.F:77
ecnd_mod
Definition ecdn_mod.F:34
ecnd_mod::iad_cndm1
integer, dimension(:), pointer iad_cndm1
Definition ecdn_mod.F:48
ecnd_mod::fr_nbcccnd1
integer, dimension(:), pointer fr_nbcccnd1
Definition ecdn_mod.F:57
ecnd_mod::iad_cnds
integer, dimension(:), pointer iad_cnds
Definition ecdn_mod.F:50
ecnd_mod::iadcnd
integer, dimension(:), pointer iadcnd
Definition ecdn_mod.F:49
ecnd_mod::fr_cndm1
integer, dimension(:), pointer fr_cndm1
Definition ecdn_mod.F:48
ecnd_mod::itagnd
integer, dimension(:), pointer itagnd
Definition ecdn_mod.F:54
ecnd_mod::procncnd
integer, dimension(:), pointer procncnd
Definition ecdn_mod.F:49
ecnd_mod::icnds10
integer, dimension(:), pointer icnds10
Definition ecdn_mod.F:42
ecnd_mod::fr_cnds
integer, dimension(:), pointer fr_cnds
Definition ecdn_mod.F:50
ecnd_mod::addcncnd
integer, dimension(:), pointer addcncnd
Definition ecdn_mod.F:49
error_mod
Definition error_mod.F:28
failwave_mod
Definition failwave_mod.F:61
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::nfvbag
integer nfvbag
Definition fvbag_mod.F:127
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
heat_mod
Definition heat_mod.F:31
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::ninter22
integer ninter22
number of /INTER/TYPE22
Definition cut-cell-search_mod.F:108
i22edge_mod
Definition cut-cell-buffer_mod.F:48
i22tri_mod
Definition cut-cell-search_mod.F:212
icontact_mod
Definition icontact_mod.F:34
icontact_mod::nme17
integer nme17
Definition icontact_mod.F:42
impbufdef_mod
Definition impbufdef_mod.F:36
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_struct_mod
Definition inter_struct_mod.F:49
interface_table_mod
Definition table_mod.F:238
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
intstamp_glob_mod::intstamp
type(intstamp_data), dimension(:), allocatable intstamp
Definition intstamp_glob_mod.F:40
intstamp_glob_mod::indexcont
integer, dimension(:), allocatable indexcont
Definition intstamp_glob_mod.F:62
intstamp_glob_mod::tagcont
integer, dimension(:), allocatable tagcont
Definition intstamp_glob_mod.F:62
mds_restart_mod
Definition mds_rest.mod.F:29
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66
mpi_tools_mod
Definition mpi_tools_mod.F:28
mpi_tools_mod::mpi_min_real_begin
subroutine mpi_min_real_begin(val, tab, stab, my_struct)
Definition mpi_tools_mod.F:73
names_and_titles_mod
Definition names_and_titles_mod.F:997
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
outmax_mod
Definition outmax_mod.F:52
outputs_mod
Definition outputs_mod.F:59
outputs_mod::ninefric
integer ninefric
Definition outputs_mod.F:65
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::ply
type(ply_data), dimension(:), allocatable ply
Definition plyxfem_mod.F:91
plyxfem_mod::plysky
type(ply_data), dimension(:), allocatable plysky
Definition plyxfem_mod.F:91
plyxfem_mod::plyskyi
type(ply_data), allocatable plyskyi
Definition plyxfem_mod.F:92
rad2r_mod
Definition rad2r.F:46
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh3act
integer, dimension(:), allocatable lsh3act
Definition remesh_mod.F:62
remesh_mod::msh3sky
integer, dimension(:), allocatable msh3sky
Definition remesh_mod.F:56
remesh_mod::lsh4upl
integer, dimension(:), allocatable lsh4upl
Definition remesh_mod.F:71
remesh_mod::ilevnod
integer, dimension(:), allocatable ilevnod
Definition remesh_mod.F:76
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
remesh_mod::lsh3upl
integer, dimension(:), allocatable lsh3upl
Definition remesh_mod.F:71
remesh_mod::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::psh4act
integer, dimension(:), allocatable psh4act
Definition remesh_mod.F:62
remesh_mod::psh3upl
integer, dimension(:), allocatable psh3upl
Definition remesh_mod.F:71
remesh_mod::psh4upl
integer, dimension(:), allocatable psh4upl
Definition remesh_mod.F:71
remesh_mod::nsh3old
integer nsh3old
Definition remesh_mod.F:66
remesh_mod::nsh4old
integer nsh4old
Definition remesh_mod.F:66
remesh_mod::msh4sky
integer, dimension(:), allocatable msh4sky
Definition remesh_mod.F:56
remesh_mod::nsh3act
integer nsh3act
Definition remesh_mod.F:66
remesh_mod::nsh4act
integer nsh4act
Definition remesh_mod.F:66
remesh_mod::lsh4act
integer, dimension(:), allocatable lsh4act
Definition remesh_mod.F:62
remesh_mod::psh3act
integer, dimension(:), allocatable psh3act
Definition remesh_mod.F:62
resolsav_mod
Definition resol_mod.F:28
resolsav_mod::ipiv_k
integer, dimension(:), allocatable ipiv_k
Definition resol_mod.F:31
seatbelt_mod
Definition seatbelt_mod.F:55
segvar_mod
Definition segvar_mod.F:61
shooting_node_mod
Definition shooting_node_mod.F:46
sms_mod
Definition sms_mod.F:29
sms_mod::tagslv_rby_sms
integer, dimension(:), allocatable tagslv_rby_sms
Definition sms_mod.F:35
sms_mod::indx2_sms
integer, dimension(:), allocatable indx2_sms
Definition sms_mod.F:39
sms_mod::tagprt_sms
integer, dimension(:), allocatable tagprt_sms
Definition sms_mod.F:35
sms_mod::tagnod_sms
integer, dimension(:), allocatable, target tagnod_sms
Definition sms_mod.F:41
sms_mod::nodxi_sms
integer, dimension(:), allocatable, target nodxi_sms
Definition sms_mod.F:41
sms_mod::tagmsr_rby_sms
integer, dimension(:), allocatable tagmsr_rby_sms
Definition sms_mod.F:35
sms_mod::nativ_sms
integer, dimension(:), allocatable nativ_sms
Definition sms_mod.F:35
sms_mod::tagslv_i21_sms
integer, dimension(:), allocatable tagslv_i21_sms
Definition sms_mod.F:43
sms_mod::tagrel_sms
integer, dimension(:), allocatable tagrel_sms
Definition sms_mod.F:35
sms_mod::kad_sms
integer, dimension(:), allocatable kad_sms
Definition sms_mod.F:38
sms_mod::lad_sms
integer, dimension(:), allocatable lad_sms
Definition sms_mod.F:38
sms_mod::jsm_sms
integer, dimension(:), allocatable jsm_sms
Definition sms_mod.F:38
sms_mod::indx1_sms
integer, dimension(:), allocatable indx1_sms
Definition sms_mod.F:39
sms_mod::jadc_sms
integer, dimension(:), allocatable jadc_sms
Definition sms_mod.F:38
sms_mod::jadi_sms
integer, dimension(:), allocatable jadi_sms
Definition sms_mod.F:47
sms_mod::jdii_sms
integer, dimension(:), allocatable jdii_sms
Definition sms_mod.F:47
sms_mod::jadt_sms
integer, dimension(:), allocatable jadt_sms
Definition sms_mod.F:38
sms_mod::tagmsr_i21_sms
integer, dimension(:), allocatable tagmsr_i21_sms
Definition sms_mod.F:43
sms_mod::jad_sms
integer, dimension(:), allocatable jad_sms
Definition sms_mod.F:38
sms_mod::kdi_sms
integer, dimension(:), allocatable kdi_sms
Definition sms_mod.F:38
sms_mod::jadtg_sms
integer, dimension(:), allocatable jadtg_sms
Definition sms_mod.F:38
sms_mod::pk_sms
integer, dimension(:), allocatable pk_sms
Definition sms_mod.F:38
sms_mod::iad_sms
integer, dimension(:), allocatable iad_sms
Definition sms_mod.F:38
sms_mod::jadp_sms
integer, dimension(:), allocatable jadp_sms
Definition sms_mod.F:38
sms_mod::iskyi_sms
integer, dimension(:,:), allocatable iskyi_sms
Definition sms_mod.F:58
sms_mod::nrwl_sms
integer, dimension(:), allocatable nrwl_sms
Definition sms_mod.F:35
sms_mod::idi_sms
integer, dimension(:), allocatable idi_sms
Definition sms_mod.F:38
sms_mod::jadi21_sms
integer, dimension(:), allocatable jadi21_sms
Definition sms_mod.F:43
sms_mod::jads10_sms
integer, dimension(:), allocatable jads10_sms
Definition sms_mod.F:38
sms_mod::nodii_sms
integer, dimension(:), allocatable, target nodii_sms
Definition sms_mod.F:41
sms_mod::jads_sms
integer, dimension(:), allocatable jads_sms
Definition sms_mod.F:38
sms_mod::jdi_sms
integer, dimension(:), allocatable jdi_sms
Definition sms_mod.F:38
sms_mod::jadr_sms
integer, dimension(:), allocatable jadr_sms
Definition sms_mod.F:38
sms_mod::tag_lnk_sms
integer, dimension(:), allocatable tag_lnk_sms
Definition sms_mod.F:35
sms_pcg_proj
Definition sms_mod.F:72
stack_mod
Definition stack_mod.F:72
state_mod
Definition state_mod.F:54
table_mod
Definition table_mod.F:112
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:60
th_surf_mod::th_surf_num_channel
integer, parameter th_surf_num_channel
number of /TH/SURF channels : AREA, VELOCITY, MASSFLOW, P A, MASS
Definition th_surf_mod.F:99
thgrelem_mod
Definition thgrelem_mod.F:28
thgrelem_mod::igrth
integer, dimension(:), allocatable igrth
Definition thgrelem_mod.F:38
thgrelem_mod::grth
integer, dimension(:), allocatable grth
Definition thgrelem_mod.F:38
thk_mod
Definition thk_mod.F:28
threac_mod
Definition threac_mod.F:28
threac_mod::nodreac
integer, dimension(:), allocatable nodreac
Definition threac_mod.F:40
time_mod
Definition time_mod.F:34
unitab_mod
Definition unitab_mod.F:513
user_windows_mod
Definition user_windows_mod.F:48
xfem2vars_mod
Definition xfem2vars_mod.F:32
xfem2vars_mod::crksky
type(xfem_sky_), dimension(:), allocatable crksky
Definition xfem2vars_mod.F:44
xfem2vars_mod::xedge4n
integer, dimension(:,:), allocatable xedge4n
Definition xfem2vars_mod.F:39
xfem2vars_mod::indx_crk
integer, dimension(:), allocatable indx_crk
Definition xfem2vars_mod.F:38
xfem2vars_mod::crkedge
type(xfem_edge_), dimension(:), allocatable crkedge
Definition xfem2vars_mod.F:42
xfem2vars_mod::xedge3n
integer, dimension(:,:), allocatable xedge3n
Definition xfem2vars_mod.F:40
newskw_init
subroutine newskw_init(iskwp, numskw_l, nskwp, numskw_l_send, iskwp_l_send, recvcount)
Definition newskw.F:379
newskw
subroutine newskw(skew, iskwn, x, iskwp_l, nskwp, numskw_l, numskw_l_send, iskwp_l_send, recvcount, iskwp)
Definition newskw.F:32
nlocal_acc
subroutine nlocal_acc(nloc_dmg, nodft, nodlt)
Definition nlocal_acc.F:33
nlocal_dtnoda
subroutine nlocal_dtnoda(nodft, nodlt, nloc_dmg, dtnod_nlocal, dt2t)
Definition nlocal_dtnoda.F:33
nlocal_incr
subroutine nlocal_incr(nloc_dmg, nodft, nodlt)
Definition nlocal_incr.F:31
nlocal_vel
subroutine nlocal_vel(nloc_dmg, nodft, nodlt)
Definition nlocal_vel.F:31
pblast_load_computation
subroutine pblast_load_computation(pblast, iloadp, fac, a, v, x, iadc, fsky, lloadp, fext, noda_surf, noda_pext, itab, h3d_data, th_surf, wfext)
Definition pblast.F:41
pfluid
subroutine pfluid(iloadp, rload, npc, tf, a, v, x, xframe, ms, nsensor, sensor_tab, wfexc, wfext, iadc, fsky, fskyv, lloadp, fext, h3d_data, th_surf, python)
Definition pfluid.F:45
free_pinch
subroutine free_pinch(pinch_data)
Definition pinchtype_mod.F:99
ply_accele
subroutine ply_accele(inod, ms_layer, zi_layer, ms, nodft, nodlt, nplymax, nplyxfe, nddim, msz2)
Definition ply_accele.F:34
ply_bcs
subroutine ply_bcs(nodft, nodlt, icodt, iskew, skew, inod, ms_ply, ibc_ply)
Definition ply_bcs.F:32
ply_vitesse
subroutine ply_vitesse(nodft, nodlt, nplymax, inod, nddim)
Definition ply_vitesse.F:33
poro
subroutine poro(geo, nodpor, ms, x, v, w, af, am, skew, weight, nporgeo)
Definition poro.F:40
pressure_cyl
subroutine pressure_cyl(loads, table, nsensor, sensor_tab, iframe, dt1, x, v, acc, fext, h3d_data, cptreac, fthreac, nodreac, fsky, wfext)
Definition pressure_cyl.F:40
cp_dm
subroutine cp_dm(numgeo, geo, igeo, dmcp, iflag)
Definition produt_v.F:2563
r2r_exchange
subroutine r2r_exchange(iexlnk, igrnod, dx, v, vr, a, ar, ms, in, stx, str, r2r_on, dd_r2r, weight, iad_elem, fr_elem, rby, xdp, x, dd_r2r_elem, sdd_r2r_elem, off_sph_r2r, numsph_glo_r2r, nloc_dmg)
Definition r2r_exchange.F:52
r2r_getdata
subroutine r2r_getdata(iexlnk, igrnod, x, v, vr, a, ar, ms, in, xdp, dx, r2r_on, dd_r2r, weight, iad_elem, fr_elem, stifn, stifr, dd_r2r_elem, sdd_r2r_elem, nloc_dmg, wfext, wfext_md)
Definition r2r_getdata.F:47
r2r_sendkine
subroutine r2r_sendkine(iexlnk, igrnod, ms, in)
Definition r2r_getdata.F:341
get_shmbuf_c
void get_shmbuf_c(int *val1, int *val2)
Definition rad2rad_c.c:2787
get_fbuf_c
void get_fbuf_c(my_real_c *fbuf, int *len)
Definition rad2rad_c.c:995
r2r_unlock_threads_c
void r2r_unlock_threads_c(int *nthr)
Definition rad2rad_c.c:369
r2r_block_c
void r2r_block_c()
Definition rad2rad_c.c:406
r2r_sem_c
void r2r_sem_c()
Definition rad2rad_c.c:430
get_fbufdp_c
void get_fbufdp_c(double *fbuf, int *len)
Definition rad2rad_c.c:1013
send_fbuf_c
void send_fbuf_c(my_real_c *fbuf, int *len)
Definition rad2rad_c.c:958
close_sock_c
void close_sock_c(int *sd)
Definition rad2rad_c.c:2571
send_ibuf_c
void send_ibuf_c(int *ibuf, int *len)
Definition rad2rad_c.c:940
get_ibuf_c
void get_ibuf_c(int *ibuf, int *len)
Definition rad2rad_c.c:1031
send_fbufdp_c
void send_fbufdp_c(double *fbuf, int *len)
Definition rad2rad_c.c:977
radiation
subroutine radiation(ibcr, fradia, npc, tf, x, temp, nsensor, sensor_tab, fthe, iad, fthesky, python, glob_therm)
Definition radiation.F:38
rbagdt
subroutine rbagdt(geo, igeo)
Definition rbagdt.F:29
rbe2t1
subroutine rbe2t1(irbe2, lrbe2, x, a, ar, ms, in, skew, weight, iad_rbe2, fr_rbe2m, nmrbe2, stifn, stifr, r2size)
Definition rbe2f.F:38
rbe2v
subroutine rbe2v(irbe2, lrbe2, x, a, ar, v, vr, skew)
Definition rbe2v.F:34
rbe3t1
subroutine rbe3t1(rbe3, nodes, skew, dmast, adm, dinert, adi, h3d_data, dt1, tt, impl_s)
Definition rbe3f.F:50
rbe3f
subroutine rbe3f(irbe3, lrbe3, x, a, ar, ms, in, frbe3, skew, weight, stifn, stifr, jt, jr, irotg, max_m, am, arm, msm, inm, stifnm, stifrm, nmt0, iadmp, pen, v, vr, nmt, dt1, iroddl)
Definition rbe3f.F:280
prerbe3p0
subroutine prerbe3p0(rbe3)
Definition rbe3f.F:2036
rbe3v
subroutine rbe3v(rbe3, nodes, skew)
Definition rbe3v.F:35
rbycor
subroutine rbycor(rby, x, v, vr, skew, fsav, lpby, npby, iskew, itab, weight, a, ar, ms, in, kind, irbkin_l, nrbykin_l, weight_md, ms_2d)
Definition rbycor.F:36
rbyfor
subroutine rbyfor(timers, rby, a, ar, x, vr, fsav, in, stifn, stifr, fani, lpby, npby, weight, ms, v, igrsurf, bufsf, icodr, iskew, skew, kind, iad_rby, fr_rby6, rby6, irbkin_l, nrbykin_l, nativ_sms, dimfb, fbsav6, stabsen, tabsensor, nodreac, fthreac, cptreac, dampr, sdamp, damp, ndamp_vrel, id_damp_vrel, igrnod, tagslv_rby, iparit, wfext, ndamp_vrel_rbyg, size_rby6_c, rby6_c)
Definition rbyfor.F:53
rbysens
subroutine rbysens(iparg, ipari, ms, in, ixs, ixq, ixc, ixt, ixp, ixr, skew, itab, itabm1, iskwn, npby, itag, lpby, fsky, nsensor, rby, x, v, vr, ixtg, igrv, ibgr, sensor_tab, a, ar, fsav, stifn, stifr, fani, weight, dmast, dinert, bufsf, fr_rby2, partsav, ipart, elbuf_tab, icfield, lcfield, tagslv_rby)
Definition rbyonf.F:232
rbyvit
subroutine rbyvit(rby, x, v, vr, skew, fsav, lpby, npby, iskew, itab, weight, a, ar, ms, in, kind, irbkin_l, nrbykin_l, nodreac, fthreac, freac)
Definition rbyvit.F:38
reaction_forces_th
subroutine reaction_forces_th(nodft, nodlt, a, ar, ms, in, fthreac, iflag, nodreac)
Definition reaction_forces_th.F:30
reaction_forces_check_for_requested_output
subroutine reaction_forces_check_for_requested_output(npby, h3d_data, comptreac)
Definition reactions.F:31
reaction_forces_1
subroutine reaction_forces_1(nodft, nodlt, a, ar, freac)
Definition reactions.F:123
reaction_forces_3
subroutine reaction_forces_3(nodft, nodlt, a, ar, ms, in, freac)
Definition reactions.F:275
reaction_forces_2
subroutine reaction_forces_2(nodft, nodlt, a, ar, ms, in, freac, iflag)
Definition reactions.F:199
reallocate_i_skyline
subroutine reallocate_i_skyline(new_count, call_id, intheat, nodadt_therm, pon)
Definition reallocate_skyline.F:39
renum_siz
subroutine renum_siz(ipari, rnum_siz)
Definition renum_siz.F:29
resol
subroutine resol(timers, element, nodes, coupling, af, iaf, iskwn, neth, ipart, nom_opt, kxx, ixx, ixtg, ixs, ixq, ixt, ixp, ixr, ifill, mat_elem, ims, npc, ibcl, ibfv, idum, las, laccelm, nnlink, lnlink, iparg, dd_iad, igrv, iexlnk, kinet, ipari, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, nodpor, monvol, ilink, llink, linale, neflsw, nnflsw, icut, cluster, itask, inoise, thke, damp, pm, skews, geo, eani, bufmat, bufgeo, bufsf, w, veul, fill, dfill, alph, wb, dsave, asave, msnf, tf, forc, vel, fsav, fzero, xlas, accelm, agrv, fr_wave, failwave, parts0, elbuf, rwbuf, sensors, rwsav, rby, rivet, secbuf, volmon, lambda, wa, fv, partsav, uwa, val2, phi, segvar, r, crflsw, flsw, fani, xcut, anin, tani, secfcum, bufnois, idata, rdata, iframe, kxsp, ixsp, nod2sp, ispsym, ispcond, xframe, spbuf, xspsym, vspsym, pv, fsavd, ibvel, lbvel, wasph, w16, isphio, lprtsph, lonfsph, vsphio, fbvel, lagbuf, ibcslag, iactiv, dampr, gjbufi, gjbufr, rbmpc, ibmpc, sphveln, nbrcvois, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, npsegcom, lsegcom, nporgeo, ixtg1, npbyl, lpbyl, rbyl, igeo, ipm, madprt, madsh4, madsh3, madsol, madnod, madfail, iad_rby, fr_rby, fr_wall, iad_rby2, fr_rby2, iad_i2m, fr_i2m, addcni2, procni2, iadi2, fr_mv, iadmv2, fr_ll, fr_rl, iadcj, fr_cj, fr_sec, iad_sec, iad_cut, fr_cut, rg_cut, newfront, fr_mad, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, eigipm, eigibuf, eigrpm, lnodpor, fr_i18, graphe, iflow, rflow, lgrav, dd_r2r, fasolfr, fr_lagf, llagf, lprw, icontact, rcontact, sh4tree, sh3tree, ipadmesh, padmesh, msc, mstg, inc, intg, ptg, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, acontact, pcontact, factiv, sh4trim, sh3trim, mscnd, incnd, ibfflux, fbfflux, rbym, irbym, lnrbym, icodrbym, ibcv, fconv, ibftemp, fbftemp, iad_rbym, fr_rbym, weight_rm, ms_ply, zi_ply, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icode_ply, icodt_ply, iskew_ply, admsms, madclnod, nom_sect, mcpc, mcptg, dmelc, dmeltg, mssa, dmels, mstr, dmeltr, msp, dmelp, msrt, dmelrt, ibcr, fradia, res_sms, table, irbe2, lrbe2, iad_rbe2, fr_rbe2, phie, msf, procne_pxfem, iadsdp_pxfem, iadrcp_pxfem, icfield, lcfield, cfield, msz2, diag_sms, iloadp, lloadp, loadp, inod_crk, iel_crk, iadc_crk, adsky_crk, cne_crk, procne_crk, iadsdp_crk, iadrcp_crk, ibufssg_io, ibc_ply, dmint2, ibordnode, elbuf_tab, por, nodedge, iad_edge, fr_edge, fr_nbedge, crknodiad, lgauge, gauge, igaup, ngaup, nodlevxf, dd_r2r_elem, nodglobxfe, sph2sol, sol2sph, irst, dmsph, wagap, xfem_tab, elcutc, nodenr, kxfenod2elc, enrtag, rthbu f, kxig3d, ixig3d, knot, wige, wsmcomp, stack, cputime_mp_glob, cputime_mp, tab_ump, poin_ump, sol2sph_typ, irunn_bis, addcsrect, iad_frnor, fr_nor, procnor, iad_fredg, fr_edg, drape_sh4n, drape_sh3n, tab_mat, nativ0_sms, multi_fvm, segquadfr, ms_2d, h3d_data, subsets, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, forneqs, nloc_dmg, iskwp_l, knotlocpc, knotlocel, pinch_data, tag_skins6, ale_connectivity, xcell, xface, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, ibcscyc, lbcscyc, t_monvol, id_global_vois, face_vois, dynain_data, fcont_max, ebcs_tab, diffusion, kloadpinter, loadpinter, dgaploadint, drapeg, user_windows, output, interfaces, dt, loads, python, dpl0cld, vel0cld, ndamp_vrel, id_damp_vrel, fr_damp_vrel, ndamp_vrel_rbyg, names_and_titles, unitab, liflow, lrflow, glob_therm, pblast, rbe3)
Definition resol.F:633
smp_init
subroutine smp_init(itsk, nodftsk, nodltsk, numntsk, ndtsk, ipmtsk, partftsk, partltsk, nwaftsk, igmtsk, greftsk, greltsk)
Definition resol_init.F:1559
resol_init
subroutine resol_init(itask, fr_nbcc, isendto, ircvfrom, iad_elem, fr_elem, itabm1, ipari, iparg, itab, ixs10, ixs20, i13a, i13b, i13c, i13d, i13e, i13f, i13g, i13h, i13i, i15a, i15b, i15c, i15d, i15e, i15f, i15g, i15h, i15i, i87a, i87b, i87c, i87d, i87e, i87f, i87g, nfia, nfea, nfoa, ndma, ndma2, nodft, nodlt, ndtask, numnthread, ixs16, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pon, ikine, a, ar, v, vr, x, d, ms, in, stifn, stifr, dmas, diner, fani, anin, wa, uwa, pm, geo, partsav, parts0, monvol, i87h, i87i, i87j, i87k, i15j, kxx, secbuf, secfcum, nstrf, igrnod, iexlnk, xframe, ixtg1, ib, viscn, dd_r2r, elbuf, ipart, madprt, madsh4, madsh3, madsol, madnod, madfail, igeo, intlist, nbintc, procne, niskyfi, weight, isizxv, ilenxv, addcni2, procni2, iad_i2m, fr_i2m, fr_nbcci2, i2size, fr_mad, lwibem, lwrbem, fxbfp, fxbefw, fxbedp, fxbgrp, fxbgrw, ndin, islen7, irlen7, islen11, irlen11, lwiflow, lwrflow, iflow, addcnel, cnel, addtmpl, ipartl, npartl, nfnca, nftca, i15ath, i35ath, ipm, sh4tree, ipadmesh, msc, inc, sh3tree, mstg, intg, ptg, fthe, fthesky, ftheskyi, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, sh4trim, sh3trim, mscnd, incnd, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, niskyfie, mcp, ms0, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icodt, icodr, ibfv, admsms, nodreac, igrouc, ngrouc, igrounc, ngrounc, fr_rby, fr_rby6, npby, nom_sect, mcpc, mcptg, grth, igrth, nelem, lag_sec, nprw, diag_sms, dmelc, dmeltg, ngrth, nft2, dmels, dmeltr, dmelp, dmelrt, res_sms, i87l, irbe2, lrbe2, nmrbe2, iad_rbe2, fr_rbe2, fr_rbe2m, r2size, lpby, procne_pxfem, isendp_pxfem, irecvp_pxfem, iadsdp_pxfem, iadrcp_pxfem, fr_nbcc1, rby, int18kine, xdp, i87m, inod_crkxfem, iel_crkxfem, iadc_crkxfem, adsky_crkxfem, procne_crkxfem, isendp_crkxfem, irecvp_crkxfem, iadsdp_crkxfem, iadrcp_crkxfem, int24use, ndama2, igroupc, igrouptg, igroups, igroupflg, dmint2, irbkin_l, nrbykin_l, kindrby, elbuf_tab, sensors, dd_r2r_elem, sdd_r2r_elem, kinet, weight_md, dmsph, ioldsect, lbufidel24, intbuf_tab, numsph_glo_r2r, flg_sphinout_r2r, i15k, condn, condnsky, kxfenod2elc, elcutc, nodedge, iad_edge, crknodiad, fr_edge, fr_nbedge, nodlevxf, crkedge, xfem_tab, isensint, nisubmax, intlist25, int24e2euse, tabmp_l, i87n, tab_mat, h3d_data, tagtrimc, tagtrimtg, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, forneqs, int7itied, fxvel_fgeo, failwave, nloc_dmg, pinch_data, slloadp, tagslv_rby, nfnca2, nftca2, in0, sort_comm, stack, output, thke, sfr_elem, sh_offset_tab, need_comm_int25_solid_erosion, comm_int25_solid_erosion, iskwn, iframe, loads, glob_therm, pblast, rbe3)
Definition resol_init.F:173
rbe2cor
subroutine rbe2cor(irbe2, lrbe2, x, v, vr, skew, iskew, itab, weight, a, ar, ms, in, weight_md)
Definition rgbcor.F:476
rgwal0
subroutine rgwal0(x, a, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, frwl6, nodnx_sms, weight_md, dimfb, fbsav6, stabsen, tabsensor, wfext, wfext_md)
Definition rgwal0.F:40
rgwalf
subroutine rgwalf(a, rwbuf, nprw, ms)
Definition rgwal0.F:378
rivet1
subroutine rivet1(ms, in, a, ar, x, ixrt, rivet, geo, v, vr, itask)
Definition rivet1.F:31
rlink11
subroutine rlink11(ms, in, a, ar, v, vr, nnlink, lllink, skew, fr_ll, weight, frl6, x, xframe)
Definition rlink10.F:144
rlink10
subroutine rlink10(ms, in, a, ar, v, vr, nlink, llink, skew, fr_rl, weight, frl6)
Definition rlink10.F:36
rmatacce
subroutine rmatacce(rbym, arbym, arrbym, vrbym, vrrbym, irbym, lnrbym, x, a, ar, v, vr, kind)
Definition rmatacce.F:31
rmatforp
subroutine rmatforp(timers, a, ar, x, vr, in, stifn, stifr, irby, lnrby, rby, icodrby, weight, ms, v, fr_rbm, iad_rby, arby, vrby, arrby, vrrby, kind, rbym6)
Definition rmatforp.F:41
s10cndf2
subroutine s10cndf2(icnds10, weight, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, a, iadcnd, fskycnd, itagnd, nodftsk, nodltsk, eftsk, eltsk, itsk, itab, stifn, stifnd)
Definition s10cndf.F:227
s10cndf1
subroutine s10cndf1(icnds10, weight, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, a, iadcnd, fskycnd, itagnd, nodftsk, nodltsk, eftsk, eltsk, itsk, itab, stifn, stifnd)
Definition s10cndf.F:38
s10cndfnd
subroutine s10cndfnd(icnds10, weight, iad_cnds, fr_cnds, itab, nodftsk, nodltsk, eftsk, eltsk, itsk, stifn, stifnd)
Definition s10cndf.F:768
s10stfe_poff
subroutine s10stfe_poff(icnds10, weight, iad_cnds, fr_cnds, itab, nodftsk, nodltsk, eftsk, eltsk, itsk, stifn, stifnd)
Definition s10cndf.F:1770
cnd_dmasi2
subroutine cnd_dmasi2(icnds10, nkend, imap2nd, masi2nd0, ms, weight)
Definition s10cndf.F:1096
s10cndv
subroutine s10cndv(icnds10, vnd, v)
Definition s10cndv.F:29
s10getvdm
subroutine s10getvdm(icnds10, v, vnd, vmd)
Definition s10cndv.F:258
s10cndi2a
subroutine s10cndi2a(icnds10, itagnd, a)
Definition s10cndv.F:161
s10cndi2a1
subroutine s10cndi2a1(icnds10, itagnd, a)
Definition s10cndv.F:212
s4lagsfem
subroutine s4lagsfem(iparg, ixs, x, v, elbuf_tab, sfem_nodvar, s_sfem_nodvar, iad_elem, fr_elem, ixs10, xdp, sxdp, numnod, sfr_elem, nspmd, numels, numels8, numels10, nparg, ngroup, iresp)
Definition s4lagsfem.F:42
section_fio
subroutine section_fio(nstrf, v, vr, a, ar, secbuf, ms, in, weight, iad_cut, fr_cut, wfext)
Definition section_fio.F:34
section_io
subroutine section_io(nstrf, d, dr, v, vr, fsav, secfcum, a, ar, secbuf, ms, in, x, fani, weight, xsec, iad_elem, fr_elem, rg_cut, iad_cut, fr_cut, weight_md, ioldsect, stabsen, dimfb, tabs, fbsav6, wfext)
Definition section_io.F:46
spmd_i21fthecom
subroutine spmd_i21fthecom(ipari, fthe, intbuf_tab, sensor_tab, niskyfi, ftheskyi, isky, fskyi, condnskyi, nsensor, nodadt_therm)
Definition send_cand.F:2192
spmd_i21tempcom
subroutine spmd_i21tempcom(ipari, temp, intbuf_tab, nsensor, sensor_tab)
Definition send_cand.F:1991
sensor_base
subroutine sensor_base(sensors, nsensor, time, timestep, xsens, ipari, partsav2, gauge, fsav, x, v, a, acc, nprw, subset, igrsurf, igrnod, python)
Definition sensor_base.F:57
sensor_dist_surf0
subroutine sensor_dist_surf0(nsensor, sensor_tab, x, igrsurf, comm_sens16)
Definition sensor_dist_surf0.F:36
sensor_ener_sav
subroutine sensor_ener_sav(nsensor, sensor_tab, partsav, partsav2)
Definition sensor_ener_sav.F:31
sensor_init
subroutine sensor_init(subset, iparg, ngrouc, ipartc, iparttg, iparts, ipartq, ipartt, ipartp, ipartr, sensors, time, timestep, iout, python, ntask)
Definition sensor_init.F:43
sensor_logical
subroutine sensor_logical(sensors)
Definition sensor_logical.F:38
sensor_spmd
subroutine sensor_spmd(sensor_tab, ipari, nprw, isensp, nsensp, xsens, x, accelm, iaccp, naccp, gauge, igaup, ngaup, partsav2, nsensor, comm_sens14, sensor_struct)
Definition sensor_spmd.F:43
sensor_temp0
subroutine sensor_temp0(nsensor, sensor_tab, igrnod, temp, weight, comm_sens17, sensor_struct)
Definition sensor_temp0.F:35
sms_build_mat_2
subroutine sms_build_mat_2(itask, nodft, nodlt, ixc, iparg, ixs, ixt, ixp, ixr, ixtg, nodnx_sms, ms, ms0, indx1_sms, indx2_sms, jad_sms, jdi_sms, lt_sms, kad_sms, kdi_sms, ltk_sms, pk_sms, nodii_sms, jadc_sms, jads_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, diag_sms, tagprt_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, iad_elem, fr_elem, npby, lpby, tagslv_rby_sms, lad_sms, jsm_sms, dmeltg, dmelc, mskyi_sms, iskyi_sms, jadi_sms, jdii_sms, lti_sms, nodxi_sms, dmels, dmeltr, dmelp, dmelrt, igeo, fr_sms, fr_rms, ev, ipari, intbuf_tab, kinet, tagslv_i21_sms, jadi21_sms, intstamp, ixs10, jads10_sms, ilink, rlink, nnlink, lnlink, tag_lnk_sms, ljoint, iadcj, fr_cj, itab, weight, dmint2, elbuf_tab, tagmsr_rby_sms, nprw, lprw, fr_wall, nrwl_sms, rby, x, a, ar, in, v, vr, irbe2, lrbe2, irbe3, lrbe3, iad_rbe3m, fr_rbe3m, nativ_sms, t2main_sms, t2fac_sms, mskyi_fi_sms, list_sms, list_rms, sz_mw6, mw6)
Definition sms_build_mat_2.F:64
sms_encin_2
subroutine sms_encin_2(timers, itask, nodft, nodlt, nodxi_sms, ms, jad_sms, jdi_sms, lt_sms, indx1_sms, diag_sms, iad_elem, fr_elem, weight, v, a, wv, wmv, wdg, xmom_sms, icodt, icodr, iskew, skew, ibfv, vel, npc, tf, x, d, sensors, iframe, xframe, jadi_sms, jdii_sms, lti_sms, iskyi_sms, mskyi_sms, fr_sms, fr_rms, npby, tagslv_rby_sms, intstamp, cptreac, nodreac, fthreac, ar, vr, dr, in, rby, irbe2, lrbe2, iad_rbe2, fr_rbe2m, nmrbe2, r2size, irbe3, lrbe3, frbe3, iad_rbe3m, fr_rbe3m, fr_rbe3mp, rrbe3, rrbe3_pon, iad_rby, fr_rby6, rby6, lpby, tagmsr_rby_sms, r3size, nodii_sms, indx2_sms, ibcscyc, lbcscyc, output, mskyi_fi_sms, list_sms, list_rms, vfi, sz_mw6, mw6)
Definition sms_encin_2.F:66
sms_mass_scale_2
subroutine sms_mass_scale_2(timers, python, itask, nodft, nodlt, nodii_sms, indx2_sms, nodxi_sms, ms, ms0, a, icodt, icodr, iskew, skew, jad_sms, jdi_sms, lt_sms, x_sms, p_sms, z_sms, y_sms, prec_sms, indx1_sms, diag_sms, iad_elem, fr_elem, weight, npby, lpby, tagslv_rby_sms, lad_sms, kad_sms, jrb_sms, ibfv, vel, npc, tf, v, x, d, sensor_tab, nsensor, iframe, xframe, jadi_sms, jdii_sms, lti_sms, fr_sms, fr_rms, iskyi_sms, mskyi_sms, res_sms, igrv, agrv, lgrav, ilink, rlink, fr_rl, frl6, nnlink, lnlink, fr_ll, fnl6, tag_lnk_sms, itab, fsav, ljoint, iadcj, fr_cj, am, vr, in, frl, fnl, nprw, lprw, rwbuf, rwsav, fopt, fr_wall, nrwl_sms, intstamp, kinet, ixc, ixtg, sh4tree, sh3tree, cptreac, nodreac, fthreac, frwl6, dim, tagslv_rby, dampr, damp, igrnod, dr, rby, tagmsr_rby_sms, jsm_sms, irbe2, lrbe2, iad_rbe2, fr_rbe2m, nmrbe2, r2size, irbe3, lrbe3, frbe3, iad_rbe3m, fr_rbe3m, fr_rbe3mp, rrbe3, rrbe3_pon, prec_sms3, diag_sms3, iad_rby, fr_rby6, rby6, r3size, betate, ibcscyc, lbcscyc, mskyi_fi_sms, list_sms, list_rms, cjwork, frea, irwl_work, vfi, sz_mw6, mw6, wfext, ams_work)
Definition sms_mass_scale_2.F:88
soltospha
subroutine soltospha(itask, v, a, ms, pm, ipart, ixs, iparts, kxsp, ipartsp, irst, spbuf, partsav, sol2sph, iparg, ngrounc, igrounc, elbuf_tab, igeo)
Definition soltospha.F:43
sortie_error
subroutine sortie_error(v, nodglob, weight, itab, ms, ms0, param, partsav, ipart, pm, igeo)
Definition sortie_error.F:34
sortie_main
subroutine sortie_main(timers, pm, d, v, ale_connect, w, elbuf, iparg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, wa, itab, x, geo, ms, a, cont, partsav, icut, xcut, fint, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, ebcs_tab, tani, inoise, bufnois, rby, neflsw, nnflsw, crflsw, flsw, lout, nodes, fsav, skew, elbuf_tab, cluster, vr, in, weight, fcluster, mcluster, dd_iad, dmas, accelm, gauge, ipari, eani, ipart, mat_param, igrnod, subset, nom_opt, ar, igrsurf, bufsf, idata, rdata, kxx, ixx, bufmat, bufgeo, kxsp, ixsp, nod2sp, spbuf, dr, fsavd, ixri, rivet, iskwn, iframe, xframe, ixs10, ixs20, ixs16, ndma, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_rby2, iad_rby2, fr_wall, fr_sec, fxbipm, fxbrpm, ndin, fxbdep, fxbvit, fxbacc, iflow, rflow, ipartl, npartl, iaccp, naccp, fasolfr, fncont, ftcont, iparth, fr_mv, ipart_state, sh4tree, sh3tree, temp, thke, err_thk_sh4, err_thk_sh3, inod_pxfem, fthreac, nodreac, gresav, diag_sms, sh4trim, sh3trim, fncont2, xmom_sms, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, sensors, qfricint, igaup, ngaup, weight_md, ncont, indexcont, nodglobxfe, nodedge, xfem_tab, nv46, rthbuf, kxig3d, ixig3d, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, stack, isphio, vsphio, icode, indx_crk, xedge4n, xedge3n, sph2sol, stifn, stifr, drape_sh4n, drape_sh3n, ms_2d, multi_fvm, segquadfr, h3d_data, iskew, pskids, iskwp, knotlocpc, knotlocel, pinch_data, tag_skins6, irunn_bis, tf, npc, dynain_data, fcont_max, mds_matid, fncontp2, ftcontp2, ibcl, iloadp, lloadp, loadp, tagncont, loadp_hyd_inter, forc, drapeg, user_windows, output, dt, fsavsurf, table, loads, sfani, iparit, x_c, sz_npcont2, npcont2, glob_therm, pblast, wfext)
Definition sortie_main.F:145
spgauge_f
subroutine spgauge_f(p, ff, p0, p1, p2, n)
Definition spgauge.F:259
sphprep
subroutine sphprep(timers, pm, geo, x, v, ms, elbuf_tab, wa, pld, bufmat, partsav, iparg, npc, ipart, itab, bufgeo, xframe, kxsp, ixsp, nod2sp, ipartsp, spbuf, ispcond, ispsym, xspsym, vspsym, wasph, lprtsph, lonfsph, wsp2sort, isphio, vsphio, igrsurf, d, sphveln, itask, xdp, ibufssg_io, lgauge, gauge, ngrounc, igrounc, sol2sph, sph2sol, ixs, iads, addcne, fskyd, dmsph, waspact, icontact, off_sph_r2r, wsmcomp, irunn_bis, sph_iord1, sph_work, wfext)
Definition sphprep.F:76
sphres44b
subroutine sphres44b(kxsp, ixsp, nod2sp, iparg, spbuf)
Definition sphres44b.F:30
splissv
subroutine splissv(x, v, ms, a, spbuf, wa, itab, kxsp, ixsp, nod2sp, d, ispsym, xspsym, vspsym, bufmat, bufgeo, npc, pld, pm, geo, ispcond, xframe, waspsym, ipartsp, partsav, wacomp, wsmcomp, waspact, ipart, itask, sph2sol, sol2sph, irst, ixs, iparg, ngrounc, igrounc, elbuf_tab, iad_elem, fr_elem, igeo, sol2sph_typ, sph_work)
Definition splissv.F:52
split_asspar4
subroutine split_asspar4(addcne, numnod, nthreads, first, last, sadsky)
Definition split_asspar4.F:29
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_chkw
subroutine spmd_chkw(iwiout, iout)
Definition spmd_chkw.F:38
spmd_collect
subroutine spmd_collect(a, itab, weight, nodglob, sizp0)
Definition spmd_collect.F:34
spmd_collect_multi_fvm
subroutine spmd_collect_multi_fvm(ixs, multi_fvm, flag)
Definition spmd_collect_multi_fvm.F:38
spmd_collect_nlocal
subroutine spmd_collect_nlocal(a, sizea, numnod_local, posi, nloc_dmg, sizp0, nodglob, itab)
Definition spmd_collect_nlocal.F:37
spmd_collectm
subroutine spmd_collectm(nodnx_sms, itab, weight, nodglob, sizp0)
Definition spmd_collectm.F:35
spmd_collectt
subroutine spmd_collectt(temp, itab, weight, nodglob, sizp0)
Definition spmd_collectt.F:35
spmd_exch2_a_pon
subroutine spmd_exch2_a_pon(interfaces, iad_elem, fr_elem, addcne, procne, fr_nbcc, size, lenr, lens, fsky, fskyv, fskym, ifsubm, sizi, leni, iadsdp, iadrcp, isendp, irecvp, ffsky, procne_pxfem, fr_nbcc1, iadsdp_pxfem, iadrcp_pxfem, isendp_pxfem, irecvp_pxfem, lenr1, lens1, iadsdp_crk, iadrcp_crk, isendp_crk, irecvp_crk, fskyd, crknodiad, crksky, forneqsky, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch2_a_pon.F:49
spmd_exch_a
subroutine spmd_exch_a(a, adp, ar, stifn, stifr, ms, iad_elem, fr_elem, msnf, ifsubm, size, lenr, fthe, mcp, dmsph, condn, ms_2d, mcp_off, forneqs, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch_a.F:40
spmd_exch_a_ams_poff
subroutine spmd_exch_a_ams_poff(a, ar, stifn, stifr, ms, iad_elem, fr_elem, msnf, ifsubm, size, lenr, fthe, mcp, fr_loc, nb_fr, ms_2d, mcp_off, forneqs, nfacnit, lenc, fcont, h3d_data, fncont, ftcont, glob_therm)
Definition spmd_exch_a_ams_poff.F:40
spmd_exch_da20
subroutine spmd_exch_da20(intbuf_tab, ipari, iad_elem, fr_elem, len20, nbint20, lenr, intlist, nbintc)
Definition spmd_exch_da20.F:39
spmd_exch_deleted_surf_edge
subroutine spmd_exch_deleted_surf_edge(iad_elem, nodes, shoot_struct, intbuf_tab, newfront, ipari, geo, ixs, ixc, ixt, ixp, ixr, ixtg, ixs10, addcnel, cnel, tag_node, tag_elem)
Definition spmd_exch_deleted_surf_edge.F:41
spmd_exch_vmax
subroutine spmd_exch_vmax(iad_stsh, fr_stsh, iad_rtsh, fr_rtsh, v_max)
Definition spmd_exch_dttsh.F:119
spmd_exch_fa
subroutine spmd_exch_fa(iad_stsh, fr_stsh, iad_rtsh, fr_rtsh, a)
Definition spmd_exch_dttsh.F:251
spmd_exch_efric
subroutine spmd_exch_efric(ipari, intlist, nbintc, islen7, irlen7, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, intbuf_tab, h3d_data)
Definition spmd_exch_efric.F:43
spmd_exch_i24
subroutine spmd_exch_i24(ipari, intbuf_tab, itab, iad_elem, fr_elem, intlist, nbintc, iad_i24, fr_i24, sfr_i24, i24maxnsne, flag, int24e2euse)
Definition spmd_exch_i24.F:41
spmd_exch_i25
subroutine spmd_exch_i25(ipari, intbuf_tab, itab, iad_elem, fr_elem, intlist, nbintc, iad_i25, fr_i25, sfr_i25, flag)
Definition spmd_exch_i25.F:41
spmd_exch_icodt
subroutine spmd_exch_icodt(icodt, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_icodt.F:33
spmd_exch_icont
subroutine spmd_exch_icont(icontact, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_icont.F:34
spmd_exch_inter_18
subroutine spmd_exch_inter_18(ninter, nspmd, number_inter18, sxcell, inter18_list, xcell, multi_fvm, xcell_remote, intbuf_tab, ale_connectivity)
Definition spmd_exch_inter_18.F:40
spmd_exch_press
subroutine spmd_exch_press(ipari, intlist, nbintc, fncont, ftcont, islen7, irlen7, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, intbuf_tab, n_cse_fric_inter, n_scal_cse_efric)
Definition spmd_exch_press.F:43
spmd_exch_sub_pon
subroutine spmd_exch_sub_pon(nloc_dmg)
Definition spmd_exch_sub.F:395
spmd_exch_sub_poff
subroutine spmd_exch_sub_poff(nloc_dmg)
Definition spmd_exch_sub.F:231
spmd_exch_tagncont
subroutine spmd_exch_tagncont(tagncont, iad_elem, fr_elem, lenr)
Definition spmd_exch_tagncont.F:35
spmd_exch_thknod
subroutine spmd_exch_thknod(thknod, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_thknod.F:33
spmd_exch_wave
subroutine spmd_exch_wave(fr_wave, iad_elem, fr_elem, size, lenr)
Definition spmd_exch_wave.F:33
spmd_exsum_fb6
subroutine spmd_exsum_fb6(dim6, dim_exch, fb6)
Definition spmd_exsum_fb6.F:33
spmd_fvb_switch
subroutine spmd_fvb_switch(monvol)
Definition spmd_fvb_switch.F:34
spmd_glob_min5
subroutine spmd_glob_min5(dt2, itypts, nelts, icodt, imsch, tstop, iwiout, mstop, ismsch, int24use, nbintc, intlist, ipari, intbuf_tab)
Definition spmd_glob_min5.F:36
spmd_glob_minv
subroutine spmd_glob_minv(t_monvol, dt2, itypts, nelts, volmon, fr_mv)
Definition spmd_glob_minv.F:35
spmd_i25front_init
subroutine spmd_i25front_init(itab, main_proc, intbuf_tab, ipari)
Definition spmd_i25front.F:38
spmd_i7fcom_poff
subroutine spmd_i7fcom_poff(ipari, a, stifn, viscn, intlist, nbintc, icodt, secfcum, nstrf, icontact, fcont, islen7, irlen7, islen11, irlen11, islen17, irlen17, igrbric, ixs, ixs16, fthe, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, condn, iflag, intbuf_tab, h3d_data, multi_fvm, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, fsav, interfaces, nodadt_therm)
Definition spmd_i7fcom_poff.F:59
spmd_i7fcom_pon
subroutine spmd_i7fcom_pon(ipari, intlist, nbintc, niskyfi, icodt, secfcum, nstrf, icontact, fcont, igrbric, ixs, ixs16, niskyfie, nbint20, iflag, intbuf_tab, sfskyi, sisky, h3d_data, multi_fvm, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, fsav, interfaces, glob_therm)
Definition spmd_i7fcom_pon.F:72
upgrade_rem_2ry
subroutine upgrade_rem_2ry(ipari, count_remslv, count_remslve, nodadt_therm)
Definition spmd_i7tool.F:7235
spmd_i7xvcom2
subroutine spmd_i7xvcom2(ipari, x, v, ms, imsch, i2msch, dt2prev, intlist, nbintc, islen7, irlen7, islen11, irlen11, islen17, irlen17, ixs, ixs16, nsensor, igrbric, temp, iflag, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, sensor_tab, intbuf_tab, int24e2euse, forneqs, multi_fvm, interfaces)
Definition spmd_i7xvcom2.F:56
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_int18_law151_pon
subroutine spmd_int18_law151_pon(ipari, islen7, irlen7, iflag, intbuf_tab, multi_fvm)
Definition spmd_int18_law151_pon.F:41
spmd_exch_r2r_sphoff
subroutine spmd_exch_r2r_sphoff(off_sph_r2r, iad_elem, fr_elem, dd_r2r, dd_r2r_elem, lenr)
Definition spmd_r2r.F:2131
spmd_exch_r2r_sph
subroutine spmd_exch_r2r_sph(a, iad_elem, fr_elem, dd_r2r, dd_r2r_elem, lenr)
Definition spmd_r2r.F:2003
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62
spmd_sd_xv
subroutine spmd_sd_xv(x, d, v, vr, ms, in, iad_elem, fr_elem, weight, imsch, w, isizxv, ilenxv, xdp)
Definition spmd_sd_xv.F:42
spmd_exch_sec
subroutine spmd_exch_sec(nstrf, x, ms, weight, xsec, fr_sec, iad_sec, lsend1, lrecv1, lsend2, lrecv2, weight_md)
Definition spmd_section.F:415
spmd_sort_sms
subroutine spmd_sort_sms(iskyi_sms, mskyi_sms, fr_sms)
Definition spmd_sms.F:33
spmd_nlist_sms
subroutine spmd_nlist_sms(fr_sms, fr_rms)
Definition spmd_sms.F:184
ams_prepare_poff_assembly
subroutine ams_prepare_poff_assembly(iad_elem, fr_elem, nb_fr, fr_loc, iad_i2m, fr_i2m, nb_fri2m, fr_loc_i2m)
Definition spmd_sms.F:116
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:523
spmd_wiout
subroutine spmd_wiout(iout, iwiout)
Definition spmd_wiout.F:40
spmd_max_xfe_i
subroutine spmd_max_xfe_i(int)
Definition spmd_xfem.F:1130
spmd_exch_crkvel
subroutine spmd_exch_crkvel(iad_elem, fr_elem, inod_crk, itab, x, v, vr)
Definition spmd_xfem.F:35
sponfv
subroutine sponfv(x, v, a, d, ms, spbuf, itab, kxsp, ixsp, nod2sp, npc, pld, isphio, vsphio, ipart, ipartsp, waspact, wa, vnormal, sph_work, wfext)
Definition sponfv.F:41
spwfvis
subroutine spwfvis(spbuf, ipartsp, partsav, iparg, elbuf_tab, kxsp, waspact)
Definition spwfvis.F:35
srfvit
subroutine srfvit(x, v, vr, a, ar, npby, rby, ms, in, igrsurf, bufsf)
Definition srfvit.F:35
fvmesh0
subroutine fvmesh0(t_monvol, xyzini, ixs, ixc, ixtg, pm, ipm, igrsurf, xyzref, nb_node)
Definition fvmesh0.F:55
fvdim
subroutine fvdim(t_monvol)
Definition fvmesh.F:3457
sms_ini_jad_1
subroutine sms_ini_jad_1(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, pk_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1178
sms_ini_jad_2
subroutine sms_ini_jad_2(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, nprw, lprw, tagmsr_rby_sms, intstamp, ipart, igeo, nativ_sms, irbe2, lrbe2, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1567
sms_ini_kdi
subroutine sms_ini_kdi(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, kad_sms, kdi_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, iad_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, ipart, igeo, nativ_sms)
Definition sms_init.F:774
sms_ini_kad
subroutine sms_ini_kad(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs16, ixs20, iparg, ms, ms0, nodnx_sms, icodt, icodr, kinet, kad_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, tagprt_sms, tagrel_sms, itab, irbe2, irbe3, lrbe2, lrbe3, nprw, lprw, ipart, igeo, nativ_sms)
Definition sms_init.F:391
sms_ini_jad_3
subroutine sms_ini_jad_3(ixc, iparg, ixs, ixt, ixp, ixr, ixtg, ixs10, nodnx_sms, jadc_sms, jads_sms, jads10_sms, jadt_sms, jadp_sms, jadr_sms, jadtg_sms, tagprt_sms, kad_sms, kdi_sms, tagrel_sms, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, ipartx, npby, lpby, kinet, tagslv_rby_sms, ipari, intbuf_tab, lad_sms, jsm_sms, intstamp, ipart, igeo, tagmsr_rby_sms, nativ_sms, iad_sms, idi_sms, jad_sms, jdi_sms, t2main_sms)
Definition sms_init.F:1871
deallocate_joint
subroutine deallocate_joint()
Definition deallocate_joint.F:31
int18_law151_init
subroutine int18_law151_init(s_append_array, ninter, npari, numnod, numels, ngrbric, multi_fvm, igrbric, ipari, ixs, x, v, ms, kinet, x_append, v_append, mass_append, kinet_append)
Definition int18_law151_init.F:34
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:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
startime
subroutine startime(event, itask)
Definition timer.F:93
printime
subroutine printime(itask, got_timer, startdate, starttime, enddate, endtime)
Definition timer.F:184
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
trace_out
subroutine trace_out(nsub)
Definition trace_back.F:324
trace_in
subroutine trace_in(nsub, itab, atab)
Definition trace_back.F:98
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
ener_w0
subroutine ener_w0
Definition static.F:313
stop_sensor
subroutine stop_sensor(sensors, h3d_data, dynain_data, output)
Definition stop_sensor.F:39
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:254
array_mod::array_type
Definition array_mod.F:61
groupdef_mod::group_
Definition groupdef_mod.F:700
nlocal_reg_mod::nlocal_str_
Definition nlocal_reg_mod.F:124
pinchtype_mod::pinch
Definition pinchtype_mod.F:76
unitab_mod::unit_type_
Definition unitab_mod.F:520
tempur
subroutine tempur(temp, mcp, fthe, nodft, nodlt, weight, mcp_off, heat_stored)
Definition tempur.F:29
th_time_output
subroutine th_time_output(ithout, sensors, output)
Definition th_time_output.F:32
thbcs
subroutine thbcs(nodft, nodlast, icodt, icodr, iskew, skew, a, ar, ms, in, fthreac, nodreac, cptreac)
Definition thbcs.F:33
thbcs_imp
subroutine thbcs_imp(nodft, nodlast, a, ar, fthreac, nodreac, cptreac, fthdtm, dt3)
Definition thbcs_imp.F:33
thermbilan
subroutine thermbilan(glob_therm)
Definition thermbilan.F:35
printime_interf
subroutine printime_interf(intbuf_tab, ipari, intlist, nbintc, treshold)
Definition timer_interf.F:160
timfun
subroutine timfun(python, fv, np, tf)
Definition timfun.F:33
upd_tmax
subroutine upd_tmax(elbuf_tab, iparg, geo, pm, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, d, v, iad_elem, fr_elem, weight, ipm, igeo, stack, itask)
Definition upd_outmax.F:56
update_failwave
subroutine update_failwave(failwave)
Definition update_failwave.F:34
update_slipring
subroutine update_slipring(ixr, ixc, iparg, elbuf_tab, flag_slipring_update, flag_retractor_update, x, npby)
Definition update_slipring.F:39
upenr_crk
subroutine upenr_crk(addcne_crk, inod_crk, nodft, nodlt, nodenr, enrtag, nodlevxf, procne_crk)
Definition upenr_crk.F:32
upxfem1
subroutine upxfem1(xfem_tab, iparg, ixc, ngrouc, igrouc, ixtg, iadc_crk, iel_crk, inod_crk, elcutc, nodedge, enrtag, crkedge, xedge4n, xedge3n)
Definition upxfem1.F:42
upxfem2
subroutine upxfem2(iparg, ixc, ngrouc, igrouc, iadc_crk, iel_crk, elcutc, ixtg, enrtag, inod_crk, iad_elem, fr_elem, iad_edge, fr_edge, fr_nbedge, crkedge)
Definition upxfem2.F:43
upxfem_tagxp
subroutine upxfem_tagxp(xfem_tab, iparg, ixc, ngrouc, igrouc, ixtg, iadc_crk, iel_crk, inod_crk, elcutc, nodedge, enrtag, crkedge, xedge4n, xedge3n, itab)
Definition upxfem_tagxp.F:42
user_windows_routine
subroutine user_windows_routine(ispmd, nspmd, userl_avail, user_windows, rad_inputname, len_rad_inputname, numnod, ncycle, itab, tt, dt1, wfext, d, x, v, vr, ms, in, stifn, stifr, a, ar, dt2)
Definition user_windows.F:43
vitesse
subroutine vitesse(a, ar, v, vr, fzero, itab, nale)
Definition vitesse.F:29
vitessepinch
subroutine vitessepinch(apinch, vpinch, nodft, nodlt)
Definition vitessepinch.F:33
spmd_crk_adv
subroutine spmd_crk_adv(iad_elem, fr_elem, inod_crk, enrtag)
Definition xfemfsky.F:712
xfeoff
subroutine xfeoff(xfem_tab, iparg, ixc, ngrouc, igrouc, iel_crk, elcutc, ixtg, iadc_crk, iad_elem, iad_edge, fr_edge, fr_nbedge, fr_elem, nlay, inod_crk, crkedge, xedge4n, xedge3n)
Definition xfeoff.F:44
zeror
subroutine zeror(a, n)
Definition zero.F:39