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

Go to the source code of this file.

Functions/Subroutines

subroutine inter_prepare_sort (itask, nb_inter_sorted, list_inter_sorted, isendto, irecvfrom, ipari, iad_elem, fr_elem, x, v, ms, temp, kinet, nodnx_sms, itab, weight, intbuf_tab, inter_struct, sort_comm, nodnx_sms_siz, temp_siz, component)

Function/Subroutine Documentation

◆ inter_prepare_sort()

subroutine inter_prepare_sort ( integer, intent(in) itask,
integer, intent(in) nb_inter_sorted,
integer, dimension(nb_inter_sorted), intent(in) list_inter_sorted,
integer, dimension(ninter+1,nspmd+1), intent(in) isendto,
integer, dimension(ninter+1,nspmd+1), intent(in) irecvfrom,
integer, dimension(npari,ninter), intent(inout) ipari,
integer, dimension(2,nspmd+1), intent(in) iad_elem,
integer, dimension(sfr_elem), intent(in) fr_elem,
intent(in) x,
intent(in) v,
intent(in) ms,
intent(in) temp,
integer, dimension(numnod), intent(in) kinet,
integer, dimension(nodnx_sms_siz), intent(in) nodnx_sms,
integer, dimension(numnod), intent(in) itab,
integer, dimension(numnod), intent(inout) weight,
type(intbuf_struct_), dimension(ninter), intent(inout) intbuf_tab,
type(inter_struct_type), dimension(ninter), intent(inout) inter_struct,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
integer, intent(in) nodnx_sms_siz,
integer, intent(in) temp_siz,
type(component_), dimension(ninter), intent(inout) component )

Definition at line 52 of file inter_prepare_sort.F.

57
58!$COMMENT
59! INTER_PREPARE_SORT description
60! first step of the sort : creation of coarse & fine grids
61! exchange of cell (coarse & fine grid) between processor
62
63! INTER_PREPARE_SORT organization :
64! * computation of the bounds
65! * exchange & globalization of the bounds
66! * creation of a common grid (coarse & fine)
67! * coloration of coarse grid
68! * exchange of coarse cells to limit the amount of comm. between proc
69! * coloration of the fine grid
70! * exchange the number of local cell (fine grid)
71! * create the voxel of secondary nodes
72! * prepare the comm of remote secondary nodes
73!$ENDCOMMENT
74C-----------------------------------------------
75C M o d u l e s
76C-----------------------------------------------
77 USE intbufdef_mod
78 USE inter_struct_mod
79 USE inter_sorting_mod
80 USE tri7box
81 USE fill_voxel_mod
82 USE voxel_dimensions_mod, ONLY : compute_voxel_dimensions
83 USE command_line_args_mod, ONLY : got_preview
84 use inter_component_bound_mod , only : inter_component_bound
85 use spmd_exchange_component_mod , only : spmd_exchange_component
86
87C-----------------------------------------------
88C I m p l i c i t T y p e s
89C-----------------------------------------------
90#include "implicit_f.inc"
91C-----------------------------------------------
92C C o m m o n B l o c k s
93C-----------------------------------------------
94#include "com01_c.inc"
95#include "com04_c.inc"
96#include "param_c.inc"
97#include "tabsiz_c.inc"
98C-----------------------------------------------
99C D u m m y A r g u m e n t s
100C-----------------------------------------------
101 INTEGER, INTENT(in) :: ITASK ! omp thread ID
102 INTEGER, INTENT(in) :: NB_INTER_SORTED ! number of interfaces that need to be sorted
103 INTEGER, INTENT(in) :: NODNX_SMS_SIZ! size of NODNX_SMS
104 INTEGER, INTENT(in) :: TEMP_SIZ ! size of TEMP
105 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED ! list of interfaces that need to be sorted
106 INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: ISENDTO,IRECVFROM ! array for S and R : isendto = nsn ; ircvfrom = nmn
107 INTEGER,DIMENSION(NPARI,NINTER), INTENT(inout) :: IPARI
108 my_real, DIMENSION(3*NUMNOD), INTENT(in) :: x ! position
109 my_real, DIMENSION(3*NUMNOD), INTENT(in) :: v ! velocity
110 my_real, DIMENSION(NUMNOD), INTENT(in) :: ms ! mass
111 my_real, DIMENSION(TEMP_SIZ), INTENT(in) :: temp ! temperature
112 INTEGER, DIMENSION(NUMNOD), INTENT(inout) :: WEIGHT ! weight : 1 if current proc computes the node
113 INTEGER, DIMENSION(NUMNOD), INTENT(in) :: ITAB ! global node ID
114 INTEGER, DIMENSION(NUMNOD), INTENT(in) :: KINET ! k energy &
115 INTEGER, DIMENSION(NODNX_SMS_SIZ), INTENT(in) :: NODNX_SMS ! SMS array
116 INTEGER, DIMENSION(2,NSPMD+1), INTENT(in) :: IAD_ELEM ! connectivity array iad(P+1)-iad(P) = nb of frontier node on P
117 INTEGER, DIMENSION(SFR_ELEM), INTENT(in) :: FR_ELEM ! frontier node ID
118
119
120 TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB ! interface data
121 TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT ! structure for interface
122 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
123 type(component_), dimension(ninter), intent(inout) :: component
124C-----------------------------------------------
125C L o c a l V a r i a b l e s
126C-----------------------------------------------
127 LOGICAL :: TYPE18
128 INTEGER :: KK,N
129 INTEGER :: INACTI,NTY
130 INTEGER :: NB_REQUEST_COARSE_CELL ! number of request for coarse cell comm
131 integer :: mode
132 INTEGER, DIMENSION(NB_INTER_SORTED) :: ARRAY_REQUEST_COARSE_CELL ! array of request
133 INTEGER, DIMENSION(NB_INTER_SORTED) :: LIST_INTER_COARSE_CELL ! list of interface
134 integer :: nsn, nsnr, nrtm, nmn
135 integer :: DUMMY(1)
136 my_real :: tzinf,curv
137! ----------------------------------------
138 nsn = 0
139 nsnr = 0
140 nrtm = 0
141 nmn = 0
142
143 ! -----------------------------
144 ! compute the min/max position
145 IF(nb_inter_sorted>0) THEN
146 if(itask==0) then
147 box_limit(1:3) = -ep30
148 box_limit(4:6) = ep30
149 endif
150 call my_barrier( )
151
152 ! ---------------------
153 ! compute the curv and the number of main nodes
154 ! the min/max position of main nodes
155 ! and the min/max position of S nodes
156 ! to create the bounding box "box_limit"
157 DO kk=1,nb_inter_sorted
158 n = list_inter_sorted(kk)
159 nty = ipari(7,n)
160 inacti = ipari(22,n)
161 type18 = .false.
162 IF(nty == 7 .AND. inacti ==7)type18=.true.
163 ! FILLS INTER_STRUCT%BOX_LIMIT_MAIN
164 CALL inter_count_node_curv( n,itask,ipari,intbuf_tab,
165 1 x,inter_struct)
166 CALL my_barrier()
167 tzinf = intbuf_tab(n)%variables(tzinf_index)
168 curv = inter_struct(n)%curv_max_max
169 call inter_component_bound(numnod,tzinf,curv,x,component(n))
170 ENDDO
171 ! ---------------------
172 CALL my_barrier()
173 ENDIF
174 ! -----------------------------
175
176 ! -----------------------------
177 ! globalization of min/max position
178 IF(nspmd>1.AND.need_to_sort>0)THEN
179 IF(itask==0) THEN
180 CALL spmd_box_limit_reduction(nb_inter_sorted,box_limit)
181 ENDIF
182 CALL my_barrier()
183 ENDIF
184 ! -----------------------------
185
186 ! -----------------------------
187 ! allocation & initialization of coarse_grid
188 IF(itask==0) THEN
189 IF(.NOT.ALLOCATED(local_coarse_grid)) THEN
190 ALLOCATE(local_coarse_grid(nb_box_coarse_grid**3+1))
191 ENDIF
192 local_coarse_grid(1:nb_box_coarse_grid**3+1) = 0
193 ENDIF
194 CALL my_barrier()
195 ! -----------------------------
196
197 ! -----------------------------
198 ! color the coarse grid
199 IF(nb_inter_sorted>0) THEN
200 IF(itask==0) CALL inter_box_creation(nb_cell_x,nb_cell_y,nb_cell_z,box_limit)
201 CALL my_barrier()
202 CALL inter_color_coarse_voxel(itask,nb_inter_sorted,list_inter_sorted,ipari,intbuf_tab,
203 . x,sort_comm)
204 ENDIF
205 ! -----------------------------
206
207 ! -----------------------------
208 ! exchange of coarse_grid : send/rcv part
209 IF(nspmd>1.AND.need_to_sort>0)THEN
210 IF(itask==0) THEN
211 do kk=1,nb_inter_sorted
212 n = list_inter_sorted(kk)
213 call spmd_exchange_component(1,nspmd,component(n))
214 enddo
215 ENDIF
216 ENDIF
217 ! -----------------------------
218
219 ! -----------------------------
220 ! color the voxel (fine grid)
221 IF(nb_inter_sorted>0) THEN
222 CALL my_barrier()
223 CALL inter_color_voxel( itask,nb_inter_sorted,list_inter_sorted,ipari,intbuf_tab,
224 . x,inter_struct,sort_comm )
225 ENDIF
226 ! -----------------------------
227
228
229 IF(need_to_sort>0)THEN
230 IF(nspmd > 1 .AND. itask == 0) THEN
231 ! -----------------------------
232 do kk=1,nb_inter_sorted
233 n = list_inter_sorted(kk)
234 call spmd_exchange_component(2,nspmd,component(n))
235 enddo
236
237 DO kk=1,nb_inter_sorted
238 n = list_inter_sorted(kk)
239 mode = 1
240 ! -----------------------------
241 ! exchange of number of colored cells (fine grid)
242 CALL spmd_cell_list_exchange(irecvfrom,isendto,mode,weight,iad_elem,
243 . fr_elem,x,v,ms,temp,
244 . kinet,nodnx_sms,itab,intbuf_tab,ipari,
245 . n,inter_struct,sort_comm,nodnx_sms_siz,temp_siz, got_preview,component) ! size of cell list
246 ! -----------------------------
247 if(got_preview == 1) THEN
248 nrtm = ipari(4,n)
249 nsn = ipari(5,n)
250 nsnr = ipari(24,n)
251 nmn = ipari(6,n)
252 call compute_voxel_dimensions(nmn, nrtm, inter_struct(n))
253 endif
254 ! -----------------------------
255 ! creation of voxel of secondary nodes
256 ! wait comm R "exchange of number of colored cells" & send/rcv the colored cells
257 CALL inter_voxel_creation(ipari,intbuf_tab,x,n,sort_comm)! create the voxel of secondary nodes
258 mode = 2
259 CALL spmd_cell_list_exchange(irecvfrom,isendto,mode,weight,iad_elem,
260 . fr_elem,x,v,ms,temp,
261 . kinet,nodnx_sms,itab,intbuf_tab,ipari,
262 . n,inter_struct,sort_comm,nodnx_sms_siz,temp_siz, got_preview,component) ! mpi wait size of cell list
263
264 ! -----------------------------
265 if(got_preview == 1) THEN
266 CALL fill_voxel_local_partial(nsn,intbuf_tab(n)%nsv,nsnr,nrtm,numnod,x,intbuf_tab(n)%stfns,inter_struct(n),
267 . sort_comm(n)%request_cell_rcv, sort_comm(n)%NB_REQUEST_CELL_RCV)
268 endif
269 ! -----------------------------
270 ! wait comm R "send/rcv the colored cells"
271 ! and compute the number of secondary nodes needed by remote proc
272 ! + comm of "number of secondary nodes needed by remote proc"
273 ! + creation of the secondary node list
274 ! + initialize the S buffer of secondary node data (x & v)
275 CALL spmd_cell_list_exchange(irecvfrom,isendto,3,weight,iad_elem,
276 . fr_elem,x,v,ms,temp,
277 . kinet,nodnx_sms,itab,intbuf_tab,ipari,
278 . n,inter_struct,sort_comm,nodnx_sms_siz,temp_siz, got_preview,component)
279
280 ENDDO
281 ELSEIF (itask == 0) THEN
282 DO kk=1,nb_inter_sorted
283 n = list_inter_sorted(kk)
284 if(got_preview == 1) THEN
285 nrtm = ipari(4,n) ; nsn = ipari(5,n) ; nsnr = ipari(24,n) ; nmn = ipari(6,n)
286 call compute_voxel_dimensions(nmn, nrtm, inter_struct(n))
287 CALL fill_voxel_local_partial(nsn,intbuf_tab(n)%nsv,nsnr,nrtm,numnod,x,
288 . intbuf_tab(n)%stfns,inter_struct(n),dummy,0)
289 ENDIF
290 ENDDO
291 ENDIF
292 ENDIF
293
294
295 ! -----------------------------
296
297 ! -----------------------------
298 ! Fill the voxels with local secondary nodes
299
300 ! -----------------------------
301 ! wait comm S "send/rcv the colored cells"
302 ! wait comm S/R "number of secondary nodes needed by remote proc"
303 DO kk=1,nb_inter_sorted
304 n = list_inter_sorted(kk)
305 IF(nspmd>1.AND.need_to_sort>0)THEN
306 IF(itask==0) THEN
307 ! wait comm S "send/rcv the colored cells"
308 CALL spmd_cell_list_exchange(irecvfrom,isendto,4,weight,iad_elem,
309 . fr_elem,x,v,ms,temp,
310 . kinet,nodnx_sms,itab,intbuf_tab,ipari,
311 . n,inter_struct,sort_comm,nodnx_sms_siz,temp_siz, got_preview,component)
312 ! wait "number of secondary nodes needed by remote proc"
313 if(got_preview == 1) THEN
314 nrtm = ipari(4,n) ; nsn = ipari(5,n) ; nsnr = ipari(24,n) ; nmn = ipari(6,n)
315 CALL fill_voxel_local_partial(nsn,intbuf_tab(n)%nsv,nsnr,nrtm,numnod,x,intbuf_tab(n)%stfns,inter_struct(n),
316 . sort_comm(n)%REQUEST_NB_R, sort_comm(n)%NBRECV_NB)
317 endif
318
319 CALL spmd_wait_nb(irecvfrom,isendto,n,sort_comm)
320 ENDIF
321 CALL my_barrier()
322 ENDIF
323 ENDDO
324
325
326
327 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
inter_box_creation
subroutine inter_box_creation(nb_cell_x, nb_cell_y, nb_cell_z, box_limit)
Definition inter_box_creation.F:32
inter_color_coarse_voxel
subroutine inter_color_coarse_voxel(itask, nb_inter_sorted, list_inter_sorted, ipari, intbuf_tab, x, sort_comm)
Definition inter_color_coarse_voxel.F:35
inter_color_voxel
subroutine inter_color_voxel(itask, nb_inter_sorted, list_inter_sorted, ipari, intbuf_tab, x, inter_struct, sort_comm)
Definition inter_color_voxel.F:38
inter_count_node_curv
subroutine inter_count_node_curv(nin, itask, ipari, intbuf_tab, x, inter_struct)
Definition inter_count_node_curv.F:40
inter_voxel_creation
subroutine inter_voxel_creation(ipari, intbuf_tab, x, nin, sort_comm)
Definition inter_voxel_creation.F:32
command_line_args_mod
Definition command_line_args.F:31
command_line_args_mod::got_preview
integer got_preview
Definition command_line_args.F:32
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::need_to_sort
integer need_to_sort
Definition inter_sorting_mod.F:62
inter_sorting_mod::nb_box_coarse_grid
integer, parameter nb_box_coarse_grid
Definition inter_sorting_mod.F:70
inter_sorting_mod::local_coarse_grid
integer, dimension(:), allocatable local_coarse_grid
Definition inter_sorting_mod.F:74
inter_sorting_mod::nb_cell_z
integer nb_cell_z
Definition inter_sorting_mod.F:72
inter_sorting_mod::nb_cell_y
integer nb_cell_y
Definition inter_sorting_mod.F:72
inter_sorting_mod::nb_cell_x
integer nb_cell_x
Definition inter_sorting_mod.F:72
inter_struct_mod
Definition inter_struct_mod.F:49
spmd_box_limit_reduction
subroutine spmd_box_limit_reduction(nb_inter_sorted, box_limit)
Definition spmd_box_limit_reduction.F:35
spmd_cell_list_exchange
subroutine spmd_cell_list_exchange(ircvfrom, isendto, mode, weight, iad_elem, fr_elem, x, v, ms, temp, kinet, nodnx_sms, itab, intbuf_tab, ipari, nin, inter_struct, sort_comm, nodnx_sms_siz, temp_size, got_preview, component)
Definition spmd_cell_list_exchange.F:44
spmd_wait_nb
subroutine spmd_wait_nb(ircvfrom, isendto, nin, sort_comm)
Definition spmd_wait_nb.F:35
my_barrier
subroutine my_barrier
Definition machine.F:31