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 2165044 : 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 2165044 : ier=0
53 : #if defined HAVE_MPI
54 2165044 : l_use_omp_map=.false.
55 2165044 : if(present(use_omp_map)) l_use_omp_map=use_omp_map
56 2165044 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
57 2156744 : if(.not. l_use_omp_map) then
58 : call MPI_ALLTOALLV(xval,sendcnts,sdispls,MPI_DOUBLE_PRECISION,recvbuf,&
59 2156744 : & 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 2165044 : 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 : !!***
|
