advect_create_particles Subroutine

public subroutine advect_create_particles()

Uses

  • proc~~advect_create_particles~~UsesGraph proc~advect_create_particles advect_create_particles module~mod_global_parameters mod_global_parameters proc~advect_create_particles->module~mod_global_parameters module~mod_usr_methods mod_usr_methods proc~advect_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~~advect_create_particles~~CallsGraph proc~advect_create_particles advect_create_particles mpi_allreduce mpi_allreduce proc~advect_create_particles->mpi_allreduce mpi_bcast mpi_bcast proc~advect_create_particles->mpi_bcast phys_to_primitive phys_to_primitive proc~advect_create_particles->phys_to_primitive proc~advect_update_payload advect_update_payload proc~advect_create_particles->proc~advect_update_payload proc~find_particle_ipe find_particle_ipe proc~advect_create_particles->proc~find_particle_ipe proc~interpolate_var interpolate_var proc~advect_create_particles->proc~interpolate_var proc~push_particle_into_particles_on_mype push_particle_into_particles_on_mype proc~advect_create_particles->proc~push_particle_into_particles_on_mype proc~unif_01 rng_t%unif_01 proc~advect_create_particles->proc~unif_01 proc~advect_update_payload->proc~interpolate_var 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 proc~mpistop mpistop proc~interpolate_var->proc~mpistop proc~next rng_t%next proc~unif_01->proc~next proc~get_igslice->proc~mpistop mpi_abort mpi_abort proc~mpistop->mpi_abort proc~rotl rotl proc~next->proc~rotl

Called by

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

Source Code

  subroutine advect_create_particles()
    ! initialise the particles
    use mod_global_parameters
    use mod_usr_methods, only: usr_create_particles, usr_update_payload,&
        usr_check_particle

    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) * (xprobmax1 - xprobmin1)
          x(2,n) = xprobmin2 + rrd(n,2) * (xprobmax2 - xprobmin2)
          x(3,n) = xprobmin3 + rrd(n,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)
        w=ps(igrid)%w
        call phys_to_primitive(ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,ixGhi3,&
           ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,ixGhi3,w,ps(igrid)%x)
        do idir=1,ndir
          call interpolate_var(igrid,ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,ixGhi3,&
             ixMlo1,ixMlo2,ixMlo3,ixMhi1,ixMhi2,ixMhi3,w(ixGlo1:ixGhi1,&
             ixGlo2:ixGhi2,ixGlo3:ixGhi3,iw_mom(idir)),ps(igrid)%x,x(:,n),&
             v(idir,n))
        end do
        particle(n)%self%u(:) = 0.d0
        particle(n)%self%u(1:ndir) = v(1:ndir,n)

        ! Compute default and user-defined payloads
        allocate(particle(n)%payload(npayload))
        if(ndefpayload>0) then
          call advect_update_payload(igrid,x(:,n),v(:,n),q(n),m(n),defpayload,&
             ndefpayload,0.d0)
          particle(n)%payload(1:ndefpayload)=defpayload
        end if
        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 advect_create_particles