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 (output, 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, 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(output_), intent(inout) output,
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,
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(output%data%ninefric,output%data%s_efricint), intent(in) csefric,
dimension(output%data%s_efric), intent(in) csefricg,
dimension(output%data%ninefric_stamp,output%data%s_efricintg), intent(in) csefric_stamp,
dimension(output%data%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 172 of file genh3d.F.

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