OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
resol_init.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_init ../engine/source/engine/resol_init.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| admgvid ../engine/source/model/remesh/admgvid.F
29!|| admini ../engine/source/model/remesh/admini.F
30!|| admordr ../engine/source/model/remesh/admordr.F
31!|| anim_xfe_init ../engine/source/output/anim/generate/anim_crk_init.F
32!|| assadd2 ../engine/source/assembly/assadd2.F
33!|| chkinit ../engine/source/interfaces/interf/chkstfn3.F
34!|| cndmasi2_dim ../engine/source/elements/solid/solide10/s10cndf.F
35!|| cndmasi2_ini ../engine/source/elements/solid/solide10/s10cndf.F
36!|| cndordr ../engine/source/model/remesh/cndordr.F
37!|| dim_tshedg ../engine/source/elements/thickshell/solidec/dim_tshedg.F
38!|| fillipartl ../engine/source/engine/resol_init.F
39!|| findgroupc ../engine/source/elements/findgroup.F
40!|| findgroups ../engine/source/elements/findgroup.F
41!|| grpsplit ../engine/source/engine/resol_init.F
42!|| imp_init ../engine/source/implicit/imp_init.F
43!|| ind_tshedg ../engine/source/elements/thickshell/solidec/ind_tshedg.F
44!|| ini_tmax ../engine/source/output/ini_outmax.F
45!|| init_kyne ../engine/source/engine/resol_init.F
46!|| init_reac_nod ../engine/source/output/th/init_reac_nod.F
47!|| init_th_group ../engine/source/output/th/init_th_group.F
48!|| initimeg ../engine/source/system/timer.F
49!|| inivel_init ../engine/source/loads/general/inivel/inivel_init.F90
50!|| int_flushtime ../common_source/modules/interfaces/metric_mod.F
51!|| inter_sh_offset_ini ../engine/source/interfaces/shell_offset/inter_offset_ini.F90
52!|| kinini ../engine/source/constraints/general/kinini.F
53!|| mpp_init ../engine/source/mpi/interfaces/spmd_i7tool.F
54!|| my_barrier ../engine/source/system/machine.F
55!|| r2r_init ../engine/source/coupling/rad2rad/r2r_init.F
56!|| rbe2_init ../engine/source/constraints/general/rbe2/rbe2f.F
57!|| s10cnd_ini ../engine/source/elements/solid/solide10/s10cndf.F
58!|| s10cndi2_ini ../engine/source/elements/solid/solide10/s10cndf.F
59!|| s10cnds_dim ../engine/source/elements/solid/solide10/s10cndf.F
60!|| s10cnds_ini ../engine/source/elements/solid/solide10/s10cndf.F
61!|| section_init ../engine/source/tools/sect/section_init.F
62!|| spmd_anim_ply_init ../engine/source/mpi/anim/spmd_anim_ply_init.F
63!|| spmd_failwave_boundaries ../engine/source/mpi/output/spmd_exch_failwave.F
64!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
65!|| spmd_sub_boundaries ../engine/source/mpi/spmd_exch_sub.F
66!|| tmax_ipart ../engine/source/output/tmax_ipart.f
67!|| tshcdcom_dim ../engine/source/elements/thickshell/solidec/tshcdcom_dim.F
68!|| tshcdcom_ini ../engine/source/elements/thickshell/solidec/tshcdcom_ini.F
69!|| zero1 ../engine/source/system/zero.f
70!|| zeror ../engine/source/system/zero.F
71!||--- uses -----------------------------------------------------
72!|| alemuscl_mod ../common_source/modules/ale/alemuscl_mod.F
73!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
74!|| dtdc_mod ../engine/share/modules/dtdc_mod.F
75!|| ecnd_mod ../engine/share/modules/ecdn_mod.F
76!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
77!|| element_mod ../common_source/modules/elements/element_mod.F90
78!|| failwave_mod ../common_source/modules/failwave_mod.F
79!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
80!|| groupdef_mod ../common_source/modules/groupdef_mod.F
81!|| h3d_inc_mod ../engine/share/modules/h3d_inc_mod.F
82!|| h3d_mod ../engine/share/modules/h3d_mod.F
83!|| inivel_init_mod ../engine/source/loads/general/inivel/inivel_init.F90
84!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
85!|| inter_sh_offset_ini_mod ../engine/source/interfaces/shell_offset/inter_offset_ini.F90
86!|| inter_sh_offset_mod ../engine/source/modules/interfaces/sh_offset_mod.F90
87!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.f
88!|| loads_mod ../common_source/modules/loads/loads_mod.F90
89!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
90!|| outmax_mod ../common_source/modules/outmax_mod.F
91!|| output_mod ../common_source/modules/output/output_mod.F90
92!|| parith_on_mod ../common_source/modules/parith_on_mod.F90
93!|| pblast_mod ../common_source/modules/loads/pblast_mod.F90
94!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
95!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
96!|| rbe3_mod ../common_source/modules/constraints/rbe3_mod.F90
97!|| sensor_mod ../common_source/modules/sensor_mod.F90
98!|| spmd_xv_inter_type1_mod ../engine/source/mpi/nodes/spmd_sd_xv_inter1.F90
99!|| stack_mod ../engine/share/modules/stack_mod.F
100!||====================================================================
101 SUBROUTINE resol_init(
102 1 ITASK ,FR_NBCC ,
103 2 ISENDTO ,IRCVFROM ,IAD_ELEM,FR_ELEM ,ITABM1 ,
104 3 IPARI ,IPARG ,ITAB ,IXS10 ,IXS20 ,
105 4 I13A ,I13B ,I13C ,I13D ,I13E ,
106 5 I13F ,I13G ,I13H ,I13I ,I15A ,
107 6 I15B ,I15C ,I15D ,I15E ,I15F ,
108 7 I15G ,I15H ,I15I ,I87A ,I87B ,
109 8 I87C ,I87D ,I87E ,I87F ,I87G ,
110 9 NFIA ,NFEA ,NFOA ,NDMA ,NDMA2 ,
111 A NODFT ,NODLT ,NDTASK ,NUMNTHREAD ,IXS16 ,
112 B IXS ,IXQ ,IXC ,IXT ,IXP ,
113 C IXR ,IXTG ,PON, IKINE ,
114 D A ,AR ,V ,VR ,
115 E X ,D ,MS ,IN ,STIFN ,
116 F STIFR ,DMAS ,DINER ,
117 G WA ,UWA ,PM ,GEO ,
118 H PARTSAV ,PARTS0 ,MONVOL ,
119 I I87H ,I87I ,I87J ,I87K ,
120 J I15J ,KXX ,
121 K SECBUF ,SECFCUM ,NSTRF ,IGRNOD ,IEXLNK ,
122 L XFRAME ,
123 M IXTG1 ,IB ,VISCN ,DD_R2R ,
124 O ELBUF ,IPART ,MADPRT ,MADSH4 ,
125 P MADSH3 ,MADSOL ,MADNOD ,MADFAIL ,IGEO ,
126 Q INTLIST ,NBINTC ,PROCNE ,NISKYFI ,WEIGHT ,
127 R ISIZXV ,ILENXV ,ADDCNI2 ,PROCNI2 ,IAD_I2M ,
128 S FR_I2M ,FR_NBCCI2,I2SIZE ,FR_MAD ,LWIBEM ,
129 T LWRBEM ,FXBFP ,FXBEFW ,FXBEDP ,FXBGRP ,
130 U FXBGRW ,NDIN ,
131 V ISLEN7 ,IRLEN7 ,ISLEN11 ,IRLEN11 ,
132 W LWIFLOW ,LWRFLOW ,IFLOW ,ADDCNEL ,CNEL ,
133 X ADDTMPL ,IPARTL ,NPARTL ,NFNCA ,NFTCA ,
134 Y I15ATH ,I35ATH ,IPM ,SH4TREE ,IPADMESH ,
135 Z MSC ,INC ,SH3TREE ,MSTG ,INTG ,
136 a PTG ,FTHE ,FTHESKY ,FTHESKYI ,NME17 ,
137 b ISLEN17 ,IRLEN17 ,IRLEN7T ,ISLEN7T ,LINDIDEL ,
138 c LBUFIDEL,SH4TRIM ,SH3TRIM ,MSCND ,INCND ,
139 d IRLEN20 ,ISLEN20 ,IRLEN20T,ISLEN20T ,NBINT20 ,
140 e IRLEN20E,ISLEN20E ,NISKYFIE,
141 f MCP ,MS0 ,INOD_PXFEM,IEL_PXFEM,IADC_PXFEM,
142 g ADSKY_PXFEM,ICODT,ICODR ,IBFV ,ADMSMS ,
143 h NODREAC ,IGROUC ,NGROUC ,IGROUNC ,NGROUNC ,
144 i FR_RBY ,FR_RBY6 ,NPBY ,
145 j NOM_SECT ,MCPC ,MCPTG ,GRTH ,IGRTH ,
146 k NELEM ,LAG_SEC ,NPRW ,DIAG_SMS ,DMELC ,
147 l DMELTG ,NGRTH ,NFT2 ,DMELS ,DMELTR ,
148 m DMELP ,DMELRT ,RES_SMS ,I87L ,IRBE2 ,
149 n LRBE2 ,NMRBE2 ,IAD_RBE2 ,FR_RBE2 ,FR_RBE2M ,
150 o R2SIZE ,LPBY ,PROCNE_PXFEM ,ISENDP_PXFEM,IRECVP_PXFEM,
151 p IADSDP_PXFEM,IADRCP_PXFEM,FR_NBCC1,RBY,INT18KINE ,
152 q XDP ,I87M,INOD_CRKXFEM,IEL_CRKXFEM ,IADC_CRKXFEM,
153 r ADSKY_CRKXFEM,PROCNE_CRKXFEM,ISENDP_CRKXFEM,IRECVP_CRKXFEM,
154 s IADSDP_CRKXFEM,IADRCP_CRKXFEM ,INT24USE,NDAMA2 ,
155 t IGROUPC ,IGROUPTG ,IGROUPS ,IGROUPFLG ,DMINT2 ,IRBKIN_L,
156 u NRBYKIN_L,KINDRBY ,ELBUF_TAB ,SENSORS ,DD_R2R_ELEM,
157 v SDD_R2R_ELEM ,KINET, WEIGHT_MD,DMSPH ,IOLDSECT,LBUFIDEL24,
158 w INTBUF_TAB ,NUMSPH_GLO_R2R, FLG_SPHINOUT_R2R,I15K,
159 y CONDN ,CONDNSKY ,KXFENOD2ELC ,ELCUTC ,NODEDGE,
160 z IAD_EDGE ,CRKNODIAD,FR_EDGE ,FR_NBEDGE ,NODLEVXF,
161 x CRKEDGE ,XFEM_TAB ,ISENSINT , NISUBMAX,
162 1 INTLIST25 ,INT24E2EUSE ,TABMP_L ,
163 2 I87N ,TAB_MAT,H3D_DATA,TAGTRIMC,TAGTRIMTG,
164 3 IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS ,
165 4 IGRBEAM ,IGRSPRING,IGRPART ,FORNEQS ,INT7ITIED ,
166 5 FXVEL_FGEO,FAILWAVE,NLOC_DMG,PINCH_DATA,SLLOADP ,
167 6 TAGSLV_RBY,NFNCA2 ,NFTCA2 ,IN0 ,SORT_COMM,STACK,OUTPUT,
168 7 THKE ,SFR_ELEM ,SH_OFFSET_TAB,
169 8 NEED_COMM_INT25_SOLID_EROSION,COMM_INT25_SOLID_EROSION,
170 9 ISKWN ,IFRAME, LOADS ,GLOB_THERM,PBLAST,RBE3,NHIER_RBY)
171C-----------------------------------------------
172C M o d u l e s
173C-----------------------------------------------
174 USE plyxfem_mod
175 USE elbufdef_mod
176 USE intbufdef_mod
177 USE crackxfem_mod
178 USE ecnd_mod
179 USE h3d_mod
180 USE groupdef_mod
181 USE failwave_mod
183 USE pinchtype_mod
184 USE pblast_mod
185 USE dtdc_mod
187 USE stack_mod
188 USE outmax_mod
189 USE sensor_mod
190 USE h3d_inc_mod
192 USE output_mod
193 USE inter_sh_offset_ini_mod , only : inter_sh_offset_ini
194 USE inter_sh_offset_mod , only:sh_offset_
195 USE loads_mod
196 USE inivel_init_mod , only: inivel_init
197 use glob_therm_mod
198 use spmd_xv_inter_type1_mod , only : is_present_inter1
199 USE parith_on_mod, only: element_pon_
200 use rbe3_mod
201 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
202C-----------------------------------------------
203C I m p l i c i t T y p e s
204C-----------------------------------------------
205#include "implicit_f.inc"
206C-----------------------------------------------
207C C o m m o n B l o c k s
208C-----------------------------------------------
209#include "com01_c.inc"
210#include "com04_c.inc"
211#include "com08_c.inc"
212#include "com10_c.inc"
213#include "com_xfem1.inc"
214#include "param_c.inc"
215#include "scr02_c.inc"
216#include "scr03_c.inc"
217#include "scr07_c.inc"
218#include "scr12_c.inc"
219#include "scr14_c.inc"
220#include "scr16_c.inc"
221#include "scr17_c.inc"
222#include "scr23_c.inc"
223#include "units_c.inc"
224#include "cong2_c.inc"
225#include "task_c.inc"
226#include "parit_c.inc"
227#include "timerc_c.inc"
228#include "rad2r_c.inc"
229#include "scr18_c.inc"
230#include "spmd_c.inc"
231#include "fxbcom.inc"
232#include "flowcom.inc"
233#include "remesh_c.inc"
234#include "sms_c.inc"
235#include "lagmult.inc"
236#include "sphcom.inc"
237#include "intstamp_c.inc"
238C-----------------------------------------------------------------
239C D u m m y A r g u m e n t s
240C-----------------------------------------------
241 TYPE(element_pon_) :: PON
242 INTEGER ITASK, NBINTC, NODFT, NODLT, LINDIDEL, LBUFIDEL,
243 . numnthread, ndtask, nfia, nfea, nfoa ,ndma, nfnca, nftca,
244 . ndma2,ndin,n1,n2,n3,igtyp,npartl,ngrouc,ngrounc,
245 . i13a,i13b,i13c,i13d,i13e,i13f,i13g,i13h,i13i,
246 . i15a,i15b,i15c,i15d,i15e,i15f,i15g,i15h,i15i,i15j,i15k,
247 . i87a,i87b,i87c,i87d,i87e,i87f,i87g,i87h,i87i,i87j,
248 . i87k,i87l,i87m,i87n,nfnca2,nftca2,
249 . isizxv , ilenxv, i2size, islen7,irlen7 ,islen11 ,irlen11,
250 . i15ath, i35ath, nme17,islen17,irlen17,irlen7t,islen7t,
251 . irlen20,islen20,irlen20t,islen20t,nbint20,irlen20e,
252 . islen20e,nelem,lag_sec, ngrth, nft2,nmrbe2,
253 . int18kine,int24use,ndama2, nrbykin_l,ioldsect,lbufidel24,
254 . tabmp_l,tagtrimc(*),tagtrimtg(*), slloadp,sfr_elem
255 INTEGER
256 . ixs(nixs,*),ixs10(6,*) ,ixs20(12,*),
257 . ixs16(6,*) , igeo(npropgi,*),
258 . ixq(nixq,*),ixc(nixc,*), ixt(nixt,*), ixp(nixp,*),
259 . ixr(nixr,*), ixtg(nixtg,*), ixtg1(4,*),
260 . itab(*), iparg(nparg,*), ipari(npari,*),
261 . iexlnk(nr2r,*),
262 . weight(*), nstrf(*), ib(nibcld,*), itabm1(*),
263 . monvol(*),kxx(nixx,*),isendto(ninter+1,nspmd+1),
264 . fr_nbcc(2,nspmd+1), iad_elem(2,nspmd+1) ,fr_elem(*),
265 . ircvfrom(ninter+1,nspmd+1), intlist(ninter), procne(*),
266 . niskyfi(*),addcni2(*),procni2(*),iad_i2m(*),fr_i2m(*),
267 . fr_nbcci2(*), ipart(*),
268 . dd_r2r(nspmd+1,*),ipartl(*),
269 . madprt(*), madsh4(*), madsh3(*), madsol(*), madnod(*),
270 . madfail(*), fr_mad(5,*), lwibem, lwrbem, lwiflow, lwrflow,
271 . iflow(*), addcnel(0:*), cnel(0:*), addtmpl(0:*),
272 . ipm(npropmi,*), sh4tree(*), ipadmesh(*), sh3tree(*),
273 . sh4trim(*), sh3trim(*), niskyfie(*),
274 . icodt(*), icodr(*),ibfv(nifv,*),
275 . inod_pxfem(*),iel_pxfem(*) ,iadc_pxfem(4,*),elcutc(2,*),
276 . adsky_pxfem(*), kxfenod2elc(*),nodlevxf(*),crknodiad(*),
277 . nodedge(*),iad_edge(*),fr_edge(*),fr_nbedge(*), nodreac(*),
278 . igrouc(*),igrounc(*),fr_rby(*),fr_rby6(*),npby(*),
279 . nom_sect(*), grth(*),igrth(*), nprw(*),iad_rbe2(*),
280 . fr_rbe2(*),fr_rbe2m(*),r2size, irbe2(nrbe2l,*),lrbe2(*),
281 . ikine(numnod),lpby(*), procne_pxfem(*),
282 . isendp_pxfem(*),irecvp_pxfem(*),iadsdp_pxfem(*),
283 . iadrcp_pxfem(*),fr_nbcc1(2,*),inod_crkxfem(*),
284 . iel_crkxfem(*),iadc_crkxfem(*),adsky_crkxfem(0:*),
285 . procne_crkxfem(*),isendp_crkxfem(*),irecvp_crkxfem(*),
286 . iadsdp_crkxfem(*),iadrcp_crkxfem(*),
287 . igroupc(*),igrouptg(*),igroups(*),igroupflg(2),
288 . irbkin_l(*), kindrby(*), dd_r2r_elem(*),sdd_r2r_elem,
289 . kinet(*),weight_md(*),numsph_glo_r2r,flg_sphinout_r2r,
290 . isensint(nisubmax+1,ninter),nisubmax,
291 . intlist25(ninter25) ,int24e2euse ,fxvel_fgeo,
292 . tagslv_rby(numnod)
293 INTEGER, INTENT(IN ),DIMENSION(LISKN,NUMFRAM+1) :: IFRAME
294 INTEGER, INTENT(IN ),DIMENSION(LISKN,NUMSKW+1) :: ISKWN
295! INT7ITIED : check if an interface type 7 with ITIED /= 0 is used
296! in order to force the communication of a list of candidate nodes
297! INT7ITIED = 0 type 7 + ITIED/=0 not used
298! INT7ITIED = 1 type 7 + ITIED/=0 used
299 INTEGER, INTENT(INOUT) :: INT7ITIED
300 INTEGER, INTENT(INOUT) :: NHIER_RBY
301 my_real
302 . X(3,*), D(3,*), V(3,*), VR(3,*),
303 . MS(*), IN(*), WA(*), A(3,*), AR(3,*),
304 . UWA(*), STIFN(*), STIFR(*),
305 . PARTSAV(NPSAV,*),PARTS0(*),
306 . DMAS, DINER ,
307 . PM(NPROPM,*) , GEO(NPROPG,*),
308 . VISCN(*),
309 . SECBUF(*),SECFCUM(7,NUMNOD,NSECT),XFRAME(NXFRAME,*),
310 . elbuf(*), msc(*), inc(*), mstg(*), intg(*), ptg(*),
311 . mscnd(*), incnd(*), fthe(*), fthesky(*),ftheskyi(*), mcp(*),
312 . ms0(*), admsms(*), mcpc(*), mcptg(*), diag_sms(*),
313 . dmelc(*), dmeltg(*), dmels(*), dmeltr(*), dmelp(*), dmelrt(*),
314 . res_sms(3,*),rby(nrby,*), dmint2(4,i2nsn25),
315 . dmsph(*),condn(*),condnsky ,tab_mat(ngroup),forneqs(3,*)
316 my_real
317 . fxbfp(*), fxbefw(*), fxbedp(*), fxbgrp(*), fxbgrw(*),in0(*)
318 my_real
319 . thke(numelc+numeltg)
320c INTEGER*8
321c . I8A(3,3,*),I8AR(3,3,*),I8STIFN(3,*),I8STIFR(3,*),
322c . I8VISCN(3,*)
323C
324
325 LOGICAL, DIMENSION(NSPMD), INTENT(inout) :: NEED_COMM_INT25_SOLID_EROSION !< boolean, true if the proc needs to comm some values related to interface type 25 with solid erosion
326 INTEGER, INTENT(inout) :: COMM_INT25_SOLID_EROSION !< integer, sub-communicator related to interface type 25 with solid erosion
327C
328 DOUBLE PRECISION XDP(3,*)
329 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
330 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
331 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
332 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
333 TYPE(H3D_DATABASE) :: H3D_DATA
334 TYPE (PINCH) :: PINCH_DATA
335 TYPE (SENSORS_) :: SENSORS
336C-----------------------------------------------
337 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
338 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
339 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
340 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
341 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
342 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
343 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
344 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
345 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
346C-----------------------------------------------
347 TYPE (FAILWAVE_STR_) ,TARGET :: FAILWAVE
348 TYPE (NLOCAL_STR_) ,TARGET :: NLOC_DMG
349 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
350 TYPE (STACK_PLY) :: STACK
351C-----------------------------------------------
352 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
353 TYPE(sh_offset_) :: SH_OFFSET_TAB
354 TYPE (LOADS_) ,INTENT(INOUT) :: LOADS
355 type (glob_therm_) ,intent(inout) :: glob_therm
356 type (pblast_) ,intent(inout) :: pblast
357 type (rbe3_) ,intent(inout) :: rbe3
358C-----------------------------------------------
359C L o c a l V a r i a b l e s
360C-----------------------------------------------
361 INTEGER IMUEL, I, J, K, NG, NINT7,NNOD,K2S,K0,IAD1,IDUM,LLL,
362 . lrbuf, libuf, ity, iad, nnbem, ityp,irotg,ns,lf,lt,ll,l,
363 . l1,l2,isectr,nfr,ic,icr,nisub, ni25,nbr,nsensor,inloc
364 INTEGER JD(50),KD(50),JFI,KFI,NMN,II,NINOUT,NNO,NEL,IFLGADM,
365 . N,JJ,KK, NFT, ISOLNOD,NBS
366 INTEGER, DIMENSION(SENSORS%NSENSOR) :: INDEX_SENSOR
367 INTEGER, DIMENSION(:), ALLOCATABLE :: ISEND,IRECV
368 INTEGER :: ITIED,NINIVELTG
369 my_real :: rdum
370 CHARACTER ZONE*5
371 INTEGER VALUES(8)
372C=======================================================================
373 IDUM = 0
374 rdum = zero
375 isectr = 0
376 nsensor = sensors%NSENSOR
377C-----------------------------------------------
378C //
379C-----------------------------------------------
380C
381C Sequential part
382C
383 IF (itask == 0)THEN
384C zeroing ITYPTS for DTIX
385C
386 itypts=0
387C
388C kinematic conditions : arrays init. (RBY & INT20)
389C
390 CALL init_kyne(ikine,npby,lpby,tagslv_rby,nhier_rby)
391 CALL spmd_max_i(nhier_rby)
392C
393C reaction force (node array)
394C
395 cptreac = 0
396 IF (ireac == 1 ) CALL init_reac_nod(cptreac,nodreac,nthgrp,output%TH%ITHGRP,output%TH%ITHBUF)
397C
398C TH init for group of elems
399C
400 ngrth = 0
401 IF (igrelem == 1 ) THEN
402 CALL init_th_group(grth ,igrth ,nelem ,ngrth ,iparg ,
403 . ipart ,igrbric ,igrquad ,igrsh4n ,igrsh3n,
404 . igrtruss ,igrbeam ,igrspring)
405 ENDIF
406C----- reset initial mass
407 IF (imassi /= 0) THEN
408 ms(1:numnod)=ms0(1:numnod)
409 IF (iroddl /=0) in(1:numnod)=in0(1:numnod)
410 END IF
411C
412C Parallel Structures Init.
413C
414 irotg=0
415 DO i=1,nrbe3
416 irotg=max(irotg,rbe3%IRBE3(6,i))
417 ENDDO
418 CALL spmd_max_i(irotg)
419 rbe3%irotg = irotg
420 IF(irotg==0) THEN
421 rbe3%irotg_sz = 5
422 ELSE
423 rbe3%irotg_sz = 10
424 ENDIF
425
426C---------RBE2----
427 irotg=0
428 DO i=1,nrbe2
429 ic = irbe2(4,i)
430 icr=(ic-512*(ic/512))/64
431 irotg=max(irotg,icr)
432 IF (irbe2(11,i)==0) irotg =1
433 ENDDO
434 CALL spmd_max_i(irotg)
435 IF(irotg==0) THEN
436 r2size = 4
437 ELSE
438 r2size = 8
439 ENDIF
440 ns = nrbe2
441 CALL spmd_max_i(ns)
442 IF (ns==0) r2size = 0
443 nfr = iad_rbe2(nspmd+1)-iad_rbe2(1)
444 IF (nspmd==1) THEN
445 rbe3%irotg_sz = 0
446 r2size = 0
447 ENDIF
448
449c
450C IRBE2 init.
451 CALL rbe2_init(irbe2 ,lrbe2 ,nmrbe2 ,fr_rbe2 ,fr_rbe2m,nfr)
452C
453 CALL mpp_init(
454 1 ipari ,isendto ,ircvfrom,intlist ,nbintc ,
455 2 isizxv ,ilenxv ,iad_elem,i2size ,itask ,
456 3 islen7 ,irlen7 ,islen11 ,irlen11 ,igrbric ,
457 4 nme17 ,islen17 ,irlen17 ,irlen7t ,islen7t ,
458 5 lindidel,lbufidel,irlen20 ,islen20 ,irlen20t,
459 6 islen20t,nbint20 ,irlen20e,islen20e,fr_rby ,
460 7 fr_rby6 ,npby ,irbkin_l,nrbykin_l,kindrby,
461 8 nsensor ,sensors%SENSOR_TAB,lbufidel24, intbuf_tab,
462 9 sort_comm,need_comm_int25_solid_erosion,comm_int25_solid_erosion )
463C
464 IF(idel7ng>0.OR.irad2r>0.OR.alemuscl_param%IALEMUSCL>0.OR.pdel>0) THEN
465 CALL chkinit(
466 2 ixs ,ixq ,ixc ,ixt ,ixp ,
467 3 ixr ,ixtg ,ixs10 ,ixs20 ,
468 4 ixs16 ,ixtg1 ,geo ,addcnel ,cnel ,
469 5 addtmpl ,iparg )
470 ENDIF
471
472C
473 IF (irad2r /= 0) THEN
474 CALL r2r_init(iexlnk ,itab,igrnod,x ,
475 2 ms ,in ,dd_r2r,weight ,iad_elem,
476 3 fr_elem,addcnel,cnel,ixc,iparg,icodt,icodr,
477 4 ibfv,d,rby,npby,xdp,stifn,stifr,dd_r2r_elem,
478 5 sdd_r2r_elem,weight_md,ilenxv,numsph_glo_r2r,
479 6 flg_sphinout_r2r,ipari,nloc_dmg)
480 END IF
481 ! FANI(1,1) = VECT_CONT !cont
482
483 ! FANI(1,NFIA+1) = VECT_FINT ! FINT
484 nfia = numnod*min(1,anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT)
485 ! FANI(1,NFEA+1) = VECT_FEXT ! FEXT
486 nfea = nfia + numnod*min(1,anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT)
487 ! FANI(1,NFNCA+1) = VECT_PCONT ! FNCONT
488 nfnca= nfea + numnod*min(1,anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT)
489 ! FANI(1,NFTCA+1) = VECT_PCONT_2 !FTCONT
490 nftca= nfnca+ numnod*min(1,anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT)
491 ! FANI(1,NFOA+1) = SECT + RBODY + RWALL = FOPT
492 nfoa = nftca+ numnod*min(1,anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT)
493 ! FANI(1,NFT2+1) = VECT_CONT2 = FNCONT2
494 nft2 = nfoa+ 2*(nsect+nrbody+nrwall)
495 ! FANI(1,NFNCA2+1) = VECT_PCONT2 = FNCONTP2
496 nfnca2= nft2 + numnod*min(1,anim_v(13)+h3d_data%N_VECT_CONT2)
497 ! FANI(1,NFTCA2+1) = VECT_PCONT2_2 = FTCONTP2
498 nftca2= nfnca2+ numnod*min(1,anim_v(27)+h3d_data%N_VECT_PCONT2)
499
500 ! ANIN(1,1) = SCAL_DT
501 ! ANIN(1,NDMA+1) = SCAL_DMAS
502 ndma = numnod*min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
503 ! ANIN(1,NDIN+1) = SCAL_DINER
504 ndin = ndma +numnod*min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
505 ! anin(1,ndma2+1) = scal_spring
506 ndma2 = ndin+numnod*min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER)
507 ! ANIN(1,NDAMA2+1) = SCAL_DAMA2 ! PDAMA2
508 ndama2 = ndma2+numelr*(anim_fe(11)+anim_fe(12)+anim_fe(13))
509
510
511 IF(iroddl/=0)THEN
512 DO ng=1,ninter
513 ity = ipari(7,ng)
514 IF(ity==2) THEN
515 nmn=ipari(6,ng)
516 DO ii = 1, nmn
517 i = intbuf_tab(ng)%MSR(ii)
518 intbuf_tab(ng)%NMAS(nmn+ii) = in(i)
519C For multidomains inertia of main nodes on multidomains interface msut be non zero
520 IF (irad2r==1) in(i)=max(em20,in(i))
521 END DO
522 END IF
523 END DO
524 END IF
525 dmas = zero
526 diner = zero
527C
528 IF(mcheck==0)ncycle=0
529 i7kglo = 0
530 nabfwr = 0
531C
532 i13a=1+2*nsnod
533 i13b=i13a+nsels
534 i13c=i13b+nselq
535 i13d=i13c+nselc
536 i13e=i13d+nselt
537 i13f=i13e+nselp
538 i13g=i13f+nselr
539 i13h=i13g+nselu
540 i13i=i13h+nseltg
541 i15ath=1+lipart1*(npart+nthpart)
542 i15a=i15ath+2*9*(npart+nthpart)
543 i15b=i15a+numels
544 i15c=i15b+numelq
545 i15d=i15c+numelc
546 i15e=i15d+numelt
547 i15f=i15e+numelp
548 i15g=i15f+numelr
549 i15h=i15g
550 i15i=i15h+numeltg
551 i15j=i15i+numelx
552 i15k=i15j+numsph
553 i35ath=1+lisub1*nsubs
554C
555 i87a = 1
556 i87b = i87a + 8 * numels + 6 * numels10 + 12 * numels20 + 8 * numels16
557 i87c = i87b + 4 * numelq
558 i87d = i87c + 4 * numelc
559 i87e = i87d + 2 * numelt
560 i87f = i87e + 2 * numelp
561 i87g = i87f + 3 * numelr
562 i87h = i87g + 3 * numeltg
563 i87h = i87h + 3 * numeltg6
564 i87i = i87h
565 i87j = i87i + 4 * nskymv0
566 i87k = i87j + 4 * nconld
567 i87l = i87k + 4 * glob_therm%NUMCONV
568 i87m = i87l + 4 * glob_therm%NUMRADIA
569 i87n = i87m + slloadp
570C I87O = I87N + 4 * GLOB_THERM%NFXFLUX
571C
572C----------------------------
573 maxnx=0
574 DO i=1,numelx
575 IF (kxx(3,i)>maxnx) maxnx=kxx(3,i)
576 ENDDO
577C----------------------------
578 DO i=1,npart
579 partsav(8,i)=parts0(i)
580 ENDDO
581C----------------------------
582 IF (ispmd==0)THEN
583 CALL date_and_time(startdate, starttime, zone, values)
584 WRITE(istdo,'(A,I2.2,A,I2.2,A,I4.4)') ' ',values(3),'/',values(2),'/',values(1)
585 WRITE(iout,'(A,I2.2,A,I2.2,A,I4.4)') ' ',values(3),'/',values(2),'/',values(1)
586 END IF
587C
588 manim = 0
589 mrest = 0
590 mstop = 0
591 ictlstop = 0
592 h3d_data%MH3D = 0
593 IF(dtin/=0. .AND. mcheck==0)THEN !go on with previous time step in case of checkpoint restart (/CHKPT)
594 IF(dt2old==zero)THEN
595 dt2old=dtin/onep1
596 ELSE
597 dt2old= min(dt2old,dtin/onep1)
598 ENDIF
599 ENDIF
600 IF(anim_v(26)+h3d_data%N_VECT_CONT_MAX >0) ifcontmax=1
601 IF(h3d_data%N_VECT_PCONT_MAX >0) ifcontpmax=1
602 IF(h3d_data%N_VECT_CONT2_MAX >0) ifcont2max=1
603 IF(h3d_data%N_VECT_PCONT2_MAX >0) ifcontp2max=1
604 IF(h3d_data%N_VECT_CONT2_MIN >0) ifcont2min=1
605 IF(h3d_data%N_VECT_PCONT2_MIN >0) ifcontp2min=1
606 IF(h3d_data%N_SCAL_CSE_FRIC >0) THEN
607 output%DATA%S_EFRIC = numnod
608 IF(nintstamp/=0) output%DATA%S_EFRICG = numnodg
609 ENDIF
610 IF(output%DATA%NINEFRIC >0) output%DATA%S_EFRICINT = numnod
611 IF(output%DATA%NINEFRIC_STAMP >0) output%DATA%S_EFRICINTG = numnodg
612C------------------------
613C PARAL. ARITH.
614C------------------------
615 IF(iparit==3) THEN
616 write(6,*) 'Non supported /PARITH option'
617 ELSEIF(iparit/=0) THEN
618C
619C parith/on
620C
621 IF(ivector==1)THEN
622 iad1 = numnod+2
623 ELSE
624 iad1 = 1
625 ENDIF
626 CALL assadd2(
627 1 pon%ADSKY ,pon%ADSKY(iad1),pon%FSKY ,pon%FSKYM ,iad_elem ,
628 2 fr_elem ,fr_nbcc ,procne,niskyfi ,addcni2 ,
629 3 procni2 ,iad_i2m ,fr_i2m,fr_nbcci2,addcni2(iad1),
630 4 pon%IADSDP ,pon%IADRCP ,pon%ISENDP,pon%IRECVP ,fthesky ,
631 5 niskyfie,inod_pxfem ,adsky_pxfem,procne_pxfem,
632 6 isendp_pxfem,irecvp_pxfem ,iadsdp_pxfem,iadrcp_pxfem,
633 7 fr_nbcc1,inod_crkxfem,adsky_crkxfem,procne_crkxfem,
634 8 isendp_crkxfem,irecvp_crkxfem,iadsdp_crkxfem,iadrcp_crkxfem,
635 9 condnsky,glob_therm)
636 ENDIF
637C
638 CALL fillipartl(
639 1 ipartl ,ipart(i15a),ipart(i15b),ipart(i15c),ipart(i15d),
640 2 ipart(i15e),ipart(i15f),ipart(i15g),ipart(i15h),ipart(i15i),
641 3 ipart(i15j),ipart(i15k),npartl )
642C------------------------
643C SPLIT GROUP FOR OPTIMIZATION
644C------------------------
645 CALL grpsplit(
646 1 iparg, igrouc, ngrouc, igrounc, ngrounc,
647 2 ixc,ixs,ixtg,ipm,igeo,pm,geo,tabmp_l,tab_mat)
648C--------------------------
649C FIND GROUP FOR SHELLS
650C--------------------------
651 IF(igroupflg(1) == 1 ) CALL findgroupc(iparg, igrouc, ngrouc, igroupc, igrouptg)
652C--------------------------
653C FIND GROUP FOR BRICKS
654C--------------------------
655 IF(igroupflg(2) == 1 ) CALL findgroups(iparg, igroups)
656C----------------------------------------------------------
657C TAG : NODES FROM ALL SECTIONS
658C----------------------------------------------------------
659 IF(isecut/=0)THEN
660 k0=nstrf(25)
661 DO i=1,nsect
662 nnod=nstrf(k0+6)
663 k2s=k0+30+nstrf(k0+14)
664 DO j=1,nnod
665 secfcum(4,nstrf(k2s),i)=1.
666 k2s=k2s+1
667 ENDDO
668 IF (nstrf(k0) >= 100 ) isectr = i
669 k0=nstrf(k0+24)
670 ENDDO
671 CALL section_init(nstrf,secbuf,nom_sect,isectr,nsect,ioldsect)
672 ENDIF
673C-----------------------------------------------------
674C SQRT H1, H2, H3 for shell elements
675C-----------------------------------------------------
676 DO i = 1, numgeo
677 igtyp = igeo(11,i)
678 IF(igtyp==1.OR.(igtyp>=9 .AND. igtyp<=11).OR.igtyp==16) THEN
679 geo(18,i) = sqrt(geo(13,i))
680 geo(19,i) = sqrt(geo(14,i))
681 geo(20,i) = sqrt(geo(15,i))
682 ENDIF
683 ENDDO
684C-----------------------------------------------------
685C optional SQRT(G), SQRT(A11) SQRT(A12), SQRT(NU), SQRT(SHF) for former restart file
686C-----------------------------------------------------
687 IF(pminver<6)THEN
688 DO i = 1, numgeo
689 geo(100,i) = sqrt(geo(38,i)) ! SHFSR
690 END DO
691 DO i = 1, nummat
692 IF(ipm(2,i)==999)cycle !possible negative square root otherwise PM(25)=CPE(gas)
693 pm(12,i) = sqrt(abs(pm(22,i))) ! GSR
694 pm(13,i) = sqrt(abs(pm(24,i))) ! A11SR
695 pm(14,i) = sqrt(abs(pm(25,i))) ! A12SR
696 pm(190,i)= sqrt(abs(pm(21,i))) ! NUSR
697 END DO
698 END IF
699C----------------------------------------------------------
700C INIT FLEX BODY
701C----------------------------------------------------------
702 IF (nfxbody>0) THEN
703 DO i=1,lenvar
704 fxbfp(i)=zero
705 fxbgrp(i)=zero
706 ENDDO
707 DO i=1,nfxbody
708 fxbefw(i)=zero
709 fxbgrw(i)=zero
710 fxbedp(i)=zero
711 ENDDO
712 ENDIF
713C----------------------------------------------------------
714C LWORKING ARRAY SIZES - AIRBAG BEM
715C----------------------------------------------------------
716 iad=0
717 lwibem=0
718 lwrbem=0
719 DO i=1,nvolu
720 ityp=monvol(iad+2)
721 IF (ityp==7) THEN
722 nnbem=monvol(iad+32)
723 lwibem=lwibem+1+nnbem
724 lwrbem=lwrbem+nnbem**2
725 ENDIF
726 iad=iad+nimv
727 ENDDO
728C----------------------------------------------------------
729C WORKING ARRAY SIZES - FLOW BEM
730C----------------------------------------------------------
731 iad=0
732 lwiflow=0
733 lwrflow=0
734 DO i=1,nflow
735 ityp=iflow(iad+2)
736 IF (ityp == 1 .OR.ityp == 3) THEN
737 lwiflow=lwiflow+iflow(iad+8)
738 lwrflow=lwrflow+iflow(iad+9)
739 ENDIF
740 iad=iad+liflow
741 ENDDO
742C----------------------------------------------------------
743C Domain Decomposition Weight computation
744C----------------------------------------------------------
745 IF(iddw>0) CALL initimeg(ngroup)
746C----------------------------------------------------------
747C Init Adaptive Meshing (Sequential)
748C----------------------------------------------------------
749 IF(nadmesh/=0)THEN
750 CALL admini(ixc ,ipart(i15c),ixtg ,ipart(i15h),ipart,
751 . igeo,ipm ,iparg ,x ,ms ,
752 . in ,elbuf_tab ,sh4tree,ipadmesh,msc ,
753 . inc ,sh3tree ,mstg ,intg ,ptg ,
754 . sh4trim ,sh3trim,mscnd ,incnd ,pm ,
755 . mcp ,mcpc ,mcptg ,tagtrimc ,tagtrimtg,
756 . glob_therm%ITHERM_FE)
757!
758 CALL admordr(sh4tree,sh3tree,ixc,ixtg)
759 iadmesh=0
760 ngdone=1
761 END IF
762 IF(istatcnd/=0)THEN
763C ADAPTIVE MESHING + STATIC CONDENSATION
764 CALL cndordr(ipart,ipart(i15c),ipart(i15h),sh4tree,sh3tree)
765 END IF
766C----------------------------------------------------------
767C Lagrangian multipliers (sequential)
768C----------------------------------------------------------
769 IF(lag_ncf+lag_ncl > 0)THEN
770 lag_sec=0
771C numbering incompatible options if NSPMD > 1
772 DO i = 1, ninter
773 IF(ipari(33,i)/=0)lag_sec=1
774 END DO
775 DO i = 1, nrwall
776 IF(nprw(i+5*nrwall)==1)lag_sec=1
777 END DO
778 IF(nbcslag+ngjoint+nrbylag > 0)lag_sec=1
779C NUMMPC + NFVLAG : ok (parallele SPMD)
780 END IF
781
782C-----------------------
783C INTERFACE TYPE 1
784C-----------------------
785 is_present_inter1 = -1
786C-----------------------
787C INTERFACE TYPE 18 KINE
788C-----------------------
789 int18kine=0
790 DO i=1, ninter
791 IF(ipari(7,i) == 7 .AND. ipari(34,i) == -2 .AND. ipari(22,i) == 7)THEN
792 int18kine=1
793 ENDIF
794 ENDDO
795C-----------------------
796C INTERFACE TYPE 7 FLAG + ITIED /= 0
797C-----------------------
798 int7itied = 0
799 DO i=1, ninter
800 ityp = ipari(7,i)
801 itied = ipari(85,i)
802 IF(ityp==7.AND.itied/=0)THEN
803 int7itied = 1
804 ENDIF
805 IF(ityp==10) int7itied = 1
806 ENDDO
807C-----------------------
808C INTERFACE TYPE 24 FLAG
809C-----------------------
810 int24use = 0
811 DO i=1, ninter
812 IF(ipari(7,i)==24)THEN
813 int24use = 1
814C Check if type 24 has E2E , set INT24E2EUSE
815 IF(ipari(59,i) >0) int24e2euse=1
816 ENDIF
817 ENDDO
818C-----------------------
819C INTERFACE TYPE 25 LIST
820C-----------------------
821 ni25 = 0
822 DO i=1, ninter
823 IF(ipari(7,i)==25)THEN
824 ni25 = ni25 + 1
825 intlist25(ni25)=i
826 ENDIF
827 ENDDO
828C-----------------------
829C SENSOR INTERFACE
830C-----------------------
831 IF (sensors%STABSEN > 0) THEN
832 DO n=1,ninter
833 nisub =ipari(36,n)
834 isensint(1,n) = sensors%TABSENSOR(n+1 + nsect) - sensors%TABSENSOR(n + nsect)
835C
836 IF (ipari(71,n)>0) THEN
837C-- sensor associated to all interfaces of type19
838 isensint(1,n) = isensint(1,ipari(71,n))
839 ENDIF
840C
841 DO i=1,nisub
842 isensint(i+1,n) = sensors%TABSENSOR(i +1 + nsect + ninter) -
843 . sensors%TABSENSOR(i + nsect + ninter)
844 ENDDO
845 ENDDO
846 ENDIF
847C-----------------------
848C INTERFACE TYPE 2 penalty
849C-----------------------
850 int2pen=0
851 DO i=1, ninter
852 IF (ipari(7,i) == 2 .AND. ipari(20,i) == 25) THEN
853 int2pen=1
854 EXIT
855 ENDIF
856 ENDDO
857
858C-----------------------
859C /IMPDISP/FGEO
860C-----------------------
861 fxvel_fgeo=0
862 DO n=1,nfxvel
863 IF (ibfv(13,n) > 0 ) THEN
864 fxvel_fgeo = 1
865 EXIT
866 ENDIF
867 ENDDO
868
869
870 ENDIF ! ITASK==0
871C-----------------------------------------------------
872C END OF SEQUENTIAL PART
873C-----------------------------------------------------
874C
875 CALL my_barrier()
876C--- // --------------------------------------
877C FORCE & MOMENTUM INIT
878C---------------------------------------------
879 IF(ninter/=0.AND.anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT >0) output%DATA%VECT_CONT = 0
880 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0) THEN
881 output%DATA%VECT_PCONT = 0
882 output%DATA%VECT_PCONT_2 = 0
883 END IF
884 IF(anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS >0)THEN
885 output%DATA%SCAL_DMAS = 0
886!!#include "vectorize.inc"
887!! DO I=NODFT,NODLT
888!! ANIN(I+NDMA) = ZERO
889!! ENDDO
890 ENDIF
891 IF(anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER >0)THEN
892 output%DATA%SCAL_DINER = 0
893!!#include "vectorize.inc"
894!! DO I=NODFT,NODLT
895!! ANIN(I+NDIN) = ZERO
896!! ENDDO
897 END IF
898 IF(anim_n(15) == 1 .OR. anim_n(16) == 1 .OR. h3d_data%N_SCAL_DAMA2 == 1)THEN
899 output%DATA%SCAL_DAMA2 = 0
900!!#include "vectorize.inc"
901!! DO I=NODFT,NODLT
902!! ANIN(NDAMA2+2*(I-1)+1) = ZERO
903!! ANIN(NDAMA2+2*(I-1)+2) = ZERO
904!! ENDDO
905 ENDIF
906!C-----------------------------------------------
907C RESTARTING RADIOSS ENGINE.
908 IF (iparit==0) THEN
909 CALL zeror(a(1,ndtask),numnod)
910 IF(iroddl/=0)CALL zeror(ar(1,ndtask),numnod)
911 DO i=ndtask,ndtask+numnod-1
912 stifn(i)=em20
913 ENDDO
914 IF(iroddl/=0)THEN
915 DO i=ndtask,ndtask+numnod-1
916 stifr(i)=em20
917 ENDDO
918 ENDIF
919C
920 IF(kdtint/=0)THEN
921 CALL zero1(viscn(ndtask),numnod)
922 ENDIF
923C
924 IF (glob_therm%ITHERM_FE > 0) THEN
925 CALL zero1(fthe(ndtask),numnod)
926 ENDIF
927C
928 IF(sol2sph_flag/=0)THEN
929 CALL zero1(dmsph(ndtask),numnod)
930 ENDIF
931
932 IF (glob_therm%NODADT_THERM > 0) THEN
933 CALL zero1(condn(ndtask),numnod)
934 ENDIF
935C
936 IF(npinch > 0) THEN
937 CALL zeror(pinch_data%APINCH(1,ndtask),npinch)
938 DO i=ndtask,ndtask+numnod-1
939 pinch_data%STIFPINCH(i)=em20
940 ENDDO
941 ENDIF
942 ELSE ! IPARIT>0
943 CALL zeror(a(1,nodft),numnthread)
944 IF(iroddl/=0)CALL zeror(ar(1,nodft),numnthread)
945 DO i=nodft,nodlt
946 stifn(i)=em20
947 ENDDO
948 IF(iroddl/=0)THEN
949 DO i=nodft,nodlt
950 stifr(i)=em20
951 ENDDO
952 ENDIF
953 IF(kdtint/=0)THEN
954 CALL zero1(viscn(nodft),numnthread)
955 ENDIF
956C
957 IF (glob_therm%ITHERM_FE > 0 ) THEN
958 CALL zero1(fthe(nodft),numnthread)
959 ENDIF
960C
961 IF(sol2sph_flag/=0)THEN
962 CALL zero1(dmsph(nodft),numnthread)
963 ENDIF
964
965 IF (glob_therm%NODADT_THERM > 0) THEN
966 CALL zero1(condn(nodft),numnthread)
967 ENDIF
968C
969 IF(npinch > 0) THEN
970 CALL zeror(pinch_data%APINCH(1,nodft),numnthread)
971 DO i=nodft,nodlt
972 pinch_data%STIFPINCH(i)=em20
973 ENDDO
974 ENDIF
975 ENDIF
976
977C
978 IF(iparit==0) THEN
979 IF(iroddl==0) THEN
980 DO i = nodft, nodlt
981 stifn(i) = stifn(i)*weight(i)
982 ENDDO
983 ELSE
984 DO i = nodft, nodlt
985 stifn(i) = stifn(i)*weight(i)
986 stifr(i) = stifr(i)*weight(i)
987 ENDDO
988 ENDIF
989 ENDIF
990C-----------------------------------------------------
991C INIT IMPLICIT
992C----------------------------------------------------------
993C --default values----
994 IF (itask==0) CALL imp_init(v,vr,iparg,ipm,igeo,elbuf_tab)
995C----------------------------------------------------------
996C INIT ADAPTIVE MESHING //
997C----------------------------------------------------------
998 IF(nadmesh/=0)THEN
999 iflgadm=0
1000 CALL admgvid(
1001 1 iparg ,elbuf_tab ,pon%FSKY ,pon%FSKY ,fthesky,
1002 2 pon%IADC,pon%IAD_TG,iflgadm,igrouc,ngrouc,
1003 3 condnsky ,glob_therm%NODADT_THERM)
1004 END IF
1005C
1006C----------------------------------------------------------
1007 IF( itask == 0) CALL kinini()
1008C----------------------------------------------------------
1009C INIT SELECTIVE MASS SCALING
1010C----------------------------------------------------------
1011 IF(idtmins == 1 .AND. idtmins_old == 1)THEN
1012 IF(dtfacs /= dtfacs_old .OR. dtmins /= dtmins_old)THEN
1013C Forget about previous mass scaling (reversibility)
1014 admsms(nodft:nodlt)=zero
1015 res_sms(1:3,nodft:nodlt)=zero
1016 ELSEIF(idtgrs_old/=0)THEN
1017 IF( idtgrs < 0.AND.
1018 . -idtgrs /= igrpart(idtgrs_old)%ID) THEN
1019C
1020C Forget about previous mass scaling (reversibility)
1021 admsms(nodft:nodlt)=zero
1022 res_sms(1:3,nodft:nodlt)=zero
1023 ELSE
1024C ..as if single run
1025 END IF
1026 ELSEIF(idtgrs_old==0.AND.idtgrs/=0)THEN
1027C
1028C Forget about previous mass scaling (reversibility)
1029 admsms(nodft:nodlt)=zero
1030 res_sms(1:3,nodft:nodlt)=zero
1031 ELSE
1032C ..as if single run
1033 END IF
1034C
1035 ELSEIF(idtmins == 2 .AND. idtmins_old == 2)THEN
1036 IF(dtfacs /= dtfacs_old .OR. dtmins /= dtmins_old)THEN
1037C ..keep non diagonal mass from previous run
1038 ELSEIF(idtgrs_old/=0)THEN
1039 IF( idtgrs < 0.AND.
1040 . -idtgrs/= igrpart(idtgrs_old)%ID) THEN
1041C
1042C Forget about previous mass scaling (reversibility)
1043 IF(itask==0)THEN
1044 dmelc(1:numelc )=zero
1045 dmeltg(1:numeltg)=zero
1046 dmels(1:numels )=zero
1047 dmeltr(1:numelt )=zero
1048 dmelp(1:numelp )=zero
1049 dmelrt(1:numelr )=zero
1050 dmint2(1:4,1:i2nsn25)=zero
1051 END IF
1052 res_sms(1:3,nodft:nodlt)=zero
1053 ELSE
1054C ..as if single run
1055 END IF
1056 ELSEIF(idtgrs_old==0.AND.idtgrs/=0)THEN
1057C
1058C Forget about previous mass scaling (reversibility)
1059 IF(itask==0)THEN
1060 dmelc(1:numelc )=zero
1061 dmeltg(1:numeltg)=zero
1062 dmels(1:numels )=zero
1063 dmeltr(1:numelt )=zero
1064 dmelp(1:numelp )=zero
1065 dmelrt(1:numelr )=zero
1066 dmint2(1:4,1:i2nsn25)=zero
1067 END IF
1068 res_sms(1:3,nodft:nodlt)=zero
1069 ELSE
1070C ..as if single run
1071 END IF
1072C
1073 ELSEIF(idtmins == 1 .AND. idtmins_old /= idtmins)THEN
1074C
1075 admsms(nodft:nodlt)=zero
1076 res_sms(1:3,nodft:nodlt)=zero
1077C
1078 ELSEIF(idtmins == 2 .AND. idtmins_old /= idtmins)THEN
1079C
1080 IF(itask==0)THEN
1081 dmelc(1:numelc )=zero
1082 dmeltg(1:numeltg)=zero
1083 dmels(1:numels )=zero
1084 dmeltr(1:numelt )=zero
1085 dmelp(1:numelp )=zero
1086 dmelrt(1:numelr )=zero
1087 dmint2(1:4,1:i2nsn25)=zero
1088 END IF
1089 res_sms(1:3,nodft:nodlt)=zero
1090C
1091 ELSEIF(idtmins_int /= 0 .AND. idtmins_int_old /= idtmins_int)THEN
1092C
1093 res_sms(1:3,nodft:nodlt)=zero
1094C
1095 END IF
1096C
1097 IF(itask == 0) THEN
1098 nisky_sms=0
1099C enforce sorting contacts
1100 kforsms=0
1101 IF((idtmins==2.AND.idtmins_old/=idtmins).OR.
1102 . (idtmins_int/=0.AND.idtmins_int_old/=idtmins_int))THEN
1103 kforsms=1
1104 END IF
1105 ENDIF
1106C
1107 IF(anim_ply > 0.AND. itask == 0) THEN
1108 CALL spmd_anim_ply_init ()
1109 ENDIF
1110C
1111 IF (icrack3d > 0 .AND. itask == 0)THEN
1112 CALL anim_xfe_init(ixc,ixtg,inod_crkxfem,iel_crkxfem,
1113 . iadc_crkxfem,iadc_crkxfem(1+4*ecrkxfec))
1114 ENDIF
1115C-----------------------
1116C ITET=2 OF S10
1117C-----------------------
1118 IF(ns10e > 0) THEN
1119 IF (itask == 0) THEN
1120 IF(nspmd>1) THEN
1121 CALL s10cnds_dim(icnds10,itagnd,fr_elem,iad_elem,nbs )
1122 ALLOCATE (iad_cnds(nspmd+1),fr_cnds(nbs))
1123 CALL s10cnds_ini(icnds10,itagnd,fr_elem,iad_elem,iad_cnds,fr_cnds )
1124 ELSE
1125 ALLOCATE (iad_cnds(0),fr_cnds(0))
1126 END IF
1127
1128 CALL cndmasi2_dim(ipari,intbuf_tab,icnds10,itagnd,weight,nkend,
1129 1 iad_cnds,fr_cnds,nbs,nspmd)
1130 IF(nkend>0) THEN
1131 ALLOCATE (imap2nd(nkend),masi2nd0(nkend))
1132 CALL cndmasi2_ini(ipari,intbuf_tab,icnds10,itagnd,
1133 . nkend,imap2nd,masi2nd0,ms0,weight, itab )
1134 IF(mcheck>0) nkend = -nkend
1135 END IF
1136 CALL s10cndi2_ini(ipari,intbuf_tab,icnds10,itagnd,weight,
1137 . fr_cnds,iad_cnds,itab )
1139 1 addcncnd,procncnd,vnd ,v ,itab ,
1141 END IF
1142 CALL my_barrier()
1143 ENDIF
1144C-----------------------
1145C TMAX OF H3D
1146C-----------------------
1147 IF (itask == 0)
1148 . CALL tmax_ipart(iparg ,ipart ,ipart(i15a),ipart(i15c),
1149 . ipart(i15i),h3d_data)
1150 CALL ini_tmax(elbuf_tab ,iparg ,geo ,pm ,
1151 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
1152 . ixc ,ixtg ,ixt ,ixp ,ixr ,
1153 . x ,d ,v ,iad_elem ,fr_elem ,
1154 . weight ,ipm ,igeo ,stack ,itask )
1155!$OMP SINGLE
1156 IF (failwave%WAVE_MOD > 0) THEN
1157 CALL spmd_failwave_boundaries(failwave,iad_elem,fr_elem)
1158 ENDIF
1159 ! Non-local regularization is activated
1160 IF (nloc_dmg%IMOD > 0) THEN
1161 CALL spmd_sub_boundaries(nloc_dmg,iad_elem,fr_elem)
1162 ENDIF
1163C-----------------------
1164C DT_DC OF TSH
1165C-----------------------
1166 ntsheg =0
1167 ntshegg =0
1168 IF (idttsh>0) CALL dim_tshedg(elbuf_tab ,ntsheg, ixs ,iparg )
1169 IF(nspmd>1) THEN
1170 ntshegg = ntsheg
1171 CALL spmd_max_i(ntshegg)
1172 END IF
1173 IF (ntsheg > 0) THEN
1174 ALLOCATE (ienunl(2*ntsheg),alpha_dc(numnod))
1175 ienunl=0
1176 alpha_dc=one
1177 CALL ind_tshedg(elbuf_tab ,ienunl, ixs ,iparg )
1178 IF(nspmd>1) THEN
1179 nbs = iad_elem(1,nspmd+1)-iad_elem(1,1)
1180 ALLOCATE (isend(nbs),irecv(nbs))
1181 isend=0
1182 CALL tshcdcom_dim(ienunl,fr_elem,iad_elem,nbs,nbr ,
1183 . isend ,irecv )
1184 ALLOCATE (iad_stsh(nspmd+1),fr_stsh(nbs))
1185 CALL tshcdcom_ini(isend,iad_elem,fr_elem,iad_stsh,fr_stsh)
1186 ALLOCATE (iad_rtsh(nspmd+1),fr_rtsh(nbr))
1187 CALL tshcdcom_ini(irecv,iad_elem,fr_elem,iad_rtsh,fr_rtsh)
1188 DEALLOCATE(isend,irecv)
1189 END IF
1190 END IF
1191C-----------------------
1192C offset for contact
1193C-----------------------
1194 CALL inter_sh_offset_ini(
1195 . ngroup, nparg, iparg, npropg,
1196 . numgeo, geo, numelc, nixc,
1197 . ixc, numeltg, nixtg, ixtg,
1198 . numnod, nspmd, iad_elem, fr_elem,
1199 . sfr_elem, thke, elbuf_tab, sh_offset_tab,
1200 . iparit )
1201! inivel w/ Tstart
1202 niniveltg = loads%NINIVELT
1203 IF (nspmd>1) CALL spmd_max_i(niniveltg)
1204 loads%NINIVELT_G = niniveltg
1205 IF (tt == zero .AND. loads%NINIVELT > 0) THEN
1206 CALL inivel_init(
1207 . ngrnod, ngrbric, ngrquad, ngrsh3n,
1208 . igrnod, igrbric, igrquad, igrsh3n,
1209 . numskw, liskn, iskwn, numfram,
1210 . iframe, loads%NINIVELT,loads%INIVELT,sensors)
1211 END IF
1212
1213 DO n = 1, ninter
1214 CALL int_flushtime(intbuf_tab(n)%METRIC)
1215 ENDDO
1216!$OMP END SINGLE
1217C-------------------------------------------
1218 RETURN
1219 END
1220C
1221C-----------------------------------------------
1222!||====================================================================
1223!|| grpsplit ../engine/source/engine/resol_init.F
1224!||--- called by ------------------------------------------------------
1225!|| resol_init ../engine/source/engine/resol_init.F
1226!||--- calls -----------------------------------------------------
1227!|| sort_mid_pid ../engine/source/system/sort_mid_pid.F
1228!||--- uses -----------------------------------------------------
1229!|| element_mod ../common_source/modules/elements/element_mod.F90
1230!||====================================================================
1231 SUBROUTINE grpsplit(
1232 1 IPARG, IGROUC, NGROUC, IGROUNC, NGROUNC,
1233 2 IXC,IXS,IXTG,IPM,IGEO,PM,GEO,TABMP_L,TAB_MAT)
1234 use element_mod , only : nixc,nixtg,nixs
1235C----6------------------------------------------------------------------
1236C I m p l i c i t T y p e s
1237C-----------------------------------------------
1238#include "implicit_f.inc"
1239C-----------------------------------------------
1240C C o m m o n B l o c k s
1241C-----------------------------------------------
1242#include "com01_c.inc"
1243#include "param_c.inc"
1244#include "com04_c.inc"
1245C-----------------------------------------------------------------
1246C D u m m y A r g u m e n t s
1247C-----------------------------------------------
1248 INTEGER IPARG(NPARG,*),IGROUC(*),IGROUNC(*),
1249 . ngrouc, ngrounc,tabmp_l
1250
1251 INTEGER IXC(NIXC,*),IXS(NIXS,*),IXTG(NIXTG,*),
1252 . ipm(npropmi,*),igeo(npropgi,*)
1253 my_real pm(npropm,*),geo(npropg,*)
1254 my_real tab_mat(ngroup)
1255! tab_mat_prop
1256! 1 : shell
1257! 2 : tri
1258! 3 --> 9 : solid
1259! 3 : ISOL=8
1260! 4 : ISOL=10
1261! 5 : ISOL=16
1262! 6 : ISOL=20
1263! 7 : ISOL=6
1264! 8 : ISOL=4
1265! 9 : ISOL=others
1266C-----------------------------------------------
1267C L o c a l V a r i a b l e s
1268C-----------------------------------------------
1269 INTEGER NG, ITY, N_SHELL, N_SOL(7),N_TRI,MARQUEUR,MARQUEUR_2,MARQUEUR_3
1270 INTEGER I,J,II,JJ,K,INDI
1271 INTEGER COMPTEUR_MAT_PROP_SHELL,COMPTEUR_MAT_PROP_SOL,COMPTEUR_MAT_PROP_TRI,
1272 . MID,PID,MTN,NEL,NFT,FIRST,LAST,SHIFT,ISOL,GR_ID,GR_ID2
1273 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_SHELL_LOC,TAB_TRI_LOC
1274 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: TAB_SOL_LOC
1275 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB_LOC
1276 INTEGER, DIMENSION(:), ALLOCATABLE :: IGROUC_SHELL,IGROUC_TRI,MID_SHELL,MID_TRI
1277 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_GROUP_MID_SHELL,POIN_GROUP_MID_TRI
1278 INTEGER, DIMENSION(:), ALLOCATABLE :: POIN_GROUP_PID_SHELL,POIN_GROUP_PID_TRI
1279 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_GROUP_MID_SOL
1280 INTEGER, DIMENSION(:,:), ALLOCATABLE :: POIN_GROUP_PID_SOL
1281 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IGROUC_SOL,MID_SOL
1282 my_real poids_j,poids_j1
1283C-----------------------------------------------
1284C
1285 n_shell = 0
1286 n_sol(1:7) = 0
1287 n_tri = 0
1288 ngrouc = 0
1289 ngrounc = 0
1290
1291 ALLOCATE(tab_shell_loc(ngroup,5))
1292 ALLOCATE(tab_tri_loc(ngroup,5))
1293 ALLOCATE(tab_sol_loc(ngroup,5,7))
1294 ALLOCATE( igrouc_shell(ngroup),igrouc_tri(ngroup) )
1295 ALLOCATE( igrouc_sol(ngroup,7) )
1296
1297 ALLOCATE( poin_group_mid_shell(ngroup),poin_group_mid_tri(ngroup) )
1298 ALLOCATE( poin_group_pid_shell(ngroup),poin_group_pid_tri(ngroup) )
1299 ALLOCATE( poin_group_mid_sol(ngroup,7),poin_group_pid_sol(ngroup,7) )
1300
1301 ALLOCATE(mid_shell(nummat))
1302 ALLOCATE(mid_tri(nummat))
1303 ALLOCATE(mid_sol(nummat,7))
1304
1305 compteur_mat_prop_shell = 0
1306 mid_shell(1:nummat) = 0
1307 mid_tri(1:nummat) = 0
1308 mid_sol(1:nummat,1:7) = 0
1309
1310 DO ng = 1, ngroup
1311 ity =iparg(5,ng)
1312 IF(ity==3.OR.ity==7)THEN
1313 ngrouc = ngrouc + 1
1314 igrouc(ngrouc)=ng
1315 IF(ity==3) THEN
1316 n_shell = n_shell + 1
1317 nft = iparg(3,ng)+1
1318 mid = ixc(1,nft)
1319 pid = ixc(6,nft)
1320 mtn = iparg(1,ng)
1321 mid_shell(mid) = mid_shell(mid) + 1
1322 poin_group_mid_shell(n_shell) = mid
1323 poin_group_pid_shell(n_shell) = pid
1324 igrouc_shell(n_shell) = ng
1325
1326 tab_shell_loc(n_shell,1) = iparg(2,ng)
1327 tab_shell_loc(n_shell,2) = ng
1328 tab_shell_loc(n_shell,3) = mid
1329 tab_shell_loc(n_shell,4) = pid
1330 tab_shell_loc(n_shell,5) = ngrouc
1331
1332 ELSEIF(ity==7) THEN
1333 n_tri = n_tri + 1
1334 nft = iparg(3,ng)+1
1335 mid = ixtg(1,nft)
1336 pid = ixtg(5,nft)
1337 mtn = iparg(1,ng)
1338 mid_tri(mid) = mid_tri(mid) + 1
1339 poin_group_mid_tri(n_tri) = mid
1340 poin_group_pid_tri(n_tri) = pid
1341 igrouc_tri(n_tri) = ng
1342
1343 tab_tri_loc(n_tri,1) = iparg(2,ng)
1344 tab_tri_loc(n_tri,2) = ng
1345 tab_tri_loc(n_tri,3) = mid
1346 tab_tri_loc(n_tri,4) = pid
1347 tab_tri_loc(n_tri,5) = ngrouc
1348
1349 ENDIF
1350 ELSE
1351 ngrounc = ngrounc + 1
1352 igrounc(ngrounc)=ng
1353 IF(ity==1) THEN
1354 nft = iparg(3,ng)+1
1355 mid = ixs(1,nft)
1356 pid = ixs(10,nft)
1357 mtn = iparg(1,ng)
1358 isol = iparg(28,ng)
1359 IF(isol==4) THEN
1360 indi = 6
1361 ELSEIF(isol==6) THEN
1362 indi = 5
1363 ELSEIF(isol==8) THEN
1364 indi = 1
1365 ELSEIF(isol==10) THEN
1366 indi = 2
1367 ELSEIF(isol==16) THEN
1368 indi = 3
1369 ELSEIF(isol==20) THEN
1370 indi = 4
1371 ELSE
1372 indi = 7
1373 ENDIF
1374
1375 n_sol(indi) = n_sol(indi) + 1
1376 igrouc_sol(n_sol(indi),indi) = ng
1377
1378 tab_sol_loc(n_sol(indi),1,indi) = iparg(2,ng)
1379 tab_sol_loc(n_sol(indi),2,indi) = ng
1380 tab_sol_loc(n_sol(indi),3,indi) = mid
1381 tab_sol_loc(n_sol(indi),4,indi) = pid
1382 tab_sol_loc(n_sol(indi),5,indi) = ngrounc
1383
1384 mid_sol(mid,indi) = mid_sol(mid,indi) + 1
1385 poin_group_mid_sol(n_sol(indi),indi) = mid
1386 poin_group_pid_sol(n_sol(indi),indi) = pid
1387
1388 ENDIF
1389 END IF
1390 END DO
1391! -------------------------
1392 IF(n_shell>0) THEN
1393
1394 ALLOCATE( tab_loc(n_shell,3) )
1395 tab_loc(1:n_shell,1:3) = -1
1396
1397
1398 CALL sort_mid_pid(n_shell,igrouc_shell,
1399 1 poin_group_mid_shell,poin_group_pid_shell,
1400 2 mid_shell,tab_loc,tab_shell_loc,tab_mat)
1401
1402
1403 DO i = 1,n_shell
1404 j = tab_loc(i,1)
1405 ii = tab_shell_loc(i,5)
1406 jj = tab_shell_loc(j,2)
1407 igrouc(ii) = jj
1408 ENDDO
1409
1410 DEALLOCATE( tab_loc )
1411 ENDIF ! N_SHELL>0
1412! -------------------------
1413 IF(n_tri>0) THEN
1414
1415 ALLOCATE( tab_loc(n_tri,3) )
1416 tab_loc(1:n_tri,1:3) = -1
1417
1418
1419 CALL sort_mid_pid(n_tri,igrouc_tri,
1420 1 poin_group_mid_tri,poin_group_pid_tri,
1421 2 mid_tri,tab_loc,tab_tri_loc,tab_mat)
1422
1423
1424 DO i = 1,n_tri
1425 j = tab_loc(i,1)
1426 ii = tab_tri_loc(i,5)
1427 jj = tab_tri_loc(j,2)
1428 igrouc(ii) = jj
1429 ENDDO
1430
1431 DEALLOCATE( tab_loc )
1432 ENDIF ! N_TRI>0
1433! -------------------------
1434 DO indi=1,7
1435 IF(n_sol(indi)>0) THEN
1436
1437 ALLOCATE( tab_loc(n_sol(indi),3) )
1438 tab_loc(1:n_sol(indi),1:3) = -1
1439
1440
1441 CALL sort_mid_pid(n_sol(indi),igrouc_sol(1,indi),
1442 1 poin_group_mid_sol(1,indi),poin_group_pid_sol(1,indi),
1443 2 mid_sol(1,indi),tab_loc,tab_sol_loc(1,1,indi),tab_mat)
1444
1445
1446 DO i = 1,n_sol(indi)
1447 j = tab_loc(i,1)
1448 ii = tab_sol_loc(i,5,indi)
1449 jj = tab_sol_loc(j,2,indi)
1450 igrounc(ii) = jj
1451 ENDDO
1452
1453 DEALLOCATE( tab_loc )
1454 ENDIF ! N_SOL>0
1455 ENDDO
1456! -------------------------
1457
1458 DEALLOCATE(mid_shell)
1459 DEALLOCATE(mid_tri)
1460 DEALLOCATE(mid_sol)
1461
1462 DEALLOCATE( poin_group_mid_shell,poin_group_mid_tri )
1463 DEALLOCATE( poin_group_pid_shell,poin_group_pid_tri )
1464 DEALLOCATE( poin_group_mid_sol,poin_group_pid_sol )
1465
1466
1467 DEALLOCATE(tab_shell_loc)
1468 DEALLOCATE(tab_tri_loc)
1469 DEALLOCATE(tab_sol_loc)
1470 DEALLOCATE( igrouc_shell,igrouc_tri )
1471 DEALLOCATE( igrouc_sol )
1472
1473 RETURN
1474 END
1475C
1476C-----------------------------------------------
1477!||====================================================================
1478!|| fillipartl ../engine/source/engine/resol_init.F
1479!||--- called by ------------------------------------------------------
1480!|| resol_init ../engine/source/engine/resol_init.F
1481!||====================================================================
1482 SUBROUTINE fillipartl(
1483 1 IPARTL ,IPARTS,IPARTQ ,IPARTC ,IPARTT,
1484 2 IPARTP ,IPARTR,IPARTUR,IPARTTG,IPARTX,
1485 3 IPARTSP,IPARTIG3D,NPARTL)
1486C----6---------------------------------------------------------------7---------8
1487C I m p l i c i t T y p e s
1488C-----------------------------------------------
1489#include "implicit_f.inc"
1490C-----------------------------------------------
1491C C o m m o n B l o c k s
1492C-----------------------------------------------
1493#include "com04_c.inc"
1494#include "sphcom.inc"
1495C-----------------------------------------------------------------
1496C D u m m y A r g u m e n t s
1497C-----------------------------------------------!$OMP+PRIVATE(
1498 INTEGER IPARTS(*),IPARTQ(*),IPARTC(*),IPARTT(*),IPARTSP(*),
1499 . ipartp(*),ipartr(*),ipartur(*),iparttg(*),ipartx(*),
1500 . ipartl(*),ipartig3d(*),
1501 . npartl
1502C-----------------------------------------------
1503C L o c a l V a r i a b l e s
1504C-----------------------------------------------
1505 INTEGER I
1506C-----------------------------------------------
1507C //
1508C-----------------------------------------------
1509C
1510 DO i = 1, npart
1511 ipartl(i) = 0
1512 END DO
1513C
1514 DO i = 1, numels
1515 ipartl(iparts(i))=1
1516 END DO
1517C
1518 DO i = 1, numelq
1519 ipartl(ipartq(i))=1
1520 END DO
1521C
1522 DO i = 1, numelc
1523 ipartl(ipartc(i))=1
1524 END DO
1525C
1526 DO i = 1, numelt
1527 ipartl(ipartt(i))=1
1528 END DO
1529C
1530 DO i = 1, numelp
1531 ipartl(ipartp(i))=1
1532 END DO
1533C
1534 DO i = 1, numelr
1535 ipartl(ipartr(i))=1
1536 END DO
1537C
1538 DO i = 1, numeltg
1539 ipartl(iparttg(i))=1
1540 END DO
1541C
1542 DO i = 1, numelx
1543 ipartl(ipartx(i))=1
1544 END DO
1545C
1546 DO i = 1, numels
1547 ipartl(iparts(i))=1
1548 END DO
1549C
1550 DO i = 1, numsph
1551 ipartl(ipartsp(i))=1
1552 END DO
1553C
1554 DO i = 1, numelig3d
1555 ipartl(ipartig3d(i))=1
1556 END DO
1557C
1558 npartl = 0
1559 DO i = 1, npart
1560 IF(ipartl(i)>0)THEN
1561 npartl = npartl + 1
1562 ipartl(npartl) = i
1563 END IF
1564 END DO
1565C
1566 RETURN
1567 END
1568C
1569!||====================================================================
1570!|| smp_init ../engine/source/engine/resol_init.F
1571!||--- called by ------------------------------------------------------
1572!|| resol ../engine/source/engine/resol.F
1573!||--- calls -----------------------------------------------------
1574!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
1575!||====================================================================
1576 SUBROUTINE smp_init(
1577 1 ITSK ,NODFTSK ,NODLTSK ,NUMNTSK,NDTSK,
1578 2 IPMTSK,PARTFTSK,PARTLTSK,NWAFTSK,IGMTSK,
1579 3 GREFTSK,GRELTSK)
1580C-----------------------------------------------
1581C I m p l i c i t T y p e s
1582C-----------------------------------------------
1583#include "implicit_f.inc"
1584C-----------------------------------------------
1585C C o m m o n B l o c k s
1586C-----------------------------------------------
1587#include "com01_c.inc"
1588#include "com04_c.inc"
1589#include "param_c.inc"
1590#include "task_c.inc"
1591C-----------------------------------------------
1592C D u m m y A r g u m e n t s
1593C-----------------------------------------------
1594 INTEGER ITSK, NODFTSK, NODLTSK, NUMNTSK, NDTSK,
1595 1 ipmtsk, partftsk, partltsk, nwaftsk, igmtsk,
1596 2 greftsk,greltsk
1597C-----------------------------------------------
1598C L o c a l V a r i a b l e s
1599C-----------------------------------------------
1600 INTEGER LENWA_T, OMP_GET_THREAD_NUM
1601 EXTERNAL omp_get_thread_num
1602C-----------------------------------------------
1603C S o u r c e L i n e s
1604C-----------------------------------------------
1605C
1606C Initialisation // SMP
1607C
1608 itsk = omp_get_thread_num()
1609 nodftsk = 1+itsk*numnod/ nthread
1610 nodltsk = (itsk+1)*numnod/nthread
1611 numntsk = nodltsk - nodftsk + 1
1612 ndtsk = 1 + itsk*numnod
1613 ipmtsk = 1 + itsk*npsav*npart
1614 partftsk = 1+itsk*npsav*npart/ nthread
1615 partltsk = (itsk+1)*npsav*npart/nthread
1616 lenwa_t = lenwa / nthread
1617 nwaftsk = 1+itsk*lenwa_t
1618 igmtsk = 1 + itsk*npsav*ngpe
1619 greftsk = 1+itsk*npsav*ngpe/ nthread
1620 greltsk = (itsk+1)*npsav*ngpe/nthread
1621c NWALTSK = (ITSK+1)*LENWA_T
1622c LOUT = ISPMD==0.AND.ITSK==0
1623C
1624 RETURN
1625 END
1626!||====================================================================
1627!|| init_kyne ../engine/source/engine/resol_init.f
1628!||--- called by ------------------------------------------------------
1629!|| resol_init ../engine/source/engine/resol_init.F
1630!||====================================================================
1631 SUBROUTINE init_kyne(IKINE,NPBY,LPBY,TAGSLV_RBY,NHIER_RBY)
1632C----6---------------------------------------------------------------7---------8
1633C I m p l i c i t T y p e s
1634C-----------------------------------------------
1635#include "implicit_f.inc"
1636#include "comlock.inc"
1637C-----------------------------------------------
1638C C o m m o n B l o c k s
1639C-----------------------------------------------
1640#include "com04_c.inc"
1641#include "lagmult.inc"
1642#include "param_c.inc"
1643C-----------------------------------------------------------------
1644C D u m m y A r g u m e n t s
1645C-----------------------------------------------
1646 INTEGER IKINE(NUMNOD),NPBY(NNPBY,*),LPBY(*),TAGSLV_RBY(*)
1647 INTEGER, INTENT(INOUT) :: NHIER_RBY
1648C-----------------------------------------------
1649C L o c a l V a r i a b l e s
1650C-----------------------------------------------
1651 INTEGER N,I,J,K,NSN
1652
1653 DO j=1,numnod
1654 ikine(j)=0
1655 ENDDO
1656C-------------------------------------
1657C Processing Rigid Bodies
1658C-------------------------------------
1659 k = 0
1660 nhier_rby = 0
1661 DO n=1,nrbykin
1662 nsn = npby(2,n)
1663 nhier_rby = max(nhier_rby,npby(20,n))
1664 DO i=1,nsn
1665 j=lpby(k+i)
1666 ikine(j) = (ikine(j)/2)*2 + 1
1667 ENDDO
1668 k = k + nsn
1669 ENDDO
1670C-------------------------------------------
1671 tagslv_rby(1:numnod)=0
1672 k=0
1673 DO n=1,nrbykin
1674 nsn=npby(2,n)
1675 IF(npby(7,n)>=1)THEN
1676 DO i=1,nsn
1677 tagslv_rby(lpby(i+k))=n
1678 ENDDO
1679 ENDIF
1680 k=k+nsn
1681 ENDDO
1682C-------------------------------------------
1683 DO n=1,nrbylag
1684 nsn = npby(2,n)
1685 DO i=1,nsn
1686 j=lpby(k+i)
1687 ikine(j) = (ikine(j)/2)*2 + 1
1688 ENDDO
1689 k = k + 3*nsn
1690 ENDDO
1691 RETURN
1692 END
subroutine admgvid(iparg, elbuf_tab, fskyv, fsky, fthesky, iadc, iadtg, iflg, igrouc, ngrouc, condnsky, nodadt_therm)
Definition admgvid.F:35
subroutine admini(ixc, ipartc, ixtg, iparttg, ipart, igeo, ipm, iparg, x, ms, in, elbuf_tab, sh4tree, ipadmesh, msc, inc, sh3tree, mstg, intg, ptg, sh4trim, sh3trim, mscnd, incnd, pm, mcp, mcpc, mcptg, tagtrimc, tagtrimtg, itherm_fe)
Definition admini.F:45
subroutine admordr(sh4tree, sh3tree, ixc, ixtg)
Definition admordr.F:36
subroutine anim_xfe_init(ixc, ixtg, inod_crk, iel_crk, iadc_crk, iadtg_crk)
subroutine assadd2(addcne, indsky, fsky, fskym, iad_elem, fr_elem, fr_nbcc, procne, niskyfi, addcni2, procni2, iad_i2m, fr_i2m, fr_nbcci2, indskyi2, iadsdp, iadrcp, isendp, irecvp, fthesky, niskyfie, inod_pxfem, addcne_pxfem, procne_pxfem, isendp_pxfem, irecvp_pxfem, iadsdp_pxfem, iadrcp_pxfem, fr_nbcc1, inod_crkxfem, addcne_crkxfem, procne_crkxfem, isendp_crkxfem, irecvp_crkxfem, iadsdp_crkxfem, iadrcp_crkxfem, condnsky, glob_therm)
Definition assadd2.F:43
subroutine chkinit(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixs10, ixs20, ixs16, ixtg1, geo, addcnel, cnel, adsky, iparg)
Definition chkstfn3.F:265
subroutine cndordr(ipart, ipartc, iparttg, sh4tree, sh3tree)
Definition cndordr.F:32
#define my_real
Definition cppsort.cpp:32
subroutine dim_tshedg(elbuf_str, nedg, ixs, iparg)
Definition dim_tshedg.F:32
subroutine initimeg(ng)
Definition timer.F:1316
subroutine findgroups(iparg, igroups)
Definition findgroup.F:74
subroutine findgroupc(iparg, igrouc, ngrouc, igroupc, igrouptg)
Definition findgroup.F:30
subroutine zero1(r, n)
subroutine imp_init(v, vr, iparg, ipm, igeo, elbuf_tab)
Definition imp_init.F:38
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
subroutine ind_tshedg(elbuf_str, ienunl, ixs, iparg)
Definition ind_tshedg.F:32
subroutine ini_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 ini_outmax.F:44
subroutine init_reac_nod(cptreac, nodreac, nthgrp, ithgrp, ithbuf)
subroutine init_th_group(gr, igr, nelem, ngrth, iparg, ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
type(alemuscl_param_) alemuscl_param
integer, dimension(:), pointer fr_stsh
Definition dtdc_mod.F:42
integer, dimension(:), pointer iad_stsh
Definition dtdc_mod.F:42
integer, dimension(:), pointer iad_rtsh
Definition dtdc_mod.F:43
integer ntshegg
Definition dtdc_mod.F:39
integer, dimension(:), pointer ienunl
Definition dtdc_mod.F:40
integer, dimension(:), pointer fr_rtsh
Definition dtdc_mod.F:43
integer, dimension(:), pointer iad_cndm1
Definition ecdn_mod.F:48
integer, dimension(:), pointer fr_nbcccnd1
Definition ecdn_mod.F:57
integer, dimension(:), pointer iad_cnds
Definition ecdn_mod.F:50
integer, dimension(:), allocatable imap2nd
Definition ecdn_mod.F:64
integer, dimension(:), pointer fr_cndm
Definition ecdn_mod.F:47
integer, dimension(:), pointer fr_cndm1
Definition ecdn_mod.F:48
integer, dimension(:), pointer itagnd
Definition ecdn_mod.F:54
integer, dimension(:), pointer procncnd
Definition ecdn_mod.F:49
integer, dimension(:), pointer icnds10
Definition ecdn_mod.F:42
integer, dimension(:), pointer fr_cnds
Definition ecdn_mod.F:50
integer, dimension(:), pointer addcncnd
Definition ecdn_mod.F:49
integer, dimension(:), pointer iad_cndm
Definition ecdn_mod.F:47
integer nkend
Definition ecdn_mod.F:63
integer, dimension(:), pointer fr_nbcccnd
Definition ecdn_mod.F:57
integer ifcontp2max
Definition outmax_mod.F:69
integer ifcontmax
Definition outmax_mod.F:69
integer ifcont2max
Definition outmax_mod.F:69
integer ifcontp2min
Definition outmax_mod.F:69
integer ifcontpmax
Definition outmax_mod.F:69
integer ifcont2min
Definition outmax_mod.F:69
subroutine r2r_init(iexlnk, itab, igrnod, x, ms, in, dd_r2r, weight, iad_elem, fr_elem, addcnel, cnel, ixc, iparg, icodt, icodr, ibfv, dx, rby, npby, xdp, stifn, stifr, dd_r2r_elem, sdd_r2r_elem, weight_md, ilenxv, numsph_glo_r2r, flg_sphinout_r2r, ipari, nloc_dmg)
Definition r2r_init.F:70
subroutine rbe2_init(irbe2, lrbe2, nmrbe2, fr_rbe2, fr_rbe2m, nfr)
Definition rbe2f.F:623
subroutine init_kyne(ikine, npby, lpby, tagslv_rby, nhier_rby)
subroutine fillipartl(ipartl, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, ipartx, ipartsp, ipartig3d, npartl)
subroutine grpsplit(iparg, igrouc, ngrouc, igrounc, ngrounc, ixc, ixs, ixtg, ipm, igeo, pm, geo, tabmp_l, tab_mat)
subroutine smp_init(itsk, nodftsk, nodltsk, numntsk, ndtsk, ipmtsk, partftsk, partltsk, nwaftsk, igmtsk, greftsk, greltsk)
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, 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, nhier_rby)
Definition resol_init.F:171
subroutine s10cnds_ini(icnds10, itags, fr_elem, iad_elem, iad_cdns, fr_cdns)
Definition s10cndf.F:861
subroutine s10cnd_ini(icnds10, itagnd, iad_cndm, fr_cndm, fr_nbcccnd, addcncnd, procncnd, vnd, v, itab, iad_cndm1, fr_cndm1, fr_nbcccnd1)
Definition s10cndf.F:399
subroutine s10cndi2_ini(ipari, intbuf_tab, icnds10, itagnd, weight, fr_cnds, iad_cnds, itab)
Definition s10cndf.F:513
subroutine cndmasi2_dim(ipari, intbuf_tab, icnds10, itagnd, weight, nkend, iad_cnds, fr_cnds, s_fr, nspmd)
Definition s10cndf.F:950
subroutine s10cnds_dim(icnds10, itags, fr_elem, iad_elem, nbdds)
Definition s10cndf.F:819
subroutine cndmasi2_ini(ipari, intbuf_tab, icnds10, itagnd, nkend, imap2nd, masi2nd0, ms, weight, itab)
Definition s10cndf.F:1049
subroutine section_init(nstrf, secbuf, nom_sect, isectr, nsect, ioldsect)
subroutine sort_mid_pid(n_shell, igrouc_shell, poin_group_mid_shell, poin_group_pid_shell, mid_shell, tab_loc, tab_shell_loc, tab_mat)
subroutine spmd_failwave_boundaries(failwave, iad_elem, fr_elem)
subroutine spmd_sub_boundaries(nloc_dmg, iad_elem, fr_elem)
subroutine mpp_init(ipari, isendto, ircvfrom, intlist, nbintc, isizxv, ilenxv, iad_elem, i2size, itask, islen7, irlen7, islen11, irlen11, igrbric, nme17, islen17, irlen17, irlen7t, islen7t, lindidel, lbufidel, irlen20, islen20, irlen20t, islen20t, nbint20, irlen20e, islen20e, fr_rby, fr_rby6, npby, irbkin_l, nrbykin_l, kindrby, nsensor, sensor_tab, lbufidel24, intbuf_tab, sort_comm, need_comm_int25_solid_erosion, comm_int25_solid_erosion)
subroutine kinini(ikine)
Definition kinini.F:29
subroutine spmd_anim_ply_init(igeo, geo, iparg, ixc, ixtg, ipartc, ipartq, iparttg, stack)
subroutine my_barrier
Definition machine.F:31
subroutine tmax_ipart(iparg, ipart, iparts, ipartc, ipartg, h3d_data)
Definition tmax_ipart.F:34
subroutine tshcdcom_dim(ienunl, fr_elem, iad_elem, nbdds, nbddr, isend, irecv)
subroutine tshcdcom_ini(isend, iad_elem, fr_elem, iad_stsh, fr_stsh)
subroutine zeror(a, n)
Definition zero.F:39