?????????????? ?????? ? ????????? ?????????? ??????? ?????

end program kontur
!********** Подпрограмма расчета топологических матриц ****************
subroutine derevo(yzlov,vetvey,ta,he,C,A)
!ta - массив начальных узлов
!he - массив коненых узлов
real C(vetvey,vetvey),A(vetvey,vetvey)
real workC(vetvey),det(2)
integer ipvtC(vetvey),mderevo(vetvey)
integer yzlov,vetvey,v,ptr,ta(vetvey),he(vetvey)
integer, allocatable::ADJ(:),NEXT(:),VECTOR(:),VISIT(:),LIST(:)
!определение размеров массивов
MAXP1=yzlov+1;IW=MAXP1+2*vetvey
allocate(ADJ(IW),NEXT(IW),VECTOR(MAXP1),VISIT(MAXP1),LIST(MAXP1))
!инициализация переменных
KP=yzlov
ADJ=0;NEXT=0;VECTOR=0;VISIT=0;LIST=0
PTR=0; V=KP; I=KP+1;
do K=1,vetvey
M=ta(K); N=he(K); NEXT(I)=NEXT(M); ADJ(I)=N; NEXT(M)=I;
I=I+1; NEXT(I)=NEXT(N); ADJ(I)=M; NEXT(N)=I; I=I+1;
end do;
LIST(yzlov+1)=0; I=1; N=1; LIST(1)=V; VECTOR(V)=0; VISIT(V)=1;
!поиск узлов ветвей, относящихся к дереву
do while (1==1)
M=LIST(N); PTR=M;
do while (1==1)
NNN=NEXT(PTR); PTR=NNN;
if (PTR==0) exit
J=ADJ(PTR);
if (VISIT(J)==0) then
I=I+1; LIST(I)=J; VISIT(J)=I; VECTOR(J)=M;
end if
end do
N=N+1;
if (LIST(N)==0) exit
end do
!формирование массива с номерами ветвей дерева и хорд
do m=1,vetvey
mderevo(m)=m;
end do;
do k1=1,vetvey
if (VECTOR(k1)/=0) k2=VECTOR(k1)
do m=1,vetvey
if ((ta(m)==k1 .and. he(m)==k2).or.(ta(m)==k2.and.he(m)==k1)) then
mderevo(m)=0;exit
end if
end do
end do
j=yzlov-1
do i=1,vetvey
A(i,ta(i))=1;A(i,he(i))=- 1;
if (ta(i)==yzlov) A(i,ta(i))=0
if (he(i)==yzlov) A(i,he(i))=0
if (mderevo(i)/=0) then
j=j+1;A(i,j)=1
endif
end do
C=transpose(A)
91