Первая часть 3 расчётки по ОиУ

program main
    use OiU3
    implicit none
    integer :: c(7,7), k, l, temp(7,7), summa
    integer, parameter :: i = 10
    summa = 0
    do k = 1,7
        do l = 1,7
            if (k == l) then
                c(k,l) = 100000
            else if ( mod( (i + 3*k + 5*l), 17) == 0 ) then
                c(k,l) = 17
            else
                c(k,l) = mod( (i + 3*k + 5*l), 17)
            end if
        end do
    end do
    temp = c
    write (0,fmt='(a,i2)') 'Road 1 to 2: ',c(1,2)
    call write_matrix(c,7)
    call transform(temp,7, summa)
    call write_matrix(temp,7)
    write (0,fmt = '(a,i3)') 'Then we choose better summa:', summa
end program main

module OiU3
    contains
    !
    subroutine numbers(n)
        integer :: n, i
        write (0,fmt = '(a4$)') '| \ '
        do i = 1,n,1
            write(0, fmt = '(a,i2,a$)') '|',i,':'
        end do
        write (0,fmt = '(a1)') '|'
    end subroutine
    !
    subroutine cap(n)
        integer :: n, i
        do i =1,n
            write (0,fmt = '(a$)') '+---'
        end do
        write (0,fmt = '(a)') '+'
    end subroutine
    !
    subroutine write_array(array,n)
        integer :: n, i
        integer :: array(n)
        write (0,*)
        call cap(n+1)
        call numbers(n)
        call cap(n+1)
        write (0,fmt = '(a$)') '| / '
        do i = 1,n
            write (0,fmt = '(a,i2,a$)') '|', array(i),' '
        end do
        write (0,fmt = '(a)') '|'
        call cap(n+1)
        write (0,*)
    end subroutine
    !
    subroutine write_matrix(matrix, n)
        integer :: n
        integer :: matrix(n,n), k, l
        !
        write (0,*)
        call cap(n+1)
        call numbers(n)
        do k = 1,n
            call cap(n+1)
            write (0, fmt='(a,i2,a$)') '|', k, ':'
            do l = 1,n
                if ( matrix(k,l)>10000 ) then
                    write (0, fmt = '(a$)') '|inf'
                else
                    write (0,fmt='(a,i3$)') '|',matrix(k,l)
                end if
            end do
            write (0,fmt='(a)') '|'
        end do
        call cap(n+1)
        write (0,*)
    end subroutine
    !
    integer function minimum(array,n) result(res_index)
        integer :: n, i
        integer :: array(n)
        res_index = 1
        do i =1,n,1
            if( array(i)<array(res_index) ) then
                res_index = i
            end if
        end do
    end function
    !
    subroutine min_stroka(matrix,n,stroka_min)
        integer :: n, i
        integer :: matrix(n,n), stroka_min(n),temp_array(n)
        do i =1,n
            temp_array = matrix(i,:)
            stroka_min(i) = matrix(i, minimum(temp_array,n))
        end do
    end subroutine
    !
    subroutine min_stolbec(matrix,n,stolbec_min)
        integer :: n, i
        integer :: matrix(n,n), stolbec_min(n),temp_array(n)
        do i =1,n
            temp_array = matrix(:,i)
            stolbec_min(i) = matrix(minimum(temp_array,n), i)
        end do
    end subroutine
    !
    subroutine transform(matrix, n, summa)
        integer :: n,i, summa_1, summa_2, summa
        integer :: matrix(n,n), temp_matrix(n,n), stroka_min(n), stolbec_min(n)
        ! 1 sequence of actions
        temp_matrix = matrix
        !
        call min_stroka(temp_matrix,n,stroka_min)
        write (0,fmt = '(a$)') 'Massiv strok: '
        do i = 1,n
            temp_matrix(i,:) = temp_matrix(i,:) - stroka_min(i)
        end do
        call write_array(stroka_min,n)
        call min_stolbec(temp_matrix,n,stolbec_min)
        do i = 1,n
            temp_matrix(:,i) = temp_matrix(:,i) - stolbec_min(i)
        end do
        write (0,fmt = '(a$)') 'Massiv stolbcov: '
        call write_array(stolbec_min,n)
        call write_matrix(temp_matrix,n)
        !
        summa_1 = sum(stroka_min) + sum(stolbec_min)
        ! 2 sequence of actions
        temp_matrix = matrix
        !
        call min_stolbec(temp_matrix,n,stolbec_min)
        do i = 1,n
            temp_matrix(:,i) = temp_matrix(:,i) - stolbec_min(i)
        end do
        write (0,fmt = '(a$)') 'Massiv stolbcov: '
        call write_array(stolbec_min,n)
        call min_stroka(temp_matrix,n,stroka_min)
        do i = 1,n
            temp_matrix(i,:) = temp_matrix(i,:) - stroka_min(i)
        end do
        write (0,fmt = '(a$)') 'Massiv strok: '
        call write_array(stroka_min,n)
        call write_matrix(temp_matrix,n)
        !
        summa_2 = sum(stroka_min) + sum(stolbec_min)
        !
        write (0,fmt = '(a,i3)') 'Sum then stroki first then stolbcy:',summa_1
        write (0,fmt = '(a,i3)') 'Sum then stolbcy first then stroki:',summa_2
        if (summa_1>summa_2) then
            summa = summa_1
            !do i =1,n
                !temp_array = matrix(i,:)
                !stroka_min(i) = matrix(i, minimum(temp_array,n))
            !end do
            call min_stroka(matrix,n,stroka_min)
            do i = 1,n
                matrix(i,:) = matrix(i,:) - stroka_min(i)
            end do
            call min_stolbec(matrix,n,stolbec_min)
            do i = 1,n
                matrix(:,i) = matrix(:,i) - stolbec_min(i)
            end do
        else
            summa = summa_2
            call min_stolbec(matrix,n,stolbec_min)
            do i = 1,n
                matrix(:,i) = matrix(:,i) - stolbec_min(i)
            end do
            call min_stroka(matrix,n,stroka_min)
            do i = 1,n
                matrix(i,:) = matrix(i,:) - stroka_min(i)
            end do
        end if
    end subroutine
end module