1!{\src2tex{textfont=tt}} 2!!****f* ABINIT/xmpi_gatherv 3!! NAME 4!! xmpi_gatherv 5!! 6!! FUNCTION 7!! This module contains functions that calls MPI routine, 8!! if we compile the code using the MPI CPP flags. 9!! xmpi_gatherv is the generic function. 10!! 11!! COPYRIGHT 12!! Copyright (C) 2001-2016 ABINIT group (MT,GG) 13!! This file is distributed under the terms of the 14!! GNU General Public License, see ~ABINIT/COPYING 15!! or http://www.gnu.org/copyleft/gpl.txt . 16!! 17!! SOURCE 18 19!!*** 20 21!!****f* ABINIT/xmpi_gatherv_int 22!! NAME 23!! xmpi_gatherv_int 24!! 25!! FUNCTION 26!! Gathers data from all tasks and delivers it to all. 27!! Target: one-dimensional integer arrays. 28!! 29!! INPUTS 30!! xval= buffer array 31!! recvcounts= number of received elements 32!! displs= relative offsets for incoming data 33!! nelem= number of elements 34!! root= rank of receiving process 35!! spaceComm= MPI communicator 36!! 37!! OUTPUT 38!! ier= exit status, a non-zero value meaning there is an error 39!! 40!! SIDE EFFECTS 41!! recvbuf= received buffer 42!! 43!! SOURCE 44subroutine xmpi_gatherv_int(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 45 46 47!This section has been created automatically by the script Abilint (TD). 48!Do not modify the following lines by hand. 49#undef ABI_FUNC 50#define ABI_FUNC 'xmpi_gatherv_int' 51!End of the abilint section 52 53 implicit none 54 55!Arguments------------------------- 56 integer, DEV_CONTARRD intent(in) :: xval(:) 57 integer, DEV_CONTARRD intent(inout) :: recvbuf(:) 58 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 59 integer,intent(in) :: nelem,root,spaceComm 60 integer,intent(out) :: ier 61 62!Local variables------------------- 63 integer :: cc,dd 64 65! ************************************************************************* 66 67 ier=0 68#if defined HAVE_MPI 69 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 70 call MPI_gatherV(xval,nelem,MPI_INTEGER,recvbuf,recvcounts,displs,& 71& MPI_INTEGER,root,spaceComm,ier) 72 else if (spaceComm == MPI_COMM_SELF) then 73#endif 74 dd=0;if (size(displs)>0) dd=displs(1) 75 cc=size(xval);if (size(recvcounts)>0) cc=recvcounts(1) 76 recvbuf(dd+1:dd+cc)=xval(1:cc) 77#if defined HAVE_MPI 78 end if 79#endif 80 81end subroutine xmpi_gatherv_int 82!!*** 83 84!!****f* ABINIT/xmpi_gatherv_int1_dp1 85!! NAME 86!! xmpi_gatherv_int1_dp1 87!! 88!! FUNCTION 89!! Gathers data from all tasks and delivers it to all. 90!! Target : one-dimensional integer arrray and one-dimensionnal dp array 91!! 92!! INPUTS 93!! buf_int=buffer integer array that is going to be gathered 94!! buf_int_size=size of buf_int array 95!! buf_dp=buffer dp array that is going to be gathered 96!! buf_dp_size=size of buf_dp array 97!! spaceComm=MPI communicator to be gathered on it 98!! root=rank of receiving process 99!! spaceComm=MPI communicator 100!! 101!! OUTPUT 102!! buf_int_all=buffer integer array gathered 103!! buf_int_size_all=size of buffer integer array gathered 104!! buf_dp_all=buffer dp array gathered 105!! buf_dp_size_all=size of buffer dp array gathered 106!! ier=exit status, a non-zero value meaning there is an error 107!! 108!! SOURCE 109 110subroutine xmpi_gatherv_int1_dp1(buf_int,buf_int_size,buf_dp,buf_dp_size, & 111& buf_int_all,buf_int_size_all,buf_dp_all,buf_dp_size_all,root,& 112& spaceComm,ier) 113 114 115!This section has been created automatically by the script Abilint (TD). 116!Do not modify the following lines by hand. 117#undef ABI_FUNC 118#define ABI_FUNC 'xmpi_gatherv_int1_dp1' 119!End of the abilint section 120 121 implicit none 122 123!Arguments------------------------- 124!scalars 125 integer,intent(in) :: buf_int_size,buf_dp_size,root,spaceComm 126 integer,intent(out) :: buf_int_size_all,buf_dp_size_all,ier 127!arrays 128 integer,intent(in) :: buf_int(:) 129 integer,allocatable,target,intent(out) :: buf_int_all(:) 130 real(dp),intent(in) :: buf_dp(:) 131 real(dp),allocatable,target, intent(out) :: buf_dp_all(:) 132 133!Local variables-------------- 134!scalars 135 integer :: buf_pack_size,ierr,ii,iproc,istart_dp,istart_int 136 integer :: lg,lg1,lg2,lg_int,lg_dp,me,n1,nproc,position 137 integer :: totalbufcount 138 logical,parameter :: use_pack=.false. 139!arrays 140 integer :: buf_size(2),pos(3) 141 integer,allocatable :: buf_dp_size1(:),buf_int_size1(:) 142 integer,allocatable :: count_dp(:),count_int(:),count_size(:),counts(:) 143 integer,allocatable :: disp_dp(:),disp_int(:),displ(:),displ_dp(:),displ_int(:) 144 integer,allocatable :: pos_all(:) 145 integer,pointer:: outbuf_int(:) 146 real(dp ) :: tsec(2) 147 real(dp),pointer :: outbuf_dp(:) 148 character,allocatable :: buf_pack(:),buf_pack_tot(:) 149 150! ************************************************************************* 151 152 ier=0 153 154#if defined HAVE_MPI 155 if (spaceComm/=MPI_COMM_SELF.and.spaceComm/=MPI_COMM_NULL) then 156 157 nproc=xmpi_comm_size(spaceComm) 158 159!First version: using 2 allgather (one for ints, another for reals) 160!------------------------------------------------------------------ 161 if (.not.use_pack) then 162 163! Prepare communications 164 ABI_ALLOCATE(count_int,(nproc)) 165 ABI_ALLOCATE(disp_int,(nproc)) 166 ABI_ALLOCATE(count_dp,(nproc)) 167 ABI_ALLOCATE(disp_dp,(nproc)) 168 ABI_ALLOCATE(count_size,(2*nproc)) 169 buf_size(1)=buf_int_size;buf_size(2)=buf_dp_size 170 call xmpi_allgather(buf_size,2, count_size,spaceComm,ier) 171 do iproc=1,nproc 172 count_int(iproc)=count_size(2*iproc-1) 173 count_dp(iproc)=count_size(2*iproc) 174 end do 175 disp_int(1)=0;disp_dp(1)=0 176 do ii=2,nproc 177 disp_int(ii)=disp_int(ii-1)+count_int(ii-1) 178 disp_dp (ii)=disp_dp (ii-1)+count_dp (ii-1) 179 end do 180 buf_int_size_all=sum(count_int) 181 buf_dp_size_all =sum(count_dp) 182 ABI_STAT_ALLOCATE(buf_int_all,(buf_int_size_all), ier) 183 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 184 ABI_STAT_ALLOCATE(buf_dp_all ,(buf_dp_size_all), ier) 185 if (ier/= 0) call xmpi_abort(msg='error allocating buf_dp_all in xmpi_gatherv') 186 187! Communicate (one call for integers, one call for reals) 188 call xmpi_gatherv(buf_int,buf_int_size,buf_int_all,count_int,disp_int,root,spaceComm,ierr) 189 call xmpi_gatherv(buf_dp,buf_dp_size,buf_dp_all,count_dp,disp_dp,root,spaceComm,ierr) 190 191! Release the memory 192 ABI_DEALLOCATE(count_int) 193 ABI_DEALLOCATE(disp_int) 194 ABI_DEALLOCATE(count_dp) 195 ABI_DEALLOCATE(disp_dp) 196 ABI_DEALLOCATE(count_size) 197 198!2nd version: using 1 allgather (with MPI_PACK) 199!----------------------------------------------------------------- 200 else 201 202 me=xmpi_comm_rank(spaceComm) 203 204! Compute size of message 205 call MPI_PACK_SIZE(buf_int_size,MPI_INTEGER,spaceComm,lg1,ier) 206 call MPI_PACK_SIZE(buf_dp_size,MPI_DOUBLE_PRECISION,spaceComm,lg2,ier) 207 lg=lg1+lg2 208 209! Pack data to be sent 210 position=0;buf_pack_size=lg1+lg2 211 ABI_STAT_ALLOCATE(buf_pack,(buf_pack_size), ier) 212 if (ier/= 0) call xmpi_abort(msg='error allocating buf_pack xmpi_gatherv') 213 call MPI_PACK(buf_int,buf_int_size,MPI_INTEGER,buf_pack,buf_pack_size,position,spaceComm,ier) 214 call MPI_PACK(buf_dp,buf_dp_size,MPI_DOUBLE_PRECISION,buf_pack,buf_pack_size,position,spaceComm,ier) 215 216! Gather size of all packed messages 217 ABI_ALLOCATE(pos_all,(nproc*3)) 218 ABI_ALLOCATE(counts,(nproc)) 219 ABI_ALLOCATE(buf_int_size1,(nproc)) 220 ABI_ALLOCATE(buf_dp_size1,(nproc)) 221 ABI_ALLOCATE(displ,(nproc)) 222 ABI_ALLOCATE(displ_int,(nproc)) 223 ABI_ALLOCATE(displ_dp,(nproc)) 224 pos(1)=position;pos(2)=buf_int_size;pos(3)=buf_dp_size 225 call MPI_ALLGATHER(pos,3,MPI_INTEGER,pos_all,3,MPI_INTEGER,spaceComm,ier) 226 ii=1 227 do iproc=1,nproc 228 counts(iproc)=pos_all(ii);ii=ii+1 229 buf_int_size1(iproc)=pos_all(ii);ii=ii+1 230 buf_dp_size1(iproc)=pos_all(ii);ii=ii+1 231 end do 232 233 displ(1)=0 ; displ_int(1)=0 ; displ_dp(1)=0 234 do iproc=2,nproc 235 displ(iproc)=displ(iproc-1)+counts(iproc-1) 236 displ_int(iproc)=displ_int(iproc-1)+buf_int_size1(iproc-1) 237 displ_dp(iproc)=displ_dp(iproc-1)+buf_dp_size1(iproc-1) 238 end do 239 240 totalbufcount=displ(nproc)+counts(nproc) 241 ABI_STAT_ALLOCATE(buf_pack_tot,(totalbufcount), ier) 242 if (ier/= 0) call xmpi_abort(msg='error allocating buf_pack_tot in xmpi_gatherv') 243 buf_int_size_all=sum(buf_int_size1) 244 buf_dp_size_all=sum(buf_dp_size1) 245 246 if (me==root) then 247 ABI_STAT_ALLOCATE(buf_int_all,(buf_int_size_all), ier) 248 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 249 ABI_STAT_ALLOCATE(buf_dp_all,(buf_dp_size_all), ier) 250 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 251 else 252 ABI_STAT_ALLOCATE(buf_int_all,(1), ier) 253 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 254 ABI_STAT_ALLOCATE(buf_dp_all,(1), ier) 255 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 256 end if 257 258! Gather all packed messages 259 call MPI_GATHERV(buf_pack,position,MPI_PACKED,buf_pack_tot,counts,displ,MPI_PACKED,root,spaceComm,ier) 260 if (me==root) then 261 position=0 262 do iproc=1,nproc 263 lg_int=buf_int_size1(iproc); lg_dp=buf_dp_size1(iproc) 264 istart_int=displ_int(iproc); istart_dp=displ_dp(iproc) 265 outbuf_int=>buf_int_all(istart_int+1:istart_int+lg_int) 266 call MPI_UNPACK(buf_pack_tot,totalbufcount,position, outbuf_int, & 267& lg_int, MPI_INTEGER,spaceComm,ier) 268 outbuf_dp=>buf_dp_all(istart_dp+1:istart_dp+lg_dp) 269 call MPI_UNPACK(buf_pack_tot,totalbufcount,position,outbuf_dp, & 270& lg_dp, MPI_DOUBLE_PRECISION,spaceComm,ier) 271 end do 272 end if 273 274! Release the memory 275 ABI_DEALLOCATE(pos_all) 276 ABI_DEALLOCATE(counts) 277 ABI_DEALLOCATE(buf_int_size1) 278 ABI_DEALLOCATE(buf_dp_size1) 279 ABI_DEALLOCATE(displ) 280 ABI_DEALLOCATE(displ_int) 281 ABI_DEALLOCATE(displ_dp) 282 ABI_DEALLOCATE(buf_pack_tot) 283 ABI_DEALLOCATE(buf_pack) 284 285 end if 286 else if (spaceComm == MPI_COMM_SELF) then 287#endif 288 289!Sequential version 290 ABI_STAT_ALLOCATE(buf_int_all,(buf_int_size), ier) 291 if (ier/= 0) call xmpi_abort(msg='error allocating buf_int_all in xmpi_gatherv') 292 ABI_STAT_ALLOCATE(buf_dp_all,(buf_dp_size), ier) 293 if (ier/= 0) call xmpi_abort(msg='error allocating buf_dp_all in xmpi_gatherv') 294 buf_int_all(:)=buf_int(:) 295 buf_dp_all(:)=buf_dp(:) 296 buf_int_size_all=buf_int_size 297 buf_dp_size_all=buf_dp_size 298 299#if defined HAVE_MPI 300 end if 301#endif 302 303end subroutine xmpi_gatherv_int1_dp1 304!!*** 305 306!!****f* ABINIT/xmpi_gatherv_int2d 307!! NAME 308!! xmpi_gatherv_int2d 309!! 310!! FUNCTION 311!! This module contains functions that calls MPI routine, 312!! if we compile the code using the MPI CPP flags. 313!! xmpi_gatherv is the generic function. 314!! 315!! INPUTS 316!! xval= buffer array 317!! recvcounts= number of received elements 318!! displs= relative offsets for incoming data 319!! nelem= number of elements 320!! root= rank of receiving process 321!! spaceComm= MPI communicator 322!! 323!! OUTPUT 324!! ier= exit status, a non-zero value meaning there is an error 325!! 326!! SIDE EFFECTS 327!! recvbuf= received buffer 328!! 329!! SOURCE 330 331subroutine xmpi_gatherv_int2d(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 332 333 334!This section has been created automatically by the script Abilint (TD). 335!Do not modify the following lines by hand. 336#undef ABI_FUNC 337#define ABI_FUNC 'xmpi_gatherv_int2d' 338!End of the abilint section 339 340 implicit none 341 342!Arguments------------------------- 343 integer, DEV_CONTARRD intent(in) :: xval(:,:) 344 integer, DEV_CONTARRD intent(inout) :: recvbuf(:,:) 345 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 346 integer,intent(in) :: nelem,root,spaceComm 347 integer,intent(out) :: ier 348 349!Local variables-------------- 350 integer :: cc,dd,sz1 351 352! ************************************************************************* 353 354 ier=0 355#if defined HAVE_MPI 356 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 357 call MPI_gatherV(xval,nelem,MPI_INTEGER,recvbuf,recvcounts,displs,& 358& MPI_INTEGER,root,spaceComm,ier) 359 else if (spaceComm == MPI_COMM_SELF) then 360#endif 361 sz1=size(xval,1) 362 dd=0;if (size(displs)>0) dd=displs(1)/sz1 363 cc=size(xval,2);if (size(recvcounts)>0) cc=recvcounts(1)/sz1 364 recvbuf(:,dd+1:dd+cc)=xval(:,1:cc) 365#if defined HAVE_MPI 366 end if 367#endif 368 369end subroutine xmpi_gatherv_int2d 370!!*** 371 372!!****f* ABINIT/xmpi_gatherv_dp 373!! NAME 374!! xmpi_gatherv_dp 375!! 376!! FUNCTION 377!! Gathers data from all tasks and delivers it to all. 378!! Target: one-dimensional double precision arrays. 379!! 380!! INPUTS 381!! xval= buffer array 382!! recvcounts= number of received elements 383!! displs= relative offsets for incoming data 384!! nelem= number of elements 385!! root= rank of receiving process 386!! spaceComm= MPI communicator 387!! 388!! OUTPUT 389!! ier= exit status, a non-zero value meaning there is an error 390!! 391!! SIDE EFFECTS 392!! recvbuf= received buffer 393!! 394!! SOURCE 395 396subroutine xmpi_gatherv_dp(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 397 398 399!This section has been created automatically by the script Abilint (TD). 400!Do not modify the following lines by hand. 401#undef ABI_FUNC 402#define ABI_FUNC 'xmpi_gatherv_dp' 403!End of the abilint section 404 405 implicit none 406 407!Arguments------------------------- 408 real(dp), DEV_CONTARRD intent(in) :: xval(:) 409 real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:) 410 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 411 integer,intent(in) :: nelem,root,spaceComm 412 integer,intent(out) :: ier 413 414!Local variables-------------- 415 integer :: cc,dd 416 417! ************************************************************************* 418 419 ier=0 420#if defined HAVE_MPI 421 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 422 call MPI_gatherV(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,recvcounts,displs,& 423& MPI_DOUBLE_PRECISION,root,spaceComm,ier) 424 else if (spaceComm == MPI_COMM_SELF) then 425#endif 426 dd=0;if (size(displs)>0) dd=displs(1) 427 cc=size(xval);if (size(recvcounts)>0) cc=recvcounts(1) 428 recvbuf(dd+1:dd+cc)=xval(1:cc) 429#if defined HAVE_MPI 430 end if 431#endif 432 433end subroutine xmpi_gatherv_dp 434!!*** 435 436!!****f* ABINIT/xmpi_gatherv_dp2d 437!! NAME 438!! xmpi_gatherv_dp2d 439!! 440!! FUNCTION 441!! Gathers data from all tasks and delivers it to all. 442!! Target: double precision two-dimensional arrays. 443!! 444!! INPUTS 445!! xval= buffer array 446!! recvcounts= number of received elements 447!! displs= relative offsets for incoming data 448!! nelem= number of elements 449!! root= rank of receiving process 450!! spaceComm= MPI communicator 451!! 452!! OUTPUT 453!! ier= exit status, a non-zero value meaning there is an error 454!! 455!! SIDE EFFECTS 456!! recvbuf= received buffer 457!! 458!! SOURCE 459subroutine xmpi_gatherv_dp2d(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 460 461 462!This section has been created automatically by the script Abilint (TD). 463!Do not modify the following lines by hand. 464#undef ABI_FUNC 465#define ABI_FUNC 'xmpi_gatherv_dp2d' 466!End of the abilint section 467 468 implicit none 469 470!Arguments------------------------- 471 real(dp), DEV_CONTARRD intent(in) :: xval(:,:) 472 real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:) 473 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 474 integer,intent(in) :: nelem,root,spaceComm 475 integer,intent(out) :: ier 476 477!Local variables-------------- 478 integer :: cc,dd,sz1 479 480! ************************************************************************* 481 482 ier=0 483#if defined HAVE_MPI 484 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 485 call MPI_gatherV(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,recvcounts,displs,& 486& MPI_DOUBLE_PRECISION,root,spaceComm,ier) 487 else if (spaceComm == MPI_COMM_SELF) then 488#endif 489 sz1=size(xval,1) 490 dd=0;if (size(displs)>0) dd=displs(1)/sz1 491 cc=size(xval,2);if (size(recvcounts)>0) cc=recvcounts(1)/sz1 492 recvbuf(:,dd+1:dd+cc)=xval(:,1:cc) 493#if defined HAVE_MPI 494 end if 495#endif 496 497end subroutine xmpi_gatherv_dp2d 498!!*** 499 500!!****f* ABINIT/xmpi_gatherv_dp3d 501!! NAME 502!! xmpi_gatherv_dp3d 503!! 504!! FUNCTION 505!! Gathers data from all tasks and delivers it to all. 506!! Target: double precision three-dimensional arrays. 507!! 508!! INPUTS 509!! xval= buffer array 510!! recvcounts= number of received elements 511!! displs= relative offsets for incoming data 512!! nelem= number of elements 513!! root= rank of receiving process 514!! spaceComm= MPI communicator 515!! 516!! OUTPUT 517!! ier= exit status, a non-zero value meaning there is an error 518!! 519!! SIDE EFFECTS 520!! recvbuf= received buffer 521!! 522!! SOURCE 523 524subroutine xmpi_gatherv_dp3d(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 525 526 527!This section has been created automatically by the script Abilint (TD). 528!Do not modify the following lines by hand. 529#undef ABI_FUNC 530#define ABI_FUNC 'xmpi_gatherv_dp3d' 531!End of the abilint section 532 533 implicit none 534 535!Arguments------------------------- 536 real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:) 537 real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:) 538 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 539 integer,intent(in) :: nelem,root,spaceComm 540 integer,intent(out) :: ier 541 542!Local variables-------------- 543 integer :: cc,dd,sz12 544 545! ************************************************************************* 546 547 ier=0 548#if defined HAVE_MPI 549 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 550 call MPI_gatherV(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,recvcounts,displs,& 551& MPI_DOUBLE_PRECISION,root,spaceComm,ier) 552 else if (spaceComm == MPI_COMM_SELF) then 553#endif 554 sz12=size(xval,1)*size(xval,2) 555 dd=0;if (size(displs)>0) dd=displs(1)/sz12 556 cc=size(xval,3);if (size(recvcounts)>0) cc=recvcounts(1)/sz12 557 recvbuf(:,:,dd+1:dd+cc)=xval(:,:,1:cc) 558#if defined HAVE_MPI 559 end if 560#endif 561 562end subroutine xmpi_gatherv_dp3d 563!!*** 564 565!!****f* ABINIT/xmpi_gatherv_dp4d 566!! NAME 567!! xmpi_gatherv_dp4d 568!! 569!! FUNCTION 570!! Gathers data from all tasks and delivers it to all. 571!! Target: double precision four-dimensional arrays. 572!! 573!! INPUTS 574!! xval= buffer array 575!! recvcounts= number of received elements 576!! displs= relative offsets for incoming data 577!! nelem= number of elements 578!! root= rank of receiving process 579!! spaceComm= MPI communicator 580!! 581!! OUTPUT 582!! ier= exit status, a non-zero value meaning there is an error 583!! 584!! SIDE EFFECTS 585!! recvbuf= received buffer 586!! 587!! SOURCE 588 589subroutine xmpi_gatherv_dp4d(xval,nelem,recvbuf,recvcounts,displs,root,spaceComm,ier) 590 591 592!This section has been created automatically by the script Abilint (TD). 593!Do not modify the following lines by hand. 594#undef ABI_FUNC 595#define ABI_FUNC 'xmpi_gatherv_dp4d' 596!End of the abilint section 597 598 implicit none 599 600!Arguments------------------------- 601 real(dp), DEV_CONTARRD intent(in) :: xval(:,:,:,:) 602 real(dp), DEV_CONTARRD intent(inout) :: recvbuf(:,:,:,:) 603 integer, DEV_CONTARRD intent(in) :: recvcounts(:),displs(:) 604 integer,intent(in) :: nelem,root,spaceComm 605 integer,intent(out) :: ier 606 607!Local variables------------------- 608 integer :: cc,dd,sz123 609 610! ************************************************************************* 611 612 ier=0 613#if defined HAVE_MPI 614 if (spaceComm /= MPI_COMM_SELF .and. spaceComm /= MPI_COMM_NULL) then 615 call MPI_gatherV(xval,nelem,MPI_DOUBLE_PRECISION,recvbuf,recvcounts,displs,& 616& MPI_DOUBLE_PRECISION,root,spaceComm,ier) 617 else if (spaceComm == MPI_COMM_SELF) then 618#endif 619 sz123=size(xval,1)*size(xval,2)*size(xval,3) 620 dd=0;if (size(displs)>0) dd=displs(1)/sz123 621 cc=size(xval,4);if (size(recvcounts)>0) cc=recvcounts(1)/sz123 622 recvbuf(:,:,:,dd+1:dd+cc)=xval(:,:,:,1:cc) 623#if defined HAVE_MPI 624 end if 625#endif 626 627end subroutine xmpi_gatherv_dp4d 628!!*** 629