Расчет токов несимметрических коротких замыканий на ЭВМ (Лабораторная работа № 6), страница 10

*YHMPZWW(300),KHDNW(70),NWA(70),NWMPZ(30),YHMPZ(30),

*AJHMPZ(30)

C Блок 1: Подготовительные операции; KHB - Количество Ветвей Текущее

KHB=KH

KYИJ=0

DO 1 I=1,KW

AJMPZWW(I)=0.

1 KHMPZWW(I)=0

C Начало цикла по удалению узлов из схемы; последовательно удал.

C в порядке возрастания количества присоединенных к ним ветвей все узлы

C схемы, кроме узла КЗ

DO 32 IUZ=1,KW

C Блок 2: Определение количества ветвей, которые присоединены к не удаленным

C узлам, начиная с текущего (удаляемого) узла и кончая последним

C узлом в массиве NW(KW)

DO 7 J=IUZ,KW

KHDNW(J)=0

M=NW(J)

DO 2 K=1,KHB

IF(N1K(K).EQ.M.OR.N2K(K).EQ.M)KHDNW(J)=KHDNW(J)+1

2 CONTINUE

7 CONTINUE

C Блок 3: Определение наибольшего количества ветвей KHMAX, которые

C      присоединены к одному из не удаленных узлов

KHMAX=0

DO 3 J=ИUZ,KW

IF(KHMAX.LT.KHDNW(J))KHMAX=KHDNW(J)

3 CONTINUE

C Блок 4: Перестановка не удаленных номеров узлов в массиве

C NW(KW) таким образом, чтобы среди не удаленных узлов сначала

C находились узлы из наименьшим количеством присоединенных к ним

C ветвей, затем - с большей, и т.д. (оптимизация преобразований

C Многолучевой звезды в полный многоугольник)

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)

C Блок 5: Выделение со списков ветвей схемы (массивы N1K(KH),N2K

C         (KH),Y(KH),AJ(KH)) тех ветвей, которые образовывают многолучевую звезду в узле NW(IUZ) (массивы)

C   NWW - Номер Узла Удаляемого

C   YSUM - Проводимость Суммарная (собственная) удаляемого узла

C   KHNWD - Количество Ветвей Не удаленных

C   KHMPZ - Количество Ветвей Многолучевой Звезды

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)

AJ(KHNWD)=AJ(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)

AJHMPZ(KHMPZ)=AJ(I)

13 CONTINUE

C Блок 6: Содержит ли многолучевая звезда только один луч?

IF(KHMPZ.LE.1) GO TO 29

C Блок 7: Объединение нескольких параллельных ветвей Многолучевой

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)

AJHMPZ(M1)=AJHMPZ(M1)+AJHMPZ(M2)

KHMPZ=KHMPZ-1

IF(M2.GT.KHMPZ) GO TO 18

DO 16 I=M2,KHMPZ

YHMPZ(I)=YHMPZ(I+1)

AJHMPZ(I)=AJHMPZ(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 Блок 8: Преобразование многолуч. звезды в полный многоугольник.

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

AJ(I)=AJ(I)+AJHMPZ(L)*YHMPZ(K)/YSUM

GO TO 22

21 AJ(I)=AJ(I)+AJHMPZ(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),AJ(100) в подпрограмме ZHORTKA/ недостаточная',

*' для вашей задачи. Расчет заканчивается'

STOP

33 N1K(KHNWD)=NL

N2K(KHNWD)=NP

IF(NL.EQ.0) GO TO 25

AJ(KHNWD)=AJHMPZ(L)*YHMPZ(K)/YSUM

GO TO 26

25 AJ(KHNWD)=AJHMPZ(K)*YHMPZ(L)/YSUM

26 Y(KHNWD)=YHMPZ(K)*YHMPZ(L)/YSUM

27 CONTINUE

28 CONTINUE

C Блок 9: Запоминание информации об удаляемом узле в выходных

C массивах YSMPZWW(KW),AJMPZWW(KW),NWMPZWW(KYIJ),YHMPZWW(KYIJ)

29 YSMPZWW(IUZ)=YSUM

DO 31 K=1,KHMPZ

IF(NWMPZ(K).NE.0) GO TO 30

AJMPZWW(IUZ)=AJHMPZ(K)

GO TO 31

30 KHMPZWW(IUZ)=KHMPZWW(IUZ)+1

KYИJ=KYIJ+1

IF(KYIJ.LE.300) GO TO 35

WRITE(5,*)' Размерность массивов NWMPZWW(300),',

*'YHMPZWW(300) в подпрограмме ZHORTKA /недостаточная',

*' для вашей задачи. Расчет заканчивается'

STOP

35 NWMPZWW(KYIJ)=NWMPZ(K)

YHMPZWW(KYIJ)=YHMPZ(K)

31 CONTINUE

C Блок 10: Новое значение для текущего количества ветвей

KHB=KHNWD

32 CONTINUE

RETURN

END

Дополнение 2

2 1 10 2 6 3 1000.