SURFEX v8.1
General documentation of Surfex
mpl_broadcast_mod.F90
Go to the documentation of this file.
1 MODULE mpl_broadcast_mod
2 
3 !**** MPL_BROADCAST Message broadcast
4 
5 ! Purpose.
6 ! --------
7 ! Broadcasts a message from the process with rank root
8 ! to all processes in the group.
9 
10 !** Interface.
11 ! ----------
12 ! CALL MPL_BROADCAST
13 
14 ! Input required arguments :
15 ! -------------------------
16 ! PBUF - buffer containing message
17 ! (can be type REAL*4, REAL*8 or INTEGER)
18 ! KTAG - message tag
19 
20 ! Input optional arguments :
21 ! -------------------------
22 ! KROOT - number of root process (default=1)
23 ! KCOMM - Communicator number if different from MPI_COMM_WORLD
24 ! or from that established as the default
25 ! by an MPL communicator routine
26 ! KMP_TYPE - buffering type (see MPL_BUFFER_METHOD)
27 ! overrides value provided to MPL_BUFFER_METHOD
28 ! CDSTRING - Character string for ABORT messages
29 ! used when KERROR is not provided
30 !
31 
32 ! Output required arguments :
33 ! -------------------------
34 ! none
35 
36 ! Output optional arguments :
37 ! -------------------------
38 ! KREQUEST - Communication request
39 ! required when buffering type is non-blocking
40 ! KERROR - return error code. If not supplied,
41 ! MPL_BROADCAST aborts when an error is detected.
42 ! Author.
43 ! -------
44 ! D.Dent, M.Hamrud, S.Saarinen ECMWF
45 
46 ! Modifications.
47 ! --------------
48 ! Original: 2000-09-01
49 ! P.Marguinaud : 2012-04-13 : Cleaning & refactor PREAMB1
50 ! P.Marguinaud : 2012-09-11 : Add MPL_BROADCAST_LOGICAL1
51 ! M.Hamrud : 2014-10-22 : Add nonblocking option
52 ! F. Vana 05-Mar-2015 Support for single precision
53 
54 ! ------------------------------------------------------------------
55 
56 USE parkind1 , ONLY : jprd, jpim, jpib, jprm
57 
58 USE mpl_mpif
59 USE mpl_data_module
60 USE mpl_stats_mod
61 USE yommplstats
62 USE mpl_message_mod
63 USE mpl_send_mod
64 USE mpl_recv_mod
65 USE mpl_barrier_mod
66 USE mpl_myrank_mod
67 
68 IMPLICIT NONE
69 PRIVATE
70 
71 LOGICAL :: llabort=.true.
72 
73 INTERFACE mpl_broadcast
74 MODULE PROCEDURE mpl_broadcast_real4,mpl_broadcast_real8, &
75  & mpl_broadcast_real42,mpl_broadcast_real43,mpl_broadcast_real44,&
76  & mpl_broadcast_real82,mpl_broadcast_real83,mpl_broadcast_real84,&
77  & mpl_broadcast_real4_scalar,mpl_broadcast_real8_scalar, &
78  & mpl_broadcast_int,mpl_broadcast_int2,mpl_broadcast_int3,mpl_broadcast_int_scalar, &
79  & mpl_broadcast_char_scalar, mpl_broadcast_char1, &
80  & mpl_broadcast_logical_scalar, mpl_broadcast_logical1
81 END INTERFACE
82 
83 PUBLIC mpl_broadcast
84 
85 CONTAINS
86 
87 SUBROUTINE mpl_broadcast_preamb1(KROOTR,KCOMMR,KPL_NUMPROC,KPL_MYRANK,KMP_TYPER,LDRETURN,KERROR,KCOMM,KROOT,KMP_TYPE)
88 
89 
90 #ifdef USE_8_BYTE_WORDS
91  USE mpi4to8, ONLY : &
92  mpi_comm_size => mpi_comm_size8
93 #endif
94 
95 
96 INTEGER(KIND=JPIM),INTENT(OUT) :: KROOTR
97 INTEGER(KIND=JPIM),INTENT(OUT) :: KCOMMR
98 INTEGER(KIND=JPIM),INTENT(OUT) :: KPL_NUMPROC
99 INTEGER(KIND=JPIM),INTENT(OUT) :: KPL_MYRANK
100 INTEGER(KIND=JPIM),INTENT(OUT) :: KMP_TYPER
101 LOGICAL, INTENT(OUT) :: LDRETURN
102 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
103 INTEGER(KIND=JPIM),INTENT(IN), OPTIONAL :: KROOT
104 INTEGER(KIND=JPIM),INTENT(IN), OPTIONAL :: KCOMM
105 INTEGER(KIND=JPIM),INTENT(IN), OPTIONAL :: KMP_TYPE
106 
107 INTEGER(KIND=JPIM) :: IERROR
108 INTEGER(KIND=JPIM) :: ITID
109 
110 itid = oml_my_thread()
111 ierror = 0
112 
113 IF(mpl_numproc < 1) CALL mpl_message( &
114  & cdmessage='MPL_BROADCAST: MPL NOT INITIALISED ',ldabort=llabort)
115 
116 IF(PRESENT(kcomm)) THEN
117  kcommr=kcomm
118 ELSE
119  kcommr=mpl_comm_oml(itid)
120 ENDIF
121 
122 IF(kcommr == mpl_comm_oml(itid)) THEN
123  kpl_numproc = mpl_numproc
124  kpl_myrank = mpl_rank
125 ELSE
126  CALL mpi_comm_size(kcommr,kpl_numproc,ierror)
127  kpl_myrank = mpl_myrank(kcommr)
128 ENDIF
129 
130 IF(PRESENT(kroot)) THEN
131  krootr=kroot
132 ELSE
133  krootr=1
134 ENDIF
135 
136 IF(PRESENT(kmp_type)) THEN
137  kmp_typer=kmp_type
138 ELSE
139  kmp_typer=mpl_method
140 ENDIF
141 
142 IF (PRESENT (kerror)) kerror = ierror
143 
144 IF (kpl_numproc == 1) THEN
145  IF(PRESENT(kerror)) THEN
146  kerror=0
147  ENDIF
148  ldreturn=.true.
149 ELSE
150  ldreturn=.false.
151 ENDIF
152 
153 END SUBROUTINE mpl_broadcast_preamb1
154 
155 SUBROUTINE mpl_broadcast_real4(PBUF,KTAG,KROOT,KMP_TYPE,&
156  KCOMM,KERROR,KREQUEST,CDSTRING)
157 
158 
159 #ifdef USE_8_BYTE_WORDS
160  USE mpi4to8, ONLY : &
161  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
162 #endif
163 
164 
165 REAL(KIND=JPRM) :: PBUF(:)
166 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
167 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
168 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
169 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
170 
171 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
172 LOGICAL :: LLRETURN
173 
174 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
175 IF (llreturn) RETURN
176 
177 ierror = 0
178 
179 icount = SIZE(pbuf)
180 
181 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
182  CALL mpi_bcast(pbuf,icount,int(mpi_real4),iroot-1,icomm,ierror)
183 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
184  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
185  CALL mpi_ibcast(pbuf,icount,int(mpi_real4),iroot-1,icomm,krequest,ierror)
186 ELSE
187  IF(PRESENT(kerror)) THEN
188  ierror=1
189  ELSE
190  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
191  ENDIF
192 ENDIF
193 
194 IF(lmplstats) THEN
195  IF(iroot == ipl_myrank) THEN
196  CALL mpl_sendstats(icount,int(mpi_real4))
197  ENDIF
198  CALL mpl_recvstats(icount,int(mpi_real4))
199 ENDIF
200 
201 IF(PRESENT(kerror)) THEN
202  kerror=ierror
203 ELSE
204  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
205 ENDIF
206 
207 
208 END SUBROUTINE mpl_broadcast_real4
209 
210 SUBROUTINE mpl_broadcast_real8(PBUF,KTAG,KROOT,KMP_TYPE,&
211  KCOMM,KERROR,KREQUEST,CDSTRING)
212 
213 
214 #ifdef USE_8_BYTE_WORDS
215  USE mpi4to8, ONLY : &
216  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
217 #endif
218 
219 
220 REAL(KIND=JPRD) :: PBUF(:)
221 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
222 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
223 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
224 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
225 
226 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
227 LOGICAL :: LLRETURN
228 
229 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
230 IF (llreturn) RETURN
231 
232 ierror = 0
233 
234 icount = SIZE(pbuf)
235 
236 ! Passing PBUF(1) here causes incorrect results on IBM
237 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
238  CALL mpi_bcast(pbuf,icount,int(mpi_real8),iroot-1,icomm,ierror)
239 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
240  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
241  CALL mpi_ibcast(pbuf,icount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
242 ELSE
243  IF(PRESENT(kerror)) THEN
244  ierror=1
245  ELSE
246  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
247  ENDIF
248 ENDIF
249 IF(lmplstats) THEN
250  IF(iroot == ipl_myrank) THEN
251  CALL mpl_sendstats(icount,int(mpi_real8))
252  ENDIF
253  CALL mpl_recvstats(icount,int(mpi_real8))
254 ENDIF
255 
256 IF(PRESENT(kerror)) THEN
257  kerror=ierror
258 ELSE
259  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
260 ENDIF
261 
262 
263 END SUBROUTINE mpl_broadcast_real8
264 
265 
266 SUBROUTINE mpl_broadcast_real42(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
267 
268 REAL(KIND=JPRM) :: PBUF(:,:)
269 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
270 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
271 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
272 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
273 
274 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
275 LOGICAL :: LLRETURN
276 
277 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
278 IF (llreturn) RETURN
279 
280 ierror = 0
281 
282 icount = SIZE(pbuf)
283 IF (icount > 0) THEN
284  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2))) - &
285  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2)))) /= 4_jpib*(icount - 1) ) THEN
286  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
287  ENDIF
288 ENDIF
289 
290 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
291  CALL mpi_bcast(pbuf(1,1),icount,int(mpi_real4),iroot-1,icomm,ierror)
292 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
293  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
294  CALL mpi_ibcast(pbuf(1,1),icount,int(mpi_real4),iroot-1,icomm,krequest,ierror)
295 ELSE
296  IF(PRESENT(kerror)) THEN
297  ierror=1
298  ELSE
299  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
300  ENDIF
301 ENDIF
302 
303 IF(lmplstats) THEN
304  IF(iroot == ipl_myrank) THEN
305  CALL mpl_sendstats(icount,int(mpi_real4))
306  ENDIF
307  CALL mpl_recvstats(icount,int(mpi_real4))
308 ENDIF
309 
310 IF(PRESENT(kerror)) THEN
311  kerror=ierror
312 ELSE
313  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
314 ENDIF
315 
316 END SUBROUTINE mpl_broadcast_real42
317 
318 
319 SUBROUTINE mpl_broadcast_real43(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
320 
321 REAL(KIND=JPRM) :: PBUF(:,:,:)
322 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
323 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
324 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
325 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
326 
327 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
328 LOGICAL :: LLRETURN
329 
330 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
331 IF (llreturn) RETURN
332 
333 ierror = 0
334 
335 icount = SIZE(pbuf)
336 IF (icount > 0) THEN
337  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2),ubound(pbuf,3))) - &
338  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2),lbound(pbuf,3)))) /= 4_jpib*(icount - 1) ) THEN
339  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
340  ENDIF
341 ENDIF
342 
343 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
344  CALL mpi_bcast(pbuf(1,1,1),icount,int(mpi_real4),iroot-1,icomm,ierror)
345 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
346  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
347  CALL mpi_ibcast(pbuf(1,1,1),icount,int(mpi_real4),iroot-1,icomm,krequest,ierror)
348 ELSE
349  IF(PRESENT(kerror)) THEN
350  ierror=1
351  ELSE
352  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
353  ENDIF
354 ENDIF
355 
356 IF(lmplstats) THEN
357  IF(iroot == ipl_myrank) THEN
358  CALL mpl_sendstats(icount,int(mpi_real4))
359  ENDIF
360  CALL mpl_recvstats(icount,int(mpi_real4))
361 ENDIF
362 
363 IF(PRESENT(kerror)) THEN
364  kerror=ierror
365 ELSE
366  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
367 ENDIF
368 
369 END SUBROUTINE mpl_broadcast_real43
370 
371 
372 SUBROUTINE mpl_broadcast_real44(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
373 
374 REAL(KIND=JPRM) :: PBUF(:,:,:,:)
375 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
376 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
377 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
378 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
379 
380 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
381 LOGICAL :: LLRETURN
382 
383 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
384 IF (llreturn) RETURN
385 
386 ierror = 0
387 
388 icount = SIZE(pbuf)
389 IF (icount > 0) THEN
390  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2),ubound(pbuf,3),ubound(pbuf,4))) - &
391  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2),lbound(pbuf,3),lbound(pbuf,4)))) &
392  & /= 4_jpib*(icount - 1) ) THEN
393  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
394  ENDIF
395 ENDIF
396 
397 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
398  CALL mpi_bcast(pbuf(1,1,1,1),icount,int(mpi_real4),iroot-1,icomm,ierror)
399 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
400  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
401  CALL mpi_ibcast(pbuf(1,1,1,1),icount,int(mpi_real4),iroot-1,icomm,krequest,ierror)
402 ELSE
403  IF(PRESENT(kerror)) THEN
404  ierror=1
405  ELSE
406  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
407  ENDIF
408 ENDIF
409 
410 IF(lmplstats) THEN
411  IF(iroot == ipl_myrank) THEN
412  CALL mpl_sendstats(icount,int(mpi_real4))
413  ENDIF
414  CALL mpl_recvstats(icount,int(mpi_real4))
415 ENDIF
416 
417 IF(PRESENT(kerror)) THEN
418  kerror=ierror
419 ELSE
420  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
421 ENDIF
422 
423 END SUBROUTINE mpl_broadcast_real44
424 
425 
426 SUBROUTINE mpl_broadcast_real82(PBUF,KTAG,KROOT,KMP_TYPE,&
427  KCOMM,KERROR,KREQUEST,CDSTRING)
428 
429 #ifdef USE_8_BYTE_WORDS
430  USE mpi4to8, ONLY : &
431  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
432 #endif
433 
434 REAL(KIND=JPRD) :: PBUF(:,:)
435 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
436 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
437 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
438 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
439 
440 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
441 LOGICAL :: LLRETURN
442 
443 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
444 IF (llreturn) RETURN
445 
446 ierror = 0
447 
448 icount = SIZE(pbuf)
449 #ifndef NAG
450 IF (icount > 0) THEN
451  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2))) - &
452  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2)))) /= 8_jpib*(icount - 1) ) THEN
453  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
454  ENDIF
455 ENDIF
456 #endif
457 
458 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
459  CALL mpi_bcast(pbuf(1,1),icount,int(mpi_real8),iroot-1,icomm,ierror)
460 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
461  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
462  CALL mpi_ibcast(pbuf(1,1),icount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
463 ELSE
464  IF(PRESENT(kerror)) THEN
465  ierror=1
466  ELSE
467  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
468  ENDIF
469 ENDIF
470 
471 IF(lmplstats) THEN
472  IF(iroot == ipl_myrank) THEN
473  CALL mpl_sendstats(icount,int(mpi_real8))
474  ENDIF
475  CALL mpl_recvstats(icount,int(mpi_real8))
476 ENDIF
477 
478 IF(PRESENT(kerror)) THEN
479  kerror=ierror
480 ELSE
481  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
482 ENDIF
483 
484 
485 END SUBROUTINE mpl_broadcast_real82
486 
487 SUBROUTINE mpl_broadcast_real83(PBUF,KTAG,KROOT,KMP_TYPE,&
488  KCOMM,KERROR,KREQUEST,CDSTRING)
489 
490 #ifdef USE_8_BYTE_WORDS
491  USE mpi4to8, ONLY : &
492  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
493 #endif
494 
495 
496 REAL(KIND=JPRD) :: PBUF(:,:,:)
497 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
498 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
499 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
500 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
501 
502 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
503 LOGICAL :: LLRETURN
504 
505 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
506 IF (llreturn) RETURN
507 
508 ierror = 0
509 
510 icount = SIZE(pbuf)
511 #ifndef NAG
512 IF (icount > 0) THEN
513  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2),ubound(pbuf,3))) - &
514  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2),lbound(pbuf,3)))) /= 8_jpib*(icount - 1) ) THEN
515  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
516  ENDIF
517 ENDIF
518 #endif
519 
520 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
521  CALL mpi_bcast(pbuf(1,1,1),icount,int(mpi_real8),iroot-1,icomm,ierror)
522 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
523  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
524  CALL mpi_ibcast(pbuf(1,1,1),icount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
525 ELSE
526  IF(PRESENT(kerror)) THEN
527  ierror=1
528  ELSE
529  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
530  ENDIF
531 ENDIF
532 IF(lmplstats) THEN
533  IF(iroot == ipl_myrank) THEN
534  CALL mpl_sendstats(icount,int(mpi_real8))
535  ENDIF
536  CALL mpl_recvstats(icount,int(mpi_real8))
537 ENDIF
538 
539 IF(PRESENT(kerror)) THEN
540  kerror=ierror
541 ELSE
542  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
543 ENDIF
544 
545 
546 END SUBROUTINE mpl_broadcast_real83
547 
548 SUBROUTINE mpl_broadcast_real84(PBUF,KTAG,KROOT,KMP_TYPE,&
549  KCOMM,KERROR,KREQUEST,CDSTRING)
550 
551 #ifdef USE_8_BYTE_WORDS
552  USE mpi4to8, ONLY : &
553  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
554 #endif
555 
556 
557 REAL(KIND=JPRD) :: PBUF(:,:,:,:)
558 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
559 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
560 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
561 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
562 
563 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
564 LOGICAL :: LLRETURN
565 
566 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
567 IF (llreturn) RETURN
568 
569 ierror = 0
570 
571 icount = SIZE(pbuf)
572 #ifndef NAG
573 IF (icount > 0) THEN
574  IF( (loc(pbuf(ubound(pbuf,1),ubound(pbuf,2),ubound(pbuf,3),ubound(pbuf,4))) - &
575  & loc(pbuf(lbound(pbuf,1),lbound(pbuf,2),lbound(pbuf,3),lbound(pbuf,4)))) /= 8_jpib*(icount - 1) ) THEN
576  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
577  ENDIF
578 ENDIF
579 #endif
580 
581 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
582  CALL mpi_bcast(pbuf(1,1,1,1),icount,int(mpi_real8),iroot-1,icomm,ierror)
583 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
584  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
585  CALL mpi_ibcast(pbuf(1,1,1,1),icount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
586 ELSE
587  IF(PRESENT(kerror)) THEN
588  ierror=1
589  ELSE
590  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
591  ENDIF
592 ENDIF
593 
594 IF(lmplstats) THEN
595  IF(iroot == ipl_myrank) THEN
596  CALL mpl_sendstats(icount,int(mpi_real8))
597  ENDIF
598  CALL mpl_recvstats(icount,int(mpi_real8))
599 ENDIF
600 
601 IF(PRESENT(kerror)) THEN
602  kerror=ierror
603 ELSE
604  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
605 ENDIF
606 
607 
608 END SUBROUTINE mpl_broadcast_real84
609 
610 
611 SUBROUTINE mpl_broadcast_real4_scalar(PBUF,KTAG,KROOT,KMP_TYPE,&
612  KCOMM,KERROR,KREQUEST,CDSTRING)
613 
614 
615 #ifdef USE_8_BYTE_WORDS
616  USE mpi4to8, ONLY : &
617  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
618 #endif
619 
620 
621 REAL(KIND=JPRM) :: PBUF
622 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
623 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
624 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
625 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
626 
627 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
628 LOGICAL :: LLRETURN
629 
630 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
631 IF (llreturn) RETURN
632 
633 ierror = 0
634 
635 icount = 1
636 
637 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
638  CALL mpi_bcast(pbuf,icount,int(mpi_real4),iroot-1,icomm,ierror)
639 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
640  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
641  CALL mpi_ibcast(pbuf,icount,int(mpi_real4),iroot-1,icomm,krequest,ierror)
642 ELSE
643  IF(PRESENT(kerror)) THEN
644  ierror=1
645  ELSE
646  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
647  ENDIF
648 ENDIF
649 
650 IF(PRESENT(kerror)) THEN
651  kerror=ierror
652 ELSE
653  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
654 ENDIF
655 
656 END SUBROUTINE mpl_broadcast_real4_scalar
657 
658 
659 SUBROUTINE mpl_broadcast_real8_scalar(PBUF,KTAG,KROOT,KMP_TYPE,&
660  KCOMM,KERROR,KREQUEST,CDSTRING)
661 
662 
663 #ifdef USE_8_BYTE_WORDS
664  USE mpi4to8, ONLY : &
665  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
666 #endif
667 
668 
669 REAL(KIND=JPRD) :: PBUF
670 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
671 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
672 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
673 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
674 
675 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
676 LOGICAL :: LLRETURN
677 
678 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
679 IF (llreturn) RETURN
680 
681 ierror = 0
682 
683 icount = 1
684 
685 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
686  CALL mpi_bcast(pbuf,icount,int(mpi_real8),iroot-1,icomm,ierror)
687 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
688  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
689  CALL mpi_ibcast(pbuf,icount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
690 ELSE
691  IF(PRESENT(kerror)) THEN
692  ierror=1
693  ELSE
694  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
695  ENDIF
696 ENDIF
697 
698 IF(PRESENT(kerror)) THEN
699  kerror=ierror
700 ELSE
701  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
702 ENDIF
703 
704 
705 END SUBROUTINE mpl_broadcast_real8_scalar
706 
707 
708 SUBROUTINE mpl_broadcast_int(KBUF,KTAG,KROOT,KMP_TYPE,&
709  KCOMM,KERROR,KREQUEST,CDSTRING)
710 
711 
712 #ifdef USE_8_BYTE_WORDS
713  USE mpi4to8, ONLY : &
714  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
715 #endif
716 
717 
718 INTEGER(KIND=JPIM) :: KBUF(:)
719 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
720 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
721 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
722 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
723 
724 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
725 LOGICAL :: LLRETURN
726 
727 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
728 IF (llreturn) RETURN
729 
730 ierror = 0
731 
732 icount = SIZE(kbuf)
733 
734 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
735  CALL mpi_bcast(kbuf,icount,int(mpi_integer),iroot-1,icomm,ierror)
736 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
737  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
738  CALL mpi_ibcast(kbuf,icount,int(mpi_integer),iroot-1,icomm,krequest,ierror)
739 ELSE
740  IF(PRESENT(kerror)) THEN
741  ierror=1
742  ELSE
743  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
744  ENDIF
745 ENDIF
746 
747 IF(lmplstats) THEN
748  IF(iroot == ipl_myrank) THEN
749  CALL mpl_sendstats(icount,int(mpi_integer))
750  ENDIF
751  CALL mpl_recvstats(icount,int(mpi_integer))
752 ENDIF
753 
754 IF(PRESENT(kerror)) THEN
755  kerror=ierror
756 ELSE
757  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
758 ENDIF
759 
760 
761 END SUBROUTINE mpl_broadcast_int
762 
763 
764 SUBROUTINE mpl_broadcast_int2(KBUF,KTAG,KROOT,KMP_TYPE,&
765  KCOMM,KERROR,KREQUEST,CDSTRING)
766 
767 INTEGER(KIND=JPIM) :: KBUF(:,:)
768 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
769 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
770 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
771 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
772 
773 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
774 LOGICAL :: LLRETURN
775 
776 
777 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
778 IF (llreturn) RETURN
779 
780 ierror = 0
781 icount = SIZE(kbuf)
782 
783 IF (icount > 0) THEN
784  IF( (loc(kbuf(ubound(kbuf,1),ubound(kbuf,2))) - &
785  & loc(kbuf(lbound(kbuf,1),lbound(kbuf,2)))) /= 4_jpib*(icount - 1) ) THEN
786  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
787  ENDIF
788 ENDIF
789 
790 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
791  CALL mpi_bcast(kbuf(1,1),icount,int(mpi_integer),iroot-1,icomm,ierror)
792 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
793  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
794  CALL mpi_ibcast(kbuf(1,1),icount,int(mpi_integer),iroot-1,icomm,krequest,ierror)
795 ELSE
796  IF(PRESENT(kerror)) THEN
797  ierror=1
798  ELSE
799  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
800  ENDIF
801 ENDIF
802 
803 IF(lmplstats) THEN
804  IF(iroot == ipl_myrank) THEN
805  CALL mpl_sendstats(icount,int(mpi_integer))
806  ENDIF
807  CALL mpl_recvstats(icount,int(mpi_integer))
808 ENDIF
809 
810 IF(PRESENT(kerror)) THEN
811  kerror=ierror
812 ELSE
813  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
814 ENDIF
815 
816 END SUBROUTINE mpl_broadcast_int2
817 
818 
819 SUBROUTINE mpl_broadcast_int3(KBUF,KTAG,KROOT,KMP_TYPE,&
820  KCOMM,KERROR,KREQUEST,CDSTRING)
821 
822 INTEGER(KIND=JPIM) :: KBUF(:,:,:)
823 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
824 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
825 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
826 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
827 
828 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
829 LOGICAL :: LLRETURN
830 
831 
832 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
833 IF (llreturn) RETURN
834 
835 ierror = 0
836 icount = SIZE(kbuf)
837 
838 IF (icount > 0) THEN
839  IF( (loc(kbuf(ubound(kbuf,1),ubound(kbuf,2),ubound(kbuf,3))) - &
840  & loc(kbuf(lbound(kbuf,1),lbound(kbuf,2),lbound(kbuf,3)))) /= 4_jpib*(icount - 1) ) THEN
841  CALL mpl_message(cdmessage='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',ldabort=llabort)
842  ENDIF
843 ENDIF
844 
845 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
846  CALL mpi_bcast(kbuf(1,1,1),icount,int(mpi_integer),iroot-1,icomm,ierror)
847 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
848  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
849  CALL mpi_ibcast(kbuf(1,1,1),icount,int(mpi_integer),iroot-1,icomm,krequest,ierror)
850 ELSE
851  IF(PRESENT(kerror)) THEN
852  ierror=1
853  ELSE
854  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
855  ENDIF
856 ENDIF
857 
858 IF(lmplstats) THEN
859  IF(iroot == ipl_myrank) THEN
860  CALL mpl_sendstats(icount,int(mpi_integer))
861  ENDIF
862  CALL mpl_recvstats(icount,int(mpi_integer))
863 ENDIF
864 
865 IF(PRESENT(kerror)) THEN
866  kerror=ierror
867 ELSE
868  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
869 ENDIF
870 
871 END SUBROUTINE mpl_broadcast_int3
872 
873 
874 SUBROUTINE mpl_broadcast_int_scalar(KBUF,KTAG,KROOT,KMP_TYPE,&
875  KCOMM,KERROR,KREQUEST,CDSTRING)
876 
877 
878 #ifdef USE_8_BYTE_WORDS
879  USE mpi4to8, ONLY : &
880  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
881 #endif
882 
883 
884 INTEGER(KIND=JPIM) :: KBUF
885 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
886 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
887 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
888 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
889 
890 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
891 LOGICAL :: LLRETURN
892 
893 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
894 IF (llreturn) RETURN
895 
896 ierror = 0
897 
898 icount = 1
899 
900 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
901  CALL mpi_bcast(kbuf,icount,int(mpi_integer),iroot-1,icomm,ierror)
902 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
903  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
904  CALL mpi_ibcast(kbuf,icount,int(mpi_integer),iroot-1,icomm,krequest,ierror)
905 ELSE
906  IF(PRESENT(kerror)) THEN
907  ierror=1
908  ELSE
909  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
910  ENDIF
911 ENDIF
912 
913 IF(lmplstats) THEN
914  IF(iroot == ipl_myrank) THEN
915  CALL mpl_sendstats(icount,int(mpi_integer))
916  ENDIF
917  CALL mpl_recvstats(icount,int(mpi_integer))
918 ENDIF
919 
920 IF(PRESENT(kerror)) THEN
921  kerror=ierror
922 ELSE
923  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
924 ENDIF
925 
926 
927 END SUBROUTINE mpl_broadcast_int_scalar
928 
929 
930 SUBROUTINE mpl_broadcast_char_scalar(CDBUF,KTAG,KROOT,KMP_TYPE,&
931  KCOMM,KERROR,KREQUEST,CDSTRING)
932 
933 
934 #ifdef USE_8_BYTE_WORDS
935  USE mpi4to8, ONLY : &
936  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
937 #endif
938 
939 
940 CHARACTER*(*) :: CDBUF
941 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
942 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
943 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
944 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
945 
946 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
947 LOGICAL :: LLRETURN
948 
949 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
950 IF (llreturn) RETURN
951 
952 ierror = 0
953 
954 icount = len(cdbuf)
955 
956 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
957  CALL mpi_bcast(cdbuf,icount,int(mpi_byte),iroot-1,icomm,ierror)
958 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
959  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
960  CALL mpi_ibcast(cdbuf,icount,int(mpi_byte),iroot-1,icomm,krequest,ierror)
961 ELSE
962  IF(PRESENT(kerror)) THEN
963  ierror=1
964  ELSE
965  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
966  ENDIF
967 ENDIF
968 
969 IF(lmplstats) THEN
970  IF(iroot == ipl_myrank) THEN
971  CALL mpl_sendstats(icount,int(mpi_byte))
972  ENDIF
973  CALL mpl_recvstats(icount,int(mpi_byte))
974 ENDIF
975 
976 IF(PRESENT(kerror)) THEN
977  kerror=ierror
978 ELSE
979  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
980 ENDIF
981 
982 
983 END SUBROUTINE mpl_broadcast_char_scalar
984 
985 SUBROUTINE mpl_broadcast_char1(CDBUF,KTAG,KROOT,KMP_TYPE,&
986  KCOMM,KERROR,KREQUEST,CDSTRING)
987 
988 
989 #ifdef USE_8_BYTE_WORDS
990  USE mpi4to8, ONLY : &
991  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
992 #endif
993 
994 
995 CHARACTER*(*) :: CDBUF (:)
996 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
997 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
998 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
999 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
1000 
1001 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
1002 LOGICAL :: LLRETURN
1003 
1004 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
1005 IF (llreturn) RETURN
1006 
1007 ierror = 0
1008 
1009 icount = len(cdbuf)*SIZE(cdbuf)
1010 
1011 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
1012  CALL mpi_bcast(cdbuf,icount,int(mpi_byte),iroot-1,icomm,ierror)
1013 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
1014  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
1015  CALL mpi_ibcast(cdbuf,icount,int(mpi_byte),iroot-1,icomm,krequest,ierror)
1016 ELSE
1017  IF(PRESENT(kerror)) THEN
1018  ierror=1
1019  ELSE
1020  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
1021  ENDIF
1022 ENDIF
1023 
1024 IF(lmplstats) THEN
1025  IF(iroot == ipl_myrank) THEN
1026  CALL mpl_sendstats(icount,int(mpi_byte))
1027  ENDIF
1028  CALL mpl_recvstats(icount,int(mpi_byte))
1029 ENDIF
1030 
1031 IF(PRESENT(kerror)) THEN
1032  kerror=ierror
1033 ELSE
1034  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
1035 ENDIF
1036 
1037 
1038 END SUBROUTINE mpl_broadcast_char1
1039 
1040 SUBROUTINE mpl_broadcast_logical_scalar(LDBUF,KTAG,KROOT,KMP_TYPE,&
1041  KCOMM,KERROR,KREQUEST,CDSTRING)
1042 
1043 
1044 #ifdef USE_8_BYTE_WORDS
1045  USE mpi4to8, ONLY : &
1046  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
1047 #endif
1048 
1049 
1050 LOGICAL :: LDBUF
1051 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
1052 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
1053 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
1054 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
1055 
1056 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
1057 LOGICAL :: LLRETURN
1058 
1059 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
1060 IF (llreturn) RETURN
1061 
1062 ierror = 0
1063 
1064 icount = 1
1065 
1066 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
1067  CALL mpi_bcast(ldbuf,icount,int(mpi_logical),iroot-1,icomm,ierror)
1068 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
1069  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
1070  CALL mpi_ibcast(ldbuf,icount,int(mpi_logical),iroot-1,icomm,krequest,ierror)
1071 ELSE
1072  IF(PRESENT(kerror)) THEN
1073  ierror=1
1074  ELSE
1075  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
1076  ENDIF
1077 ENDIF
1078 
1079 IF(lmplstats) THEN
1080  IF(iroot == ipl_myrank) THEN
1081  CALL mpl_sendstats(icount,int(mpi_byte))
1082  ENDIF
1083  CALL mpl_recvstats(icount,int(mpi_byte))
1084 ENDIF
1085 
1086 IF(PRESENT(kerror)) THEN
1087  kerror=ierror
1088 ELSE
1089  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
1090 ENDIF
1091 
1092 
1093 END SUBROUTINE mpl_broadcast_logical_scalar
1094 
1095 SUBROUTINE mpl_broadcast_logical1(LDBUF,KTAG,KROOT,KMP_TYPE,&
1096  KCOMM,KERROR,KREQUEST,CDSTRING)
1097 
1098 
1099 #ifdef USE_8_BYTE_WORDS
1100  USE mpi4to8, ONLY : &
1101  mpi_comm_size => mpi_comm_size8, mpi_bcast => mpi_bcast8
1102 #endif
1103 
1104 
1105 LOGICAL :: LDBUF (:)
1106 INTEGER(KIND=JPIM),INTENT(IN) :: KTAG
1107 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT,KCOMM,KMP_TYPE
1108 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
1109 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
1110 
1111 INTEGER(KIND=JPIM) :: ICOUNT,ICOMM,IERROR,IROOT,IPL_NUMPROC,IPL_MYRANK,IMP_TYPE
1112 LOGICAL :: LLRETURN
1113 
1114 CALL mpl_broadcast_preamb1(iroot,icomm,ipl_numproc,ipl_myrank,imp_type,llreturn,kerror,kcomm,kroot,kmp_type)
1115 IF (llreturn) RETURN
1116 
1117 ierror = 0
1118 
1119 icount = SIZE (ldbuf)
1120 
1121 IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
1122  CALL mpi_bcast (ldbuf,icount,int(mpi_logical),iroot-1,icomm,ierror)
1123 ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
1124  IF(.NOT.PRESENT(krequest)) CALL mpl_message(kerror,'MPL_SEND',' KREQUEST MISSING',ldabort=llabort)
1125  CALL mpi_ibcast (ldbuf,icount,int(mpi_logical),iroot-1,icomm,krequest,ierror)
1126 ELSE
1127  IF(PRESENT(kerror)) THEN
1128  ierror=1
1129  ELSE
1130  CALL mpl_message(kerror,'MPL_BROADCAST',' INVALID METHOD',ldabort=llabort)
1131  ENDIF
1132 ENDIF
1133 
1134 
1135 IF(lmplstats) THEN
1136  IF(iroot == ipl_myrank) THEN
1137  CALL mpl_sendstats(icount,int(mpi_byte))
1138  ENDIF
1139  CALL mpl_recvstats(icount,int(mpi_byte))
1140 ENDIF
1141 
1142 IF(PRESENT(kerror)) THEN
1143  kerror=ierror
1144 ELSE
1145  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_BROADCAST',cdstring,ldabort=llabort)
1146 ENDIF
1147 
1148 
1149 END SUBROUTINE mpl_broadcast_logical1
1150 
1151 END MODULE mpl_broadcast_mod
mpl_send_mod
Definition: mpl_send_mod.F90:4
mpl_broadcast_mod::mpl_broadcast_real82
subroutine mpl_broadcast_real82(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:428
mpl_broadcast_mod::mpl_broadcast_int_scalar
subroutine mpl_broadcast_int_scalar(KBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:876
mpl_message_mod::mpl_message
subroutine, public mpl_message(KERROR, CDMESSAGE, CDSTRING, LDABORT)
Definition: mpl_message_mod.F90:54
mpl_broadcast_mod::mpl_broadcast_char1
subroutine mpl_broadcast_char1(CDBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:987
mpl_broadcast_mod::mpl_broadcast_int3
subroutine mpl_broadcast_int3(KBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:821
mpl_data_module::jp_blocking_buffered
integer(kind=jpim), parameter jp_blocking_buffered
Definition: mpl_data_module.F90:61
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
mpl_barrier_mod
Definition: mpl_barrier_mod.F90:1
parkind1::jprd
integer, parameter jprd
Definition: parkind1.F90:39
mpl_stats_mod::mpl_recvstats
subroutine, public mpl_recvstats(ICOUNT, ITYPE)
Definition: mpl_stats_mod.F90:271
mpl_broadcast_mod::mpl_broadcast_real44
subroutine mpl_broadcast_real44(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:373
mpl_broadcast_mod::mpl_broadcast
Definition: mpl_broadcast_mod.F90:73
mpl_mpif
Definition: mpl_mpif.F90:1
mpl_data_module::mpl_numproc
integer(kind=jpim) mpl_numproc
Definition: mpl_data_module.F90:40
mpl_stats_mod
Definition: mpl_stats_mod.F90:1
mpl_broadcast_mod::mpl_broadcast_real83
subroutine mpl_broadcast_real83(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:489
mpl_broadcast_mod::mpl_broadcast_char_scalar
subroutine mpl_broadcast_char_scalar(CDBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:932
yommplstats::lmplstats
logical lmplstats
Definition: yommplstats.F90:17
mpl_message_mod
Definition: mpl_message_mod.F90:1
mpl_data_module::jp_non_blocking_standard
integer(kind=jpim), parameter jp_non_blocking_standard
Definition: mpl_data_module.F90:64
mpl_broadcast_mod
Definition: mpl_broadcast_mod.F90:1
mpl_data_module::mpl_comm_oml
integer(kind=jpim), dimension(:), allocatable mpl_comm_oml
Definition: mpl_data_module.F90:43
mpl_data_module::jp_blocking_standard
integer(kind=jpim), parameter jp_blocking_standard
Definition: mpl_data_module.F90:60
mpl_broadcast_mod::mpl_broadcast_logical1
subroutine mpl_broadcast_logical1(LDBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:1097
mpl_stats_mod::mpl_sendstats
subroutine, public mpl_sendstats(ICOUNT, ITYPE)
Definition: mpl_stats_mod.F90:206
mpl_myrank_mod
Definition: mpl_myrank_mod.F90:1
mpl_data_module::jp_non_blocking_buffered
integer(kind=jpim), parameter jp_non_blocking_buffered
Definition: mpl_data_module.F90:65
mpl_broadcast_mod::mpl_broadcast_logical_scalar
subroutine mpl_broadcast_logical_scalar(LDBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:1042
parkind1::jprm
integer, parameter jprm
Definition: parkind1.F90:30
mpl_broadcast_mod::mpl_broadcast_int
subroutine mpl_broadcast_int(KBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:710
mpl_myrank_mod::mpl_myrank
integer(kind=jpim) function, public mpl_myrank(KCOMM)
Definition: mpl_myrank_mod.F90:54
mpl_barrier_mod::llabort
logical llabort
Definition: mpl_barrier_mod.F90:54
mpl_broadcast_mod::mpl_broadcast_preamb1
subroutine mpl_broadcast_preamb1(KROOTR, KCOMMR, KPL_NUMPROC, KPL_MYRANK, KMP_TYPER, LDRETURN, KERROR, KCOMM, KROOT, KMP_TYPE)
Definition: mpl_broadcast_mod.F90:88
mpl_broadcast_mod::mpl_broadcast_real84
subroutine mpl_broadcast_real84(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:550
mpl_data_module::mpl_rank
integer(kind=jpim) mpl_rank
Definition: mpl_data_module.F90:40
mpl_broadcast_mod::mpl_broadcast_real4
subroutine mpl_broadcast_real4(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:157
mpl_data_module
Definition: mpl_data_module.F90:1
mpl_data_module::mpl_method
integer(kind=jpim) mpl_method
Definition: mpl_data_module.F90:39
mpl_broadcast_mod::mpl_broadcast_real4_scalar
subroutine mpl_broadcast_real4_scalar(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:613
mpl_broadcast_mod::mpl_broadcast_real42
subroutine mpl_broadcast_real42(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:267
mpl_broadcast_mod::mpl_broadcast_real8_scalar
subroutine mpl_broadcast_real8_scalar(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:661
mpl_recv_mod
Definition: mpl_recv_mod.F90:5
mpl_broadcast_mod::mpl_broadcast_real43
subroutine mpl_broadcast_real43(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:320
parkind1::jpib
integer, parameter jpib
Definition: parkind1.F90:14
mpl_broadcast_mod::mpl_broadcast_real8
subroutine mpl_broadcast_real8(PBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:212
mpl_broadcast_mod::mpl_broadcast_int2
subroutine mpl_broadcast_int2(KBUF, KTAG, KROOT, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_broadcast_mod.F90:766
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13