Метад пераўтварэння многапрамянёвых зорак ў поўныя многавугольнiкi (Лабараторная работа № 4), страница 14

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

C         вузлы з найменшай колькасцю далучаных да iх галiн, затым - з

C         большай, i г.д. (аптымiзацыя пераутварэнняу многапрамяневай

C         зоркi у поуны многавугольнiк)

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: Выдзяленне са спiсау галiн схемы (масiвы N1K(KH),N2K

C         (KH),Y(KH),JY(KH)) тых галiн, якiя утвараюць многапраC         мяневую зорку у вузле NW(IUZ) (масiвы NWMPZ(KHMPZ),

C         YHMPZ)KHMPZ),JHMPZ(KHMPZ)

C   NWW - Нумар Вузла Выдаляемага

C   YSUM - Праводнасць СУМарная (уласная) выдаляемага вузла

C   KHNWD - Колькасць Галiн НяВыДаленых

C   KHMPZ - Колькасць Галiн МногаПрамяневай Зоркi

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: Цi утрымлiвае многапрамяневая зорка толькi адзiн прамень?

860 IF(KHMPZ.LE.1) GO TO 29

C Блок 107: Аб'яднанне некалькiх паралельных галiн многапрамяневай зоркi

C         (калi яны есць) у адну

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: Пераутварэнне многапрамяневай зоркi у поуны многавугольнiк.

C         Колькасць галiн многавугольнiка роуна колькасцi злучэнняу

C         з n па два, дзе n-колькасць прамянеу многапрамяневай зоркi.

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,*)' Вымернасць масiвау N1K(100),N2K(100),Y(100),JY(100) у

*падпраграме ZHORTKA/ недастатковая для вашай задачы. Разлiк заканч

*ваецца'

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: Запамiнанне каэфiцыентау вузлавога раунання для выдаляемага

C вузла (раунання з трыангуляванай матрыцай) у выхадных масiвах

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,*)' Вымернасць масiвау NWMPZWW(300),YHMPZWW(300) у падпра

*граме ZHORTKA /недастатковая для вашай задачы.Разлiк заканчваецца'

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: Новае значэнне для бягучай колькасцi галiн

870 KHB=KHNWD

32 CONTINUE

RETURN

END