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

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

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)

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)

298FORMAT(16F25.10)

197FORMAT(16E25.10)

196FORMAT(120E25.10)

195FORMAT(16F10.5)

191FORMAT(32I2)

299FORMAT(64E25.10) 1200 CONTINUE

RETURN END

167

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

168