subroutine wann_check_unitarity(num_kpts, num_wann, u_matrix, timing_level, iprint, stdout, &
timer, error, comm)
!================================================!
use w90_constants, only: dp, cmplx_1, cmplx_0, eps5
use w90_io, only: io_stopwatch_start, io_stopwatch_stop
use w90_comms, only: w90_comm_type
use w90_types, only: timer_list_type
implicit none
! arguments
integer, intent(in) :: num_kpts, num_wann, timing_level, iprint, stdout
complex(kind=dp), intent(in) :: u_matrix(:, :, :)
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), allocatable, intent(out) :: error
type(w90_comm_type), intent(in) :: comm
! local variables
integer :: nkp, i, j, m
complex(kind=dp) :: ctmp1, ctmp2
if (timing_level > 1 .and. iprint > 0) call io_stopwatch_start('wann: check_unitarity', timer)
do nkp = 1, num_kpts
do i = 1, num_wann
do j = 1, num_wann
ctmp1 = cmplx_0
ctmp2 = cmplx_0
do m = 1, num_wann
ctmp1 = ctmp1 + u_matrix(i, m, nkp)*conjg(u_matrix(j, m, nkp))
ctmp2 = ctmp2 + u_matrix(m, j, nkp)*conjg(u_matrix(m, i, nkp))
end do
if ((i .eq. j) .and. (abs(ctmp1 - cmplx_1) .gt. eps5)) &
then
if (iprint > 0) write (stdout, *) ' ERROR: unitariety of final U', nkp, i, j, &
ctmp1
call set_error_fatal(error, 'wann_check_unitarity: error 1', comm)
return
end if
if ((i .eq. j) .and. (abs(ctmp2 - cmplx_1) .gt. eps5)) &
then
if (iprint > 0) write (stdout, *) ' ERROR: unitariety of final U', nkp, i, j, &
ctmp2
call set_error_fatal(error, 'wann_check_unitarity: error 2', comm)
return
end if
if ((i .ne. j) .and. (abs(ctmp1) .gt. eps5)) then
if (iprint > 0) write (stdout, *) ' ERROR: unitariety of final U', nkp, i, j, &
ctmp1
call set_error_fatal(error, 'wann_check_unitarity: error 3', comm)
return
end if
if ((i .ne. j) .and. (abs(ctmp2) .gt. eps5)) then
if (iprint > 0) write (stdout, *) ' ERROR: unitariety of final U', nkp, i, j, &
ctmp2
call set_error_fatal(error, 'wann_check_unitarity: error 4', comm)
return
end if
end do
end do
end do
if (timing_level > 1 .and. iprint > 0) call io_stopwatch_stop('wann: check_unitarity', timer)
return
end subroutine wann_check_unitarity