SURFEX v8.1
General documentation of Surfex
mpl_wait_mod.F90
Go to the documentation of this file.
2 
3 !**** MPL_WAIT Waits for completion
4 
5 ! Purpose.
6 ! --------
7 ! Returns control when the operation(s) identified by the request
8 ! is completed.
9 ! Normally used in conjunction with non-blocking buffering type
10 
11 !** Interface.
12 ! ----------
13 ! CALL MPL_WAIT
14 
15 ! Input required arguments :
16 ! -------------------------
17 ! PBUF - array with same size and shape as buffer
18 ! used for MPL_SEND or MPL_RECV
19 ! KREQUEST - array or scalar containing
20 ! Communication request(s)
21 ! as provided by MPL_RECV or MPL_SEND
22 
23 ! Input optional arguments :
24 ! -------------------------
25 ! CDSTRING - Character string for ABORT messages
26 ! used when KERROR is not provided
27 
28 ! Output required arguments :
29 ! -------------------------
30 ! none
31 
32 ! Output optional arguments :
33 ! -------------------------
34 ! KOUNT - must be the same size and shape as KREQUEST
35 ! contains number of items sent/received
36 ! KERROR - return error code. If not supplied,
37 ! MPL_WAIT aborts when an error is detected.
38 ! Author.
39 ! -------
40 ! D.Dent, M.Hamrud ECMWF
41 
42 ! Modifications.
43 ! --------------
44 ! Original: 2000-09-01
45 ! J. Hague: 2005-04-25 WAITALL replaced by WAIT loop
46 ! F. Vana 05-Mar-2015 Support for single precision
47 
48 ! ------------------------------------------------------------------
49 
50 USE parkind1 ,ONLY : jprd, jpim, jprm, jpib
51 
52 USE mpl_mpif
55 
56 IMPLICIT NONE
57 
58 PRIVATE
59 
60 INTERFACE mpl_wait
64 END INTERFACE
65 
66 PUBLIC mpl_wait
67 
68 CONTAINS
69 
70 
71 SUBROUTINE mpl_waits_real4(PBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
72 
73 
74 #ifdef USE_8_BYTE_WORDS
75  USE mpi4to8, ONLY : &
76  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8, &
77  mpi_wait => mpi_wait8
78 #endif
79 
80 REAL(KIND=JPRM) :: PBUF(:)
81 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST(:)
82 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
83 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT(size(krequest))
84 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
85 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT,IW
86 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size,size(krequest))
87 LOGICAL :: LLABORT
88 llabort=.true.
89 iwaiterr=0
90 icounterr=0
91 
92 IF(mpl_numproc < 1) CALL mpl_message( &
93  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
94 
95 ireqlen=SIZE(krequest)
96 !CALL MPI_WAITALL(IREQLEN,KREQUEST,IWAIT_STATUS,IWAITERR)
97 DO jl=1,ireqlen
98  CALL mpi_wait(krequest(jl),iwait_status(1,jl),iw)
99  iwaiterr=max(iwaiterr,iw)
100 ENDDO
101 
102 IF(PRESENT(kount))THEN
103  IF(SIZE(kount) /= ireqlen) THEN
104  CALL mpl_message( &
105  & cdmessage='MPL_WAIT: KOUNT AND KREQUEST INCONSISTENT ', &
106  & cdstring=cdstring,ldabort=llabort)
107  ENDIF
108  DO jl=1,ireqlen
109  CALL mpi_get_count(iwait_status(1,jl),int(mpi_real4),kount(jl),icounterr)
110  ENDDO
111 ENDIF
112 
113 IF(PRESENT(kerror))THEN
114  kerror=iwaiterr+icounterr
115 ELSE IF(iwaiterr /= 0) THEN
116  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
117 ELSE IF(icounterr /= 0) THEN
118  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
119 ENDIF
120 
121 RETURN
122 END SUBROUTINE mpl_waits_real4
123 
124 
125 SUBROUTINE mpl_wait1_real4(PBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
127 
128 #ifdef USE_8_BYTE_WORDS
129  USE mpi4to8, ONLY : &
130  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8
131 #endif
132 
133 REAL(KIND=JPRM) :: PBUF(:)
134 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST
135 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
136 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT
137 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
138 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT
139 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
140 LOGICAL :: LLABORT
141 llabort=.true.
142 iwaiterr=0
143 icounterr=0
144 
145 IF(mpl_numproc < 1) CALL mpl_message( &
146  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
147 
148 CALL mpi_wait(krequest,iwait_status,iwaiterr)
149 
150 IF(PRESENT(kount))THEN
151  CALL mpi_get_count(iwait_status(1),int(mpi_real4),kount,icounterr)
152 ENDIF
153 
154 IF(PRESENT(kerror))THEN
155  kerror=iwaiterr+icounterr
156 ELSE IF(iwaiterr /= 0) THEN
157  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
158 ELSE IF(icounterr /= 0) THEN
159  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
160 ENDIF
161 
162 RETURN
163 END SUBROUTINE mpl_wait1_real4
164 
165 
166 SUBROUTINE mpl_waits_real8(PBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
168 
169 #ifdef USE_8_BYTE_WORDS
170  USE mpi4to8, ONLY : &
171  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8, &
172  mpi_wait => mpi_wait8
173 #endif
174 
175 REAL(KIND=JPRD) :: PBUF(:)
176 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST(:)
177 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
178 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT(size(krequest))
179 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
180 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT,IW
181 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size,size(krequest))
182 LOGICAL :: LLABORT
183 llabort=.true.
184 iwaiterr=0
185 icounterr=0
186 
187 IF(mpl_numproc < 1) CALL mpl_message( &
188  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
189 
190 ireqlen=SIZE(krequest)
191 !CALL MPI_WAITALL(IREQLEN,KREQUEST,IWAIT_STATUS,IWAITERR)
192 DO jl=1,ireqlen
193  CALL mpi_wait(krequest(jl),iwait_status(1,jl),iw)
194  iwaiterr=max(iwaiterr,iw)
195 ENDDO
196 
197 IF(PRESENT(kount))THEN
198  IF(SIZE(kount) /= ireqlen) THEN
199  CALL mpl_message( &
200  & cdmessage='MPL_WAIT: KOUNT AND KREQUEST INCONSISTENT ', &
201  & cdstring=cdstring,ldabort=llabort)
202  ENDIF
203  DO jl=1,ireqlen
204  CALL mpi_get_count(iwait_status(1,jl),int(mpi_real8),kount(jl),icounterr)
205  ENDDO
206 ENDIF
207 
208 IF(PRESENT(kerror))THEN
209  kerror=iwaiterr+icounterr
210 ELSE IF(iwaiterr /= 0) THEN
211  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
212 ELSE IF(icounterr /= 0) THEN
213  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
214 ENDIF
215 
216 RETURN
217 END SUBROUTINE mpl_waits_real8
218 
219 
220 SUBROUTINE mpl_wait1_real8(PBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
222 
223 #ifdef USE_8_BYTE_WORDS
224  USE mpi4to8, ONLY : &
225  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8
226 #endif
227 
228 REAL(KIND=JPRD) :: PBUF(:)
229 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST
230 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
231 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT
232 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
233 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,ICOUNT
234 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
235 LOGICAL :: LLABORT
236 llabort=.true.
237 iwaiterr=0
238 icounterr=0
239 
240 IF(mpl_numproc < 1) CALL mpl_message( &
241  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
242 
243 CALL mpi_wait(krequest,iwait_status,iwaiterr)
244 
245 IF(PRESENT(kount))THEN
246  CALL mpi_get_count(iwait_status(1),int(mpi_real8),kount,icounterr)
247 ENDIF
248 
249 IF(PRESENT(kerror))THEN
250  kerror=iwaiterr+icounterr
251 ELSE IF(iwaiterr /= 0) THEN
252  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
253 ELSE IF(icounterr /= 0) THEN
254  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
255 ENDIF
256 
257 RETURN
258 END SUBROUTINE mpl_wait1_real8
259 
260 
261 SUBROUTINE mpl_waits_int(KBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
263 
264 #ifdef USE_8_BYTE_WORDS
265  USE mpi4to8, ONLY : &
266  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8, &
267  mpi_wait => mpi_wait8
268 #endif
269 
270 INTEGER(KIND=JPIM) :: KBUF(:)
271 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST(:)
272 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
273 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT(size(krequest))
274 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
275 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT,IW
276 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size,size(krequest))
277 LOGICAL :: LLABORT
278 llabort=.true.
279 iwaiterr=0
280 icounterr=0
281 
282 IF(mpl_numproc < 1) CALL mpl_message( &
283  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
284 
285 ireqlen=SIZE(krequest)
286 !CALL MPI_WAITALL(IREQLEN,KREQUEST,IWAIT_STATUS,IWAITERR)
287 DO jl=1,ireqlen
288  CALL mpi_wait(krequest(jl),iwait_status(1,jl),iw)
289  iwaiterr=max(iwaiterr,iw)
290 ENDDO
291 
292 IF(PRESENT(kount))THEN
293  IF(SIZE(kount) /= ireqlen) THEN
294  CALL mpl_message( &
295  & cdmessage='MPL_WAIT: KOUNT AND KREQUEST INCONSISTENT ', &
296  & cdstring=cdstring,ldabort=llabort)
297  ENDIF
298  DO jl=1,ireqlen
299  CALL mpi_get_count(iwait_status(1,jl),int(mpi_integer),kount(jl),icounterr)
300  ENDDO
301 ENDIF
302 
303 IF(PRESENT(kerror))THEN
304  kerror=iwaiterr+icounterr
305 ELSE IF(iwaiterr /= 0) THEN
306  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
307 ELSE IF(icounterr /= 0) THEN
308  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
309 ENDIF
310 
311 RETURN
312 END SUBROUTINE mpl_waits_int
313 
314 
315 SUBROUTINE mpl_wait1_int(KBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
317 
318 #ifdef USE_8_BYTE_WORDS
319  USE mpi4to8, ONLY : &
320  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8
321 #endif
322 
323 INTEGER(KIND=JPIM) :: KBUF(:)
324 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST
325 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
326 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT
327 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
328 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT
329 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
330 LOGICAL :: LLABORT
331 llabort=.true.
332 iwaiterr=0
333 icounterr=0
334 
335 IF(mpl_numproc < 1) CALL mpl_message( &
336  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
337 
338 CALL mpi_wait(krequest,iwait_status,iwaiterr)
339 
340 IF(PRESENT(kount))THEN
341  CALL mpi_get_count(iwait_status(1),int(mpi_integer),kount,icounterr)
342 ENDIF
343 
344 IF(PRESENT(kerror))THEN
345  kerror=iwaiterr+icounterr
346 ELSE IF(iwaiterr /= 0) THEN
347  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
348 ELSE IF(icounterr /= 0) THEN
349  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
350 ENDIF
351 
352 RETURN
353 END SUBROUTINE mpl_wait1_int
354 
355 SUBROUTINE mpl_wait1_int8(KBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
357 
358 #ifdef USE_8_BYTE_WORDS
359  USE mpi4to8, ONLY : &
360  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8
361 #endif
362 
363 INTEGER(KIND=JPIB) :: KBUF(:)
364 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST
365 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
366 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT
367 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
368 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT
369 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
370 LOGICAL :: LLABORT
371 llabort=.true.
372 iwaiterr=0
373 icounterr=0
374 
375 IF(mpl_numproc < 1) CALL mpl_message( &
376  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
377 
378 CALL mpi_wait(krequest,iwait_status,iwaiterr)
379 
380 IF(PRESENT(kount))THEN
381  CALL mpi_get_count(iwait_status(1),int(mpi_integer8),kount,icounterr)
382 ENDIF
383 
384 IF(PRESENT(kerror))THEN
385  kerror=iwaiterr+icounterr
386 ELSE IF(iwaiterr /= 0) THEN
387  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
388 ELSE IF(icounterr /= 0) THEN
389  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
390 ENDIF
391 
392 RETURN
393 END SUBROUTINE mpl_wait1_int8
394 
395 
396 SUBROUTINE mpl_waits_int2(KBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
398 
399 #ifdef USE_8_BYTE_WORDS
400  USE mpi4to8, ONLY : &
401  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8, &
402  mpi_wait => mpi_wait8
403 #endif
404 
405 INTEGER(KIND=JPIM) :: KBUF(:,:)
406 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST(:)
407 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
408 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT(size(krequest))
409 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
410 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT,IW
411 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size,size(krequest))
412 LOGICAL :: LLABORT
413 llabort=.true.
414 iwaiterr=0
415 icounterr=0
416 
417 IF(mpl_numproc < 1) CALL mpl_message( &
418  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
419 
420 ireqlen=SIZE(krequest)
421 !CALL MPI_WAITALL(IREQLEN,KREQUEST,IWAIT_STATUS,IWAITERR)
422 DO jl=1,ireqlen
423  CALL mpi_wait(krequest(jl),iwait_status(1,jl),iw)
424  iwaiterr=max(iwaiterr,iw)
425 ENDDO
426 
427 IF(PRESENT(kount))THEN
428  IF(SIZE(kount) /= ireqlen) THEN
429  CALL mpl_message( &
430  & cdmessage='MPL_WAIT: KOUNT AND KREQUEST INCONSISTENT ', &
431  & cdstring=cdstring,ldabort=llabort)
432  ENDIF
433  DO jl=1,ireqlen
434  CALL mpi_get_count(iwait_status(1,jl),int(mpi_integer),kount(jl),icounterr)
435  ENDDO
436 ENDIF
437 
438 IF(PRESENT(kerror))THEN
439  kerror=iwaiterr+icounterr
440 ELSE IF(iwaiterr /= 0) THEN
441  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
442 ELSE IF(icounterr /= 0) THEN
443  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
444 ENDIF
445 
446 RETURN
447 END SUBROUTINE mpl_waits_int2
448 
449 
450 SUBROUTINE mpl_wait1_int2(KBUF,KREQUEST,KOUNT,KERROR,CDSTRING)
452 
453 #ifdef USE_8_BYTE_WORDS
454  USE mpi4to8, ONLY : &
455  mpi_waitall => mpi_waitall8, mpi_get_count => mpi_get_count8
456 #endif
457 
458 INTEGER(KIND=JPIM) :: KBUF(:,:)
459 INTEGER(KIND=JPIM),INTENT(IN) :: KREQUEST
460 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
461 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KOUNT
462 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
463 INTEGER(KIND=JPIM) :: IWAITERR,ICOUNTERR,JL,IREQLEN,ICOUNT
464 INTEGER(KIND=JPIM) :: IWAIT_STATUS(mpi_status_size)
465 LOGICAL :: LLABORT
466 llabort=.true.
467 iwaiterr=0
468 icounterr=0
469 
470 IF(mpl_numproc < 1) CALL mpl_message( &
471  & cdmessage='MPL_WAIT: MPL NOT INITIALISED ',ldabort=llabort)
472 
473 CALL mpi_wait(krequest,iwait_status,iwaiterr)
474 
475 IF(PRESENT(kount))THEN
476  CALL mpi_get_count(iwait_status(1),int(mpi_integer),kount,icounterr)
477 ENDIF
478 
479 IF(PRESENT(kerror))THEN
480  kerror=iwaiterr+icounterr
481 ELSE IF(iwaiterr /= 0) THEN
482  CALL mpl_message(iwaiterr,'MPL_WAIT_WAITING',cdstring,ldabort=llabort)
483 ELSE IF(icounterr /= 0) THEN
484  CALL mpl_message(icounterr,'MPL_WAIT_COUNT',cdstring,ldabort=llabort)
485 ENDIF
486 
487 RETURN
488 END SUBROUTINE mpl_wait1_int2
489 
490 END MODULE mpl_wait_mod
subroutine mpl_waits_int(KBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
static long size
Definition: bytes_io.c:262
subroutine, public mpl_message(KERROR, CDMESSAGE, CDSTRING, LDABORT)
integer, parameter jpim
Definition: parkind1.F90:13
integer, parameter jprd
Definition: parkind1.F90:39
integer(kind=jpim) mpl_numproc
subroutine mpl_waits_real4(PBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
subroutine mpl_wait1_int2(KBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
subroutine mpl_wait1_int8(KBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
integer, parameter jprm
Definition: parkind1.F90:30
subroutine mpl_wait1_int(KBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
integer, parameter jpib
Definition: parkind1.F90:14
subroutine mpl_wait1_real4(PBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
subroutine mpl_waits_int2(KBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
subroutine mpl_waits_real8(PBUF, KREQUEST, KOUNT, KERROR, CDSTRING)
subroutine mpl_wait1_real8(PBUF, KREQUEST, KOUNT, KERROR, CDSTRING)