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,J
78 INTEGER :: P,P_LOC,LOCAL_RANK
79 INTEGER :: MY_SIZE,OLD_POINTER
80 INTEGER :: ADRESS,SHIFT_
81
82 INTEGER IERROR1,STATUS(MPI_STATUS_SIZE),IERROR
83 INTEGER :: SIZE_CELL_LIST,TOTAL_RCV_SIZE,TOTAL_SEND_SIZE
84 INTEGER :: LOC_PROC,ID_PROC
85 INTEGER :: COUNT_COMM_SIZE_CELL,ID_COMM
86 INTEGER :: ITIED
87! ----------------------------------------
88 loc_proc = ispmd + 1
89 ! -------------------------
90 ! MODE=1 : alltoall comm --> exchange of coarse cell
91 IF(mode==1) THEN
92 nb_request_coarse_cell = 0
93 DO kk=1,nb_inter_sorted
94 nin = list_inter_sorted(kk)
95 array_request_coarse_cell(kk) = mpi_request_null
96 IF(sort_comm(nin)%PROC_NUMBER>nspmd/2) THEN
97 IF(irecvfrom(nin,loc_proc)==0.AND.isendto(nin,loc_proc)==0) cycle
98
99 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_SIZE_COARSE_CELL)) THEN
100 my_size = sort_comm(nin)%PROC_NUMBER
101 ALLOCATE(sort_comm(nin)%SEND_SIZE_COARSE_CELL(my_size))
102 ENDIF
103
104 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_SIZE_COARSE_CELL)) THEN
105 my_size = sort_comm(nin)%PROC_NUMBER
106 ALLOCATE(sort_comm(nin)%RCV_SIZE_COARSE_CELL(my_size))
107 ENDIF
108
109 IF(.NOT.ALLOCATED(sort_comm(nin)%SEND_DISPLS_COARSE_CELL)) THEN
110 my_size = sort_comm(nin)%PROC_NUMBER
111 ALLOCATE(sort_comm(nin)%SEND_DISPLS_COARSE_CELL(my_size))
112 ENDIF
113
114 IF(.NOT.ALLOCATED(sort_comm(nin)%RCV_DISPLS_COARSE_CELL)) THEN
115 my_size = sort_comm(nin)%PROC_NUMBER
116 ALLOCATE(sort_comm(nin)%RCV_DISPLS_COARSE_CELL(my_size))
117 ENDIF
118
119!isendto = nsn
120!IRECVFROM = nmn
121 total_rcv_size = 0
122 DO i=1,sort_comm(nin)%PROC_NUMBER
123 id_proc = sort_comm(nin)%PROC_LIST(i)
124 sort_comm(nin)%SEND_SIZE_COARSE_CELL(i) = 0
125 IF(isendto(nin,loc_proc)>0.AND.irecvfrom(nin,id_proc)>0) THEN ! nmn of proc ID_PROC >0
126 sort_comm(nin)%SEND_SIZE_COARSE_CELL(i) = nb_box_coarse_grid**3 + 1
127 ENDIF
128 sort_comm(nin)%SEND_DISPLS_COARSE_CELL(i) = 0
129
130 sort_comm(nin)%RCV_SIZE_COARSE_CELL(i) = 0
131 IF(irecvfrom(nin,loc_proc)>0.AND.isendto(nin,id_proc)>0) THEN ! nmn of current proc >0
132 sort_comm(nin)%RCV_SIZE_COARSE_CELL(i) = nb_box_coarse_grid**3 + 1
133 ENDIF
134 sort_comm(nin)%RCV_DISPLS_COARSE_CELL(i) = total_rcv_size
135 IF(irecvfrom(nin,loc_proc)>0.AND.isendto(nin,id_proc)>0) THEN ! nmn of current proc >0
136 total_rcv_size = total_rcv_size + nb_box_coarse_grid**3 + 1
137 ENDIF
138 ENDDO
139
140 IF(.NOT.ALLOCATED(sort_comm(nin)%GLOBAL_COARSE_CELL ) )THEN
141 ALLOCATE(sort_comm(nin)%GLOBAL_COARSE_CELL(total_rcv_size))
142 ENDIF
143 sort_comm(nin)%SIZE_GLOBAL_COARSE_CELL = total_rcv_size
144
145 IF(isendto(nin,loc_proc)>0) total_send_size = nb_box_coarse_grid**3 + 1
146
147 nb_request_coarse_cell = nb_request_coarse_cell + 1
148 list_inter_coarse_cell(nb_request_coarse_cell) = nin
149
150 CALL spmd_ialltoallv_int(sort_comm(nin)%COARSE_GRID,
151 . sort_comm(nin)%GLOBAL_COARSE_CELL,sort_comm(nin)%SEND_SIZE_COARSE_CELL,total_send_size,
152 . sort_comm(nin)%SEND_DISPLS_COARSE_CELL,
153 . total_rcv_size,sort_comm(nin)%RCV_SIZE_COARSE_CELL,
154 . sort_comm(nin)%RCV_DISPLS_COARSE_CELL,array_request_coarse_cell(nb_request_coarse_cell),
155 . sort_comm(nin)%COMM,sort_comm(nin)%PROC_NUMBER)
156 ENDIF
157 ENDDO
158 ENDIF
159 ! -------------------------
160 ! MODE=2 : - wait the previous comm
161 ! - check if current proc and remote proc need to communicate
162 IF(mode==2) THEN
163 DO kk=1,nb_request_coarse_cell
164 CALL mpi_wait(array_request_coarse_cell(kk),status,ierror)
165 nin = list_inter_coarse_cell(kk)
166 itied = ipari(85,nin)
167 CALL check_coarse_grid(nin,sort_comm(nin)%MAIN_COARSE_GRID,sort_comm,itied)
168
169 DEALLOCATE( sort_comm(nin)%GLOBAL_COARSE_CELL )
170 DEALLOCATE( sort_comm(nin)%COARSE_GRID )
171 ENDDO
172 nb_request_coarse_cell = 0
173 ENDIF
174! -------------------------
175
176#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