overlap_dealloc Subroutine

public subroutine overlap_dealloc(a_matrix, m_matrix, m_matrix_local, m_matrix_orig, m_matrix_orig_local, u_matrix, u_matrix_opt, error, comm)

Uses

  • proc~~overlap_dealloc~~UsesGraph proc~overlap_dealloc overlap_dealloc module~w90_error w90_error proc~overlap_dealloc->module~w90_error module~w90_comms w90_comms module~w90_error->module~w90_comms module~w90_error_base w90_error_base module~w90_error->module~w90_error_base module~w90_comms->module~w90_error_base module~w90_constants w90_constants module~w90_comms->module~w90_constants

Dellocate memory

Arguments

Type IntentOptional Attributes Name
complex(kind=dp), intent(inout), allocatable :: a_matrix(:,:,:)
complex(kind=dp), intent(inout), allocatable :: m_matrix(:,:,:,:)
complex(kind=dp), intent(inout), allocatable :: m_matrix_local(:,:,:,:)
complex(kind=dp), intent(inout), allocatable :: m_matrix_orig(:,:,:,:)
complex(kind=dp), intent(inout), allocatable :: m_matrix_orig_local(:,:,:,:)
complex(kind=dp), intent(inout), allocatable :: u_matrix(:,:,:)
complex(kind=dp), intent(inout), allocatable :: u_matrix_opt(:,:,:)
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~overlap_dealloc~~CallsGraph proc~overlap_dealloc overlap_dealloc proc~mpirank mpirank proc~overlap_dealloc->proc~mpirank proc~set_error_dealloc set_error_dealloc proc~overlap_dealloc->proc~set_error_dealloc proc~comms_sync_error comms_sync_error proc~set_error_dealloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_dealloc->proc~set_base_error

Source Code

  subroutine overlap_dealloc(a_matrix, m_matrix, m_matrix_local, m_matrix_orig, &
                             m_matrix_orig_local, u_matrix, u_matrix_opt, error, comm)
    !================================================!
    !
    !! Dellocate memory
    !
    !================================================!

    !use w90_io, only: io_error
    use w90_error, only: set_error_dealloc, w90_error_type

    implicit none

    ! arguments
    complex(kind=dp), allocatable, intent(inout) :: m_matrix(:, :, :, :)
    complex(kind=dp), allocatable, intent(inout) :: u_matrix(:, :, :)
    complex(kind=dp), allocatable, intent(inout) :: m_matrix_orig(:, :, :, :)
    complex(kind=dp), allocatable, intent(inout) :: a_matrix(:, :, :)
    complex(kind=dp), allocatable, intent(inout) :: u_matrix_opt(:, :, :)
    complex(kind=dp), allocatable, intent(inout) :: m_matrix_local(:, :, :, :)
    complex(kind=dp), allocatable, intent(inout) :: m_matrix_orig_local(:, :, :, :)
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm

    ! local variables
    integer :: ierr
    logical :: on_root = .false.

    if (mpirank(comm) == 0) on_root = .true.

    if (allocated(u_matrix_opt)) then
      deallocate (u_matrix_opt, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating u_matrix_opt in overlap_dealloc', comm)
        return
      end if
    end if
    if (allocated(a_matrix)) then
      deallocate (a_matrix, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating a_matrix in overlap_dealloc', comm)
        return
      end if
    end if
    if (allocated(m_matrix_orig)) then
      deallocate (m_matrix_orig, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating m_matrix_orig in overlap_dealloc', comm)
        return
      end if
    end if
    if (allocated(m_matrix_orig_local)) then
      deallocate (m_matrix_orig_local, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating m_matrix_orig_local in overlap_dealloc', comm)
        return
      end if
    end if
    if (on_root) then
      if (allocated(m_matrix)) then
        deallocate (m_matrix, stat=ierr)
        if (ierr /= 0) then
          call set_error_dealloc(error, 'Error deallocating m_matrix in overlap_dealloc', comm)
          return
        end if
      end if
    end if
    if (allocated(m_matrix_local)) then
      deallocate (m_matrix_local, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating m_matrix_local in overlap_dealloc', comm)
        return
      end if
    end if
    if (allocated(u_matrix)) then
      deallocate (u_matrix, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error deallocating u_matrix in overlap_dealloc', comm)
        return
      end if
    end if

    return

  end subroutine overlap_dealloc