Метод преобразования многолучевой звезды в полный многоугольник (Лабораторная работа № 4), страница 10

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