| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer(kind=ip), | intent(in) | :: | idx | |||
| integer(kind=ip), | intent(in) | :: | idirection |
direction to move from current |
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