2025

71

XQ=XAQ+XT PRINT 15

PRINT 19, LRFLAG,L,R,HIF,NI

PRINT 21,XT,XAD,XTYD,XTYQ,XAQ,H

PRINT 190,XAQ,XAD,XAD1

PRINT 20,KM1,RYD,RYQ

PRINT 191,kzc1

PRINT 22,E,GAMMA,S,K

PRINT 23,QBEG,QEND,HQ

PRINT 9

IF0=1.

N=6

N1=N+1

N2=N-1

DO 7 jji=1,ni

IGR=0

IPRIN=0

DO 6 Q=QBEG,QEND,HQ

CУТОЧНЕНИЕ U1,U2,BETTA call U1U2N(gamma,k,s,kzc1)

G=L

km3=(am3(1.05)-am3(0.95))*10 KM2=(AMOB(2.05)-AMOB(1.95))*10. KM=KM1+KM2+km3

73

END

function AM3(w0) real i3,m,l

common /m1/g,q,e,l,xaq,xt,r,xad,qbeg m=1

w1=l

xqt=xaq+xt

zn=r**2+w0**2*(xad+xt)*xqt

ch=sqrt(r**2+w0**2*xqt**2)

i3=e*w0*ch/zn am3=-(m/w1)*(r/w0)*(i3)**2 return

end

subroutine U1U2N(gamma,k,s,kzc1) REAL K,KZC1,KM,M0,IF0

COMPLEX Z1,Z2,A,B,C,ZC1,ZC11,I1,I2,UT1,ZD1 common /M1/G,tetag,eps,alfa,XAQ,xs,R,XAD,QBEG

common /BB/beta,beta1 common /MK1/U1 common /M5/U2

common /M2/ xsyd,xsyq,if0,h,km common /M3/ fd0,ff0,fq0,m0,ryd,ryq common /x/ xd,xq

PI=3.1415926

TETA=PI*TETAG/180.

C НАЧАЛЬНЫЕ УСЛОВИЯ

TETA1=0.

74

TETA2=0.

TETAU=TETA

U1=GAMMA

U11=0.

C ВЫЧИСЛЕНИЕ УГЛА BETA

10 BETA=ATAN(((U1*COS(TETA)-EPS)*R+U1*ALFA*XD*SIN(TETA))/ *(ALFA*(U1*COS(TETA)-EPS)*XQ-U1*R*SIN(TETA)))

C СОПРОТИВЛЕНИЯ Z1 И Z2

XAC=0.5*(XAD+XAQ)

XU=0.5*(XAD-XAQ)

ZV=R+ALFA*XU*SIN(2*BETA)

ZM=ALFA*(XS+XAC+XU*COS(2*BETA))

Z1=CMPLX(ZV,ZM)

RYC=0.5*(RYD+RYQ)

XSYC=0.5*(XSYD+XSYQ)

A=CMPLX(R,ALFA*XS)

B=CMPLX(RYC/S,ALFA*XSYC)

C=CMPLX(RYC/S,ALFA*(XSYC+XAC))

Z2=A+CMPLX(0,ALFA*XAC)*B/C

C ТОКИ I1 И I2

ZC1=CMPLX(0.,KZC1)

ZD1=CMPLX(R*0.5,ALFA*XS*0.5)

ZC11=ZC1+ZD1

A=CMPLX(COS(TETAU)*EPS,-SIN(TETAU)*EPS)

B=2*Z1*Z2+ZC11*(Z1+Z2)

I1=((ZC11+CMPLX(1.,-K)*Z2)*GAMMA-(ZC11+CMPLX(1.,-1.)*Z2)*A)/B I2=((ZC11+CMPLX(1.,K)*Z1)*GAMMA-(ZC11+CMPLX(1.,1.)*Z1)*A)/B

C НАПРЯЖЕНИЯ U1 И U2

UT1=A+Z1*I1

75

U1=CABS(UT1)

U2=CABS(I2*Z2)

C ВЕЩЕСТВЕННАЯ ЧАСТЬ

A1=REAL(UT1)

C МНИМАЯ ЧАСТЬ

B1=AIMAG(UT1)

C УГОЛ TETA1

TETA1=ATAN(B1/A1)

TETAU=TETA1+TETA

C ПРОВЕРКА УСЛОВИЙ СХОДИМОСТИ

A1=ABS(U11-U1) B1=AMIN1(ABS(U11),ABS(U1))/100. C1=ABS(TETA2-TETA1) D1=AMIN1(ABS(TETA2),ABS(TETA1))/100. IF (A1.LT.B1.AND.C1.LT.D1) GOTO 14

C ЗАПОМИНАНИЕ РЕЗУЛЬТАТОВ

U11=U1

TETA2=TETA1

GOTO 10

14 CONTINUE beta=beta*180./pi return

END

FUNCTION AMOB(S)

C

C ВЫЧИСЛЕНИЕ МОМЕНТА M20 И КОЭФ-ТА KM2

C

REAL IF0,KM,M0

76

REAL I1,I1A,I1P,I2,I2A,I2P,L COMMON /M5/U2

COMMON /M1/G,Q,E,L,XAQ,XS,R,XAD,QBEG

COMMON /M2/XSYD,XSYQ,IF0,H,KM

COMMON /M3/FD0,FF0,FQ0,M0,RYD,RYQ

XYD=XAD+XSYD

XYQ=XAQ+XSYQ

XD=XAD+XS

XQ=XAQ+XS

R1=XD+XQ-XAD**2/XYD

R2=XD+XQ-XAQ**2/XYQ

R3=1.-2.*S

R4=L*S A=R*(1.-R4**2*(XYD*XYQ)/(RYD*RYQ))+0.5*L**2*S*R3

1*(R2*XYQ/RYQ+R1*XYD/RYD) B=R*R4*(XYD/RYD+XYQ/RYQ)-0.5*L*R3*(XD+XQ-R4**2*(XD+

1XQ-XAD**2/XYD-XAQ**2/XYQ)*XYD*XYQ/(RYD*RYQ)) C=R**2*(1.-R4**2*XYD*XYQ/(RYD*RYQ))-R*R4**2*(R2*XYQ/RYQ+

1R1*XYD/RYD)+R3*L**2*((XD*XQ-R4**2*(XD-XAD**2/XYD) 1*(XQ-XAQ**2/XYQ)*XYD*XYQ/(RYD*RYQ)))

D=R**2*R4*(XYD/RYD+XYQ/RYQ)+R*R4*(XD+XQ-R4**2*(XD+XQ- 1XAD**2/XYD-XAQ**2/XYQ)*XYD*XYQ/(RYD*RYQ))+L**3*S*R3*((XD-

1XAD**2/XYD)*XQ*XYD/RYD+(XQ-XAQ**2/XYQ)*XD*XYQ/RYQ) A1=0.5*L**2*R3*S*((XQ-XD+XAD**2/XYD)*XYD/RYD+(XQ-XD- 1XAQ**2/XYQ)*XYQ/RYQ) B1=0.5*L*R3*(XD-XQ-R4**2*(XD-XQ-XAD**2/XYD+XAQ**2/XYQ) 1*XYD*XYQ/(RYD*RYQ))

R1=C**2+D**2

I1A=(A*C+B*D)/R1*U2

77

I1P=(A*D-B*C)/R1*U2 I1=SQRT(I1A**2+I1P**2) I2A=(A1*C+B1*D)/R1*U2 I2P=(A1*D-B1*C)/R1*U2 I2=SQRT(I2A**2+I2P**2) AMOB=U2*I1A-R*I1**2-R/R3*I2**2 AMOB=AMOB/L

RETURN

END

FUNCTION FID(IF0)

C

C РАСЧЕТ УСТАНОВИВШЕГОСЯ ЗНАЧЕНИЯ ТОКА ID0

C

COMMON /M1/G,QQ,E,L,XAQ,XT,R,XAD,QBEG REAL IF0,L

PI=3.1415926

Q=PI*QQ/180.

A1=(XAQ+XT)*L

A2=(G*COS(Q)-L*E)*A1-G*R*SIN(Q)

A3=R**2+(XAD+XT)*A1*L

FID=A2/A3

RETURN

END

FUNCTION FIQ(IF0)

C

CРАСЧЕТ УСТАНОВИВШЕГОСЯ ЗНАЧЕНИЯ ТОКА IQ0

COMMON /M1/G,QQ,E,L,XAQ,XT,R,XAD,QBEG REAL IF0,L

78

PI=3.1415926

Q=PI*QQ/180.

A1=(XAD+XT)*L

A2=(G*COS(Q)-L*E)*R+G*SIN(Q)*A1

A3=R**2+(XAQ+XT)*A1*L

FIQ=A2/A3

RETURN

END

SUBROUTINE MATR1(A)

C ПОДПРОГРАММА MATR1(A) ОПРЕДЕЛЕНИЯ КОЭФФИЦИЕНТОВ

CСИСТЕМЫ ДИФФЕРЕНЦИАЛЬНЫХ УРАВНЕНИЙ

REAL IQ0,M0,L,KM,IF0,ID0

COMMON /M1/G,QQ,E,L,XAQ,XT,R,XAD,QBEG COMMON /M2/XTYD,XTYQ,IF0,H,KM COMMON /M3/FD0,FF0,FQ0,M0,RYD,RYQ COMMON /M4/id0,IQ0

DOUBLE PRECISION A(6,6) PI=3.1415926

Q=PI*QQ/180. DO 1 I=1,6

DO 1 J=1,6

1 A(I,J)=0.

ID0=FID(IF0)

IQ0=FIQ(IF0)

FD0=(XAD+XT)*ID0+E

FQ0=(XAQ+XT)*IQ0

M0=FD0*IQ0-FQ0*ID0

D1=XAD*XTYD+XAD*XT+XT*XTYD

79

D2=XAQ*XTYQ+XAQ*XT+XT*XTYQ A(1,1)=-R*(XAD+XTYD)/D1

A(1,2)=L

A(1,3)=R*XAD/D1

A(1,5)=FQ0

A(1,6)=-G*COS(Q)

A(2,1)=-L

A(2,2)=-R*(XAQ+XTYQ)/D2

A(2,4)=R*XAQ/D2

A(2,5)=-FD0

A(2,6)=-G*SIN(Q)

A(3,1)=RYD*XAD/D1

A(3,3)=-RYD*(XAD+XT)/D1

A(4,2)=RYQ*XAQ/D2

A(4,4)=-RYQ*(XAQ+XT)/D2

A(5,1)=IQ0/H-FQ0*(XAD+XTYD)/H/D1 A(5,2)=FD0*(XAQ+XTYQ)/H/D2-ID0/H

a(5,3)=fq0*xad/h/d1 a(5,4)=-fd0*xaq/h/d2

A(5,5)=-KM/H

A(6,5)=-1.

RETURN

END

subroutine RAUS(b,c)

double precision b(7),c(7,7),r3,r4,r5,r6 do 1 i=1,7

do 1 j=1,7 1 c(i,j)=0.

80

c(1,1)=b(7)

c(2,1)=b(6)

c(1,2)=b(5)

c(2,2)=b(4)

c(1,3)=b(3)

c(1,4)=b(1)

c(2,3)=b(2)

r3=b(7)/b(6) c(3,1)=b(5)-r3*b(4) c(3,2)=b(3)-r3*b(2) c(3,3)=b(1) r4=b(6)/c(3,1) c(4,1)=b(4)-r4*c(3,2) c(4,2)=b(2)-r4*c(3,3) r5=c(3,1)/c(4,1) c(5,1)=c(3,2)-r5*c(4,2) c(5,2)=c(3,3)-r5*c(4,3) r6=c(4,1)/c(5,1) c(6,1)=c(4,2)-r6*c(5,2) c(7,1)=c(5,2)

return end

SUBROUTINE SPOLZ(RAS,*) REAL KM1,KM2,KU1,km3 REAL IF0,IQ0,L,ID0,M0 DOUBLE PRECISION RAS(7,7) COMMON /M5/U2

COMMON /MK1/KU1

COMMON /BB/B1,B2