Skip to content
Snippets Groups Projects
Commit cbad6e72 authored by Antoine Cyril David Hoffmann's avatar Antoine Cyril David Hoffmann
Browse files

single node gatherv output is ready

parent a9ae50d2
No related branches found
No related tags found
No related merge requests found
Expand all Hide whitespace changes
Inline Side-by-side
src/array_mod.F90
+ 0
− 9
View file @ cbad6e72
......@@ -63,18 +63,9 @@ MODULE array
! Poisson operator (ikx,iky,iz)
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: inv_poisson_op
!! Diagnostics (full arrays to gather on process 0 for output)
! moments
COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: moments_e_full
COMPLEX(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: moments_i_full
! ES potential
COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: phi_full
! Gyrocenter density for electron and ions (ikx,iky,iz)
COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ne00
COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ni00
COMPLEX(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ni00_full
! Kinetic spectrum sum_kx,ky(|Napj(z)|^2), (ip,ij,iz)
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Nepjz
......
src/basic_mod.F90
+ 2
− 0
View file @ cbad6e72
......@@ -62,6 +62,8 @@ MODULE basic
tc_step, tc_clos, tc_ghost, tc_coll, tc_process
real(dp) :: maxruntime = 1e9 ! Maximum simulation CPU time
LOGICAL :: GATHERV_OUTPUT = .true.
INTERFACE allocate_array
MODULE PROCEDURE allocate_array_dp1,allocate_array_dp2,allocate_array_dp3,allocate_array_dp4, allocate_array_dp5, allocate_array_dp6
MODULE PROCEDURE allocate_array_dc1,allocate_array_dc2,allocate_array_dc3,allocate_array_dc4, allocate_array_dc5, allocate_array_dc6
......
src/diagnose.F90
+ 226
− 230
View file @ cbad6e72
This diff is collapsed.
src/grid_mod.F90
+ 7
− 3
View file @ cbad6e72
......@@ -56,7 +56,7 @@ MODULE grid
INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: displs_nkx, displs_nky
! "" for p
INTEGER, PUBLIC :: local_np_e, local_np_i
INTEGER, PUBLIC :: total_np_e, total_np_i
INTEGER, PUBLIC :: total_np_e, total_np_i, Np_e, Np_i
integer(C_INTPTR_T), PUBLIC :: local_np_e_offset, local_np_i_offset
INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: rcv_p_e, rcv_p_i
INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: dsp_p_e, dsp_p_i
......@@ -67,7 +67,7 @@ MODULE grid
INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: counts_nz
INTEGER, DIMENSION(:), ALLOCATABLE, PUBLIC :: displs_nz
! "" for j (not parallelized)
INTEGER, PUBLIC :: local_nj_e, local_nj_i
INTEGER, PUBLIC :: local_nj_e, local_nj_i, Nj_e, Nj_i
! Grids containing position in fourier space
REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: kxarray, kxarray_full
REAL(dp), DIMENSION(:), ALLOCATABLE, PUBLIC :: kyarray, kyarray_full
......@@ -163,6 +163,8 @@ CONTAINS
! Total number of Hermite polynomials we will evolve
total_np_e = (Pmaxe/deltape) + 1
total_np_i = (Pmaxi/deltapi) + 1
Np_e = total_np_e ! Reduced names (redundant)
Np_i = total_np_i
! Build the full grids on process 0 to diagnose it without comm
ALLOCATE(parray_e_full(1:total_np_e))
ALLOCATE(parray_i_full(1:total_np_i))
......@@ -246,7 +248,9 @@ CONTAINS
USE prec_const
IMPLICIT NONE
INTEGER :: ij
! Total number of J degrees
Nj_e = jmaxe+1
Nj_i = jmaxi+1
! Build the full grids on process 0 to diagnose it without comm
ALLOCATE(jarray_e_full(1:jmaxe+1))
ALLOCATE(jarray_i_full(1:jmaxi+1))
......
src/memory.F90
+ 0
− 4
View file @ cbad6e72
......@@ -14,7 +14,6 @@ SUBROUTINE memory
! Electrostatic potential
CALL allocate_array( phi, ikys,ikye, ikxs,ikxe, izgs,izge)
CALL allocate_array( phi_full, 1,Nky, 1,Nkx, 1,Nz)
CALL allocate_array( phi_ZF, ikxs,ikxe, izs,ize)
CALL allocate_array( phi_EM, ikys,ikye, izs,ize)
CALL allocate_array(inv_poisson_op, ikys,ikye, ikxs,ikxe, izs,ize)
......@@ -58,7 +57,6 @@ SUBROUTINE memory
!Ions arrays
CALL allocate_array( Ni00, ikys,ikye, ikxs,ikxe, izs,ize)
CALL allocate_array( Ni00_full, 1,Nky, 1,Nkx, 1,Nz)
CALL allocate_array( dens_i, ikys,ikye, ikxs,ikxe, izs,ize)
CALL allocate_array( upar_i, ikys,ikye, ikxs,ikxe, izs,ize)
CALL allocate_array( uper_i, ikys,ikye, ikxs,ikxe, izs,ize)
......@@ -127,6 +125,4 @@ SUBROUTINE memory
CALL allocate_array( Ciipj, 1,(pmaxi+1)*(jmaxi+1), 1,(pmaxi+1)*(jmaxi+1), 1,1, 1,1, 1,1)
ENDIF
!____________DIAGNOSTIC PURPOSE ONLY ARRAYS_______________
END SUBROUTINE memory
src/parallel_mod.F90
+ 181
− 74
View file @ cbad6e72
MODULE parallel
USE basic
USE grid, ONLY: Nkx,Nky,Nz, ikys,ikye, izs,ize, local_nky, local_nz, &
local_np_e, local_np_i, total_np_e, total_np_i, &
local_np_e, local_np_i, Np_e, Np_i, Nj_e, Nj_i, &
pmaxi, pmaxe, ips_e, ipe_e, ips_i, ipe_i, &
jmaxi, jmaxe, ijs_e, ije_e, ijs_i, ije_i, &
rcv_p_e, rcv_p_i, dsp_p_e, dsp_p_i
......@@ -9,16 +9,21 @@ MODULE parallel
IMPLICIT NONE
! recieve and displacement counts for gatherv
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_y, dsp_y, rcv_zy, dsp_zy
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zp_e, dsp_zp_e
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zp_i, dsp_zp_i
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zp_e, dsp_zp_e
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_yp_e, dsp_yp_e
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zyp_e, dsp_zyp_e
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zp_i, dsp_zp_i
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_yp_i, dsp_yp_i
INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zyp_i, dsp_zyp_i
PUBLIC :: manual_0D_bcast, manual_3D_bcast, init_parallel_var, &
gather_xyz, gather_pjz_e, gather_pjz_i!, gather_pjxyz
gather_xyz, gather_pjz_i, gather_pjxyz_e, gather_pjxyz_i
CONTAINS
SUBROUTINE init_parallel_var
INTEGER :: i_
!!!!!! XYZ gather variables
!! Y reduction at constant x and z
! number of points recieved and displacement for the y reduction
......@@ -43,29 +48,72 @@ CONTAINS
print*, rcv_zy, dsp_zy
!!!!! PJZ gather variables
! ELECTRONS
! P variables are already defined in grid module (see rcv_p_a, dsp_p_a)
! IONS
!! Z reduction for full slices of p data but constant j
! number of points recieved and displacement for the z reduction
ALLOCATE(rcv_zp_i(0:num_procs_z-1),dsp_zp_i(0:num_procs_z-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nz*Np_i,1,MPI_INTEGER,rcv_zp_i,1,MPI_INTEGER,comm_z,ierr)
! the displacement array can be build from each local_np as
dsp_zp_i(0)=0
DO i_=1,num_procs_z-1
dsp_zp_i(i_) =dsp_zp_i(i_-1) + rcv_zp_i(i_-1)
END DO
!!!!! PJXYZ gather variables
!! Y reduction for full slices of p data but constant j
! number of points recieved and displacement for the y reduction
ALLOCATE(rcv_yp_i(0:num_procs_ky-1),dsp_yp_i(0:num_procs_ky-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nky*Np_i,1,MPI_INTEGER,rcv_yp_i,1,MPI_INTEGER,comm_ky,ierr)
! the displacement array can be build from each local_np as
dsp_yp_i(0)=0
DO i_=1,num_procs_ky-1
dsp_yp_i(i_) =dsp_yp_i(i_-1) + rcv_yp_i(i_-1)
END DO
!! Z reduction for full slices of py data but constant j
! number of points recieved and displacement for the z reduction
ALLOCATE(rcv_zyp_i(0:num_procs_z-1),dsp_zyp_i(0:num_procs_z-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nz*Np_i*Nky,1,MPI_INTEGER,rcv_zyp_i,1,MPI_INTEGER,comm_z,ierr)
! the displacement array can be build from each local_np as
dsp_zyp_i(0)=0
DO i_=1,num_procs_z-1
dsp_zyp_i(i_) =dsp_zyp_i(i_-1) + rcv_zyp_i(i_-1)
END DO
! ELECTONS
!! Z reduction for full slices of p data but constant j
! number of points recieved and displacement for the z reduction
ALLOCATE(rcv_zp_e(0:num_procs_z-1),dsp_zp_e(0:num_procs_z-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nz*total_np_e,1,MPI_INTEGER,rcv_zp_e,1,MPI_INTEGER,comm_z,ierr)
CALL MPI_ALLGATHER(local_nz*Np_e,1,MPI_INTEGER,rcv_zp_e,1,MPI_INTEGER,comm_z,ierr)
! the displacement array can be build from each local_np as
dsp_zp_e(0)=0
DO i_=1,num_procs_z-1
dsp_zp_e(i_) =dsp_zp_e(i_-1) + dsp_zp_e(i_-1)
dsp_zp_e(i_) =dsp_zp_e(i_-1) + rcv_zp_e(i_-1)
END DO
! IONS
! P variables are already defined in grid module (see rcv_p_a, dsp_p_a)
!! Z reduction for full slices of p data but constant j
!!!!! PJXYZ gather variables
!! Y reduction for full slices of p data but constant j
! number of points recieved and displacement for the y reduction
ALLOCATE(rcv_yp_e(0:num_procs_ky-1),dsp_yp_e(0:num_procs_ky-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nky*Np_e,1,MPI_INTEGER,rcv_yp_e,1,MPI_INTEGER,comm_ky,ierr)
! the displacement array can be build from each local_np as
dsp_yp_e(0)=0
DO i_=1,num_procs_ky-1
dsp_yp_e(i_) =dsp_yp_e(i_-1) + rcv_yp_e(i_-1)
END DO
!! Z reduction for full slices of py data but constant j
! number of points recieved and displacement for the z reduction
ALLOCATE(rcv_zp_i(0:num_procs_z-1),dsp_zp_i(0:num_procs_z-1)) !Displacement sizes for balance diagnostic
ALLOCATE(rcv_zyp_e(0:num_procs_z-1),dsp_zyp_e(0:num_procs_z-1)) !Displacement sizes for balance diagnostic
! all processes share their local number of points
CALL MPI_ALLGATHER(local_nz*total_np_i,1,MPI_INTEGER,rcv_zp_i,1,MPI_INTEGER,comm_z,ierr)
CALL MPI_ALLGATHER(local_nz*Np_e*Nky,1,MPI_INTEGER,rcv_zyp_e,1,MPI_INTEGER,comm_z,ierr)
! the displacement array can be build from each local_np as
dsp_zp_i(0)=0
dsp_zyp_e(0)=0
DO i_=1,num_procs_z-1
dsp_zp_i(i_) =dsp_zp_i(i_-1) + dsp_zp_i(i_-1)
dsp_zyp_e(i_) =dsp_zyp_e(i_-1) + rcv_zyp_e(i_-1)
END DO
END SUBROUTINE init_parallel_var
......@@ -109,122 +157,181 @@ CONTAINS
END SUBROUTINE gather_xyz
!!!!! Gather a field in kinetic + z coordinates on rank 0 !!!!!
SUBROUTINE gather_pjz_e(field_sub,field_full)
COMPLEX(dp), DIMENSION(ips_e:ipe_e, ijs_e:ije_e, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION( 1:pmaxe+1, 1:jmaxe+1, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: buffer_lp_cz !local p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxe+1 ) :: buffer_fp_cz !full p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxe+1, izs:ize ) :: buffer_fp_lz !full p, local z
COMPLEX(dp), DIMENSION( 1:pmaxe+1, 1:Nz ) :: buffer_fp_fz !full p, full z
INTEGER :: snd_p, snd_z, root_p, root_z, root_ky, ij, iz, Npe
SUBROUTINE gather_pjz_i(field_sub,field_full)
COMPLEX(dp), DIMENSION(ips_i:ipe_i, ijs_i:ije_i, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION( 1:pmaxi+1, 1:jmaxi+1, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_i:ipe_i) :: buffer_lp_cz !local p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxi+1 ) :: buffer_fp_cz !full p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxi+1, izs:ize ) :: buffer_fp_lz !full p, local z
COMPLEX(dp), DIMENSION( 1:pmaxi+1, 1:Nz ) :: buffer_fp_fz !full p, full z
INTEGER :: snd_p, snd_z, root_p, root_z, root_ky, ij, iz
Npe = pmaxe+1 ! total number of hermite moments
snd_p = local_np_e ! Number of points to send along y (per z)
snd_z = Npe*local_nz ! Number of points to send along z (full y)
snd_p = local_np_i ! Number of points to send along y (per z)
snd_z = Np_i*local_nz ! Number of points to send along z (full y)
root_p = 0; root_z = 0; root_ky = 0
IF(rank_ky .EQ. root_ky) THEN
DO ij = 1,jmaxe+1
DO ij = 1,jmaxi+1
DO iz = izs,ize
! fill a buffer to contain a slice of data at constant kx and z
buffer_lp_cz(ips_e:ipe_e) = field_sub(ips_e:ipe_e,ij,iz)
CALL MPI_GATHERV(buffer_lp_cz, snd_p, MPI_DOUBLE_COMPLEX, &
buffer_fp_cz, rcv_p_e, dsp_p_e, MPI_DOUBLE_COMPLEX, &
buffer_lp_cz(ips_i:ipe_i) = field_sub(ips_i:ipe_i,ij,iz)
CALL MPI_GATHERV(buffer_lp_cz, snd_p, MPI_DOUBLE_COMPLEX, &
buffer_fp_cz, rcv_p_i, dsp_p_i, MPI_DOUBLE_COMPLEX, &
root_p, comm_p, ierr)
buffer_fp_lz(1:Npe,iz) = buffer_fp_cz(1:Npe)
buffer_fp_lz(1:Np_i,iz) = buffer_fp_cz(1:Np_i)
ENDDO
! send the full line on y contained by root_kyas
IF(rank_p .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fp_lz, snd_z, MPI_DOUBLE_COMPLEX, &
buffer_fp_fz, rcv_zp_e, dsp_zp_e, MPI_DOUBLE_COMPLEX, &
buffer_fp_fz, rcv_zp_i, dsp_zp_i, MPI_DOUBLE_COMPLEX, &
root_z, comm_z, ierr)
ENDIF
! ID 0 (the one who output) rebuild the whole array
IF(my_id .EQ. 0) &
field_full(1:Npe,ij,1:Nz) = buffer_fp_fz(1:Npe,1:Nz)
field_full(1:Np_i,ij,1:Nz) = buffer_fp_fz(1:Np_i,1:Nz)
ENDDO
ENDIF
END SUBROUTINE gather_pjz_e
END SUBROUTINE gather_pjz_i
SUBROUTINE gather_pjz_i(field_sub,field_full)
COMPLEX(dp), DIMENSION(ips_i:ipe_i, ijs_i:ije_i, izs:ize), INTENT(IN) :: field_sub
SUBROUTINE gather_pjz_e(field_sub,field_full)
COMPLEX(dp), DIMENSION(ips_e:ipe_e, ijs_e:ije_e, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION( 1:pmaxi+1, 1:jmaxi+1, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_i:ipe_i) :: buffer_lp_cz !local p, constant z
COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: buffer_lp_cz !local p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxi+1 ) :: buffer_fp_cz !full p, constant z
COMPLEX(dp), DIMENSION( 1:pmaxi+1, izs:ize ) :: buffer_fp_lz !full p, local z
COMPLEX(dp), DIMENSION( 1:pmaxi+1, 1:Nz ) :: buffer_fp_fz !full p, full z
INTEGER :: snd_p, snd_z, root_p, root_z, root_ky, ij, iz, Npi
INTEGER :: snd_p, snd_z, root_p, root_z, root_ky, ij, iz
Npi = pmaxi+1 ! total number of hermite moments
snd_p = local_np_i ! Number of points to send along y (per z)
snd_z = Npi*local_nz ! Number of points to send along z (full y)
snd_p = local_np_e ! Number of points to send along y (per z)
snd_z = Np_e*local_nz ! Number of points to send along z (full y)
root_p = 0; root_z = 0; root_ky = 0
IF(rank_ky .EQ. root_ky) THEN
DO ij = 1,jmaxi+1
DO iz = izs,ize
! fill a buffer to contain a slice of data at constant kx and z
buffer_lp_cz(ips_i:ipe_i) = field_sub(ips_i:ipe_i,ij,iz)
buffer_lp_cz(ips_e:ipe_e) = field_sub(ips_e:ipe_e,ij,iz)
CALL MPI_GATHERV(buffer_lp_cz, snd_p, MPI_DOUBLE_COMPLEX, &
buffer_fp_cz, rcv_p_i, dsp_p_i, MPI_DOUBLE_COMPLEX, &
buffer_fp_cz, rcv_p_e, dsp_p_e, MPI_DOUBLE_COMPLEX, &
root_p, comm_p, ierr)
buffer_fp_lz(1:Npi,iz) = buffer_fp_cz(1:Npi)
buffer_fp_lz(1:Np_e,iz) = buffer_fp_cz(1:Np_e)
ENDDO
! send the full line on y contained by root_kyas
IF(rank_p .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fp_lz, snd_z, MPI_DOUBLE_COMPLEX, &
buffer_fp_fz, rcv_zp_i, dsp_zp_i, MPI_DOUBLE_COMPLEX, &
buffer_fp_fz, rcv_zp_e, dsp_zp_e, MPI_DOUBLE_COMPLEX, &
root_z, comm_z, ierr)
ENDIF
! ID 0 (the one who output) rebuild the whole array
IF(my_id .EQ. 0) &
field_full(1:Npi,ij,1:Nz) = buffer_fp_fz(1:Npi,1:Nz)
field_full(1:Np_e,ij,1:Nz) = buffer_fp_fz(1:Np_e,1:Nz)
ENDDO
ENDIF
END SUBROUTINE gather_pjz_i
END SUBROUTINE gather_pjz_e
!!!!! Gather a field in kinetic + spatial coordinates on rank 0 !!!!!
!!!!! Gather a field in spatial coordinates on rank 0 !!!!!
SUBROUTINE gather_pjxyz_i(field_sub,field_full)
COMPLEX(dp), DIMENSION( ips_i:ipe_i, 1:Nj_i, ikys:ikye, 1:Nkx, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION( 1:Np_i, 1:Nj_i, 1:Nky, 1:Nkx, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_i:ipe_i) :: buffer_lp_cy_cz !local p, constant y, constant z
COMPLEX(dp), DIMENSION(1:Np_i) :: buffer_fp_cy_cz ! full p, constant y, constant z
COMPLEX(dp), DIMENSION(1:Np_i, ikys:ikye) :: buffer_fp_ly_cz ! full p, local y, constant z
COMPLEX(dp), DIMENSION(1:Np_i, 1:Nky ) :: buffer_fp_fy_cz ! full p, full y, constant z
COMPLEX(dp), DIMENSION(1:Np_i, 1:Nky, izs:ize ) :: buffer_fp_fy_lz ! full p, full y, local z
COMPLEX(dp), DIMENSION(1:Np_i, 1:Nky, 1:Nz ) :: buffer_fp_fy_fz ! full p, full y, full z
INTEGER :: snd_p, snd_y, snd_z, root_p, root_z, root_ky, iy, ix, iz, ij
snd_p = local_np_i ! Number of points to send along p (per z,y)
snd_y = Np_i*local_nky ! Number of points to send along y (per z, full p)
snd_z = Np_i*Nky*local_nz ! Number of points to send along z (full y, full p)
root_p = 0; root_z = 0; root_ky = 0
j: DO ij = 1,Nj_i
x: DO ix = 1,Nkx
z: DO iz = izs,ize
y: DO iy = ikys,ikye
! fill a buffer to contain a slice of p data at constant j, ky, kx and z
buffer_lp_cy_cz(ips_i:ipe_i) = field_sub(ips_i:ipe_i,ij,iy,ix,iz)
CALL MPI_GATHERV(buffer_lp_cy_cz, snd_p, MPI_DOUBLE_COMPLEX, &
buffer_fp_cy_cz, rcv_p_i, dsp_p_i, MPI_DOUBLE_COMPLEX, &
root_p, comm_p, ierr)
buffer_fp_ly_cz(1:Np_i,iy) = buffer_fp_cy_cz(1:Np_i)
ENDDO y
! send the full line on p contained by root_p
IF(rank_p .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fp_ly_cz, snd_y, MPI_DOUBLE_COMPLEX, &
buffer_fp_fy_cz, rcv_yp_i, dsp_yp_i, MPI_DOUBLE_COMPLEX, &
root_ky, comm_ky, ierr)
buffer_fp_fy_lz(1:Np_i,1:Nky,iz) = buffer_fp_fy_cz(1:Np_i,1:Nky)
ENDIF
ENDDO z
! send the full line on y contained by root_kyas
IF(rank_ky .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fp_fy_lz, snd_z, MPI_DOUBLE_COMPLEX, &
buffer_fp_fy_fz, rcv_zyp_i, dsp_zyp_i, MPI_DOUBLE_COMPLEX, &
root_z, comm_z, ierr)
ENDIF
! ID 0 (the one who output) rebuild the whole array
IF(my_id .EQ. 0) &
field_full(1:Np_i,ij,1:Nky,ix,1:Nz) = buffer_fp_fy_fz(1:Np_i,1:Nky,1:Nz)
ENDDO x
ENDDO j
END SUBROUTINE gather_pjxyz_i
SUBROUTINE gather_pjxyz_e(field_sub,field_full)
COMPLEX(dp), DIMENSION( ips_e:ipe_e, ijs_e:ije_e, ikys:ikye, 1:Nkx, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION(1:total_np_e, ijs_e:ije_e, 1:Nky, 1:Nkx, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: buffer_lp_cy_cz !local p, constant y, constant z
COMPLEX(dp), DIMENSION(1:total_np_e) :: buffer_fp_cy_cz ! full p, constant y, constant z
COMPLEX(dp), DIMENSION(1:total_np_e, ikys:ikye) :: buffer_fp_ly_cz ! full p, local y, constant z
COMPLEX(dp), DIMENSION(1:total_np_e, 1:Nky ) :: buffer_fp_fy_cz ! full p, full y, constant z
COMPLEX(dp), DIMENSION(1:total_np_e, 1:Nky, izs:ize ) :: buffer_fp_fy_lz ! full p, full y, local z
COMPLEX(dp), DIMENSION(1:total_np_e, 1:Nky, 1:Nz ) :: buffer_fp_fy_fz ! full p, full y, full z
INTEGER :: snd_y, snd_z, root_p, root_z, root_ky, ix, iz
COMPLEX(dp), DIMENSION( ips_e:ipe_e, 1:Nj_e, ikys:ikye, 1:Nkx, izs:ize), INTENT(IN) :: field_sub
COMPLEX(dp), DIMENSION( 1:Np_e, 1:Nj_e, 1:Nky, 1:Nkx, 1:Nz), INTENT(INOUT) :: field_full
COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: buffer_lp_cy_cz !local p, constant y, constant z
COMPLEX(dp), DIMENSION(1:Np_e) :: buffer_fp_cy_cz ! full p, constant y, constant z
COMPLEX(dp), DIMENSION(1:Np_e, ikys:ikye) :: buffer_fp_ly_cz ! full p, local y, constant z
COMPLEX(dp), DIMENSION(1:Np_e, 1:Nky ) :: buffer_fp_fy_cz ! full p, full y, constant z
COMPLEX(dp), DIMENSION(1:Np_e, 1:Nky, izs:ize ) :: buffer_fp_fy_lz ! full p, full y, local z
COMPLEX(dp), DIMENSION(1:Np_e, 1:Nky, 1:Nz ) :: buffer_fp_fy_fz ! full p, full y, full z
INTEGER :: snd_p, snd_y, snd_z, root_p, root_z, root_ky, iy, ix, iz, ij
snd_y = local_nky ! Number of points to send along y (per z)
snd_z = Nky*local_nz ! Number of points to send along z (full y)
snd_p = local_np_e ! Number of points to send along p (per z,y)
snd_y = Np_e*local_nky ! Number of points to send along y (per z, full p)
snd_z = Np_e*Nky*local_nz ! Number of points to send along z (full y, full p)
root_p = 0; root_z = 0; root_ky = 0
IF(rank_p .EQ. root_p) THEN
DO ix = 1,Nkx
DO iz = izs,ize
! fill a buffer to contain a slice of data at constant kx and z
buffer_ly_cz(ikys:ikye) = field_sub(ikys:ikye,ix,iz)
CALL MPI_GATHERV(buffer_ly_cz, snd_y, MPI_DOUBLE_COMPLEX, &
buffer_fy_cz, rcv_y, dsp_y, MPI_DOUBLE_COMPLEX, &
root_ky, comm_ky, ierr)
buffer_fy_lz(1:Nky,iz) = buffer_fy_cz(1:Nky)
ENDDO
j: DO ij = 1,Nj_e
x: DO ix = 1,Nkx
z: DO iz = izs,ize
y: DO iy = ikys,ikye
! fill a buffer to contain a slice of p data at constant j, ky, kx and z
buffer_lp_cy_cz(ips_e:ipe_e) = field_sub(ips_e:ipe_e,ij,iy,ix,iz)
CALL MPI_GATHERV(buffer_lp_cy_cz, snd_p, MPI_DOUBLE_COMPLEX, &
buffer_fp_cy_cz, rcv_p_e, dsp_p_e, MPI_DOUBLE_COMPLEX, &
root_p, comm_p, ierr)
buffer_fp_ly_cz(1:Np_e,iy) = buffer_fp_cy_cz(1:Np_e)
ENDDO y
! send the full line on p contained by root_p
IF(rank_p .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fp_ly_cz, snd_y, MPI_DOUBLE_COMPLEX, &
buffer_fp_fy_cz, rcv_yp_e, dsp_yp_e, MPI_DOUBLE_COMPLEX, &
root_ky, comm_ky, ierr)
buffer_fp_fy_lz(1:Np_e,1:Nky,iz) = buffer_fp_fy_cz(1:Np_e,1:Nky)
ENDIF
ENDDO z
! send the full line on y contained by root_kyas
IF(rank_ky .EQ. 0) THEN
CALL MPI_GATHERV(buffer_fy_lz, snd_z, MPI_DOUBLE_COMPLEX, &
buffer_fy_fz, rcv_zy, dsp_zy, MPI_DOUBLE_COMPLEX, &
CALL MPI_GATHERV(buffer_fp_fy_lz, snd_z, MPI_DOUBLE_COMPLEX, &
buffer_fp_fy_fz, rcv_zyp_e, dsp_zyp_e, MPI_DOUBLE_COMPLEX, &
root_z, comm_z, ierr)
ENDIF
! ID 0 (the one who output) rebuild the whole array
IF(my_id .EQ. 0) &
field_full(1:Nky,ix,1:Nz) = buffer_fy_fz(1:Nky,1:Nz)
ENDDO
ENDIF
END SUBROUTINE gather_pjxyz
field_full(1:Np_e,ij,1:Nky,ix,1:Nz) = buffer_fp_fy_fz(1:Np_e,1:Nky,1:Nz)
ENDDO x
ENDDO j
END SUBROUTINE gather_pjxyz_e
!!!!! This is a manual way to do MPI_BCAST !!!!!!!!!!!
SUBROUTINE manual_3D_bcast(field_)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment