overlap_write Subroutine

public subroutine overlap_write(kmesh_info, au_matrix, m_matrix, eval, num_bands, num_kpts, num_proj, dist_k, seedname, error, comm)

Uses

  • proc~~overlap_write~~UsesGraph proc~overlap_write overlap_write module~w90_error w90_error proc~overlap_write->module~w90_error module~w90_types w90_types proc~overlap_write->module~w90_types 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_constants w90_constants module~w90_types->module~w90_constants module~w90_comms->module~w90_constants module~w90_comms->module~w90_error_base

Write the Mmn and Amn from files

Arguments

Type IntentOptional Attributes Name
type(kmesh_info_type), intent(in) :: kmesh_info
complex(kind=dp), intent(in) :: au_matrix(:,:,:)
complex(kind=dp), intent(in) :: m_matrix(:,:,:,:)
real(kind=dp), intent(in), pointer :: eval(:,:)
integer, intent(in) :: num_bands
integer, intent(in) :: num_kpts
integer, intent(in) :: num_proj
integer, intent(in) :: dist_k(:)
character(len=50), intent(in) :: seedname
type(w90_error_type), intent(inout), allocatable :: error
type(w90_comm_type), intent(in) :: comm

Calls

proc~~overlap_write~~CallsGraph proc~overlap_write overlap_write interface~comms_allreduce comms_allreduce proc~overlap_write->interface~comms_allreduce proc~mpirank mpirank proc~overlap_write->proc~mpirank proc~set_error_alloc set_error_alloc proc~overlap_write->proc~set_error_alloc proc~set_error_dealloc set_error_dealloc proc~overlap_write->proc~set_error_dealloc proc~set_error_file set_error_file proc~overlap_write->proc~set_error_file proc~comms_allreduce_cmplx comms_allreduce_cmplx interface~comms_allreduce->proc~comms_allreduce_cmplx proc~comms_allreduce_real comms_allreduce_real interface~comms_allreduce->proc~comms_allreduce_real proc~comms_sync_error comms_sync_error proc~set_error_alloc->proc~comms_sync_error proc~set_base_error set_base_error proc~set_error_alloc->proc~set_base_error proc~set_error_dealloc->proc~comms_sync_error proc~set_error_dealloc->proc~set_base_error proc~set_error_file->proc~comms_sync_error proc~set_error_file->proc~set_base_error proc~comms_allreduce_cmplx->proc~comms_sync_error proc~comms_no_sync_allreduce_cmplx comms_no_sync_allreduce_cmplx proc~comms_allreduce_cmplx->proc~comms_no_sync_allreduce_cmplx proc~comms_allreduce_real->proc~comms_sync_error proc~comms_no_sync_allreduce_real comms_no_sync_allreduce_real proc~comms_allreduce_real->proc~comms_no_sync_allreduce_real

Called by

proc~~overlap_write~~CalledByGraph proc~overlap_write overlap_write proc~w90_disentangle~2 w90_disentangle proc~w90_disentangle~2->proc~overlap_write proc~w90_project_overlap~2 w90_project_overlap proc~w90_project_overlap~2->proc~overlap_write proc~w90_disentangle w90_disentangle proc~w90_disentangle->proc~w90_disentangle~2 proc~w90_project_overlap w90_project_overlap proc~w90_project_overlap->proc~w90_project_overlap~2 program~wannier wannier program~wannier->proc~w90_disentangle~2 program~wannier->proc~w90_project_overlap~2

Source Code

  subroutine overlap_write(kmesh_info, au_matrix, m_matrix, eval, num_bands, num_kpts, &
                           num_proj, dist_k, seedname, error, comm)
    !================================================!
    !! Write the Mmn and Amn from files
    !
    !================================================!

    use w90_types, only: kmesh_info_type
    use w90_error

    implicit none

    ! arguments
    type(kmesh_info_type), intent(in) :: kmesh_info
    type(w90_comm_type), intent(in) :: comm
    type(w90_error_type), allocatable, intent(inout) :: error

    integer, intent(in) :: num_bands, num_kpts, num_proj

    complex(kind=dp), intent(in) :: au_matrix(:, :, :)
    complex(kind=dp), intent(in) :: m_matrix(:, :, :, :)
    real(kind=dp), pointer, intent(in) :: eval(:, :)

    integer, intent(in) :: dist_k(:)

    character(len=50), intent(in) :: seedname

    complex(kind=dp), allocatable, dimension(:, :, :, :) :: m_mat_global

    ! local variables
    integer :: fu, ik, in, ip, n, m, ierr, ikp_loc

    allocate (m_mat_global(num_bands, num_bands, kmesh_info%nntot, num_kpts), stat=ierr)
    if (ierr /= 0) then
      call set_error_alloc(error, 'Error in allocating m_mat_global in overlap_write', comm)
      return
    end if

    m_mat_global = cmplx(0.0_dp, 0.0_dp, kind=dp)

    ikp_loc = 1
    do ik = 1, num_kpts
      if (dist_k(ik) == mpirank(comm)) then
        m_mat_global(:, :, :, ik) = m_matrix(1:num_bands, 1:num_bands, 1:kmesh_info%nntot, ikp_loc)
        ikp_loc = ikp_loc + 1
      end if
    end do

    call comms_allreduce(m_mat_global(1, 1, 1, 1), num_bands*num_bands*kmesh_info%nntot*num_kpts, 'SUM', error, comm)
    if (allocated(error)) return

    if (mpirank(comm) == 0) then

      ! dump overlap ("M") matrix
      open (newunit=fu, file=trim(seedname)//'.mmn_dump', err=201)

      write (fu, '(a)') "header" !header='Created on '//cdate//' at '//ctime
      write (fu, '(3i5)') num_bands, num_kpts, kmesh_info%nntot

      do ik = 1, num_kpts
        do in = 1, kmesh_info%nntot
          write (fu, *) ik, kmesh_info%nnlist(ik, in), kmesh_info%nncell(:, ik, in)
          do n = 1, num_bands
            do m = 1, num_bands
              write (fu, '(2f18.12)') m_mat_global(m, n, in, ik)
            end do
          end do
        end do
      end do

      close (fu)

      ! dump projections
      open (newunit=fu, file=trim(seedname)//'.amn_dump', err=202)

      write (fu, '(a)') "header" !header='Created on '//cdate//' at '//ctime
      write (fu, '(3i5)') num_bands, num_kpts, num_proj ! number of projections (select_proj ignored here)

      do ik = 1, num_kpts
        do ip = 1, num_proj
          do m = 1, num_bands
            write (fu, '(3i5,2f18.12)') m, ip, ik, au_matrix(m, ip, ik)
          end do
        end do
      end do

      close (fu)

      ! dump evals; eigenvalues are optional input (not required for wannierisation),
      ! only write the file when the caller has supplied them
      if (associated(eval)) then
        open (newunit=fu, file=trim(seedname)//'.eig_dump', err=203)

        do ik = 1, num_kpts
          do m = 1, num_bands
            write (fu, '(2i5,f18.12)') m, ik, eval(m, ik)
          end do
        end do

        close (fu)
      end if

    end if ! on root

    if (allocated(m_mat_global)) then
      deallocate (m_mat_global, stat=ierr)
      if (ierr /= 0) then
        call set_error_dealloc(error, 'Error in deallocating m_mat_global in overlap_write', comm)
        return
      end if
    end if

    return

201 call set_error_file(error, 'Error: Problem opening output file '//trim(seedname)//'.mmn_dump', comm)
    return
202 call set_error_file(error, 'Error: Problem opening output file '//trim(seedname)//'.amn_dump', comm)
    return
203 call set_error_file(error, 'Error: Problem opening output file '//trim(seedname)//'.eig_dump', comm)
    return
  end subroutine overlap_write