OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_prepare_sort.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| inter_prepare_sort ../engine/source/interfaces/generic/inter_prepare_sort.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| compute_voxel_dimensions ../engine/source/interfaces/intsort/voxel_dimensions.f90
29!|| fill_voxel_local_partial ../engine/source/interfaces/intsort/fill_voxel.F90
30!|| inter_box_creation ../engine/source/interfaces/generic/inter_box_creation.F
31!|| inter_color_coarse_voxel ../engine/source/interfaces/generic/inter_color_coarse_voxel.F
32!|| inter_color_voxel ../engine/source/interfaces/generic/inter_color_voxel.F
33!|| inter_component_bound ../engine/source/interfaces/generic/inter_component_bound.F90
34!|| inter_count_node_curv ../engine/source/interfaces/generic/inter_count_node_curv.F
35!|| inter_voxel_creation ../engine/source/interfaces/generic/inter_voxel_creation.F
36!|| my_barrier ../engine/source/system/machine.F
37!|| spmd_box_limit_reduction ../engine/source/mpi/interfaces/spmd_box_limit_reduction.F
38!|| spmd_cell_list_exchange ../engine/source/mpi/interfaces/spmd_cell_list_exchange.F
39!|| spmd_exchange_component ../engine/source/mpi/interfaces/spmd_exch_component.F90
40!|| spmd_wait_nb ../engine/source/mpi/interfaces/spmd_wait_nb.f
41!||--- uses -----------------------------------------------------
42!|| command_line_args_mod ../engine/share/modules/command_line_args.F
43!|| fill_voxel_mod ../engine/source/interfaces/intsort/fill_voxel.F90
44!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
45!|| inter_component_bound_mod ../engine/source/interfaces/generic/inter_component_bound.F90
46!|| inter_sorting_mod ../engine/share/modules/inter_sorting_mod.F
47!|| inter_struct_mod ../engine/share/modules/inter_struct_mod.F
48!|| spmd_exchange_component_mod ../engine/source/mpi/interfaces/spmd_exch_component.F90
49!|| tri7box ../engine/share/modules/tri7box.F
50!|| voxel_dimensions_mod ../engine/source/interfaces/intsort/voxel_dimensions.F90
51!||====================================================================
52 SUBROUTINE inter_prepare_sort( ITASK,NB_INTER_SORTED,LIST_INTER_SORTED,ISENDTO,IRECVFROM,
53 . IPARI,IAD_ELEM,FR_ELEM,X,V,
54 . MS,TEMP,KINET,NODNX_SMS,ITAB,
55 . WEIGHT,INTBUF_TAB,INTER_STRUCT,SORT_COMM,NODNX_SMS_SIZ,
56 . TEMP_SIZ, component )
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
80 USE tri7box
81 USE fill_voxel_mod
82 USE voxel_dimensions_mod, ONLY : compute_voxel_dimensions
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
191 ENDIF
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
328 END SUBROUTINE inter_prepare_sort
#define my_real
Definition cppsort.cpp:32
end diagonal values have been computed in the(sparse) matrix id.SOL
subroutine inter_box_creation(nb_cell_x, nb_cell_y, nb_cell_z, box_limit)
subroutine inter_color_coarse_voxel(itask, nb_inter_sorted, list_inter_sorted, ipari, intbuf_tab, x, sort_comm)
subroutine inter_color_voxel(itask, nb_inter_sorted, list_inter_sorted, ipari, intbuf_tab, x, inter_struct, sort_comm)
subroutine inter_count_node_curv(nin, itask, ipari, intbuf_tab, x, inter_struct)
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)
subroutine inter_voxel_creation(ipari, intbuf_tab, x, nin, sort_comm)
integer, parameter nb_box_coarse_grid
integer, dimension(:), allocatable local_coarse_grid
subroutine spmd_box_limit_reduction(nb_inter_sorted, box_limit)
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)
subroutine spmd_wait_nb(ircvfrom, isendto, nin, sort_comm)
subroutine my_barrier
Definition machine.F:31