Output kperp array

gather real xyz array

src/diagnose.F90

@@ -96,20 +96,22 @@ SUBROUTINE diagnose_full(kstep)
   USE basic,           ONLY: speak,chrono_runt,&
                              cstep,iframe0d,iframe3d,iframe5d,crashed
   USE grid,            ONLY: &
-    parray_full,pmax,jarray_full,jmax,&
-    kyarray_full,kxarray_full,zarray_full, ngz, total_nz, local_nz, ieven
+    parray_full,pmax,jarray_full,jmax, kparray, &
+    kyarray_full,kxarray_full,zarray_full, ngz, total_nz, local_nz, ieven,&
+    local_Nky, total_nky, local_nkx, total_nkx
   USE geometry, ONLY: gxx, gxy, gxz, gyy, gyz, gzz, &
                       hatR, hatZ, hatB, dBdx, dBdy, dBdz, Jacobian, gradz_coeff
   USE diagnostics_par
   USE futils,          ONLY: creatf, creatg, creatd, closef, putarr, putfile, attach, openf!, putarrnd ! Routine de merde, jamais l'utiliser
   USE array
   USE model,           ONLY: EM
-  USE parallel,        ONLY: my_id, comm0, gather_z
+  USE parallel,        ONLY: my_id, comm0, gather_z, gather_xyz_real
   USE collision,       ONLY: coll_outputinputs
   IMPLICIT NONE
   INTEGER, INTENT(in) :: kstep
   INTEGER, parameter  :: BUFSIZE = 2
   REAL(xp), DIMENSION(total_nz) :: Az_full ! full z array for metric output
+  REAL(xp), DIMENSION(total_nky,total_nkx,total_nz) :: kp_full
   INTEGER :: rank = 0, ierr
   INTEGER :: dims(1) = (/0/)
   !____________________________________________________________________________
@@ -141,6 +143,8 @@ SUBROUTINE diagnose_full(kstep)
     CALL putarr(fidres, "/data/grid/coordz",    zarray_full,   "z/R", ionode=0)
     CALL putarr(fidres, "/data/grid/coordp" ,   parray_full,   "p", ionode=0)
     CALL putarr(fidres, "/data/grid/coordj" ,   jarray_full,   "j", ionode=0)
+    CALL gather_xyz_real(kparray(1:local_Nky,1:local_Nkx,1:local_nz,ieven),kp_full,local_nky,total_nky,total_nkx,local_nz,total_nz)
+    CALL putarr(fidres, "/data/grid/coordkp" ,      kp_full,   "kp", ionode=0)
     ! Metric info
     CALL   creatg(fidres, "/data/metric", "Metric data")
     CALL gather_z(gxx((1+ngz/2):(local_nz+ngz/2),ieven),Az_full,local_nz,total_nz)
@@ -171,8 +175,6 @@ SUBROUTINE diagnose_full(kstep)
     CALL putarr(fidres, "/data/metric/Jacobian", Az_full, "Jacobian", ionode =0)
     CALL gather_z(gradz_coeff((1+ngz/2):(local_nz+ngz/2),ieven),Az_full,local_nz,total_nz)
     CALL putarr(fidres, "/data/metric/gradz_coeff", Az_full, "gradz_coeff", ionode =0)
-    ! CALL putarrnd(fidres, "/data/metric/Ckxky",       Ckxky(1:local_nky,1:local_nkx,(1+ngz/2):(local_nz+ngz/2),:), (/1, 1, 3/))
-    ! CALL putarrnd(fidres, "/data/metric/kernel",    kernel(1,(1+ngj/2):(local_nj+ngj/2),1:local_nky,1:local_nkx,(1+ngz/2):(local_nz+ngz/2),1), (/1, 2, 4/))
     !  var0d group (gyro transport)
     IF (nsave_0d .GT. 0) THEN
      CALL creatg(fidres, "/data/var0d", "0d profiles")

src/parallel_mod.F90

@@ -37,7 +37,7 @@ MODULE parallel
   INTEGER, DIMENSION(:), ALLOCATABLE :: rcv_zyp, dsp_zyp
 
   PUBLIC :: ppinit, manual_0D_bcast, manual_3D_bcast, init_parallel_var, &
-            gather_xyz, gather_pjz, gather_pjxyz, exchange_ghosts_1D
+            gather_xyz, gather_xyz_real, gather_pjz, gather_pjxyz, exchange_ghosts_1D
 
 CONTAINS
 
@@ -245,6 +245,42 @@ CONTAINS
     ENDIF
   END SUBROUTINE gather_xyz
   
+  SUBROUTINE gather_xyz_real(field_loc,field_tot,nky_loc,nky_tot,nkx_tot,nz_loc,nz_tot)
+    IMPLICIT NONE
+    INTEGER, INTENT(IN) :: nky_loc,nky_tot,nkx_tot,nz_loc,nz_tot
+    REAL(xp), DIMENSION(:,:,:), INTENT(IN)  :: field_loc
+    REAL(xp), DIMENSION(:,:,:), INTENT(OUT) :: field_tot
+    REAL(xp), DIMENSION(nky_tot,nz_loc) :: buffer_yt_zl !full  y, local z
+    REAL(xp), DIMENSION(nky_tot,nz_tot) :: buffer_yt_zt !full  y, full  z
+    REAL(xp), DIMENSION(nky_loc):: buffer_yl_zc !local y, constant z
+    REAL(xp), DIMENSION(nky_tot):: buffer_yt_zc !full  y, constant z
+    INTEGER :: snd_y, snd_z, root_p, root_z, root_ky, ix, iz
+
+    snd_y  = nky_loc    ! Number of points to send along y (per z)
+    snd_z  = nky_tot*nz_loc ! Number of points to send along z (full y)
+    root_p = 0; root_z = 0; root_ky = 0
+    IF(rank_p .EQ. root_p) THEN
+      DO ix = 1,nkx_tot
+        DO iz = 1,nz_loc
+          ! fill a buffer to contain a slice of data at constant kx and z
+          buffer_yl_zc(1:nky_loc) = field_loc(1:nky_loc,ix,iz)
+          CALL MPI_GATHERV(buffer_yl_zc, snd_y,        mpi_xp_r, &
+                           buffer_yt_zc, rcv_y, dsp_y, mpi_xp_r, &
+                           root_ky, comm_ky, ierr)
+          buffer_yt_zl(1:nky_tot,iz) = buffer_yt_zc(1:nky_tot)
+        ENDDO
+        ! send the full line on y contained by root_ky
+        IF(rank_ky .EQ. root_ky) THEN
+          CALL MPI_GATHERV(buffer_yt_zl, snd_z,          mpi_xp_r, &
+                           buffer_yt_zt, rcv_zy, dsp_zy, mpi_xp_r, &
+                           root_z, comm_z, ierr)
+        ENDIF
+        ! ID 0 (the one who output) rebuild the whole array
+        IF(my_id .EQ. 0) &
+          field_tot(1:nky_tot,ix,1:nz_tot) = buffer_yt_zt(1:nky_tot,1:nz_tot)
+      ENDDO
+    ENDIF
+  END SUBROUTINE gather_xyz_real
 
   !!!!! Gather a field in kinetic + z coordinates on rank 0 !!!!!
   SUBROUTINE gather_pjz(field_loc,field_tot,na_tot,np_loc,np_tot,nj_tot,nz_loc,nz_tot)