Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* ABINIT/xmpi_alltoallv_dp2d
3 : : !! NAME
4 : : !! xmpi_alltoallv_dp2d
5 : : !!
6 : : !! FUNCTION
7 : : !! This module contains functions calling the MPI routine ALLTOALLV
8 : : !! xmpi_alltoallv is the generic function.
9 : : !!
10 : : !! COPYRIGHT
11 : : !! Copyright (C) 2001-2026 ABINIT group (AR,XG)
12 : : !! This file is distributed under the terms of the
13 : : !! GNU General Public License, see ~ABINIT/COPYING
14 : : !! or http://www.gnu.org/copyleft/gpl.txt .
15 : : !!
16 : : !! INPUTS
17 : : !! xval= buffer array
18 : : !! sendcnts= number of sent elements
19 : : !! sdispls= postions of values sent by the processor
20 : : !! rdispls= positions of values received by the processor
21 : : !! recvcnts= number of received elements
22 : : !! comm= MPI communicator
23 : : !!
24 : : !! OUTPUT
25 : : !! ier= exit status, a non-zero value meaning there is an error
26 : : !!
27 : : !! SIDE EFFECTS
28 : : !! recvbuf= received buffer
29 : : !!
30 : : !! SOURCE
31 : :
32 [ - + - + : 2172160 : subroutine xmpi_alltoallv_dp2d(xval,sendcnts,sdispls,recvbuf,recvcnts,rdispls,comm,ier,use_omp_map)
- + - + -
+ - + ]
33 : :
34 : : !Arguments-------------------------
35 : : real(dp), DEV_CONTARRD intent(in) :: xval(:,:)
36 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:)
37 : : integer , DEV_CONTARRD intent(in) :: sendcnts(:),sdispls(:),rdispls(:),recvcnts(:)
38 : : integer ,intent(in) :: comm
39 : : integer ,intent(out) :: ier
40 : : logical ,intent(in), optional :: use_omp_map
41 : :
42 : : !Local variables-------------------
43 : : logical :: l_use_omp_map
44 : : integer :: sc,sds,sdr,sz1
45 : : integer :: i
46 : : #ifdef HAVE_OPENMP_OFFLOAD
47 : : integer :: j
48 : : #endif
49 : :
50 : : ! *********************************************************************
51 : :
52 : 2172160 : ier=0
53 : : #if defined HAVE_MPI
54 : 2172160 : l_use_omp_map=.false.
55 [ + + ]: 2172160 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
56 [ + + ]: 2172160 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
57 [ + - ]: 2163860 : if(.not. l_use_omp_map) then
58 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
59 [ - + - - : 2163860 : & recvcnts,rdispls,MPI_DOUBLE_PRECISION,comm,ier)
- - - + -
- - - - +
- - - - -
+ - - - -
- + - + -
- - + - -
- + - + -
- - + -
- ]
60 : : else
61 : : #ifdef HAVE_OPENMP_OFFLOAD
62 : : #ifdef HAVE_GPU_MPI
63 : : ! Proper GPU-aware call
64 : : !$OMP TARGET DATA USE_DEVICE_ADDR(xval,recvbuf)
65 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
66 : : & recvcnts,rdispls,MPI_DOUBLE_PRECISION,comm,ier)
67 : : !$OMP END TARGET DATA
68 : : #else
69 : : !$OMP TARGET UPDATE FROM(xval)
70 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
71 : : & recvcnts,rdispls,MPI_DOUBLE_PRECISION,comm,ier)
72 : : !$OMP TARGET UPDATE TO(recvbuf)
73 : : #endif
74 : : #endif
75 : : end if
76 [ + - ]: 8300 : else if (comm == MPI_COMM_SELF) then
77 : : #endif
78 : 8300 : sz1=size(xval,1)
79 [ + - ]: 8300 : sds=0;if (size(sdispls)>0) sds=sdispls(1)/sz1
80 [ + - ]: 8300 : sdr=0;if (size(rdispls)>0) sdr=rdispls(1)/sz1
81 [ + - ]: 8300 : sc=size(xval,2);if (size(sendcnts)>0) sc=sendcnts(1)/sz1
82 [ + - ]: 8300 : if(.not. l_use_omp_map) then
83 : : !$OMP parallel do
84 [ + + ]: 58623600 : do i=1,sc
85 [ + + ]: 175854200 : recvbuf(:,sdr+i)=xval(:,sds+i)
86 : : end do
87 : : else
88 : : #ifdef HAVE_OPENMP_OFFLOAD
89 : : !$OMP TARGET PARALLEL DO COLLAPSE(2) MAP(to:xval,recvbuf) PRIVATE(i,j)
90 : : do i=1,sc
91 : : do j=1,sz1
92 : : recvbuf(j,sdr+i)=xval(j,sds+i)
93 : : end do
94 : : end do
95 : : #endif
96 : : end if
97 : :
98 : : #if defined HAVE_MPI
99 : : end if
100 : : #endif
101 : :
102 : 2172160 : end subroutine xmpi_alltoallv_dp2d
103 : : !!***
104 : :
105 : : !!****f* ABINIT/xmpi_alltoallv_int2d
106 : : !! NAME
107 : : !! xmpi_alltoallv_int2d
108 : : !!
109 : : !! FUNCTION
110 : : !! Sends data from all to all processes.
111 : : !! Target: two-dimensional integer arrays.
112 : : !!
113 : : !! SOURCE
114 : :
115 [ - + - + : 788 : subroutine xmpi_alltoallv_int2d(xval,sendcnts,sdispls,recvbuf,recvcnts,rdispls,comm,ier)
- + - + -
+ - + ]
116 : :
117 : : !Arguments-------------------------
118 : : integer, DEV_CONTARRD intent(in) :: xval(:,:)
119 : : integer, DEV_CONTARRD intent(inout) :: recvbuf(:,:)
120 : : integer, DEV_CONTARRD intent(in) :: sendcnts(:),sdispls(:),rdispls(:),recvcnts(:)
121 : : integer,intent(in) :: comm
122 : : integer,intent(out) :: ier
123 : :
124 : : !Local variables-------------------
125 : : integer :: sc,sds,sdr,sz1
126 : :
127 : : ! *********************************************************************
128 : :
129 : 788 : ier=0
130 : : #if defined HAVE_MPI
131 [ + + ]: 788 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
132 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_INTEGER,recvbuf,&
133 [ - + - - : 772 : & recvcnts,rdispls,MPI_INTEGER,comm,ier)
- - - + -
- - - - +
- - - - -
+ - - - -
- + - + -
- - + - -
- + - + -
- - + -
- ]
134 [ + - ]: 16 : else if (comm == MPI_COMM_SELF) then
135 : : #endif
136 : 16 : sz1=size(xval,1)
137 [ + - ]: 16 : sds=0;if (size(sdispls)>0) sds=sdispls(1)/sz1
138 [ + - ]: 16 : sdr=0;if (size(rdispls)>0) sdr=rdispls(1)/sz1
139 [ + - ]: 16 : sc=size(xval,2);if (size(sendcnts)>0) sc=sendcnts(1)/sz1
140 [ + + + + ]: 207160 : recvbuf(:,sdr+1:sdr+sc)=xval(:,sds+1:sds+sc)
141 : : #if defined HAVE_MPI
142 : : end if
143 : : #endif
144 : :
145 : 788 : end subroutine xmpi_alltoallv_int2d
146 : : !!***
147 : :
148 : : !!****f* ABINIT/xmpi_alltoallv_dp1d
149 : : !! NAME
150 : : !! xmpi_alltoallv_dp1d
151 : : !!
152 : : !! FUNCTION
153 : : !! Sends data from all to all processes.
154 : : !! Target: double precision one-dimensional arrays.
155 : : !!
156 : : !! SOURCE
157 : :
158 [ # # # # : 0 : subroutine xmpi_alltoallv_dp1d(xval,sendcnts,sdispls,recvbuf,recvcnts,rdispls,comm,ier)
# # # # #
# ]
159 : :
160 : : !Arguments-------------------------
161 : : real(dp), DEV_CONTARRD intent(in) :: xval(:)
162 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:)
163 : : integer, DEV_CONTARRD intent(in) :: sendcnts(:),sdispls(:),recvcnts(:)
164 : : integer,intent(in) :: comm, rdispls
165 : : integer,intent(out) :: ier
166 : :
167 : : !Local variables-------------------
168 : : integer :: sc,sds,sdr
169 : : integer :: i
170 : : #if defined HAVE_MPI
171 : 0 : integer, allocatable :: rdispls_on(:)
172 : : #endif
173 : :
174 : : ! *********************************************************************
175 : :
176 : 0 : ier=0
177 : : #if defined HAVE_MPI
178 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
179 [ # # # # : 0 : ABI_STAT_MALLOC(rdispls_on,(size(sendcnts)), ier)
# # # # #
# # # ]
180 [ # # ]: 0 : if (ier/= 0) call xmpi_abort(msg='error allocating rdispls_on in xmpi_alltoallv')
181 [ # # ]: 0 : rdispls_on = 0
182 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
183 [ # # # # : 0 : & recvcnts,rdispls_on,MPI_DOUBLE_PRECISION,comm,ier)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
184 [ # # ]: 0 : ABI_FREE(rdispls_on)
185 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
186 : : #endif
187 [ # # ]: 0 : sdr=rdispls;sds=0;if (size(sdispls)>0) sds=sdispls(1)
188 [ # # ]: 0 : sc=size(xval);if (size(sendcnts)>0) sc=sendcnts(1)
189 : : !$OMP parallel do
190 [ # # ]: 0 : do i = 1, sc
191 : 0 : recvbuf(i)=xval(sds+i)
192 : : end do
193 : : #if defined HAVE_MPI
194 : : end if
195 : : #endif
196 : :
197 : 0 : end subroutine xmpi_alltoallv_dp1d
198 : : !!***
199 : :
200 : : !!****f* ABINIT/xmpi_alltoallv_dp1d2
201 : : !! NAME
202 : : !! xmpi_alltoallv_dp1d2
203 : : !!
204 : : !! FUNCTION
205 : : !! Sends data from all to all processes.
206 : : !! Target: double precision one-dimensional arrays.
207 : : !!
208 : : !! SOURCE
209 : :
210 [ # # # # : 0 : subroutine xmpi_alltoallv_dp1d2(xval,sendcnts,sdispls,recvbuf,recvcnts,rdispls,comm,ier)
# # # # #
# # # ]
211 : :
212 : : !Arguments-------------------------
213 : : real(dp), DEV_CONTARRD intent(in) :: xval(:)
214 : : real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:)
215 : : integer, DEV_CONTARRD intent(in) :: sendcnts(:),sdispls(:),recvcnts(:),rdispls(:)
216 : : integer,intent(in) :: comm
217 : : integer,intent(out) :: ier
218 : :
219 : : !Local variables-------------------
220 : : integer :: sc,sds,sdr
221 : :
222 : : ! *********************************************************************
223 : :
224 : 0 : ier=0
225 : : #if defined HAVE_MPI
226 [ # # ]: 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
227 : : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
228 [ # # # # : 0 : & recvcnts,rdispls,MPI_DOUBLE_PRECISION,comm,ier)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
229 [ # # ]: 0 : else if (comm == MPI_COMM_SELF) then
230 : : #endif
231 [ # # ]: 0 : sds=0;if (size(sdispls)>0) sds=sdispls(1)
232 [ # # ]: 0 : sdr=0;if (size(rdispls)>0) sdr=rdispls(1)
233 [ # # ]: 0 : sc=size(xval);if (size(sendcnts)>0) sc=sendcnts(1)
234 [ # # ]: 0 : recvbuf(sdr+1:sdr+sc)=xval(sds+1:sds+sc)
235 : : #if defined HAVE_MPI
236 : : end if
237 : : #endif
238 : :
239 : 0 : end subroutine xmpi_alltoallv_dp1d2
240 : : !!***
|
