restart_io.f90

!!$!================================================================================
!!$!================================================================================
!!$!================================================================================
!!$subroutine restart_read
!!$
!!$  use m_openmpi
!!$  use m_parameters
!!$  use m_io
!!$  use m_fields
!!$  use m_work
!!$  use x_fftw
!!$  use m_particles
!!$  implicit none
!!$
!!$  integer*4    :: nx1,ny1,nz1, nums1, MST1, nums_read
!!$  integer      :: i, j, k, n
!!$
!!$  real*8 :: ST
!!$
!!$  fname = run_name//'.64.'//file_ext
!!$  inquire(file=fname,exist=there)
!!$  if(.not.there) then
!!$     write(out,*) '*** error: Cannot find file : '//trim(fname)
!!$     stop
!!$  end if
!!$
!!$  write(out,*) 'Reading from the file (seq): ',trim(fname)
!!$  call flush(out)
!!$
!!$  ! root process reads parameters from the file
!!$  if (myid_world.eq.0) then
!!$     open(91,file=fname,form='unformatted',access='stream')
!!$     read(91) nx1, ny1, nz1, nums1, MST1, TIME, DT
!!$  end if
!!$
!!$  call MPI_BCAST(nx1,  1,MPI_INTEGER4,0,MPI_COMM_WORLD,mpi_err)
!!$  call MPI_BCAST(ny1,  1,MPI_INTEGER4,0,MPI_COMM_WORLD,mpi_err)
!!$  call MPI_BCAST(nz1,  1,MPI_INTEGER4,0,MPI_COMM_WORLD,mpi_err)
!!$  call MPI_BCAST(nums1,1,MPI_INTEGER4,0,MPI_COMM_WORLD,mpi_err)
!!$
!!$  call MPI_BCAST(TIME,1,MPI_REAL8,0,MPI_COMM_WORLD,mpi_err)
!!$  call MPI_BCAST(  DT,1,MPI_REAL8,0,MPI_COMM_WORLD,mpi_err)
!!$
!!$  ! everyone checks of the parameters coinside with what's in the .in file
!!$  if (nx.ne.nx1 .or. ny.ne.ny1 .or. nz_all.ne.nz1) then
!!$     write(out,*) '*** error: Dimensions are different'
!!$     write(out,*) '***     .in file: ',nx,ny,nz_all
!!$     write(out,*) '*** restart file: ',nx1,ny1,nz1
!!$     call flush(out)
!!$     stop
!!$  end if
!!$
!!$!-----------------------------------------------------------------------
!!$!     dealing with scalars.
!!$!     
!!$!     The number of scalars can be varied throughout the simulation.
!!$!     If the restart file has fewer scalars than the 
!!$!     .in file, the scalars are added and initialized according to
!!$!     their description in the .in-file.  
!!$!     If the restart file has more scalars than the .in file, the
!!$!     extra scalars are dropped.
!!$!     
!!$!     in short, whatever is specfied in the .in file, prevails.
!!$!-----------------------------------------------------------------------
!!$
!!$  if (n_scalars.lt.nums1) then
!!$
!!$     write(out,*) ' WARNING: nums in restart file:',nums1
!!$     write(out,*) '          nums in .in file    :',n_scalars
!!$     write(out,'(''Losing '',i3,'' scalars.'')') nums1-n_scalars
!!$     call flush(out)
!!$     nums_read = n_scalars
!!$
!!$  else if (n_scalars.gt.nums1) then
!!$
!!$     write(out,*) ' WARNING: nums in restart file:',nums1
!!$     write(out,*) '          nums in .in file    :',n_scalars
!!$     write(out,'(''Adding '',i3,'' scalars.'')') n_scalars-nums1
!!$     call flush(out)
!!$     nums_read = nums1
!!$
!!$
!!$  else
!!$
!!$     nums_read = n_scalars
!!$
!!$  end if
!!$
!!$!----------------------------------------------------------------------
!!$!  ------------ reading the stuff from the restart file ---------------
!!$!----------------------------------------------------------------------
!!$
!!$  ! only the hydro part of processors is involved in this
!!$  hydro_only: if (task.eq.'hydro') then
!!$     count = (nx+2) * ny * nz
!!$     ! the root reads everything and sends to the slaves
!!$     if (myid.eq.0) then
!!$        do n = 1, 3 + nums_read + n_les
!!$           ! first chunk belongs to the root
!!$           read(91) (((fields(i,j,k,n),i=1,nx),j=1,ny),k=1,nz)
!!$           ! the rest gets read and sent to the appropriate porcess
!!$           do id_to = 1,numprocs-1
!!$              read(91) (((wrk(i,j,k,1),i=1,nx),j=1,ny),k=1,nz)
!!$              tag = (3+nums_read) * id_to + n-1
!!$              call MPI_SEND(wrk(1,1,1,1),count,MPI_REAL8,id_to,tag,MPI_COMM_TASK,mpi_err)
!!$
!!$
!!$           end do
!!$        end do
!!$        ! then the root closes the restart file
!!$        close(91)
!!$     else
!!$        ! the slaves receive and put it into ss array
!!$        do n = 1, 3 + nums_read + n_les
!!$           tag = (3+nums_read) * myid + n-1
!!$           call MPI_RECV(fields(1,1,1,n),count,MPI_REAL8,0,tag,MPI_COMM_TASK,mpi_status,mpi_err)
!!$        end do
!!$     end if
!!$
!!$  end if hydro_only
!!$
!!$  return
!!$end subroutine restart_read
!!$
!!$
!!$
!!$
!!$!================================================================================
!!$!================================================================================
!!$!================================================================================
!!$subroutine restart_write
!!$
!!$!  This routine is called to GENERATE RESTART FILES  
!!$!  The file is written without MPI-2 tricks
!!$!  the stuff gets sent to the root process adn written out in
!!$!  some orderly fashion
!!$
!!$  use m_openmpi
!!$  use m_parameters
!!$  use m_io
!!$  use m_fields
!!$  use m_work
!!$  use x_fftw
!!$  implicit none
!!$
!!$  integer :: n, nums_out, i, j, k
!!$
!!$  real*8 :: ST
!!$  integer :: MST
!!$
!!$  if (itime.eq.last_dump) return
!!$
!!$
!!$!---------------------------------------------------------------------
!!$!     dumping the restart file with particles
!!$!---------------------------------------------------------------------
!!$!  if (int_particles) call particles_restart_write
!!$!  if (int_particles) call particles_restart_write_binary
!!$
!!$  ! how many scalars to write
!!$  nums_out = 0
!!$  if (int_scalars) nums_out = n_scalars
!!$
!!$  ! first FFT everything to real space
!!$  wrk(:,:,:,1:3+nums_out+n_les) = fields(:,:,:,1:3+nums_out+n_les)
!!$
!!$  ! --------------- writing process ------------------
!!$
!!$  fname = run_name//'.64.'//file_ext
!!$
!!$  ! if not the root, just send the stuff to the root
!!$  if (myid.ne.0) then
!!$
!!$     do n = 1 , 3 + nums_out + n_les
!!$
!!$        wrk(:,:,:,0) = wrk(:,:,:,n)
!!$        tag = (3+nums_out+n_les) * myid + n-1
!!$        count = (nx+2) * ny * nz
!!$        call MPI_ISEND(wrk(1,1,1,0),count,MPI_REAL8,0,tag,MPI_COMM_TASK,request,mpi_err)
!!$
!!$!        write(out,'(''sending var '',i3,'' to '',i4,'': '',i3)') n,0,mpi_err
!!$!        call flush(out)
!!$
!!$        call MPI_WAIT(request,mpi_status,mpi_err)
!!$
!!$!        write(out,'(''sent var '',i3,'' to '',i4,'': '',i3)') n,0,mpi_err
!!$!        call flush(out)
!!$
!!$     end do
!!$
!!$  else
!!$     ! if it's the root, then write the restart file
!!$!!     open(91,file=fname,form='binary')
!!$     open(91,file=fname,form='unformatted', access='stream')
!!$
!!$     ! first write the parameters
!!$     ST = zip
!!$     write(91) int(nx,4),int(ny,4),int(nz*numprocs,4),int(nums_out,4),int(MST,4),TIME,DT
!!$
!!$     ! then write the variables, one by one
!!$     do n = 1 , 3 + nums_out + n_les
!!$
!!$        ! first write the chunk from the root process
!!$        wrk(:,:,:,0) = wrk(:,:,:,n)
!!$        write(91) (((wrk(i,j,k,0),i=1,nx),j=1,ny),k=1,nz)
!!$        ! then receive chinks of the same variable from each process and write it out
!!$        do id_from=1,numprocs-1
!!$           tag = (3+nums_out+n_les) * id_from + n-1
!!$           count = (nx+2) * ny * nz
!!$           call MPI_RECV(wrk(1,1,1,0),count,MPI_REAL8,id_from,tag,MPI_COMM_TASK,mpi_status,mpi_err)
!!$
!!$!           write(out,'(''received var '',i3,'' from '',i4,'': '',i3)') n,id_from,mpi_err
!!$!           call flush(out)
!!$
!!$           write(91) (((wrk(i,j,k,0),i=1,nx),j=1,ny),k=1,nz)
!!$        end do
!!$     end do
!!$     close(91)
!!$
!!$  end if
!!$
!!$  write(out,*) '------------------------------------------------'
!!$  write(out,*) 'Restart file written (seq): '//trim(fname)
!!$  write(out,"(' Velocities and ',i3,' scalars (incl. LES)')") nums_out+n_les
!!$  write(out,"(' Restart file time = ',f15.10,i7)") time,itime
!!$  write(out,*) '------------------------------------------------'
!!$  call flush(out)
!!$
!!$
!!$  ! setting the variable last_dump to current timestep number 
!!$  last_dump = ITIME
!!$
!!$  return
!!$end subroutine restart_write
!!$
!!$
!================================================================================
!================================================================================
!================================================================================
subroutine restart_write_parallel

!  This routine is called to GENERATE RESTART FILES  
!  The file is written using the collective write (MPI-2 standard)

  use m_openmpi
  use m_parameters
  use m_io
  use m_fields
  use m_work
  use x_fftw
  implicit none

  integer :: n, nums_out, i, j, k

  integer :: MST
  integer(kind=MPI_INTEGER_KIND) :: fh
  integer(kind=MPI_OFFSET_KIND)  :: offset
  real*8, allocatable :: sctmp8(:,:,:)

  integer*4 :: nx1, ny1, nz1, nums1, nles1
  real*8 :: ST

  if (itime.eq.last_dump) return

  ! how many scalars to write
  nums_out = 0
  if (int_scalars) nums_out =  n_scalars

  ! using wrk array
  wrk(:,:,:,1:3+nums_out) = fields(:,:,:,1:3+nums_out)
  if (n_les>0) wrk(:,:,:,3+nums_out+1:3+nums_out+n_les) = fields(:,:,:,3+n_scalars+1:3+n_scalars+n_les)

  ! --------------- writing process ------------------

  fname = run_name//'.64.'//file_ext

  ! allocating the temporary array sctmp8
  allocate(sctmp8(nx,ny,nz),stat=ierr)
  if (ierr.ne.0) stop '*** RESTART_READ_PARALLEL: cannot allocate sctmp8'
  sctmp8 = zip

  ! opening the file
  call MPI_INFO_CREATE(mpi_info, mpi_err)
  call MPI_FILE_OPEN(MPI_COMM_TASK,fname,MPI_MODE_WRONLY+MPI_MODE_CREATE,mpi_info,fh,mpi_err)

  ! the master node writes the header with parameters
  if (myid.eq.0) then
     nx1 = nx;  ny1 = ny;  nz1 = nz_all;  nles1 = n_les;  nums1 = nums_out;
     count = 1
     ST = zip
     call MPI_FILE_WRITE(fh,   nx1, count, MPI_INTEGER4, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh,   ny1, count, MPI_INTEGER4, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh,   nz1, count, MPI_INTEGER4, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh, nums1, count, MPI_INTEGER4, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh, nles1, count, MPI_INTEGER4, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh,  TIME, count, MPI_REAL8, mpi_status, mpi_err)
     call MPI_FILE_WRITE(fh,    DT, count, MPI_REAL8, mpi_status, mpi_err)
  end if

  ! all nodes write their stuff into the file
  ! first writing the velocities and passive scalars
  writing_fields: do n = 1, 3 + nums_out + n_les

     offset = 36 + (n-1)*nx*ny*nz_all*8 + myid*nx*ny*nz*8
     count = nx * ny * nz
     ! note that we want the data from the restart to have dimensions (nx,ny,nz),
     ! while the fields array has fimensions (nx+2,ny,nz).
     ! this is an artefact of the times when the code used to write the variables in real space.
     ! that is why we need to duplicate each field in the sctmp array first, and then
     ! write sctmp8 into the file with appropriate offset

     sctmp8(1:nx,1:ny,1:nz) = wrk(1:nx,1:ny,1:nz,n)

     call MPI_FILE_WRITE_AT(fh, offset, sctmp8, count, MPI_REAL8, mpi_status, mpi_err)

  end do writing_fields
  

  call MPI_FILE_CLOSE(fh, mpi_err)
  call MPI_INFO_FREE(mpi_info, mpi_err)
  deallocate(sctmp8)

  write(out,*) '------------------------------------------------'
  write(out,*) 'Restart file written (par): '//trim(fname)
  write(out,"(' Velocities and ',i3,' passive scalars')") nums_out
  if (n_les>0) write(out,"(' Also wrote',i3,' LES scalars)')") n_les
  write(out,"(' Restart file time = ',f15.10,i7)") time, itime
  write(out,*) '------------------------------------------------'
  call flush(out)

  last_dump = ITIME

  return
end subroutine restart_write_parallel

!================================================================================
!================================================================================
!================================================================================
!================================================================================

subroutine restart_read_parallel

  use m_openmpi
  use m_parameters
  use m_io
  use m_fields
  use m_work
  use x_fftw
  use m_particles
  implicit none

  integer*4    :: nx1,ny1,nz1, nums1, nles1, nums_read
  integer      :: i, j, k, n, n_skip

  integer(kind=MPI_INTEGER_KIND) :: fh
  integer(kind=MPI_OFFSET_KIND)  :: offset
  real*8, allocatable :: sctmp8(:,:,:)

  ! checking if the restart file exists
  fname = run_name//'.64.'//file_ext
  inquire(file=fname,exist=there)
  if(.not.there) then
     write(out,*) '*** error: Cannot find file : '//trim(fname)
     stop
  end if

  write(out,*) 'Reading from the file (par): ',trim(fname)
  call flush(out)

  ! ----------------------------------------------------------------------
  ! first reading the parameters from the restart file.
  ! the root process opens it and reads the parameters, then broadcasts 
  ! the parameters.  After that it's decided if the parameters make sense,
  ! how many scalars to read etc.
  ! ----------------------------------------------------------------------

  if (myid.eq.0) then
     open(91,file=fname,form='unformatted',access='stream')
     read(91) nx1, ny1, nz1, nums1, nles1, TIME, DT
     close(91)
  end if

  call MPI_BCAST(nx1,  1,MPI_INTEGER4,0,MPI_COMM_TASK,mpi_err)
  call MPI_BCAST(ny1,  1,MPI_INTEGER4,0,MPI_COMM_TASK,mpi_err)
  call MPI_BCAST(nz1,  1,MPI_INTEGER4,0,MPI_COMM_TASK,mpi_err)
  call MPI_BCAST(nums1,1,MPI_INTEGER4,0,MPI_COMM_TASK,mpi_err)
  call MPI_BCAST(nles1,1,MPI_INTEGER4,0,MPI_COMM_TASK,mpi_err)

  call MPI_BCAST(TIME,1,MPI_REAL8,0,MPI_COMM_TASK,mpi_err)
  call MPI_BCAST(  DT,1,MPI_REAL8,0,MPI_COMM_TASK,mpi_err)

  ! checking if the array sizes are the same in .in file and restart file
  if (nx.ne.nx1 .or. ny.ne.ny1 .or. nz_all.ne.nz1) then
     write(out,*) '*** error: Dimensions are different'
     write(out,*) '***     .in file: ',nx,ny,nz_all
     write(out,*) '*** restart file: ',nx1,ny1,nz1
     call flush(out)
     call my_exit(-1)
  end if

  ! checking if the number of LES quantities is the same in .in and restart files
  if (n_les .ne. nles1) then
     write(out,*) '*** WARNING : Different values of n_les:'
     write(out,*) '***     .in file: ',n_les
     write(out,*) '*** restart file: ',nles1
     write(out,*) '*** Make sure you are running the same simulation.'
     call flush(out)
  end if

!-----------------------------------------------------------------------
!     dealing with scalars.
!     
!     The number of scalars can be varied throughout the simulation.
!     If the restart file has fewer scalars than the 
!     .in file, the scalars are added and initialized according to
!     their description in the .in-file.  
!     If the restart file has more scalars than the .in file, the
!     extra scalars are dropped.
!     
!     in short, whatever is specfied in the .in file, prevails.
!-----------------------------------------------------------------------

  if (n_scalars.lt.nums1) then

     write(out,*) ' WARNING: nums in restart file:',nums1
     write(out,*) '          nums in .in file    :',n_scalars
     write(out,'(''Losing '',i3,'' scalars.'')') nums1-n_scalars
     call flush(out)
     nums_read = n_scalars

  else if (n_scalars.gt.nums1) then

     write(out,*) ' WARNING: nums in restart file:',nums1
     write(out,*) '          nums in .in file    :',n_scalars
     write(out,'(''Adding '',i3,'' scalars.'')') n_scalars-nums1
     call flush(out)
     nums_read = nums1

     ! initializing the added scalars
     do n=nums1+1,n_scalars
        call init_scalar(n)
     end do

  else

     nums_read = n_scalars

  end if

!----------------------------------------------------------------------
!  ------------ reading the stuff from the restart file ---------------
!----------------------------------------------------------------------

  ! allocating the temporary array sctmp8
  allocate(sctmp8(nx,ny,nz),stat=ierr)
  if (ierr.ne.0) stop '*** RESTART_READ_PARALLEL: cannot allocate sctmp8'
  sctmp8 = zip

  ! opening the file
  call MPI_INFO_CREATE(mpi_info, mpi_err)
  call MPI_FILE_OPEN(MPI_COMM_TASK,fname,MPI_MODE_RDONLY,mpi_info,fh,mpi_err)

  ! note that the data from the restart file has dimensions (nx,ny,nz),
  ! while the fields array has fimensions (nx+2,ny,nz).  
  ! that is why we need to read each field in the sctmp array first, and then
  ! rearrange it and put into the fields array.

  reading_fields: do n = 1, 3 + nums_read

     write(out,"('Reading variable # ',i3)") n
     call flush(out)

     offset = 36 + (n-1)*nx*ny*nz_all*8 + myid*nx*ny*nz*8
     count = nx * ny * nz
!     call MPI_FILE_READ_AT(fh, offset, sctmp8, count, MPI_REAL8, mpi_status, mpi_err)
     call MPI_FILE_READ_AT_ALL(fh, offset, sctmp8, count, MPI_REAL8, mpi_status, mpi_err)
     fields(1:nx,1:ny,1:nz,n) = sctmp8(1:nx,1:ny,1:nz)
  end do reading_fields

  ! now reading the LES variables.  They are stored after the fields
  ! u,v,w,sc(1...nums1), so we are applying the offset based on the 
  ! number of scalars in the restart file.
  reading_les_fields: do n = 1, n_les

     write(out,"('Reading LES variable # ',i3)") n
     call flush(out)

     n_skip = 3 + nums1
     offset = 36 + (n_skip+n-1)*nx*ny*nz_all*8 + myid*nx*ny*nz*8


     count = nx * ny * nz
!     call MPI_FILE_READ_AT(fh, offset, sctmp8, count, MPI_REAL8, mpi_status, mpi_err)
     call MPI_FILE_READ_AT_ALL(fh, offset, sctmp8, count, MPI_REAL8, mpi_status, mpi_err)
     fields(1:nx,1:ny,1:nz,3+n_scalars+n) = sctmp8(1:nx,1:ny,1:nz)
  end do reading_les_fields

  call MPI_FILE_CLOSE(fh, mpi_err)
  call MPI_INFO_FREE(mpi_info, mpi_err)
  deallocate(sctmp8)

  write(out,*) "Restart file successfully read."
  call flush(out)

  return
end subroutine restart_read_parallel