find_highest_sign_per_node Subroutine

public subroutine find_highest_sign_per_node(n_states, largest_dets_node, largest_dets)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: n_states
integer(kind=n_int), intent(inout) :: largest_dets_node(0:niftot,n_states)
integer(kind=n_int), intent(out) :: largest_dets(0:niftot,n_states)

Contents


Source Code

    subroutine find_highest_sign_per_node(n_states, largest_dets_node, largest_dets)
        ! routine to find the largest signs on each node and store them
        ! sequentially into the global list
        integer, intent(in) :: n_states
        integer(n_int), intent(inout) :: largest_dets_node(0:niftot, n_states)
        integer(n_int), intent(out) :: largest_dets(0:niftot, n_states)

        integer :: i, max_pos, j
        real(dp) :: tmp_sign(lenof_sign), max_sign
        real(dp) :: reduce_in(2), reduce_out(2)
        integer(n_int) :: max_det(0:niftot)

        do i = 1, n_states
            max_sign = 0.0_dp
            max_pos = 1

            do j = n_states, 1, -1
                call extract_sign(largest_dets_node(:, j), tmp_sign)
                ! why is this call?
                if (any(largest_dets_node(:, j) /= 0)) then

#ifdef CMPLX_
                    max_sign = sqrt(sum(abs(tmp_sign(1::2)))**2 + sum(abs(tmp_sign(2::2)))**2)
#else
                    max_sign = sum(real(abs(tmp_sign), dp))
#endif

                    ! We have the largest sign
                    max_pos = j
                    exit
                end if
            end do
            reduce_in = [max_sign, real(iProcIndex, dp)]
            call MPIAllReduceDatatype(reduce_in, 1, MPI_MAXLOC, MPI_2DOUBLE_PRECISION, reduce_out)

            if (iProcIndex == nint(reduce_out(2))) then
                max_det = largest_dets_node(:, max_pos)
                ! and then set it to zero
                largest_dets_node(:, max_pos) = 0
            else
                max_det = 0
            end if

            call MPIBCast(max_det, NIfTot + 1, nint(reduce_out(2)))

            if (iProcIndex == root) then
                largest_dets(:, i) = max_det
            end if
        end do

    end Subroutine find_highest_sign_per_node