Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

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

.pdf
Скачиваний:
55
Добавлен:
13.03.2016
Размер:
2.41 Mб
Скачать

161

CALL DMCRCR(M,M,LU3,M,M,M,LU2,M,M,M,F2,M) 7301 CONTINUE

C********************************************************************** DO 8401 N=1,2

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

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

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

DO 81011 II=1,M DO 81011 JJ=1,M

LI1(II,JJ)=SA*MMT*LI(II,JJ) 81011 CONTINUE

C********************************************************************* C ВЫЧИСЛЕНИЕ СОБСТВЕННЫХ ЗНАЧЕНИЙ МАТРИЦЫ LI1

CALL DEVLCG(M,LI1,M,EVI)

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

DO 8220 I=1,M DO 8220 J=1,M

F(I,J)=EVI(I)**(J-1) 8220 CONTINUE

DO 82201 II=1,M

DO 82201 JJ=1,M

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

DO 8334 II=1,M1

DO 8334 JJ=1,M1

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

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

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

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

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

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

DO 8221 J=1,M DO 82211 II=1,M DO 82211 JJ=1,M

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

DO 8222 I=1,M F(I,J)=EX1**EVI(I)

8222 CONTINUE

DO 8335 II=1,M1

DO 8335 JJ=1,M1

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

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

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

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

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

CALL DMCRCR(M,M,LI1, M,M,M,LI1,M,M,M,F2,M)

CALL DMCRCR(M,M,F2,M,M,M,LI1,M,M,M,F3,M)

CALL DMCRCR(M,M,F3,M,M,M,LI1,M,M,M,F4,M)

162

 

CALL DMCRCR(M,M,F4,M,M,M,LI1,M,M,M,F5,M)

 

CALL DMCRCR(M,M,F5,M,M,M,LI1,M,M,M,F6,M)

 

CALL DMCRCR(M,M,F6,M,M,M,LI1,M,M,M,F7,M)

 

DO 8440 I=1,M1

 

DO 8440 II=1,M

 

DO 8440 JJ=1,M

 

IF(I.EQ.1)AG(1,II,JJ)=E(II,JJ)

 

IF(I.EQ.2)AG(2,II,JJ)=LI1(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)

8440

CONTINUE

 

DO 8445 II=1,M

 

DO 8445 JJ=1,M

 

LI2(II,JJ)=0.

8445

CONTINUE

 

DO 8444 I=1,M1

 

DO 8444 II=1,M

 

DO 8444 JJ=1,M

 

LI2(II,JJ)=LI2(II,JJ)+

 

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

8444

CONTINUE

 

IF(N.EQ.2) GOTO 82411

 

DO 82412 II=1,M

 

DO 82412 JJ=1,M

 

LI3(II,JJ)=LI2(II,JJ)

82412

CONTINUE

82411 CONTINUE

8401

CONTINUE

 

CALL DMCRCR(M,M,LI3, M,M,M,LI2,M,M,M,F2,M)

C**************************************************************************

1112

CONTINUE

 

DO 102 I=1,M20

 

DO 102 J=1,M20

GG(I,J)=0.

GG1(I,J)=0.

GG2(I,J)=0.

102CONTINUE DO 103 I=1,M GG(I,I)=1. GG(I,I+M)=1.

GG(I+M,I+2*M)=1.

GG(I+M,I+3*M)=1.

GG1(I,I)=1.

GG1(I,I+M)=1.

GG1(I+M,I+2*M)=1.

GG1(I+M,I+3*M)=1.

103CONTINUE DO 104 I=1,M

163

DO 104 J=1,M GG(I+2*M,J)=-LU(I,J) GG(I+2*M,J+M)=LU(I,J) GG(I+3*M,J+2*M)=-LI(I,J) GG(I+3*M,J+3*M)=+LI(I,J) GG1(I+2*M,J)=LU3(I,J) GG1(I+2*M,J+M)=LU2(I,J) GG1(I+3*M,J+2*M)=LI3(I,J) GG1(I+3*M,J+3*M)=LI2(I,J)

104CONTINUE

CALL DLINCG (M20,GG1,M20,GG2,M20) DO 316 I=1,M

DO 316 J=1,M HH11(I,J)=GG2(I,J) HH12(I,J)=GG2(I,J+M) HH13(I,J)=GG2(I,J+2*M) HH14(I,J)=GG2(I,J+3*M) HH21(I,J)=GG2(I+M,J) HH22(I,J)=GG2(I+M,J+M) HH23(I,J)=GG2(I+M,J+2*M) HH24(I,J)=GG2(I+M,J+3*M) HH31(I,J)=GG2(I+2*M,J) HH32(I,J)=GG2(I+2*M,J+M) HH33(I,J)=GG2(I+2*M,J+2*M) HH34(I,J)=GG2(I+2*M,J+3*M) HH41(I,J)=GG2(I+3*M,J) HH42(I,J)=GG2(I+3*M,J+M) HH43(I,J)=GG2(I+3*M,J+2*M) HH44(I,J)=GG2(I+3*M,J+3*M)

316CONTINUE

CALL DMCRCR (M,M,LU3,M,M,M,HH11,M,M,M,F,M) CALL DMCRCR (M,M,LU,M,M,M,F,M,M,M,HH11,M) CALL DMCRCR (M,M,LU2,M,M,M,HH21,M,M,M,F,M) CALL DMCRCR (M,M,LU,M,M,M,F,M,M,M,HH21,M) CALL DMCRCR (M,M,LU3,M,M,M,HH13,M,M,M,F,M) CALL DMCRCR (M,M,LU,M,M,M,F,M,M,M,HH13,M) CALL DMCRCR (M,M,LU2,M,M,M,HH23,M,M,M,F,M) CALL DMCRCR (M,M,LU,M,M,M,F,M,M,M,HH23,M) CALL DMCRCR (M,M,LI3,M,M,M,HH32,M,M,M,F,M) CALL DMCRCR (M,M,LI,M,M,M,F,M,M,M,HH32,M) CALL DMCRCR (M,M,LI2,M,M,M,HH42,M,M,M,F,M) CALL DMCRCR (M,M,LI,M,M,M,F,M,M,M,HH42,M) CALL DMCRCR (M,M,LI3,M,M,M,HH34,M,M,M,F,M) CALL DMCRCR (M,M,LI,M,M,M,F,M,M,M,HH34,M) CALL DMCRCR (M,M,LI2,M,M,M,HH44,M,M,M,F,M) CALL DMCRCR (M,M,LI,M,M,M,F,M,M,M,HH44,M) DO 105 I=1,M10

DO 105 J=1,M20

GG3(I,J)=0.0

105CONTINUE DO 306 I=1,M DO 306 J=1,M

164

GG3(I,J)=-HH11(I,J)+HH21(I,J) GG3(I,J+2*M)=-HH13(I,J)+HH23(I,J) GG3(I,J+3*M)=-Z(I,J) GG3(I+M,J+M)=-HH32(I,J)+HH42(I,J) GG3(I+M,J+2*M)=-Y(I,J) GG3(I+M,J+3*M)=-HH34(I,J)+HH44(I,J)

306CONTINUE K1=0

K0=0

DO 307 J=1,M20

IF (IH(J).EQ.1)K1=K1+1 IF (IH(J).EQ.0)GOTO 309 DO 308 I=1,M10 GG4(I,K1)=-GG3(I,J) B10(K1)=B5(J)

308CONTINUE GOTO 307

309CONTINUE

IF (IH(J).EQ.0)K0=K0+1 IF (IH(J).EQ.1)GOTO 307 DO 310 I=1,M10 GG5(I,K0)=GG3(I,J)

310CONTINUE

307CONTINUE

CALL DMUCRV (M10,M10,GG4,M10,M10,B10,1,M10,B6)

CALL DLSLCG(M10,GG5,M10,B6,1,B7) C*****************************************************

K1=0

DO 322 J=1,M20

IF (IH(J).EQ.0) K1=K1+1

IF (IH(J).EQ.1) GOTO 322 B5(J)=B7(K1)

322CONTINUE DO 321 I=1,M UK1(I)=B5(I)

AIK1(I)=B5(I+M)

321CONTINUE

CALL DMUCRV(M,M,Z,M,M,AIK1,1,M,AA) CALL DMUCRV(M,M,Y,M,M,UK1,1,M,BB)

CALL DMCRCR(M,M,LI,M,M,M,LI3,M,M,M,CC,M) CALL DMCRCR(M,M,LI,M,M,M,LI2,M,M,M,DD,M) DO 323 I=1,M

B1(I)=UK1(I)

B1(I+M)=AIK1(I)

B1(I+2*M)=AA(I)

B1(I+3*M)=BB(I)

323CONTINUE

CALL DLSLCG(M20,GG,M20,B1,1,B4) DO 1501 I=1,M

AA(I)=0.

B(I)=0.

1501 B(I)=B4(I)

 

165

 

CALL DMUCRV(M,M,LU3,M,M,B,1,M,AA)

 

DO 1502 I=1,M

 

BB(I)=0.

 

B(I)=0.

1502

B(I)=B4(I+M)

 

CALL DMUCRV(M,M,LU2,M,M,B,1,M,BB)

 

DO 1503 I=1,M

 

UX(I)=AA(I)+BB(I)

 

IF(LM.EQ.MMT)UK1(I)=UX(I)

1503

UXM(I)=DSQRT(REAL(UX(I))**2+AIMAG(UX(I))**2)

 

DO 1504 I=1,M

 

AA(I)=0.

 

B(I)=0.

1504 B(I)=B4(I+2*M)

 

CALL DMUCRV(M,M,LI3,M,M,B,1,M,AA)

 

DO 1505 I=1,M

 

BB(I)=0.

 

B(I)=0.

1505

B(I)=B4(I+3*M)

 

CALL DMUCRV(M,M,LI2,M,M,B,1,M,BB)

 

DO 1506 I=1,M

AIX(I)=AA(I)+BB(I)

IF(LM.EQ.MMT) AIK1(I)=AIX(I)

AIXM(I)=SQRT(REAL(AIX(I))**2+AIMAG(AIX(I))**2)

cпровод номер 1

IF(I.EQ.1.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP1(NN,LL)=PPP1(NN,LL)+AIXM(1)**2/2*R11(1)

IF(I.EQ.1.AND.LL.GT.1)PPP1(NN,LL)=PPP1(NN,LL)+AIXM(1)**2/2*R11(1)

cпровод номер 2

IF(I.EQ.2.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP2(NN,LL)=PPP2(NN,LL)+AIXM(2)**2/2*R11(2)

IF(I.EQ.2.AND.LL.GT.1)PPP2(NN,LL)=PPP2(NN,LL)+AIXM(2)**2/2*R11(2)

cпровод номер 3

IF(I.EQ.3.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP3(NN,LL)=PPP3(NN,LL)+AIXM(3)**2/2*R11(3)

IF(I.EQ.3.AND.LL.GT.1)PPP3(NN,LL)=PPP3(NN,LL)+AIXM(3)**2/2*R11(3)

cпровод номер 4

IF(I.EQ.4.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP4(NN,LL)=PPP4(NN,LL)+AIXM(4)**2/2*R11(4)

IF(I.EQ.4.AND.LL.GT.1)PPP4(NN,LL)=PPP4(NN,LL)+AIXM(4)**2/2*R11(4)

cпровод номер 5

IF(I.EQ.5.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP5(NN,LL)=PPP5(NN,LL)+AIXM(5)**2/2*R11(5)

IF(I.EQ.5.AND.LL.GT.1)PPP5(NN,LL)=PPP5(NN,LL)+AIXM(5)**2/2*R11(5)

cпровод номер 6

IF(I.EQ.6.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP6(NN,LL)=PPP6(NN,LL)+AIXM(6)**2/2*R11(6)

IF(I.EQ.6.AND.LL.GT.1)PPP6(NN,LL)=PPP6(NN,LL)+AIXM(6)**2/2*R11(6)

cпровод номер 7

IF(I.EQ.7.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP7(NN,LL)=PPP7(NN,LL)+AIXM(7)**2/2*R11(7)

IF(I.EQ.7.AND.LL.GT.1)PPP7(NN,LL)=PPP7(NN,LL)+AIXM(7)**2/2*R11(7)

166

cпровод номер 8

IF(I.EQ.8.AND.LL.EQ.1.AND.PR.EQ.2)

/PPP8(NN,LL)=PPP8(NN,LL)+AIXM(8)**2/2*R11(8)

IF(I.EQ.8.AND.LL.GT.1)PPP8(NN,LL)=PPP8(NN,LL)+AIXM(8)**2/2*R11(8) c суммарные потери во всех проводах

IF(LL.EQ.1.AND.PR.EQ.2.)PPP(NN,LL)=PPP(NN,LL)+AIXM(I)**2/2*R11(I)

IF(LL.GT.1)PPP(NN,LL)=PPP(NN,LL)+AIXM(I)**2/2*R11(I)

cwrite(10,196)ppp(nn,ll),aixm(i),r11(i)

IF(LL.EQ.1.AND.PR.EQ.1.)PP1=PP1+AIXM(I)**2/2*R11(I)

 

IF(LL.EQ.1.AND.PR.EQ.2.)PP2=PP2+AIXM(I)**2/2*R11(I)

 

SM(I)=UX(I)*DCONJG(AIX(I))/2.

1506

CONTINUE

c

WRITE(10,196) UXM

c

WRITE(11,196) AIXM

2104

CONTINUE

1300

CONTINUE

 

GOTO 1200

C===================================================================

 

GOTO 10

 

GOTO 1600

1600

CONTINUE

10

CONTINUE

3

FORMAT(80X)

2

FORMAT(6F20.15)

6

FORMAT(20F15.10)

7

FORMAT(8I6)

77

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

78

FORMAT('FFU2')

79

FORMAT('FFI2')

8

FORMAT(24F20.15)

9

FORMAT(20x,24F20.15)

99

format(24f25.14)

199

format(16f25.10)

215

FORMAT(8F35.10)

296

FORMAT(16F25.23)

198

FORMAT(16F25.10)

298FORMAT(16F25.10)

197FORMAT(16E25.10)

196FORMAT(120E25.10)

195FORMAT(16F10.5)

191FORMAT(32I2)

299FORMAT(64E25.10) 1200 CONTINUE

RETURN END

167

Приложение 4. Акт использования результатов работы

168