OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
igrsurf_split.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine igrsurf_split (scep, cep, t_monvol, igrsurf, igrsurf_proc)

Function/Subroutine Documentation

◆ igrsurf_split()

subroutine igrsurf_split ( integer, intent(in) scep,
integer, dimension(scep), intent(in) cep,
type(monvol_struct_), dimension(nvolu), intent(inout) t_monvol,
type(surf_), dimension(nsurf), intent(inout) igrsurf,
type(surf_), dimension(nsurf,nspmd), intent(inout) igrsurf_proc )
Parameters
[in]scepsize of CEP array
[in]cepconnectivity element --> processor
[in,out]igrsurfsurface structure, size =NSURF
[in,out]igrsurf_procsurface structure per proc , size =NSURF,NSPMD
[in,out]t_monvolmonitor volume structure, size =NVOLU

Definition at line 33 of file igrsurf_split.F.

34!$COMMENT
35! IGSURF_SPLIT description
36! IGSURF_SPLIT splits the global IGSURF array into local
37! IGSURF_PROC arrays in order to save
38! CPU time in ddsplit routine (avoid NSPMD
39! treatments)
40!
41! IGSURF_SPLIT organization :
42! - 1rst step : count the number of element per surface
43! on a given processor and allocate the
44! IGRSURF_PROC structure
45! - 2nd step : fill the structure
46!$ENDCOMMENT
47
48 USE groupdef_mod
49 USE monvol_struct_mod
50 USE array_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "param_c.inc"
59#include "com01_c.inc"
60#include "com04_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(IN) :: SCEP !< size of CEP array
65 INTEGER, DIMENSION(SCEP), INTENT(IN) :: CEP !< connectivity element --> processor
66 TYPE(SURF_), DIMENSION(NSURF), INTENT(INOUT) :: IGRSURF !< surface structure, size =NSURF
67 TYPE(SURF_), DIMENSION(NSURF,NSPMD), INTENT(INOUT) :: IGRSURF_PROC !< surface structure per proc , size =NSURF,NSPMD
68 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL !< monitor volume structure, size =NVOLU
69
70! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
71! CEP : integer ; dimension=NUMNOD
72! CEP gives the id processor of an element
73
74! monitor volume array
75! IGRSURF : SURF_ ; dimension=NSURF
76! global surface property array
77! %ELTYP --> type of element (shell, triangle...)
78! %ELEM --> element id
79! %NSEG --> total element number
80! IGRSURF_PROC : SURF_ ; dimension=NSURF*NSPMD
81! local surface property array (=IGRSURF for each proc)
82! %ELTYP --> type of element (shell, triangle...)
83! %ELEM --> element id
84! %NSEG --> total element number
85! -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**-*-*-*-*-*-*-*-*-*-*-*-*
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
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 ! offset array
107C-----------------------------------------------------
108C S o u r c e L i n e s
109C-----------------------------------------------------
110
111 ! --------------------------------------
112 ! offset for the CEP array
113 offs = 0 ! offset for solid
114 offq = numels ! offset for quad
115 offc = numels+numelq ! offset for shell
116 offtg = numels+numelq+ numelc+numelt+numelp+numelr ! offset for triangle
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 ! 1st step : count the number of element per proc and allocate the structure
125 k1 = 1
126
127 igrsurf_proc(1:nsurf,1:nspmd)%NSEG = 0
128
129 DO nv=1,nvolu ! NVOLU = number of volume
130 is = t_monvol(nv)%EXT_SURFID ! id of the surface
131 nn = igrsurf(is)%NSEG ! number of element per surface
132 jj(1:nspmd) = 0 ! proc index
133 igrsurf_proc(is,1:nspmd)%NSEG = 0
134 already_done(is) = .true.
135 DO j=1,nn
136 ity = igrsurf(is)%ELTYP(j) ! type of the element
137 ii = igrsurf(is)%ELEM(j) ! id of the element
138 proc = 0 ! id of the proc /= 0 if ITY = 3 or 7
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 ! allocation : several MONVOL can refer to the same surface ID
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 ! force the NJ1, NJ2, NJ3 nodes on the processor PROC
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)
165 IF (nj1 /= 0) CALL ifrontplus(nj1, proc)
166 IF (nj2 /= 0) CALL ifrontplus(nj2, proc)
167 IF (nj3 /= 0) CALL ifrontplus(nj3, proc)
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
175 CALL ifrontplus(node_id, proc)
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
180 CALL ifrontplus(node_id, proc)
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
185 CALL ifrontplus(node_id, proc)
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 ! 2nd step : fill the structure
202 k1 = 1
203 DO nv=1,nvolu ! NVOLU = number of volume
204 is = t_monvol(nv)%EXT_SURFID ! id of the surface
205 nn = igrsurf(is)%NSEG ! number of element per surface
206 jj(1:nspmd) = 0 ! proc index
207 DO j=1,nn
208 ity = igrsurf(is)%ELTYP(j) ! type of the element
209 ii = igrsurf(is)%ELEM(j) ! id of the element
210 proc = 0 ! id of the proc /= 0 if ITY = 3 or 7
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 ! number of segment
232 ALLOCATE( igrsurf(is)%PROC(nn) )
233 igrsurf(is)%PROC(1:nn) = 0
234 igrsurf_proc(is,1:nspmd)%NSEG = 0
235 ! -------------
236 ! loop over the segment of the surface
237 DO j=1,nn
238 ity = igrsurf(is)%ELTYP(j) ! type of the element
239 ii = igrsurf(is)%ELEM(j) ! id of the element
240 ! -------------
241 ! find on which processor the segment is defined
242 ! if ity/=0 (segment belongs to an element) --> the processor is given by CEP array
243 IF(ity==0) THEN ! segment is not related to a element --> need to find the list of proc where the nodes are set
244 up_bound = 4
245 IF(n2d/=0) up_bound = 2
246 ! -------------
247 ! loop over the 4 nodes of the segment
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 ! if true, already computed
252 i_need_it(node_id) = .true.
253 number_proc = 0
254 CALL plist_ifront(proc_list,node_id,number_proc) ! compute the list of proc
255 proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D = number_proc
256 CALL alloc_1d_array(proc_list_per_node(node_id))
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 ! loop over the surface to find where the nodes ared defined
270 ! if ity/=0 --> use the CEP array
271 ! if ity=0 --> compute the union of processor list of the 4 nodes
272 ! merge the processor lists in 1 list
273 ! if there are several processor in the merged list, need to find the processor with the highest occurrence
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 ! number of segment
278 ! -------------
279 ! loop over the segment of the surface
280 DO j=1,nn
281 ity = igrsurf(is)%ELTYP(j) ! type of the element
282 ii = igrsurf(is)%ELEM(j) ! id of the element
283 proc = 0
284 ! -------------
285 ! find on which processor the segment is defined
286 ! if ity/=0 (segment belongs to an element) --> the processor is given by CEP array
287 IF(ity==1) THEN ! solid
288 proc = cep(ii) + 1
289 ELSEIF(ity==2) THEN ! quad
290 proc = cep(offs+ii) + 1
291 ELSEIF(ity==3) THEN ! shell
292 proc = cep(offc+ii) + 1
293 ELSEIF(ity==7) THEN ! triangle
294 proc = cep(offtg+ii) + 1
295 ELSEIF(ity==0) THEN ! segment is not related to a element
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 ! compute the size of merged list
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 ! merge of processor list
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 ! merge + union computation
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 ! find the leading processor
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 ! if all the nodes are not defined on PROC, need to add it on PROC
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
356 CALL ifrontplus(node_id, proc)
357
358 number_proc = 0
359 CALL plist_ifront(proc_list,node_id,number_proc)
360 CALL dealloc_1d_array(proc_list_per_node(node_id))
361 proc_list_per_node(node_id)%SIZE_INT_ARRAY_1D = number_proc
362 CALL alloc_1d_array(proc_list_per_node(node_id))
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 ! save the processor for the segment J
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 ! loop over the surface to save the IGRSURF% data into IGRSURF_PROC% structure
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 ! number of segment
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 ! type of segment
399 elem_id = igrsurf(is)%ELEM(j)
400 igrsurf_proc(is,proc)%ELEM( jj(proc) ) = elem_id ! element id
401 igrsurf_proc(is,proc)%LOCAL_SEG( jj(proc) ) = j ! pointer from IGRSURF_PROC to IGRSURF
402 ENDIF
403 ENDDO
404 ENDIF
405 ENDDO
406 ! --------------------------------------
407 DEALLOCATE( i_need_it )
408 DEALLOCATE( proc_list_per_node )
409
410 RETURN
plist_ifront
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
array_mod::alloc_1d_array
Definition array_mod.F:95
array_mod::dealloc_1d_array
Definition array_mod.F:99
array_mod
Definition array_mod.F:51
groupdef_mod
Definition groupdef_mod.F:662
monvol_struct_mod
Definition monvol_struct_mod.F:66