output_ensemble Subroutine

public subroutine output_ensemble(send_n_particles_for_output, send_particles, send_payload, typefile)

Uses

  • proc~~output_ensemble~~UsesGraph proc~output_ensemble output_ensemble module~mod_global_parameters mod_global_parameters proc~output_ensemble->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

Type IntentOptional Attributes Name
integer, intent(in) :: send_n_particles_for_output
type(particle_t), intent(in), dimension(send_n_particles_for_output) :: send_particles
double precision, intent(in), dimension(npayload,send_n_particles_for_output) :: send_payload
character(len=*), intent(in) :: typefile

Calls

proc~~output_ensemble~~CallsGraph proc~output_ensemble output_ensemble mpi_allgather mpi_allgather proc~output_ensemble->mpi_allgather proc~mpi_recv_wrapper mpi_recv_wrapper proc~output_ensemble->proc~mpi_recv_wrapper proc~mpi_send_wrapper mpi_send_wrapper proc~output_ensemble->proc~mpi_send_wrapper proc~output_particle output_particle proc~output_ensemble->proc~output_particle mpi_recv mpi_recv proc~mpi_recv_wrapper->mpi_recv mpi_send mpi_send proc~mpi_send_wrapper->mpi_send proc~partcoord_to_cartesian partcoord_to_cartesian proc~output_particle->proc~partcoord_to_cartesian

Called by

proc~~output_ensemble~~CalledByGraph proc~output_ensemble output_ensemble proc~destroy_particles destroy_particles proc~destroy_particles->proc~output_ensemble proc~write_particle_output write_particle_output proc~write_particle_output->proc~output_ensemble proc~comm_particles comm_particles proc~comm_particles->proc~destroy_particles proc~handle_particles handle_particles proc~handle_particles->proc~write_particle_output proc~advance_particles advance_particles proc~handle_particles->proc~advance_particles proc~particles_finish particles_finish proc~particles_finish->proc~destroy_particles proc~advance advance proc~advance->proc~handle_particles proc~advance_particles->proc~comm_particles proc~main main proc~main->proc~handle_particles proc~timeintegration timeintegration proc~main->proc~timeintegration proc~timeintegration->proc~advance program~agile agile program~agile->proc~main

Source Code

  subroutine output_ensemble(send_n_particles_for_output,send_particles,&
     send_payload,typefile)
    use mod_global_parameters

    integer, intent(in)             :: send_n_particles_for_output
    type(particle_t), dimension(send_n_particles_for_output),&
        intent(in)  :: send_particles
    double precision, dimension(npayload,send_n_particles_for_output),&
        intent(in)  :: send_payload
    character(len=*), intent(in)    :: typefile
    character(len=std_len)              :: filename
    type(particle_t), allocatable, dimension(:)   :: receive_particles
    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, nout
    logical                         :: file_exists

    receive_n_particles_for_output_from_ipe(:) = 0

    call MPI_ALLGATHER(send_n_particles_for_output, 1, MPI_INTEGER,&
        receive_n_particles_for_output_from_ipe, 1, MPI_INTEGER, icomm,&
        ierrmpi)

    ! If there are no particles to be written, skip the output
    if (sum(receive_n_particles_for_output_from_ipe(:)) == 0) return

    if (mype > 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)
    else
      ! Create file and write header
      if(typefile=='destroy') then ! Destroyed file
        write(filename,"(a,a,i6.6,a)") trim(base_filename) // '_',&
            trim(typefile) // '.csv'
        n_output_destroyed= n_output_destroyed + 1
        inquire(file=filename, exist=file_exists)

        if (.not. file_exists) then
          open(unit=unitparticles, file=filename)
          write(unitparticles,"(a)") trim(csv_header)
        else
          open(unit=unitparticles, file=filename, access='sequential',&
              position='append')
        end if

      else ! Ensemble file
        write(filename,"(a,a,i6.6,a)") trim(base_filename) // '_',&
            trim(typefile) // '_', nint(t_next_output/dtsave_particles),'.csv'
        open(unit=unitparticles,file=filename)
        write(unitparticles,"(a)") trim(csv_header)
      end if

      ! Write own particles
      do ipart=1,send_n_particles_for_output
        call output_particle(send_particles(ipart),send_payload(1:npayload,&
           ipart),0,unitparticles)
      end do

      ! Write particles from other tasks
      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 output_particle(receive_particles(ipart),&
             receive_payload(1:npayload,ipart),ipe,unitparticles)
        end do ! ipart
        deallocate(receive_particles)
        deallocate(receive_payload)
      end do ! ipe

      close(unitparticles)
    end if

  end subroutine output_ensemble