write_particles_snapshot Subroutine

public subroutine write_particles_snapshot()

Uses

  • proc~~write_particles_snapshot~~UsesGraph proc~write_particles_snapshot write_particles_snapshot module~mod_global_parameters mod_global_parameters proc~write_particles_snapshot->module~mod_global_parameters module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

Arguments

None

Calls

proc~~write_particles_snapshot~~CallsGraph proc~write_particles_snapshot write_particles_snapshot proc~append_to_snapshot append_to_snapshot proc~write_particles_snapshot->proc~append_to_snapshot proc~mpi_recv_wrapper mpi_recv_wrapper proc~write_particles_snapshot->proc~mpi_recv_wrapper proc~mpi_send_wrapper mpi_send_wrapper proc~write_particles_snapshot->proc~mpi_send_wrapper mpi_recv mpi_recv proc~mpi_recv_wrapper->mpi_recv mpi_send mpi_send proc~mpi_send_wrapper->mpi_send

Called by

proc~~write_particles_snapshot~~CalledByGraph proc~write_particles_snapshot write_particles_snapshot proc~saveamrfile saveamrfile proc~saveamrfile->proc~write_particles_snapshot proc~timeintegration timeintegration proc~timeintegration->proc~saveamrfile proc~main main proc~main->proc~timeintegration program~agile agile program~agile->proc~main

Source Code

  subroutine write_particles_snapshot()
    use mod_global_parameters

    character(len=std_len)          :: filename
!    type(particle_t), dimension(nparticles_per_cpu_hi)  :: send_particles
!    type(particle_t), dimension(nparticles_per_cpu_hi)  :: receive_particles
!    double precision, dimension(npayload,nparticles_per_cpu_hi)  :: send_payload
!    double precision, dimension(npayload,nparticles_per_cpu_hi)  :: receive_payload
    type(particle_t), allocatable, dimension(:)  :: send_particles
    type(particle_t), allocatable, dimension(:)  :: receive_particles
    double precision, allocatable, dimension(:,:)  :: send_payload
    double precision, allocatable, dimension(:,:)  :: receive_payload
    integer                         :: status(MPI_STATUS_SIZE)
    integer,dimension(0:npe-1)      :: receive_n_particles_for_output_from_ipe
    integer                         :: ipe, ipart, iipart,&
        send_n_particles_for_output
    logical,save                    :: file_exists=.false.

    if (.not. write_snapshot) return

    receive_n_particles_for_output_from_ipe(:) = 0

    ! open the snapshot file on the headnode
    if (mype .eq. 0) then
      write(filename,"(a,a,i4.4,a)") trim(base_filename),'_particles',&
         snapshotnext,'.dat'
      INQUIRE(FILE=filename, EXIST=file_exists)
      if (.not. file_exists) then
        open(unit=unitparticles,file=filename,form='unformatted',status='new',&
           access='stream')
      else
        open(unit=unitparticles,file=filename,form='unformatted',&
           status='replace',access='stream')
      end if
      write(unitparticles) nparticles,it_particles,npayload
    end if
    if (npe==1) then
      do iipart=1,nparticles_on_mype;ipart=particles_on_mype(iipart);
        call append_to_snapshot(particle(ipart)%self,particle(ipart)%payload)
      end do
      return
    end if

    if (mype .ne. 0) then
      call mpi_send_wrapper(nparticles_on_mype,1,MPI_INTEGER,0,mype,icomm,ierrmpi)
      ! fill the send_buffer
      send_n_particles_for_output = nparticles_on_mype
      allocate(send_particles(1:send_n_particles_for_output))
      allocate(send_payload(1:npayload,1:send_n_particles_for_output))
      do iipart=1,nparticles_on_mype;ipart=particles_on_mype(iipart);
        send_particles(iipart) = particle(ipart)%self
        send_payload(1:npayload,iipart) = particle(ipart)%payload(1:npayload)
      end do
    else
      ! get number of particles on other ipes
      do ipe=1,npe-1
        call mpi_recv_wrapper(receive_n_particles_for_output_from_ipe(ipe),1,&
           MPI_INTEGER,ipe,ipe,icomm,status,ierrmpi)
      end do
    end if

    if (mype .ne. 0) then
      call mpi_send_wrapper(send_particles,send_n_particles_for_output,type_particle,0,&
         mype,icomm,ierrmpi)
      call mpi_send_wrapper(send_payload,npayload*send_n_particles_for_output,&
         MPI_DOUBLE_PRECISION,0,mype,icomm,ierrmpi)
      deallocate(send_particles)
      deallocate(send_payload)
    end if

    if (mype==0) then
      ! first output own particles (already in receive buffer)
      do iipart=1,nparticles_on_mype;ipart=particles_on_mype(iipart);
        call append_to_snapshot(particle(ipart)%self,particle(ipart)%payload)
      end do
      ! now output the particles sent from the other ipes
      do ipe=1,npe-1
        allocate(receive_particles(1:receive_n_particles_for_output_from_ipe(&
           ipe)))
        allocate(receive_payload(1:npayload,&
           1:receive_n_particles_for_output_from_ipe(ipe)))
        call mpi_recv_wrapper(receive_particles&
           ,receive_n_particles_for_output_from_ipe(ipe),type_particle,ipe,ipe,&
           icomm,status,ierrmpi)
        call mpi_recv_wrapper(receive_payload&
           ,npayload*receive_n_particles_for_output_from_ipe(ipe),&
           MPI_DOUBLE_PRECISION,ipe,ipe,icomm,status,ierrmpi)
        do ipart=1,receive_n_particles_for_output_from_ipe(ipe)
          call append_to_snapshot(receive_particles(ipart),&
             receive_payload(1:npayload,ipart))
        end do ! ipart
        deallocate(receive_particles)
        deallocate(receive_payload)
      end do ! ipe
      close(unit=unitparticles)
    end if ! mype == 0

  end subroutine write_particles_snapshot