Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* ABINIT/xmpi_land_log0d
3 : !! NAME
4 : !! xmpi_land_log0d
5 : !!
6 : !! FUNCTION
7 : !! Logical AND accross the nodes.
8 : !! Combines value from all processes and distribute the result back to all processes.
9 : !! Target: logical scalar
10 : !!
11 : !! SOURCE
12 :
13 13 : subroutine xmpi_land_log0d(xval, comm)
14 :
15 : !Arguments ------------------------------------
16 : logical,intent(inout) :: xval
17 : integer,intent(in) :: comm
18 :
19 : !Local variables-------------------------------
20 : integer :: ierr
21 : #if defined HAVE_MPI
22 : logical :: out_val(1)
23 : #endif
24 :
25 : ! *************************************************************************
26 :
27 13 : ierr=0
28 : #if defined HAVE_MPI
29 13 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
30 26 : call MPI_ALLREDUCE([xval], out_val, 1, MPI_LOGICAL, MPI_LAND, comm, ierr)
31 13 : xval = out_val(1)
32 : end if
33 : #endif
34 :
35 13 : end subroutine xmpi_land_log0d
36 : !!***
37 :
38 : !----------------------------------------------------------------------
39 :
40 : !!****f* ABINIT/xmpi_land_log1d
41 : !! NAME
42 : !! xmpi_land_log1d
43 : !!
44 : !! FUNCTION
45 : !! Combines values from all processes and distribute
46 : !! the result back to all processes.
47 : !! Target: one-dimensional logical arrays.
48 : !!
49 : !! INPUTS
50 : !! comm= MPI communicator
51 : !!
52 : !! SIDE EFFECTS
53 : !! xval= buffer array
54 : !!
55 : !! SOURCE
56 :
57 0 : subroutine xmpi_land_log1d(xval,comm)
58 :
59 : !Arguments ------------------------------------
60 : integer,intent(in) :: comm
61 : logical, DEV_CONTARRD intent(inout) :: xval(:)
62 :
63 : !Local variables-------------------------------
64 : #if defined HAVE_MPI
65 : integer :: ierr,n1
66 0 : logical,allocatable :: xsum(:)
67 : #endif
68 :
69 : ! *************************************************************************
70 :
71 : #if defined HAVE_MPI
72 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
73 : ! Accumulate xval on all proc. in comm
74 0 : n1 = size(xval)
75 0 : ABI_STAT_MALLOC(xsum,(n1), ierr)
76 0 : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_land_log1d')
77 0 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_LOGICAL,MPI_LAND,comm,ierr)
78 0 : xval (:) = xsum(:)
79 0 : ABI_FREE(xsum)
80 : end if
81 : #endif
82 :
83 0 : end subroutine xmpi_land_log1d
84 : !!***
85 :
86 : !----------------------------------------------------------------------
87 :
88 : !!****f* ABINIT/xmpi_lor_log1d
89 : !! NAME
90 : !! xmpi_lor_log1d
91 : !!
92 : !! FUNCTION
93 : !! Combines values from all processes and distribute
94 : !! the result back to all processes.
95 : !! Target: one-dimensional logical arrays.
96 : !!
97 : !! INPUTS
98 : !! comm= MPI communicator
99 : !!
100 : !! SIDE EFFECTS
101 : !! xval= buffer array
102 : !!
103 : !! SOURCE
104 :
105 173 : subroutine xmpi_lor_log1d(xval,comm)
106 :
107 : !Arguments ------------------------------------
108 : integer,intent(in) :: comm
109 : logical, DEV_CONTARRD intent(inout) :: xval(:)
110 :
111 : !Local variables-------------------------------
112 : #if defined HAVE_MPI
113 : integer :: ierr,n1
114 173 : logical,allocatable :: xsum(:)
115 : #endif
116 :
117 : ! *************************************************************************
118 :
119 : #if defined HAVE_MPI
120 173 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
121 : ! Accumulate xval on all proc. in comm
122 173 : n1 = size(xval)
123 519 : ABI_STAT_MALLOC(xsum,(n1), ierr)
124 173 : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_lor_log1d')
125 173 : call MPI_ALLREDUCE(xval,xsum,n1,MPI_LOGICAL,MPI_LOR,comm,ierr)
126 35726 : xval (:) = xsum(:)
127 173 : ABI_FREE(xsum)
128 : end if
129 : #endif
130 :
131 173 : end subroutine xmpi_lor_log1d
132 : !!***
133 :
134 : !----------------------------------------------------------------------
135 :
136 : !!****f* ABINIT/xmpi_lor_log2d
137 : !! NAME
138 : !! xmpi_lor_log2d
139 : !!
140 : !! FUNCTION
141 : !! Combines values from all processes and distribute
142 : !! the result back to all processes.
143 : !! Target: two-dimensional logical arrays.
144 : !!
145 : !! INPUTS
146 : !! comm= MPI communicator
147 : !!
148 : !! SIDE EFFECTS
149 : !! xval= buffer array
150 : !!
151 : !! SOURCE
152 :
153 0 : subroutine xmpi_lor_log2d(xval,comm)
154 :
155 : !Arguments ------------------------------------
156 : integer,intent(in) :: comm
157 : logical, DEV_CONTARRD intent(inout) :: xval(:,:)
158 :
159 : !Local variables-------------------------------
160 : #if defined HAVE_MPI
161 : integer :: my_dt,my_op,n1,n2,ierr
162 : integer(kind=int64) :: ntot
163 0 : logical,allocatable :: xsum(:,:)
164 : #endif
165 :
166 : ! *************************************************************************
167 :
168 : #if defined HAVE_MPI
169 0 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
170 : ! Accumulate xval on all proc. in comm
171 0 : n1 = size(xval,1)
172 0 : n2 = size(xval,2)
173 :
174 0 : ABI_STAT_MALLOC(xsum,(n1,n2), ierr)
175 0 : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_lor_log2d')
176 :
177 : !This product of dimensions can be greater than a 32bit integer
178 : !We use a INT64 to store it. If it is too large, we switch to an
179 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
180 0 : ntot=int(n1,kind=int64)*n2
181 :
182 0 : if (ntot<=xmpi_maxint32_64) then
183 0 : call MPI_ALLREDUCE(xval,xsum,n1*n2,MPI_LOGICAL,MPI_LOR,comm,ierr)
184 : else
185 0 : call xmpi_largetype_create(ntot,MPI_LOGICAL,my_dt,my_op,MPI_LOR)
186 0 : call MPI_ALLREDUCE(xval,xsum,1,my_dt,my_op,comm,ierr)
187 0 : call xmpi_largetype_free(my_dt,my_op)
188 : end if
189 :
190 0 : xval (:,:) = xsum(:,:)
191 0 : ABI_FREE(xsum)
192 : end if
193 : #endif
194 :
195 0 : end subroutine xmpi_lor_log2d
196 : !!***
197 :
198 : !----------------------------------------------------------------------
199 :
200 : !!****f* ABINIT/xmpi_lor_log3d
201 : !! NAME
202 : !! xmpi_lor_log3d
203 : !!
204 : !! FUNCTION
205 : !! Combines values from all processes and distribute
206 : !! the result back to all processes.
207 : !! Target: three-dimensional logical arrays.
208 : !!
209 : !! INPUTS
210 : !! comm= MPI communicator
211 : !!
212 : !! SIDE EFFECTS
213 : !! xval= buffer array
214 : !!
215 : !! SOURCE
216 :
217 19 : subroutine xmpi_lor_log3d(xval,comm)
218 :
219 : !Arguments ------------------------------------
220 : integer,intent(in) :: comm
221 : logical, DEV_CONTARRD intent(inout) :: xval(:,:,:)
222 :
223 : !Local variables-------------------------------
224 : #if defined HAVE_MPI
225 : integer :: my_dt,my_op,n1,n2,n3,ierr
226 : integer(kind=int64) :: ntot
227 19 : logical,allocatable :: xsum(:,:,:)
228 : #endif
229 :
230 : ! *************************************************************************
231 :
232 : #if defined HAVE_MPI
233 19 : if (comm /= MPI_COMM_SELF .and. comm /= MPI_COMM_NULL) then
234 : ! Accumulate xval on all proc. in comm
235 19 : n1 = size(xval,1)
236 19 : n2 = size(xval,2)
237 19 : n3 = size(xval,3)
238 :
239 : ! #if defined HAVE_MPI2_INPLACE
240 : ! call MPI_ALLREDUCE(MPI_IN_PLACE,xval,n1*n2*n3,MPI_LOGICAL,MPI_LOR,comm,ierr)
241 : ! #else
242 95 : ABI_STAT_MALLOC(xsum,(n1,n2,n3), ierr)
243 19 : if (ierr/= 0) call xmpi_abort(msg='error allocating xsum in xmpi_lor_log3d')
244 :
245 : !This product of dimensions can be greater than a 32bit integer
246 : !We use a INT64 to store it. If it is too large, we switch to an
247 : !alternate routine because MPI<4 doesnt handle 64 bit counts.
248 19 : ntot=int(n1,kind=int64)*n2*n3
249 :
250 19 : if (ntot<=xmpi_maxint32_64) then
251 19 : call MPI_ALLREDUCE(xval,xsum,n1*n2*n3,MPI_LOGICAL,MPI_LOR,comm,ierr)
252 : else
253 0 : call xmpi_largetype_create(ntot,MPI_LOGICAL,my_dt,my_op,MPI_LOR)
254 0 : call MPI_ALLREDUCE(xval,xsum,1,my_dt,my_op,comm,ierr)
255 0 : call xmpi_largetype_free(my_dt,my_op)
256 : end if
257 :
258 7399 : xval (:,:,:) = xsum(:,:,:)
259 19 : ABI_FREE(xsum)
260 : ! #endif
261 : end if
262 : #endif
263 :
264 19 : end subroutine xmpi_lor_log3d
265 : !!***
|
