check Subroutine

subroutine check(idx, idirection)

Arguments

Type IntentOptional Attributes Name
integer(kind=ip), intent(in) :: idx
integer(kind=ip), intent(in) :: idirection

direction to move from current


Calls

proc~~check~~CallsGraph proc~check problem_17::check proc~add_to_queue problem_17::add_to_queue proc~check->proc~add_to_queue proc~index_in_queue problem_17::index_in_queue proc~check->proc~index_in_queue

Called by

proc~~check~~CalledByGraph proc~check problem_17::check program~problem_17 problem_17 program~problem_17->proc~check

Source Code

    subroutine check(idx, idirection)
        implicit none
        integer(ip),intent(in) :: idx ! current item in the queue to process
        integer(ip),intent(in) :: idirection !! direction to move from current

        integer(ip) :: alt
        integer(ip),dimension(2) :: v ! neighbor to move to
        integer(ip) :: imovesv, idxv, distv
        integer(ip),dimension(NSTATE) :: istate
        logical :: in_queue

        associate ( i         => queue(idx)%state(1), &
                    j         => queue(idx)%state(2), &
                    direction => queue(idx)%state(3), &
                    n_moves   => queue(idx)%state(4))

            if (direction==-idirection) return ! can't reverse

            ! the one to go to:
            if (direction==idirection) then
                if (n_moves==MAX_MOVES_IN_DIR) return ! can't move in this direction anymore
                imovesv = n_moves + 1
            else
                imovesv = 1 ! reset on change of direction
            end if
            select case(idirection)
            case(UP);   v = [i-1, j  ]
            case(DOWN); v = [i+1, j  ]
            case(LEFT); v = [i,   j-1]
            case(RIGHT);v = [i,   j+1]
            end select
            if (v(1)<1 .or. v(2)<1 .or. v(1)>n_rows .or. v(2)>n_cols) return ! can't go off the board

            istate = [v(1), v(2), idirection, imovesv] ! new state
            idxv = index_in_queue(istate) ! is it already in the queue
            in_queue = idxv>0 ! if this one is already part of another path
            if (in_queue) then
                if (queue(idxv)%visited) return ! already visited this one
                distv = queue(idxv)%dist ! distance in the queue
            else
                !call add_to_queue(istate, idxv) ! add this to the queue for processing ! always add it ??
                distv = huge(1_ip) ! not processed yet, so huge number
            end if

            !alt = queue(idx)%dist + map(queue(idxv)%state(1), queue(idxv)%state(2))
            alt = queue(idx)%dist + map(v(1), v(2)) ! new distance
            if (alt < distv) then ! the new one is better, so replace values in the queue
                if (.not. in_queue) call add_to_queue(istate, idxv) ! only add it if we accept it ????
                ! accept this step
                queue(idxv)%dist  = alt ! new best dist
                queue(idxv)%iprev = idx ! previous
            end if

        end associate

    end subroutine check