sample_create_particles Subroutine

public subroutine sample_create_particles()

Uses

  • proc~~sample_create_particles~~UsesGraph proc~sample_create_particles sample_create_particles module~mod_global_parameters mod_global_parameters proc~sample_create_particles->module~mod_global_parameters module~mod_usr_methods mod_usr_methods proc~sample_create_particles->module~mod_usr_methods 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~~sample_create_particles~~CallsGraph proc~sample_create_particles sample_create_particles mpi_allreduce mpi_allreduce proc~sample_create_particles->mpi_allreduce mpi_bcast mpi_bcast proc~sample_create_particles->mpi_bcast proc~find_particle_ipe find_particle_ipe proc~sample_create_particles->proc~find_particle_ipe proc~push_particle_into_particles_on_mype push_particle_into_particles_on_mype proc~sample_create_particles->proc~push_particle_into_particles_on_mype proc~sample_update_payload sample_update_payload proc~sample_create_particles->proc~sample_update_payload proc~unif_01 rng_t%unif_01 proc~sample_create_particles->proc~unif_01 proc~get_igslice get_igslice proc~find_particle_ipe->proc~get_igslice proc~particle_in_domain particle_in_domain proc~find_particle_ipe->proc~particle_in_domain phys_to_conserved phys_to_conserved proc~sample_update_payload->phys_to_conserved proc~interpolate_var interpolate_var proc~sample_update_payload->proc~interpolate_var proc~next rng_t%next proc~unif_01->proc~next proc~mpistop mpistop proc~get_igslice->proc~mpistop proc~interpolate_var->proc~mpistop proc~rotl rotl proc~next->proc~rotl mpi_abort mpi_abort proc~mpistop->mpi_abort

Called by

proc~~sample_create_particles~~CalledByGraph proc~sample_create_particles sample_create_particles proc~particles_create particles_create proc~particles_create->proc~sample_create_particles proc~main main proc~main->proc~particles_create program~agile agile program~agile->proc~main

Source Code

  subroutine sample_create_particles()
    ! initialise the particles (=fixed interpolation points)
    use mod_global_parameters
    use mod_usr_methods, only: usr_create_particles, usr_update_payload,&
        usr_check_particle, usr_particle_position

    integer          :: n, idir, igrid, ipe_particle, nparticles_local
    double precision :: x(3, num_particles)
    double precision :: v(3, num_particles)
    double precision :: q(num_particles)
    double precision :: m(num_particles)
    double precision :: rrd(num_particles,ndir)
    double precision :: w(ixGlo1:ixGhi1,ixGlo2:ixGhi2,ixGlo3:ixGhi3,1:nw)
    double precision :: defpayload(ndefpayload)
    double precision :: usrpayload(nusrpayload) 
    logical          :: follow(num_particles), check

    follow = .false.
    x      = 0.0d0

    if (mype==0) then
      if (.not. associated(usr_create_particles)) then
        ! Randomly distributed
        do idir=1,ndir
          do n = 1, num_particles
            rrd(n,idir) = rng%unif_01()
          end do
        end do
        do n=1, num_particles
          x(1,n) = xprobmin1 + rrd(n+1,1) * (xprobmax1 - xprobmin1)
          x(2,n) = xprobmin2 + rrd(n+1,2) * (xprobmax2 - xprobmin2)
          x(3,n) = xprobmin3 + rrd(n+1,3) * (xprobmax3 - xprobmin3)
        end do
      else
        call usr_create_particles(num_particles, x, v, q, m, follow)
      end if
    end if

    call MPI_BCAST(x,3*num_particles,MPI_DOUBLE_PRECISION,0,icomm,ierrmpi)
    call MPI_BCAST(follow,num_particles,MPI_LOGICAL,0,icomm,ierrmpi)

    nparticles_local = 0

    do n=1,num_particles
      call find_particle_ipe(x(:,n),igrid,ipe_particle)
      particle(n)%igrid  = igrid
      particle(n)%ipe    = ipe_particle

      if(ipe_particle == mype) then
        check = .true.

        ! Check for user-defined modifications or rejection conditions
        if (associated(usr_check_particle)) call usr_check_particle(igrid, x(:,&
           n), v(:,n), q(n), m(n), follow(n), check)
        if (check) then
          call push_particle_into_particles_on_mype(n)
        else
          cycle
        end if

        nparticles_local = nparticles_local + 1

        allocate(particle(n)%self)
        particle(n)%self%follow = follow(n)
        particle(n)%self%index  = n
        particle(n)%self%time   = global_time
        particle(n)%self%dt     = 0.0d0
        particle(n)%self%x = 0.d0
        particle(n)%self%x(:) = x(:,n)
        particle(n)%self%u(:) = 0.d0

        allocate(particle(n)%payload(npayload))
        call sample_update_payload(igrid,x(:,n),v(:,n),q(n),m(n),defpayload,&
           ndefpayload,0.d0)
        particle(n)%payload(1:ndefpayload) = defpayload      
        if (associated(usr_update_payload)) then
          call usr_update_payload(igrid,x(:,n),v(:,n),q(n),m(n),usrpayload,&
             nusrpayload,0.d0)
          particle(n)%payload(ndefpayload+1:npayload)=usrpayload
        end if
      end if

    end do

    call MPI_ALLREDUCE(nparticles_local,nparticles,1,MPI_INTEGER,MPI_SUM,icomm,&
       ierrmpi)

  end subroutine sample_create_particles