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

Go to the source code of this file.

Functions/Subroutines

subroutine spmd_coarse_cell_exchange (nb_inter_sorted, list_inter_sorted, irecvfrom, isendto, mode, ipari, sort_comm, nb_request_coarse_cell, array_request_coarse_cell, list_inter_coarse_cell)

Function/Subroutine Documentation

◆ spmd_coarse_cell_exchange()

subroutine spmd_coarse_cell_exchange ( integer, intent(in) nb_inter_sorted,
integer, dimension(nb_inter_sorted), intent(in) list_inter_sorted,
integer, dimension(ninter+1,nspmd+1), intent(in) irecvfrom,
integer, dimension(ninter+1,nspmd+1), intent(in) isendto,
integer, intent(in) mode,
integer, dimension(npari,ninter), intent(in) ipari,
type(sorting_comm_type), dimension(ninter), intent(inout) sort_comm,
integer, intent(inout) nb_request_coarse_cell,
integer, dimension(nb_inter_sorted), intent(inout) array_request_coarse_cell,
integer, dimension(nb_inter_sorted), intent(inout) list_inter_coarse_cell )

Definition at line 31 of file spmd_coarse_cell_exchange.F.

33!$COMMENT
34! SPMD_COARSE_CELL_EXCHANGE description :
35! for large interfaces : communication of coarse cells with alltoll mpi comm
36! and check if 2 procs need to echange data
37!
38! SPMD_COARSE_CELL_EXCHANGE organization :
39! First part MODE=1 : alltoall comm --> exchange of coarse cell
40! Second part MODE=2 : wait & check if 2 processors for a given interface need to echange data
41!$ENDCOMMENT
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE inter_sorting_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C M e s s a g e P a s s i n g
52C-----------------------------------------------
53#include "spmd.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "param_c.inc"
60#include "task_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(in) :: NB_INTER_SORTED ! number of interfaces that need to be sorted
65 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED ! list of interfaces that need to be sorted
66 INTEGER, INTENT(in) :: MODE ! Mode: 1 -> End / RCV / 2 -> Wait + Computation
67 INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: ISENDTO,IRECVFROM ! array for S and R : isendto = nsn ; IRECVFROM = nmn
68 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI ! interface data
69 TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM ! structure for interface sorting comm
70 INTEGER, INTENT(inout) :: NB_REQUEST_COARSE_CELL ! number of request
71 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(inout) :: ARRAY_REQUEST_COARSE_CELL ! array of request
72 INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(inout) :: LIST_INTER_COARSE_CELL ! list of interface
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76#ifdef MPI
77 INTEGER :: KK,NIN,I
78 INTEGER :: MY_SIZE
79
80 INTEGER STATUS(MPI_STATUS_SIZE),IERROR
81 INTEGER :: TOTAL_RCV_SIZE,TOTAL_SEND_SIZE
82 INTEGER :: LOC_PROC,ID_PROC
83 INTEGER :: ITIED
84! ----------------------------------------
85 loc_proc = ispmd + 1
86 ! -------------------------
87 ! MODE=1 : alltoall comm --> exchange of coarse cell
88 IF(mode==1) THEN
89 nb_request_coarse_cell = 0
90 DO kk=1,nb_inter_sorted
91 nin = list_inter_sorted(kk)
92 array_request_coarse_cell(kk) = mpi_request_null
93 IF(sort_comm(nin)%PROC_NUMBER>nspmd/2) THEN
94 IF(irecvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) cycle
95
96 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_SIZE_COARSE_CELL)) THEN
97 my_size = sort_comm(nin)%PROC_NUMBER
98 ALLOCATE(sort_comm(nin)%SEND_SIZE_COARSE_CELL(my_size))
99 ENDIF
100
101 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_SIZE_COARSE_CELL)) THEN
102 my_size = sort_comm(nin)%PROC_NUMBER
103 ALLOCATE(sort_comm(nin)%RCV_SIZE_COARSE_CELL(my_size))
104 ENDIF
105
106 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_DISPLS_COARSE_CELL)) THEN
107 my_size = sort_comm(nin)%PROC_NUMBER
108 ALLOCATE(sort_comm(nin)%SEND_DISPLS_COARSE_CELL(my_size))
109 ENDIF
110
111 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_DISPLS_COARSE_CELL)) THEN
112 my_size = sort_comm(nin)%PROC_NUMBER
113 ALLOCATE(sort_comm(nin)%RCV_DISPLS_COARSE_CELL(my_size))
114 ENDIF
115
116!isendto = nsn
117!IRECVFROM = nmn
118 total_rcv_size = 0
119 DO i=1,sort_comm(nin)%PROC_NUMBER
120 id_proc = sort_comm(nin)%PROC_LIST(i)
121 sort_comm(nin)%SEND_SIZE_COARSE_CELL(i) = 0
122 IF(isendto(nin,loc_proc)>0.AND.irecvfrom(nin,id_proc)>0) THEN ! nmn of proc ID_PROC >0
123 sort_comm(nin)%SEND_SIZE_COARSE_CELL(i) = nb_box_coarse_grid**3 + 1
124 ENDIF
125 sort_comm(nin)%SEND_DISPLS_COARSE_CELL(i) = 0
126
127 sort_comm(nin)%RCV_SIZE_COARSE_CELL(i) = 0
128 IF(irecvfrom(nin,loc_proc)>0.AND.isendto(nin,id_proc)>0) THEN ! nmn of current proc >0
129 sort_comm(nin)%RCV_SIZE_COARSE_CELL(i) = nb_box_coarse_grid**3 + 1
130 ENDIF
131 sort_comm(nin)%RCV_DISPLS_COARSE_CELL(i) = total_rcv_size
132 IF(irecvfrom(nin,loc_proc)>0.AND.isendto(nin,id_proc)>0) THEN ! nmn of current proc >0
133 total_rcv_size = total_rcv_size + nb_box_coarse_grid**3 + 1
134 ENDIF
135 ENDDO
136
137 IF(.NOT.ALLOCATED(sort_comm(nin)%GLOBAL_COARSE_CELL ) )THEN
138 ALLOCATE(sort_comm(nin)%GLOBAL_COARSE_CELL(total_rcv_size))
139 ENDIF
140 sort_comm(nin)%SIZE_GLOBAL_COARSE_CELL = total_rcv_size
141
142 IF(isendto(nin,loc_proc)>0) total_send_size = nb_box_coarse_grid**3 + 1
143
144 nb_request_coarse_cell = nb_request_coarse_cell + 1
145 list_inter_coarse_cell(nb_request_coarse_cell) = nin
146
147 CALL spmd_ialltoallv_int(sort_comm(nin)%COARSE_GRID,
148 . sort_comm(nin)%GLOBAL_COARSE_CELL,sort_comm(nin)%SEND_SIZE_COARSE_CELL,total_send_size,
149 . sort_comm(nin)%SEND_DISPLS_COARSE_CELL,
150 . total_rcv_size,sort_comm(nin)%RCV_SIZE_COARSE_CELL,
151 . sort_comm(nin)%RCV_DISPLS_COARSE_CELL,array_request_coarse_cell(nb_request_coarse_cell),
152 . sort_comm(nin)%COMM,sort_comm(nin)%PROC_NUMBER)
153 ENDIF
154 ENDDO
155 ENDIF
156 ! -------------------------
157 ! MODE=2 : - wait the previous comm
158 ! - check if current proc and remote proc need to communicate
159 IF(mode==2) THEN
160 DO kk=1,nb_request_coarse_cell
161 CALL mpi_wait(array_request_coarse_cell(kk),status,ierror)
162 nin = list_inter_coarse_cell(kk)
163 itied = ipari(85,nin)
164 CALL check_coarse_grid(nin,sort_comm(nin)%MAIN_COARSE_GRID,sort_comm,itied)
165
166 DEALLOCATE( sort_comm(nin)%GLOBAL_COARSE_CELL )
167 DEALLOCATE( sort_comm(nin)%COARSE_GRID )
168 ENDDO
169 nb_request_coarse_cell = 0
170 ENDIF
171! -------------------------
172
173#endif
check_coarse_grid
subroutine check_coarse_grid(nin, main_coarse_grid, sort_comm, itied)
Definition check_coarse_grid.F:31
mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525
inter_sorting_mod
Definition inter_sorting_mod.F:57
inter_sorting_mod::nb_box_coarse_grid
integer, parameter nb_box_coarse_grid
Definition inter_sorting_mod.F:70
spmd_ialltoallv_int
subroutine spmd_ialltoallv_int(sendbuf, recvbuf, send_size, total_send_size, sdispls, total_rcv_size, rcv_size, rdispls, request, comm, nb_proc)
Definition spmd_ialltoallv_int.F:35