tem_reduction_spatial_close Subroutine

public subroutine tem_reduction_spatial_close(me, proc)

Perform the global reduction

After the local reductions have been performed (in _append), the results must be communicated between processes.

Arguments

Type IntentOptional Attributes Name
type(tem_reduction_spatial_type), intent(inout) :: me(:)

The reduction type to work on. All definitions should be present in here
type(tem_comm_env_type), intent(in) :: proc

communicator for processes participating in this reduction

Calls

proc~~tem_reduction_spatial_close~~CallsGraph proc~tem_reduction_spatial_close tem_reduction_spatial_close mpi_reduce mpi_reduce proc~tem_reduction_spatial_close->mpi_reduce

Called by

proc~~tem_reduction_spatial_close~~CalledByGraph proc~tem_reduction_spatial_close tem_reduction_spatial_close proc~tem_convergence_check_point tem_convergence_check_point proc~tem_convergence_check_point->proc~tem_reduction_spatial_close proc~tem_convergence_check_element tem_convergence_check_element proc~tem_convergence_check_element->proc~tem_reduction_spatial_close proc~hvs_ascii_dump_point_data hvs_ascii_dump_point_data proc~hvs_ascii_dump_point_data->proc~tem_reduction_spatial_close proc~hvs_ascii_dump_elem_data hvs_ascii_dump_elem_data proc~hvs_ascii_dump_elem_data->proc~tem_reduction_spatial_close proc~tem_convergence_check tem_convergence_check proc~tem_convergence_check->proc~tem_convergence_check_point proc~tem_convergence_check->proc~tem_convergence_check_element proc~hvs_output_write hvs_output_write proc~hvs_output_write->proc~hvs_ascii_dump_point_data proc~hvs_output_write->proc~hvs_ascii_dump_elem_data proc~tem_tracker tem_tracker proc~tem_tracker->proc~hvs_output_write

Contents

Source Code

tem_reduction_spatial_close

Source Code

  subroutine tem_reduction_spatial_close(me, proc)
    ! ---------------------------------------------------------------------------
    !> The reduction type to work on. All definitions should be
    !! present in here
    type( tem_reduction_spatial_type ), intent(inout) :: me(:)
    !> communicator for processes participating in this reduction
    type(tem_comm_env_type), intent(in)  :: proc
    ! ---------------------------------------------------------------------------
    integer :: i, nComp, ierr, globalnElems
    real(kind=rk), allocatable :: buff(:)
    real(kind=rk)              :: Vglob
    ! ---------------------------------------------------------------------------
    globalnElems = 0

    !loop over all tracking objects
    do i = 1, size(me)

      ! get number of components
      nComp = me(i)%nComponents

      allocate(buff(nComp))
      buff = 0.0_rk

      !choose reduction operation and perform it
      select case( me( i )%reduceType )
        !sum all values
        case('sum', 'weighted_sum')
          call mpi_reduce( me(i)%val, buff,                                    &
            &              nComp, rk_mpi, mpi_sum, proc%root, proc%comm, iErr)
          me(i)%val = buff

        !sum all values and devide by number of elements
        case('average')
          globalnElems = 0
          ! get global number of elements in this reduction to rank 0
          call mpi_reduce( me(i)%nElems, globalnElems,                        &
            &              1, mpi_integer, mpi_sum, proc%root, proc%comm, iErr)
          call mpi_reduce( me(i)%val, buff,                                  &
            &              nComp, rk_mpi, mpi_sum, proc%root, proc%comm, iErr)
          if (proc%rank == proc%root) &
            & me(i)%val(:) = buff / real( globalnElems, kind = rk)

        !sum all values(sum of squares) and extract a square root
        case('l2norm')
          call mpi_reduce( me(i)%val, buff,                                    &
          &                nComp, rk_mpi, mpi_sum, proc%root, proc%comm, iErr)
          me(i)%val(:) = sqrt(buff)

        !maximium over all values
        case('max','linfnorm')
          call mpi_reduce( me(i)%val, buff,                                    &
          &                nComp, rk_mpi, mpi_max, proc%root, proc%comm, iErr)
          me(i)%val = buff

        !minimum over all values
        case('min')
          call mpi_reduce( me(i)%val, buff,                                    &
          &                nComp, rk_mpi, mpi_min, proc%root, proc%comm, iErr)
          me(i)%val = buff

        !sum all values(sum of squares), normalize and extract a square root
        case('l2normalized')
          call mpi_reduce( me(i)%Vloc, Vglob,                            &
          &                1, rk_mpi, mpi_sum, proc%root, proc%comm, iErr)
          call mpi_reduce( me(i)%val, buff,                                  &
          &                nComp, rk_mpi, mpi_sum, proc%root, proc%comm, iErr)
          me(i)%val(:) = sqrt(buff/Vglob)

        case default
      end select
      deallocate( buff )
    enddo

  end subroutine tem_reduction_spatial_close