SURFEX v8.1
General documentation of Surfex
mpl_gatherv_mod.F90
Go to the documentation of this file.
1 #ifdef RS6K
2 @process nocheck
3 #endif
4 MODULE mpl_gatherv_mod
5 
6 !**** MPL_GATHERV Gather data to specific processor
7 
8 ! Purpose.
9 ! --------
10 ! Gather data to specific processor
11 ! The data may be REAL*4, REAL*8,or INTEGER, one dimensional array
12 ! REAL*4,or REAL*8, two dimensional array
13 ! or INTEGER scalar
14 
15 !** Interface.
16 ! ----------
17 ! CALL MPL_GATHERV
18 
19 ! Input required arguments :
20 ! -------------------------
21 ! PSENDBUF - buffer containing message
22 ! (can be type REAL*4, REAL*8 or INTEGER)
23 ! PRECVBUF - buffer containing message (required from kroot)
24 ! (can be type REAL*4, REAL*8 or INTEGER)
25 ! KRECVCOUNTS-number of elements received from each process
26 ! (required from kroot processor)
27 
28 ! Input optional arguments :
29 ! -------------------------
30 ! KROOT - rank of receiveing processor (default 1)
31 ! KMP_TYPE - buffering type (see MPL_BUFFER_METHOD)
32 ! overrides value provided to MPL_BUFFER_METHOD
33 ! KCOMM - Communicator number if different from MPI_COMM_WORLD
34 ! or from that established as the default
35 ! by an MPL communicator routine
36 ! KRECVDISPL -displacements in PRECVBUF at which to place
37 ! the incoming data
38 ! CDSTRING - Character string for ABORT messages
39 ! used when KERROR is not provided
40 
41 ! Output required arguments :
42 ! -------------------------
43 ! none
44 
45 ! Output optional arguments :
46 ! -------------------------
47 ! KREQUEST - Communication request
48 ! required when buffering type is non-blocking
49 ! KERROR - return error code. If not supplied,
50 ! MPL_GATHERV aborts when an error is detected.
51 ! Author.
52 ! -------
53 ! D.Dent, M.Hamrud ECMWF
54 
55 ! Modifications.
56 ! --------------
57 ! Original: 2000-11-23
58 ! M.Hamrud : 2014-10-22 : Add nonblocking option
59 ! F. Vana 05-Mar-2015 Support for single precision
60 
61 ! --- *NOT* THREAD SAFE YET ---
62 
63 ! ------------------------------------------------------------------
64 
65 USE parkind1 , ONLY : jprd, jpim, jpib, jprm
66 
67 USE mpl_mpif
68 USE mpl_data_module
69 USE mpl_stats_mod
70 USE yommplstats
71 USE mpl_message_mod
72 USE mpl_send_mod
73 USE mpl_recv_mod
74 USE mpl_myrank_mod
75 
76 IMPLICIT NONE
77 
78 PRIVATE
79 
80 
81 LOGICAL :: llabort=.true.
82 REAL(KIND=JPRD) :: zdum_jprd
83 REAL(KIND=JPRM) :: zdum_jprm
84 INTEGER(KIND=JPIM) :: zdum_int
85 
86 INTERFACE mpl_gatherv
87 MODULE PROCEDURE mpl_gatherv_real8,mpl_gatherv_real4,mpl_gatherv_int,&
88  & mpl_gatherv_int_scalar
89 END INTERFACE
90 
91 PUBLIC mpl_gatherv
92 
93 CONTAINS
94 
95 SUBROUTINE mpl_gatherv_preamb1(IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE, &
96  & KCOMM,KROOT,KMP_TYPE,KREQUEST)
97 
98 
99 #ifdef USE_8_BYTE_WORDS
100  USE mpi4to8, ONLY : &
101  mpi_comm_size => mpi_comm_size8
102 #endif
103 
104 
105 
106 INTEGER(KIND=JPIM),INTENT(OUT) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
107 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
108 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE,KREQUEST
109 INTEGER(KIND=JPIM) :: ITID
110 itid = oml_my_thread()
111 ierror = 0
112 
113 IF(mpl_numproc < 1) CALL mpl_message( &
114  & cdmessage='MPL_GATHERV: MPL NOT INITIALISED ',ldabort=llabort)
115 
116 IF(PRESENT(kcomm)) THEN
117  icomm=kcomm
118 ELSE
119  icomm=mpl_comm_oml(itid)
120 ENDIF
121 
122 IF(icomm == mpl_comm_oml(itid)) THEN
123  ipl_numproc = mpl_numproc
124  ipl_myrank = mpl_rank
125 ELSE
126  CALL mpi_comm_size(icomm,ipl_numproc,ierror)
127  ipl_myrank = mpl_myrank(icomm)
128 ENDIF
129 
130 IF(PRESENT(kroot)) THEN
131  iroot=kroot
132 ELSE
133  iroot=1
134 ENDIF
135 
136 IF(PRESENT(kmp_type)) THEN
137  imp_type=kmp_type
138 ELSE
139  imp_type=mpl_method
140 ENDIF
141 IF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
142  IF(.NOT.PRESENT(krequest)) CALL mpl_message(cdmessage='MPL_GATHERV: KREQUEST MISSING',ldabort=llabort)
143 ENDIF
144 
145 
146 END SUBROUTINE mpl_gatherv_preamb1
147 
148 SUBROUTINE mpl_gatherv_preamb2(IPL_NUMPROC,IPL_MYRANK,IRECVBUFSIZE,ISENDCOUNT,&
149  & KRECVCOUNTS,KIRECVDISPL,KRECVDISPL,CDSTRING)
150 
151 INTEGER(KIND=JPIM),INTENT(IN) :: IPL_NUMPROC,IPL_MYRANK,IRECVBUFSIZE,ISENDCOUNT
152 INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
153 INTEGER(KIND=JPIM),INTENT(OUT) :: KIRECVDISPL(:)
154 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:)
155 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
156 INTEGER(KIND=JPIM) :: IR
157 
158 
159 IF(SIZE(krecvcounts) < ipl_numproc) THEN
160  WRITE(mpl_errunit,*)'MPL_GATHERV: ERROR KRECVCOUNTS DIMENSION=',&
161  & SIZE(krecvcounts)
162  CALL mpl_message(cdmessage=&
163  & 'MPL_GATHERV: ERROR KRECVCOUNTS DIMENSION IS WRONG',ldabort=llabort)
164 ENDIF
165 IF(isendcount /= krecvcounts(ipl_myrank)) THEN
166  WRITE(mpl_errunit,*)'MPL_GATHERV: ERROR KRECVCOUNTS INCONSISTENCY ',&
167  & isendcount,krecvcounts(ipl_myrank)
168  CALL mpl_message(cdmessage=&
169  & 'MPL_GATHERV: ERROR ISENDCOUNT /= KRECVCOUNTS(MPL_RANK) ',ldabort=llabort)
170 ENDIF
171 
172 IF(PRESENT(krecvdispl)) THEN
173  kirecvdispl(1:ipl_numproc) = krecvdispl(1:ipl_numproc)
174 ELSE
175  kirecvdispl(1:ipl_numproc) = 0
176  DO ir=2, ipl_numproc
177  kirecvdispl(ir) = kirecvdispl(ir-1) + krecvcounts(ir-1)
178  ENDDO
179 ENDIF
180 DO ir=1, ipl_numproc
181  IF(kirecvdispl(ir)+krecvcounts(ir) > irecvbufsize) THEN
182  WRITE(mpl_errunit,'(A,4I10)')'MPL_GATHERV:RECV BUFFER TOO SMALL ', &
183  & ir,kirecvdispl(ir),krecvcounts(ir),irecvbufsize
184  CALL mpl_message(cdmessage='MPL_GATHERV',cdstring=cdstring,ldabort=llabort)
185  ENDIF
186 ENDDO
187 
188 END SUBROUTINE mpl_gatherv_preamb2
189 
190 SUBROUTINE mpl_gatherv_real4(PSENDBUF,KROOT,PRECVBUF,KRECVCOUNTS,KRECVDISPL, &
191  & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
192 
193 
194 #ifdef USE_8_BYTE_WORDS
195  USE mpi4to8, ONLY : &
196  mpi_gatherv => mpi_gatherv8
197 #endif
198 
199 
200 
201 REAL(KIND=JPRM),INTENT(IN) :: PSENDBUF(:)
202 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
203 REAL(KIND=JPRM),INTENT(OUT),OPTIONAL :: PRECVBUF(:)
204 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:)
205 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
206 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
207 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
208 
209 INTEGER(KIND=JPIM) :: IRECVDISPL(mpl_numproc)
210 INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
211 INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
212 
213 
214 isendcount = SIZE(psendbuf)
215 #ifndef NAG
216 IF( (loc(psendbuf(ubound(psendbuf,1))) - loc(psendbuf(lbound(psendbuf,1)))) /= 4_jpib*(isendcount - 1) .AND. &
217  & isendcount > 0 ) THEN
218  CALL mpl_message(cdmessage='MPL_GATHERV: SENDBUF NOT CONTIGUOUS ',ldabort=llabort)
219 ENDIF
220 #endif
221 
222 CALL mpl_gatherv_preamb1(ierror,ipl_numproc,ipl_myrank,icomm,iroot,imp_type,kcomm,kroot,kmp_type,krequest)
223 
224 IF(ipl_myrank == iroot) THEN
225  IF( .NOT. PRESENT(precvbuf)) CALL mpl_message(&
226  & cdmessage='MPL_GATHERV:RECVBUF MISSING',cdstring=cdstring,ldabort=llabort)
227 
228  irecvbufsize = SIZE(precvbuf)
229 #ifndef NAG
230  IF( (loc(precvbuf(ubound(precvbuf,1))) - loc(precvbuf(lbound(precvbuf,1)))) /= 4_jpib*(irecvbufsize - 1) .AND. &
231  & irecvbufsize > 0 ) THEN
232  CALL mpl_message(cdmessage='MPL_GATHERV: RECVBUF NOT CONTIGUOUS ',ldabort=llabort)
233  ENDIF
234 #endif
235 
236  CALL mpl_gatherv_preamb2(ipl_numproc,ipl_myrank,irecvbufsize,isendcount,&
237  & krecvcounts,irecvdispl,krecvdispl,cdstring)
238  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
239  CALL mpi_gatherv(psendbuf(1),isendcount,int(mpi_real4),precvbuf(1),krecvcounts, &
240  & irecvdispl,int(mpi_real4),iroot-1,icomm,ierror)
241  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
242  CALL mpi_igatherv(psendbuf(1),isendcount,int(mpi_real4),precvbuf(1),krecvcounts, &
243  & irecvdispl,int(mpi_real4),iroot-1,icomm,krequest,ierror)
244  ENDIF
245  IF(lmplstats) THEN
246  CALL mpl_sendstats(isendcount,int(mpi_real4))
247  CALL mpl_recvstats(sum(krecvcounts),int(mpi_real4))
248  ENDIF
249 ELSE
250  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
251  CALL mpi_gatherv(psendbuf(1),isendcount,int(mpi_real4),zdum_jprm,1, &
252  & 1,int(mpi_real4),iroot-1,icomm,ierror)
253  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
254  CALL mpi_igatherv(psendbuf(1),isendcount,int(mpi_real4),zdum_jprm,1, &
255  & 1,int(mpi_real4),iroot-1,icomm,krequest,ierror)
256  ENDIF
257  IF(lmplstats) THEN
258  CALL mpl_sendstats(isendcount,int(mpi_real4))
259  ENDIF
260 ENDIF
261 
262 IF(PRESENT(kerror)) THEN
263  kerror=ierror
264 ELSE
265  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_GATHERV',&
266  & cdstring,ldabort=llabort)
267 ENDIF
268 
269 END SUBROUTINE mpl_gatherv_real4
270 
271 SUBROUTINE mpl_gatherv_real8(PSENDBUF,KROOT,PRECVBUF,KRECVCOUNTS,KRECVDISPL, &
272  & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
273 
274 
275 #ifdef USE_8_BYTE_WORDS
276  USE mpi4to8, ONLY : &
277  mpi_gatherv => mpi_gatherv8
278 #endif
279 
280 
281 
282 REAL(KIND=JPRD) :: PSENDBUF(:)
283 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:)
284 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
285 REAL(KIND=JPRD),OPTIONAL :: PRECVBUF(:)
286 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
287 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
288 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
289 
290 INTEGER(KIND=JPIM) :: IRECVDISPL(mpl_numproc)
291 INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
292 INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
293 INTEGER(KIND=JPIM) :: IDUM,IST,IEND,JK
294 
295 
296 isendcount = SIZE(psendbuf)
297 #ifndef NAG
298 IF( (loc(psendbuf(ubound(psendbuf,1))) - loc(psendbuf(lbound(psendbuf,1)))) /= 8_jpib*(isendcount - 1) .AND. &
299  & isendcount > 0 ) THEN
300  CALL mpl_message(cdmessage='MPL_GATHERV: SENDBUF NOT CONTIGUOUS ',ldabort=llabort)
301 ENDIF
302 #endif
303 
304 CALL mpl_gatherv_preamb1(ierror,ipl_numproc,ipl_myrank,icomm,iroot,imp_type,kcomm,kroot,kmp_type,krequest)
305 
306 IF(ipl_myrank == iroot) THEN
307  IF( .NOT. PRESENT(precvbuf)) CALL mpl_message(&
308  & cdmessage='MPL_GATHERV:RECVBUF MISSING',cdstring=cdstring,ldabort=llabort)
309  irecvbufsize = SIZE(precvbuf)
310 #ifndef NAG
311  IF( (loc(precvbuf(ubound(precvbuf,1))) - loc(precvbuf(lbound(precvbuf,1)))) /= 8_jpib*(irecvbufsize - 1) .AND. &
312  & irecvbufsize > 0 ) THEN
313  CALL mpl_message(cdmessage='MPL_GATHERV: RECVBUF NOT CONTIGUOUS ',ldabort=llabort)
314  ENDIF
315 #endif
316  CALL mpl_gatherv_preamb2(ipl_numproc,ipl_myrank,irecvbufsize,isendcount,&
317  & krecvcounts,irecvdispl,krecvdispl,cdstring)
318 
319  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
320  CALL mpi_gatherv(psendbuf(1),isendcount,int(mpi_real8),precvbuf(1),krecvcounts,&
321  & irecvdispl,int(mpi_real8),iroot-1,icomm,ierror)
322  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
323  CALL mpi_igatherv(psendbuf(1),isendcount,int(mpi_real8),precvbuf(1),krecvcounts,&
324  & irecvdispl,int(mpi_real8),iroot-1,icomm,krequest,ierror)
325  ENDIF
326  IF(lmplstats) THEN
327  CALL mpl_sendstats(isendcount,int(mpi_real8))
328  CALL mpl_recvstats(sum(krecvcounts),int(mpi_real8))
329  ENDIF
330 ELSE
331  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
332  CALL mpi_gatherv(psendbuf(1),isendcount,int(mpi_real8),zdum_jprd,1, &
333  & 1,int(mpi_real8),iroot-1,icomm,ierror)
334  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
335  CALL mpi_igatherv(psendbuf(1),isendcount,int(mpi_real8),zdum_jprd,1, &
336  & 1,int(mpi_real8),iroot-1,icomm,krequest,ierror)
337  ENDIF
338  IF(lmplstats) THEN
339  CALL mpl_sendstats(isendcount,int(mpi_real8))
340  ENDIF
341 ENDIF
342 
343 IF(PRESENT(kerror)) THEN
344  kerror=ierror
345 ELSE
346  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_GATHERV',cdstring,&
347  & ldabort=llabort)
348 ENDIF
349 
350 END SUBROUTINE mpl_gatherv_real8
351 
352 SUBROUTINE mpl_gatherv_int(KSENDBUF,KROOT,KRECVBUF,KRECVCOUNTS,KRECVDISPL, &
353  & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
354 
355 
356 #ifdef USE_8_BYTE_WORDS
357  USE mpi4to8, ONLY : &
358  mpi_gatherv => mpi_gatherv8
359 #endif
360 
361 
362 
363 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
364 INTEGER(KIND=JPIM),INTENT(IN) :: KSENDBUF(:)
365 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KRECVBUF(:)
366 INTEGER(KIND=JPIM),INTENT(IN) :: KRECVCOUNTS(:)
367 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
368 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
369 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
370 
371 INTEGER(KIND=JPIM) :: IRECVDISPL(mpl_numproc)
372 INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
373 INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
374 
375 isendcount = SIZE(ksendbuf)
376 #ifndef NAG
377 IF( (loc(ksendbuf(ubound(ksendbuf,1))) - loc(ksendbuf(lbound(ksendbuf,1)))) /= 4_jpib*(isendcount - 1) .AND. &
378  & isendcount > 0 ) THEN
379  CALL mpl_message(cdmessage='MPL_GATHERV: SENDBUF NOT CONTIGUOUS ',ldabort=llabort)
380 ENDIF
381 #endif
382 
383 CALL mpl_gatherv_preamb1(ierror,ipl_numproc,ipl_myrank,icomm,iroot,imp_type,kcomm,kroot,kmp_type,krequest)
384 
385 IF(ipl_myrank == iroot) THEN
386  IF( .NOT. PRESENT(krecvbuf)) CALL mpl_message(&
387  & cdmessage='MPL_GATHERV:RECVBUF MISSING',cdstring=cdstring,ldabort=llabort)
388 
389  irecvbufsize = SIZE(krecvbuf)
390 #ifndef NAG
391  IF( (loc(krecvbuf(ubound(krecvbuf,1))) - loc(krecvbuf(lbound(krecvbuf,1)))) /= 4_jpib*(irecvbufsize - 1) .AND. &
392  & irecvbufsize > 0 ) THEN
393  CALL mpl_message(cdmessage='MPL_GATHERV: RECVBUF NOT CONTIGUOUS ',ldabort=llabort)
394  ENDIF
395 #endif
396 
397  CALL mpl_gatherv_preamb2(ipl_numproc,ipl_myrank,irecvbufsize,isendcount,&
398  & krecvcounts,irecvdispl,krecvdispl,cdstring)
399  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
400  CALL mpi_gatherv(ksendbuf(1),isendcount,int(mpi_integer),krecvbuf(1),&
401  & krecvcounts,irecvdispl,int(mpi_integer),iroot-1,icomm,ierror)
402  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
403  CALL mpi_igatherv(ksendbuf(1),isendcount,int(mpi_integer),krecvbuf(1),&
404  & krecvcounts,irecvdispl,int(mpi_integer),iroot-1,icomm,krequest,ierror)
405  ENDIF
406  IF(lmplstats) THEN
407  CALL mpl_sendstats(isendcount,int(mpi_integer))
408  CALL mpl_recvstats(sum(krecvcounts),int(mpi_integer))
409  ENDIF
410 ELSE
411  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
412  CALL mpi_gatherv(ksendbuf(1),isendcount,int(mpi_integer),zdum_int,1, &
413  & 1,int(mpi_integer),iroot-1,icomm,ierror)
414  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
415  CALL mpi_igatherv(ksendbuf(1),isendcount,int(mpi_integer),zdum_int,1, &
416  & 1,int(mpi_integer),iroot-1,icomm,krequest,ierror)
417  ENDIF
418  IF(lmplstats) THEN
419  CALL mpl_sendstats(isendcount,int(mpi_integer))
420  ENDIF
421 ENDIF
422 
423 IF(PRESENT(kerror)) THEN
424  kerror=ierror
425 ELSE
426  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_GATHERV',cdstring,ldabort=llabort)
427 ENDIF
428 
429 END SUBROUTINE mpl_gatherv_int
430 
431 SUBROUTINE mpl_gatherv_int_scalar(KSENDBUF,KROOT,KRECVBUF,KRECVCOUNTS,&
432  & KMP_TYPE,KRECVDISPL,KCOMM,KERROR,KREQUEST,CDSTRING)
433 
434 
435 #ifdef USE_8_BYTE_WORDS
436  USE mpi4to8, ONLY : &
437  mpi_gatherv => mpi_gatherv8, mpi_gather => mpi_gather8
438 #endif
439 
440 
441 
442 INTEGER(KIND=JPIM),INTENT(IN) :: KSENDBUF
443 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
444 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KRECVBUF(:)
445 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:) ! Not used; for compatibility only
446 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
447 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
448 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
449 
450 INTEGER(KIND=JPIM) :: IRECVDISPL(mpl_numproc),IRECVCOUNTS(mpl_numproc)
451 INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
452 INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
453 
454 isendcount = 1
455 CALL mpl_gatherv_preamb1(ierror,ipl_numproc,ipl_myrank,icomm,iroot,imp_type,kcomm,kroot,kmp_type,krequest)
456 
457 IF(ipl_myrank == iroot) THEN
458  IF( .NOT. PRESENT(krecvbuf)) CALL mpl_message(&
459  & cdmessage='MPL_GATHERV:RECVBUF MISSING',cdstring=cdstring,ldabort=llabort)
460  irecvbufsize = SIZE(krecvbuf)
461  IF(PRESENT(krecvdispl)) THEN
462  irecvcounts(:) = 1
463  CALL mpl_gatherv_preamb2(ipl_numproc,ipl_myrank,irecvbufsize,isendcount,&
464  & irecvcounts,irecvdispl,krecvdispl,cdstring)
465  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
466  CALL mpi_gatherv(ksendbuf,isendcount,int(mpi_integer),krecvbuf(1),&
467  & irecvcounts,irecvdispl,int(mpi_integer),iroot-1,icomm,ierror)
468  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
469  CALL mpi_igatherv(ksendbuf,isendcount,int(mpi_integer),krecvbuf(1),&
470  & irecvcounts,irecvdispl,int(mpi_integer),iroot-1,icomm,krequest,ierror)
471  ENDIF
472  IF(lmplstats) THEN
473  CALL mpl_sendstats(isendcount,int(mpi_integer))
474  CALL mpl_recvstats(sum(irecvcounts),int(mpi_integer))
475  ENDIF
476  ELSE
477  IF(irecvbufsize < ipl_numproc) THEN
478  CALL mpl_message(cdmessage='MPL_GATHERV:IRECVBUFSIZE < IPL_NUMPROC',&
479  & cdstring=cdstring,ldabort=llabort)
480  ENDIF
481  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
482  CALL mpi_gather(ksendbuf,isendcount,int(mpi_integer),krecvbuf(1),&
483  & isendcount,int(mpi_integer),iroot-1,icomm,ierror)
484  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
485  CALL mpi_igather(ksendbuf,isendcount,int(mpi_integer),krecvbuf(1),&
486  & isendcount,int(mpi_integer),iroot-1,icomm,krequest,ierror)
487  ENDIF
488  IF(lmplstats) THEN
489  CALL mpl_sendstats(isendcount,int(mpi_integer))
490  CALL mpl_recvstats(isendcount,int(mpi_integer))
491  ENDIF
492  ENDIF
493 ELSE
494  IF(PRESENT(krecvdispl)) THEN
495  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
496  CALL mpi_gatherv(ksendbuf,isendcount,int(mpi_integer),zdum_int,1, &
497  & 1,int(mpi_integer),iroot-1,icomm,ierror)
498  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
499  CALL mpi_igatherv(ksendbuf,isendcount,int(mpi_integer),zdum_int,1, &
500  & 1,int(mpi_integer),iroot-1,icomm,krequest,ierror)
501  ENDIF
502  IF(lmplstats) THEN
503  CALL mpl_sendstats(isendcount,int(mpi_integer))
504  ENDIF
505  ELSE
506  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
507  CALL mpi_gather(ksendbuf,isendcount,int(mpi_integer),zdum_int,&
508  & 1,int(mpi_integer),iroot-1,icomm,ierror)
509  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
510  CALL mpi_igather(ksendbuf,isendcount,int(mpi_integer),zdum_int,&
511  & 1,int(mpi_integer),iroot-1,icomm,krequest,ierror)
512  ENDIF
513  IF(lmplstats) THEN
514  CALL mpl_sendstats(isendcount,int(mpi_integer))
515  ENDIF
516  ENDIF
517 ENDIF
518 
519 IF(PRESENT(kerror)) THEN
520  kerror=ierror
521 ELSE
522  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_GATHERV',cdstring,ldabort=llabort)
523 ENDIF
524 
525 END SUBROUTINE mpl_gatherv_int_scalar
526 
527 SUBROUTINE mpl_gatherv_real8_scalar(PSENDBUF,KROOT,PRECVBUF,KRECVCOUNTS,&
528  & KRECVDISPL,KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
529 
530 
531 #ifdef USE_8_BYTE_WORDS
532  USE mpi4to8, ONLY : &
533  mpi_gatherv => mpi_gatherv8, mpi_gather => mpi_gather8
534 #endif
535 
536 
537 
538 REAL(KIND=JPRD),INTENT(IN) :: PSENDBUF
539 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
540 REAL(KIND=JPRD),INTENT(OUT),OPTIONAL :: PRECVBUF(:)
541 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:) ! Not used; for compatibility only
542 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE
543 INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
544 CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
545 
546 INTEGER(KIND=JPIM) :: IRECVDISPL(mpl_numproc),IRECVCOUNTS(mpl_numproc)
547 INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
548 INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
549 
550 isendcount = 1
551 CALL mpl_gatherv_preamb1(ierror,ipl_numproc,ipl_myrank,icomm,iroot,imp_type,kcomm,kroot,kmp_type,krequest)
552 
553 IF(ipl_myrank == iroot) THEN
554  IF( .NOT. PRESENT(precvbuf)) CALL mpl_message(&
555  & cdmessage='MPL_GATHERV:RECVBUF MISSING',cdstring=cdstring,ldabort=llabort)
556  irecvbufsize = SIZE(precvbuf)
557  IF(PRESENT(krecvdispl)) THEN
558  irecvcounts(:) = 1
559  CALL mpl_gatherv_preamb2(ipl_numproc,ipl_myrank,irecvbufsize,isendcount,&
560  & irecvcounts,irecvdispl,krecvdispl,cdstring)
561  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
562  CALL mpi_gatherv(psendbuf,isendcount,int(mpi_real8),precvbuf(1),&
563  & irecvcounts,irecvdispl,int(mpi_real8),iroot-1,icomm,ierror)
564  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
565  CALL mpi_igatherv(psendbuf,isendcount,int(mpi_real8),precvbuf(1),&
566  & irecvcounts,irecvdispl,int(mpi_real8),iroot-1,icomm,krequest,ierror)
567  ENDIF
568  IF(lmplstats) THEN
569  CALL mpl_sendstats(isendcount,int(mpi_real8))
570  CALL mpl_recvstats(sum(irecvcounts),int(mpi_real8))
571  ENDIF
572  ELSE
573  IF(irecvbufsize < ipl_numproc) THEN
574  CALL mpl_message(cdmessage='MPL_GATHERV:IRECVBUFSIZE < IPL_NUMPROC',&
575  & cdstring=cdstring,ldabort=llabort)
576  ENDIF
577  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
578  CALL mpi_gather(psendbuf,isendcount,int(mpi_real8),precvbuf(1),&
579  & isendcount,int(mpi_real8),iroot-1,icomm,ierror)
580  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
581  CALL mpi_igather(psendbuf,isendcount,int(mpi_real8),precvbuf(1),&
582  & isendcount,int(mpi_real8),iroot-1,icomm,krequest,ierror)
583  ENDIF
584  IF(lmplstats) THEN
585  CALL mpl_sendstats(isendcount,int(mpi_real8))
586  CALL mpl_recvstats(isendcount,int(mpi_real8))
587  ENDIF
588  ENDIF
589 ELSE
590  IF(PRESENT(krecvdispl)) THEN
591  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
592  CALL mpi_gatherv(psendbuf,isendcount,int(mpi_real8),zdum_jprd,1, &
593  & 1,int(mpi_real8),iroot-1,icomm,ierror)
594  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
595  CALL mpi_igatherv(psendbuf,isendcount,int(mpi_real8),zdum_jprd,1, &
596  & 1,int(mpi_real8),iroot-1,icomm,krequest,ierror)
597  ENDIF
598  IF(lmplstats) THEN
599  CALL mpl_sendstats(isendcount,int(mpi_real8))
600  ENDIF
601  ELSE
602  IF(imp_type == jp_blocking_standard .OR. imp_type == jp_blocking_buffered) THEN
603  CALL mpi_gather(psendbuf,isendcount,int(mpi_real8),zdum_jprd,&
604  & 1,int(mpi_real8),iroot-1,icomm,ierror)
605  ELSEIF(imp_type == jp_non_blocking_standard .OR. imp_type == jp_non_blocking_buffered) THEN
606  CALL mpi_igather(psendbuf,isendcount,int(mpi_real8),zdum_jprd,&
607  & 1,int(mpi_real8),iroot-1,icomm,krequest,ierror)
608  ENDIF
609  IF(lmplstats) THEN
610  CALL mpl_sendstats(isendcount,int(mpi_real8))
611  ENDIF
612  ENDIF
613 ENDIF
614 
615 IF(PRESENT(kerror)) THEN
616  kerror=ierror
617 ELSE
618  IF(ierror /= 0 ) CALL mpl_message(ierror,'MPL_GATHERV',cdstring,ldabort=llabort)
619 ENDIF
620 
621 END SUBROUTINE mpl_gatherv_real8_scalar
622 
623 END MODULE mpl_gatherv_mod
624 
625 
mpl_send_mod
Definition: mpl_send_mod.F90:4
mpl_message_mod::mpl_message
subroutine, public mpl_message(KERROR, CDMESSAGE, CDSTRING, LDABORT)
Definition: mpl_message_mod.F90:54
mpl_gatherv_mod::llabort
logical llabort
Definition: mpl_gatherv_mod.F90:81
mpl_gatherv_mod::mpl_gatherv
Definition: mpl_gatherv_mod.F90:86
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_gatherv_mod::zdum_int
integer(kind=jpim) zdum_int
Definition: mpl_gatherv_mod.F90:84
parkind1::jprd
integer, parameter jprd
Definition: parkind1.F90:39
mpl_gatherv_mod::mpl_gatherv_real8_scalar
subroutine mpl_gatherv_real8_scalar(PSENDBUF, KROOT, PRECVBUF, KRECVCOUNTS, KRECVDISPL, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_gatherv_mod.F90:529
mpl_stats_mod::mpl_recvstats
subroutine, public mpl_recvstats(ICOUNT, ITYPE)
Definition: mpl_stats_mod.F90:271
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
yommplstats::lmplstats
logical lmplstats
Definition: yommplstats.F90:17
mpl_gatherv_mod::mpl_gatherv_preamb2
subroutine mpl_gatherv_preamb2(IPL_NUMPROC, IPL_MYRANK, IRECVBUFSIZE, ISENDCOUNT, KRECVCOUNTS, KIRECVDISPL, KRECVDISPL, CDSTRING)
Definition: mpl_gatherv_mod.F90:150
mpl_message_mod
Definition: mpl_message_mod.F90:1
mpl_gatherv_mod::mpl_gatherv_int_scalar
subroutine mpl_gatherv_int_scalar(KSENDBUF, KROOT, KRECVBUF, KRECVCOUNTS, KMP_TYPE, KRECVDISPL, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_gatherv_mod.F90:433
mpl_data_module::jp_non_blocking_standard
integer(kind=jpim), parameter jp_non_blocking_standard
Definition: mpl_data_module.F90:64
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_gatherv_mod::zdum_jprd
real(kind=jprd) zdum_jprd
Definition: mpl_gatherv_mod.F90:82
mpl_gatherv_mod::mpl_gatherv_real8
subroutine mpl_gatherv_real8(PSENDBUF, KROOT, PRECVBUF, KRECVCOUNTS, KRECVDISPL, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_gatherv_mod.F90:273
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_gatherv_mod::mpl_gatherv_preamb1
subroutine mpl_gatherv_preamb1(IERROR, IPL_NUMPROC, IPL_MYRANK, ICOMM, IROOT, IMP_TYPE, KCOMM, KROOT, KMP_TYPE, KREQUEST)
Definition: mpl_gatherv_mod.F90:97
mpl_data_module::jp_non_blocking_buffered
integer(kind=jpim), parameter jp_non_blocking_buffered
Definition: mpl_data_module.F90:65
mpl_gatherv_mod::zdum_jprm
real(kind=jprm) zdum_jprm
Definition: mpl_gatherv_mod.F90:83
mpl_data_module::mpl_errunit
integer(kind=jpim) mpl_errunit
Definition: mpl_data_module.F90:40
parkind1::jprm
integer, parameter jprm
Definition: parkind1.F90:30
sum
intent(out) overrides sub arrays one Sort by the least significant key first sum(iindex(1:n))
mpl_myrank_mod::mpl_myrank
integer(kind=jpim) function, public mpl_myrank(KCOMM)
Definition: mpl_myrank_mod.F90:54
mpl_data_module::mpl_rank
integer(kind=jpim) mpl_rank
Definition: mpl_data_module.F90:40
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_gatherv_mod::mpl_gatherv_int
subroutine mpl_gatherv_int(KSENDBUF, KROOT, KRECVBUF, KRECVCOUNTS, KRECVDISPL, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_gatherv_mod.F90:354
mpl_recv_mod
Definition: mpl_recv_mod.F90:5
parkind1::jpib
integer, parameter jpib
Definition: parkind1.F90:14
mpl_gatherv_mod::mpl_gatherv_real4
subroutine mpl_gatherv_real4(PSENDBUF, KROOT, PRECVBUF, KRECVCOUNTS, KRECVDISPL, KMP_TYPE, KCOMM, KERROR, KREQUEST, CDSTRING)
Definition: mpl_gatherv_mod.F90:192
mpl_gatherv_mod
Definition: mpl_gatherv_mod.F90:4
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13