OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
genh3d.F File Reference
#include "implicit_f.inc"
#include "build_info.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "com_xfem1.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "scr23_c.inc"
#include "chara_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"
#include "filescount_c.inc"
#include "tabsiz_c.inc"
#include "intstamp_c.inc"
#include "macro.inc"
#include "sysunit.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine genh3d (timers, x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connect, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, sh4tree, sh3tree, h3d_data, multi_fvm, subset, pskids, tag_skins6, tf, npf, fcont_max, mds_matid, fncontp2, ftcontp2, ibcl, iloadp, lloadp, fac, sensors, tagncont, loadp_hyd_inter, xframe, forc, ar, csefric, csefricg, csefric_stamp, csefricg_stamp, table, iframe, loads, drape_sh4n, drape_sh3n, drapeg, x_c, glob_therm, pblast)

Function/Subroutine Documentation

◆ genh3d()

subroutine genh3d ( type(timer_), intent(inout) timers,
x,
d,
v,
a,
bufel,
integer, dimension(nixs,numels) ixs,
integer, dimension(nixq,numelq) ixq,
integer, dimension(nixc,numelc) ixc,
integer, dimension(nixt,numelt) ixt,
integer, dimension(nixp,numelp) ixp,
integer, dimension(nixr,numelr) ixr,
integer, dimension(nixtg,numeltg) ixtg,
integer swaft,
integer smas,
integer sxnorm,
integer siad,
integer, dimension(nparg,ngroup) iparg,
pm,
geo,
ms,
integer sinvert,
cont,
integer smater,
integer, dimension(*) icut,
skew,
xcut,
fint,
integer, dimension(numnod) itab,
integer sel2fa,
fext,
fopt,
anin,
integer, dimension(*) lpby,
integer, dimension(nnpby,*) npby,
integer, dimension(*) nstrf,
rwbuf,
integer, dimension(*) nprw,
tani,
type (elbuf_struct_), dimension(ngroup) elbuf_tab,
type (matparam_struct_), dimension(nummat), intent(in) mat_param,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(*) weight,
eani,
integer, dimension(lipart1,*) ipart,
type (cluster_), dimension(ncluster) cluster,
integer, dimension(*) iparts,
integer, dimension(*) ipartq,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
integer, dimension(*) ipartp,
integer, dimension(*) ipartr,
integer, dimension(*) ipartur,
integer, dimension(*) iparttg,
rby,
integer swa4,
tors,
integer, dimension(*) nom_opt,
bufsf,
integer, dimension(*) idata,
rdata,
integer siadg,
bufmat,
bufgeo,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
integer, dimension(*) ipartx,
integer suix,
integer sxusr,
integer snfacptx,
integer sixedge,
integer sixfacet,
integer sixsolid,
integer snumx1,
integer snumx2,
integer snumx3,
integer soffx1,
integer soffx2,
integer soffx3,
integer smass1,
integer smass2,
integer smass3,
integer sfunc1,
integer sfunc2,
integer sfunc3,
integer, dimension(nisp,*) kxsp,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(*) nod2sp,
integer, dimension(*) ipartsp,
spbuf,
integer, dimension(6,*) ixs10,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
vr,
integer, dimension(smonvol) monvol,
volmon,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(npropgi,numgeo) igeo,
integer, dimension(*) nodglob,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(nspmd+1,*) fr_sec,
integer, dimension(3,*) fr_rby2,
integer, dimension(4,*) iad_rby2,
integer, dimension(*) fr_wall,
integer, dimension(*) iflow,
rflow,
fncont,
ftcont,
temp,
thke,
err_thk_sh4,
err_thk_sh3,
diag_sms,
integer, dimension(npari,*) ipari,
fncont2,
dr,
type(t_ale_connectivity), intent(in) ale_connect,
integer, dimension(nrbe2l,*) irbe2,
integer, dimension(nrbe3l,*) irbe3,
integer, dimension(*) lrbe2,
integer, dimension(*) lrbe3,
integer, dimension(3,*) fr_rbe2,
integer, dimension(3,*) fr_rbe3m,
integer, dimension(4,*) iad_rbe2,
dxancg,
integer, dimension(*) nod_pxfem,
integer, dimension(*) iel_pxfem,
zi_ply,
vgaz,
fcontg,
fncontg,
ftcontg,
fanreac,
integer, dimension(*) inod_crk,
integer, dimension(*) iel_crk,
integer, dimension(2,*) elcutc,
integer, dimension(*) iadc_crk,
pdama2,
res_sms,
integer, dimension(*) weight_md,
integer, dimension(*) nodglobxfe,
integer, dimension(2,*) nodedge,
fcluster,
mcluster,
type (elbuf_struct_), dimension(ngroup,nxel) xfem_tab,
w,
integer nv46,
integer, dimension(*) ipartig3d,
integer, dimension(*) kxig3d,
integer, dimension(*) ixig3d,
integer sig3dsolid,
knot,
wige,
integer, dimension(*) nercvois,
integer, dimension(*) nesdvois,
integer, dimension(*) lercvois,
integer, dimension(*) lesdvois,
type (xfem_edge_), dimension(*) crkedge,
integer, dimension(*) indx_crk,
integer, dimension(4,*) xedge4n,
integer, dimension(3,*) xedge3n,
type (stack_ply) stack,
integer, dimension(*) sph2sol,
stifn,
stifr,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) sh4tree,
integer, dimension(*) sh3tree,
type (h3d_database) h3d_data,
type (multi_fvm_struct), intent(in) multi_fvm,
type (subset_), dimension(nsubs), target subset,
pskids,
integer, dimension(*) tag_skins6,
tf,
integer, dimension(*) npf,
fcont_max,
integer, dimension(*) mds_matid,
fncontp2,
ftcontp2,
integer, dimension(nibcld,*) ibcl,
integer, dimension(sizloadp,*) iloadp,
integer, dimension(slloadp) lloadp,
fac,
type (sensors_), intent(in) sensors,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(nloadp_hyd) loadp_hyd_inter,
xframe,
forc,
dimension(sar), intent(in) ar,
dimension(ninefric,s_efricint), intent(in) csefric,
dimension(s_efric), intent(in) csefricg,
dimension(ninefric_stamp,s_efricintg), intent(in) csefric_stamp,
dimension(s_efricg), intent(in) csefricg_stamp,
type (ttable), dimension(ntable), intent(in) table,
integer, dimension(liskn,numfram+1), intent(in) iframe,
type (loads_), intent(in) loads,
type (drape_), dimension(numelc_drape), intent(in) drape_sh4n,
type (drape_), dimension(numeltg_drape), intent(in) drape_sh3n,
type (drapeg_), intent(in) drapeg,
intent(in) x_c,
type (glob_therm_), intent(in) glob_therm,
type (pblast_), intent(in) pblast )

Definition at line 171 of file genh3d.F.

212C-----------------------------------------------
213C M o d u l e s
214C-----------------------------------------------
215 USE timer_mod
216 USE fvbag_mod , only:fvbag_data, fvdata, nfvbag, airbags_total_fvm_in_h3d, fvspmd
217 USE h3d_oned_scalar_mod, ONLY: h3d_oned_scalar
218 USE names_and_titles_mod, ONLY: ncharline100
219 USE plyxfem_mod
220 USE message_mod
221 USE elbufdef_mod
222 USE crackxfem_mod
223 USE cluster_mod
224 USE stack_mod
225 USE h3d_mod
226 USE aleanim_mod !, ONLY : FANI_CELL
227 USE multi_fvm_mod
228 USE groupdef_mod
229 USE inoutfile_mod
230 USE ale_connectivity_mod
231 USE sensor_mod
232 USE outmax_mod
233 USE h3d_inc_mod
234 USE outputs_mod
235 USE table_mod
236 USE loads_mod
237 USE matparam_def_mod
238 USE my_alloc_mod
239 USE outmax_mod
240 USE drape_mod
241 use glob_therm_mod
242 USE pblast_mod
243 USE h3d_gather_id_val_mod
244 USE spmd_mod
245C-----------------------------------------------
246C I m p l i c i t T y p e s
247C-----------------------------------------------
248#include "implicit_f.inc"
249#ifdef MPI
250#endif
251C-----------------------------------------------
252C C o m m o n B l o c k s
253C-----------------------------------------------
254#include "build_info.inc"
255#include "com01_c.inc"
256#include "com04_c.inc"
257#include "com08_c.inc"
258#include "com_xfem1.inc"
259#include "sphcom.inc"
260#include "param_c.inc"
261#include "units_c.inc"
262#include "scr14_c.inc"
263#include "scr16_c.inc"
264#include "scr17_c.inc"
265#include "scr23_c.inc"
266#include "chara_c.inc"
267#include "task_c.inc"
268#include "spmd_c.inc"
269#include "filescount_c.inc"
270#include "tabsiz_c.inc"
271#include "intstamp_c.inc"
272#include "macro.inc"
273#include "sysunit.inc"
274C-----------------------------------------------
275C E x t e r n a l F u n c t i o n s
276C-----------------------------------------------
277 INTEGER SYSFUS2
278C-----------------------------------------------
279C D u m m y A r g u m e n t s
280C-----------------------------------------------
281 TYPE(TIMER_), INTENT(INOUT) :: TIMERS ! Timers for /MON
282 INTEGER SWAFT,SMAS,SXNORM,SIAD,SINVERT,SMATER,SEL2FA,SWA4,
283 . SIADG,NERCVOIS(*),NESDVOIS(*),LERCVOIS(*),
284 . LESDVOIS(*),SPH2SOL(*),SH4TREE(*),SH3TREE(*),TAG_SKINS6(*)
285 integer
286 . suix, sxusr ,sfacptx,sixedge,sixfacet,sixsolid,snumx1,
287 . snumx2,snumx3,soffx1,soffx2,soffx3,smass1,smass2,
288 . smass3,sfunc1,sfunc2,sfunc3,sfin,snfacptx,npf(*)
289
290 INTEGER IGEO(NPROPGI,NUMGEO),IPM(NPROPMI,NUMMAT),INDX_CRK(*),
291 . LRBE2(*),LRBE3(*),FR_RBE2(3,*),FR_RBE3M(3,*),
292 . NOD_PXFEM(*), IEL_PXFEM(*),NODEDGE(2,*),XEDGE4N(4,*),XEDGE3N(3,*),
293 . INOD_CRK(*),IEL_CRK(*),ELCUTC(2,*),IADC_CRK(*)
294 my_real
295 . x(3*numnod), d(3*numnod), v(3*numnod), a(3,numnod), bufel(*),
296 . pm(npropm,nummat), geo(npropg,numgeo),cont(*),
297 . xcut(*) , fint(3,numnod),ms(numnod),rwbuf(nrwlp,*),skew(lskew,*),
298 . rby(nrby,*),fext(3,numnod) ,fopt(6,*),anin(*),tani(6,*),eani(*),
299 . tors(15,*),bufsf(*), rdata(*),
300 . bufmat(*),bufgeo(*),
301 . spbuf(*), vr(3*numnod),volmon(svolmon), rflow(*), fncont(3,*), ftcont(3,*),
302 . temp(*), thke(*), err_thk_sh4(*), err_thk_sh3(*), diag_sms(*),
303 . fncont2(3,*), dr(3,*),dxancg(3,*),zi_ply(*),vgaz(*),
304 . fcontg(*), fncontg(*), ftcontg(*),fanreac(6,*),pdama2(2,*),
305 . res_sms(*),fcluster(3,*),mcluster(3,*),w(sw),
306 . wige(*),knot(*),stifn(*),stifr(*),pskids(*),tf(*),fcont_max(*),
307 . fncontp2(3,*) ,ftcontp2(3,*)
308 INTEGER IPARG(NPARG,NGROUP),NSTRF(*),LPBY(*),
309 . IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),
310 . IXT(NIXT,NUMELT),IXP(NIXP,NUMELP),IXR(NIXR,NUMELR),MONVOL(SMONVOL) ,
311 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
312 . ICUT(*), ITAB(NUMNOD),NPBY(NNPBY,*),NPRW(*),
313 . WEIGHT(*),IPART(LIPART1,*),IPARTS(*),IPARTQ(*),IPARTC(*),
314 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTUR(*),IPARTTG(*),
315 . NOM_OPT(*),
316 . IDATA(*),KXX(NIXX,*), IXX(*), IPARTX(*),
317 . KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*), IPARTSP(*),
318 . NODGLOB(*),IAD_ELEM(2,*),FR_ELEM(*),FR_WALL(*), IFLOW(*),
319 . IPARI(NPARI,*),IRBE2(NRBE2L,*),IRBE3(NRBE3L,*),
320 . WEIGHT_MD(*),NODGLOBXFE(*),IPARTIG3D(*)
321 INTEGER CTEXT(111), IB
322 INTEGER DD_IAD(NSPMD+1,*)
323 INTEGER FR_SEC(NSPMD+1,*),FR_RBY2(3,*),IAD_RBY2(4,*),
324 . NERBE2T(NRBE2G),
325 . NERBE3T(NRBE3G),IAD_RBE2(4,*),NV46,KXIG3D(*),
326 . IXIG3D(*),SIG3DSOLID,MDS_MATID(*)
327 INTEGER LLOADP(SLLOADP)
328 INTEGER ILOADP(SIZLOADP,*),IBCL(NIBCLD,*)
329 INTEGER TAGNCONT(NLOADP_HYD_INTER,NUMNOD),LOADP_HYD_INTER(NLOADP_HYD)
330 INTEGER ,DIMENSION(LISKN,NUMFRAM+1), INTENT(IN) :: IFRAME
331 my_real
332 . fac(lfaccld,*),xframe(nxframe,*),forc(*)
333 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
334 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
335 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
336 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
337 TYPE (STACK_PLY) :: STACK
338 TYPE (H3D_DATABASE) :: H3D_DATA
339 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
340 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
341 TYPE (SUBSET_) , TARGET, DIMENSION(NSUBS) :: SUBSET
342 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
343 TYPE (SENSORS_) , INTENT(IN) :: SENSORS
344 TYPE (LOADS_) , INTENT(IN) :: LOADS
345 TYPE (TTABLE),DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
346 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
347 my_real , INTENT(IN) :: ar(sar)
348 my_real , INTENT(IN) :: csefric(ninefric,s_efricint) ,csefricg(s_efric),
349 . csefric_stamp(ninefric_stamp,s_efricintg) ,csefricg_stamp(s_efricg)
350 my_real ,DIMENSION(3,NUMNOD), INTENT(IN) :: x_c
351 TYPE (DRAPE_) , INTENT(IN) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
352 TYPE (DRAPEG_), INTENT(IN) :: DRAPEG
353 type (glob_therm_), intent(in) :: GLOB_THERM
354 type (pblast_), intent(in) :: PBLAST
355C-----------------------------------------------
356C L o c a l V a r i a b l e s
357C-----------------------------------------------
358 INTEGER iterator
359 my_real, DIMENSION(:), ALLOCATABLE :: waft , mas
360 INTEGER IAD(SIAD),INVERT(SINVERT),EL2FA(SEL2FA),IADG(NSPMD,SIADG),FIRST_NODE_IG3D
361 my_real ,DIMENSION (:), ALLOCATABLE :: cbuf
362 INTEGER ,DIMENSION (:), ALLOCATABLE :: ICBUF
363 SAVE cbuf,icbuf
364 CHARACTER*80 STR,H3DTITLE
365 CHARACTER(LEN=NCHARLINE100):: KEYWORD
366 CHARACTER CH_H3D*4,FILNAM*100
367 INTEGER I, NBF, NBPART, J, IFUNC, FILEN, NSENSOR,NELCUT,N,K,NERBY,ISK(6),LAYER,IPT,GAUSS,ID_PLY,IUVAR
368 INTEGER II,II_L,INC,NDMA2,NB1D,NBONED_T, NBF_L, LEN
369 INTEGER NERBE2,NERBE3,ALL_SUB_CHILDS,IDMDS,IMDSVAR,ID
370 INTEGER I161,I16A,I16B,I16C,I16D,I16E,I16F,I16G,I16H,I16I,I16J,I16K,I16L,I16M,I16N
371 INTEGER NNN
372 INTEGER ISPH3D
373 INTEGER SBUFSPM,SBUFRECVM,SBUFSPO,SPORBY,N_OUTP_DATA,LEN_H3DTITLE,N_H3D_PART_LIST
374 my_real cdg(3),xmin,ymin,zmin,xmax,ymax,zmax, scale
375 INTEGER JJ, SUBG,IR,IS,IT,INTER_INPUT,INTERSKID,NI,ITYSKID,INTERFRIC
376 INTEGER, DIMENSION(:), ALLOCATABLE :: SHELL_ID,SHELL_ID_P,
377 . SHELL_ITY,SHELL_ITY_P,ONED_ID,ONED_ID_P,
378 . ONED_ITY,ONED_ITY_P,SOLID_ID,SOLID_ID_P,
379 . SOLID_ITY,SOLID_ITY_P,IS_WRITEN_SHELL,
380 . IS_WRITEN_SHELL_P,IS_WRITEN_ONED,
381 . IS_WRITEN_ONED_P,IS_WRITEN_NODE,
382 . IS_WRITEN_NODE_P,NODE_ID,NODE_ID_P,
383 . IS_WRITEN_SOLID,IS_WRITEN_SOLID_P,
384 . SPH_ID,SPH_ID_P,IS_WRITEN_SPH,IS_WRITEN_SPH_P,
385 . QUAD_ID,QUAD_ID_P,IS_WRITEN_QUAD,IS_WRITEN_QUAD_P,
386 . SKIN_ID_P,IS_WRITEN_SKIN,IS_WRITEN_SKIN_P,
387 . ISOLNOD,ISOLNOD_P
388 INTEGER, DIMENSION(:), ALLOCATABLE :: IS_WRITEN_NODE_FVM,NODE_ID_FVM
389 INTEGER INFO1,INFO2,IS_CORNER_DATA, COMPID_RBODIES, COMPID_RBE2S, COMPID_RBE3S, MAX_PART_ID
390 INTEGER ERROR_LOAD,NUMNOD_H3DPART
391c a mettre en allocatable
392 INTEGER, DIMENSION(:,:), ALLOCATABLE ::
393 . IXC_P,
394 . IXC_TMP,
395 . IXTG_TMP,
396 . IXTG_P,
397 . IXS_TMP,
398 . IXS_P,
399 . IXR_TMP,
400 . IXR_P,
401 . IXP_TMP,
402 . IXP_P,
403 . KXSP_TMP,
404 . KXSP_P,
405 . IXT_TMP,
406 . IXT_P,
407 . IXS10_TMP,
408 . IXS10_P,
409 . IXS16_TMP,
410 . IXS16_P,
411 . IXS20_TMP,
412 . IXS20_P,
413 . IXQ_TMP,
414 . IXQ_P,
415 . IXSKIN_TMP,
416 . IXSKIN_P
417 INTEGER, DIMENSION(:), ALLOCATABLE ::
418 . IPARTS_P,
419 . IPARTR_P,
420 . IPARTP_P,
421 . IPARTT_P,
422 . IPARTSP_P,
423 . IPARTS10_P,
424 . IPARTS16_P,
425 . IPARTS20_P,
426 . IPARTC_P,
427 . IPARTTG_P,
428 . IPARTQ_P,
429 . IPARTSKIN_P,
430 . NODAL_IPART,
431 . IMAPSKP
432 my_real, DIMENSION(:), ALLOCATABLE :: x_p,d_p
433 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAB_P
434 INTEGER :: IAD_H3DPART,IAD_P,NUMNODG0,IP0 ,NIXSKIN
435 INTEGER :: NUMNOD_P(NSPMD)
436 INTEGER MAX_NOD_ID,MAX_NCORN
437 REAL(KIND=4), dimension(:), ALLOCATABLE :: shell_stack
438 REAL(KIND=4), dimension(:), ALLOCATABLE :: shell_stack_p
439 INTEGER,DIMENSION(NSPMD) :: GATHER_SIZE
440 INTEGER,DIMENSION(NSPMD) :: TMP_OFFSETS
441 INTEGER,DIMENSION(NSPMD+1) :: SH_TRIA_SPMD_OFFSETS
442 my_real, DIMENSION(:), ALLOCATABLE :: nodal_scalar,nodal_scalar_p,
443 . nodal_vector,nodal_vector_p,
444 . nodal_tensor,nodal_tensor_p,
445 . oned_scalar,oned_scalar_p,
446 . oned_vector,oned_vector_p,
447 . oned_tensor,oned_tensor_p,
448 . oned_torsor,oned_torsor_p,
449 . shell_scalar_p,shell_scalar,
450 . shell_vector,shell_vector_p,
451 . shell_tensor,shell_tensor_p,
452 . solid_scalar,solid_scalar_p,
453 . solid_vector,solid_vector_p,
454 . solid_tensor,solid_tensor_p,
455 . solid_tensor_corner,solid_tensor_corner_p,
456 . skin_scalar,skin_scalar_p,
457 . skin_vector,skin_vector_p,
458 . skin_tensor,skin_tensor_p,
459 . sph_scalar,sph_scalar_p,
460 . sph_tensor,sph_tensor_p,
461 . quad_scalar,quad_scalar_p,
462 . quad_vector,quad_vector_p,
463 . quad_tensor,quad_tensor_p,nodal_scalar_fvm,
464 . nodal_vector_fvm
465 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGNOD,TAGNOD_P,
466 . ITAB_P_PART,ITABM1_P
467 my_real xwl(nrwall) ,ywl(nrwall) , zwl(nrwall), v1(nrwall), v2(nrwall), v3(nrwall),
468 . vv1(nrwall), vv2(nrwall), vv3(nrwall), xl(nrwall), xn(nrwall), yn(nrwall),
469 . zn(nrwall)
470 LOGICAL IS_FILE_EXISTS
471 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_CHILD,SUB_IAD,SUB_TITLE
472 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_NCHILD
473 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_LEVEL
474 INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_ID
475 INTEGER (KIND=8) :: H3DTOTALSIZE8
476 INTEGER :: LEN_TMP_NAME,LEN_RADVERS,OBJECT_ID, NPOLH, NPOLHG, NPOLH_ANIM, NPOLH_ANIM_G,
477 * FVM_GLOBALS(3)
478 INTEGER :: AIRBAGS_TOTAL_FVM_IN_H3D_G
479 CHARACTER(len=2148) :: TMP_NAME
480 CHARACTER RADVERS*68
481 TYPE(FVBAG_DATA), DIMENSION(:), ALLOCATABLE :: FVDATA_P
482 my_real, DIMENSION(:), ALLOCATABLE :: fvdata_1d_array,fvdata_1d_array_p
483 INTEGER ITMP,MODE
484 TYPE user_nod_id_
485 !VIRTUAL NODES MANAGEMENT
486 !some option are writing virtual entities in H3D files. it requires to generate nodes which must have identifiers.
487 !
488 ! +-----------------USER NODE IDENTIFIERS----------------------------------------------+
489 ! | INPUT FILE | FVMBAG | ... | RWALL |
490 ! +-------------------+-----------------------------+-----|----------------------------+
491 ! | (real nodes) | (virtual added nodes) | ... | (virtual added nodes) |
492 ! +-------------------+-----------------------------+-----|----------------------------+
493 ! | NUMNOD | %FVMBAG_LEN | ... | %RWALL_LEN | numbering
494 ! | n/a | %FVMBAG_SHIFT+1 | ... | %RWALL_SHIFT+1 | min identifier
495 ! | %INPUT_MAX | %FVMBAG_SHIFT+%FVMBAG_LEN | ... | %RWALL_SHIFT+%RWALL_LEN | max identifier
496 ! +-------------------+-----------------------------+-----+----------------------------+
497 INTEGER INPUT_MAX !input file maximum user identifier (/NODE)
498 INTEGER RWALL_SHIFT !RWALL virtual nodes starts from uID = %RWALL_SHIFT + 1
499 INTEGER RWALL_LEN !RWALL virtual nodes numbering
500 INTEGER FVMBAG_SHIFT !FVMBAG has virtual nodes from uID = %FVMBAG_SHIFT+1
501 INTEGER FVMBAG_LEN !FVMBAG virtual nodes numbering
502 END TYPE
503
504 TYPE(USER_NOD_ID_) :: USER_NOD_ID
505 INTEGER SZ_ANIN
506 INTEGER :: MAX_SHELL_STACKSIZE ! Maximum number of shell scalar to write
507 INTEGER :: SHELL_STACKSIZE ! Number of shell scalar to write
508 INTEGER :: SHELL_STACKSIZE_P0 ! total shell scalar to write after gather
509 integer elem
510C-----------------------------------------------
511C S o u r c e L i n e s
512C-----------------------------------------------
513 max_shell_stacksize = numelc + numeltg
514 CALL startime(timers,macro_timer_genh3d)
515
516 user_nod_id%INPUT_MAX=0
517 user_nod_id%RWALL_SHIFT=0
518 user_nod_id%RWALL_LEN=0
519 user_nod_id%FVMBAG_SHIFT=0
520 user_nod_id%FVMBAG_LEN=0
521
522 ndma2 = numnod*(min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
523 . +min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
524 . +min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
525 nsensor = sensors%NSENSOR
526 ALLOCATE(mas(smas))
527 ALLOCATE(sub_nchild(nsubs))
528 ALLOCATE(sub_level(nsubs))
529 ALLOCATE(sub_id(nsubs))
530
531c
532 i161=1
533 i16a=i161+lnopt1*nrbody0
534 i16b=i16a+lnopt1*naccelm
535 i16c=i16b+lnopt1*nvolu
536 i16d=i16c+lnopt1*(ninter+nintsub)
537 i16e=i16d+lnopt1*nrwall
538 i16f=i16e !obsolete option removed
539 i16g=i16f+lnopt1*njoint
540 i16h=i16g+lnopt1*nsect
541 i16i=i16h+lnopt1*nlink
542 i16j=i16i+lnopt1*(numskw+1+numfram+1)
543 i16k=i16j+lnopt1*nfxbody
544 i16l=i16k+lnopt1*nflow
545 i16m=i16l+lnopt1*nrbe2
546 i16n=i16m+lnopt1*nrbe3
547
548
549
550c
551 error_load = 0
552c
553 h3d_data%IH3D_RUN = h3d_data%IH3D_RUN + 1
554 IF(ispmd == 0) THEN
555 numnodg0 = numnodg
556 ip0 = 1
557 ELSE
558 numnodg0 = 1
559 ip0 = 0
560 ENDIF
561C----- same size of skin than quad
562 nixskin = nixq
563
564 ALLOCATE(x_p(8*numnodg0))
565 ALLOCATE(itab_p(numnodg0))
566
567 CALL my_alloc( ixtg_p ,nixtg,numeltgg*ip0)
568 CALL my_alloc( ixs_p ,nixs,(numelsg-numels10g-numels16g-numels20g)*ip0)
569 CALL my_alloc( ixp_p ,nixp,numelpg*ip0)
570 CALL my_alloc( ixr_p ,nixr,numelrg*ip0)
571 CALL my_alloc( kxsp_p ,nisp,numsphg*ip0)
572 CALL my_alloc( ixt_p ,nixt,numeltrg*ip0) !!
573 CALL my_alloc( ixc_p ,nixc,numelcg*ip0)
574 CALL my_alloc( ixs10_p ,11,numels10g*ip0)
575 CALL my_alloc( ixs16_p ,17,numels16g*ip0)
576 CALL my_alloc( ixs20_p ,21,numels20g*ip0)
577 ALLOCATE( ipartc_p(numelcg*ip0))
578 ALLOCATE( iparttg_p(numeltgg*ip0))
579 ALLOCATE( ipartq_p(numelqg*ip0))
580 ALLOCATE( iparts_p((numelsg-numels10g-numels16g-numels20g)*ip0))
581 ALLOCATE( ipartr_p(numelrg*ip0))
582 ALLOCATE( ipartp_p(numelpg*ip0))
583 ALLOCATE( ipartt_p(numeltrg*ip0))
584 ALLOCATE( ipartsp_p(numsphg*ip0))
585 ALLOCATE( iparts10_p(numels10g*ip0))
586 ALLOCATE( iparts16_p(numels16g*ip0))
587 ALLOCATE( iparts20_p(numels20g*ip0))
588 CALL my_alloc( ixq_p ,nixq,numelqg*ip0)
589 CALL my_alloc( ixc_tmp ,nixc,numelc)
590 CALL my_alloc( ixtg_tmp ,nixtg,numeltg)
591 CALL my_alloc( ixr_tmp ,nixr,numelr)
592 CALL my_alloc( ixp_tmp ,nixp,numelp)
593 CALL my_alloc( kxsp_tmp ,nisp,numsph)
594 CALL my_alloc( ixt_tmp ,nixt,numelt)
595 CALL my_alloc( ixs10_tmp ,11,numels10)
596 CALL my_alloc( ixs16_tmp ,17,numels16)
597 CALL my_alloc( ixs20_tmp ,21,numels20)
598 CALL my_alloc( ixq_tmp ,nixq,numelq)
599 CALL my_alloc( ixskin_tmp ,nixskin,numskin)
600 CALL my_alloc( ixskin_p ,nixskin,numsking*ip0)
601 ALLOCATE( ipartskin_p(numsking*ip0))
602c
603 ALLOCATE(d_p(numnodg0*8))
604
605 IF(nspmd > 1) THEN
606 CALL startime(timers,macro_timer_spmdh3d)
607 CALL spmd_h3d_gather_r_node(weight,d,3*numnod,d_p,3*numnodg)
608 CALL stoptime(timers,macro_timer_spmdh3d)
609 ENDIF
610c
611C**********************************************************************************************
612C COMPUTE COMPONENT ID FOR RBODIES
613C**********************************************************************************************
614 max_part_id = 0
615 compid_rbodies = 0
616 compid_rbe2s = 0
617 compid_rbe3s = 0
618 DO i=1,npart
619 max_part_id = max(max_part_id,ipart(4,i))
620 ENDDO
621 IF(h3d_data%RBODY_SINGLE == 1)compid_rbodies = max_part_id + 1
622 IF(h3d_data%RBE2_SINGLE == 1)compid_rbe2s = max_part_id + 2
623 IF(h3d_data%RBE3_SINGLE == 1)compid_rbe3s = max_part_id + 3
624C**********************************************************************************************
625C BUILD H3D FILE
626C**********************************************************************************************
627 IF (ispmd==0) THEN
628 filnam=rootnam(1:rootlen)//'.h3d'
629 filen = rootlen + 4
630 len_tmp_name = outfile_name_len + rootlen + 4
631 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
632C
633c**********************************************************************************************
634C CREATE PARTS + HIERARCHY
635C**********************************************************************************************
636 IF ((h3d_data%IH3D == 1 .AND. irun == 1)
637 . .OR.( h3d_data%IH3D_RUN == 1 .AND. irun > 1)) THEN
638
639 IF (nsubs > 0) THEN
640 all_sub_childs = 0
641 DO j=1,nsubs
642 all_sub_childs = all_sub_childs + subset(j)%NCHILD
643 sub_id(j) = subset(j)%ID
644 sub_nchild(j) = subset(j)%NCHILD
645 sub_level(j) = subset(j)%LEVEL
646 ENDDO
647!
648 ALLOCATE(sub_child(all_sub_childs))
649 sub_child(1:all_sub_childs) = 0
650 ALLOCATE(sub_iad(nsubs))
651 sub_iad(1:nsubs) = 0
652 ALLOCATE(sub_title(nsubs*ltitr))
653 sub_title(1:nsubs*ltitr) = 0
654 k = 0
655 DO j=1,nsubs
656 DO i=1,subset(j)%NCHILD
657 k = k + 1
658 sub_child(k) = subset(j)%CHILD(i)
659 ENDDO
660 sub_iad(j) = k
661 ENDDO
662! title
663 DO j=1,nsubs
664 CALL fretitl(subset(j)%TITLE,sub_title(ltitr * (j-1)+1),ltitr)
665 ENDDO
666 ELSE
667 ALLOCATE(sub_child(0))
668 ALLOCATE(sub_iad(0))
669 ALLOCATE(sub_title(0))
670 ENDIF !IF (NSUBS > 0) THEN
671 ENDIF ! IH3D,IRUN
672
673 IF (h3d_data%IH3D == 1 .AND. irun == 1) THEN
674C
675c**********************************************************************************************
676C OPEN H3D LIB
677C**********************************************************************************************
678 error_load = 0
679 CALL h3dlib_load(error_load)
680 IF(error_load == 1) THEN
681 CALL ancmsg(msgid=274,anmode=aninfo)
682 CALL arret(2)
683 ENDIF
684C
685c**********************************************************************************************
686C OPEN H3D FILE
687C**********************************************************************************************
688 is_h3d_used = .true.
689 WRITE(radvers,'(A,A)') 'Radioss ',vers
690 len_radvers = len_trim(radvers)
691C
692 CALL startime(timers,macro_timer_libh3d)
693 CALL c_h3d_open_file(tmp_name,len_tmp_name,h3d_data%PERCENTAGE_ERROR,h3d_data%COMP_LEVEL,
694 . radvers,len_radvers,fac_mass,fac_length,fac_time)
695 CALL c_h3d_create_components(ipart,lipart1,npart,ltitr,igeo,npropgi,
696 . h3d_data%PARTS(1)%PART,
697 . nrbody, nrwall, nom_opt, lnopt1, i16d, npby, nnpby,
698 . sub_nchild, nsubs, nrbe2, nrbe3, i16l, i16m, n2d ,irbe2,
699 . nrbe2l,sub_id,sub_child,sub_level,sub_iad,sub_title,irbe3,
700 . nrbe3l,compid_rbodies,compid_rbe2s,compid_rbe3s)
701 CALL stoptime(timers,macro_timer_libh3d)
702
703
704C
705 ELSEIF( h3d_data%IH3D_RUN == 1 .AND. irun > 1) THEN
706c**********************************************************************************************
707C OPEN H3D LIB
708C**********************************************************************************************
709 error_load = 0
710 CALL h3dlib_load(error_load)
711 IF(error_load == 1) THEN
712 CALL ancmsg(msgid=274,anmode=aninfo)
713 CALL arret(2)
714 ENDIF
715C
716c**********************************************************************************************
717C REOPEN H3D FILE
718C**********************************************************************************************
719 INQUIRE( file=tmp_name(1:len_tmp_name), exist=is_file_exists )
720 IF (is_file_exists) THEN
721 CALL startime(timers,macro_timer_libh3d)
722 is_h3d_used = .true.
723 CALL c_h3d_reopen_file(tmp_name,len_tmp_name,h3d_data%PERCENTAGE_ERROR,h3d_data%COMP_LEVEL)
724 CALL stoptime(timers,macro_timer_libh3d)
725 ELSE
726c**********************************************************************************************
727C OPEN H3D FILE
728C**********************************************************************************************
729 WRITE(ch_h3d,'(I4.4)')irun
730 filnam=rootnam(1:rootlen)//'_'//ch_h3d//'.h3d'
731 len_tmp_name = outfile_name_len + len_trim(filnam)
732 tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam))
733 h3d_data%IH3D = 1
734 filen = rootlen + 9
735 is_h3d_used = .true.
736C
737 WRITE(radvers,'(A,A)') 'Radioss ',vers
738 len_radvers = len_trim(radvers)
739C
740 CALL startime(timers,macro_timer_libh3d)
741 CALL c_h3d_open_file(tmp_name,len_tmp_name,h3d_data%PERCENTAGE_ERROR,h3d_data%COMP_LEVEL,
742 . radvers,len_radvers,fac_mass,fac_length,fac_time)
743 CALL c_h3d_create_components(ipart,lipart1,npart,ltitr,igeo,npropgi,h3d_data%PARTS(1)%PART,
744 . nrbody, nrwall, nom_opt, lnopt1, i16d, npby, nnpby,
745 . sub_nchild, nsubs, nrbe2g, nrbe3g, i16e, i16f, n2d ,irbe2,
746 . nrbe2l,sub_id,sub_child,sub_level,sub_iad,sub_title,irbe3,
747 . nrbe3l,compid_rbodies,compid_rbe2s,compid_rbe3s)
748 CALL stoptime(timers,macro_timer_libh3d)
749
750 ENDIF
751 ENDIF
752 ENDIF
753c**********************************************************************************************
754C CREATE ITAB_P
755C**********************************************************************************************
756 IF(nspmd > 1) THEN
757 CALL startime(timers,macro_timer_spmdh3d)
758 CALL spmd_h3d_gather_i_node(weight,itab,numnod,itab_p,numnodg)
759 CALL spmd_h3d_gather_r_node(weight,x,3*numnod,x_p,3*numnodg)
760 CALL stoptime(timers,macro_timer_spmdh3d)
761 ELSE
762 DO i=1,numnod
763 itab_p(i) = itab(i)
764 ENDDO
765 ENDIF
766c**********************************************************************************************
767C H3D/PART
768C**********************************************************************************************
769 IF (ispmd == 0)THEN
770 ALLOCATE(tagnod_p(numnodg))
771 ELSE
772 ALLOCATE(tagnod_p(1))
773 ENDIF
774
775 IF(h3d_data%IPART_SELECT == 1) THEN
776 ALLOCATE(tagnod(numnod))
777 tagnod(1:numnod) = 0
778c
779c
780 DO i=1,numsph
781 IF (h3d_data%PARTS(1)%PART(ipartsp(i)) == 1) THEN
782 IF(kxsp(2,i) > 0 )tagnod(kxsp(2,i)) = 1
783 ENDIF
784 ENDDO
785c
786 DO i=1,numelr
787 IF (h3d_data%PARTS(1)%PART(ipartr(i)) == 1) THEN
788 DO j=2,4
789 IF(ixr(j,i) > 0 )tagnod(ixr(j,i)) = 1
790 ENDDO
791 ENDIF
792 ENDDO
793c
794 DO i=1,numelp
795 IF (h3d_data%PARTS(1)%PART(ipartp(i)) == 1) THEN
796 DO j=2,4
797 IF(ixp(j,i) > 0 )tagnod(ixp(j,i)) = 1
798 ENDDO
799 ENDIF
800 ENDDO
801c
802 DO i=1,numelt
803 IF (h3d_data%PARTS(1)%PART(ipartt(i)) == 1) THEN
804 DO j=2,4
805 IF(ixt(j,i) > 0 )tagnod(ixt(j,i)) = 1
806 ENDDO
807 ENDIF
808 ENDDO
809c
810 DO i=1,nrbody
811 IF(npby(1,i) > 0 ) tagnod(npby(1,i)) = 1
812 DO j=1,npby(2,i)
813 IF(lpby(npby(11,i)+j) > 0) tagnod(lpby(npby(11,i)+j)) = 1
814 ENDDO
815 ENDDO
816c
817 DO i=1,numelc
818 IF (h3d_data%PARTS(1)%PART(ipartc(i)) == 1) THEN
819 DO j=2,5
820 IF(ixc(j,i) > 0 )tagnod(ixc(j,i)) = 1
821 ENDDO
822 ENDIF
823 ENDDO
824c
825 DO i=1,numeltg
826 IF (h3d_data%PARTS(1)%PART(iparttg(i)) == 1) THEN
827 DO j=2,4
828 tagnod(ixtg(j,i)) = 1
829 ENDDO
830 ENDIF
831 ENDDO
832c
833 DO i=1,numels
834 IF (h3d_data%PARTS(1)%PART(iparts(i)) == 1) THEN
835 DO j=2,9
836 IF(ixs(j,i) > 0 )tagnod(ixs(j,i)) = 1
837 ENDDO
838 ENDIF
839 ENDDO
840c
841 DO i=1,numelq
842 IF (h3d_data%PARTS(1)%PART(ipartq(i)) == 1) THEN
843 DO j=2,5
844 IF(ixq(j,i) > 0 )tagnod(ixq(j,i)) = 1
845 ENDDO
846 ENDIF
847 ENDDO
848
849 numnod_h3dpart = 0
850
851 IF(nspmd > 1) THEN
852 CALL startime(timers,macro_timer_spmdh3d)
853 CALL spmd_h3d_gather_i(numnod,1,numnod_p,nspmd)
854 CALL stoptime(timers,macro_timer_spmdh3d)
855 IF(ispmd == 0) THEN
856 DO i=1,nspmd
857 numnod_h3dpart = numnod_h3dpart + numnod_p(i)
858 ENDDO
859 ENDIF
860 ENDIF
861C
862 ALLOCATE(itab_p_part(numnod_h3dpart))
863 ALLOCATE(itabm1_p(2*numnodg))
864C
865 IF(nspmd > 1) THEN
866 CALL startime(timers,macro_timer_spmdh3d)
867 CALL spmd_h3d_gather_i_node(weight,tagnod,numnod,tagnod_p,numnodg)
868 CALL spmd_h3d_gather_i_node_part(weight,tagnod,itab,numnod,itab_p_part,numnod_h3dpart)
869 CALL stoptime(timers,macro_timer_spmdh3d)
870 IF(ispmd == 0) THEN
871 CALL h3d_constit(itab_p,itabm1_p,numnodg)
872 DO i=1,numnod_h3dpart
873 IF(itab_p_part(i) /= 0)THEN
874 IF(sysfus2(itab_p_part(i),itabm1_p,numnodg) /= 0) THEN
875 tagnod_p(sysfus2(itab_p_part(i),itabm1_p,numnodg)) = 1
876 ENDIF
877 ENDIF
878 ENDDO
879 ENDIF
880 ELSE
881 DO i=1,numnod
882 tagnod_p(i) = tagnod(i)
883 ENDDO
884 ENDIF
885 DEALLOCATE(itab_p_part)
886 DEALLOCATE(itabm1_p)
887 ELSE IF(ispmd == 0) THEN
888 DO i=1,numnodg
889 tagnod_p(i) = 1
890 ENDDO
891 ENDIF
892c**********************************************************************************************
893C CREATE NODES
894C**********************************************************************************************
895c
896 max_nod_id = 0
897 IF(nspmd > 1 .AND. ispmd==0)THEN
898 DO i=1,numnodg
899 max_nod_id = max(max_nod_id,itab_p(i))
900 ENDDO
901 ELSEIF(nspmd == 1)THEN
902 max_nod_id = 0
903 DO i=1,numnod
904 max_nod_id = max(max_nod_id,itab(i))
905 ENDDO
906 ENDIF
907 user_nod_id%INPUT_MAX = max_nod_id
908
909 !Create /NODE entities
910 IF(nspmd > 1 .AND. ispmd==0 .AND. h3d_data%IH3D == 1 )THEN
911 CALL startime(timers,macro_timer_libh3d)
912 CALL c_h3d_create_nodes(itab_p,numnodg,x_p,tagnod_p,d_p)
913 CALL stoptime(timers,macro_timer_libh3d)
914 ELSEIF(ispmd==0 .AND. h3d_data%IH3D == 1)THEN
915 CALL startime(timers,macro_timer_libh3d)
916 CALL c_h3d_create_nodes(itab,numnod,x,tagnod_p,d)
917 CALL stoptime(timers,macro_timer_libh3d)
918 ENDIF
919 DEALLOCATE(x_p)
920
921 !Create virtual nodes (FVMBAG polyhedra centroids)
922 airbags_total_fvm_in_h3d_g = 0
923
924 user_nod_id%FVMBAG_SHIFT = max_nod_id
925 user_nod_id%FVMBAG_LEN = 0
926
927 IF(nspmd > 1)THEN
928 IF(nfvbag >0 )THEN
929
930 if (ispmd == 0)ALLOCATE (fvdata_p(nfvbag))
931 airbags_total_fvm_in_h3d_g = 0
932 DO j=1,nfvbag
933
934 ! get NPOLHG,NPOLH_ANIM_G, AIRBAGS_TOTAL_FVM_IN_H3D
935 if ( (fvspmd(j)%PMAIN-1 == 0) .and. (ispmd == 0)) then ! no communication Internal mesh is already on Domain 0
936
937 npolhg = fvdata(j)%NPOLH
938 npolh_anim_g = fvdata(j)%NPOLH_ANIM
939 airbags_total_fvm_in_h3d_g = airbags_total_fvm_in_h3d
940
941 else
942 if (fvspmd(j)%PMAIN-1 == ispmd)then ! the airbag is on another domain the ispmd=0
943
944 fvm_globals(1) = fvdata(j)%NPOLH
945 fvm_globals(2) = fvdata(j)%NPOLH_ANIM
946 fvm_globals(3) = airbags_total_fvm_in_h3d
947
948 call spmd_send(fvm_globals,3,it_spmd(1),25001)
949 endif
950
951 if (ispmd == 0)then
952 call spmd_recv(fvm_globals,3,it_spmd(fvspmd(j)%PMAIN),25001)
953 npolhg = fvm_globals(1)
954 npolh_anim_g = fvm_globals(2)
955 airbags_total_fvm_in_h3d_g = fvm_globals(3)
956 else
957 npolhg = 0
958 npolh_anim_g = 0
959 airbags_total_fvm_in_h3d_g = 0
960 endif
961 endif
962
963 ! Allocate FVDATA_P
964 if (ispmd == 0)then
965 ALLOCATE (fvdata_p(j)%CENTROID_POLH(3,npolhg))
966 ALLOCATE (fvdata_p(j)%QPOLH(3,npolhg))
967 ALLOCATE (fvdata_p(j)%PPOLH(npolhg))
968 ALLOCATE (fvdata_p(j)%SSPPOLH(npolhg))
969 ALLOCATE (fvdata_p(j)%DTPOLH(npolhg))
970 ALLOCATE (fvdata_p(j)%MPOLH(npolhg))
971 ALLOCATE (fvdata_p(j)%RPOLH(npolhg))
972 ALLOCATE (fvdata_p(j)%TPOLH(npolhg))
973 fvdata_p(j)%NPOLH = npolhg
974 fvdata_p(j)%NPOLH_ANIM = npolh_anim_g
975 endif
976
977 if ( (fvspmd(j)%PMAIN-1 == 0) .and. (ispmd == 0)) then ! no communication Internal mesh is already on Domain 0 just copy
978 ! NPOLH = NPOLH_G
979 fvdata_p(j)%CENTROID_POLH(1,1:npolh) = fvdata(j)%CENTROID_POLH(1,1:npolh)
980 fvdata_p(j)%CENTROID_POLH(2,1:npolh) = fvdata(j)%CENTROID_POLH(2,1:npolh)
981 fvdata_p(j)%CENTROID_POLH(3,1:npolh) = fvdata(j)%CENTROID_POLH(3,1:npolh)
982 fvdata_p(j)%QPOLH(1,1:npolh) = fvdata(j)%QPOLH(1,1:npolh)
983 fvdata_p(j)%QPOLH(2,1:npolh) = fvdata(j)%QPOLH(2,1:npolh)
984 fvdata_p(j)%QPOLH(3,1:npolh) = fvdata(j)%QPOLH(3,1:npolh)
985 fvdata_p(j)%PPOLH(1:npolh) = fvdata(j)%PPOLH(1:npolh)
986 fvdata_p(j)%SSPPOLH(1:npolh) = fvdata(j)%SSPPOLH(1:npolh)
987 fvdata_p(j)%DTPOLH(1:npolh) = fvdata(j)%DTPOLH(1:npolh)
988 fvdata_p(j)%MPOLH(1:npolh) = fvdata(j)%MPOLH(1:npolh)
989 fvdata_p(j)%RPOLH(1:npolh) = fvdata(j)%RPOLH(1:npolh)
990 fvdata_p(j)%TPOLH(1:npolh) = fvdata(j)%TPOLH(1:npolh)
991 else
992 if (ispmd == fvspmd(j)%PMAIN-1)then ! Nothing to do for the others
993 ALLOCATE(fvdata_1d_array(12*npolh))
994 fvdata_1d_array(00*npolh+1:01*npolh) = fvdata(j)%CENTROID_POLH(1,1:npolh)
995 fvdata_1d_array(01*npolh+1:02*npolh) = fvdata(j)%CENTROID_POLH(2,1:npolh)
996 fvdata_1d_array(02*npolh+1:03*npolh) = fvdata(j)%CENTROID_POLH(3,1:npolh)
997 fvdata_1d_array(03*npolh+1:04*npolh) = fvdata(j)%QPOLH(1,1:npolh)
998 fvdata_1d_array(04*npolh+1:05*npolh) = fvdata(j)%QPOLH(2,1:npolh)
999 fvdata_1d_array(05*npolh+1:06*npolh) = fvdata(j)%QPOLH(3,1:npolh)
1000 fvdata_1d_array(06*npolh+1:07*npolh) = fvdata(j)%PPOLH(1:npolh)
1001 fvdata_1d_array(07*npolh+1:08*npolh) = fvdata(j)%SSPPOLH(1:npolh)
1002 fvdata_1d_array(08*npolh+1:09*npolh) = fvdata(j)%DTPOLH(1:npolh)
1003 fvdata_1d_array(09*npolh+1:10*npolh) = fvdata(j)%MPOLH(1:npolh)
1004 fvdata_1d_array(10*npolh+1:11*npolh) = fvdata(j)%RPOLH(1:npolh)
1005 fvdata_1d_array(11*npolh+1:12*npolh) = fvdata(j)%TPOLH(1:npolh)
1006
1007 call spmd_send(fvdata_1d_array,12*npolh,it_spmd(1),25000)
1008 DEALLOCATE(fvdata_1d_array)
1009 endif
1010
1011 if (ispmd == 0)then
1012 ALLOCATE(fvdata_1d_array(12*npolhg))
1013 call spmd_recv(fvdata_1d_array,12*npolhg,it_spmd(fvspmd(j)%PMAIN),25000)
1014
1015 fvdata_p(j)%CENTROID_POLH(1,1:npolhg) = fvdata_1d_array(00*npolhg+1:01*npolhg)
1016 fvdata_p(j)%CENTROID_POLH(2,1:npolhg) = fvdata_1d_array(01*npolhg+1:02*npolhg)
1017 fvdata_p(j)%CENTROID_POLH(3,1:npolhg) = fvdata_1d_array(02*npolhg+1:03*npolhg)
1018 fvdata_p(j)%QPOLH(1,1:npolhg) = fvdata_1d_array(03*npolhg+1:04*npolhg)
1019 fvdata_p(j)%QPOLH(2,1:npolhg) = fvdata_1d_array(04*npolhg+1:05*npolhg)
1020 fvdata_p(j)%QPOLH(3,1:npolhg) = fvdata_1d_array(05*npolhg+1:06*npolhg)
1021 fvdata_p(j)%PPOLH(1:npolhg) = fvdata_1d_array(06*npolhg+1:07*npolhg)
1022 fvdata_p(j)%SSPPOLH(1:npolhg) = fvdata_1d_array(07*npolhg+1:08*npolhg)
1023 fvdata_p(j)%DTPOLH(1:npolhg) = fvdata_1d_array(08*npolhg+1:09*npolhg)
1024 fvdata_p(j)%MPOLH(1:npolhg) = fvdata_1d_array(09*npolhg+1:10*npolhg)
1025 fvdata_p(j)%RPOLH(1:npolhg) = fvdata_1d_array(10*npolhg+1:11*npolhg)
1026 fvdata_p(j)%TPOLH(1:npolhg) = fvdata_1d_array(11*npolhg+1:12*npolhg)
1027 user_nod_id%FVMBAG_LEN = user_nod_id%FVMBAG_LEN + npolhg
1028 DEALLOCATE(fvdata_1d_array)
1029 endif
1030 endif
1031
1032 ENDDO
1033 endif!NFVBAG > 0
1034
1035 ELSE !IF NSPMD==1
1036
1037 airbags_total_fvm_in_h3d_g = airbags_total_fvm_in_h3d
1038 IF(nfvbag > 0)THEN
1039 ALLOCATE (fvdata_p(nfvbag))
1040 DO j=1,nfvbag
1041 npolh = fvdata(j)%NPOLH
1042 npolh_anim = fvdata(j)%NPOLH
1043 npolh = max(1,npolh) !allocation size 1 if no polyhedron
1044 ALLOCATE (fvdata_p(j)%CENTROID_POLH(3,npolh))
1045 ALLOCATE (fvdata_p(j)%QPOLH(3,npolh))
1046 ALLOCATE (fvdata_p(j)%PPOLH(npolh))
1047 ALLOCATE (fvdata_p(j)%SSPPOLH(npolh))
1048 ALLOCATE (fvdata_p(j)%DTPOLH(npolh))
1049 ALLOCATE (fvdata_p(j)%MPOLH(npolh))
1050 ALLOCATE (fvdata_p(j)%RPOLH(npolh))
1051 ALLOCATE (fvdata_p(j)%TPOLH(npolh))
1052 ! 10*NPOLH
1053 fvdata_p(j)%NPOLH = npolh
1054 fvdata_p(j)%NPOLH_ANIM = npolh_anim
1055 fvdata_p(j)%CENTROID_POLH(1,1:npolh) = fvdata(j)%CENTROID_POLH(1,1:npolh)
1056 fvdata_p(j)%CENTROID_POLH(2,1:npolh) = fvdata(j)%CENTROID_POLH(2,1:npolh)
1057 fvdata_p(j)%CENTROID_POLH(3,1:npolh) = fvdata(j)%CENTROID_POLH(3,1:npolh)
1058 fvdata_p(j)%QPOLH(1,1:npolh) = fvdata(j)%QPOLH(1,1:npolh)
1059 fvdata_p(j)%QPOLH(2,1:npolh) = fvdata(j)%QPOLH(2,1:npolh)
1060 fvdata_p(j)%QPOLH(3,1:npolh) = fvdata(j)%QPOLH(3,1:npolh)
1061 fvdata_p(j)%PPOLH(1:npolh) = fvdata(j)%PPOLH(1:npolh)
1062 fvdata_p(j)%SSPPOLH(1:npolh) = fvdata(j)%SSPPOLH(1:npolh)
1063 fvdata_p(j)%DTPOLH(1:npolh) = fvdata(j)%DTPOLH(1:npolh)
1064 fvdata_p(j)%MPOLH(1:npolh) = fvdata(j)%MPOLH(1:npolh)
1065 fvdata_p(j)%RPOLH(1:npolh) = fvdata(j)%RPOLH(1:npolh)
1066 fvdata_p(j)%TPOLH(1:npolh) = fvdata(j)%TPOLH(1:npolh)
1067 user_nod_id%FVMBAG_LEN = user_nod_id%FVMBAG_LEN + npolh
1068 ENDDO
1069 ENDIF ! NFVBAG > 0
1070 ENDIF
1071
1072 max_nod_id = max_nod_id + user_nod_id%FVMBAG_LEN !incrementing MAX_NOD_ID for next option which is generating virtual nodes
1073
1074 IF(nfvbag > 0 .AND. ispmd==0 .AND. h3d_data%IH3D == 1)THEN
1075 CALL startime(timers,macro_timer_libh3d)
1076 CALL h3d_create_fvmbag_centroids(monvol,volmon, fvdata_p, nfvbag, smonvol, svolmon, user_nod_id%FVMBAG_SHIFT)
1077 CALL stoptime(timers,macro_timer_libh3d)
1078 ENDIF
1079
1080c**********************************************************************************************
1081C CREATE SPH
1082C**********************************************************************************************
1083c
1084 IF(h3d_data%IH3D == 1) THEN
1085 IF(nspmd > 1) THEN
1086 DO i=1,numsph
1087 DO j=1,2
1088 kxsp_tmp(j,i) = kxsp(j,i)
1089 ENDDO
1090 kxsp_tmp(3,i) = itab(kxsp(3,i))
1091 DO j=4,nisp
1092 kxsp_tmp(j,i) = kxsp(j,i)
1093 ENDDO
1094 ENDDO
1095c
1096 CALL startime(timers,macro_timer_spmdh3d)
1097 CALL spmd_h3d_gather_i(kxsp_tmp,nisp*numsph,kxsp_p,nisp*numsphg)
1098 CALL stoptime(timers,macro_timer_spmdh3d)
1099c
1100 ELSE
1101 DO i=1,numsph
1102 DO j=1,2
1103 kxsp_p(j,i) = kxsp(j,i)
1104 ENDDO
1105 kxsp_p(3,i) = itab(kxsp(3,i))
1106 DO j=4,nisp
1107 kxsp_p(j,i) = kxsp(j,i)
1108 ENDDO
1109 ENDDO
1110 ENDIF
1111c
1112 IF(nspmd > 1) THEN
1113 if (ispmd == 0)then
1114 ipartsp_p(1:numsphg)=0
1115 endif
1116 CALL startime(timers,macro_timer_spmdh3d)
1117 CALL spmd_h3d_gather_i(ipartsp,numsph,ipartsp_p,numsphg)
1118 CALL stoptime(timers,macro_timer_spmdh3d)
1119 ELSE
1120 DO i=1,numsph
1121 ipartsp_p(i) = ipartsp(i)
1122 ENDDO
1123 ENDIF
1124 ENDIF
1125
1126 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1127 CALL startime(timers,macro_timer_libh3d)
1128 CALL c_h3d_create_sph(itab_p,numnodg,kxsp_p,nisp,numsphg,ipartsp_p,ipart,lipart1,x,h3d_data%PARTS(1)%PART)
1129 CALL stoptime(timers,macro_timer_libh3d)
1130 ENDIF
1131c**********************************************************************************************
1132C CREATE 1D CONNECTIVITY
1133C**********************************************************************************************
1134C
1135C CREATE SPRINGS
1136C
1137 IF(h3d_data%IH3D == 1) THEN
1138 IF(nspmd > 1) THEN
1139 DO i=1,numelr
1140 ixr_tmp(1,i) = ixr(1,i)
1141 DO j=2,4
1142 IF (ixr(j,i) /= 0 )ixr_tmp(j,i) = itab(ixr(j,i))
1143 ENDDO
1144 ixr_tmp(4:nixr,i) = ixr(4:nixr,i)
1145 ENDDO
1146c
1147 CALL startime(timers,macro_timer_spmdh3d)
1148 CALL spmd_h3d_gather_i(ixr_tmp,nixr*numelr,ixr_p,nixr*numelrg)
1149 CALL stoptime(timers,macro_timer_spmdh3d)
1150c
1151 ELSE
1152 DO i=1,numelr
1153 ixr_p(1,i) = ixr(1,i)
1154 DO j=2,4
1155 IF (ixr(j,i) /= 0 ) ixr_p(j,i) = itab(ixr(j,i))
1156 ENDDO
1157 ixr_p(4:nixr,i) = ixr(4:nixr,i)
1158 ENDDO
1159 ENDIF
1160c
1161 IF(nspmd > 1) THEN
1162 CALL startime(timers,macro_timer_spmdh3d)
1163 CALL spmd_h3d_gather_i(ipartr,numelr,ipartr_p,numelrg)
1164 CALL stoptime(timers,macro_timer_spmdh3d)
1165 ELSE
1166 DO i=1,numelr
1167 ipartr_p(i) = ipartr(i)
1168 ENDDO
1169 ENDIF
1170 ENDIF
1171c
1172 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1173 CALL startime(timers,macro_timer_libh3d)
1174 CALL c_h3d_create_springs(itab,numnod,ixr_p,nixr,numelrg,ipartr_p,ipart,lipart1,h3d_data%PARTS(1)%PART)
1175 CALL stoptime(timers,macro_timer_libh3d)
1176 ENDIF
1177C
1178C CREATE BEAMS
1179C
1180C
1181 IF(h3d_data%IH3D == 1) THEN
1182 IF(nspmd > 1) THEN
1183 DO i=1,numelp
1184 ixp_tmp(1,i) = ixp(1,i)
1185 DO j=2,4
1186 ixp_tmp(j,i) = itab(ixp(j,i))
1187 ENDDO
1188 ixp_tmp(4:nixp,i) = ixp(4:nixp,i)
1189 ENDDO
1190c
1191 CALL startime(timers,macro_timer_spmdh3d)
1192 CALL spmd_h3d_gather_i(ixp_tmp,nixp*numelp,ixp_p,nixp*numelpg)
1193 CALL stoptime(timers,macro_timer_spmdh3d)
1194c
1195 ELSE
1196 DO i=1,numelp
1197 ixp_p(1,i) = ixp(1,i)
1198 DO j=2,4
1199 ixp_p(j,i) = itab(ixp(j,i))
1200 ENDDO
1201 ixp_p(4:nixp,i) = ixp(4:nixp,i)
1202 ENDDO
1203 ENDIF
1204 IF(nspmd > 1) THEN
1205 CALL startime(timers,macro_timer_spmdh3d)
1206 CALL spmd_h3d_gather_i(ipartp,numelp,ipartp_p,numelpg)
1207 CALL stoptime(timers,macro_timer_spmdh3d)
1208 ELSE
1209 DO i=1,numelp
1210 ipartp_p(i) = ipartp(i)
1211 ENDDO
1212 ENDIF
1213 ENDIF
1214c
1215c
1216 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1217 CALL startime(timers,macro_timer_libh3d)
1218 CALL c_h3d_create_beams(itab,numnod,ixp_p,nixp,numelpg,ipartp_p,ipart,lipart1,h3d_data%PARTS(1)%PART)
1219 CALL stoptime(timers,macro_timer_libh3d)
1220 ENDIF
1221C
1222C CREATE TRUSS
1223C
1224C
1225 IF(h3d_data%IH3D == 1) THEN
1226 IF(nspmd > 1) THEN
1227 DO i=1,numelt
1228 ixt_tmp(1,i) = ixt(1,i)
1229 DO j=2,4
1230 ixt_tmp(j,i) = itab(ixt(j,i))
1231 ENDDO
1232 ixt_tmp(4:nixt,i) = ixt(4:nixt,i)
1233 ENDDO
1234c
1235 CALL startime(timers,macro_timer_spmdh3d)
1236 CALL spmd_h3d_gather_i(ixt_tmp,nixt*numelt,ixt_p,nixp*numeltrg)
1237 CALL stoptime(timers,macro_timer_spmdh3d)
1238c
1239 ELSE
1240 DO i=1,numelt
1241 ixt_p(1,i) = ixt(1,i)
1242 DO j=2,4
1243 ixt_p(j,i) = itab(ixt(j,i))
1244 ENDDO
1245 ixt_p(4:nixt,i) = ixt(4:nixt,i)
1246 ENDDO
1247 ENDIF
1248 IF(nspmd > 1) THEN
1249 CALL startime(timers,macro_timer_spmdh3d)
1250 CALL spmd_h3d_gather_i(ipartt,numelt,ipartt_p,numeltrg)
1251 CALL stoptime(timers,macro_timer_spmdh3d)
1252 ELSE
1253 DO i=1,numelt
1254 ipartt_p(i) = ipartt(i)
1255 ENDDO
1256 ENDIF
1257 ENDIF
1258c
1259c
1260 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1261 CALL startime(timers,macro_timer_libh3d)
1262 CALL c_h3d_create_truss(itab,numnod,ixt_p,nixt,numeltrg,ipartt_p,ipart,lipart1,h3d_data%PARTS(1)%PART)
1263 CALL stoptime(timers,macro_timer_libh3d)
1264 ENDIF
1265C
1266c**********************************************************************************************
1267C CREATE RBODY CONNECTIVITY
1268C**********************************************************************************************
1269
1270 IF(nspmd > 1 .AND. h3d_data%IH3D == 1)THEN
1271 nerby = 0
1272 IF (nrbody>0)
1273 . CALL drbycnt(nerby,npby,fr_rby2)
1274 nerbe2 = 0
1275 IF (nrbe2g>0)
1276 . CALL drbe2cnt(nerbe2,irbe2,lrbe2,weight)
1277 nerbe3 = 0
1278 IF (nrbe3g>0)
1279 . CALL drbe3cnt(nerbe3,irbe3,lrbe3,weight)
1280c
1281 sbufspm=0
1282 sbufrecvm=0
1283 sbufspo=0
1284 sporby=0
1285
1286 DO i=1,nspmd
1287 sbufspm = sbufspm + iad_rby2(1,i)
1288 sbufrecvm = sbufrecvm + iad_rby2(2,i)+1
1289 ENDDO
1290 sbufspm = sbufspm + 2*nrbykin
1291 sbufrecvm = sbufrecvm + 2*nrbykin*nspmd
1292 DO i=1,nrbykin
1293
1294 IF ((ispmd+1)==abs(fr_rby2(3,i)))
1295 . sbufspo = sbufspo + fr_rby2(2,i)
1296 ENDDO
1297 sbufspo = sbufspo + nrbykin*2
1298 IF (ispmd==0) THEN
1299 sporby = nerby+nrbykin*2
1300 ELSE
1301 sporby=1
1302 ENDIF
1303
1304 CALL h3d_create_rbodies_impi(npby,lpby,fr_rby2,iad_rby2,
1305 . sbufspm,sbufrecvm,sbufspo,sporby,
1306 . nodglob,weight,itab,compid_rbodies)
1307
1308 CALL h3d_create_rbe2_impi(lrbe2, irbe2,nodglob,weight,nerbe2,
1309 . nerbe2t,itab,compid_rbe2s)
1310
1311 CALL h3d_create_rbe3_impi(lrbe3, irbe3,nodglob,weight,nerbe3,
1312 . nerbe3t,itab,compid_rbe3s)
1313
1314 ELSE
1315 IF(nspmd == 1 .AND. ispmd==0 .AND. h3d_data%IH3D == 1) THEN
1316 CALL startime(timers,macro_timer_libh3d)
1317 CALL c_h3d_create_rbodies(itab,numnod,npby,nnpby,lpby,nrbody,compid_rbodies)
1318 CALL c_h3d_create_rbe2(itab,numnod,irbe2,nrbe2l,lrbe2,nrbe2,compid_rbe2s,compid_rbe2s)
1319 CALL c_h3d_create_rbe3(itab,numnod,irbe3,nrbe3l,lrbe3,nrbe3,compid_rbe3s,compid_rbe3s)
1320 CALL stoptime(timers,macro_timer_libh3d)
1321 ENDIF
1322 ENDIF
1323C
1324c**********************************************************************************************
1325C CREATE SH4N & SH3N CONNECTIVITY
1326C**********************************************************************************************
1327c
1328 IF(h3d_data%IH3D == 1) THEN
1329 IF(nspmd > 1 .AND. h3d_data%IH3D == 1) THEN
1330 DO i=1,numelc
1331 ixc_tmp(1,i) = ixc(1,i)
1332 DO j=2,5
1333 ixc_tmp(j,i) = itab(ixc(j,i))
1334 ENDDO
1335 ixc_tmp(6:nixc,i) = ixc(6:nixc,i)
1336 ENDDO
1337c
1338 CALL startime(timers,macro_timer_spmdh3d)
1339 CALL spmd_h3d_gather_i(ixc_tmp,nixc*numelc,ixc_p,nixc*numelcg)
1340 CALL stoptime(timers,macro_timer_spmdh3d)
1341c
1342 DO i=1,numeltg
1343 ixtg_tmp(1,i) = ixtg(1,i)
1344 DO j=2,4
1345 ixtg_tmp(j,i) = itab(ixtg(j,i))
1346 ENDDO
1347 ixtg_tmp(5:nixtg,i) = ixtg(5:nixtg,i)
1348 ENDDO
1349c
1350 CALL startime(timers,macro_timer_spmdh3d)
1351 CALL spmd_h3d_gather_i(ixtg_tmp,nixtg*numeltg,ixtg_p,nixtg*numeltgg)
1352 CALL stoptime(timers,macro_timer_spmdh3d)
1353c
1354 ELSE
1355 DO i=1,numelc
1356 ixc_p(1,i) = ixc(1,i)
1357 DO j=2,5
1358 ixc_p(j,i) = itab(ixc(j,i))
1359 ENDDO
1360 ixc_p(6:nixc,i) = ixc(6:nixc,i)
1361 ENDDO
1362
1363 DO i=1,numeltg
1364 ixtg_p(1,i) = ixtg(1,i)
1365 DO j=2,4
1366 ixtg_p(j,i) = itab(ixtg(j,i))
1367 ENDDO
1368 ixtg_p(5:nixtg,i) = ixtg(5:nixtg,i)
1369 ENDDO
1370
1371 ENDIF
1372 IF(nspmd > 1) THEN
1373 CALL startime(timers,macro_timer_spmdh3d)
1374 CALL spmd_h3d_gather_i(ipartc,numelc,ipartc_p,numelcg)
1375 CALL stoptime(timers,macro_timer_spmdh3d)
1376 CALL startime(timers,macro_timer_spmdh3d)
1377 CALL spmd_h3d_gather_i(iparttg,numeltg,iparttg_p,numeltgg)
1378 CALL stoptime(timers,macro_timer_spmdh3d)
1379 ELSE
1380 DO i=1,numelc
1381 ipartc_p(i) = ipartc(i)
1382 ENDDO
1383 DO i=1,numeltg
1384 iparttg_p(i) = iparttg(i)
1385 ENDDO
1386 ENDIF
1387 ENDIF
1388c
1389
1390
1391 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1392 CALL startime(timers,macro_timer_libh3d)
1393 CALL c_h3d_create_shells(itab_p,numnodg,ixc_p,nixc,numelcg,ipartc_p,ipart,lipart1,
1394 . h3d_data%PARTS(1)%PART)
1395 CALL c_h3d_create_sh3ns(itab_p,numnodg,ixtg_p,nixtg,numeltgg,iparttg_p,ipart,lipart1,
1396 . h3d_data%PARTS(1)%PART)
1397 CALL stoptime(timers,macro_timer_libh3d)
1398 ENDIF
1399C
1400c**********************************************************************************************
1401C CREATE RWALLS
1402C**********************************************************************************************
1403c
1404 max_nod_id = user_nod_id%FVMBAG_SHIFT + user_nod_id%FVMBAG_LEN
1405 user_nod_id%RWALL_SHIFT = max_nod_id
1406
1407 IF(h3d_data%IH3D == 1 .AND. nrwall>0) THEN
1408
1409 CALL scanor(x,d,cdg,xmin,ymin,zmin,xmax,ymax,zmax,scale,
1410 . weight)
1411C
1412
1413 CALL h3d_dxyz_rwall(
1414 2 nstrf,rwbuf,nprw ,x,xmin,
1415 3 ymin,zmin,xmax,ymax,zmax,
1416 4 fr_sec,fr_wall,weight,itab,
1417 5 xwl ,ywl , zwl, v1, v2, v3, vv1, vv2, vv3, xl, xn, yn, zn )
1418
1419
1420 IF(ispmd==0) THEN
1421 CALL startime(timers,macro_timer_libh3d)
1422 CALL c_h3d_create_rwalls(nom_opt, lnopt1, i16d, nprw, nrwall, user_nod_id%RWALL_SHIFT,
1423 . xwl ,ywl , zwl, v1, v2, v3, vv1, vv2, vv3, xl, xn, yn, zn, user_nod_id%RWALL_LEN )
1424 CALL stoptime(timers,macro_timer_libh3d)
1425 max_nod_id = max_nod_id + user_nod_id%RWALL_LEN !incrementing MAX_NOD_ID for next option which is generating virtual nodes
1426 ENDIF
1427
1428 ENDIF
1429C
1430c**********************************************************************************************
1431C CREATE SOLIDS CONNECTIVITY
1432C**********************************************************************************************
1433c
1434 IF(h3d_data%IH3D == 1) THEN
1435
1436 IF(nspmd > 1) THEN
1437 ALLOCATE(ixs_tmp(nixs,numels8))
1438c
1439 DO i=1,numels8
1440 ixs_tmp(1,i) = ixs(1,i)
1441 DO j=2,9
1442 ixs_tmp(j,i) = itab(ixs(j,i))
1443 ENDDO
1444 ixs_tmp(10:nixs,i) = ixs(10:nixs,i)
1445 ENDDO
1446c
1447 DO i=1,numels10
1448 ixs10_tmp(1,i) = itab(ixs(2,numels8+i))
1449 ixs10_tmp(2,i) = itab(ixs(4,numels8+i))
1450 ixs10_tmp(3,i) = itab(ixs(7,numels8+i))
1451 ixs10_tmp(4,i) = itab(ixs(6,numels8+i))
1452 DO j=1,6
1453 IF (ixs10(j,i)>0) THEN
1454 ixs10_tmp(4+j,i) = itab(ixs10(j,i))
1455 ELSE
1456 ixs10_tmp(4+j,i) = 0
1457 END IF
1458 ENDDO
1459 ixs10_tmp(11,i) = ixs(nixs,numels8+i)
1460 ENDDO
1461c
1462c
1463 DO i=1,numels16
1464 ixs16_tmp(1,i) = itab(ixs(2,numels8+numels10+numels20+i))
1465 ixs16_tmp(2,i) = itab(ixs(3,numels8+numels10+numels20+i))
1466 ixs16_tmp(3,i) = itab(ixs(4,numels8+numels10+numels20+i))
1467 ixs16_tmp(4,i) = itab(ixs(5,numels8+numels10+numels20+i))
1468 ixs16_tmp(5,i) = itab(ixs(6,numels8+numels10+numels20+i))
1469 ixs16_tmp(6,i) = itab(ixs(7,numels8+numels10+numels20+i))
1470 ixs16_tmp(7,i) = itab(ixs(8,numels8+numels10+numels20+i))
1471 ixs16_tmp(8,i) = itab(ixs(9,numels8+numels10+numels20+i))
1472 DO j=1,8
1473 ixs16_tmp(8+j,i) = itab(ixs16(j,i))
1474 ENDDO
1475 ixs16_tmp(17,i) = ixs(nixs,numels8+numels10+numels20+i)
1476 ENDDO
1477c
1478c
1479 DO i=1,numels20
1480 ixs20_tmp(1,i) = itab(ixs(2,numels8+numels10+i))
1481 ixs20_tmp(2,i) = itab(ixs(3,numels8+numels10+i))
1482 ixs20_tmp(3,i) = itab(ixs(4,numels8+numels10+i))
1483 ixs20_tmp(4,i) = itab(ixs(5,numels8+numels10+i))
1484 ixs20_tmp(5,i) = itab(ixs(6,numels8+numels10+i))
1485 ixs20_tmp(6,i) = itab(ixs(7,numels8+numels10+i))
1486 ixs20_tmp(7,i) = itab(ixs(8,numels8+numels10+i))
1487 ixs20_tmp(8,i) = itab(ixs(9,numels8+numels10+i))
1488 DO j=1,12
1489 ixs20_tmp(8+j,i) = itab(ixs20(j,i))
1490 ENDDO
1491 ixs20_tmp(21,i) = ixs(nixs,numels8+numels10+i)
1492 ENDDO
1493c
1494 CALL startime(timers,macro_timer_spmdh3d)
1495 CALL spmd_h3d_gather_i(ixs_tmp,nixs*numels8,ixs_p,nixs*(numelsg-numels10g-numels16g-numels20g))
1496 CALL spmd_h3d_gather_i(ixs10_tmp,11*numels10,ixs10_p,11*numels10g)
1497 CALL spmd_h3d_gather_i(ixs16_tmp,17*numels16,ixs16_p,17*numels16g)
1498 CALL spmd_h3d_gather_i(ixs20_tmp,21*numels20,ixs20_p,21*numels20g)
1499 CALL stoptime(timers,macro_timer_spmdh3d)
1500 DEALLOCATE(ixs_tmp)
1501 ELSE
1502c
1503 DO i=1,numels8
1504 ixs_p(1,i) = ixs(1,i)
1505 DO j=2,9
1506 ixs_p(j,i) = itab(ixs(j,i))
1507 ENDDO
1508 ixs_p(10:nixs,i) = ixs(10:nixs,i)
1509 ENDDO
1510c
1511 DO i=1,numels10
1512 ixs10_p(1,i) = itab(ixs(2,numels8+i))
1513 ixs10_p(2,i) = itab(ixs(4,numels8+i))
1514 ixs10_p(3,i) = itab(ixs(7,numels8+i))
1515 ixs10_p(4,i) = itab(ixs(6,numels8+i))
1516 DO j=1,6
1517 ixs10_p(4+j,i) = itab(ixs10(j,i))
1518 ENDDO
1519 ixs10_p(11,i) = ixs(nixs,numels8+i)
1520 ENDDO
1521c
1522 DO i=1,numels16
1523 ixs16_p(1,i) = itab(ixs(2,numels8+numels10+numels20+i))
1524 ixs16_p(2,i) = itab(ixs(3,numels8+numels10+numels20+i))
1525 ixs16_p(3,i) = itab(ixs(4,numels8+numels10+numels20+i))
1526 ixs16_p(4,i) = itab(ixs(5,numels8+numels10+numels20+i))
1527 ixs16_p(5,i) = itab(ixs(6,numels8+numels10+numels20+i))
1528 ixs16_p(6,i) = itab(ixs(7,numels8+numels10+numels20+i))
1529 ixs16_p(7,i) = itab(ixs(8,numels8+numels10+numels20+i))
1530 ixs16_p(8,i) = itab(ixs(9,numels8+numels10+numels20+i))
1531 DO j=1,8
1532 ixs16_p(8+j,i) = ixs16(j,i)
1533 ENDDO
1534 ixs16_p(17,i) = ixs(nixs,numels8+numels10+numels20+i)
1535 ENDDO
1536c
1537 DO i=1,numels20
1538 ixs20_p(1,i) = itab(ixs(2,numels8+numels10+i))
1539 ixs20_p(2,i) = itab(ixs(3,numels8+numels10+i))
1540 ixs20_p(3,i) = itab(ixs(4,numels8+numels10+i))
1541 ixs20_p(4,i) = itab(ixs(5,numels8+numels10+i))
1542 ixs20_p(5,i) = itab(ixs(6,numels8+numels10+i))
1543 ixs20_p(6,i) = itab(ixs(7,numels8+numels10+i))
1544 ixs20_p(7,i) = itab(ixs(8,numels8+numels10+i))
1545 ixs20_p(8,i) = itab(ixs(9,numels8+numels10+i))
1546 DO j=1,12
1547 ixs20_p(8+j,i) = itab(ixs20(j,i))
1548 ENDDO
1549 ixs20_p(21,i) = ixs(nixs,numels8+numels10+i)
1550 ENDDO
1551 ENDIF
1552 IF(nspmd > 1) THEN
1553 CALL startime(timers,macro_timer_spmdh3d)
1554 CALL spmd_h3d_gather_i(iparts,numels8,iparts_p,numelsg-numels10g-numels16g-numels20g)
1555 CALL spmd_h3d_gather_i(iparts(numels8+1),numels10,iparts10_p,numels10g)
1556 CALL spmd_h3d_gather_i(iparts(numels8+numels10+1),numels20,iparts20_p,numels20g)
1557 CALL spmd_h3d_gather_i(iparts(numels8+numels10+numels20+1),numels16,iparts16_p,numels16g)
1558 CALL stoptime(timers,macro_timer_spmdh3d)
1559 ELSE
1560 DO i=1,numels8
1561 iparts_p(i) = iparts(i)
1562 ENDDO
1563 DO i=1,numels10
1564 iparts10_p(i) = iparts(i+numels8)
1565 ENDDO
1566 DO i=1,numels20
1567 iparts20_p(i) = iparts(i+numels8+numels10)
1568 ENDDO
1569 DO i=1,numels16
1570 iparts16_p(i) = iparts(i+numels8+numels10+numels20)
1571 ENDDO
1572 ENDIF
1573 ENDIF
1574c
1575c
1576 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1577 CALL startime(timers,macro_timer_libh3d)
1578 CALL c_h3d_create_solid8n(itab_p,numnodg,ixs_p,nixs,numelsg,iparts_p,ipart,lipart1,
1579 . h3d_data%PARTS(1)%PART,numels10g,ixs10_p,iparts10_p,numels16g,ixs16_p,
1580 . iparts16_p,numels20g,ixs20_p,iparts20_p)
1581 CALL stoptime(timers,macro_timer_libh3d)
1582 ENDIF
1583C
1584c**********************************************************************************************
1585C CREATE QUADS CONNECTIVITY
1586C**********************************************************************************************
1587c
1588 IF(h3d_data%IH3D == 1) THEN
1589 IF(nspmd > 1) THEN
1590 DO i=1,numelq
1591 ixq_tmp(1,i) = ixq(1,i)
1592 DO j=2,5
1593 ixq_tmp(j,i) = itab(ixq(j,i))
1594 ENDDO
1595 ixq_tmp(6:nixq,i) = ixq(6:nixq,i)
1596 ENDDO
1597 CALL startime(timers,macro_timer_spmdh3d)
1598 CALL spmd_h3d_gather_i(ixq_tmp,nixq*numelq,ixq_p,nixq*numelqg)
1599 CALL stoptime(timers,macro_timer_spmdh3d)
1600 ELSE
1601 DO i=1,numelq
1602 ixq_p(1,i) = ixq(1,i)
1603 DO j=2,5
1604 ixq_p(j,i) = itab(ixq(j,i))
1605 ENDDO
1606 ixq_p(6:nixq,i) = ixq(6:nixq,i)
1607 ENDDO
1608 ENDIF
1609 IF(nspmd > 1) THEN
1610 CALL startime(timers,macro_timer_spmdh3d)
1611 CALL spmd_h3d_gather_i(ipartq,numelq,ipartq_p,numelqg)
1612 CALL stoptime(timers,macro_timer_spmdh3d)
1613 ELSE
1614 DO i=1,numelq
1615 ipartq_p(i) = ipartq(i)
1616 ENDDO
1617 ENDIF
1618 ENDIF
1619c
1620c
1621 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1622 CALL startime(timers,macro_timer_libh3d)
1623 CALL c_h3d_create_quads(itab_p,numnodg,ipart,lipart1,h3d_data%PARTS(1)%PART,
1624 . ixq_p,nixq,numelqg,ipartq_p)
1625 CALL stoptime(timers,macro_timer_libh3d)
1626 ENDIF
1627c**********************************************************************************************
1628C CREATE SKIN (4-N) CONNECTIVITY ( THICK SHELLS +solid +PLOAD...)
1629C**********************************************************************************************
1630C-------------nodal_pid used for PLOAD---
1631 IF (numskinp>0) THEN
1632 ALLOCATE(nodal_ipart(numnod),imapskp(numskinp0))
1633 CALL get_nodal_ipart(elbuf_tab,iparg,ipartc,iparttg,iparts,
1634 . ixc, ixtg, ixs,ixs10,ixs16,ixs20,
1635 . nodal_ipart)
1636 CALL h3d_skin_pre_map(ibcl ,iloadp ,lloadp ,imapskp,loads,pblast)
1637 END IF
1638 IF(h3d_data%IH3D == 1 .AND. numsking>0 ) THEN
1639C----create connectivity IXSKIN_P(NIXQ,NUMSKING),IPARTSKIN_P(NUMSKING)
1640 ixskin_tmp = 0
1641 CALL h3d_skin_ixskin(elbuf_tab,iparg,iparts,ixs,ixs10,
1642 . itab ,ixskin_tmp ,tag_skins6,
1643 . ibcl,iloadp,lloadp,nodal_ipart,imapskp,loads,pblast)
1644c--------IXSKIN_TMP(1,i) :ipart (instead of mid)--IXSKIN_TMP(2-5,i) : Nj(user_id)
1645 IF(nspmd > 1) THEN
1646C
1647 CALL startime(timers,macro_timer_spmdh3d)
1648 CALL spmd_h3d_gather_i(ixskin_tmp,nixskin*numskin,ixskin_p,nixskin*numsking)
1649 CALL stoptime(timers,macro_timer_spmdh3d)
1650 ELSE
1651 ixskin_p(1:nixskin,1:numskin) = ixskin_tmp(1:nixskin,1:numskin)
1652 END IF
1653
1654c
1655 IF(ispmd == 0) THEN
1656C-----usr_id not important but unique ---------
1657 DO i=1,numsking
1658 ipartskin_p(i) = ixskin_p(1,i)
1659 ixskin_p(nixskin,i) = i
1660 ENDDO
1661 CALL startime(timers,macro_timer_libh3d)
1662C
1663 CALL c_h3d_create_skins(itab_p,numnodg,ipart,lipart1,h3d_data%PARTS(1)%PART,
1664 . ixskin_p,nixskin,numsking,ipartskin_p)
1665 CALL stoptime(timers,macro_timer_libh3d)
1666 ENDIF
1667 ENDIF
1668C
1669c**********************************************************************************************
1670C CREATE NODAL DISPLACEMENT DATAS
1671C**********************************************************************************************
1672 IF(ispmd==0.AND. h3d_data%IH3D == 1) THEN
1673 CALL startime(timers,macro_timer_libh3d)
1674 CALL c_h3d_create_displacement_datatype()
1675 CALL stoptime(timers,macro_timer_libh3d)
1676 ENDIF
1677C
1678c**********************************************************************************************
1679C CREATE RESULTS DATAS
1680C**********************************************************************************************
1681 IF(ispmd==0.AND. ( h3d_data%IH3D_RUN == 1)) THEN
1682 CALL startime(timers,macro_timer_libh3d)
1683 CALL h3d_create_datatype(h3d_data,ipari)
1684C
1685c**********************************************************************************************
1686C FINALIZE FORMAT
1687C**********************************************************************************************
1688 CALL c_h3d_create_results_end()
1689 CALL stoptime(timers,macro_timer_libh3d)
1690
1691 ENDIF
1692C
1693c**********************************************************************************************
1694C UPDATE NODES DISPLACEMENTS
1695c**********************************************************************************************
1696c
1697 IF(nrwall>0) THEN
1698
1699 CALL scanor(x,d,cdg,xmin,ymin,zmin,xmax,ymax,zmax,scale,
1700 . weight)
1701C
1702
1703 CALL h3d_dxyz_rwall_update(
1704 2 nstrf,rwbuf,nprw ,d,xmin,
1705 3 ymin,zmin,xmax,ymax,zmax,
1706 4 fr_sec,fr_wall,weight,itab,
1707 5 xwl ,ywl , zwl, v1, v2, v3, vv1, vv2, vv3)
1708 ENDIF
1709c
1710 h3dtitle = ' '
1711 len_h3dtitle = 0
1712 IF (h3d_data%N_TITLE /= 0) THEN
1713 DO i=1,h3d_data%N_TITLE
1714 IF(h3d_data%ITITLE(i) == h3d_data%IH3D) THEN
1715 h3dtitle = h3d_data%TITLE(i)
1716 len_h3dtitle = len_trim(h3d_data%TITLE(i))
1717 ENDIF
1718 ENDDO
1719 ENDIF
1720c
1721 IF(nspmd > 1 .AND. ispmd==0)THEN
1722 CALL startime(timers,macro_timer_libh3d)
1723 CALL c_h3d_update_nodes(h3dtitle,len_h3dtitle,tt,h3d_data%IH3D,
1724 . itab_p,numnodg,d_p, nrwall, user_nod_id%RWALL_SHIFT,
1725 . xwl ,ywl , zwl, v1, v2,
1726 . v3, vv1, vv2, vv3,kxsp_p,
1727 . nisp,numsphg,tagnod_p,nprw)
1728 CALL stoptime(timers,macro_timer_libh3d)
1729 ELSEIF(ispmd==0 )THEN
1730 CALL startime(timers,macro_timer_libh3d)
1731 CALL c_h3d_update_nodes(h3dtitle,len_h3dtitle,tt,h3d_data%IH3D,
1732 . itab,numnod,d, nrwall, user_nod_id%RWALL_SHIFT,
1733 . xwl ,ywl , zwl, v1, v2,
1734 . v3, vv1, vv2, vv3,kxsp_p,
1735 . nisp,numsphg,tagnod_p,nprw)
1736 CALL stoptime(timers,macro_timer_libh3d)
1737 ENDIF
1738
1739 !VIRTUAL NODES
1740 ! FVMBAGS
1741 IF(nfvbag > 0 .AND. ispmd==0)THEN
1742 CALL startime(timers,macro_timer_libh3d)
1743 CALL h3d_update_fvmbag_centroids(h3dtitle,len_h3dtitle,h3d_data%IH3D,monvol,volmon, nfvbag, smonvol, svolmon,
1744 . fvdata_p, user_nod_id%FVMBAG_SHIFT)
1745 CALL stoptime(timers,macro_timer_libh3d)
1746 ENDIF
1747c
1748c**********************************************************************************************
1749C OUTPUT RESULTS
1750c**********************************************************************************************
1751 DEALLOCATE(d_p)
1752
1753 ALLOCATE(nodal_scalar(numnod))
1754 ALLOCATE(nodal_vector(3*numnod))
1755 ALLOCATE(nodal_tensor(6*numnod))
1756 ALLOCATE(node_id(numnod))
1757 ALLOCATE(is_writen_node(numnod))
1758 is_writen_node(1:numnod) = 0
1759
1760 IF(ispmd == 0)THEN
1761 ALLOCATE(nodal_scalar_fvm(airbags_total_fvm_in_h3d_g))
1762 ALLOCATE(nodal_vector_fvm(3*airbags_total_fvm_in_h3d_g))
1763 ALLOCATE(node_id_fvm(airbags_total_fvm_in_h3d_g))
1764 ALLOCATE(is_writen_node_fvm(airbags_total_fvm_in_h3d_g))
1765 is_writen_node_fvm(1:airbags_total_fvm_in_h3d_g) = 0
1766 ELSE
1767 ALLOCATE(nodal_scalar_fvm(1))
1768 ALLOCATE(nodal_vector_fvm(3*1))
1769 ALLOCATE(node_id_fvm(1))
1770 ALLOCATE(is_writen_node_fvm(1))
1771 is_writen_node_fvm(1:1) = 0
1772 ENDIF
1773
1774c
1775 IF (ispmd == 0 )THEN
1776 ALLOCATE(is_writen_node_p(numnodg))
1777 ALLOCATE(nodal_scalar_p(numnodg))
1778 ALLOCATE(nodal_vector_p(3*numnodg))
1779 ALLOCATE(nodal_tensor_p(6*numnodg))
1780 ALLOCATE(node_id_p(numnodg))
1781 is_writen_node_p(1:numnodg) = 0
1782 ELSE
1783 ALLOCATE(is_writen_node_p(1))
1784 ALLOCATE(nodal_scalar_p(1))
1785 ALLOCATE(nodal_vector_p(1))
1786 ALLOCATE(nodal_tensor_p(1))
1787 ALLOCATE(node_id_p(1))
1788 is_writen_node_p(1) = 0
1789 ENDIF
1790c
1791c
1792 ALLOCATE(oned_scalar(numelr+numelp+numelt))
1793 ALLOCATE(oned_vector(3*(numelr+numelp+numelt)))
1794 ALLOCATE(oned_tensor(6*(numelr+numelp+numelt)))
1795 ALLOCATE(oned_torsor(9*(numelr+numelp+numelt)))
1796 ALLOCATE(oned_id(numelrg+numelpg+numeltrg))
1797 ALLOCATE(oned_ity(numelrg+numelpg+numeltrg))
1798 ALLOCATE(is_writen_oned(numelrg+numelpg+numeltrg))
1799 oned_id(1:numelr+numelp+numelt) = 0
1800 oned_ity(1:numelr+numelp+numelt) = 0
1801 is_writen_oned(1:numelr+numelp+numelt) = 0
1802c
1803 IF (ispmd == 0 )THEN
1804 ALLOCATE(oned_scalar_p(numelrg+numelpg+numeltrg))
1805 ALLOCATE(oned_vector_p(3*(numelrg+numelpg+numeltrg)))
1806 ALLOCATE(oned_tensor_p(6*(numelrg+numelpg+numeltrg)))
1807 ALLOCATE(oned_torsor_p(9*(numelrg+numelpg+numeltrg)))
1808 ALLOCATE(oned_id_p(numelrg+numelpg+numeltrg))
1809 ALLOCATE(oned_ity_p(numelrg+numelpg+numeltrg))
1810 ALLOCATE(is_writen_oned_p(numelrg+numelpg+numeltrg))
1811 is_writen_oned_p(1:numelrg+numelpg+numeltrg) = 0
1812 ELSE
1813 ALLOCATE(oned_scalar_p(1))
1814 ALLOCATE(oned_vector_p(1))
1815 ALLOCATE(oned_tensor_p(1))
1816 ALLOCATE(oned_torsor_p(1))
1817 ALLOCATE(oned_id_p(1))
1818 ALLOCATE(oned_ity_p(1))
1819 ALLOCATE(is_writen_oned_p(1))
1820 is_writen_oned_p(1) = 0
1821 ENDIF
1822c
1823c
1824 ALLOCATE(shell_scalar(numelc+numeltg))
1825 ALLOCATE(shell_stack(max_shell_stacksize))
1826 ALLOCATE(shell_stack_p(numelcg+numeltgg))
1827 ALLOCATE(shell_vector(3*(numelc+numeltg)))
1828 ALLOCATE(shell_tensor(3*(numelc+numeltg)))
1829 ALLOCATE(shell_id(numelc+numeltg))
1830 ALLOCATE(shell_ity(numelc+numeltg))
1831 ALLOCATE(is_writen_shell(numelc+numeltg))
1832 shell_id(1:numelc+numeltg) = 0
1833 shell_ity(1:numelc+numeltg) = 0
1834 is_writen_shell(1:numelc+numeltg) = 0
1835c
1836 IF (ispmd == 0 )THEN
1837 ALLOCATE(shell_scalar_p(numelcg+numeltgg))
1838 ALLOCATE(shell_vector_p(3*(numelcg+numeltgg)))
1839 ALLOCATE(shell_tensor_p(3*(numelcg+numeltgg)))
1840 ALLOCATE(shell_id_p(numelcg+numeltgg))
1841 ALLOCATE(shell_ity_p(numelcg+numeltgg))
1842 ALLOCATE(is_writen_shell_p(numelcg+numeltgg))
1843 is_writen_shell_p(1:numelcg+numeltgg) = 0
1844 ELSE
1845 ALLOCATE(shell_scalar_p(1))
1846 ALLOCATE(shell_vector_p(1))
1847 ALLOCATE(shell_tensor_p(1))
1848 ALLOCATE(shell_id_p(1))
1849 ALLOCATE(shell_ity_p(1))
1850 ALLOCATE(is_writen_shell_p(1))
1851 is_writen_shell_p(1) = 0
1852 ENDIF
1853c
1854c-------not available now with S16,S20
1855 max_ncorn = 10
1856 ALLOCATE(solid_scalar(numels))
1857 ALLOCATE(solid_vector(3*numels))
1858 ALLOCATE(solid_tensor(6*numels))
1859 ALLOCATE(solid_tensor_corner(6*numels*max_ncorn))
1860 ALLOCATE(solid_id(numels))
1861 ALLOCATE(isolnod(numels))
1862 ALLOCATE(solid_ity(numels))
1863 ALLOCATE(is_writen_solid(numels))
1864 solid_id(1:numels) = 0
1865 isolnod(1:numels) = 0
1866 solid_ity(1:numels) = 0
1867 is_writen_solid(1:numels) = 0
1868c
1869 IF (ispmd == 0 )THEN
1870 ALLOCATE(solid_scalar_p(numelsg))
1871 ALLOCATE(solid_vector_p(3*numelsg))
1872 ALLOCATE(solid_tensor_p(6*numelsg))
1873 ALLOCATE(solid_tensor_corner_p(6*numelsg*max_ncorn))
1874 ALLOCATE(solid_id_p(numelsg))
1875 ALLOCATE(solid_ity_p(numelsg))
1876 ALLOCATE(isolnod_p(numelsg))
1877 ALLOCATE(is_writen_solid_p(numelsg))
1878 is_writen_solid_p(1:numelsg) = 0
1879 ELSE
1880 ALLOCATE(solid_scalar_p(1))
1881 ALLOCATE(solid_vector_p(1))
1882 ALLOCATE(solid_tensor_p(1))
1883 ALLOCATE(solid_tensor_corner_p(1))
1884 ALLOCATE(solid_id_p(1))
1885 ALLOCATE(solid_ity_p(1))
1886 ALLOCATE(isolnod_p(1))
1887 ALLOCATE(is_writen_solid_p(1))
1888 is_writen_solid_p(1) = 0
1889 ENDIF
1890c
1891c
1892 ALLOCATE(sph_scalar(numsph))
1893 ALLOCATE(sph_tensor(6*numsph))
1894 ALLOCATE(sph_id(numsph))
1895 ALLOCATE(is_writen_sph(numsph))
1896 sph_id(1:numsph) = 0
1897 is_writen_sph(1:numsph) = 0
1898c
1899 IF (ispmd == 0 )THEN
1900 ALLOCATE(sph_scalar_p(numsphg))
1901 ALLOCATE(sph_tensor_p(6*numsphg))
1902 ALLOCATE(sph_id_p(numsphg))
1903 ALLOCATE(is_writen_sph_p(numsphg))
1904 is_writen_sph_p(1:numsphg) = 0
1905 ELSE
1906 ALLOCATE(sph_scalar_p(1))
1907 ALLOCATE(sph_tensor_p(1))
1908 ALLOCATE(sph_id_p(1))
1909 ALLOCATE(is_writen_sph_p(1))
1910 is_writen_sph_p(1) = 0
1911 ENDIF
1912c
1913c
1914 ALLOCATE(quad_scalar(numelq))
1915 ALLOCATE(quad_vector(3*numelq))
1916 ALLOCATE(quad_tensor(6*numelq))
1917 ALLOCATE(quad_id(numelq))
1918 ALLOCATE(is_writen_quad(numelq))
1919 quad_id(1:numelq) = 0
1920 is_writen_quad(1:numelq) = 0
1921c
1922 IF (ispmd == 0 )THEN
1923 ALLOCATE(quad_scalar_p(numelqg))
1924 ALLOCATE(quad_vector_p(3*numelqg))
1925 ALLOCATE(quad_tensor_p(6*numelqg))
1926 ALLOCATE(quad_id_p(numelqg))
1927 ALLOCATE(is_writen_quad_p(numelqg))
1928 is_writen_quad_p(1:numelqg) = 0
1929 ELSE
1930 ALLOCATE(quad_scalar_p(1))
1931 ALLOCATE(quad_vector_p(1))
1932 ALLOCATE(quad_tensor_p(1))
1933 ALLOCATE(quad_id_p(1))
1934 ALLOCATE(is_writen_quad_p(1))
1935 is_writen_quad_p(1) = 0
1936 ENDIF
1937c-------- for skin : only SKIN_ID_P (user id): unique
1938 ALLOCATE(skin_tensor(3*numskin))
1939 ALLOCATE(skin_vector(3*numskin))
1940 ALLOCATE(skin_scalar(numskin))
1941 ALLOCATE(is_writen_skin(numskin))
1942 is_writen_skin(1:numskin) = 0
1943c
1944 IF (ispmd == 0 )THEN
1945 ALLOCATE(skin_tensor_p(3*numsking))
1946 ALLOCATE(skin_vector_p(3*numsking))
1947 ALLOCATE(skin_scalar_p(numsking))
1948 ALLOCATE(skin_id_p(numsking))
1949 ALLOCATE(is_writen_skin_p(numsking))
1950 is_writen_skin_p(1:numsking) = 0
1951 ELSE
1952 ALLOCATE(skin_tensor_p(1))
1953 ALLOCATE(skin_vector_p(1))
1954 ALLOCATE(skin_scalar_p(1))
1955 ALLOCATE(skin_id_p(1))
1956 ALLOCATE(is_writen_skin_p(1))
1957 is_writen_skin_p(1) = 0
1958 ENDIF
1959
1960 n_outp_data = 0
1961C-----------------------------------------------
1962C UPDATE ELEMENTS OFF
1963C-----------------------------------------------
1964c
1965 CALL h3d_shell_off(
1966 . elbuf_tab ,iparg ,ixc, ixtg,numelc,shell_scalar, shell_id, shell_ity,
1967 . ipart, ipartc ,iparttg)
1968c
1969 IF (nspmd > 1 ) THEN
1970 CALL startime(timers,macro_timer_spmdh3d)
1971 CALL spmd_h3d_gather_i(shell_id,numelc+numeltg,shell_id_p,numelcg+numeltgg)
1972 CALL spmd_h3d_gather_i(shell_ity,numelc+numeltg,shell_ity_p,numelcg+numeltgg)
1973 CALL spmd_h3d_gather_r(shell_scalar,numelc+numeltg,shell_scalar_p,numelcg+numeltgg)
1974
1975 ! Gather number of Shell & Triangle elements per processor
1976 ! Permits to compute an Offset for H3D Scalar values
1977 CALL spmd_gather_int(numelc+numeltg,tmp_offsets,it_spmd(1),1,nspmd)
1978 IF (ispmd == 0) THEN
1979 sh_tria_spmd_offsets(1) = 0
1980 DO i=2,nspmd+1
1981 sh_tria_spmd_offsets(i) = sh_tria_spmd_offsets(i-1) + tmp_offsets(i-1)
1982 ENDDO
1983 ENDIF
1984 ! --------------------------------------------------------------------------
1985 CALL stoptime(timers,macro_timer_spmdh3d)
1986 ELSE
1987 shell_id_p(1:numelc+numeltg) = shell_id(1:numelc+numeltg)
1988 shell_ity_p(1:numelc+numeltg) = shell_ity(1:numelc+numeltg)
1989 shell_scalar_p(1:numelc+numeltg) = shell_scalar(1:numelc+numeltg)
1990 ENDIF
1991c
1992 IF(ispmd == 0) THEN
1993 CALL startime(timers,macro_timer_libh3d)
1994 CALL c_h3d_eroded_shell(tt,h3d_data%IH3D,itab,numnod,ixc_p,
1995 . nixc,numelcg,ipartc,ixtg,nixtg,
1996 . numeltgg,iparttg,shell_scalar_p,shell_id_p,
1997 . h3d_data%N_OUTP_H3D+3,shell_ity_p,numels,
1998 . numelq,numelt,numelp,numelr)
1999 CALL stoptime(timers,macro_timer_libh3d)
2000 ENDIF
2001c
2002 CALL h3d_solid_off(
2003 . elbuf_tab ,iparg ,ixs ,solid_scalar, solid_id, solid_ity, isolnod)
2004c
2005 IF (nspmd > 1 ) THEN
2006 CALL startime(timers,macro_timer_spmdh3d)
2007 CALL spmd_h3d_gather_i(solid_id,numels,solid_id_p,numelsg)
2008 CALL spmd_h3d_gather_i(solid_ity,numels,solid_ity_p,numelsg)
2009 CALL spmd_h3d_gather_r(solid_scalar,numels,solid_scalar_p,numelsg)
2010 CALL spmd_h3d_gather_i(isolnod,numels,isolnod_p,numelsg)
2011 CALL stoptime(timers,macro_timer_spmdh3d)
2012 ELSE
2013 solid_id_p(1:numels) = solid_id(1:numels)
2014 solid_ity_p(1:numels) = solid_ity(1:numels)
2015 solid_scalar_p(1:numels) = solid_scalar(1:numels)
2016 isolnod_p(1:numels) = isolnod(1:numels)
2017 ENDIF
2018c
2019 IF(ispmd == 0) THEN
2020 CALL startime(timers,macro_timer_libh3d)
2021 CALL c_h3d_eroded_solid(tt,h3d_data%IH3D,itab,numnod,ixs_p,
2022 . nixs,numelsg,iparts,solid_scalar_p,solid_id_p,
2023 . h3d_data%N_OUTP_H3D+4,solid_ity_p,
2024 . numelq,numelt,numelp,numelr)
2025 CALL stoptime(timers,macro_timer_libh3d)
2026
2027 ENDIF
2028c
2029 CALL h3d_oned_off(
2030 . elbuf_tab ,iparg ,ixt, ixp, ixr ,oned_scalar, oned_id, oned_ity,
2031 . ipart , ipartt ,ipartp ,ipartr)
2032c
2033 IF (nspmd > 1 ) THEN
2034 CALL startime(timers,macro_timer_spmdh3d)
2035 CALL spmd_h3d_gather_i(oned_id,numelt+numelp+numelr,oned_id_p,numeltrg+numelpg+numelrg)
2036 CALL spmd_h3d_gather_i(oned_ity,numelt+numelp+numelr,oned_ity_p,numeltrg+numelpg+numelrg)
2037 CALL spmd_h3d_gather_r(oned_scalar,numelt+numelp+numelr,oned_scalar_p,numeltrg+numelpg+numelrg)
2038 CALL stoptime(timers,macro_timer_spmdh3d)
2039 ELSE
2040 oned_id_p(1:numelt+numelp+numelr) = oned_id(1:numelt+numelp+numelr)
2041 oned_ity_p(1:numelt+numelp+numelr) = oned_ity(1:numelt+numelp+numelr)
2042 oned_scalar_p(1:numelt+numelp+numelr) = oned_scalar(1:numelt+numelp+numelr)
2043 ENDIF
2044c
2045 IF(ispmd == 0) THEN
2046 CALL startime(timers,macro_timer_libh3d)
2047 CALL c_h3d_eroded_oned(tt,h3d_data%IH3D,itab,numnod,ixt_p,
2048 . nixt,numeltrg,ipartt,ixp_p,nixp,
2049 . numelpg,ipartp,ixr_p,nixr,numelrg,
2050 . ipartr,oned_scalar_p,oned_id_p,h3d_data%N_OUTP_H3D+5,oned_ity_p)
2051 CALL stoptime(timers,macro_timer_libh3d)
2052
2053 ENDIF
2054c
2055 CALL h3d_sph_off(
2056 . elbuf_tab ,iparg ,kxsp ,sph_scalar, sph_id)
2057c
2058 IF (nspmd > 1 ) THEN
2059 CALL startime(timers,macro_timer_spmdh3d)
2060 CALL spmd_h3d_gather_i(sph_id,numsph,sph_id_p,numsphg)
2061 CALL spmd_h3d_gather_r(sph_scalar,numsph,sph_scalar_p,numsphg)
2062 CALL stoptime(timers,macro_timer_spmdh3d)
2063 ELSE
2064 sph_id_p(1:numsph) = sph_id(1:numsph)
2065 sph_scalar_p(1:numsph) = sph_scalar(1:numsph)
2066 ENDIF
2067c
2068 IF(ispmd == 0) THEN
2069 CALL startime(timers,macro_timer_libh3d)
2070 CALL c_h3d_eroded_sph(tt,h3d_data%IH3D,numsphg,sph_scalar_p,sph_id_p,
2071 . h3d_data%N_OUTP_H3D+6)
2072 CALL stoptime(timers,macro_timer_libh3d)
2073
2074 ENDIF
2075c
2076 CALL h3d_quad_off(
2077 . elbuf_tab ,iparg ,ixq,quad_scalar, quad_id,
2078 . ipart ,ipartq)
2079c
2080 IF (nspmd > 1 ) THEN
2081 CALL startime(timers,macro_timer_spmdh3d)
2082 CALL spmd_h3d_gather_i(quad_id,numelq,quad_id_p,numelq)
2083 CALL spmd_h3d_gather_r(quad_scalar,numelq,quad_scalar_p,numelq)
2084 CALL stoptime(timers,macro_timer_spmdh3d)
2085 ELSE
2086 quad_id_p(1:numelq) = quad_id(1:numelq)
2087 quad_scalar_p(1:numelq) = quad_scalar(1:numelq)
2088 ENDIF
2089c
2090 IF(ispmd == 0) THEN
2091 CALL startime(timers,macro_timer_libh3d)
2092 CALL c_h3d_eroded_quad(tt,h3d_data%IH3D,itab,numnod,ixq_p,
2093 . nixq,numelqg,ipartq,quad_scalar_p,quad_id_p,
2094 . h3d_data%N_OUTP_H3D+7)
2095 CALL stoptime(timers,macro_timer_libh3d)
2096 ENDIF
2097C
2098 CALL h3d_skin_off(elbuf_tab,iparg,ixs,ixs10,tag_skins6,skin_scalar)
2099 IF (nspmd > 1 ) THEN
2100 CALL startime(timers,macro_timer_spmdh3d)
2101 CALL spmd_h3d_gather_r(skin_scalar,numskin,skin_scalar_p,numsking)
2102 CALL stoptime(timers,macro_timer_spmdh3d)
2103 ELSE
2104 skin_scalar_p(1:numskin) = skin_scalar(1:numskin)
2105 ENDIF
2106c
2107 IF(ispmd == 0) THEN
2108 DO ii=1,numsking
2109 skin_id_p(ii) = ii
2110 ENDDO
2111 CALL startime(timers,macro_timer_libh3d)
2112 CALL c_h3d_eroded_skin(tt,h3d_data%IH3D,itab,numnod,skin_scalar_p,skin_id_p,
2113 . h3d_data%N_OUTP_H3D+8,numsking)
2114 CALL stoptime(timers,macro_timer_libh3d)
2115 ENDIF
2116C-----------------------------------------------
2117C UPDATE RESULTS VALUES
2118C-----------------------------------------------
2119c
2120 DO i = 1,h3d_data%N_OUTP_H3D
2121c-----
2122c nodal scalar
2123c-----
2124 IF(h3d_data%OUTPUT_LIST(i)%OK /= 0 .AND. h3d_data%OUTPUT_LIST(i)%ETYPE == 1 .AND.
2125 . h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 1)THEN
2126
2127 ifunc = h3d_data%OUTPUT_LIST(i)%ID
2128 inter_input = h3d_data%OUTPUT_LIST(i)%INTER
2129 info1 = h3d_data%OUTPUT_LIST(i)%INFO1
2130 info2 = h3d_data%OUTPUT_LIST(i)%INFO2
2131 keyword = h3d_data%OUTPUT_LIST(i)%KEYWORD
2132 n_outp_data = h3d_data%OUTPUT_LIST(i)%N_OUTP
2133 n_h3d_part_list = h3d_data%OUTPUT_LIST(i)%N_H3D_PART_LIST
2134 interskid = 0
2135 IF(keyword == 'SKID_LINE')THEN
2136 DO ni=1,ninter
2137 IF(ni == inter_input ) THEN
2138 interskid = h3d_data%N_SKID_INTER (ni)
2139 ityskid = ipari(7,ni)
2140 EXIT
2141 ENDIF
2142 ENDDO
2143 ENDIF
2144 interfric = 0
2145 IF(keyword == 'CSE_FRIC')THEN
2146 DO ni=1,ninter
2147 IF(ni == inter_input ) THEN
2148 interfric = h3d_data%N_CSE_FRIC_INTER (ni)
2149 EXIT
2150 ENDIF
2151 ENDDO
2152 ENDIF
2153c IF(ISPMD == 0) print *,'nodal scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2154
2155c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2156
2157 CALL h3d_nodal_scalar(
2158 . elbuf_tab ,nodal_scalar ,ifunc ,iparg ,geo ,
2159 . mas ,pm ,anin ,itab ,node_id ,
2160 . info1 ,info2 ,is_writen_node ,h3d_data%OUTPUT_LIST(i)%PART ,ipartc ,
2161 . iparttg ,ixc ,ixtg ,temp ,iflow ,
2162 . rflow ,ixs ,ixq ,nv46 ,monvol ,
2163 . volmon ,ale_connect ,diag_sms ,ms ,pdama2 ,
2164 . x ,stifr ,stifn ,keyword ,h3d_data ,
2165 . npby ,rby ,interskid ,h3d_data%N_SCAL_SKID ,pskids ,
2166 . nodglob ,ityskid ,ipartsp ,ipartr ,ipartp ,
2167 . ipartt ,iparts ,ipartq ,kxsp ,ixr ,
2168 . ixp ,ixt ,n_h3d_part_list,interfric ,csefric ,
2169 . csefricg ,csefric_stamp ,csefricg_stamp ,nodal_scalar_fvm ,airbags_total_fvm_in_h3d_g,
2170 . is_writen_node_fvm,ispmd ,fvdata_p ,user_nod_id%FVMBAG_SHIFT ,multi_fvm ,
2171 . glob_therm%ITHERM_FE, nfvbag)
2172
2173c
2174 IF (nspmd > 1 ) THEN
2175 CALL startime(timers,macro_timer_spmdh3d)
2176
2177 IF(keyword == 'SKID_LINE')THEN
2178 CALL spmd_outpitab(node_id,weight,nodglob,node_id_p)
2179 CALL spmd_outpitab(is_writen_node,weight,nodglob,is_writen_node_p)
2180 IF(ityskid== 21) THEN
2181 CALL spmd_h3d_max_r_nodal_value_21(nodglob,nodal_scalar_p,numnodg,pskids,
2182 . interskid,h3d_data%N_SCAL_SKID)
2183 ELSE
2184 CALL spmd_h3d_max_r_nodal_value(nodglob,nodal_scalar,numnod,nodal_scalar_p,numnodg)
2185 ENDIF
2186 ELSEIF(keyword == 'CSE_FRIC'.AND.interfric > 0)THEN
2187 CALL spmd_outpitab(node_id,weight,nodglob,node_id_p)
2188 CALL spmd_outpitab(is_writen_node,weight,nodglob,is_writen_node_p)
2189 IF(interfric <= ninefric ) THEN
2190 CALL spmd_h3d_sum_r_nodal_value(nodglob,nodal_scalar,numnod,nodal_scalar_p,numnodg)
2191 ELSE
2192 IF(ispmd == 0) THEN
2193 nodal_scalar_p(1:numnodg) =csefric_stamp(interfric-ninefric,1:numnodg)
2194 ENDIF
2195 ENDIF
2196 ELSEIF((keyword == 'CSE_FRIC'.AND.interfric == 0).OR.keyword == 'CSE_FRICG')THEN
2197 CALL spmd_outpitab(node_id,weight,nodglob,node_id_p)
2198 CALL spmd_outpitab(is_writen_node,weight,nodglob,is_writen_node_p)
2199 IF(nintstamp==0) THEN
2200 CALL spmd_h3d_sum_r_nodal_value(nodglob,nodal_scalar,numnod,nodal_scalar_p,numnodg)
2201 ELSE
2202 CALL spmd_h3d_sum_r_nodal_value(nodglob,nodal_scalar,numnod,nodal_scalar_p,numnodg)
2203 IF(ispmd == 0) THEN
2204 nodal_scalar_p(1:numnodg) =nodal_scalar_p(1:numnodg) + csefricg_stamp(1:numnodg)
2205 ENDIF
2206 ENDIF
2207 ELSE
2208 CALL spmd_h3d_gather_i_node(weight,node_id,numnod,node_id_p,numnodg)
2209 CALL spmd_h3d_gather_i_node(weight,is_writen_node,numnod,is_writen_node_p,numnodg)
2210 CALL spmd_h3d_gather_r_nodal_value(weight,nodal_scalar,numnod,nodal_scalar_p,numnodg)
2211 ENDIF
2212 CALL stoptime(timers,macro_timer_spmdh3d)
2213 ELSE
2214 node_id_p(1:numnod) = node_id(1:numnod)
2215 is_writen_node_p(1:numnod) = is_writen_node(1:numnod)
2216 nodal_scalar_p(1:numnod) = nodal_scalar(1:numnod)
2217 ENDIF
2218c
2219 ! nodal scalar for /NODE entities
2220 IF(ispmd == 0) THEN
2221 CALL startime(timers,macro_timer_libh3d)
2222 CALL c_h3d_update_nodal_scalar(tt,h3d_data%IH3D,itab,numnodg,nodal_scalar_p,node_id_p,
2223 . n_outp_data,is_writen_node_p)
2224 CALL stoptime(timers,macro_timer_libh3d)
2225
2226 ENDIF
2227
2228 ! nodal scalar for virtual nodes (FVM centroids)
2229 IF(ispmd == 0) THEN
2230 IF(airbags_total_fvm_in_h3d_g > 0)THEN
2231 DO j=1,airbags_total_fvm_in_h3d_g
2232 node_id_fvm(j) = user_nod_id%FVMBAG_SHIFT + j
2233 ENDDO
2234 CALL startime(timers,macro_timer_libh3d)
2235 CALL c_h3d_update_nodal_fvmbag_scalar(tt,h3d_data%IH3D,airbags_total_fvm_in_h3d_g,nodal_scalar_fvm,node_id_fvm,
2236 . n_outp_data,is_writen_node_fvm)
2237 CALL stoptime(timers,macro_timer_libh3d)
2238 ENDIF
2239 ENDIF
2240
2241c-----
2242c nodal vector
2243c-----
2244 ELSEIF(h3d_data%OUTPUT_LIST(i)%OK /= 0 .AND. h3d_data%OUTPUT_LIST(i)%ETYPE == 1 .AND.
2245 . h3d_data%OUTPUT_LIST(i)%OUTP_TYPE == 2)THEN
2246c
2247 ifunc = h3d_data%OUTPUT_LIST(i)%ID
2248 info1 = h3d_data%OUTPUT_LIST(i)%INFO1
2249 info2 = h3d_data%OUTPUT_LIST(i)%INFO2
2250 n_outp_data = h3d_data%OUTPUT_LIST(i)%N_OUTP
2251 keyword = h3d_data%OUTPUT_LIST(i)%KEYWORD
2252 n_h3d_part_list = h3d_data%OUTPUT_LIST(i)%N_H3D_PART_LIST
2253c IF(ISPMD == 0) print *,'nodal vector',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2254
2255c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2256
2257 CALL h3d_nodal_vector(
2258 . elbuf_tab ,nodal_vector , ifunc ,iparg ,geo ,
2259 . mas ,pm , anin ,itab ,node_id ,
2260 . info1 ,info2 , is_writen_node,h3d_data%OUTPUT_LIST(i)%PART,
2261 . ipartc ,
2262 . iparttg ,ixc , ixtg ,temp ,iflow ,
2263 . rflow ,ixs , ixq ,nv46 ,monvol ,
2264 . diag_sms ,ms , pdama2 ,x ,volmon ,
2265 . stifr ,stifn , a ,d ,v ,
2266 . cont ,fcontg , fint ,fext ,keyword ,
2267 . fncont ,fncontg , ftcont ,ftcontg ,fncont2 ,
2268 . dr ,dxancg , fanreac ,fcluster ,mcluster ,
2269 . vr ,fopt , npby ,vgaz ,
2270 . ipari ,igrnod , weight ,nodglob ,fcont_max ,
2271 . fncontp2 ,ftcontp2 , ar ,ipartsp ,ipartr ,
2272 . ipartp ,ipartt , iparts ,ipartq ,kxsp ,
2273 . ixr ,ixp , ixt ,n_h3d_part_list ,
2274 . nodal_vector_fvm,
2275 . is_writen_node_fvm,airbags_total_fvm_in_h3d_g,smonvol ,svolmon ,ispmd ,
2276 . fvdata_p ,user_nod_id%FVMBAG_SHIFT ,w ,sw ,x_c )
2277
2278c
2279 IF (nspmd > 1 ) THEN
2280 IF(keyword == 'CONT'.OR.keyword == 'PCONT/NORMAL'.OR.keyword == 'pcont/tangent.OR.'KEYWORD == 'fext'
2281.OR. . (KEYWORD == 'cont2.OR.'KEYWORD == 'pcont2/normal.OR.'KEYWORD == 'pcont2/tangent')
2282.OR. . (KEYWORD == 'cont2/moment')) THEN
2283 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2284 CALL SPMD_OUTPITAB(NODE_ID,WEIGHT,NODGLOB,NODE_ID_P)
2285 CALL SPMD_OUTPITAB(IS_WRITEN_NODE,WEIGHT,NODGLOB,IS_WRITEN_NODE_P)
2286.OR. IF(NINTSTAMP==0KEYWORD == 'cont2.OR.'KEYWORD == 'pcont2/normal.OR.'KEYWORD == 'pcont2/normal'
2287.OR. . KEYWORD == 'pcont2/tangent.OR.'KEYWORD == 'fext') THEN
2288 CALL SPMD_H3D_SUM_R_NODAL(NODGLOB,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG)
2289 ELSEIF(KEYWORD == 'cont')THEN
2290 CALL SPMD_H3D_SUM_R_NODAL_21(NODGLOB,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG,FCONTG)
2291 ELSEIF(KEYWORD == 'pcont/normal')THEN
2292 CALL SPMD_H3D_SUM_R_NODAL_21(NODGLOB,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG,FNCONTG)
2293 ELSEIF(KEYWORD == 'pcont/tangent')THEN
2294 CALL SPMD_H3D_SUM_R_NODAL_21(NODGLOB,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG,FTCONTG)
2295 ELSEIF(KEYWORD == 'cont2/moment')THEN
2296 CALL SPMD_H3D_SUM_R_NODAL_21(NODGLOB,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG,MCONT2)
2297 ENDIF
2298 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2299
2300.AND. ELSEIF(NINTSTAMP/=0((KEYWORD == 'cont/tmax.OR.')(KEYWORD == 'maxpcont/normal.OR.')
2301 . (KEYWORD == 'maxpcont/tangent'))) THEN
2302 IF(KEYWORD == 'cont/tmax')THEN
2303 IF(ISPMD == 0) THEN
2304 NODAL_VECTOR_P(1:3*NUMNODG) =FCONT_MAX(1:3*NUMNODG)
2305 ENDIF
2306 ELSEIF(KEYWORD == 'maxpcont/normal')THEN
2307 IF(ISPMD == 0) THEN
2308 NODAL_VECTOR_P(1:3*NUMNODG) =FNCONT_MAX(1:3*NUMNODG)
2309 ENDIF
2310 ELSEIF(KEYWORD == 'maxpcont/tangent')THEN
2311 IF(ISPMD == 0) THEN
2312 NODAL_VECTOR_P(1:3*NUMNODG) =FTCONT_MAX(1:3*NUMNODG)
2313 ENDIF
2314 ENDIF
2315
2316 ELSE
2317 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2318 CALL SPMD_H3D_GATHER_I_NODE(WEIGHT,NODE_ID,NUMNOD,NODE_ID_P,NUMNODG)
2319 CALL SPMD_H3D_GATHER_I_NODE(WEIGHT,IS_WRITEN_NODE,NUMNOD,IS_WRITEN_NODE_P,NUMNODG)
2320 CALL SPMD_H3D_GATHER_R_NODE(WEIGHT,NODAL_VECTOR,3*NUMNOD,NODAL_VECTOR_P,3*NUMNODG)
2321 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2322 ENDIF
2323
2324 ELSE
2325
2326 NODE_ID_P(1:NUMNOD) = NODE_ID(1:NUMNOD)
2327 IS_WRITEN_NODE_P(1:NUMNOD) = IS_WRITEN_NODE(1:NUMNOD)
2328 NODAL_VECTOR_P(1:3*NUMNOD) = NODAL_VECTOR(1:3*NUMNOD)
2329
2330 ENDIF
2331c
2332 ! vector update for /NODE entities
2333 IF(ISPMD == 0) THEN
2334 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2335 CALL C_H3D_UPDATE_NODAL_VECTOR(TT,H3D_DATA%IH3D,ITAB,NUMNODG,NODAL_VECTOR_P,NODE_ID_P,
2336 . N_OUTP_DATA,IS_WRITEN_NODE_P)
2337 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2338
2339 ENDIF
2340
2341 ! vector update for virtual entities (FVMBAG polyhedron centroids)
2342.AND. IF(ISPMD == 0 AIRBAGS_TOTAL_FVM_IN_H3D_G > 0) THEN
2343 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2344 DO J=1,AIRBAGS_TOTAL_FVM_IN_H3D_G
2345 NODE_ID_FVM(J) = USER_NOD_ID%FVMBAG_SHIFT + J
2346 ENDDO
2347 CALL C_H3D_UPDATE_NODAL_VECTOR(TT,H3D_DATA%IH3D,ITAB,AIRBAGS_TOTAL_FVM_IN_H3D_G,NODAL_VECTOR_FVM,
2348 . NODE_ID_FVM,
2349 . N_OUTP_DATA,IS_WRITEN_NODE_FVM)
2350 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2351
2352 ENDIF
2353
2354c-----
2355c nodal tensor
2356c-----
2357.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 1
2358 . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3)THEN
2359c
2360 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2361 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2362 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2363 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2364 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2365 N_H3D_PART_LIST = H3D_DATA%OUTPUT_LIST(I)%N_H3D_PART_LIST
2366c IF(ISPMD == 0) print *,'nodal tensor',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2367
2368c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2369
2370 CALL H3D_NODAL_TENSOR(
2371 . ELBUF_TAB, NODAL_TENSOR ,IFUNC ,IPARG,GEO ,MAS ,PM ,
2372 . ANIN , ITAB, NODE_ID ,INFO1 ,INFO2 ,
2373 . IS_WRITEN_NODE,H3D_DATA%OUTPUT_LIST(I)%PART ,IPARTC,IPARTTG,
2374 . IXC, IXTG,TEMP,IFLOW,RFLOW,IXS,IXQ,NV46,MONVOL ,VOLMON, DIAG_SMS,MS,
2375 . PDAMA2,X, STIFR, STIFN, A, D, V, CONT, FCONTG, FINT, FEXT,KEYWORD,
2376 . BUFMAT ,IXS10 ,IXS16 ,IXS20 ,IXT ,
2377 . IXP ,IXR ,IAD_ELEM ,FR_ELEM ,WEIGHT ,
2378 . IPARTSP ,IPARTR ,IPARTP ,IPARTT ,IPARTS ,
2379 . IPARTQ ,KXSP ,N_H3D_PART_LIST)
2380
2381c
2382 IF (NSPMD > 1 ) THEN
2383 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2384 CALL SPMD_H3D_GATHER_I_NODE(WEIGHT,NODE_ID,NUMNOD,NODE_ID_P,NUMNODG)
2385 CALL SPMD_H3D_GATHER_I_NODE(WEIGHT,IS_WRITEN_NODE,NUMNOD,IS_WRITEN_NODE_P,NUMNODG)
2386 CALL SPMD_H3D_GATHER_T_NODE(WEIGHT,NODAL_TENSOR,6*NUMNOD,NODAL_TENSOR_P,6*NUMNODG)
2387 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2388 ELSE
2389 NODE_ID_P(1:NUMNOD) = NODE_ID(1:NUMNOD)
2390 IS_WRITEN_NODE_P(1:NUMNOD) = IS_WRITEN_NODE(1:NUMNOD)
2391 NODAL_TENSOR_P(1:6*NUMNOD) = NODAL_TENSOR(1:6*NUMNOD)
2392 ENDIF
2393c
2394 IF(ISPMD == 0) THEN
2395 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2396 CALL C_H3D_UPDATE_NODAL_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMNODG,NODAL_TENSOR_P,NODE_ID_P,
2397 . N_OUTP_DATA,IS_WRITEN_NODE_P)
2398 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2399
2400 ENDIF
2401c-----
2402c 1d scalar
2403c-----
2404.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 4
2405.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 (NUMELTRG+NUMELPG+NUMELRG) > 0)THEN
2406
2407 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2408 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2409 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2410 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2411 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2412 IPT = H3D_DATA%OUTPUT_LIST(I)%IPT
2413c IF(ISPMD == 0) print *,'nodal scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2414
2415c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2416
2417 SZ_ANIN = SANIN - NDMA2
2418 CALL H3D_ONED_SCALAR(ELBUF_TAB ,IPARG ,GEO , IXT,
2419 . IXP ,IXR ,PM , ANIN(NDMA2+1),
2420 . ONED_SCALAR ,ONED_ID ,ONED_ITY,
2421 . IS_WRITEN_ONED ,IPARTT ,IPARTP,IPARTR,H3D_DATA%OUTPUT_LIST(I)%PART,
2422 . KEYWORD, X , D ,IPT,
2423 . NUMELP, NUMELT, NUMELR,NIXT,NIXP,
2424 . NIXR, NGROUP, ANIM_FE, MX_ANI, NPARG,
2425 . NPROPM, NPROPG, NUMMAT, NUMGEO, NUMNOD,
2426 . SZ_ANIN, NUMELPG, NUMELRG, NUMELTRG, NPART)
2427
2428c
2429 IF (NSPMD > 1 ) THEN
2430 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2431 CALL SPMD_H3D_GATHER_I(ONED_ID,NUMELT+NUMELP+NUMELR,ONED_ID_P,NUMELTRG+NUMELPG+NUMELRG)
2432 CALL SPMD_H3D_GATHER_I(ONED_ITY,NUMELT+NUMELP+NUMELR,ONED_ITY_P,NUMELTRG+NUMELPG+NUMELRG)
2433 CALL SPMD_H3D_GATHER_I(IS_WRITEN_ONED,NUMELT+NUMELP+NUMELR,IS_WRITEN_ONED_P,NUMELTRG+NUMELPG+NUMELRG)
2434 CALL SPMD_H3D_GATHER_R(ONED_SCALAR,NUMELT+NUMELP+NUMELR,ONED_SCALAR_P,NUMELTRG+NUMELPG+NUMELRG)
2435 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2436 ELSE
2437 ONED_ID_P(1:NUMELT+NUMELP+NUMELR) = ONED_ID(1:NUMELT+NUMELP+NUMELR)
2438 ONED_ITY_P(1:NUMELT+NUMELP+NUMELR) = ONED_ITY(1:NUMELT+NUMELP+NUMELR)
2439 IS_WRITEN_ONED_P(1:NUMELT+NUMELP+NUMELR) = IS_WRITEN_ONED(1:NUMELT+NUMELP+NUMELR)
2440 ONED_SCALAR_P(1:NUMELT+NUMELP+NUMELR) = ONED_SCALAR(1:NUMELT+NUMELP+NUMELR)
2441 ENDIF
2442c
2443 IF(ISPMD == 0) THEN
2444 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2445 CALL C_H3D_UPDATE_ONED_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMELTRG,NUMELPG,NUMELRG,ONED_SCALAR_P,ONED_ID_P,
2446 . N_OUTP_DATA,ONED_ITY_P,IS_WRITEN_ONED_P)
2447 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2448
2449 ENDIF
2450c-----
2451c 1d vector
2452c-----
2453.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 4
2454.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 2 (NUMELTRG+NUMELPG+NUMELRG) > 0)THEN
2455
2456 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2457 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2458 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2459 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2460 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2461c IF(ISPMD == 0) print *,'1d vector',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2462
2463c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2464
2465 CALL H3D_ONED_VECTOR(ELBUF_TAB ,IFUNC ,IPARG ,GEO ,
2466 . IXT ,IXP ,IXR ,PM ,
2467 . ANIN(NDMA2+1),ONED_VECTOR,
2468 . ONED_ID ,ONED_ITY,INFO1 ,INFO2 , IS_WRITEN_ONED ,
2469 . IPARTT ,IPARTP,IPARTR,H3D_DATA%OUTPUT_LIST(I)%PART,
2470 . KEYWORD , X , D ,TORS )
2471
2472c
2473 IF (NSPMD > 1 ) THEN
2474 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2475 CALL SPMD_H3D_GATHER_I(ONED_ID,NUMELT+NUMELP+NUMELR,ONED_ID_P,NUMELTRG+NUMELPG+NUMELRG)
2476 CALL SPMD_H3D_GATHER_I(ONED_ITY,NUMELT+NUMELP+NUMELR,ONED_ITY_P,NUMELTRG+NUMELPG+NUMELRG)
2477 CALL SPMD_H3D_GATHER_I(IS_WRITEN_ONED,NUMELT+NUMELP+NUMELR,IS_WRITEN_ONED_P,NUMELTRG+NUMELPG+NUMELRG)
2478 CALL SPMD_H3D_GATHER_R(ONED_VECTOR,3*(NUMELT+NUMELP+NUMELR),ONED_VECTOR_P,3*(NUMELTRG+NUMELPG+NUMELRG))
2479 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2480 ELSE
2481 ONED_ID_P(1:NUMELT+NUMELP+NUMELR) = ONED_ID(1:NUMELT+NUMELP+NUMELR)
2482 ONED_ITY_P(1:NUMELT+NUMELP+NUMELR) = ONED_ITY(1:NUMELT+NUMELP+NUMELR)
2483 IS_WRITEN_ONED_P(1:NUMELT+NUMELP+NUMELR) = IS_WRITEN_ONED(1:NUMELT+NUMELP+NUMELR)
2484 ONED_VECTOR_P(1:3*(NUMELT+NUMELP+NUMELR)) = ONED_VECTOR(1:3*(NUMELT+NUMELP+NUMELR))
2485 ENDIF
2486c
2487 IF(ISPMD == 0) THEN
2488 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2489 CALL C_H3D_UPDATE_ONED_VECTOR(TT,H3D_DATA%IH3D,ITAB,NUMELTRG,NUMELPG,NUMELRG,ONED_VECTOR_P,ONED_ID_P,
2490 . N_OUTP_DATA,ONED_ITY_P,IS_WRITEN_ONED_P)
2491 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2492
2493 ENDIF
2494c-----
2495c 1d tensor
2496c-----
2497.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 4
2498.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 (NUMELTRG+NUMELPG+NUMELRG) > 0)THEN
2499
2500 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2501 IPT = H3D_DATA%OUTPUT_LIST(I)%IPT
2502 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2503 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2504 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2505 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2506c IF(ISPMD == 0) print *,'1d tensor',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2507
2508c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2509
2510 CALL H3D_ONED_TENSOR(ELBUF_TAB ,IFUNC ,IPARG ,GEO ,
2511 . IXT ,IXP ,IXR ,PM ,
2512 . ANIN(NDMA2+1),ONED_TENSOR,
2513 . ONED_ID ,ONED_ITY,INFO1 ,INFO2 , IS_WRITEN_ONED ,
2514 . IPARTT ,IPARTP,IPARTR,H3D_DATA%OUTPUT_LIST(I)%PART,
2515 . KEYWORD , X , D ,IPT)
2516c
2517 IF (NSPMD > 1 ) THEN
2518 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2519 CALL SPMD_H3D_GATHER_I(ONED_ID,NUMELT+NUMELP+NUMELR,ONED_ID_P,NUMELTRG+NUMELPG+NUMELRG)
2520 CALL SPMD_H3D_GATHER_I(ONED_ITY,NUMELT+NUMELP+NUMELR,ONED_ITY_P,NUMELTRG+NUMELPG+NUMELRG)
2521 CALL SPMD_H3D_GATHER_I(IS_WRITEN_ONED,NUMELT+NUMELP+NUMELR,IS_WRITEN_ONED_P,NUMELTRG+NUMELPG+NUMELRG)
2522 CALL SPMD_H3D_GATHER_R(ONED_TENSOR,6*(NUMELT+NUMELP+NUMELR),ONED_TENSOR_P,6*(NUMELTRG+NUMELPG+NUMELRG))
2523 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2524 ELSE
2525 ONED_ID_P(1:NUMELT+NUMELP+NUMELR) = ONED_ID(1:NUMELT+NUMELP+NUMELR)
2526 ONED_ITY_P(1:NUMELT+NUMELP+NUMELR) = ONED_ITY(1:NUMELT+NUMELP+NUMELR)
2527 IS_WRITEN_ONED_P(1:NUMELT+NUMELP+NUMELR) = IS_WRITEN_ONED(1:NUMELT+NUMELP+NUMELR)
2528 ONED_TENSOR_P(1:6*(NUMELT+NUMELP+NUMELR)) = ONED_TENSOR(1:6*(NUMELT+NUMELP+NUMELR))
2529 ENDIF
2530c
2531 IF(ISPMD == 0) THEN
2532 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2533 CALL C_H3D_UPDATE_ONED_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMELTRG,NUMELPG,NUMELRG,ONED_TENSOR_P,ONED_ID_P,
2534 . N_OUTP_DATA,ONED_ITY_P,IS_WRITEN_ONED_P)
2535 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2536
2537 ENDIF
2538c-----
2539c 1d torsor
2540c-----
2541.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 4
2542.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 4 (NUMELTRG+NUMELPG+NUMELRG) > 0)THEN
2543c
2544 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2545 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2546 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2547 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2548 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2549c IF(ISPMD == 0) print *,'nodal vector',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2550
2551c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2552
2553 CALL H3D_ONED_TORSOR(IPARG,IFUNC ,IXT ,IXP ,
2554 . IXR ,TORS ,ONED_TORSOR,ONED_ID ,
2555 . ONED_ITY,INFO1 ,INFO2 , IS_WRITEN_ONED,
2556 . IPARTT ,IPARTP,IPARTR,H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD)
2557
2558c
2559 IF (NSPMD > 1 ) THEN
2560 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2561 CALL SPMD_H3D_GATHER_I(ONED_ID,NUMELT+NUMELP+NUMELR,ONED_ID_P,NUMELTRG+NUMELPG+NUMELRG)
2562 CALL SPMD_H3D_GATHER_I(ONED_ITY,NUMELT+NUMELP+NUMELR,ONED_ITY_P,NUMELTRG+NUMELPG+NUMELRG)
2563 CALL SPMD_H3D_GATHER_I(IS_WRITEN_ONED,NUMELT+NUMELP+NUMELR,IS_WRITEN_ONED_P,NUMELTRG+NUMELPG+NUMELRG)
2564 CALL SPMD_H3D_GATHER_R(ONED_TORSOR,9*(NUMELT+NUMELP+NUMELR),ONED_TORSOR_P,9*(NUMELTRG+NUMELPG+NUMELRG))
2565 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2566 ELSE
2567 ONED_ID_P(1:NUMELT+NUMELP+NUMELR) = ONED_ID(1:NUMELT+NUMELP+NUMELR)
2568 ONED_ITY_P(1:NUMELT+NUMELP+NUMELR) = ONED_ITY(1:NUMELT+NUMELP+NUMELR)
2569 IS_WRITEN_ONED_P(1:NUMELT+NUMELP+NUMELR) = IS_WRITEN_ONED(1:NUMELT+NUMELP+NUMELR)
2570 ONED_TORSOR_P(1:9*(NUMELT+NUMELP+NUMELR)) = ONED_TORSOR(1:9*(NUMELT+NUMELP+NUMELR))
2571 ENDIF
2572c
2573 IF(ISPMD == 0) THEN
2574 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2575 CALL C_H3D_UPDATE_ONED_TORSOR(TT,H3D_DATA%IH3D,ITAB,NUMELTRG,NUMELPG,NUMELRG,ONED_TORSOR_P,ONED_ID_P,
2576 . N_OUTP_DATA,ONED_ITY_P,IS_WRITEN_ONED_P)
2577 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2578 ENDIF
2579c-----
2580c shell scalar
2581c-----
2582.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 2
2583.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 (NUMELCG+NUMELTGG) > 0)THEN
2584
2585 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2586 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2587 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2588 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2589 IPT = H3D_DATA%OUTPUT_LIST(I)%IPT
2590 ID_PLY = H3D_DATA%OUTPUT_LIST(I)%PLY
2591 GAUSS = H3D_DATA%OUTPUT_LIST(I)%GAUSS
2592 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2593 IDMDS = H3D_DATA%OUTPUT_LIST(I)%IDMDS
2594 IMDSVAR = H3D_DATA%OUTPUT_LIST(I)%IMDSVAR
2595 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2596 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2597 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
2598 MODE = H3D_DATA%OUTPUT_LIST(I)%MODE
2599c IF(ISPMD == 0) print *,'shell scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2600
2601c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2602
2603 SHELL_STACKSIZE = 0
2604 CALL H3D_SHELL_SCALAR(
2605 . ELBUF_TAB ,SHELL_STACK ,IPARG ,GEO ,
2606 . IXC ,IXTG ,PM ,BUFMAT ,
2607 . EANI,
2608 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3,
2609 . X ,V ,W ,ALE_CONNECT,
2610 . NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
2611 . STACK ,SHELL_ID ,SHELL_ITY ,
2612 . IS_WRITEN_SHELL,IPARTC ,IPARTTG ,LAYER ,IPT ,
2613 . ID_PLY ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD,GLOB_THERM%ITHERM,
2614 . D ,MULTI_FVM ,IDMDS ,IMDSVAR ,MDS_MATID ,
2615 . OBJECT_ID ,MODE ,MAT_PARAM ,H3D_DATA%LIGHT,MAX_SHELL_STACKSIZE,
2616 . SHELL_STACKSIZE)
2617
2618c
2619
2620 if (ispmd==0) then
2621 IS_WRITEN_SHELL_P(1:SHELL_STACKSIZE) = IS_WRITEN_SHELL(1:SHELL_STACKSIZE)
2622 SHELL_STACK_P(1:SHELL_STACKSIZE) = SHELL_STACK(1:SHELL_STACKSIZE)
2623 SHELL_STACKSIZE_P0 = SHELL_STACKSIZE
2624 else
2625 SHELL_STACKSIZE_P0 = 1
2626 endif
2627 IF (NSPMD > 1 ) THEN
2628 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2629
2630 ! First Gather the size of the shell+triangle stack
2631 CALL SPMD_GATHER_INT(SHELL_STACKSIZE,GATHER_SIZE,IT_SPMD(1),1,NSPMD)
2632
2633 ! Then gather the shell+triangle stack to P0 & apply elemen offset
2634 ! to fit with P0 order
2635 CALL H3D_GATHER_ID_VAL(IS_WRITEN_SHELL,SHELL_STACK,SHELL_STACKSIZE,
2636 * IS_WRITEN_SHELL_P,SHELL_STACK_P,NUMELCG+NUMELTGG,
2637 * SHELL_STACKSIZE_P0,GATHER_SIZE,SH_TRIA_SPMD_OFFSETS,NSPMD,ISPMD,IT_SPMD)
2638
2639 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2640 ENDIF
2641c
2642 IF(ISPMD == 0) THEN
2643
2644 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2645 CALL C_H3D_UPDATE_SHELL_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
2646 . NIXC,NUMELCG,IPARTC,IXTG,NIXTG,
2647 . NUMELTGG,IPARTTG,SHELL_STACK_P,SHELL_ID_P,
2648 . N_OUTP_DATA,SHELL_ITY_P,NUMELS,
2649 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SHELL_P,
2650 . SHELL_STACKSIZE_P0)
2651 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2652
2653 ENDIF
2654c-----
2655c shell vector
2656c-----
2657.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 2
2658.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 2 (NUMELCG+NUMELTGG) > 0)THEN
2659
2660 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2661 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2662 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2663 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2664 IPT = H3D_DATA%OUTPUT_LIST(I)%IPT
2665 ID_PLY = H3D_DATA%OUTPUT_LIST(I)%PLY
2666 GAUSS = H3D_DATA%OUTPUT_LIST(I)%GAUSS
2667 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2668 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2669 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2670c IF(ISPMD == 0) print *,'shell vector',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2671
2672c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2673
2674 CALL H3D_SHELL_VECTOR(
2675 . ELBUF_TAB ,SHELL_VECTOR ,IFUNC ,IPARG,GEO ,
2676 . IXQ ,IXC ,IXTG ,PM ,
2677 . EL2FA ,NBF ,IAD ,
2678 . NBF_L ,EANI ,ANIN(NDMA2+1) ,NBPART ,IADG ,
2679 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3,
2680 . INVERT ,X ,V ,W ,
2681 . NV46 ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
2682 . STACK ,SHELL_ID ,SHELL_ITY ,INFO1 ,INFO2 ,
2683 . IS_WRITEN_SHELL,IPARTC ,IPARTTG ,LAYER ,IPT ,
2684 . ID_PLY ,GAUSS ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD,
2685 . D ,MULTI_FVM)
2686c
2687 IF (NSPMD > 1 ) THEN
2688 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2689 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SHELL,NUMELC+NUMELTG,IS_WRITEN_SHELL_P,NUMELCG+NUMELTGG)
2690 CALL SPMD_H3D_GATHER_R(SHELL_VECTOR,3*(NUMELC+NUMELTG),SHELL_VECTOR_P,3*(NUMELCG+NUMELTGG))
2691 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2692 ELSE
2693 IS_WRITEN_SHELL_P(1:NUMELC+NUMELTG) = IS_WRITEN_SHELL(1:NUMELC+NUMELTG)
2694 SHELL_VECTOR_P(1:3*(NUMELC+NUMELTG)) = SHELL_VECTOR(1:3*(NUMELC+NUMELTG))
2695 ENDIF
2696c
2697 IF(ISPMD == 0) THEN
2698c print *,'C_H3D_UPDATE_SHELL_VECTOR'
2699 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2700 CALL C_H3D_UPDATE_SHELL_VECTOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
2701 . NIXC,NUMELCG,IPARTC,IXTG,NIXTG,
2702 . NUMELTGG,IPARTTG,SHELL_VECTOR_P,SHELL_ID_P,
2703 . N_OUTP_DATA,SHELL_ITY_P,NUMELS,
2704 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SHELL_P)
2705 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2706
2707 ENDIF
2708c-----
2709c shell tensor
2710c-----
2711.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 2
2712.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 (NUMELCG+NUMELTGG) > 0)THEN
2713
2714 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2715 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2716 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2717 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2718 IPT = H3D_DATA%OUTPUT_LIST(I)%IPT
2719 ID_PLY = H3D_DATA%OUTPUT_LIST(I)%PLY
2720 GAUSS = H3D_DATA%OUTPUT_LIST(I)%GAUSS
2721 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2722 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
2723 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2724 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2725
2726 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2727 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2728 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2729 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2730c IF(ISPMD == 0) print *,'shell tensor',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2731
2732c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
2733
2734 CALL H3D_SHELL_TENSOR(ELBUF_TAB,SHELL_TENSOR ,IPARG ,IFUNC ,INVERT,NELCUT,
2735 . EL2FA ,NBF ,WAFT ,TANI ,IAD ,
2736 . NBF_L ,NBPART,IADG ,X ,IXC ,
2737 . IGEO ,IXTG ,IPM ,STACK ,SHELL_ID ,SHELL_ITY ,INFO1,
2738 . INFO2 ,IS_WRITEN_SHELL ,IPARTC ,IPARTTG ,LAYER ,IPT ,
2739 . ID_PLY ,GAUSS ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART ,KEYWORD,D ,
2740 . OBJECT_ID ,BUFMAT ,MAT_PARAM,GEO ,DRAPE_SH4N, DRAPE_SH3N, DRAPEG)
2741
2742c
2743 IF (NSPMD > 1 ) THEN
2744 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2745 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SHELL,NUMELC+NUMELTG,IS_WRITEN_SHELL_P,NUMELCG+NUMELTGG)
2746 CALL SPMD_H3D_GATHER_R(SHELL_TENSOR,3*(NUMELC+NUMELTG),SHELL_TENSOR_P,3*(NUMELCG+NUMELTGG))
2747 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2748 ELSE
2749 IS_WRITEN_SHELL_P(1:NUMELC+NUMELTG) = IS_WRITEN_SHELL(1:NUMELC+NUMELTG)
2750 SHELL_TENSOR_P(1:3*(NUMELC+NUMELTG)) = SHELL_TENSOR(1:3*(NUMELC+NUMELTG))
2751 ENDIF
2752c
2753 IF(ISPMD == 0) THEN
2754 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2755 CALL C_H3D_UPDATE_SHELL_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
2756 . NIXC,NUMELCG,IPARTC,IXTG,NIXTG,
2757 . NUMELTGG,IPARTTG,SHELL_TENSOR_P,SHELL_ID_P,
2758 . N_OUTP_DATA,SHELL_ITY_P,NUMELS,
2759 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SHELL_P)
2760 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2761
2762 ENDIF
2763
2764c-----
2765c solid scalar
2766c-----
2767.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 3
2768.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 NUMELSG > 0)THEN
2769
2770 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2771 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2772 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2773 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2774 IR = H3D_DATA%OUTPUT_LIST(I)%IR
2775 IS = H3D_DATA%OUTPUT_LIST(I)%IS
2776 IT = H3D_DATA%OUTPUT_LIST(I)%IT
2777 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2778 IDMDS = H3D_DATA%OUTPUT_LIST(I)%IDMDS
2779 IMDSVAR = H3D_DATA%OUTPUT_LIST(I)%IMDSVAR
2780 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2781 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2782 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
2783 MODE = H3D_DATA%OUTPUT_LIST(I)%MODE
2784c IF(ISPMD == 0) print *,'solid scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2785
2786 CALL H3D_SOLID_SCALAR(
2787 . ELBUF_TAB ,SOLID_SCALAR ,IPARG ,
2788 . IXS ,PM ,BUFMAT ,
2789 . EANI ,
2790 . IPM ,
2791 . X ,V ,W ,ALE_CONNECT,
2792 . NERCVOIS,NESDVOIS, LERCVOIS,LESDVOIS,
2793 . SOLID_ID ,SOLID_ITY ,IPARTS ,LAYER ,
2794 . IR ,IS ,IT ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,
2795 . IS_WRITEN_SOLID,INFO1,KEYWORD ,GLOB_THERM%ITHERM,FANI_CELL ,
2796 . MULTI_FVM, IDMDS ,IMDSVAR ,
2797 . OBJECT_ID ,MAT_PARAM ,MODE )
2798c
2799 IF (NSPMD > 1 ) THEN
2800 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2801 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SOLID,NUMELS,IS_WRITEN_SOLID_P,NUMELSG)
2802 CALL SPMD_H3D_GATHER_R(SOLID_SCALAR,NUMELS,SOLID_SCALAR_P,NUMELSG)
2803 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2804 ELSE
2805 IS_WRITEN_SOLID_P(1:NUMELS) = IS_WRITEN_SOLID(1:NUMELS)
2806 SOLID_SCALAR_P(1:NUMELS) = SOLID_SCALAR(1:NUMELS)
2807 ENDIF
2808c
2809 IF(ISPMD == 0) THEN
2810 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2811 CALL C_H3D_UPDATE_SOLID_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXS_P,
2812 . NIXS,NUMELSG,IPARTS,SOLID_SCALAR_P,SOLID_ID_P,
2813 . N_OUTP_DATA,SOLID_ITY_P,
2814 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SOLID_P)
2815 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2816
2817 ENDIF
2818c-----
2819c solid vector
2820c-----
2821.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 3
2822.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 2 NUMELSG > 0)THEN
2823
2824 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2825 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2826 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2827 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2828 IR = H3D_DATA%OUTPUT_LIST(I)%IR
2829 IS = H3D_DATA%OUTPUT_LIST(I)%IS
2830 IT = H3D_DATA%OUTPUT_LIST(I)%IT
2831 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2832 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2833 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2834c IF(ISPMD == 0) print *,'solid scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2835
2836 CALL H3D_SOLID_VECTOR(
2837 . ELBUF_TAB ,SOLID_VECTOR ,IFUNC ,IPARG,GEO ,
2838 . IXQ ,IXS ,IXTG ,PM ,
2839 . EL2FA ,NBF ,IAD ,
2840 . NBF_L ,EANI ,ANIN(NDMA2+1) ,NBPART ,IADG ,
2841 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3,
2842 . INVERT ,X ,V ,W ,
2843 . NV46 ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
2844 . STACK ,SOLID_ID ,SOLID_ITY ,IPARTS ,LAYER ,
2845 . IR ,IS ,IT ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,
2846 . IS_WRITEN_SOLID,INFO1,KEYWORD ,FANI_CELL ,
2847 . H3D_DATA, MULTI_FVM)
2848c
2849 IF (NSPMD > 1 ) THEN
2850 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2851 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SOLID,NUMELS,IS_WRITEN_SOLID_P,NUMELSG)
2852 CALL SPMD_H3D_GATHER_R(SOLID_VECTOR,3*NUMELS,SOLID_VECTOR_P,3*NUMELSG)
2853 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2854 ELSE
2855 IS_WRITEN_SOLID_P(1:NUMELS) = IS_WRITEN_SOLID(1:NUMELS)
2856 SOLID_VECTOR_P(1:3*NUMELS) = SOLID_VECTOR(1:3*NUMELS)
2857 ENDIF
2858c
2859 IF(ISPMD == 0) THEN
2860 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2861 CALL C_H3D_UPDATE_SOLID_VECTOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXS_P,
2862 . NIXS,NUMELSG,IPARTS,SOLID_VECTOR_P,SOLID_ID_P,
2863 . N_OUTP_DATA,SOLID_ITY_P,
2864 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SOLID_P)
2865 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2866
2867 ENDIF
2868c-----
2869c solid tensor
2870c-----
2871.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 3
2872.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 NUMELSG > 0)THEN
2873
2874 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
2875 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
2876 INFO2 = H3D_DATA%OUTPUT_LIST(I)%INFO2
2877 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
2878 IR = H3D_DATA%OUTPUT_LIST(I)%IR
2879 IS = H3D_DATA%OUTPUT_LIST(I)%IS
2880 IT = H3D_DATA%OUTPUT_LIST(I)%IT
2881 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
2882 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2883 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2884 IS_CORNER_DATA = H3D_DATA%OUTPUT_LIST(I)%IS_CORNER_DATA
2885c IF(ISPMD == 0) print *,'solid tensor',N_OUTP_DATA,'KEYWORD',LAYER,IR,IS,IT
2886c
2887 CALL H3D_SOLID_TENSOR(
2888 . ELBUF_TAB,SOLID_TENSOR, IPARG ,IFUNC ,IXS ,PM ,
2889 2 EL2FA ,NNN ,WAFT ,TANI ,
2890 3 NBPART ,X ,IADG ,IPART ,
2891 4 IPARTSP ,IPARTS ,ISPH3D ,IPM ,IGEO , SOLID_ID ,SOLID_ITY , IS_WRITEN_SOLID,
2892 5 LAYER , IR ,IS ,IT ,H3D_DATA%OUTPUT_LIST(I)%PART,INFO1 ,KEYWORD ,D ,
2893 6 SOLID_TENSOR_CORNER,IS_CORNER_DATA , IXS10 ,MAX_NCORN,OBJECT_ID)
2894c
2895 IF (NSPMD > 1 ) THEN
2896 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2897 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SOLID,NUMELS,IS_WRITEN_SOLID_P,NUMELSG)
2898 CALL SPMD_H3D_GATHER_R(SOLID_TENSOR,6*NUMELS,SOLID_TENSOR_P,6*NUMELSG)
2899 IF (IS_CORNER_DATA == 1)
2900 . CALL SPMD_H3D_GATHER_R(SOLID_TENSOR_CORNER,6*NUMELS*MAX_NCORN,SOLID_TENSOR_CORNER_P,6*NUMELSG*MAX_NCORN)
2901 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2902 ELSE
2903 IS_WRITEN_SOLID_P(1:NUMELS) = IS_WRITEN_SOLID(1:NUMELS)
2904 SOLID_TENSOR_P(1:6*NUMELS) = SOLID_TENSOR(1:6*NUMELS)
2905 IF (IS_CORNER_DATA == 1)
2906 . SOLID_TENSOR_CORNER_P(1:6*NUMELS*MAX_NCORN) = SOLID_TENSOR_CORNER(1:6*NUMELS*MAX_NCORN)
2907 ENDIF
2908c
2909 IF(ISPMD == 0) THEN
2910 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2911 CALL C_H3D_UPDATE_SOLID_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXS_P,
2912 . NIXS,NUMELSG,IPARTS,SOLID_TENSOR_P,SOLID_ID_P,
2913 . N_OUTP_DATA,SOLID_ITY_P,
2914 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SOLID_P,
2915 3 SOLID_TENSOR_CORNER_P,IS_CORNER_DATA,ISOLNOD_P,MAX_NCORN)
2916 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2917
2918 ENDIF
2919c-----
2920c sph scalar
2921c-----
2922.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 5
2923.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 NUMSPHG > 0)THEN
2924
2925 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
2926 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2927 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2928 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
2929c IF(ISPMD == 0) print *,'SPH scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
2930
2931 CALL H3D_SPH_SCALAR(
2932 . ELBUF_TAB ,SPH_SCALAR,IFUNC ,IPARG ,
2933 . KXSP ,PM ,IPART ,
2934 . IPM ,
2935 . SPH_ID ,IPARTSP ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,
2936 . IS_WRITEN_SPH,KEYWORD,SPBUF, OBJECT_ID )
2937
2938c
2939 IF (NSPMD > 1 ) THEN
2940 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2941 CALL SPMD_H3D_GATHER_I(SPH_ID,NUMSPH,SPH_ID_P,NUMSPHG)
2942 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SPH,NUMSPH,IS_WRITEN_SPH_P,NUMSPHG)
2943 CALL SPMD_H3D_GATHER_R(SPH_SCALAR,NUMSPH,SPH_SCALAR_P,NUMSPHG)
2944 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2945 ELSE
2946 SPH_ID_P(1:NUMSPH) = SPH_ID(1:NUMSPH)
2947 IS_WRITEN_SPH_P(1:NUMSPH) = IS_WRITEN_SPH(1:NUMSPH)
2948 SPH_SCALAR_P(1:NUMSPH) = SPH_SCALAR(1:NUMSPH)
2949 ENDIF
2950c
2951 IF(ISPMD == 0) THEN
2952 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2953 CALL C_H3D_UPDATE_SPH_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,KXSP_P,
2954 . NISP,NUMSPHG,IPARTS,SPH_SCALAR_P,SPH_ID_P,
2955 . N_OUTP_DATA,
2956 . NUMELQ,NUMELT,NUMELP,NUMELR,IS_WRITEN_SPH_P)
2957 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2958
2959 ENDIF
2960c-----
2961c sph tensor
2962c-----
2963.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 5
2964.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 NUMSPHG > 0)THEN
2965
2966 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
2967 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
2968c IF(ISPMD == 0) print *,'SPH tensor',N_OUTP_DATA,'KEYWORD',KEYWORD
2969c
2970 CALL H3D_SPH_TENSOR(
2971 . ELBUF_TAB,SPH_TENSOR, IPARG ,IFUNC ,KXSP ,PM ,
2972 2 EL2FA ,NNN ,WAFT ,TANI ,
2973 3 NBPART ,X ,IADG ,IPART ,
2974 4 IPARTSP ,ISPH3D ,IPM ,IGEO , SPH_ID , IS_WRITEN_SPH,
2975 5 H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD )
2976c
2977 IF (NSPMD > 1 ) THEN
2978 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2979 CALL SPMD_H3D_GATHER_I(SPH_ID,NUMSPH,SPH_ID_P,NUMSPHG)
2980 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SPH,NUMSPH,IS_WRITEN_SPH_P,NUMSPHG)
2981 CALL SPMD_H3D_GATHER_R(SPH_TENSOR,6*NUMSPH,SPH_TENSOR_P,6*NUMSPHG)
2982 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
2983 ELSE
2984 SPH_ID_P(1:NUMSPH) = SPH_ID(1:NUMSPH)
2985 IS_WRITEN_SPH_P(1:NUMSPH) = IS_WRITEN_SPH(1:NUMSPH)
2986 SPH_TENSOR_P(1:6*NUMSPH) = SPH_TENSOR(1:6*NUMSPH)
2987 ENDIF
2988c
2989 IF(ISPMD == 0) THEN
2990 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
2991 CALL C_H3D_UPDATE_SPH_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMSPHG,IPARTS,SPH_TENSOR_P,SPH_ID_P,
2992 . N_OUTP_DATA,IS_WRITEN_SPH_P)
2993 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
2994
2995 ENDIF
2996c-----
2997c quad scalar
2998c-----
2999.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 6
3000.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 NUMELQG > 0)THEN
3001
3002 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3003 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
3004 IR = H3D_DATA%OUTPUT_LIST(I)%IR
3005 IS = H3D_DATA%OUTPUT_LIST(I)%IS
3006 IT = H3D_DATA%OUTPUT_LIST(I)%IT
3007 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
3008 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3009 OBJECT_ID = H3D_DATA%OUTPUT_LIST(I)%OBJECT_ID
3010
3011
3012c IF(ISPMD == 0) print *,'QUAD scalar',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
3013
3014c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
3015
3016 CALL H3D_QUAD_SCALAR(
3017 . ELBUF_TAB ,QUAD_SCALAR ,IPARG,
3018 . IXQ ,PM ,
3019 . EANI ,
3020 . IPM ,
3021 . X ,V ,W ,ALE_CONNECT,
3022 . NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
3023 . QUAD_ID ,
3024 . IS_WRITEN_QUAD,IPARTQ ,LAYER , NPART,
3025 . IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD,GLOB_THERM%ITHERM,
3026 . BUFMAT ,MULTI_FVM ,IR ,IS ,IT ,
3027 . OBJECT_ID ,MAT_PARAM)
3028c
3029 IF (NSPMD > 1 ) THEN
3030 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3031 CALL SPMD_H3D_GATHER_I(QUAD_ID,NUMELQ,QUAD_ID_P,NUMELQG)
3032 CALL SPMD_H3D_GATHER_I(IS_WRITEN_QUAD,NUMELQ,IS_WRITEN_QUAD_P,NUMELQG)
3033 CALL SPMD_H3D_GATHER_R(QUAD_SCALAR,NUMELQ,QUAD_SCALAR_P,NUMELQG)
3034 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3035 ELSE
3036 QUAD_ID_P(1:NUMELQ) = QUAD_ID(1:NUMELQ)
3037 IS_WRITEN_QUAD_P(1:NUMELQ) = IS_WRITEN_QUAD(1:NUMELQ)
3038 QUAD_SCALAR_P(1:NUMELQ) = QUAD_SCALAR(1:NUMELQ)
3039 ENDIF
3040c
3041 IF(ISPMD == 0) THEN
3042c print *,'C_H3D_UPDATE_QUAD_SCALAR'
3043 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3044 CALL C_H3D_UPDATE_QUAD_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
3045 . NIXC,NUMELC,IPARTC,IXTG,NIXTG,
3046 . NUMELTGG,IPARTTG,QUAD_SCALAR_P,QUAD_ID_P,
3047 . N_OUTP_DATA,NUMELS,
3048 . NUMELQG,NUMELT,NUMELP,NUMELR,IS_WRITEN_QUAD_P)
3049 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3050
3051 ENDIF
3052c-----
3053c quad vector
3054c-----
3055.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 6
3056.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 2 NUMELQG > 0)THEN
3057
3058 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3059 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
3060 IR = H3D_DATA%OUTPUT_LIST(I)%IR
3061 IS = H3D_DATA%OUTPUT_LIST(I)%IS
3062 IT = H3D_DATA%OUTPUT_LIST(I)%IT
3063 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
3064 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3065
3066c IF(ISPMD == 0) print *,'QUAD vector',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
3067
3068c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
3069
3070 CALL H3D_QUAD_VECTOR(
3071 . ELBUF_TAB ,QUAD_VECTOR ,IFUNC ,IPARG,GEO ,
3072 . IXQ ,IXC ,IXTG ,PM ,
3073 . EL2FA ,NBF ,IAD ,
3074 . NBF_L ,EANI ,ANIN(NDMA2+1) ,NBPART ,IADG ,
3075 . IPM ,IGEO ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3,
3076 . INVERT ,X ,V ,W ,
3077 . NV46 ,NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,
3078 . STACK ,QUAD_ID ,INFO1 ,INFO2 ,
3079 . IS_WRITEN_QUAD,IPARTQ ,IPARTTG ,LAYER ,IPT ,
3080 . ID_PLY ,GAUSS ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART,KEYWORD,
3081 . BUFMAT ,MULTI_FVM ,IR ,IS ,IT )
3082c
3083 IF (NSPMD > 1 ) THEN
3084 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3085 CALL SPMD_H3D_GATHER_I(QUAD_ID,NUMELQ,QUAD_ID_P,NUMELQG)
3086 CALL SPMD_H3D_GATHER_I(IS_WRITEN_QUAD,NUMELQ,IS_WRITEN_QUAD_P,NUMELQG)
3087 CALL SPMD_H3D_GATHER_R(QUAD_VECTOR,3*NUMELQ,QUAD_VECTOR_P,3*NUMELQG)
3088 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3089 ELSE
3090 QUAD_ID_P(1:NUMELQ) = QUAD_ID(1:NUMELQ)
3091 IS_WRITEN_QUAD_P(1:NUMELQ) = IS_WRITEN_QUAD(1:NUMELQ)
3092 QUAD_VECTOR_P(1:3*NUMELQ) = QUAD_VECTOR(1:3*NUMELQ)
3093 ENDIF
3094c
3095 IF(ISPMD == 0) THEN
3096 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3097c print *,'C_H3D_UPDATE_QUAD_VECTOR'
3098 CALL C_H3D_UPDATE_QUAD_VECTOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
3099 . NIXC,NUMELC,IPARTC,IXTG,NIXTG,
3100 . NUMELTGG,IPARTTG,QUAD_VECTOR_P,QUAD_ID_P,
3101 . N_OUTP_DATA,NUMELS,
3102 . NUMELQG,NUMELT,NUMELP,NUMELR,IS_WRITEN_QUAD_P)
3103 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3104
3105 ENDIF
3106c-----
3107c quad tensor
3108c-----
3109.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 6
3110.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 NUMELQG > 0)THEN
3111
3112 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3113 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
3114 IR = H3D_DATA%OUTPUT_LIST(I)%IR
3115 IS = H3D_DATA%OUTPUT_LIST(I)%IS
3116 IT = H3D_DATA%OUTPUT_LIST(I)%IT
3117 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
3118 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3119
3120c IF(ISPMD == 0) print *,'QUAD tensor',N_OUTP_DATA,'IFUNC',IFUNC,'INFO1',INFO1,'INFO2',INFO2
3121
3122c IF(ISPMD == 0) print *,'H3D_DATA%OUTPUT_LIST(I)%PART',H3D_DATA%OUTPUT_LIST(I)%PART(1:NPART)
3123
3124 CALL H3D_QUAD_TENSOR(ELBUF_TAB,QUAD_TENSOR ,IPARG ,IFUNC ,INVERT,NELCUT,
3125 . EL2FA ,WAFT ,TANI ,IAD ,
3126 . NBPART,IADG ,X ,IXQ ,
3127 . IGEO ,IXTG ,IPM ,STACK ,QUAD_ID ,INFO1,
3128 . INFO2 ,IS_WRITEN_QUAD ,IPARTQ ,IPARTTG ,LAYER ,IPT ,
3129 . ID_PLY ,GAUSS ,IUVAR ,H3D_DATA%OUTPUT_LIST(I)%PART ,KEYWORD ,
3130 . IR ,IS ,IT )
3131
3132c
3133 IF (NSPMD > 1 ) THEN
3134 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3135 CALL SPMD_H3D_GATHER_I(QUAD_ID,NUMELQ,QUAD_ID_P,NUMELQG)
3136 CALL SPMD_H3D_GATHER_I(IS_WRITEN_QUAD,NUMELQ,IS_WRITEN_QUAD_P,NUMELQG)
3137 CALL SPMD_H3D_GATHER_R(QUAD_TENSOR,6*(NUMELQ),QUAD_TENSOR_P,6*(NUMELQG))
3138 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3139 ELSE
3140 QUAD_ID_P(1:NUMELQ) = QUAD_ID(1:NUMELQ)
3141 IS_WRITEN_QUAD_P(1:NUMELQ) = IS_WRITEN_QUAD(1:NUMELQ)
3142 QUAD_TENSOR_P(1:6*(NUMELQ)) = QUAD_TENSOR(1:6*(NUMELQ))
3143 ENDIF
3144c
3145 IF(ISPMD == 0) THEN
3146 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3147 CALL C_H3D_UPDATE_QUAD_TENSOR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,IXC_P,
3148 . NIXC,NUMELCG,IPARTC,IXTG,NIXTG,
3149 . NUMELTGG,IPARTTG,QUAD_TENSOR_P,QUAD_ID_P,
3150 . N_OUTP_DATA,NUMELS,
3151 . NUMELQG,NUMELT,NUMELP,NUMELR,IS_WRITEN_QUAD_P)
3152 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3153
3154 ENDIF
3155c
3156c-----
3157c skin scalar
3158c-----
3159.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 7
3160.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 1 NUMSKING > 0)THEN
3161
3162 IFUNC = H3D_DATA%OUTPUT_LIST(I)%ID
3163 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
3164 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3165 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3166
3167 CALL H3D_SKIN_SCALAR(
3168 . ELBUF_TAB ,SKIN_SCALAR ,IFUNC ,IPARG ,GEO ,
3169 . IXS ,IXS10 ,IXS16 , IXS20 ,PM ,
3170 . IPM ,IGEO ,X ,V ,W ,
3171 . IPARTS ,H3D_DATA%OUTPUT_LIST(I)%PART,
3172 . IS_WRITEN_SKIN,INFO1,KEYWORD , H3D_DATA ,
3173 6 IAD_ELEM ,FR_ELEM , WEIGHT ,TAG_SKINS6,
3174 7 NPF ,TF ,BUFMAT,IBCL ,ILOADP ,LLOADP ,FAC ,
3175 8 NSENSOR,SENSORS%SENSOR_TAB,TAGNCONT,LOADP_HYD_INTER,XFRAME,FORC ,
3176 9 NODAL_IPART ,IMAPSKP ,LOADS ,TABLE,IFRAME,MAT_PARAM,D,PBLAST)
3177c
3178 IF (NSPMD > 1 ) THEN
3179 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3180 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SKIN,NUMSKIN,IS_WRITEN_SKIN_P,NUMSKING)
3181 CALL SPMD_H3D_GATHER_R(SKIN_SCALAR,NUMSKIN,SKIN_SCALAR_P,NUMSKING)
3182 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3183 ELSE
3184 IS_WRITEN_SKIN_P(1:NUMSKIN) = IS_WRITEN_SKIN(1:NUMSKIN)
3185 SKIN_SCALAR_P(1:NUMSKIN) = SKIN_SCALAR(1:NUMSKIN)
3186 ENDIF
3187c
3188 IF(ISPMD == 0) THEN
3189 DO II=1,NUMSKING
3190 SKIN_ID_P(II) = II
3191 ENDDO
3192 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3193 CALL C_H3D_UPDATE_SKIN_SCALAR(TT,H3D_DATA%IH3D,ITAB,NUMNOD,
3194 . SKIN_SCALAR_P,SKIN_ID_P,N_OUTP_DATA,
3195 . NUMSKING,IS_WRITEN_SKIN_P)
3196 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3197
3198 ENDIF
3199c-----
3200c skin vector
3201c-----
3202.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 7
3203.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 2 NUMSKING > 0)THEN
3204
3205 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3206 INFO1 = H3D_DATA%OUTPUT_LIST(I)%INFO1
3207 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3208 CALL H3D_SKIN_VECTOR(SKIN_VECTOR,NODAL_IPART,NSENSOR,
3209 . IS_WRITEN_SKIN ,H3D_DATA%OUTPUT_LIST(I)%PART,INFO1 ,KEYWORD ,
3210 . IBCL,ILOADP,LLOADP,FAC ,NPF,TF ,SENSORS%SENSOR_TAB,
3211 . TAGNCONT,LOADP_HYD_INTER,FORC,XFRAME,X ,V ,IMAPSKP,LOADS ,
3212 . TABLE,IFRAME,D,PBLAST)
3213c
3214 IF (NSPMD > 1 ) THEN
3215 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3216 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SKIN,NUMSKIN,IS_WRITEN_SKIN_P,NUMSKING)
3217 CALL SPMD_H3D_GATHER_R(SKIN_VECTOR,3*NUMSKIN,SKIN_VECTOR_P,3*(NUMSKING))
3218 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3219 ELSE
3220 IS_WRITEN_SKIN_P(1:NUMSKIN) = IS_WRITEN_SKIN(1:NUMSKIN)
3221 SKIN_VECTOR_P(1:3*(NUMSKIN)) = SKIN_VECTOR(1:3*(NUMSKIN))
3222 ENDIF
3223c
3224 IF(ISPMD == 0) THEN
3225 DO II=1,NUMSKING
3226 SKIN_ID_P(II) = II
3227 ENDDO
3228 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3229 CALL C_H3D_UPDATE_SKIN_VECTOR(TT,H3D_DATA%IH3D,
3230 . NUMSKING,SKIN_VECTOR_P,SKIN_ID_P,
3231 . N_OUTP_DATA,IS_WRITEN_SKIN_P)
3232 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3233
3234 ENDIF
3235c-----
3236c skin tensor
3237c-----
3238.AND..AND. ELSEIF(H3D_DATA%OUTPUT_LIST(I)%OK /= 0 H3D_DATA%OUTPUT_LIST(I)%ETYPE == 7
3239.AND. . H3D_DATA%OUTPUT_LIST(I)%OUTP_TYPE == 3 NUMSKING > 0)THEN
3240
3241 N_OUTP_DATA = H3D_DATA%OUTPUT_LIST(I)%N_OUTP
3242 LAYER = H3D_DATA%OUTPUT_LIST(I)%LAYER
3243 IUVAR = H3D_DATA%OUTPUT_LIST(I)%IUVAR
3244 KEYWORD = H3D_DATA%OUTPUT_LIST(I)%KEYWORD
3245 CALL H3D_SKIN_TENSOR(
3246 . ELBUF_TAB,SKIN_TENSOR, IPARG ,IXS ,X ,PM ,
3247 4 IPARTS ,IPM ,IGEO ,IXS10 ,IXS16 ,IXS20 ,
3248 5 IS_WRITEN_SKIN ,H3D_DATA%OUTPUT_LIST(I)%PART,INFO1 ,
3249 6 KEYWORD ,IAD_ELEM ,FR_ELEM , WEIGHT ,TAG_SKINS6)
3250c
3251 IF (NSPMD > 1 ) THEN
3252 CALL STARTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3253 CALL SPMD_H3D_GATHER_I(IS_WRITEN_SKIN,NUMSKIN,IS_WRITEN_SKIN_P,NUMSKING)
3254 CALL SPMD_H3D_GATHER_R(SKIN_TENSOR,3*(NUMSKIN),SKIN_TENSOR_P,3*(NUMSKING))
3255 CALL STOPTIME(TIMERS,MACRO_TIMER_SPMDH3D)
3256 ELSE
3257 IS_WRITEN_SKIN_P(1:NUMSKIN) = IS_WRITEN_SKIN(1:NUMSKIN)
3258 SKIN_TENSOR_P(1:3*(NUMSKIN)) = SKIN_TENSOR(1:3*(NUMSKIN))
3259 ENDIF
3260c
3261 IF(ISPMD == 0) THEN
3262C-----usr_id not important but should be unique ---------
3263 DO II=1,NUMSKING
3264 SKIN_ID_P(II) = II
3265 ENDDO
3266 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3267 CALL C_H3D_UPDATE_SKIN_TENSOR(TT,H3D_DATA%IH3D,
3268 . NUMSKING,SKIN_TENSOR_P,SKIN_ID_P,
3269 . N_OUTP_DATA,IS_WRITEN_SKIN_P)
3270 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3271
3272 ENDIF
3273c
3274 ENDIF
3275 ENDDO
3276
3277c-----
3278c virtual nodes
3279c-----
3280 !A POSTERIORI CHECK ---
3281 !CHECK IF MAXIMUM VIRTUAL NODE IDENTIFIER IS WITHIN [0,2147483647=HUGE]
3282 ITMP = USER_NOD_ID%FVMBAG_LEN + USER_NOD_ID%RWALL_LEN !total number of virtual nodes
3283 IF(ITMP > 0)THEN
3284 IF(ITMP >= HUGE(ITMP) - USER_NOD_ID%INPUT_MAX)THEN !test is in fact ( USER_NOD_ID%INPUT_MAX + ITMP >= HUGE) but LHS might be over HUGE written like this.
3285 CALL ANCMSG(MSGID=305,ANMODE=ANINFO)
3286 CALL ARRET(2)
3287 END IF
3288 ENDIF
3289c-----
3290c deallocate
3291c-----
3292 ! FVMBAG visualization
3293 IF(ALLOCATED(NODAL_SCALAR_FVM))DEALLOCATE(NODAL_SCALAR_FVM)
3294 IF(ALLOCATED(NODAL_VECTOR_FVM))DEALLOCATE(NODAL_VECTOR_FVM)
3295 IF(ALLOCATED(NODE_ID_FVM))DEALLOCATE(NODE_ID_FVM)
3296 IF(ALLOCATED(IS_WRITEN_NODE_FVM))DEALLOCATE(IS_WRITEN_NODE_FVM)
3297
3298 if (ispmd ==0)then
3299 ! FVDATA_P deallocate
3300 IF(ALLOCATED(FVDATA_P))THEN
3301 DO J=1,NFVBAG
3302 IF(ASSOCIATED(FVDATA_P(J)%CENTROID_POLH))DEALLOCATE (FVDATA_P(J)%CENTROID_POLH)
3303 IF(ASSOCIATED(FVDATA_P(J)%PPOLH))DEALLOCATE (FVDATA_P(J)%PPOLH)
3304 IF(ASSOCIATED(FVDATA_P(J)%SSPPOLH))DEALLOCATE (FVDATA_P(J)%SSPPOLH)
3305 IF(ASSOCIATED(FVDATA_P(J)%DTPOLH))DEALLOCATE (FVDATA_P(J)%DTPOLH)
3306 IF(ASSOCIATED(FVDATA_P(J)%QPOLH))DEALLOCATE (FVDATA_P(J)%QPOLH)
3307 IF(ASSOCIATED(FVDATA_P(J)%MPOLH))DEALLOCATE (FVDATA_P(J)%MPOLH)
3308 IF(ASSOCIATED(FVDATA_P(J)%RPOLH))DEALLOCATE (FVDATA_P(J)%RPOLH)
3309 IF(ASSOCIATED(FVDATA_P(J)%TPOLH))DEALLOCATE (FVDATA_P(J)%TPOLH)
3310 ENDDO
3311 DEALLOCATE(FVDATA_P)
3312 ENDIF
3313 ENDIF
3314
3315 DEALLOCATE(NODAL_SCALAR)
3316 DEALLOCATE(NODAL_VECTOR)
3317 DEALLOCATE(NODE_ID)
3318 DEALLOCATE(IS_WRITEN_NODE)
3319 DEALLOCATE(IS_WRITEN_NODE_P)
3320 DEALLOCATE(NODAL_VECTOR_P)
3321 DEALLOCATE(NODAL_SCALAR_P)
3322 DEALLOCATE(NODE_ID_P)
3323c
3324 DEALLOCATE(ONED_SCALAR)
3325 DEALLOCATE(ONED_VECTOR)
3326 DEALLOCATE(ONED_TENSOR)
3327 DEALLOCATE(ONED_TORSOR)
3328 DEALLOCATE(ONED_ID)
3329 DEALLOCATE(ONED_ITY)
3330 DEALLOCATE(IS_WRITEN_ONED)
3331 DEALLOCATE(IS_WRITEN_ONED_P)
3332 DEALLOCATE(ONED_ITY_P)
3333 DEALLOCATE(ONED_ID_P)
3334 DEALLOCATE(ONED_SCALAR_P)
3335 DEALLOCATE(ONED_VECTOR_P)
3336 DEALLOCATE(ONED_TENSOR_P)
3337 DEALLOCATE(ONED_TORSOR_P)
3338c
3339 DEALLOCATE(SHELL_SCALAR)
3340 DEALLOCATE(SHELL_VECTOR)
3341 DEALLOCATE(SHELL_TENSOR)
3342 DEALLOCATE(SHELL_ID)
3343 DEALLOCATE(SHELL_ITY)
3344 DEALLOCATE(IS_WRITEN_SHELL)
3345 DEALLOCATE(SHELL_SCALAR_P)
3346 DEALLOCATE(IS_WRITEN_SHELL_P)
3347 DEALLOCATE(SHELL_TENSOR_P)
3348 DEALLOCATE(SHELL_ID_P)
3349 DEALLOCATE(SHELL_ITY_P)
3350c
3351 DEALLOCATE(SOLID_SCALAR)
3352 DEALLOCATE(SOLID_VECTOR)
3353 DEALLOCATE(SOLID_TENSOR)
3354 DEALLOCATE(SOLID_TENSOR_CORNER)
3355 DEALLOCATE(SOLID_ID)
3356 DEALLOCATE(ISOLNOD)
3357 DEALLOCATE(SOLID_ITY)
3358 DEALLOCATE(IS_WRITEN_SOLID)
3359 DEALLOCATE(SOLID_SCALAR_P)
3360 DEALLOCATE(SOLID_VECTOR_P)
3361 DEALLOCATE(SOLID_TENSOR_P)
3362 DEALLOCATE(SOLID_TENSOR_CORNER_P)
3363 DEALLOCATE(IS_WRITEN_SOLID_P)
3364 DEALLOCATE(SOLID_ID_P)
3365 DEALLOCATE(ISOLNOD_P)
3366 DEALLOCATE(SOLID_ITY_P)
3367c
3368 DEALLOCATE(SPH_SCALAR)
3369 DEALLOCATE(SPH_TENSOR)
3370 DEALLOCATE(SPH_ID)
3371 DEALLOCATE(IS_WRITEN_SPH)
3372 DEALLOCATE(SPH_SCALAR_P)
3373 DEALLOCATE(SPH_TENSOR_P)
3374 DEALLOCATE(IS_WRITEN_SPH_P)
3375 DEALLOCATE(SPH_ID_P)
3376c
3377 DEALLOCATE(QUAD_SCALAR)
3378 DEALLOCATE(QUAD_VECTOR)
3379 DEALLOCATE(QUAD_TENSOR)
3380 DEALLOCATE(QUAD_ID)
3381 DEALLOCATE(IS_WRITEN_QUAD)
3382 DEALLOCATE(QUAD_SCALAR_P)
3383 DEALLOCATE(QUAD_TENSOR_P)
3384 DEALLOCATE(IS_WRITEN_QUAD_P)
3385 DEALLOCATE(QUAD_ID_P)
3386c
3387 DEALLOCATE(SKIN_TENSOR,SKIN_VECTOR,SKIN_SCALAR)
3388 DEALLOCATE(IS_WRITEN_SKIN)
3389 DEALLOCATE(SKIN_TENSOR_P,SKIN_VECTOR_P,SKIN_SCALAR_P)
3390 DEALLOCATE(IS_WRITEN_SKIN_P)
3391 DEALLOCATE(SKIN_ID_P)
3392 DEALLOCATE(IXSKIN_TMP)
3393 DEALLOCATE(IXSKIN_P)
3394 IF (NUMSKINP>0) DEALLOCATE(NODAL_IPART,IMAPSKP)
3395c
3396 DEALLOCATE(ITAB_P)
3397
3398
3399 DEALLOCATE( IXTG_P)
3400 DEALLOCATE( IXS_P)
3401 DEALLOCATE( IXP_P)
3402 DEALLOCATE( IXR_P)
3403 DEALLOCATE( KXSP_P)
3404 DEALLOCATE( IXT_P)
3405 DEALLOCATE( IXC_P)
3406 DEALLOCATE( IXS10_P)
3407 DEALLOCATE( IXS16_P)
3408 DEALLOCATE( IXS20_P)
3409 DEALLOCATE( IPARTC_P)
3410 DEALLOCATE( IPARTTG_P)
3411 DEALLOCATE( IPARTQ_P)
3412 DEALLOCATE( IPARTS_P)
3413 DEALLOCATE( IPARTR_P)
3414 DEALLOCATE( IPARTP_P)
3415 DEALLOCATE( IPARTT_P)
3416 DEALLOCATE( IPARTSP_P)
3417 DEALLOCATE( IPARTS10_P)
3418 DEALLOCATE( IPARTS16_P)
3419 DEALLOCATE( IPARTS20_P)
3420 DEALLOCATE( IXQ_P)
3421 DEALLOCATE( IXC_TMP)
3422 DEALLOCATE( IXTG_TMP)
3423c DEALLOCATE( IXS_TMP)
3424 DEALLOCATE( IXR_TMP)
3425 DEALLOCATE( IXP_TMP)
3426 DEALLOCATE( KXSP_TMP)
3427 DEALLOCATE( IXT_TMP)
3428 DEALLOCATE( IXS10_TMP)
3429 DEALLOCATE( IXS16_TMP)
3430 DEALLOCATE( IXS20_TMP)
3431 DEALLOCATE( IXQ_TMP)
3432 DEALLOCATE( SUB_ID,SUB_LEVEL,SUB_NCHILD)
3433 IF(ALLOCATED(SUB_CHILD)) DEALLOCATE( SUB_CHILD,SUB_IAD,SUB_TITLE)
3434
3435
3436 IF (ALLOCATED(NODAL_IPART)) DEALLOCATE(NODAL_IPART)
3437
3438c
3439 IF (ALLOCATED(TAGNOD)) DEALLOCATE(TAGNOD)
3440c
3441 DEALLOCATE(TAGNOD_P)
3442c
3443 DEALLOCATE(MAS)
3444C
3445 IF(ISPMD == 0) THEN
3446 CALL STARTIME(TIMERS,MACRO_TIMER_LIBH3D)
3447 CALL C_H3D_WRITE_TOC()
3448 CALL STOPTIME(TIMERS,MACRO_TIMER_LIBH3D)
3449 ENDIF
3450C
3451 IF (ISPMD==0) THEN
3452 INQUIRE(FILE=TMP_NAME(1:LEN_TMP_NAME), SIZE=H3DTOTALSIZE8)
3453 H3DTOTALSIZE8 = H3DTOTALSIZE8/(1024*1024)
3454 H3DTOTALSIZE = H3DTOTALSIZE8
3455 WRITE (IOUT,1000) FILNAM(1:FILEN),H3D_DATA%IH3D,NCYCLE,TT
3456 WRITE (ISTDO,1000) FILNAM(1:FILEN),H3D_DATA%IH3D,NCYCLE,TT
3457 ENDIF
3458c-----------
3459 CALL STOPTIME(TIMERS,MACRO_TIMER_GENH3D)
3460
3461 RETURN
3462 1000 FORMAT (4X,' h3d file:',1X,A,' updated: frame=',1X,I5,' , nc=',1X,I7,' , time=',1X,G11.4)
c_h3d_create_beams
void c_h3d_create_beams(int *ITAB, int *NUMNOD, int *IXP, int *NIXP, int *NUMELP, int *IPARTP, int *IPART, int *LIPART1, int *H3D_PART)
Definition c_h3d_create_beams.cpp:123
c_h3d_create_components
void c_h3d_create_components(int *IPART, int *LIPART1, int *NPART, int *LTITR, int *IGEO, int *NPROPGI, int *H3D_PART, int *NRBODY, int *NRWALL, int *NOM_OPT, int *LNOPT1, int *I16D, int *NPBY, int *NNPBY, int *SUB_NCHILD, int *NSUBS, int *NRBE2, int *NRBE3, int *I16E, int *I16F, int *N2D, int *IRBE2, int *NRBE2L, int *SUB_ID, int *SUB_CHILD, int *SUB_LEVEL, int *SUB_IAD, int *SUB_TITLE, int *IRBE3, int *NRBE3L, int *COMPID_RBODIES, int *COMPID_RBE2S, int *COMPID_RBE3S)
Definition c_h3d_create_components.cpp:731
c_h3d_create_displacement_datatype
void c_h3d_create_displacement_datatype()
Definition c_h3d_create_displacement_datatype.cpp:131
c_h3d_create_nodes
void c_h3d_create_nodes(int *ITAB, int *NUMNOD, my_real *X, int *TAGNOD, my_real *D)
Definition c_h3d_create_nodes.cpp:125
c_h3d_create_quads
void c_h3d_create_quads(int *ITAB, int *NUMNOD, int *IPART, int *LIPART1, int *H3D_PART, int *IXQ, int *NIXQ, int *NUMELQ, int *IPARTQ)
Definition c_h3d_create_quads.cpp:181
c_h3d_create_rbe2
void c_h3d_create_rbe2(int *ITAB, int *NUMNOD, int *IRBE2, int *NRBE2L, int *LRBE2, int *NRBE2, int *COMPID_RBE2S)
Definition c_h3d_create_rbe2.cpp:180
c_h3d_create_rbe3
void c_h3d_create_rbe3(int *ITAB, int *NUMNOD, int *IRBE3, int *NRBE3L, int *LRBE3, int *NRBE3, int *COMPID_RBE3S)
Definition c_h3d_create_rbe3.cpp:180
c_h3d_create_rbodies
void c_h3d_create_rbodies(int *ITAB, int *NUMNOD, int *NPBY, int *NNPBY, int *LPBY, int *NRBODY, int *COMPID_RBODIES)
Definition c_h3d_create_rbodies.cpp:194
c_h3d_create_results_end
void c_h3d_create_results_end()
Definition c_h3d_create_results_end.cpp:182
c_h3d_create_rwalls
void c_h3d_create_rwalls(int *NOM_OPT, int *LNOPT1, int *I16D, int *NPRW, int *NRWALL, int *MAX_NOD_ID, my_real *XWL, my_real *YWL, my_real *ZWL, my_real *V1, my_real *V2, my_real *V3, my_real *VV1, my_real *VV2, my_real *VV3, my_real *XL, my_real *XN, my_real *YN, my_real *ZN, int *NUM_ADDED_NODES)
Definition c_h3d_create_rwalls.cpp:468
c_h3d_create_sh3ns
void c_h3d_create_sh3ns(int *ITAB, int *NUMNOD, int *IXTG, int *NIXTG, int *NUMELTG, int *IPARTTG, int *IPART, int *LIPART1, int *H3D_PART)
Definition c_h3d_create_sh3ns.cpp:161
c_h3d_create_shells
void c_h3d_create_shells(int *ITAB, int *NUMNOD, int *IXC, int *NIXC, int *NUMELC, int *IPARTC, int *IPART, int *LIPART1, int *H3D_PART)
Definition c_h3d_create_shells.cpp:161
c_h3d_create_skins
void c_h3d_create_skins(int *ITAB, int *NUMNOD, int *IPART, int *LIPART1, int *H3D_PART, int *IXQ, int *NIXQ, int *NUMELQ, int *IPARTQ)
Definition c_h3d_create_skins.cpp:196
c_h3d_create_solid8n
void c_h3d_create_solid8n(int *ITAB, int *NUMNOD, int *IXS, int *NIXS, int *NUMELS, int *IPARTS, int *IPART, int *LIPART1, int *H3D_PART, int *NUMELS10, int *IXS10, int *IPARTS10, int *NUMELS16, int *IXS16, int *IPARTS16, int *NUMELS20, int *IXS20, int *IPARTS20)
Definition c_h3d_create_solid8n.cpp:751
c_h3d_create_sph
void c_h3d_create_sph(int *ITAB, int *NUMNOD, int *KXSP, int *NISP, int *NUMSPH, int *IPARTSP, int *IPART, int *LIPART1, my_real *X, int *H3D_PART)
Definition c_h3d_create_sph.cpp:201
c_h3d_create_springs
void c_h3d_create_springs(int *ITAB, int *NUMNOD, int *IXR, int *NIXR, int *NUMELR, int *IPARTR, int *IPART, int *LIPART1, int *H3D_PART)
Definition c_h3d_create_springs.cpp:124
c_h3d_create_truss
void c_h3d_create_truss(int *ITAB, int *NUMNOD, int *IXT, int *NIXT, int *NUMELT, int *IPARTT, int *IPART, int *LIPART1, int *H3D_PART)
Definition c_h3d_create_truss.cpp:125
c_h3d_eroded_oned
void c_h3d_eroded_oned(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, int *IXT, int *NIXT, int *NUMELT, int *IPARTT, int *IXP, int *NIXP, int *NUMELP, int *IPARTP, int *IXR, int *NIXR, int *NUMELR, int *IPARTR, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE, int *ITY_ELEM)
Definition c_h3d_eroded_oned.cpp:203
c_h3d_eroded_quad
void c_h3d_eroded_quad(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, int *IXQ, int *NIXQ, int *NUMELQ, int *IPARTQ, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE)
Definition c_h3d_eroded_quad.cpp:143
c_h3d_eroded_shell
void c_h3d_eroded_shell(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, int *IXC, int *NIXC, int *NUMELC, int *IPARTC, int *IXTG, int *NIXTG, int *NUMELTG, int *IPARTTG, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE, int *ITY_ELEM, int *NUMELS, int *NUMELQ, int *NUMELT, int *NUMELP, int *NUMELR)
Definition c_h3d_eroded_shell.cpp:177
c_h3d_eroded_skin
void c_h3d_eroded_skin(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE, int *NUMELQ)
Definition c_h3d_eroded_skin.cpp:145
c_h3d_eroded_solid
void c_h3d_eroded_solid(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, int *IXS, int *NIXS, int *NUMELS, int *IPARTS, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE, int *ITY_ELEM, int *NUMELQ, int *NUMELT, int *NUMELP, int *NUMELR)
Definition c_h3d_eroded_solid.cpp:158
c_h3d_eroded_sph
void c_h3d_eroded_sph(my_real *TT, int *IH3D, int *NUMSPH, my_real *FUNC, int *ID_ELEM, int *CPT_DATATYPE)
Definition c_h3d_eroded_sph.cpp:147
c_h3d_open_file
void c_h3d_open_file(char *name, int *size, my_real *percentage_error, int *comp_level, char *RADVERS, int *LEN_RADVERS, my_real *FAC_M, my_real *FAC_L, my_real *FAC_T)
Definition c_h3d_open_file.cpp:321
c_h3d_reopen_file
void c_h3d_reopen_file(char *name, int *size, my_real *percentage_error, int *comp_level)
Definition c_h3d_open_file.cpp:535
c_h3d_update_nodal_fvmbag_scalar
void c_h3d_update_nodal_fvmbag_scalar(my_real *TT, int *IH3D, int *NUMNOD, my_real *FUNC, int *ID_NODE, int *CPT_DATATYPE, int *IS_WRITTEN)
Definition c_h3d_update_nodal_fvmbag_scalar.cpp:144
c_h3d_update_nodal_scalar
void c_h3d_update_nodal_scalar(my_real *TT, int *IH3D, int *ITAB, int *NUMNOD, my_real *FUNC, int *ID_NODE, int *CPT_DATATYPE, int *IS_WRITTEN)
Definition c_h3d_update_nodal_scalar.cpp:144
my_real
#define my_real
Definition cppsort.cpp:32
drbe2cnt
subroutine drbe2cnt(nerbe2, irbe2, lrbe2, weight)
Definition drbe2cnt.F:33
drbe3cnt
subroutine drbe3cnt(nerbe3, irbe3, lrbe3, weight)
Definition drbe3cnt.F:33
sysfus2
integer function sysfus2(iu, itabm1, numnod)
Definition sysfus.F:99
h3d_constit
subroutine h3d_constit(itab, itabm1, numnod)
Definition h3d_constit.F:33
h3d_create_datatype
subroutine h3d_create_datatype(h3d_data, ipari)
Definition h3d_create_datatype.F:39
h3d_create_fvmbag_centroids
subroutine h3d_create_fvmbag_centroids(monvol, volmon, fvdata, nfvbag, smonvol, svolmon, airbags_node_id_shift)
Definition h3d_create_fvmbag_centroids.F:34
h3d_create_rbe2_impi
subroutine h3d_create_rbe2_impi(lrbe2, irbe2, nodglob, weight, nerbe2y, nerbe2t, itab, compid_rbe2s)
Definition h3d_create_rbe2_impi.F:35
h3d_create_rbe3_impi
subroutine h3d_create_rbe3_impi(lrbe3, irbe3, nodglob, weight, nerbe3y, nerbe3t, itab, compid_rbe3s)
Definition h3d_create_rbe3_impi.F:35
h3d_create_rbodies_impi
subroutine h3d_create_rbodies_impi(npby, lpby, fr_rby2, iad_rby2, sbufspm, sbufrecvm, sbufspo, sporby, nodglob, weight, itab, compid_rbodies)
Definition h3d_create_rbodies_impi.F:37
h3dlib_load
void h3dlib_load(int *IERROR)
Definition h3d_dl.c:919
h3d_dxyz_rwall
subroutine h3d_dxyz_rwall(nstrf, rwbuf, nprw, x, xmin, ymin, zmin, xmax, ymax, zmax, fr_sec, fr_wall, weight, itab, xwl, ywl, zwl, rwall_v1, rwall_v2, rwall_v3, rwall_v4, rwall_v5, rwall_v6, rwall_v7, rwall_v8, rwall_v9, rwall_v10)
Definition h3d_dxyz_rwall.F:36
h3d_dxyz_rwall_update
subroutine h3d_dxyz_rwall_update(nstrf, rwbuf, nprw, disp, xmin, ymin, zmin, xmax, ymax, zmax, fr_sec, fr_wall, weight, itab, xwl, ywl, zwl, rwall_v1, rwall_v2, rwall_v3, rwall_v4, rwall_v5, rwall_v6)
Definition h3d_dxyz_rwall_update.F:35
h3d_nodal_scalar
subroutine h3d_nodal_scalar(elbuf_tab, nodal_scalar, ifunc, iparg, geo, mass, pm, anin, itab, node_id, info1, info2, is_written_node, h3d_part, ipartc, iparttg, ixc, ixtg, temp, iflow, rflow, ixs, ixq, nv46, monvol, volmon, ale_connect, diag_sms, ms, pdama2, x, stifr, stifn, keyword, h3d_data, npby, rby, interskid, ninterskid, pskids, nodglob, ityskid, ipartsp, ipartr, ipartp, ipartt, iparts, ipartq, kxsp, ixr, ixp, ixt, n_h3d_part_list, interfric, csefric, csefricg, csefric_stamp, csefricg_stamp, nodal_scalar_fvm, airbags_total_fvm_in_h3d, is_written_node_fvm, ispmd, fvdata_p, airbags_node_id_shift, multi_fvm, itherm_fe, nfvbag)
Definition h3d_nodal_scalar.F:64
h3d_nodal_vector
subroutine h3d_nodal_vector(elbuf_tab, nodal_vector, ifunc, iparg, geo, mass, pm, anin, itab, node_id, info1, info2, is_written_node, h3d_part, ipartc, iparttg, ixc, ixtg, temp, iflow, rflow, ixs, ixq, nv46, monvol, diag_sms, ms, pdama2, x, volmon, stifr, stifn, a, d, v, cont, fcontg, fint, fext, keyword, fncont, fncontg, ftcont, ftcontg, fncont2, dr, dxancg, fanreac, fcluster, mcluster, vr, fopt, npby, vgaz, ipari, igrnod, weight, nodglob, fcont_max, fncontp2, ftcontp2, ar, ipartsp, ipartr, ipartp, ipartt, iparts, ipartq, kxsp, ixr, ixp, ixt, n_h3d_part_list, nodal_vector_fvm, is_written_node_fvm, airbags_total_fvm_in_h3d, smonvol, svolmon, ispmd, fvdata_p, airbags_node_id_shift, w, sw, x_c)
Definition h3d_nodal_vector.F:57
get_nodal_ipart
subroutine get_nodal_ipart(elbuf_tab, iparg, ipartc, iparttg, iparts, ixc, ixtg, ixs, ixs10, ixs16, ixs20, nodal_ipart)
Definition h3d_skin_ixskin.F:929
h3d_skin_ixskin
subroutine h3d_skin_ixskin(elbuf_tab, iparg, iparts, ixs, ixs10, itab, ixskin, tag_skins6, ibcl, iloadp, lloadp, nodal_ipart, imapskp, loads, pblast)
Definition h3d_skin_ixskin.F:42
h3d_skin_off
subroutine h3d_skin_off(elbuf_tab, iparg, ixs, ixs10, tag_skins6, skin_off)
Definition h3d_skin_off.F:36
h3d_skin_pre_map
subroutine h3d_skin_pre_map(ib, iloadp, lloadp, imapskp, loads, pblast)
Definition h3d_skin_pre_map.F:34
h3d_update_fvmbag_centroids
subroutine h3d_update_fvmbag_centroids(h3dtitle, len_h3dtitle, ih3d, monvol, volmon, nfvbag, smonvol, svolmon, fvdata_p, airbags_node_id_shift)
Definition h3d_update_fvmbag_centroids.F:35
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
aleanim_mod
Definition aleanim_mod.F:40
cluster_mod
Definition cluster_mod.F:40
crackxfem_mod
Definition crackxfem_mod.F:121
drape_mod
Definition drape_mod.F:54
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
fvbag_mod::airbags_total_fvm_in_h3d
integer airbags_total_fvm_in_h3d
Definition fvbag_mod.F:191
fvbag_mod::nfvbag
integer nfvbag
Definition fvbag_mod.F:127
groupdef_mod
Definition groupdef_mod.F:662
h3d_inc_mod
Definition h3d_inc_mod.F:42
h3d_inc_mod::numskinp
integer numskinp
Definition h3d_inc_mod.F:44
h3d_inc_mod::numskinp0
integer numskinp0
Definition h3d_inc_mod.F:44
h3d_mod
Definition h3d_mod.F:308
h3d_mod::is_h3d_used
logical is_h3d_used
Definition h3d_mod.F:315
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::outfile_name
character(len=outfile_char_len) outfile_name
Definition inoutfile_mod.F:111
inoutfile_mod::outfile_name_len
integer outfile_name_len
Definition inoutfile_mod.F:109
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
outmax_mod
Definition outmax_mod.F:52
outputs_mod
Definition outputs_mod.F:59
outputs_mod::ninefric
integer ninefric
Definition outputs_mod.F:65
outputs_mod::s_efricg
integer s_efricg
Definition outputs_mod.F:64
outputs_mod::s_efricintg
integer s_efricintg
Definition outputs_mod.F:64
outputs_mod::s_efric
integer s_efric
Definition outputs_mod.F:64
outputs_mod::s_efricint
integer s_efricint
Definition outputs_mod.F:64
outputs_mod::ninefric_stamp
integer ninefric_stamp
Definition outputs_mod.F:65
plyxfem_mod
Definition plyxfem_mod.F:31
stack_mod
Definition stack_mod.F:72
table_mod
Definition table_mod.F:112
smass3
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3.F:44
spmd_gather_int
subroutine spmd_gather_int(sendbuf, recvbuf, proc, send_size, rcv_size)
Definition spmd_gather_int.F:34
spmd_h3d_gather_i
subroutine spmd_h3d_gather_i(v, len, vp0, lenp0)
Definition spmd_h3d_gather_i.F:32
spmd_h3d_gather_i_node
subroutine spmd_h3d_gather_i_node(weight, v, len, vp0, lenp0)
Definition spmd_h3d_gather_i_node.F:32
spmd_h3d_gather_i_node_part
subroutine spmd_h3d_gather_i_node_part(weight, tagnod, v, len, vp0, lenp0)
Definition spmd_h3d_gather_i_node_part.F:32
spmd_h3d_gather_r
subroutine spmd_h3d_gather_r(v, len, vp0, lenp0)
Definition spmd_h3d_gather_r.F:32
spmd_h3d_gather_r_nodal_value
subroutine spmd_h3d_gather_r_nodal_value(weight, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_nodal_value.F:32
spmd_h3d_max_r_nodal_value
subroutine spmd_h3d_max_r_nodal_value(nodglob, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_nodal_value.F:98
spmd_h3d_max_r_nodal_value_21
subroutine spmd_h3d_max_r_nodal_value_21(nodglob, vp0, lenp0, vg21, ni, nig)
Definition spmd_h3d_gather_r_nodal_value.F:160
spmd_h3d_gather_r_node
subroutine spmd_h3d_gather_r_node(weight, v, len, vp0, lenp0)
Definition spmd_h3d_gather_r_node.F:32
h3d_oned_off
subroutine h3d_oned_off(elbuf_tab, iparg, ixt, ixp, ixr, oned_scalar, id_elem, ity_elem, ipart, ipartt, ipartp, ipartr)
Definition spmd_h3d_oned_off.F:32
h3d_quad_off
subroutine h3d_quad_off(elbuf_tab, iparg, ixq, quad_scalar, id_elem, ipart, ipartq)
Definition spmd_h3d_quad_off.F:32
h3d_shell_off
subroutine h3d_shell_off(elbuf_tab, iparg, ixc, ixtg, numelc, shell_scalar, id_elem, ity_elem, ipart, ipartc, iparttg)
Definition spmd_h3d_shell_off.F:32
h3d_solid_off
subroutine h3d_solid_off(elbuf_tab, iparg, ixs, solid_scalar, id_elem, ity_elem, isolnod)
Definition spmd_h3d_solid_off.F:31
h3d_sph_off
subroutine h3d_sph_off(elbuf_tab, iparg, kxsp, sph_scalar, id_elem)
Definition spmd_h3d_sph_off.F:31
spmd_h3d_sum_r_nodal_value
subroutine spmd_h3d_sum_r_nodal_value(nodglob, v, len, vp0, lenp0)
Definition spmd_h3d_sum_r_nodal_value.F:32
spmd_outpitab
subroutine spmd_outpitab(v, weight, nodglob, vglob)
Definition spmd_outp.F:1077
drbycnt
subroutine drbycnt(nerby, npby)
Definition drbycnt.F:29
scanor
subroutine scanor(x, d, cdg, scale)
Definition scanor.F:29
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
arret
subroutine arret(nn)
Definition arret.F:87
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
fvbag_mod::fvbag_data
Definition fvbag_mod.F:52
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29