C образом, чтобы среди неудаленных узлов сначала находились
C узлы с наименьшим количеством присоединенных к ним ветвей, затем - с
C большей, и т.д. (Оптимизация преобразований многолучевой
C звезды в полный многоугольник)
840 M=IUZ
DO 5 K=1,KHMAX
DO 4 L=IUZ,KW
IF(KHDNW(L).NE.K) GO TO 4
NWA(M)=NW(L)
M=M+1
4 CONTINUE
5 CONTINUE
DO 6 J=IUZ,KW
6 NW(J)=NWA(J)
IF(NDRUK.EQ.0) GO TO 850
WRITE(3,*)' БЛОК 104',' KW=',KW,' NW(KW)',(NW(I),I=1,KW)
C Блок 105: Выделение из списка ветвей схемы (массива N1K (KH), N2K
C (KH), Y (KH), JY (KH)) тех отраслей, которые образуют многолучевую
C звезду в узле NW (IUZ) (массива NWMPZ (KHMPZ), C YHMPZ) KHMPZ), JHMPZ (KHMPZ)
C NWW - Номер Узла удаляемого
C YSUM - Проводимость Суммарная (собственная) удаляемого узла
C KHNWD - Количество ветвей Неудаленных
C KHMPZ - Количество ветвей многолучевой Звезды 850 NWW=NW(IUZ)
YSUM=0.
KHNWD=0
KHMPZ=0
DO 13 I=1,KHB
IF(NWW.EQ.N1K(I)) GO TO 10
IF(NWW.EQ.N2K(I)) GO TO 11
KHNWD=KHNWD+1
N1K(KHNWD)=N1K(I)
N2K(KHNWD)=N2K(I)
Y(KHNWD)=Y(I)
JY(KHNWD)=JY(I)
GO TO 13
10 M=N2K(I)
GO TO 12
11 M=N1K(I)
12 KHMPZ=KHMPZ+1
NWMPZ(KHMPZ)=M
YSUM=YSUM+Y(I)
YHMPZ(KHMPZ)=Y(I)
JHMPZ(KHMPZ)=JY(I)
13 CONTINUE
IF(NDRUK.EQ.0) GO TO 860
WRITE(3,*)' БЛОК 105',' KHNWD=',KHNWD
WRITE(3,*)' N1K(KHNWD),N2K(KHNWD),Y(KHNWD),JY(KHNWD)=',
*(N1K(I),N2K(I),Y(I),JY(I),I=1,KHNWD)
WRITE(3,*)' KHMPZ=',KHMPZ,' YSUM=',YSUM
WRITE(3,*)' NWMPZ(KHMPZ),YHMPZ(KHMPZ),JHMPZ(KHMPZ)=',
*(NWMPZ(I),YHMPZ(I),JHMPZ(I),I=1,KHMPZ)
C Блок 106: Содержит ли многолучевая звезда только один луч?
860 IF (KHMPZ.LE.1) GO TO 29
C Блок 107: Объединение нескольких параллельных ветвей многолучевой звезды
C (если они есть) в одну M1=1
14 M2=M1
15 M2=M2+1
IF(NWMPZ(M1).NE.NWMPZ(M2)) GO TO 17
YHMPZ(M1)=YHMPZ(M1)+YHMPZ(M2)
JHMPZ(M1)=JHMPZ(M1)+JHMPZ(M2)
KHMPZ=KHMPZ-1
IF(M2.GT.KHMPZ) GO TO 18
DO 16 I=M2,KHMPZ
YHMPZ(I)=YHMPZ(I+1)
JHMPZ(I)=JHMPZ(I+1)
16 NWMPZ(I)=NWMPZ(I+1)
M=M2-1
17 IF(M2.LT.KHMPZ) GO TO 15
18 M1=M1+1
IF(M1.LT.KHMPZ) GO TO 14
C Блок 108: Преобразование многолучевой звезды в полный многоугольник.
C Количество ветвей многоугольника равно количеству соединений
C из n по два, где n-количество лучей многолучевойк звезды. N=KHMPZ-1
DO 28 K=1,N
M=K+1
DO 27 L=M,KHMPZ
NL=NWMPZ(K)
NP=NWMPZ(L)
NPRZ=0
DO 23 I=1,KHNWD
IF((NL.EQ.N1K(I).AND.NP.EQ.N2K(I)).OR.(NP.EQ.N1K(I).AND.NL.EQ.
*N2K(I))) GO TO 20
GO TO 23
20 IF(NL.EQ.0) GO TO 21
JY(I)=JY(I)+JHMPZ(L)*YHMPZ(K)/YSUM
GO TO 22
21 JY(I)=JY(I)+JHMPZ(K)*YHMPZ(L)/YSUM
22 Y(I)=Y(I)+YHMPZ(K)*YHMPZ(L)/YSUM
NPRZ=1
23 CONTINUE
IF(NPRZ.EQ.1) GO TO 27
24 KHNWD=KHNWD+1
IF(KHNWD.LE.100) GO TO 33
WRITE (3, *) 'Размерность массивов N1K (100), N2K (100), Y (100), JY (100) в
* подпрограмме ZHORTKA / недостаточна для вашей задачи. Расчет заканчи
*ватся '
STOP
33 N1K(KHNWD)=NL
N2K(KHNWD)=NP
IF(NL.EQ.0) GO TO 25
JY(KHNWD)=JHMPZ(L)*YHMPZ(K)/YSUM
GO TO 26
25 JY(KHNWD)=JHMPZ(K)*YHMPZ(L)/YSUM
26 Y(KHNWD)=YHMPZ(K)*YHMPZ(L)/YSUM
27 CONTINUE
28 CONTINUE
IF(NDRUK.EQ.0) GO TO 29
WRITE(3,*)' БЛОК 108',' KHNWD=',KHNWD
WRITE(3,*)' N1K(KHNWD),N2K(KHNWD),Y(KHNWD),JY(KHNWD)=',
*(N1K(I),N2K(I),Y(I),JY(I),I=1,KHNWD)
C Блок 109: Запоминание коэффициентов узлового уравнения для удаляемого
C узла (уравнения с трыангуляванай матрицой) в выходных массивах
C YSMPZWW(KW),JMPZWW(KW),NWMPZWW(KNNE),YHMPZWW(KNNE)
29 YSMPZWW(IUZ)=YSUM
DO 31 K=1,KHMPZ
IF(NWMPZ(K).NE.0) GO TO 30
JMPZWW(IUZ)=JHMPZ(K)
GO TO 31
30 KHMPZWW(IUZ)=KHMPZWW(IUZ)+1
KNNE=KNNE+1
IF(KNNE.LE.300) GO TO 35
WRITE(5,*)' Размерносць массивов NWMPZWW(300),YHMPZWW(300) в подпро
*грамме ZHORTKA /недостаточная для вашей задачи.Рассчёт заканчивается'
STOP
35 NWMPZWW(KNNE)=NWMPZ(K)
YHMPZWW(KNNE)=YHMPZ(K)
31 CONTINUE
IF(NDRUK.EQ.0) GO TO 870
WRITE(3,*)' БЛОК 109',' KNNE=',KNNE
WRITE(3,*)' NWMPZWW(KNNE),YHMPZWW(KNNE)=',(NWMPZWW(I),YHMPZWW(I),
*I=1,KNNE)
WRITE(3,*)' IUZ=',IUZ,' KHMPZWW(IUZ),YSMPZWW(IUZ),JMPZWW(IUZ)=',
*(KHMPZWW(I),YSMPZWW(I),JMPZWW(I),I=1,IUZ)
C Блок 110: Новое значение для текущего количества ветвей
870 KHB=KHNWD
32 CONTINUE
RETURN
END
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.