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

WRITE(3,*)' БЛОК 1',' KH=',KH

WRITE(3,*)' N1K(KH),N2K(KH),R(KH),E(KH)=',

*(N1K(I),N2K(I),R(I),E(I),I=1,KH)

WRITE(3,*)' БЛОК 3',' Y(KH),JY(KH)=',(Y(I),JY(I),I=1,KH)

C Блок 4: Падлiк Колькасцi лiнейна незалежных Вузлоу (пераменная KW);

C         утварэнне масiва Нумароу гэтых Вузлоу (масiу NW(KW));

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

C         (гэтая колькасць вузлоу падлягае выдаленню праграмай ZHORTKA)

810 KW=0

DO 36 I=1,99

M=0

DO 35 K=1,KH

IF(I.EQ.N1K(K)) GO TO 34

IF(I.NE.N2K(K)) GO TO 35

34 M=1

35 CONTINUE

IF(M.EQ.0) GO TO 36

KW=KW+1

IF(KW.LE.70) GO TO 245

WRITE(5,244)

244 FORMAT(1X,'ВЫМЕРНАСЦЬ МАСIВАУ NW(70),KNNERAD(70),U(70),

*НЕДАСТАТКОВАЯ ДЛЯ РАШЭННЯ ВАШАЙ ЗАДАЧЫ'/1X,'ПАТРАБУЕЦЦА ПАВ

*ЯЛIЧЭННЕ РАЗМЕРНАСЦЕЙ МАСIВАУ У АПЕРАТАРЫ DIMENSION')

223 WRITE(5,*)' ПРАГРАМА ZORKA НЕ МОЖА ПРАДОУЖЫЦЬ ВЫКАНАННЕ',

*' ВАШАГА ЗАДАННЯ I ЗАВЯРШАЕ РАБОТУ'

STOP

245 NW(KW)=I

36 CONTINUE

KW1=KW-1

IF(NDRUK.EQ.0) GO TO 820

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

C Блок 5: Абнуленне масiвау для падлiку вузлавых напружанняу

820 DO 50 I=1,KW

50 U(I)=0.

C Блок 6: Засылка нумароу вузлоу у рабочыя масiвы для падпраграмы ZHORTKA

DO 40 I=1,KH

N1K1(I)=N1K(I)

40 N2K1(I)=N2K(I)

C Блок 7: Выклiк падпраграмы ZHORTKA (Згортка)

CALL ZHORTKA(N1K1,N2K1,Y,JY,NW,KW1,KH,KNNE,KNNERAD,YDIAG,JU,

*NSNNE,YNNE,NDRUK)

IF(NDRUK.EQ.0) GO TO 830

WRITE(3,*)' БЛОК 7',' KW=',KW,' KNNERAD(KW),YDIAG(KW),JU(KW)=',

*(KNNERAD(I),YDIAG(I),JU(I),I=1,KW)

WRITE(3,*)' KNNE=',KNNE,' NSNNE(KNNE),YNNE(KNNE)=',

*(NSNNE(I),YNNE(I),I=1,KNNE)

C      EREZ - рэзультатыуная ЭРС схемы адносна апошняга вузла, да якога выC             конвалася згортка

C      RREZ - рэзультатыунае супрацiуленне схемы адносна апошняга вузла

830 EREZ=JY(1)/Y(1)

RREZ=1./Y(1)

IF(NDRUK.EQ.0) GO TO 840

WRITE(3,*)' БЛОК 7',' EREZ=',EREZ,' RREZ=',RREZ

C Блок 8: Разлiк вузлавых напружанняу

840 U(KW)=EREZ

M=KW

C NK-нумар канчатковага элемента i-тага радка трыангуляавнай матрыцы

NK=KNNE

55 M=M-1

M1=M+1

C NP-нумар пачатковага элемента i-тага радка трыангуляванай матрыцы

NP=NK-KNNERAD(M)

N=NP+1

DO 52 K=M1,KW

DO 51 L=N,NK

IF(NW(K).EQ.NSNNE(L))U(M)=U(M)+U(K)*YNNE(L)

51 CONTINUE

52 CONTINUE

U(M)=(U(M)+JU(M))/YDIAG(M)

NK=NP

IF(M.GT.1)GO TO 55

IF(NDRUK.EQ.0) GO TO 850

WRITE(3,*)' БЛОК 8',' U(KW)=',(U(I),I=1,KW)

C Блок 9: Разлiк токау у галiнах схемы

850 DO 63 I=1,KH

C N1-Нумар Першага канца галiны

C N2-Нумар Другога канца галiны

C U1-вузлавое Напружанне Першага канца галiны

C U2-вузлавое Напружанне Другога канца галiны

N1=N1K(I)

N2=N2K(I)

IF(N1.EQ.0)GO TO 60

IF(N2.EQ.0)GO TO 152

GO TO 61

60 U1=0

61 DO 62 K=1,KW

IF(N2.NE.NW(K)) GO TO 62

U2=U(K)

62 CONTINUE

IF(N1.EQ.0)GO TO 155

GO TO 153

152 U2=0

153 DO 154 K=1,KW

IF(N1.NE.NW(K))GO TO 154

U1=U(K)

154 CONTINUE

155 IF(N1.GT.N2)GO TO 156

TOK(I)=(U2-U1-E(I))/R(I)

GO TO 63

156 TOK(I)=(U1-U2-E(I))/R(I)

63 CONTINUE

IF(NDRUK.EQ.0) GO TO 108

WRITE(3,*)' БЛОК 9',' TOK(KH)=',(TOK(I),I=1,KH)

C Блок 10: Запiс рэзультатау разлiкау у выхадны

C          файл AAAA.REZ, дзе AAAA - iмя файла уваходных дадзеных

108 WRITE(3,105)(NW(I),U(I),I=1,KW)

105 FORMAT(/' РЭЗУЛЬТАТЫ РАЗЛIКУ:'/'Напружаннi:'/

*'     Вузел   Напружанне'/(I8,F14.5))

WRITE(3,201)(N1K(I),N2K(I),TOK(I),I=1,KH)

201 FORMAT('Токi:'/'       Галiна схмы      Ток'/

*' (Дадатным накiрункам току у галiне лiчыцца накiрунак'/

*' ад канца галiны з большым нумарам да канца з меньшым нумарам)'/

*(I12,I5,F12.4))

C Блок 11: Закрыцце файла выхадных дадзеных на дыску ЭВМ

CLOSE(UNIT=3)

C Блок 12: Выдача канчатковага паверамлення на экран дысплея

WRITE(5,390)Z2

390 FORMAT(1X,'Праграма ZORKA работу закончыла. Рэзультаты разлiку зап

*iсаны на дыск у файл '1X,A8)

STOP

END

C

C

SUBROUTINE ZHORTKA(N1K,N2K,Y,JY,NW,KW,KH,KNNE,KHMPZWW,YSMPZWW,

* JMPZWW,NWMPZWW,YHMPZWW,NDRUK)

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

C   запiсаны апошнiм у масiве NW(KW+1)

C Уваходныя пераменныя i масiвы падпраграмы:

C   N1K(KH) - масiу Нумароу "Першых" Канцоу галiн схемы

C   N2K(KH) - масiу Нумароу "Другiх" Канцоу галiн схемы