Fixed arbitrary communicator

sdsc · Sep 20, 2018 · a106994 · a106994
1 parent 2c37376
commit a106994
Show file tree

Hide file tree

Showing 7 changed files with 20 additions and 41 deletions.
diff --git a/build/bcomm1_trans.F90 b/build/bcomm1_trans.F90
@@ -304,7 +304,7 @@ subroutine pack_bcomm1_trans(sendbuf,source,buf3,j,nv,op)
 				  buf3, 2,2*nz_fft,nz_fft,jjsize)
 	       else
 		   print *,taskid,'Unknown transform type: ',op(1:1)
-		   call MPI_abort(MPI_COMM_WORLD,ierr)
+		   call MPI_abort(mpicomm,ierr)
 	       endif
 
 	    else
@@ -320,7 +320,7 @@ subroutine pack_bcomm1_trans(sendbuf,source,buf3,j,nv,op)
 				  buf3, 2,2*nz_fft,nz_fft,jjsize)
 	       else
 		   print *,taskid,'Unknown transform type: ',op(1:1)
-		   call MPI_abort(MPI_COMM_WORLD,ierr)
+		   call MPI_abort(mpicomm,ierr)
 	       endif
 
 	    endif

diff --git a/build/btran.F90 b/build/btran.F90
@@ -235,14 +235,6 @@ subroutine p3dfft_btran_c2r_many (XYZg,dim_in,XgYZ,dim_out,nv,op)
           timers(12) = timers(12) + MPI_Wtime()
        endif
 
-!	deallocate(buf)
-
-!      do j=1,nv
-!        print *,'Exiting btran: j=',j
-!        call print_buf_real(XgYZ(1,j),nx,jisize,kjsize)
-!      enddo
-
-      call mpi_barrier(mpi_comm_world,ierr)
 
       return
       end subroutine
@@ -298,7 +290,7 @@ subroutine ztran_b_same_many(A,str1,str2,n,m,dim,nv,op)
               timers(8) = timers(8) + MPI_Wtime()
 	    else if(op(1:1) .ne. 'n' .and. op(1:1) .ne. '0') then
 		print *,'Unknown transform type: ',op(1:1)
-		call MPI_Abort(MPI_COMM_WORLD,ierr)
+		call MPI_Abort(mpicomm,ierr)
             endif
 
 	    return
@@ -405,7 +397,7 @@ subroutine p3dfft_btran_c2r (XYZg,XgYZ,op)
 					nz, 2*iisize*jjsize)
 	        else if(op(1:1) /= 'n' .and. op(1:1) /= '0') then
 		   print *,taskid,'Unknown transform type: ',op(1:1)
-		   call MPI_abort(MPI_COMM_WORLD,ierr)
+		   call MPI_abort(mpicomm,ierr)
 		endif
             endif
             call bcomm1(XYZg,buf,timers(3),timers(9))
@@ -446,7 +438,7 @@ subroutine p3dfft_btran_c2r (XYZg,XgYZ,op)
 					nz, 2*iisize*jjsize)
 	         else if(op(1:1) /= 'n' .and. op(1:1) /= '0') then
 		   print *,taskid,'Unknown transform type: ',op(1:1)
-		   call MPI_abort(MPI_COMM_WORLD,ierr)
+		   call MPI_abort(mpicomm,ierr)
 		 endif
 
                  call bcomm1(buf,buf,timers(3),timers(9))
@@ -489,7 +481,7 @@ subroutine p3dfft_btran_c2r (XYZg,XgYZ,op)
 				    nz, 2*iisize*jjsize)
 	    else if(op(1:1) /= 'n' .and. op(1:1) /= '0') then
 		print *,taskid,'Unknown transform type: ',op(1:1)
-   	        call MPI_abort(MPI_COMM_WORLD,ierr)
+   	        call MPI_abort(mpicomm,ierr)
 	    endif
             call ar_copy(XYZg,buf,Nl)
 
@@ -522,7 +514,7 @@ subroutine p3dfft_btran_c2r (XYZg,XgYZ,op)
 				    nz, 2*iisize*jjsize)
                  else if(op(1:1) /= 'n' .and. op(1:1) /= '0') then
 		    print *,taskid,'Unknown transform type: ',op(1:1)
-	            call MPI_abort(MPI_COMM_WORLD,ierr)
+	            call MPI_abort(mpicomm,ierr)
  	         endif
 
  		 dny = ny - nyc
@@ -617,8 +609,6 @@ subroutine p3dfft_btran_c2r (XYZg,XgYZ,op)
 
 #endif
 
-      call mpi_barrier(mpi_comm_world,ierr)
-
       return
       end subroutine
 

diff --git a/build/fcomm2_trans.F90 b/build/fcomm2_trans.F90
@@ -322,7 +322,7 @@ subroutine unpack_fcomm2_trans(dest,recvbuf,buf3,j,nv,op)
 		          buf3, 2,2*nz_fft,nz_fft,jjsize)
  	else
 	   print *,taskid,'Unknown transform type: ',op(3:3)
-	   call MPI_abort(MPI_COMM_WORLD,ierr)
+	   call MPI_abort(mpicomm,ierr)
 	endif
 
 	do y=1,jjsize
@@ -425,7 +425,7 @@ subroutine unpack_fcomm2_trans(dest,recvbuf,buf3,j,nv,op)
 		          dest(1,1,x), 2,2*nz_fft,nz_fft,jjsize)
  	else
 	   print *,taskid,'Unknown transform type: ',op(3:3)
-	   call MPI_abort(MPI_COMM_WORLD,ierr)
+	   call MPI_abort(mpicomm,ierr)
 	endif
 
       enddo

diff --git a/build/ftran.F90 b/build/ftran.F90
@@ -255,10 +255,6 @@ subroutine p3dfft_ftran_r2c_many (XgYZ,dim_in,XYZg,dim_out,nv,op)
 
       endif
 
-!      deallocate(buf)
-
-      call mpi_barrier(mpi_comm_world,ierr)
-
      return
       end subroutine
 
@@ -585,7 +581,7 @@ subroutine p3dfft_ftran_r2c (XgYZ,XYZg,op)
               timers(8) = timers(8) + MPI_Wtime()
 	    else if(op(3:3) .ne. 'n' .and. op(3:3) .ne. '0') then
 		print *,'Unknown transform type: ',op(3:3)
-		call MPI_Abort(MPI_COMM_WORLD,ierr)
+		call MPI_Abort(mpicomm,ierr)
             endif
 
 	    call seg_copy_z(buf,XYZg,1,iisize,1,jjsize,1,nzhc,0,iisize,jjsize,nz)
@@ -625,7 +621,7 @@ subroutine p3dfft_ftran_r2c (XgYZ,XYZg,op)
               timers(8) = timers(8) + MPI_Wtime()
             else if(op(3:3) .ne. 'n' .and. op(3:3) .ne. '0') then
                 print *,'Unknown transform type: ',op(3:3)
-                call MPI_Abort(MPI_COMM_WORLD,ierr)
+                call MPI_Abort(mpicomm,ierr)
             endif
 
         endif
@@ -671,7 +667,7 @@ subroutine p3dfft_ftran_r2c (XgYZ,XYZg,op)
               timers(8) = timers(8) + MPI_Wtime()
 	    else if(op(3:3) /= 'n' .and. op(3:3) /= '0') then
 		print *,'Unknown transform type: ',op(3:3)
-		call MPI_Abort(MPI_COMM_WORLD,ierr)
+		call MPI_Abort(mpicomm,ierr)
             endif
 
 	   call seg_copy_z(buf1,XYZg,1,iisize,1,jjsize,1,nzhc,0,iisize,jjsize,nz)
@@ -705,7 +701,7 @@ subroutine p3dfft_ftran_r2c (XgYZ,XYZg,op)
               timers(8) = timers(8) + MPI_Wtime()
             else if(op(3:3) /= 'n' .and. op(3:3) /= '0') then
                 print *,'Unknown transform type: ',op(3:3)
-                call MPI_Abort(MPI_COMM_WORLD,ierr)
+                call MPI_Abort(mpicomm,ierr)
             endif
 
 
@@ -716,12 +712,6 @@ subroutine p3dfft_ftran_r2c (XgYZ,XYZg,op)
 
       endif
 
-#ifdef DEBUG
-      print *,taskid,': Waiting at barrier'
-#endif
-
-      call mpi_barrier(mpi_comm_world,ierr)
-
       return
       end subroutine
 
@@ -820,7 +810,7 @@ subroutine ztran_f_same_many(A,str1,str2,n,m,dim,nv,op)
               timers(8) = timers(8) + MPI_Wtime()
 	    else if(op(3:3) .ne. 'n' .and. op(3:3) .ne. '0') then
 		print *,'Unknown transform type: ',op(3:3)
-		call MPI_Abort(MPI_COMM_WORLD,ierr)
+		call MPI_Abort(mpicomm,ierr)
             endif
 
 	    return

diff --git a/build/init_plan.F90 b/build/init_plan.F90
@@ -136,7 +136,6 @@ subroutine init_plan
 
 #ifdef DEBUG
 	print *,taskid, ': doing plan_f_c1'
-	call mpi_barrier(mpi_comm_world,ierr)
 #endif
 
      if(iisize*kjsize .gt. 0) then

diff --git a/build/reorder.F90 b/build/reorder.F90
@@ -150,7 +150,7 @@ subroutine reorder_trans_b1(A,B,C,op)
 				  C, 2,2*nz_fft,nz_fft,nyc)
               else
 	         print *,taskid,'Unknown transform type: ',op(1:1)
-	         call MPI_abort(MPI_COMM_WORLD,ierr)
+	         call MPI_abort(mpicomm,ierr)
 	      endif
 
               do y=1,nyhc,NBy2
@@ -400,7 +400,7 @@ subroutine reorder_trans_f2(A,B,C,op)
 				  C, 2,2*nz_fft,nz_fft,nyc)
                  else
 	           print *,taskid,'Unknown transform type: ',op(3:3)
-	           call MPI_abort(MPI_COMM_WORLD,ierr)
+	           call MPI_abort(mpicomm,ierr)
 	         endif
 	 	   do y=1,nyc
 		      do z=1,nzhc
@@ -422,7 +422,7 @@ subroutine reorder_trans_f2(A,B,C,op)
 				  B(1,1,x), 2,2*nz_fft,nz_fft,nyc)
                  else
 	           print *,taskid,'Unknown transform type: ',op(3:3)
-	           call MPI_abort(MPI_COMM_WORLD,ierr)
+	           call MPI_abort(mpicomm,ierr)
 	         endif
 	      endif
          enddo

diff --git a/build/setup.F90 b/build/setup.F90
@@ -69,14 +69,14 @@ subroutine p3dfft_setup(dims,nx,ny,nz,mpi_comm_in,nxcut,nycut,nzcut,overwrite,me
 
       if(nx .le. 0 .or. ny .le. 0 .or. nz .le. 0) then
          print *,'Invalid dimensions :',nx,ny,nz
-         call MPI_ABORT(MPI_COMM_WORLD, 0)
+         call MPI_ABORT(mpicomm, 0)
       endif
 
       if(mpi_set) then
          print *,'P3DFFT Setup error: the problem is already initialized. '
          print *,'Currently multiple setups not supported.'
          print *,'Quit the library using p3dfft_clean before initializing another setup'
-         call MPI_ABORT(MPI_COMM_WORLD, 0)
+         call MPI_ABORT(mpicomm, 0)
       endif
 
       if(present(overwrite)) then
@@ -125,7 +125,7 @@ subroutine p3dfft_setup(dims,nx,ny,nz,mpi_comm_in,nxcut,nycut,nzcut,overwrite,me
 
       if(dims(1) .le. 0 .or. dims(2) .le. 0 .or.  dims(1)*dims(2) .ne. numtasks) then
          print *,'Invalid processor geometry: ',dims,' for ',numtasks, 'tasks'
-         call MPI_ABORT(MPI_COMM_WORLD, 0)
+         call MPI_ABORT(mpicomm, 0)
       endif
 
 #ifdef STRIDE1