dealloc_one_rdm_t Subroutine

public subroutine dealloc_one_rdm_t(one_rdm)

Uses

Arguments

Type IntentOptional Attributes Name
type(one_rdm_t), intent(inout) :: one_rdm

Contents

Source Code


Source Code

    subroutine dealloc_one_rdm_t(one_rdm)

        ! Deallocate a one_rdm_t object.

        ! In/Out: one_rdm - one_rdm_t object to be deallocated.

        use rdm_data, only: one_rdm_t

        type(one_rdm_t), intent(inout) :: one_rdm

        integer :: ierr
        character(*), parameter :: t_r = 'dealloc_one_rdm_t'

        if (allocated(one_rdm%matrix)) then
            deallocate(one_rdm%matrix, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, 'Problem deallocating 1-RDM array.')
            call LogMemDeAlloc(t_r, one_rdm%matrix_tag)
        end if
        if (allocated(one_rdm%evalues)) then
            deallocate(one_rdm%evalues, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, 'Problem deallocating evalues array,')
            call LogMemDeAlloc(t_r, one_rdm%evalues_tag)
        end if
        if (allocated(one_rdm%rho_ii)) then
            deallocate(one_rdm%rho_ii, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, 'Problem deallocating 1-RDM diagonal array (rho_ii).')
            call LogMemDeAlloc(t_r, one_rdm%rho_ii_tag)
        end if
        if (allocated(one_rdm%sym_list_no)) then
            deallocate(one_rdm%sym_list_no, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, 'Problem deallocating sym_list_no array.')
        end if
        if (allocated(one_rdm%sym_list_inv_no)) then
            deallocate(one_rdm%sym_list_inv_no, stat=ierr)
            if (ierr /= 0) call stop_all(t_r, 'Problem deallocating sym_list_inv_no array.')
        end if

    end subroutine dealloc_one_rdm_t