Диссертация Акимжанов

151

DO 1058 K=K2,K3 PD(1,I)=PD(1,I)+PPP(I,K)

1058 CONTINUE PD(2,I)=PD(1,I)-PPP(I,1) PD(3,I)=PD(2,I)/PD(1,I)*100

1054 CONTINUE IF(JJ.EQ.1)WRITE(8,452)AAH

452 FORMAT(35X,'СТРУКТУРА ПОТЕРЬ ЭНЕРГИИ И МОЩНОСТИ В ВОЗДУШНЫХ ЛИНИЯХ

/, ПРИМЫКАЮЩИХ К ПОДСТАНЦИИ "',15A1,'"') IF(JJ.EQ.1)WRITE(8,401)('-',k=1,151) IF(JJ.EQ.1)WRITE(8,402)

IF(JJ.EQ.1)WRITE(8,416)

416FORMAT ('Iп/пIприсоединенияI--------------------------------------

/-----I------------------------------------------------------------

/---------------------------I') IF(JJ.EQ.1)WRITE(8,403)

/м. ','I',' Методика ','I','Высш.гарм.','I',' W1% ','I',' W2% ','I' /,' W3% ','I',' W4% ','I', ' W5% ','I',' W6% ','I',' W7% ','I',' W8 /%','I',' W9% ','I',' W10%','I',' W11%','I',' W12%','I',' W13%','I'

/,' прочие ','I')

404FORMAT('I',I3,'I',13A1,'I',F10.3,'I', F10.3,'I', F10.3,'I', F10.3, /'I',F5.2,'I', F5.2,'I', F5.2,'I',F5.2,'I',F5.2,'I',F5.2,'I',F5.2,' /I',F5.2,'I',F5.2,'I',F5.2,'I',F5.2,'I',F5.2,'I',F5.2,'I',F9.2,'I')

WRITE(8,401)( '-',k=1,151) 400 CONTINUE

GOTO 470 405 FORMAT(////)

IF(JJ.EQ.1)WRITE(8,454)AAH

454 FORMAT(35X,'ИТОГИ ИНСТРУМЕНТАЛЬНОГО ОБСЛЕДОВАНИЯ ПОДСТАНЦИИ

"',

/15A1,'" (продолжение)')

IF(JJ.EQ.1)WRITE(8,401)('-',k=1,136) IF(JJ.EQ.1)WRITE(8,406)

406 FORMAT('I',' № ','I','Наименование ','I',' Кu% (напряжения) (max)'

IF(JJ.EQ.1)WRITE(8,401)('-',k=1,136)

DO 412 K=2,N

WRITE(8,401)('-',k=1,136)

152

408FORMAT('I',I3,'I',13A1,'I', F6.3,1X,'I', F6.3,1X,'I', F6.3,1X,'I', / F6.3 ,1X,'I', F6.3,1X,'I', F6.3,1X,'I',F6.3,1X,'I',F6.3,1X,'I',F6 /.3,1X,'I',F6.3,1X,'I',F6.3,1X,'I',F6.3,1X,'I',F8.3,1X,'I'F9.3,1X,'

6FORMAT(20F15.10)

7FORMAT(8I6)

70 FORMAT(I4,2I10,F12.1,5I8)

77FORMAT('******************************************************')

78FORMAT('FFU2')

79FORMAT('FFI2')

8FORMAT(24F20.15)

9FORMAT(20x,24F20.15) 99 format(24f25.10)

196FORMAT(60E25.10)

CLOSE(4)

CLOSE(5)

CLOSE(7)

CLOSE(8)

CLOSE(9)

CLOSE(10)

CLOSE(11)

CLOSE(12)

CLOSE(1)

CLOSE(13)

CLOSE(14)

CLOSE(15)

CLOSE(16)

CLOSE(17)

CLOSE(18) STOP

END C=================================================================

SUBROUTINE RASCHET(UK1,AIK1,LL,NN,PPP,PP1,PP2,ppp1,ppp2,ppp3, /ppp4,ppp5,ppp6,ppp7,ppp8)

COMMON MM,M,M1,MT,M10,M20,PR,K1,K2,K3,N1,N2,N3,MPR,MTR,MMT DOUBLE PRECISION XA(M),YA(M),XL1(M,M),D(M,M),HC(M,M),UXM(M), /HC1(M,M),HC2(M,M),HC3(M,M),HC4(M,M),F10(M,M),XL(M,M),G(M,M),

153

/DET20,GM(M),OMP(M),R0(M),R(M),S(M),HI(M),R11(M),DET2(M),DET4(M),

/AIXM(M),PPP(1000,50),PP1,PP2,

/PPP1(1000,50),PPP2(1000,50),PPP3(1000,50),PPP4(1000,50),

/PPP5(1000,50),PPP6(1000,50),PPP7(1000,50),PPP8(1000,50)

COMPLEX Z(M,M)*16,Y(M,M)*16,AU(M,M)*16,E(M,M)*16,F(M,M)*16, /EVU(M)*16,B(M)*16,UX(M)*16,AIX(M)*16,AAI(M,M)*16,UK1(M)*16, /AIK1(M)*16,B1(M20)*16,B4(M20)*16,SM(M),B5(M20)*16,B6(M10)*16, /B7(M10)*16,B10(M10)*16,F1(M,M)*16,F2(M,M)*16,D1(M,M)*16, /D2(M,M)*16,D3(M,M)*16,EVI(M)*16,LU(M,M)*16,LI(M,M)*16, /LU1(M,M)*16,LI1(M,M)*16,LU2(M,M)*16,LU3(M,M)*16,LI2(M,M)*16, /LI3(M,M)*16,AG(M1,M,M)*16,DET10*16,DET1(M)*16,F3(M,M)*16, /F4(M,M)*16,F5(M,M)*16,F6(M,M)*16,F7(M,M)*16,DET3(M)*16,EX1*16, /GG1(M20,M20)*16,GG2(M20,M20)*16,GG3(M10,M20)*16,GG4(M10,M10)*16, /GG5(M10,M10)*16,A1(M1,M1)*16,A2(M1,M1)*16,HH(M10,M10)*16, /GG(M20,M20)*16,CC(M,M)*16,DD(M,M)*16,HH11(M,M)*16,HH12(M,M)*16, /HH13(M,M)*16,HH14(M,M)*16,HH21(M,M)*16,HH22(M,M)*16,HH23(M,M)*16, /HH24(M,M)*16,HH31(M,M)*16,HH32(M,M)*16,HH33(M,M)*16,HH34(M,M)*16, /HH41(M,M)*16,HH42(M,M)*16,HH43(M,M)*16,HH44(M,M)*16,AA(M)*16, /BB(M)*16,SS*16,SS1*16

INTEGER IPVT1(M1),IH(M20)

**********************************************************************

IF(PR.EQ.1)PP1=0.

IF(PR.EQ.2)PP2=0.

PPP(NN,LL)=0.

PPP1(NN,LL)=0.

PPP2(NN,LL)=0.

PPP3(NN,LL)=0.

PPP4(NN,LL)=0.

PPP5(NN,LL)=0.

PPP6(NN,LL)=0.

PPP7(NN,LL)=0.

PPP8(NN,LL)=0.

**********************************************************************

PI=3.14159

RZ=35.3

MMT=MM/MT

W=FLOAT(LL) EX1=CMPLX(2.71828, 0.) REWIND 2

READ(2,195) (XA(I), I=1,M)

WRITE(5,195) (XA(I),I=1,M)

READ(2,195) (YA(I),I=1,M)

WRITE(5,195) (YA(I),I=1,M)

READ(2,195) (OMP(I),I=1,M)

WRITE(5,195) (OMP(I),I=1,M) READ(2,195) (GM(I),I=1,M) WRITE(5,195) (GM(I), I=1,M) READ(2,195) (S(I), I=1,M) WRITE(5,195) (S(I), I=1,M) READ (2,191) IH

WRITE (5,191) IH DO 845 I=1,M

154

R(I)=SQRT(S(I)/PI)/1000.

HI(I)=R(I)/(2.)*SQRT(2*PI*W*50*4*PI*OMP(I)*GM(I)/20.)

R0(I)=1000./(GM(I)*S(I))

IF(HI(I).LT.1) R11(I)=R0(I)*(1+HI(I)**4/3.) IF(HI(I).GT.1) R11(I)=R0(I)*(HI(I)+0.25+3./(64.*HI(I))) IF(I.EQ.M)WRITE(12,198) R11

845 CONTINUE

1CONTINUE DO 12 I=1,M10 DO 12 J=1,M10 HH(I,J)=0.

12CONTINUE DO 161 I=1,M DO 161 J=1,M

IF(I.EQ.J)D(I,I)=R(I) IF(I.NE.J)D(I,J)=SQRT((XA(I)-XA(J))**2+(YA(I)-YA(J))**2) HC(I,J)=SQRT((XA(I)-XA(J))**2+(YA(I)+YA(J))**2)

E(I,J)=CMPLX(0.0, 0.0)

E(I,I)=CMPLX(1.0, 0.0)

161CONTINUE DO 740 I=1,M

DO 740 J=1,M XL1(I,J)=0.145*DLOG10(1000./D(I,J))/314.16

740 CONTINUE DO 743 I=1,M DO 743 J=1,M

HC1(I,J)=41.4*10.**6*DLOG10(HC(I,J)/D(I,J))

743CONTINUE

CALL DLINRG(M,HC1,M,HC3,M)

CALL DMRRRR(M,M,HC1,M,M,M,HC3,M,M,M,F10,M) DO 744 I=1,M

DO 744 J=1,M HC2(I,J)=HC3(I,J)*2.*PI*50.

744CONTINUE

DO 847 I=1,M

DO 847 J=1,M

XL(I,J)=XL1(I,J)*W*2*50*PI

HC4(I,J)=HC2(I,J)*W

R10=0.0

IF(I.EQ.J)Z(I,J)=CMPLX(R11(I),XL(I,J))

IF(I.NE.J)Z(I,J)=CMPLX(R10,XL(I,J))

IF(I.EQ.J)G(I,J)=0.00000004*YA(I)/YA(I)

IF(I.NE.J)G(I,J)=-0.00000004*YA(1)/D(I,J)

G(I,J)=0.

Y(I,J)=CMPLX(G(I,J),HC4(I,J))

847CONTINUE

DO 1300 III=1,MT IF(M.NE.3)GOTO 767 DO 761 I=1,3 B5(I)=UK1(I) B5(I+3)=AIK1(I) B5(I+6)=CMPLX(0.,0.)

155

B5(I+9)=CMPLX(0.,0.) 761 CONTINUE

767IF(M.NE.4)GOTO 768 DO 762 I=1,3 B5(I)=UK1(I) B5(M)=CMPLX(0.,0.) B5(I+M)=AIK1(I) B5(2*M)=CMPLX(0.,0.) B5(I+2*M)=CMPLX(0.,0.) B5(3*M)=CMPLX(0.,0.) B5(I+3*M)=CMPLX(0.,0.)

B5(4*M)=CMPLX(0.,0.) 762 CONTINUE

768IF(M.NE.6)GOTO 769 DO 764 I=1,3 B5(I)=UK1(I) B5(I+3)=UK1(I) B5(I+M)=AIK1(I) B5(I+M+3)=AIK1(I) B5(I+2*M)=CMPLX(0.,0.)

B5(I+2*M+3)=CMPLX(0.,0.)

B5(I+3*M)=CMPLX(0.,0.)

B5(I+3*M+3)=CMPLX(0.,0.) 764 CONTINUE

769IF(M.NE.7)GOTO 770 DO 765 I=1,3 B5(I)=UK1(I) B5(I+3)=UK1(I) B5(M)=CMPLX(0.,0.) B5(I+M)=AIK1(I) B5(I+M+3)=AIK1(I) B5(2*M)=CMPLX(0.,0.) B5(I+2*M)=CMPLX(0.,0.)

B5(I+2*M+3)=CMPLX(0.,0.)

B5(3*M)=CMPLX(0.,0.)

B5(I+3*M)=CMPLX(0.,0.)

B5(I+3*M+3)=CMPLX(0.,0.)

B5(4*M)=CMPLX(0.,0.) 765 CONTINUE

770IF(M.NE.8)GOTO 771 DO 766 I=1,3 B5(I)=UK1(I) B5(I+3)=UK1(I)

B5(MPR+1)=CMPLX(0.,0.)

B5(MPR+2)=CMPLX(0.,0.)

B5(I+M)=AIK1(I)

B5(I+M+3)=AIK1(I) B5(2*M-1)=CMPLX(0.,0.) B5(2*M)=CMPLX(0.,0.) B5(I+2*M)=CMPLX(0.,0.) B5(I+2*M+3)=CMPLX(0.,0.) B5(3*M-1)=CMPLX(0.,0.)

156

B5(3*M)=CMPLX(0.,0.)

B5(I+3*M)=CMPLX(0.,0.)

B5(I+3*M+3)=CMPLX(0.,0.) B5(4*M-1)=CMPLX(0.,0.) B5(4*M)=CMPLX(0.,0.)

766 CONTINUE

771 CONTINUE C********************************************************************** C ВЫЧИСЛЕНИЕ МАТРИЦЫ LU

CПЕРЕМНОЖЕНИЕ МАТРИЦ ПАРАМЕТРОВ

CALL DMCRCR(M,M,Z,M,M,M,Y,M,M,M,AU,M) SS1=CDSQRT(AU(1,1))

CВЫЧИСЛЕНИЕ СОБСТВЕННЫХ ЗНАЧЕНИЙ МАТРИЦЫ АU CALL DEVLCG(M,AU,M,EVU)

GOTO 1008

C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

CФОРМИРОВАНИЕ МАТРИЦЫ ВАНДЕРМОНДА

DO 20 J=1,M DO 20 I=1,M

F(I,J)=EVU(I)**(J-1) F1(I,J)=F(I,J)

20 CONTINUE

CФАКТОРИЗАЦИЯ МАТРИЦЫ ВАНДЕРМОНДА

DO 201 I=1,M1

157

DO 201 J=1,M1 A1(I,J)=F(I,J)

201 CONTINUE

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CALL DLFDCG(M1,A2,M1,IPVT1,DET10,DET20)

CВЫЧИСЛЕНИЕ ОПРЕДЕЛИТЕЛЯ ВАНДЕРМОНДА

CONTINUE SS=DET10*(10.**DET20)

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

DO 21 J=1,M1 DO 211 II=1,M1

DO 211 JJ=1,M1

F(II,JJ)=F1(II,JJ)

211CONTINUE DO 22 I=1,M1

F(I,J)=EVU(I)**0.5 22 CONTINUE

DO 202 II=1,M1 DO 202 JJ=1,M1 A1(II,JJ)=F(II,JJ)

202 CONTINUE

C ФАКТОРИЗАЦИЯ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ ОПРЕДЕЛИТЕЛЕЙ ВАНДЕРМОНДА

CALL DLFDCG(M1,A2,M1,IPVT1,DET1(J),DET2(J))

21 CONTINUE

C ВЫЧИСЛЕНИЕ ЗНАЧЕНИЯ ФУНКЦИИ ОТ МАТРИЦЫ

1700 CONTINUE

CALL DMCRCR(M,M,AU, M,M,M,AU,M,M,M,F2,M) CALL DMCRCR(M,M,F2,M,M,M,AU,M,M,M,F3,M) CALL DMCRCR(M,M,F3,M,M,M,AU,M,M,M,F4,M) CALL DMCRCR(M,M,F4,M,M,M,AU,M,M,M,F5,M) CALL DMCRCR(M,M,F5,M,M,M,AU,M,M,M,F6,M) CALL DMCRCR(M,M,F6,M,M,M,AU,M,M,M,F7,M) DO 441 I=1,M1

DO 441 II=1,M

DO 441 JJ=1,M IF(I.EQ.1)AG(1,II,JJ)=E(II,JJ) IF(I.EQ.2)AG(2,II,JJ)=AU(II,JJ) IF(I.EQ.3)AG(3,II,JJ)=F2(II,JJ) IF(I.EQ.4)AG(4,II,JJ)=F3(II,JJ) IF(I.EQ.5)AG(5,II,JJ)=F4(II,JJ) IF(I.EQ.6)AG(6,II,JJ)=F5(II,JJ) IF(I.EQ.7)AG(7,II,JJ)=F6(II,JJ) IF(I.EQ.8)AG(8,II,JJ)=F7(II,JJ)

441CONTINUE DO 442 II=1,M

DO 442 JJ=1,M LU(II,JJ)=0.

442CONTINUE DO 410 I=1,M1

DET3(I)=DET1(I)/DET10

158

DET4(I)=DET2(I)-DET20 DO 410 II=1,M

DO 410 JJ=1,M LU(II,JJ)=LU(II,JJ)+AG(I,II,JJ)*DET3(I)*(10**DET4(I))

410 CONTINUE

CALL DMCRCR(M,M,LU,M,M,M,LU,M,M,M,F3,M) C************************************************************ C ВЫЧИСЛЕНИЕ МАТРИЦЫ LI

C ПЕРЕМНОЖЕНИЕ МАТРИЦ ПАРАМЕТРОВ

CALL DMCRCR(M,M,Y,M,M,M,Z,M,M,M,AAI,M)

C ВЫЧИСЛЕНИЕ СОБСТВЕННЫХ ЗНАЧЕНИЙ МАТРИЦЫ AAI CALL DEVLCG(M,AAI,M,EVI)

CФОРМИРОВАНИЕ МАТРИЦЫ ВАНДЕРМОНДА

DO 1120 J=1,M DO 1120 I=1,M

F(I,J)=EVI(I)**(J-1) F1(I,J)=F(I,J)

1120 CONTINUE

CФАКТОРИЗАЦИЯ МАТРИЦЫ ВАНДЕРМОНДА

DO 1201 I=1,M1 DO 1201 J=1,M1

A1(I,J)=F(I,J) 1201 CONTINUE

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CВЫЧИСЛЕНИЕ ОПРЕДЕЛИТЕЛЯ ВАНДЕРМОНДА

CALL DLFDCG(M1,A2,M1,IPVT1,DET10,DET20)

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

DO 121 J=1,M1 DO 1211 II=1,M1

DO 1211 JJ=1,M1

F(II,JJ)=F1(II,JJ) 1211 CONTINUE

DO 122 I=1,M1 F(I,J)=EVI(I)**0.5

122CONTINUE

DO 1202 II=1,M1 DO 1202 JJ=1,M1

A1(II,JJ)=F(II,JJ) 1202 CONTINUE

C ФАКТОРИЗАЦИЯ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ ОПРЕДЕЛИТЕЛЕЙ ВАНДЕРМОНДА

CALL DLFDCG(M1,A2,M1,IPVT1,DET1(J),DET2(J))

121 CONTINUE

C ВЫЧИСЛЕНИЕ ЗНАЧЕНИЯ ФУНКЦИИ ОТ МАТРИЦЫ

11700 CONTINUE

CALL DMCRCR(M,M,AAI, M,M,M,AAI,M,M,M,F2,M) CALL DMCRCR(M,M,F2,M,M,M,AAI,M,M,M,F3,M) CALL DMCRCR(M,M,F3,M,M,M,AAI,M,M,M,F4,M) CALL DMCRCR(M,M,F4,M,M,M,AAI,M,M,M,F5,M) CALL DMCRCR(M,M,F5,M,M,M,AAI,M,M,M,F6,M) CALL DMCRCR(M,M,F6,M,M,M,AAI,M,M,M,F7,M)

LM=MMT

DO 7301 N=1,2

IF (N.EQ.1) SA=-1.

IF (N.EQ.2) SA=1.

CВЫЧИСЛЕНИЕ МАТРИЧНЫХ ЭКСПОНЕНЦИАЛЬНЫХ ФУНКЦИЙ

DO 7011 II=1,M

DO 7011 JJ=1,M LU1(II,JJ)=SA*MMT*LU(II,JJ)

7011 CONTINUE C*********************************************************************

CВЫЧИСЛЕНИЕ СОБСТВЕННЫХ ЗНАЧЕНИЙ МАТРИЦЫ LU1 CALL DEVLCG(M,LU1,M,EVU)

CФОРМИРОВАНИЕ МАТРИЦЫ ВАНДЕРМОНДА

DO 720 I=1,M

DO 720 J=1,M

F(I,J)=EVU(I)**(J-1)

720CONTINUE DO 7201 II=1,M

DO 7201 JJ=1,M

F1(II,JJ)=F(II,JJ) 7201 CONTINUE

DO 7334 II=1,M1

DO 7334 JJ=1,M1

A1(II,JJ)=F(II,JJ) 7334 CONTINUE

C ФАКТОРИЗАЦИЯ МАТРИЦЫ ВАНДЕРМОНДА

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CВЫЧИСЛЕНИЕ ОПРЕДЕЛИТЕЛЯ ВАНДЕРМОНДА

CALL DLFDCG(M1,A2,M1,IPVT1,DET10,DET20)

160

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

DO 7221 J=1,M DO 72211 II=1,M

DO 72211 JJ=1,M

F(II,JJ)=F1(II,JJ) 72211 CONTINUE

DO 7222 I=1,M F(I,J)=EX1**EVU(I)

7222 CONTINUE

DO 7335 II=1,M1

DO 7335 JJ=1,M1

A1(II,JJ)=F(II,JJ) 7335 CONTINUE

CФАКТОРИЗАЦИЯ ДОПОЛНЯЮЩИХ МАТРИЦ ВАНДЕРМОНДА

CALL DLFTCG(M1,A1,M1,A2,M1,IPVT1)

CВЫЧИСЛЕНИЕ ДОПОЛНЯЮЩИХ ОПРЕДЕЛИТЕЛЕЙ ВАНДЕРМОНДА

CALL DLFDCG(M1,A2,M1,IPVT1,DET1(J),DET2(J))

7221 CONTINUE

CALL DMCRCR(M,M,LU1, M,M,M,LU1,M,M,M,F2,M) CALL DMCRCR(M,M,F2,M,M,M,LU1,M,M,M,F3,M) CALL DMCRCR(M,M,F3,M,M,M,LU1,M,M,M,F4,M) CALL DMCRCR(M,M,F4,M,M,M,LU1,M,M,M,F5,M) CALL DMCRCR(M,M,F5,M,M,M,LU1,M,M,M,F6,M) CALL DMCRCR(M,M,F6,M,M,M,LU1,M,M,M,F7,M) DO 7440 I=1,M1

DO 7440 II=1,M

DO 7440 JJ=1,M IF(I.EQ.1)AG(1,II,JJ)=E(II,JJ) IF(I.EQ.2)AG(2,II,JJ)=LU1(II,JJ) IF(I.EQ.3)AG(3,II,JJ)=F2(II,JJ) IF(I.EQ.4)AG(4,II,JJ)=F3(II,JJ) IF(I.EQ.5)AG(5,II,JJ)=F4(II,JJ) IF(I.EQ.6)AG(6,II,JJ)=F5(II,JJ) IF(I.EQ.7)AG(7,II,JJ)=F6(II,JJ) IF(I.EQ.8)AG(8,II,JJ)=F7(II,JJ)

7440 CONTINUE DO 7445 II=1,M DO 7445 JJ=1,M LU2(II,JJ)=0.

7445 CONTINUE

DO 7444 I=1,M1

DO 7444 II=1,M

DO 7444 JJ=1,M LU2(II,JJ)=LU2(II,JJ)+

/(DET1(I)*(10**DET2(I))*AG(I,II,JJ))/(DET10*(10**DET20)) 7444 CONTINUE

IF(N.EQ.2) GOTO 72411 DO 72412 II=1,M

DO 72412 JJ=1,M LU3(II,JJ)=LU2(II,JJ)

72412 CONTINUE

72411 CONTINUE