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

C   Y(KH) - масiу Праводнасцей галiн схемы

C   JY(KH) - масиiу Токау крынiц току галiн схемы

C   NW(KW+1) - масiу Нумароу лiнейна незалежных Вузлоу схемы; апошнiм у гэтым

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

C   KW - Колькасць лiнейна незалежных Вузлоу схемы мiнус адзiн

C   KH - Колькасць Галiн схемы

C Выахадныя пераменныя i масiвы падпраграмы

C   KNNE - Колькасць галiн з Праводнасцямi Yij, якiя неабходна запомнiць

C          пры выкананнi прамога ходу метада Гауса для таго, каб выканаць

C          разлiк вузлавых напружанняу пры адваротным ходзе (колькасць

C          усiх нянулявых элементау у верхняй трохвугольнай матрыцы каэC          фiцыентау вузлавых раунанняу пасля заканчэння прамога ходу)

C   KHMPZWW(KW) - масiу Колькасцей Галiн МногаПрамяневых Зорак Выдаляемых

C               Вузлоу, якiя былi падключаны да выдаляемага вузла у момант

C               яго выдалення (выкарыстоуваецца пры падлiку напружанняу)

C   YSMPZWW(KW) - масiу Сум Праводнасцей галiн МногаПрамяневых Зорак ВыC               даляемага Вузла, падключаных да выдаляемых вузлоу у моC               мант iх выдалення (дыяганальны каэфiцыент сiстэмы вузлаC               вых раунанняу для раунання, якое адпавядае нумару выдаляC               емага вузла)

C   JMPZWW(KW) - масiу Tокау крынiц току МногаПрамяневых Зорак, якiя "наC               гняталi" ток у Выдаляемы Вузел у момант яго выдалення

C               (правая частка сiстэмы таго вузлавыога раунання, якое адC               павядае нумару выдаляемага вузла)

C   NWMPZWW(KNNE) - масiу Нумароу Вяршынь МногаПрамяневых Зорак ВыдаляеC                   мых Вузлоу, на якiя абапiраецца зорка у момант выдаC                   лення гэтага вузла (нумары слупкоу нянулявых элеменC                   тау у радках верхняй трохвугольнай матрыцы каэфiцыенC                   тау сiстэмы вузлавых раунанняу, якiя адпавядаюць нуC                   мару выдаляемага вузла)

C   YHMPZWW(KNNE) - масiу Праводнасцей Галiн МногаПрамяневых Зорак ВыдаляC                   емых Вузлоу (нянулявыя элементы тых радкоу верхняй

C                   трохвугольнай матрыцы каэфiцыентау сiстэмы вузлавых

C                   раунанняу, якiя адпавядаюць нумару выдаляемага вузла)

C Рабочыя масiвы у падпраграме ZHORTKA

C KHDNW(KW) - Колькасць Галiн, Далучаных да НяВыдаленых вузлоу, пачынаючы

C             ад багучага вузла i канчаючы апошнiм вузлом у спiску NW(KW)

C NWMPZ(KHMPZ) - масiу Нумароу Вузлоу МногаПрамяневай Зоркi

C YHMPZ(KHMPZ) - масiу Праводнасцей Галiн МногаПрамяневай Зоркi

C JHMPZ(KHMPZ) - масiу Токау крынiц току у Галiнах МногаПрамяневай Зоркi

REAL JY,JMPZWW,JHMPZ

DIMENSION N1K(100),N2K(100),Y(100),JY(100),NW(70),

*KHMPZWW(70),YSMPZWW(70),JMPZWW(70),NWMPZWW(300),

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

*JHMPZ(30)

C Блок 101: Падрыхтоука да уваходу у асноуны цыкл

IF(NDRUK.EQ.0) GO TO 800

WRITE(3,*)' БЛОК 101',' KW=',KW,' NW(KW+1)',(NW(I),I=1,KW+1)

WRITE(3,*)' KH=',KH,' N1K(KH),N2K(KH),Y(KH),JY(KH)=',

*(N1K(I),N2K(I),Y(I),JY(I),I=1,KH)

800 KHB=KH

KNNE=0

DO 1 I=1,KW

JMPZWW(I)=0.

1 KHMPZWW(I)=0

C Пачатак цыкла па выдаленню вузлоу са схемы; паслядоуна выдаляюцца

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

C акрамя апошняга вузла

DO 32 IUZ=1,KW

C Блок 102: Вызначэнне колькасцi галiн, якiя далучаны да нявыдаленых вузлоу

C         пачынаючы з бгучага(выдаляемага) вузла i канчаючы апошнiм вузлом

C         у масiве NW(KW)

IF(NDRUK.EQ.0) GO TO 820

WRITE(3,*)' БЛОК 102',' IUZ=',IUZ,' KHB=',KHB

820 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

IF(NDRUK.EQ.0) GO TO 830

WRITE(3,*)' БЛОК 102',' KW=',KW,' KHDNW(KW)=',(KHDNW(I),I=IUZ,KW)

C Блок 103: Вызначэнне найбольшай колькасцi галiн KHMAX, якiя далучаны да

C         аднаго з нявыдаленых вузлоу

830 KHMAX=0

DO 3 J=IUZ,KW

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

3 CONTINUE

IF(NDRUK.EQ.0) GO TO 840

WRITE(3,*)' БЛОК 103',' KHMAX=',KHMAX

C Блок 104: Перастаноука нявыдаленых нумароу вузлоу у масiве NW(KW) такiм