program x0
    implicit none
    !определение переменных и функций
    character, allocatable :: table(:,:)
    integer :: n,win,a,b,player
    logical :: process
    integer :: player_win
    !тело программы
    !
    !проверка корректности введённых значений размера поля и количества клеток, необхожимых для выигрыша
    do while(.true.)
        write (*,'(a$)') 'Enter the size of the field:'
        read (*,*) n
        if ( (n >= 20) .or. (n <= 0) ) then
            write (*,'(a)') 'Too big or incorrect value, try again.'
            cycle
        else
            exit
        end if
    end do
    do while(.true.)
        write (*,'(a$)') 'Enter the number of cells required to win:'
        read (*,*) win
        if ( (win > n) .or. (win <= 0) ) then
            write (*,'(a)') 'Too big or incorrect value, try again.'
            cycle
        else
            exit
        end if
    end do
    allocate(table(n,n))
    table(:,:) = '-'
    player = 1
    process = .true.
    !
    do while(process)
        !
        !проверка выигрыша и заполненности таблицы - 1,2 - выигрыш
        !соответствующих игроков, 3 - заполненность - 0 - игра продолжается
        if (player_win(n,win,table)==1) then
            write (*,'(a)') 'Congrats! Player 1 won!'
            exit
        elseif (player_win(n,win,table)==2) then
            write (*,'(a)') 'Congrats! Player 2 won!'
            exit
        elseif (player_win(n,win,table)==3) then
            write (*,'(a)') 'No one won!'
            exit
        else
            do while (.true.)
                write (*,'(a,1x,i1,1x,a)') 'Player',player,'walks'
                write (*,'(a$)') 'Enter a row: '
                read (*,'(i5$)') a
                write (*,'(a$)') 'Enter a column: '
                read (*,'(i5$)') b
                if ( (.not.((a<=n).and.(1<=a))) .or. (.not.((b<=n).and.(1<=b))) ) then
                    write (*,'(a)') 'Enter the correct value!'
                    cycle
                else if  ( (table(a,b) == '0') .or. (table(a,b) == 'x') ) then
                    write (*,'(a)') 'Enter the correct value!'
                    cycle
                else
                    exit
                end if
            end do
            if (player == 1) then
                table(a,b) = 'x'
                player = 2
            else
                table(a,b) = '0'
                player = 1
            end if
            call draw(n,table)
        end if
    end do
    deallocate(table)
end program x0
!
!процедура отрисовки поля
subroutine draw(draw_size,draw_table)
    integer :: draw_size, dr_1, dr_2
    character :: draw_table(draw_size,draw_size)
    !
    do dr_1 =1,draw_size
        if (dr_1 /= draw_size) then
            write (*,'(1x,i2$)') dr_1
        else
            write (*,'(1x,i2)') dr_1
        end if
    end do
    do dr_1 =1,draw_size
        do dr_2 =1,(draw_size-1)
            write (*,'(2x,a$)') draw_table(dr_1,dr_2)
        end do
        write (*,'(2x,a,1x,i2)') draw_table(dr_1,draw_size), dr_1
    end do
end subroutine
!
!функция выигрыша (состоит из других функций и процедур)
integer function player_win(pw_size, pw_win, pw_table)
    integer :: pw_1, pw_2, pw_size, pw_win, cut_win
    character :: pw_table(pw_size,pw_size), pw_win_table(pw_win,pw_win)
    logical :: full
    !
    !
    player_win = 0
    if (full(pw_size, pw_table)) then
        player_win = 3
    end if
    do pw_1 = 1, (pw_size-pw_win+1)
        do pw_2 = 1, (pw_size-pw_win+1)
            call equate(pw_size,pw_win,pw_table,pw_win_table,pw_1,pw_2)
            if (cut_win(pw_win, pw_win_table) /= 0) then
                player_win = cut_win(pw_win, pw_win_table)
                return
            end if
        end do
    end do
end function
!
!функция проверки заполненности поля
logical function full(f_size,f_table)
    integer :: f_size, f_1, f_2
    character :: f_table(f_size,f_size)
    !
    full = .true.
    do f_1 =1,f_size
        do f_2 =1, f_size
            if ( f_table(f_1,f_2) == '-' ) then
                full = .false.
                return
            end if
        end do
    end do
end function
!
!способ проверки выигрыша - так как поле и размер клеток, нужных для выигрыша не совпадает
!мы создаём процедуру, режущую исходное поле на поля размером количество клеток для выигрыша
!на количество клеток для выигрыша
subroutine equate(eq_size, eq_win, eq_table, eq_win_table, eq_pw_1, eq_pw_2)
    integer :: eq_size, eq_win, eq_pw_1, eq_pw_2, eq_1, eq_2
    character :: eq_table(eq_size, eq_size), eq_win_table(eq_win, eq_win)
    !
    do eq_1 =1, eq_win
        do eq_2 =1, eq_win
            eq_win_table(eq_1,eq_2) = eq_table( (eq_pw_1+eq_1-1),(eq_pw_2+eq_2-1) )
        end do
    end do
end subroutine
!
!функция выигрыша в обрезанной таблице
integer function cut_win(cw_win, cw_table)
    integer :: cw_win, cw_1,cw_2
    character :: cw_table(cw_win,cw_win), cw_array(cw_win),cw_x(cw_win),cw_0(cw_win)
    logical :: is_equal
    !
    cw_x(:) = 'x'
    cw_0(:) = '0'
    cut_win = 0
    !первая диагональ
    do cw_1 =1,cw_win
        cw_array(cw_1) = cw_table(cw_1,cw_1)
    end do
    if (is_equal(cw_x,cw_array,cw_win)) then
        cut_win = 1
        return
    elseif (is_equal(cw_0,cw_array,cw_win)) then
        cut_win = 2
        return
    end if
    !вторая диагональ
    do cw_1 =1,cw_win
        cw_array(cw_1) = cw_table(cw_1,(cw_win-cw_1+1))
    end do
    if (is_equal(cw_x,cw_array,cw_win)) then
        cut_win = 1
        return
    elseif (is_equal(cw_0,cw_array,cw_win)) then
        cut_win = 2
        return
    end if
    !горизонтали
    do cw_1 =1,cw_win
        do cw_2 =1,cw_win
            cw_array(cw_2) = cw_table(cw_1,cw_2)
        end do
        if (is_equal(cw_x,cw_array,cw_win)) then
            cut_win = 1
            return
        elseif (is_equal(cw_0,cw_array,cw_win)) then
            cut_win = 2
            return
        end if
    end do
    !вертикали
    do cw_1 =1,cw_win
        do cw_2 =1,cw_win
            cw_array(cw_2) = cw_table(cw_2,cw_1)
        end do
        if (is_equal(cw_x,cw_array,cw_win)) then
            cut_win = 1
            return
        elseif (is_equal(cw_0,cw_array,cw_win)) then
            cut_win = 2
            return
        end if
    end do
end function
!
!эквивалентность двух массивов
logical function is_equal(ie_a, ie_b, ie_n)
integer :: ie_n, ie_i
character :: ie_a(ie_n),ie_b(ie_n)
do ie_i = 1, ie_n
    if(ie_a(ie_i) /= ie_b(ie_i)) then
        is_equal= .false.
        return
    end if
end do
is_equal =.true.
end function