34
35
36
37
38! cpu time in
ddsplit routine(avoid nspmd
39
40
41
42
43
44
45
46
47
51
52
53
54#include "implicit_f.inc"
55
56
57
58#include "param_c.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61
62
63
64 INTEGER, INTENT(IN) :: SCEP
65 INTEGER, DIMENSION(SCEP), INTENT(IN) :: CEP
66 TYPE(SURF_), DIMENSION(NSURF), INTENT(INOUT) :: IGRSURF
67 TYPE(SURF_), DIMENSION(NSURF,NSPMD), INTENT(INOUT) :: IGRSURF_PROC
68 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89 INTEGER :: NV,IS,NN,J,K,SHIFT
90 INTEGER :: ITY,II,PROC,K1
91 INTEGER :: OFFC,OFFTG,OFFS,OFFQ
92 INTEGER, DIMENSION(NSPMD) :: JJ
93 INTEGER :: NJ,NJ1,NJ2,NJ3
94 INTEGER :: NODE_ID,NJET
95 INTEGER :: I_AM_HERE
96 LOGICAL, DIMENSION(NSURF) :: ALREADY_DONE
97 LOGICAL, DIMENSION(:), ALLOCATABLE :: I_NEED_IT
98 TYPE(array_type_int_1d), DIMENSION(:), ALLOCATABLE :: PROC_LIST_PER_NODE
99
100 INTEGER :: UP_BOUND
101 INTEGER :: INDEX_PROC,NUMBER_PROC
102 INTEGER :: SIZE_MERGED_LIST,SIZE_PROC_LIST,SIZE_UNION_PROC_LIST
103 INTEGER, DIMENSION(:), ALLOCATABLE :: MERGED_LIST
104 INTEGER, DIMENSION(NSPMD) :: UNION_PROC_LIST,PROC_LIST,NUMBER_APPEARANCE
105 INTEGER :: ELEM_ID
106 INTEGER, DIMENSION(0:7) :: OFFSET
107
108
109
110
111
112
113 offs = 0
114 offq = numels
115 offc = numels+numelq
116 offtg = numels+numelq+ numelc+numelt+numelp+numelr
117 offset(0:7) = 0
118 offset(1) = offs
119 offset(2) = offq
120 offset(3) = offc
121 offset(7) = offtg
122
123 already_done(1:nsurf) = .false.
124
125 k1 = 1
126
127 igrsurf_proc(1:nsurf,1:nspmd)%NSEG = 0
128
129 DO nv=1,nvolu
130 is = t_monvol(nv)%EXT_SURFID
131 nn = igrsurf(is)%NSEG
132 jj(1:nspmd) = 0
133 igrsurf_proc(is,1:nspmd)%NSEG = 0
134 already_done(is) = .true.
135 DO j=1,nn
136 ity = igrsurf(is)%ELTYP(j)
137 ii = igrsurf(is)%ELEM(j)
138 proc = 0
139 IF(ity==3) THEN
140 proc = cep(offc+ii) + 1
141 ELSEIF(ity==7) THEN
142 proc = cep(offtg+ii) + 1
143 ENDIF
144 IF(proc>0) THEN
145 jj(proc) = jj(proc) + 1
146 ENDIF
147 ENDDO
148
149
150 DO proc=1,nspmd
151 IF(.NOT.ALLOCATED(igrsurf_proc(is,proc)%ELTYP).AND.jj(proc)>0) THEN
152 igrsurf_proc(is,proc)%NSEG = jj(proc)
153 ALLOCATE( igrsurf_proc(is,proc)%ELTYP( jj(proc) ) )
154 ALLOCATE( igrsurf_proc(is,proc)%ELEM( jj(proc) ) )
155 ALLOCATE( igrsurf_proc(is,proc)%LOCAL_SEG( jj(proc) ) )
156 ENDIF
157
158
159 IF(jj(proc)>0) THEN
160 njet = t_monvol(nv)%NJET
161 DO nj = 1, njet
162 nj1 = t_monvol(nv)%IBAGJET(5, nj)
163 nj2 = t_monvol(nv)%IBAGJET(6, nj)
164 nj3 = t_monvol(nv)%IBAGJET(7, nj)
168 ENDDO
169
170 IF (t_monvol(nv)%NB_FILL_TRI > 0) THEN
171 DO j = 1, t_monvol(nv)%NB_FILL_TRI
172 i_am_here = 0
173 node_id = t_monvol(nv)%FILL_TRI(3 * (j - 1) + 1)
174 IF (node_id > 0) THEN
176 i_am_here = i_am_here + 1
177 ENDIF
178 node_id = t_monvol(nv)%FILL_TRI(3 * (j - 1) + 2)
179 IF (node_id > 0) THEN
181 i_am_here = i_am_here + 1
182 ENDIF
183 node_id = t_monvol(nv)%FILL_TRI(3 * (j - 1) + 3)
184 IF (node_id > 0) THEN
186 i_am_here = i_am_here + 1
187 ENDIF
188 IF( i_am_here==3 ) THEN
189 t_monvol(nv)%NUMBER_TRI_PER_PROC(proc) =
190 . t_monvol(nv)%NUMBER_TRI_PER_PROC(proc) + 1
191 ENDIF
192 ENDDO
193 ENDIF
194
195 ENDIF
196 ENDDO
197
198 k1 = k1 + nimv
199 ENDDO
200
201
202 k1 = 1
203 DO nv=1,nvolu
204 is = t_monvol(nv)%EXT_SURFID
205 nn = igrsurf(is)%NSEG
206 jj(1:nspmd) = 0
207 DO j=1,nn
208 ity = igrsurf(is)%ELTYP(j)
209 ii = igrsurf(is)%ELEM(j)
210 proc = 0
211 IF(ity==3) THEN
212 proc = cep(offc+ii) + 1
213 ELSEIF(ity==7) THEN
214 proc = cep(offtg+ii) + 1
215 ENDIF
216 IF(proc>0) THEN
217 jj(proc) = jj(proc) + 1
218 igrsurf_proc(is,proc)%ELTYP(jj(proc)) = ity
219 igrsurf_proc(is,proc)%ELEM(jj(proc)) = ii
220 igrsurf_proc(is,proc)%LOCAL_SEG( jj(proc) ) = j
221 ENDIF
222 ENDDO
223 k1 = k1 + nimv
224 ENDDO
225
226 ALLOCATE( i_need_it(numnod) )
227 ALLOCATE( proc_list_per_node(numnod) )
228 i_need_it(1:numnod) = .false.
229 DO is=1,nsurf
230 IF(.NOT.already_done(is)) THEN
231 nn = igrsurf(is)%NSEG
232 ALLOCATE( igrsurf(is)%PROC(nn) )
233 igrsurf(is)%PROC(1:nn) = 0
234 igrsurf_proc(is,1:nspmd)%NSEG = 0
235
236
237 DO j=1,nn
238 ity = igrsurf(is)%ELTYP(j)
239 ii = igrsurf(is)%ELEM(j)
240
241
242
243 IF(ity==0) THEN
244 up_bound = 4
245 IF(n2d/=0) up_bound = 2
246
247
248 DO k=1,up_bound
249 node_id = igrsurf(is)%NODES(j,k)
250 IF(node_id/=0) THEN
251 IF(.NOT.i_need_it(node_id)) THEN
252 i_need_it(node_id) = .true.
253 number_proc = 0
255 proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D = number_proc
257 proc_list_per_node(node_id)%INT_ARRAY_1D(1:number_proc) = proc_list(1:number_proc
258 ENDIF
259 ENDIF
260 ENDDO
261
262 ENDIF
263
264 ENDDO
265
266 ENDIF
267 ENDDO
268
269
270
271
272
273
274 DO is=1,nsurf
275 IF(.NOT.already_done(is)) THEN
276 igrsurf_proc(is,1:nspmd)%NSEG = 0
277 nn = igrsurf(is)%NSEG
278
279
280 DO j=1,nn
281 ity = igrsurf(is)%ELTYP(j)
282 ii = igrsurf(is)%ELEM(j)
283 proc = 0
284
285
286
287 IF(ity==1) THEN
288 proc = cep(ii) + 1
289 ELSEIF(ity==2) THEN
290 proc = cep(offs+ii) + 1
291 ELSEIF(ity==3) THEN
292 proc = cep(offc+ii) + 1
293 ELSEIF(ity==7) THEN
294 proc = cep(offtg+ii) + 1
295 ELSEIF(ity==0) THEN
296 up_bound = 4
297 IF(igrsurf(is)%NODES(j,3)==igrsurf(is)%NODES(j,4)) up_bound = 3
298 IF(n2d/=0) up_bound = 2
299 size_merged_list = 0
300
301
302 DO k=1,up_bound
303 node_id = igrsurf(is)%NODES(j,k)
304 IF(node_id/=0) THEN
305 size_merged_list = size_merged_list + proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
306 ENDIF
307 ENDDO
308
309 ALLOCATE( merged_list(size_merged_list) )
310 merged_list(1:size_merged_list) = -1
311 node_id = igrsurf(is)%NODES(j,1)
312 size_union_proc_list = 0
313 IF(node_id/=0) THEN
314
315
316 merged_list(1:proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D) =
317 . proc_list_per_node(node_id)%INT_ARRAY_1D(1:proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
318 shift = proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
319
320 proc_list(1:proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D) =
321 . proc_list_per_node(node_id)%INT_ARRAY_1D(1:proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D)
322 size_proc_list = proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
323 size_union_proc_list = 0
324
325
326 DO k=2,up_bound
327 node_id = igrsurf(is)%NODES(j,k)
328
329 merged_list(shift+1:shift+proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D) =
330 . proc_list_per_node(node_id)%INT_ARRAY_1D(1:proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D)
331 shift = shift + proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
332
333 CALL union_2_sorted_sets(proc_list, size_proc_list,
334 . proc_list_per_node(node_id)%INT_ARRAY_1D, proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D
335 . union_proc_list, size_union_proc_list )
336 proc_list(1:size_union_proc_list) = union_proc_list(1:size_union_proc_list)
337 size_proc_list = size_union_proc_list
338 ENDDO
339
340 ENDIF
341
342
343
344 number_appearance(1:nspmd) = 0
345 IF(size_union_proc_list>0) THEN
346 CALL count_member_list( union_proc_list, size_union_proc_list,
347 . merged_list, size_merged_list,
348 . number_appearance, index_proc )
349 proc = union_proc_list(index_proc)
350
351
352 IF( number_appearance(index_proc)/=up_bound ) THEN
353 DO k=1,up_bound
354 node_id = igrsurf(is)%NODES(j,k)
355 IF(node_id/=0) THEN
357
358 number_proc = 0
361 proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D = number_proc
363 proc_list_per_node(node_id)%INT_ARRAY_1D(1:number_proc) = proc_list(1:number_proc
364 ENDIF
365 ENDDO
366 ENDIF
367
368 ENDIF
369
370 DEALLOCATE( merged_list )
371 ENDIF
372
373
374 IF(proc>0) THEN
375 igrsurf_proc(is,proc)%NSEG = igrsurf_proc(is,proc)%NSEG + 1
376 igrsurf(is)%PROC(j) = proc
377 ENDIF
378 ENDDO
379
380 ENDIF
381 ENDDO
382
383
384 DO is=1,nsurf
385 IF(.NOT.already_done(is)) THEN
386 jj(1:nspmd) = 0
387 DO j=1,nspmd
388 ALLOCATE( igrsurf_proc(is,j)%ELTYP( igrsurf_proc(is,j)%NSEG ) )
389 ALLOCATE( igrsurf_proc(is,j)%ELEM( igrsurf_proc(is,j)%NSEG ) )
390 ALLOCATE( igrsurf_proc(is,j)%LOCAL_SEG( igrsurf_proc(is,j)%NSEG ) )
391 ENDDO
392 nn = igrsurf(is)%NSEG
393 DO j=1,nn
394 proc = igrsurf(is)%PROC(j)
395 IF(proc/=0) THEN
396 jj(proc) = jj(proc) + 1
397 ity = igrsurf(is)%ELTYP(j)
398 igrsurf_proc(is,proc)%ELTYP( jj(proc) ) = ity
399 elem_id = igrsurf(is)%ELEM(j)
400 igrsurf_proc(is,proc)%ELEM( jj(proc) ) = elem_id
401 igrsurf_proc(is,proc)%LOCAL_SEG( jj(proc) ) = j
402 ENDIF
403 ENDDO
404 ENDIF
405 ENDDO
406
407 DEALLOCATE( i_need_it )
408 DEALLOCATE( proc_list_per_node )
409
410 RETURN
subroutine ddsplit(p, cep, cel, igeo, mat_elem, ipm, icode, iskew, iskn, insel, ibcslag, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, iparttg, detonators, ipartx, npc, ixtg, group_param_tab, ixtg6, ixs, ixs10, ixs20, ixs16, ixq, ixc, ixt, ixp, ixr, itab, itabm1, gjbufi, nale, ale_connectivity, kxx, ixx, ibcl, ibfv, las, laccelm, nnlink, lllink, iparg, igrav, lgrav, ibvel, lbvel, iactiv, factiv, kinet, ipari, nprw, lprw, iexmad, npby, lpby, ixri, nstrf, ljoint, pornod, monvol, icontact, lagbuf, fr_iad, x, d, v, vr, dr, thke, dampr, damp, ms, in, tf, pm, skew, xframe, geo, eani, bufmat, bufgeo, bufsf, brmpc, gjbufr, w, veul, fill, dfill, wb, dsav, asav, msnf, spbuf, fac, vel, fsav, fzero, xlas, accelm, fbvel, gravfac, fr_wave, failwave, parts0, elbuf, rwl, rwsav, rby, rivet, secbuf, rvolu, rconx, nloc_dmg, fvmain, libagale, lenthg, lbufmat, lbufgeo, lbufsf, lenxlas, lnom_opt, lenlas, lenvolu, npts, cne, lcne, addcne, cni2, lcni2g, addcni2, cepi2, celi2, i2nsnt, probint, ddstat, pm1shf, dd_iad, kxsp, ixsp, nod2sp, cepsp, nthwa, nairwa, nmnt, l_mul_lag1, l_mul_lag, lwaspio, ipartsp, ispcond, pm1sph, wma, eigipm, eigibuf, eigrpm, iflow, rflow, memflow, iexlnk, fasolfr, iparth, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, iadll, lll, ibmpc, lambda, lrbagale, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, mcp, temp, unitab, intstamp, iframe, clusters, partsav, ibft, fbft, ibcv, fconv, irbe3, lrbe3, frbe3, front_rm, rbym, irbym, lcrbym, inoise, fnoise, ms0, admsms, nom_sect, ispsym, sh4tree, sh3tree, ipadmesh, ibfflux, fbfflux, sh4trim, sh3trim, padmesh, msc, mstg, inc, intg, ptg, mcpc, mcptg, rcontact, acontact, pcontact, mscnd, incnd, mssa, mstr, msp, msrt, ibcr, fradia, dmelc, dmeltg, dmels, dmeltr, dmelp, dmelrt, res_sms, isphio, lprtsph, lonfsph, vsphio, sphveln, alph, ifill, ims, irbe2, lrbe2, ms_ply, zi_ply, inod_pxfem, iel_pxfem, icodply, iskwply, addcne_pxfem, cne_pxfem, cel_pxfem, ithvar, xdp, table, celsph, icfield, lcfield, cfield, msz2, itask, diag_sms, iloadp, lloadp, loadp, inod_crkxfem, iel_crkxfem, addcne_crkxfem, cne_crkxfem, cel_crkxfem, ibufssg_io, intercep, ibordnode, iedgesh, ibordedge, linale, nodedge, iedge, cep_crkxfem, iedge_tmp, crknodiad, elbuf_tab, nom_opt, lgauge, gauge, igaup, ngaup, nodlevxf, frontb_r2r, dflow, vflow, wflow, sph2sol, sol2sph, irst, elcutc, nodenr, kxfenod2elc, enrtag, intbuf_tab, i11flag, xfem_tab, lenthgr, rthbuf, ixig3d, kxig3d, knot, ipartig3d, wige, ncrkpart, indx_crk, crklvset, crkshell, crksky, crkavx, crkedge, sensors, stack, xfem_phantom, t8, tab_ump, poin_ump, sol2sph_typ, addcsrect, csrect, drape, loads, itagnd, icnds10, addcncnd, cepcnd, celcnd, cncnd, nativ_sms, i24maxnsne, multi_fvm, segquadfr, intbuf_fric_tab, subset, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, igrslin, poin_part_shell, poin_part_tri, poin_part_sol, mid_pid_shell, mid_pid_tri, mid_pid_sol, tag_nm, nindx_nm, indx_nm, tag_scratch, nindx_scrt, indx_scrt, flag_24_25, numnod_l, tag_skn, multiple_skew, igrsurf_proc, knotlocpc, knotlocel, ale_elm, size_ale_elm, pinch_data, tag_skins6, ibcscyc, lbcscyc, t_monvol, indx_s, indx_q, indx_tg, face_elm_s, face_elm_q, face_elm_tg, nbr_th_monvol, ebcs_tab, kloadpinter, loadpinter, dgaploadint, s_loadpinter, len_cep, dynain_data, drapeg, user_windows, output, interfaces, number_load_cyl, loads_per_proc, python, dpl0cld, vel0cld, names_and_titles, bcs_per_proc, constraint_struct, glob_therm, pblast, rwstif_pen, sln_pen)
subroutine ifrontplus(n, p)