bin_variables Subroutine

public subroutine bin_variables(params, spp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(SPECIES), intent(in), DIMENSION(:), ALLOCATABLE:: spp

Contents

Source Code


Source Code

  SUBROUTINE bin_variables(params,spp)
    IMPLICIT NONE
    TYPE(KORC_PARAMS), INTENT(IN) :: params
    TYPE(SPECIES), DIMENSION(:), ALLOCATABLE, INTENT(IN) :: spp
    CHARACTER(MAX_STRING_LENGTH) :: var_name
    REAL(rp), DIMENSION(3) :: X
    REAL(rp), DIMENSION(:,:,:,:), ALLOCATABLE :: eta
    REAL(rp), DIMENSION(:,:,:,:), ALLOCATABLE :: g
    REAL(rp), DIMENSION(:,:,:,:), ALLOCATABLE :: N
    REAL(rp), DIMENSION(:,:,:), ALLOCATABLE :: array3D
    REAL(rp), DIMENSION(:,:), ALLOCATABLE :: array2D
    REAL(rp), DIMENSION(:), ALLOCATABLE :: array1D
    REAL(rp) :: R,Z,phi
    REAL(rp) :: Dtor
    REAL(rp) :: q,m
    INTEGER :: ii,jj,kk,ss,pp
    REAL(rp), DIMENSION(:), ALLOCATABLE :: send_buffer, receive_buffer
    INTEGER :: numel, mpierr
    REAL(rp) :: units

    ALLOCATE(eta(binning_params%num_bins(1),binning_params%num_bins(2),binning_params%ntor_sections,params%num_species))
    ALLOCATE(g(binning_params%num_bins(1),binning_params%num_bins(2),binning_params%ntor_sections,params%num_species))
    ALLOCATE(N(binning_params%num_bins(1),binning_params%num_bins(2),binning_params%ntor_sections,params%num_species))

    eta = 0.0_rp
    g = 0.0_rp
    N = 0.0_rp

    Dtor = 2.0_rp*C_PI/REAL(binning_params%ntor_sections,rp)

    do ss=1_idef,params%num_species
       q = ABS(spp(ss)%q)*params%cpp%charge
       m = spp(ss)%m*params%cpp%mass
       !$OMP PARALLEL DO FIRSTPRIVATE(q,m,Dtor) PRIVATE(X,ii,jj,kk,pp)&
       !$OMP& SHARED(params,spp,ss,eta,g,N)
       do pp=1_idef,spp(ss)%ppp
          if ( spp(ss)%vars%flag(pp) .EQ. 1_idef ) then
             X = spp(ss)%vars%X(pp,:)*params%cpp%length

             R = SQRT(SUM(X(1:2)**2))
             Z = X(3)

             ii = FLOOR((R - binning_params%rmin)/binning_params%dr) + 1_idef
             jj = FLOOR((Z + ABS(binning_params%zmin))/binning_params%dz) + 1_idef

             phi = ATAN2(X(2),X(1))
             if (phi.LT.0.0_rp) phi = 2.0_rp*C_PI + phi
             kk = floor(phi/Dtor) + 1_idef

             eta(ii,jj,kk,ss) = eta(ii,jj,kk,ss) + spp(ss)%vars%eta(pp)
             g(ii,jj,kk,ss) = g(ii,jj,kk,ss) + spp(ss)%vars%g(pp)
             N(ii,jj,kk,ss) = N(ii,jj,kk,ss) + 1.0_rp
          end if ! if confined
       end do ! particles
       !$OMP END PARALLEL DO
    end do ! species

    if (params%mpi_params%rank.EQ.0_idef) then
       if (.NOT.binning_params%toroidal_sections) then
          ALLOCATE(array3D(binning_params%num_bins(1),binning_params%num_bins(2),params%num_species))
       end if
    end if

    if (params%mpi_params%nmpi.GT.1_idef) then
       numel = binning_params%num_bins(1)*binning_params%num_bins(2)*binning_params%ntor_sections*params%num_species

       ALLOCATE(send_buffer(numel))
       ALLOCATE(receive_buffer(numel))

       send_buffer = RESHAPE(eta,(/numel/))
       receive_buffer = 0.0_rp
       CALL MPI_REDUCE(send_buffer,receive_buffer,numel,MPI_REAL8,MPI_SUM,0,MPI_COMM_WORLD,mpierr)
       if (params%mpi_params%rank.EQ.0_idef) then
          eta = RESHAPE(receive_buffer,(/binning_params%num_bins(1),binning_params%num_bins(2),&
               binning_params%ntor_sections,params%num_species/))

          var_name = 'eta'
          if (binning_params%toroidal_sections) then
             call save_snapshot_var(params,eta,var_name)
          else
             array3D = SUM(eta,3)
             call save_snapshot_var(params,array3D,var_name)
          end if
       end if

       DEALLOCATE(send_buffer)
       DEALLOCATE(receive_buffer)

       ALLOCATE(send_buffer(numel))
       ALLOCATE(receive_buffer(numel))

       send_buffer = RESHAPE(g,(/numel/))
       receive_buffer = 0.0_rp
       CALL MPI_REDUCE(send_buffer,receive_buffer,numel,MPI_REAL8,MPI_SUM,0,MPI_COMM_WORLD,mpierr)
       if (params%mpi_params%rank.EQ.0_idef) then
          g = RESHAPE(receive_buffer,(/binning_params%num_bins(1),binning_params%num_bins(2),&
               binning_params%ntor_sections,params%num_species/))

          var_name = 'g'
          if (binning_params%toroidal_sections) then
             call save_snapshot_var(params,g,var_name)
          else
             array3D = SUM(g,3)
             call save_snapshot_var(params,array3D,var_name)
          end if
       end if

       DEALLOCATE(send_buffer)
       DEALLOCATE(receive_buffer)

       ALLOCATE(send_buffer(numel))
       ALLOCATE(receive_buffer(numel))

       send_buffer = RESHAPE(N,(/numel/))
       receive_buffer = 0.0_rp
       CALL MPI_REDUCE(send_buffer,receive_buffer,numel,MPI_REAL8,MPI_SUM,0,MPI_COMM_WORLD,mpierr)
       if (params%mpi_params%rank.EQ.0_idef) then
          N = RESHAPE(receive_buffer,(/binning_params%num_bins(1),binning_params%num_bins(2),&
               binning_params%ntor_sections,params%num_species/))

          var_name = 'N'
          if (binning_params%toroidal_sections) then
             call save_snapshot_var(params,N,var_name)
          else
             array3D = SUM(N,3)
             call save_snapshot_var(params,array3D,var_name)
          end if
       end if

       DEALLOCATE(send_buffer)
       DEALLOCATE(receive_buffer)
    else
       var_name = 'eta'
       if (binning_params%toroidal_sections) then
          call save_snapshot_var(params,eta,var_name)
       else
          array3D = SUM(eta,3)
          call save_snapshot_var(params,array3D,var_name)
       end if

       var_name = 'g'
       if (binning_params%toroidal_sections) then
          call save_snapshot_var(params,g,var_name)
       else
          array3D = SUM(g,3)
          call save_snapshot_var(params,array3D,var_name)
       end if

       var_name = 'N'
       if (binning_params%toroidal_sections) then
          call save_snapshot_var(params,N,var_name)
       else
          array3D = SUM(N,3)
          call save_snapshot_var(params,array3D,var_name)
       end if
    end if

    DEALLOCATE(eta)
    DEALLOCATE(g)
    DEALLOCATE(N)

    if (ALLOCATED(array3D)) DEALLOCATE(array3D)
    if (ALLOCATED(array2D)) DEALLOCATE(array2D)
    if (ALLOCATED(array1D)) DEALLOCATE(array1D)
  END SUBROUTINE bin_variables