Free_MappedScalar3D Subroutine

  1. SELF_MappedScalar_3D.f90
  2. SELF_MappedScalar_3D
  3. Free_MappedScalar3D

public subroutine Free_MappedScalar3D(this)

Arguments

TypeIntentOptionalAttributesName
class(MappedScalar3D), intent(inout) :: this

Calls

proc~~free_mappedscalar3d~~CallsGraph proc~free_mappedscalar3d Free_MappedScalar3D proc~free_scalar3d_t Free_Scalar3D_t proc~free_mappedscalar3d->proc~free_scalar3d_t interface~hipfree hipFree proc~free_mappedscalar3d->interface~hipfree proc~gpucheck gpuCheck proc~free_mappedscalar3d->proc~gpucheck mpi_finalized mpi_finalized proc~free_mappedscalar3d->mpi_finalized mpi_request_free mpi_request_free proc~free_mappedscalar3d->mpi_request_free

Contents

Source Code

Free_MappedScalar3D

Source Code

  subroutine Free_MappedScalar3D(this)
    implicit none
    class(MappedScalar3D),intent(inout) :: this
    ! Local
    integer :: n,iError
    logical :: mpiIsFinalized

    ! Host storage is owned by the pools in the parent type (Stage 6b), so the parent Free
    ! releases it rather than deallocating these pointers.
    call Free_Scalar3D_t(this)

    call gpuCheck(hipFree(this%interior_gpu))
    call gpuCheck(hipFree(this%boundary_gpu))
    call gpuCheck(hipFree(this%extBoundary_gpu))
    call gpuCheck(hipFree(this%avgBoundary_gpu))
    call gpuCheck(hipFree(this%boundarynormal_gpu))
    call gpuCheck(hipFree(this%jas_gpu))

    if(c_associated(this%mortarBuff_gpu)) then
      call gpuCheck(hipFree(this%mortarBuff_gpu))
      this%mortarBuff_gpu = c_null_ptr
    endif

    if(c_associated(this%halo_sendbuf_gpu)) call gpuCheck(hipFree(this%halo_sendbuf_gpu))
    if(c_associated(this%halo_recvbuf_gpu)) call gpuCheck(hipFree(this%halo_recvbuf_gpu))
    this%halo_sendbuf_gpu = c_null_ptr
    this%halo_recvbuf_gpu = c_null_ptr

    if(allocated(this%halo_reqs)) then
      ! Persistent requests can only be released while MPI is still
      ! initialized; if the mesh (and its MPI finalization) was freed first,
      ! MPI has reclaimed them already.
      call MPI_FINALIZED(mpiIsFinalized,iError)
      if(.not. mpiIsFinalized) then
        do n = 1,size(this%halo_reqs)
          call MPI_REQUEST_FREE(this%halo_reqs(n),iError)
        enddo
      endif
      deallocate(this%halo_reqs)
    endif
    this%halo_nactive = 0
    this%halo_inflight = 0
    this%halo_static_done = .false.

  endsubroutine Free_MappedScalar3D