Determine whether minimisation of non-gauge invariant spread is converged
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(localisation_vars_type), | intent(in) | :: | old_spread | |||
| type(localisation_vars_type), | intent(in) | :: | wann_spread | |||
| real(kind=dp), | intent(inout) | :: | history(:) | |||
| real(kind=dp), | intent(inout) | :: | save_spread | |||
| integer, | intent(in) | :: | iter | |||
| integer, | intent(inout) | :: | conv_count | |||
| integer, | intent(inout) | :: | noise_count | |||
| logical, | intent(inout) | :: | lconverged | |||
| logical, | intent(inout) | :: | lrandom | |||
| logical, | intent(inout) | :: | lfirst | |||
| type(wann_control_type), | intent(in) | :: | wann_control | |||
| type(w90_error_type), | intent(out), | allocatable | :: | error | ||
| type(w90_comm_type), | intent(in) | :: | comm |
subroutine internal_test_convergence(old_spread, wann_spread, history, save_spread, iter, & conv_count, noise_count, lconverged, lrandom, lfirst, & wann_control, error, comm) !================================================! ! !! Determine whether minimisation of non-gauge !! invariant spread is converged ! !================================================! use w90_wannier90_types, only: wann_control_type implicit none ! arguments type(localisation_vars_type), intent(in) :: old_spread type(localisation_vars_type), intent(in) :: wann_spread type(w90_error_type), allocatable, intent(out) :: error type(w90_comm_type), intent(in) :: comm type(wann_control_type), intent(in) :: wann_control real(kind=dp), intent(inout) :: history(:) real(kind=dp), intent(inout) :: save_spread integer, intent(in) :: iter integer, intent(inout) :: conv_count integer, intent(inout) :: noise_count logical, intent(inout) :: lconverged, lrandom, lfirst ! local integer :: j, ierr real(kind=dp), allocatable :: temp_hist(:) real(kind=dp) :: delta_omega allocate (temp_hist(wann_control%conv_window), stat=ierr) if (ierr /= 0) then call set_error_alloc(error, 'Error allocating temp_hist in wann_main: test_convergence', comm) return end if delta_omega = wann_spread%om_tot - old_spread%om_tot if (iter .le. wann_control%conv_window) then history(iter) = delta_omega else temp_hist = eoshift(history, 1, delta_omega) history = temp_hist end if conv_count = conv_count + 1 if (conv_count .lt. wann_control%conv_window) then return else do j = 1, wann_control%conv_window if (abs(history(j)) .gt. wann_control%conv_tol) return end do end if if ((wann_control%conv_noise_amp .gt. 0.0_dp) .and. & (noise_count .lt. wann_control%conv_noise_num)) then if (lfirst) then lfirst = .false. save_spread = wann_spread%om_tot lrandom = .true. conv_count = 0 else if (abs(save_spread - wann_spread%om_tot) .lt. wann_control%conv_tol) then lconverged = .true. return else save_spread = wann_spread%om_tot lrandom = .true. conv_count = 0 end if end if else lconverged = .true. end if if (lrandom) noise_count = noise_count + 1 deallocate (temp_hist, stat=ierr) if (ierr /= 0) then call set_error_dealloc(error, 'Error deallocating temp_hist in wann_main: test_convergence', comm) return end if return end subroutine internal_test_convergence