diff --git a/src/restart_mod.f90 b/src/restart_mod.f90
index 27ec4dd..6ce6dbd 100644
--- a/src/restart_mod.f90
+++ b/src/restart_mod.f90
@@ -1,340 +1,345 @@
 MODULE restart
   ! restart module
   !
   ! write restart.me.h5 per MPI process containing the indices of the last computed matrix entries of the GK Coulomb coll.
   ! Note :  - Called only if IFCOULOMB and IFGK 
   !         - Can be extended to other coll operator
 
   USE prec_const
   use basic_mpi
   use basic
   use model
   use futils
   use grid 
 
   IMPLICIT NONE
 
   PRIVATE 
 
   logical :: restart_idx_exist
   logical :: restart_cabpj_exist
   logical,public :: restart_from = .false.
 
   LOGICAL, PUBLIC, PROTECTED :: ifrestart
   ! nsave
   INTEGER, public, PROTECTED :: nsave_ee,nsave_ii,nsave_ei,nsave_ie
 
   character(len=40),save :: rst_indices_file
   character(len=40),save :: rst_Cabpj_file 
   character(len=*),parameter :: FMTindicesDK = "(I2,',',I2)"
   character(len=*),parameter :: FMTindicesGK = "(5(I2,','))"
   character(len=*),parameter :: FMTCabpj = "(2(I3,','),(E25.18E2))"
   character(len=*),parameter :: FMTCabpjGK = "(5(I3,','),(E25.18E2))"
   character(len=*),parameter :: FMTCabpjjGK = "(3(I3,','),(E25.18E2))"
 
   ! local restart indices
   integer,public,save :: l_rst_l,k_rst_l
   integer,public,save :: j_rst_l,n_rst_l,np_rst_l
   integer, public,save:: row_rst_l
 
 
   INTERFACE write_restart_Cabpj
      MODULE PROCEDURE write_restart_DK_Cabpj
      MODULE PROCEDURE write_restart_GK_Cabpj_3dim
      MODULE PROCEDURE write_restart_GK_Cabpj_5dim
   END INTERFACE
 
   INTERFACE restart_out
      MODULE PROCEDURE restart_out_DK
      MODULE PROCEDURE restart_out_GK_3dim
      MODULE PROCEDURE restart_out_GK_5dim
   END INTERFACE restart_out
 
   INTERFACE get_restart
      MODULE PROCEDURE get_restart_DK
      MODULE PROCEDURE get_restart_GK_5dim
      MODULE PROCEDURE get_restart_GK_3dim   
   END INTERFACE get_restart
 
   ! public routines
   public :: restart_init,restart_out,get_restart, read_restart
 
 CONTAINS
   !
   SUBROUTINE read_restart
     ! read output namelist
 
     use prec_const
     IMPLICIT NONE
 
     logical :: outdir_exist
 
     NAMELIST /RESTART_PAR/ nsave_ei,nsave_ie,nsave_ee,nsave_ii,ifrestart
     !                            READ INPUT OUTPUT
     IF( me .ne. 0 ) GOTO 110
     READ(lu_in,restart_par)
     WRITE(*,restart_par)
 110 CONTINUE
     !
     CALL MPI_bcast(nsave_ei,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
     CALL MPI_bcast(nsave_ie,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
     CALL MPI_bcast(nsave_ee,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
     CALL MPI_bcast(nsave_ii,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
     CALL MPI_bcast(ifrestart,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
     !
   end SUBROUTINE read_restart
   !
   !---------------------------------------------------
   !
   subroutine restart_out_DK(Cabpj,current_indices)
     ! output restart
     implicit none
     !
     real(dp),dimension(:,:),intent(in) :: Cabpj
     integer,dimension(:),intent(in) :: current_indices
     !
     call write_restart_indices(current_indices)
     call write_restart_Cabpj(Cabpj)
     !
     !
   end subroutine restart_out_DK
   !
   subroutine restart_out_GK_5dim(Cabpj,current_indices)
     ! output restart
     implicit none
     !
     real(dp),dimension(:,:,:,:,:),intent(in) :: Cabpj
     integer,dimension(:),intent(in) :: current_indices
     !
     call write_restart_indices(current_indices)
     call write_restart_Cabpj(Cabpj)
     !
     !
     !
   end subroutine restart_out_GK_5dim
   !
   subroutine restart_out_GK_3dim(Cabpj,current_indices)
     ! output restart
     implicit none
     !
     real(dp),dimension(:,:,:),intent(in) :: Cabpj
     integer,dimension(:),intent(in) :: current_indices
     !
     call write_restart_indices(current_indices)
     call write_restart_Cabpj(Cabpj)
     !
     !
     !
   end subroutine restart_out_GK_3dim
   !
   subroutine restart_init(dirCab)
     !
     ! create restart file 
     !
     implicit none
     !
     CHARACTER(len=*), INTENT(IN) :: dirCab
     ! local vars.
     INTEGER :: dims(1)
     INTEGER :: rank
     !
     ! create restart file name in restart dir
     
     rst_indices_file = './restart/'//  trim(adjustl(dirCab)) // '/'//trim(adjustl('restart_idx.'//trim(adjustl(me_str))//'.rst'))
     rst_cabpj_file = './restart/'//  trim(adjustl(dirCab))  //  '/' //trim(adjustl('restart_Cabpj.'//trim(adjustl(me_str))//'.rst')) 
     !
     ! Inquire restart file
     INQUIRE(FILE=rst_indices_file,EXIST=restart_idx_exist)
     INQUIRE(FILE=rst_Cabpj_file,EXIST=restart_cabpj_exist)
     !
     IF( (restart_idx_exist .and. .not. restart_cabpj_exist) &
          .or. (.not. restart_idx_exist .and. restart_cabpj_exist)) THEN 
        ERROR STOP("Missing a restart file @ me = ',me")
        CALL MPI_abort(mpi_comm_world,-1,ierr)
     ENDIF
     !
     IF(restart_idx_exist .and. restart_cabpj_exist) THEN 
        restart_from = .true.
        WRITE(*,*) 'Restart me =',me, ' from ',rst_indices_file, ' and ',rst_cabpj_file
     ELSE
        restart_from = .false.
        IF( me .eq. 0 ) WRITE(*,*) 'Restart init ...' 
     ENDIF
     !
+    !                  ..... MPI WAIT ....
+    CALL mpi_barrier(MPI_COMM_WORLD,ierr)
     !
   end subroutine restart_init
   !_____________________________________________________________
   !
   subroutine write_restart_indices(current_indices)
     ! write restart indices
     implicit none
     !
     integer, dimension(:),intent(in):: current_indices ! current Hermite and Laguerre indices
     integer,save:: fid_
     !
     ! local var.
     ! append current indices in restart file
     OPEN(fid_,FILE=rst_indices_file)
     WRITE(fid_,*) current_indices(1)
     ! Previous implementation
     ! IF(size(current_indices) .eq. 2 )  WRITE(fid_,FMTindicesGK) current_indices(1), current_indices(2),0 ,0,0 
 
     ! IF(size(current_indices) .eq. 5 )  WRITE(fid_,FMTindicesGK) current_indices(1),current_indices(2),current_indices(3),current_indices(4),current_indices(5)
 
     ! IF(size(current_indices) .eq. 3 )  WRITE(fid_,FMTindicesGK) current_indices(1),current_indices(2), current_indices(3),0,0
     CLOSE(fid_) 
     !
   end subroutine write_restart_indices
   !_____________________________________________________________
   !
   subroutine write_restart_DK_Cabpj(Cabpj)
     ! write restart DK Cabpj
     implicit none
     !
     real(dp),dimension(:,:),intent(in) :: Cabpj
     ! local vars
     integer,save :: fid
     integer :: l,k,dim_
     !
     OPEN(fid,FILE= rst_Cabpj_file)
     ! Print the collisional matrix
     DO l=1,size(Cabpj,1)
        DO k=1,size(Cabpj,2)
           WRITE(fid,FMTCabpj) l,k,Cabpj(l,k)
        ENDDO
     ENDDO
     CLOSE(fid)
     !
   end subroutine 
   !
   subroutine write_restart_GK_Cabpj_5dim(Cabpj)
     ! write restart GK Cabpj
     ! note: - used to restart GK Coulomb
     implicit none
     !
     real(dp),dimension(:,:,:,:,:),intent(in) :: Cabpj
     ! local vars
     integer,save :: fid
     integer :: l,k,j,n,np,dim_
     !
     OPEN(fid,FILE= rst_Cabpj_file)
     DO l=1,size(Cabpj,1)
        DO k=1,size(Cabpj,2)
           DO j=1,size(Cabpj,3)
              DO n=1, size(Cabpj,4)
                 DO np=1, size(Cabpj,5)
                    WRITE(fid,FMTCabpjGK) l,k,j,n,np,Cabpj(l,k,j,n,np)
                 ENDDO
              ENDDO
           ENDDO
        ENDDO
     ENDDO
     CLOSE(fid)
     !
   end subroutine write_restart_GK_Cabpj_5dim
 
   subroutine write_restart_GK_Cabpj_3dim(Cabpj)
     ! write restart GK Cabpj
     ! note: - used to restart GK Coulomb
     implicit none
     !
     real(dp),dimension(:,:,:),intent(in) :: Cabpj
     ! local vars
     integer,save :: fid
     integer :: l,k,j,dim_
     !
     OPEN(fid,FILE= rst_Cabpj_file)
     DO l=1,size(Cabpj,1)
        DO k=1,size(Cabpj,2)
           DO j=1,size(Cabpj,3)
                    WRITE(fid,FMTCabpjjGK) l,k,j,Cabpj(l,k,j)
           ENDDO
        ENDDO
     ENDDO
     CLOSE(fid)
     !
   end subroutine write_restart_GK_Cabpj_3dim
   !
   subroutine get_restart_DK(Cabpj)
     !
     ! get indices from restart file for local matrix
     implicit none
     !
     real(dp),dimension(:,:),intent(inout) :: Cabpj
     ! loc vars
     integer :: fid,ENDOF
     integer :: l,k
     real(dp) :: buff_
 
     ! open indices restart files
     OPEN(fid,FILE = rst_indices_file)    
     READ(fid,*) row_rst_l
     CLOSE(fid)
 
     write(*,*) 'Restart me =', me, ' at row = ',row_rst_l
 
-   ! get restart local Cabpj
+    ! get restart local Cabpj
     OPEN(fid,FILE = rst_Cabpj_file)
     ENDOF = 0
     DO WHILE(ENDOF .eq. 0) 
        READ(fid,*,IOSTAT=ENDOF) l,k,buff_
        ! allocate to matrix
        Cabpj(l,k) = buff_
     ENDDO
     CLOSE(fid)
     !
+    !                  ..... MPI WAIT ....
+    CALL mpi_barrier(MPI_COMM_WORLD,ierr)
+    !
   end subroutine get_restart_DK
   !
   subroutine get_restart_GK_5dim(Cabpj)
     !
     ! get indices from restart file for local GK matrix
     implicit none
     !
     real(dp),dimension(:,:,:,:,:),intent(inout) :: Cabpj
     ! loc vars
     integer,save :: fid
     integer :: l,k,j,n,np,ENDOF
     real(dp) :: buff_
     ! open indices restart files
     OPEN(fid,FILE = rst_indices_file)    
     READ(fid,*) l_rst_l,k_rst_l,j_rst_l,n_rst_l,np_rst_l
     CLOSE(fid)
     !! print*,l_rst_l,k_rst_l,j_rst_l,n_rst_l,np_rst_l    
     ! get restart local Cabpj
     OPEN(fid,FILE = rst_Cabpj_file)
     ENDOF = 0
     DO WHILE(ENDOF .eq. 0) 
        READ(fid,*,IOSTAT=ENDOF) l,k,j,n,np,buff_
        ! allocate to matrix
        Cabpj(l,k,j,n,np) = buff_       
     ENDDO
     CLOSE(fid)
     !
   end subroutine get_restart_GK_5dim
   !
   subroutine get_restart_GK_3dim(Cabpj)
     !
     ! get indices from restart file for local GK matrix
     implicit none
     !
     real(dp),dimension(:,:,:),intent(inout) :: Cabpj
     ! loc vars
     integer :: fid,ENDOF
     integer :: l,k,j,n,np
     real(dp) :: buff_
     ! open indices restart files
     OPEN(fid,FILE = rst_indices_file)    
     READ(fid,*) l_rst_l,k_rst_l,j_rst_l,n_rst_l,np_rst_l
     CLOSE(fid)
     ! get restart local Cabpj
     OPEN(fid,FILE = rst_Cabpj_file)
     ENDOF = 0
     DO WHILE(ENDOF .eq. 0) 
        READ(fid,*,IOSTAT=ENDOF) l,k,j,buff_
        ! allocate to matrix
        Cabpj(l,k,j) = buff_       
     ENDDO
-    
+
   end subroutine get_restart_GK_3dim
   !
 END MODULE restart