gistfile1.f90

program prog
integer :: n 
  
integer :: i,j,k,m,l,p, ifact
integer, pointer, dimension(:,:) :: y, y0,  y2, y4, y1
integer, allocatable, target, dimension(:,:) :: b, y3, a
real(8) :: s, t

open(1, file = "C:\projects\hello\numbers.txt")
do_n: do n= 28, 50 
!---------------------------------------------------------вычисляем вектора суммирования y(i,j)--------------------------------------------------------

y0=>froben2(n,n)
allocate(b(n,2))
b=0
b(n-1:n,:)=y0(:,:)
y1=>b
  
allocate(a(n,2:1))
y4=>a

do l=1,n-2
	k=n-l
	m=size(y1)/n

		do_2: do i=1,m

			if (y1(k,i)==0)then
			    y4=>glue1(y4, y1(1:n,i),n) 
			    !write(1,*), y1(1:n,i)
		    else			
				y2=>froben2(k,y1(k,i))
				
				allocate(y3(n,size(y2)/2))
				
				 y3=0
				do_1: do j=1,size(y2)/2 
					y3(1:,j)=y1(1:,i)
				end do do_1
			  	y3(k-1:k,:)=y2(1:,1:)
				y4=>glue(y4,y3,n)

				deallocate(y3)
			
			endif
	!		write(*,*), y4
		end do do_2
		y1=>eq(y4,n)
		y4=>a
end do	
!-----------------------------------поправляем решение уравнения фробениуса-----------------------------------			
deallocate(b)
y=>a
k=(n-2)/4

do i=1,size(y1)/n	
	j=0
	p=0
	l=0
	
	do while(j<k .and. p==0)
		j=j+1
		l=2*(2*j+1)
		p=y1(l,i)
	end do
	
	if (j==k .and. p==0) then
	 y=>glue1(y,y1(1:n,i),n)
	 endif
 end do
 
!---------------------------------------------------------------конец для вектора суммирования-----------------------------------------------------------


   k=1000000000+n;
    write(1,*) k
    write(1,*) size(y)  
	do i=1,(size(y)/n)
	    do_in: do j=1,n
	     write(1,*) y(j,i)
	     end do do_in
    end do 
    
     
     
      write(*,*),  k
      write(*,*) size(y) 
      write(*,*),  y
      
     end do do_n
  close(1)
  
  
	
	

    read(*,*) 
 
 !===========================================================================================================================================     
Contains
  
function froben2 (k, n)  ! вычисляем корни уравнения x+ky=n и записываем в двумерный массив froben2
    integer, pointer, dimension(:,:) :: froben2
	integer :: k, n, i
	allocate(froben2(2,n/k +1))
			If ( k > n) then
			 froben2(:, 1)=[n,0]
			else
			do i = 0,(n/k) 
			
		    froben2(:,i+1) = [n-k*i, i]
			end do
			end if
end function froben2

function glue(a,b,n) ! склейка двух двумерных массивов с одинаковой первой размерностью
	integer, pointer :: glue(:,:)
	integer a(:,:), b(:,:), k, n

	k=(size(a)+size(b))/n
	allocate(glue(n,k))
	glue(:,1:size(a)/n)=a(1:,1:)
	glue(:,1+size(a)/n:k)=b(1:,1:)
end function glue 

function glue1(a,b,n)! склейка массива и строки
	integer, pointer :: glue1(:,:)
	integer a(:,:), b(:), k, n

	k=size(a)/n +1
	allocate(glue1(n,k))
	glue1(1:n,1:k-1)=a(1:n,1:)
	glue1(1:n,k)=b(1:n)
end function glue1 
 
 function eq(y4, n) !запоминание ссылки под новым именем, чтобы не изменять при перестановке
	integer, pointer :: eq(:,:)
	integer :: y4(:,:), n, m
		m=size(y4)/n
	allocate(eq(n,m))
	eq(1:,1:) =  y4(1:,1:)
 end function eq

end program prog