FV3 Bundle
mpp_comm.inc
Go to the documentation of this file.
1 ! -*-f90-*-
2 
3 !***********************************************************************
4 !* GNU Lesser General Public License
5 !*
6 !* This file is part of the GFDL Flexible Modeling System (FMS).
7 !*
8 !* FMS is free software: you can redistribute it and/or modify it under
9 !* the terms of the GNU Lesser General Public License as published by
10 !* the Free Software Foundation, either version 3 of the License, or (at
11 !* your option) any later version.
12 !*
13 !* FMS is distributed in the hope that it will be useful, but WITHOUT
14 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 !* for more details.
17 !*
18 !* You should have received a copy of the GNU Lesser General Public
19 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
20 !***********************************************************************
21 
22 #ifdef use_libSMA
23 #include <mpp_comm_sma.inc>
24 #elif defined(use_libMPI)
25 #include <mpp_comm_mpi.inc>
26 #else
27 #include <mpp_comm_nocomm.inc>
28 #endif
29 
30 #ifndef no_8byte_integers
31 #undef MPP_CHKSUM_INT_
32 #define MPP_CHKSUM_INT_ mpp_chksum_i8_1d
33 #undef MPP_CHKSUM_INT_RMASK_
34 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i8_1d_rmask
35 #undef MPP_TYPE_
36 #define MPP_TYPE_ integer(LONG_KIND)
37 #undef MPP_RANK_
38 #define MPP_RANK_ (:)
39 #include <mpp_chksum_int.h>
40 
41 #undef MPP_CHKSUM_INT_
42 #define MPP_CHKSUM_INT_ mpp_chksum_i8_2d
43 #undef MPP_CHKSUM_INT_RMASK_
44 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i8_2d_rmask
45 #undef MPP_TYPE_
46 #define MPP_TYPE_ integer(LONG_KIND)
47 #undef MPP_RANK_
48 #define MPP_RANK_ (:,:)
49 #include <mpp_chksum_int.h>
50 
51 #undef MPP_CHKSUM_INT_
52 #define MPP_CHKSUM_INT_ mpp_chksum_i8_3d
53 #undef MPP_CHKSUM_INT_RMASK_
54 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i8_3d_rmask
55 #undef MPP_TYPE_
56 #define MPP_TYPE_ integer(LONG_KIND)
57 #undef MPP_RANK_
58 #define MPP_RANK_ (:,:,:)
59 #include <mpp_chksum_int.h>
60 
61 #undef MPP_CHKSUM_INT_
62 #define MPP_CHKSUM_INT_ mpp_chksum_i8_4d
63 #undef MPP_CHKSUM_INT_RMASK_
64 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i8_4d_rmask
65 #undef MPP_TYPE_
66 #define MPP_TYPE_ integer(LONG_KIND)
67 #undef MPP_RANK_
68 #define MPP_RANK_ (:,:,:,:)
69 #include <mpp_chksum_int.h>
70 
71 #undef MPP_CHKSUM_INT_
72 #define MPP_CHKSUM_INT_ mpp_chksum_i8_5d
73 #undef MPP_CHKSUM_INT_RMASK_
74 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i8_5d_rmask
75 #undef MPP_TYPE_
76 #define MPP_TYPE_ integer(LONG_KIND)
77 #undef MPP_RANK_
78 #define MPP_RANK_ (:,:,:,:,:)
79 #include <mpp_chksum_int.h>
80 #endif
81 
82 #undef MPP_CHKSUM_INT_
83 #define MPP_CHKSUM_INT_ mpp_chksum_i4_1d
84 #undef MPP_CHKSUM_INT_RMASK_
85 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i4_1d_rmask
86 #undef MPP_TYPE_
87 #define MPP_TYPE_ integer(INT_KIND)
88 #undef MPP_RANK_
89 #define MPP_RANK_ (:)
90 #include <mpp_chksum_int.h>
91 
92 #undef MPP_CHKSUM_INT_
93 #define MPP_CHKSUM_INT_ mpp_chksum_i4_2d
94 #undef MPP_CHKSUM_INT_RMASK_
95 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i4_2d_rmask
96 #undef MPP_TYPE_
97 #define MPP_TYPE_ integer(INT_KIND)
98 #undef MPP_RANK_
99 #define MPP_RANK_ (:,:)
100 #include <mpp_chksum_int.h>
101 
102 #undef MPP_CHKSUM_INT_
103 #define MPP_CHKSUM_INT_ mpp_chksum_i4_3d
104 #undef MPP_CHKSUM_INT_RMASK_
105 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i4_3d_rmask
106 #undef MPP_TYPE_
107 #define MPP_TYPE_ integer(INT_KIND)
108 #undef MPP_RANK_
109 #define MPP_RANK_ (:,:,:)
110 #include <mpp_chksum_int.h>
111 
112 #undef MPP_CHKSUM_INT_
113 #define MPP_CHKSUM_INT_ mpp_chksum_i4_4d
114 #undef MPP_CHKSUM_INT_RMASK_
115 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i4_4d_rmask
116 #undef MPP_TYPE_
117 #define MPP_TYPE_ integer(INT_KIND)
118 #undef MPP_RANK_
119 #define MPP_RANK_ (:,:,:,:)
120 #include <mpp_chksum_int.h>
121 
122 #undef MPP_CHKSUM_INT_
123 #define MPP_CHKSUM_INT_ mpp_chksum_i4_5d
124 #undef MPP_CHKSUM_INT_RMASK_
125 #define MPP_CHKSUM_INT_RMASK_ mpp_chksum_i4_5d_rmask
126 #undef MPP_TYPE_
127 #define MPP_TYPE_ integer(INT_KIND)
128 #undef MPP_RANK_
129 #define MPP_RANK_ (:,:,:,:,:)
130 #include <mpp_chksum_int.h>
131 
132 #undef MPP_CHKSUM_
133 #define MPP_CHKSUM_ mpp_chksum_r8_0d
134 #undef MPP_TYPE_
135 #define MPP_TYPE_ real(DOUBLE_KIND)
136 #undef MPP_RANK_
137 #define MPP_RANK_ !
138 #include <mpp_chksum_scalar.h>
139 
140 #undef MPP_CHKSUM_
141 #define MPP_CHKSUM_ mpp_chksum_r8_1d
142 #undef MPP_TYPE_
143 #define MPP_TYPE_ real(DOUBLE_KIND)
144 #undef MPP_RANK_
145 #define MPP_RANK_ (:)
146 #include <mpp_chksum.h>
147 
148 #undef MPP_CHKSUM_
149 #define MPP_CHKSUM_ mpp_chksum_r8_2d
150 #undef MPP_TYPE_
151 #define MPP_TYPE_ real(DOUBLE_KIND)
152 #undef MPP_RANK_
153 #define MPP_RANK_ (:,:)
154 #include <mpp_chksum.h>
155 
156 #undef MPP_CHKSUM_
157 #define MPP_CHKSUM_ mpp_chksum_r8_3d
158 #undef MPP_TYPE_
159 #define MPP_TYPE_ real(DOUBLE_KIND)
160 #undef MPP_RANK_
161 #define MPP_RANK_ (:,:,:)
162 #include <mpp_chksum.h>
163 
164 #undef MPP_CHKSUM_
165 #define MPP_CHKSUM_ mpp_chksum_r8_4d
166 #undef MPP_TYPE_
167 #define MPP_TYPE_ real(DOUBLE_KIND)
168 #undef MPP_RANK_
169 #define MPP_RANK_ (:,:,:,:)
170 #include <mpp_chksum.h>
171 
172 #undef MPP_CHKSUM_
173 #define MPP_CHKSUM_ mpp_chksum_r8_5d
174 #undef MPP_TYPE_
175 #define MPP_TYPE_ real(DOUBLE_KIND)
176 #undef MPP_RANK_
177 #define MPP_RANK_ (:,:,:,:,:)
178 #include <mpp_chksum.h>
179 
180 #ifdef OVERLOAD_C8
181 #undef MPP_CHKSUM_
182 #define MPP_CHKSUM_ mpp_chksum_c8_0d
183 #undef MPP_TYPE_
184 #define MPP_TYPE_ complex(DOUBLE_KIND)
185 #undef MPP_RANK_
186 #define MPP_RANK_ !
187 #include <mpp_chksum_scalar.h>
188 
189 #undef MPP_CHKSUM_
190 #define MPP_CHKSUM_ mpp_chksum_c8_1d
191 #undef MPP_TYPE_
192 #define MPP_TYPE_ complex(DOUBLE_KIND)
193 #undef MPP_RANK_
194 #define MPP_RANK_ (:)
195 #include <mpp_chksum.h>
196 
197 #undef MPP_CHKSUM_
198 #define MPP_CHKSUM_ mpp_chksum_c8_2d
199 #undef MPP_TYPE_
200 #define MPP_TYPE_ complex(DOUBLE_KIND)
201 #undef MPP_RANK_
202 #define MPP_RANK_ (:,:)
203 #include <mpp_chksum.h>
204 
205 #undef MPP_CHKSUM_
206 #define MPP_CHKSUM_ mpp_chksum_c8_3d
207 #undef MPP_TYPE_
208 #define MPP_TYPE_ complex(DOUBLE_KIND)
209 #undef MPP_RANK_
210 #define MPP_RANK_ (:,:,:)
211 #include <mpp_chksum.h>
212 
213 #undef MPP_CHKSUM_
214 #define MPP_CHKSUM_ mpp_chksum_c8_4d
215 #undef MPP_TYPE_
216 #define MPP_TYPE_ complex(DOUBLE_KIND)
217 #undef MPP_RANK_
218 #define MPP_RANK_ (:,:,:,:)
219 #include <mpp_chksum.h>
220 
221 #undef MPP_CHKSUM_
222 #define MPP_CHKSUM_ mpp_chksum_c8_5d
223 #undef MPP_TYPE_
224 #define MPP_TYPE_ complex(DOUBLE_KIND)
225 #undef MPP_RANK_
226 #define MPP_RANK_ (:,:,:,:,:)
227 #include <mpp_chksum.h>
228 #endif
229 
230 #ifdef OVERLOAD_R4
231 #undef MPP_CHKSUM_
232 #define MPP_CHKSUM_ mpp_chksum_r4_0d
233 #undef MPP_TYPE_
234 #define MPP_TYPE_ real(FLOAT_KIND)
235 #undef MPP_RANK_
236 #define MPP_RANK_ !
237 #include <mpp_chksum_scalar.h>
238 
239 #undef MPP_CHKSUM_
240 #define MPP_CHKSUM_ mpp_chksum_r4_1d
241 #undef MPP_TYPE_
242 #define MPP_TYPE_ real(FLOAT_KIND)
243 #undef MPP_RANK_
244 #define MPP_RANK_ (:)
245 #include <mpp_chksum.h>
246 
247 #undef MPP_CHKSUM_
248 #define MPP_CHKSUM_ mpp_chksum_r4_2d
249 #undef MPP_TYPE_
250 #define MPP_TYPE_ real(FLOAT_KIND)
251 #undef MPP_RANK_
252 #define MPP_RANK_ (:,:)
253 #include <mpp_chksum.h>
254 
255 #undef MPP_CHKSUM_
256 #define MPP_CHKSUM_ mpp_chksum_r4_3d
257 #undef MPP_TYPE_
258 #define MPP_TYPE_ real(FLOAT_KIND)
259 #undef MPP_RANK_
260 #define MPP_RANK_ (:,:,:)
261 #include <mpp_chksum.h>
262 
263 #undef MPP_CHKSUM_
264 #define MPP_CHKSUM_ mpp_chksum_r4_4d
265 #undef MPP_TYPE_
266 #define MPP_TYPE_ real(FLOAT_KIND)
267 #undef MPP_RANK_
268 #define MPP_RANK_ (:,:,:,:)
269 #include <mpp_chksum.h>
270 
271 #undef MPP_CHKSUM_
272 #define MPP_CHKSUM_ mpp_chksum_r4_5d
273 #undef MPP_TYPE_
274 #define MPP_TYPE_ real(FLOAT_KIND)
275 #undef MPP_RANK_
276 #define MPP_RANK_ (:,:,:,:,:)
277 #include <mpp_chksum.h>
278 #endif
279 
280 #ifdef OVERLOAD_C4
281 #undef MPP_CHKSUM_
282 #define MPP_CHKSUM_ mpp_chksum_c4_0d
283 #undef MPP_TYPE_
284 #define MPP_TYPE_ complex(FLOAT_KIND)
285 #undef MPP_RANK_
286 #define MPP_RANK_ !
287 #include <mpp_chksum_scalar.h>
288 
289 #undef MPP_CHKSUM_
290 #define MPP_CHKSUM_ mpp_chksum_c4_1d
291 #undef MPP_TYPE_
292 #define MPP_TYPE_ complex(FLOAT_KIND)
293 #undef MPP_RANK_
294 #define MPP_RANK_ (:)
295 #include <mpp_chksum.h>
296 
297 #undef MPP_CHKSUM_
298 #define MPP_CHKSUM_ mpp_chksum_c4_2d
299 #undef MPP_TYPE_
300 #define MPP_TYPE_ complex(FLOAT_KIND)
301 #undef MPP_RANK_
302 #define MPP_RANK_ (:,:)
303 #include <mpp_chksum.h>
304 
305 #undef MPP_CHKSUM_
306 #define MPP_CHKSUM_ mpp_chksum_c4_3d
307 #undef MPP_TYPE_
308 #define MPP_TYPE_ complex(FLOAT_KIND)
309 #undef MPP_RANK_
310 #define MPP_RANK_ (:,:,:)
311 #include <mpp_chksum.h>
312 
313 #undef MPP_CHKSUM_
314 #define MPP_CHKSUM_ mpp_chksum_c4_4d
315 #undef MPP_TYPE_
316 #define MPP_TYPE_ complex(FLOAT_KIND)
317 #undef MPP_RANK_
318 #define MPP_RANK_ (:,:,:,:)
319 #include <mpp_chksum.h>
320 
321 #undef MPP_CHKSUM_
322 #define MPP_CHKSUM_ mpp_chksum_c4_5d
323 #undef MPP_TYPE_
324 #define MPP_TYPE_ complex(FLOAT_KIND)
325 #undef MPP_RANK_
326 #define MPP_RANK_ (:,:,:,:,:)
327 #include <mpp_chksum.h>
328 #endif
329 
330 !#################################################
331 #undef MPP_GATHER_1D_
332 #undef MPP_GATHER_1DV_
333 #undef MPP_TYPE_
334 #define MPP_TYPE_ logical
335 #define MPP_GATHER_1D_ mpp_gather_logical_1d
336 #define MPP_GATHER_1DV_ mpp_gather_logical_1dv
337 #undef MPP_GATHER_PELIST_2D_
338 #undef MPP_GATHER_PELIST_3D_
339 #define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_logical_2d
340 #define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_logical_3d
341 #include <mpp_gather.h>
342 
343 #undef MPP_GATHER_1D_
344 #undef MPP_GATHER_1DV_
345 #undef MPP_TYPE_
346 #define MPP_TYPE_ integer(INT_KIND)
347 #define MPP_GATHER_1D_ mpp_gather_int4_1d
348 #define MPP_GATHER_1DV_ mpp_gather_int4_1dv
349 #undef MPP_GATHER_PELIST_2D_
350 #undef MPP_GATHER_PELIST_3D_
351 #define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_int4_2d
352 #define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_int4_3d
353 #include <mpp_gather.h>
354 
355 #undef MPP_GATHER_1D_
356 #undef MPP_GATHER_1DV_
357 #undef MPP_TYPE_
358 #define MPP_TYPE_ real(FLOAT_KIND)
359 #define MPP_GATHER_1D_ mpp_gather_real4_1d
360 #define MPP_GATHER_1DV_ mpp_gather_real4_1dv
361 #undef MPP_GATHER_PELIST_2D_
362 #undef MPP_GATHER_PELIST_3D_
363 #define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_real4_2d
364 #define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_real4_3d
365 #include <mpp_gather.h>
366 
367 #undef MPP_GATHER_1D_
368 #undef MPP_GATHER_1DV_
369 #undef MPP_TYPE_
370 #define MPP_TYPE_ real(DOUBLE_KIND)
371 #define MPP_GATHER_1D_ mpp_gather_real8_1d
372 #define MPP_GATHER_1DV_ mpp_gather_real8_1dv
373 #undef MPP_GATHER_PELIST_2D_
374 #undef MPP_GATHER_PELIST_3D_
375 #define MPP_GATHER_PELIST_2D_ mpp_gather_pelist_real8_2d
376 #define MPP_GATHER_PELIST_3D_ mpp_gather_pelist_real8_3d
377 #include <mpp_gather.h>
378 
379 !#################################################
380 #undef MPP_SCATTER_PELIST_2D_
381 #undef MPP_SCATTER_PELIST_3D_
382 #undef MPP_TYPE_
383 #define MPP_TYPE_ integer(INT_KIND)
384 #define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_int4_2d
385 #define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_int4_3d
386 #include <mpp_scatter.h>
387 
388 #undef MPP_SCATTER_PELIST_2D_
389 #undef MPP_SCATTER_PELIST_3D_
390 #undef MPP_TYPE_
391 #define MPP_TYPE_ real(FLOAT_KIND)
392 #define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_real4_2d
393 #define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_real4_3d
394 #include <mpp_scatter.h>
395 
396 #undef MPP_SCATTER_PELIST_2D_
397 #undef MPP_SCATTER_PELIST_3D_
398 #undef MPP_TYPE_
399 #define MPP_TYPE_ real(DOUBLE_KIND)
400 #define MPP_SCATTER_PELIST_2D_ mpp_scatter_pelist_real8_2d
401 #define MPP_SCATTER_PELIST_3D_ mpp_scatter_pelist_real8_3d
402 #include <mpp_scatter.h>
will
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version will
Definition: mpp_transmit_mpi.h:166
mpp_chksum_scalar.h
fv3jedi_increment_mod::copy
subroutine, public copy(self, rhs)
Definition: fv3jedi_increment_mod.f90:254
mpp_chksum_int.h
diag_integral_mod::version
character(len=128) version
Definition: diag_integral.F90:121
mpp_comm_nocomm.inc
is
l_size ! loop over number of fields ke do je do ie to is
Definition: mpp_do_redistribute.h:72
mpp_comm_sma.inc
type_distribution::received
logical function received(this, seqno)
Definition: m_distribution.f90:72
mpp_gather.h
a
************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If see< http:! ***********************************************************************!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! MPP_TRANSMIT !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine MPP_TRANSMIT_(put_data, put_len, to_pe, get_data, get_len, from_pe, block, tag, recv_request, send_request)!a message-passing routine intended to be reminiscent equally of both MPI and SHMEM!put_data and get_data are contiguous MPP_TYPE_ arrays!at each call, your put_data array is put to to_pe 's get_data! your get_data array is got from from_pe 's put_data!i.e we assume that typically(e.g updating halo regions) each PE performs a put _and_ a get!special PE designations:! NULL_PE:to disable a put or a get(e.g at boundaries)! ANY_PE:if remote PE for the put or get is to be unspecific! ALL_PES:broadcast and collect operations(collect not yet implemented)!ideally we would not pass length, but this f77-style call performs better(arrays passed by address, not descriptor)!further, this permits< length > contiguous words from an array of any rank to be passed(avoiding f90 rank conformance check)!caller is responsible for completion checks(mpp_sync_self) before and after integer, intent(in) ::put_len, to_pe, get_len, from_pe MPP_TYPE_, intent(in) ::put_data(*) MPP_TYPE_, intent(out) ::get_data(*) logical, intent(in), optional ::block integer, intent(in), optional ::tag integer, intent(out), optional ::recv_request, send_request logical ::block_comm integer ::i MPP_TYPE_, allocatable, save ::local_data(:) !local copy used by non-parallel code(no SHMEM or MPI) integer ::comm_tag integer ::rsize if(.NOT.module_is_initialized) call mpp_error(FATAL, 'MPP_TRANSMIT:You must first call mpp_init.') if(to_pe.EQ.NULL_PE .AND. from_pe.EQ.NULL_PE) return block_comm=.true. if(PRESENT(block)) block_comm=block if(debug) then call SYSTEM_CLOCK(tick) write(stdout_unit,'(a, i18, a, i6, a, 2i6, 2i8)')&'T=', tick, ' PE=', pe, ' MPP_TRANSMIT begin:to_pe, from_pe, put_len, get_len=', to_pe, from_pe, put_len, get_len end if comm_tag=DEFAULT_TAG if(present(tag)) comm_tag=tag!do put first and then get if(to_pe.GE.0 .AND. to_pe.LT.npes) then!use non-blocking sends if(debug .and.(current_clock.NE.0)) call SYSTEM_CLOCK(start_tick)!z1l:truly non-blocking send.! if(request(to_pe).NE.MPI_REQUEST_NULL) then !only one message from pe-> to_pe in queue *PE waiting for to_pe ! call error else get_len so only do gets but you cannot have a pure get with MPI call a get means do a wait to ensure put on remote PE is complete error call increase mpp_nml request_multiply call MPP_TRANSMIT get_len end if return end subroutine MPP_TRANSMIT_ ! MPP_BROADCAST ! subroutine but that doesn t allow !broadcast to a subset of PEs This version and mpp_transmit will remain !backward compatible intent(inout) a
Definition: mpp_transmit_mpi.h:178
not
*f90 *************************************************************************GNU Lesser General Public License **This file is part of the GFDL Flexible Modeling System(FMS). ! *! *FMS is free software without even the implied warranty of MERCHANTABILITY or *FITNESS FOR A PARTICULAR PURPOSE See the GNU General Public License *for more details **You should have received a copy of the GNU Lesser General Public *License along with FMS If not
Definition: drifters_compute_k.h:5
mpp_comm_mpi.inc
mpp_chksum.h
mpp_scatter.h