kmesh_dealloc Subroutine

public subroutine kmesh_dealloc(kmesh_info, error, comm)

Uses

  • proc~~kmesh_dealloc~~UsesGraph proc~kmesh_dealloc kmesh_dealloc module~w90_types w90_types proc~kmesh_dealloc->module~w90_types module~w90_constants w90_constants module~w90_types->module~w90_constants

Release memory from the kmesh module

Arguments

Type IntentOptional Attributes Name
type(kmesh_info_type), intent(inout) :: kmesh_info
type(w90_error_type), intent(out), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~kmesh_dealloc~~CallsGraph proc~kmesh_dealloc kmesh_dealloc proc~set_error_dealloc set_error_dealloc proc~kmesh_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 kmesh_dealloc(kmesh_info, error, comm)
    !================================================
    !!  Release memory from the kmesh module
    !   This routine now check to see if arrays
    !   are allocated, as there are some code
    !   paths that will not allocate on all nodes
    !================================================

    use w90_types, only: kmesh_info_type

    implicit none

    type(kmesh_info_type), intent(inout) :: kmesh_info
    type(w90_error_type), allocatable, intent(out) :: error
    type(w90_comm_type), intent(in) :: comm
    integer :: ierr

    ! Deallocate real arrays
    if (allocated(kmesh_info%bk)) then
      deallocate (kmesh_info%bk, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating bk in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%bka)) then
      deallocate (kmesh_info%bka, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating bka in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%wb)) then
      deallocate (kmesh_info%wb, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating wb in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%nnord)) then
      deallocate (kmesh_info%wb, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating wb in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%nninv)) then
      deallocate (kmesh_info%wb, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating wb in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%nnrev)) then
      deallocate (kmesh_info%wb, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating wb in kmesh_dealloc', comm)
        return
      end if
    end if

    ! Deallocate integer arrays
    if (allocated(kmesh_info%neigh)) then
      deallocate (kmesh_info%neigh, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating neigh in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%nncell)) then
      deallocate (kmesh_info%nncell, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating nncell in kmesh_dealloc', comm)
        return
      end if
    end if
    if (allocated(kmesh_info%nnlist)) then
      deallocate (kmesh_info%nnlist, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating nnlist in kmesh_dealloc', comm)
        return
      end if
    end if

    return

  end subroutine kmesh_dealloc