Разработка алгоритма и программы расчета электрической цепи (массив индуктивностей - 39 мГн, напряжение цепи - 140 В, частота - 260 Гц), страница 5

write(*,*)'3--raschet shemy pri izmenenii paranetra Q   4--vyhod   5--VYVOD AMPLITYDNYH ZNACHENYY'

READ(*,*) UPR

IF(UPR.EQ.1)GOTO 123

IF(UPR.EQ.2)GOTO 124

IF(UPR.EQ.3)GOTO 129

IF(UPR.EQ.4)GOTO 126

IF(UPR.EQ.5)GOTO 127

goto 125

127  do 767 i=1,50

767  write(*,435)

WRITE(4,*)'AMPLITUDNYE ZNACHENIYA TOKOV I NAPRYAZHENYY'

WRITE(*,*)'AMPLITUDNYE ZNACHENIYA TOKOV I NAPRYAZHENYY'

WRITE(4,*)'  UAD=',AM(1),'  IL1=',AM(2),'  IC2=',AM(3)

WRITE(4,*) '  ISUM=',AM(4),'  UBC=',AM(5)

WRITE(*,*)'  UAD=',AM(1),'  IL1=',AM(2),'  IC2=',AM(3)

WRITE(*,*) '  ISUM=',AM(4),'  UBC=',AM(5)

PAUSE

GOTO 125

123  do 133 i=1,50

133  write(*,435)

WRITE(*,*)'VVEDITE MASHTABNYY KOFICIENTY'

READ(*,*)ZOF,ZOF2,ZOF3,zof4,zof5

CALL MGV(AM(1),FI(1),F,UM,KOL,DT,ZOF)

call mgv(am(2),fi(2),f,il1m,kol,dt,ZOF2)

call mgv(am(3),fi(3),f,ic1m,kol,dt,ZOF3)

call mgv(am(4),fi(4),f,isumm,kol,dt,zof4)

call mgv(am(5),fi(5),f,uBcm,kol,dt,zof5)

WRITE(4,*)'GRAFIKI FUNKCII UAD,IL,IC'

WRITE(4,*)'UAD-@,IL=#,IC=$,ISUM=&,UBC=*'

call grafik(UM,IL1M,IC1M,ISUMM,uBcm,KOL,69)

call grafik2(UM,IL1M,IC1M,ISUMM,uBcm,KOL,69)

pause

GOTO 125

CALL MV(AM(1),FI(1),F,UM,KOL,DT)

call mv(am(2),fi(2),f,il1m,kol,dt)

call mv(am(3),fi(3),f,ic1m,kol,dt)

call mv(am(4),fi(4),f,isumm,kol,dt)

124  do 134 i=1,50

134  write(*,435)

WRITE(*,*)'VIBERETY METHOD INTEGRIROVANIYA'

write(*,*)'1--simpsona  2--trapecii'

READ(*,*)UPR

IF(UPR.EQ.1) GOTO 342

IF(UPR.EQ.2) goto 343

goto 125

342  CALL MV(AM(1),FI(1),F,UM,KOL,DT)

call mv(am(2),fi(2),f,il1m,kol,dt)

call mv(am(3),fi(3),f,ic1m,kol,dt)

call mv(am(4),fi(4),f,isumm,kol,dt)

call mv(am(5),fi(5),f,UBCM,kol,dt)

call simp(um,t,kol,ud)

call simp(il1m,t,kol,ild)

call simp(ic1m,t,kol,icd)

call simp(iSUMM,t,kol,iSUMD)

call simp(UBCM,t,kol,UBCD)  

DO 498 I=1,KOL

498  write(4,665)um(I),il1m(I),ic1m(I),isumm(i),UBCM(I)

WRITE(4,*)'    METHOD SIMPSONA '

write(4,*)'Ud        Ild        Ilc       ISUMM      UBCD'

write(4,*)'  ____________________________________'

WRITE(4,665)ud,ild,icd,ISUMD,UBCD

pause

GOTO 125

343  CALL MV(AM(1),FI(1),F,UM,KOL,DT)

call mv(am(2),fi(2),f,il1m,kol,dt)

call mv(am(3),fi(3),f,ic1m,kol,dt)

call mv(am(4),fi(4),f,isumm,kol,dt)

call mv(am(5),fi(4),f,UBCM,kol,dt)

call trap(um,t,kol,ud)

call trap(il1m,t,kol,ild)

call trap(ic1m,t,kol,icd)

call TRAP(iSUMM,t,kol,iSUMD)

call TRAP(UBCM,t,kol,UBCD)

WRITE(4,*)'    METHOD TRAPECII'

write(4,*)'Ud        Ild        Ilc       ISUMM       UBCD'

write(4,*)'  ______________________________________'

WRITE(4,665)ud,ild,icd,ISUMD,UBCD

pause

GOTO 125

dq=(q2-q1)/40

665     format(2x,'I',f8.3,'I',f8.3,'I',F8.3,'I',F8.3,'I','I',F8.3,'I',/,    2x,56('-'))

CLOSE(4)

129  do 135 i=1,50

135  write(*,435)

UPR=0

DO 455 I=1,40

ILQ(I)=0

ICQ(I)=0

455  CONTINUE

WRITE(*,*)'VIDERETY METHOD INTEGRIROVANIYA'

write(*,*)'1--simpsona  2--trapecii'

READ(*,*)UPR

do 434 kn=1,40

DO 445 I=1,2

XC(I)=-J/(2*PI*F*C(i))

445  CONTINUE

XL=J*2*PI*F*L

Z(1)=R(1)

Z(2)=1/(1/XC(1)+1/XL)

Z(3)=R(2)

Z(4)=R(3)+XC(2)

DO 446 I=1,4

ZSUM=ZSUM+Z(I)

446  CONTINUE

!  OPREDELENEI TOKA V SXEME

ISUM=U/ZSUM

UBC=ISUM*Z(2)

IL1=UBC/XL

IC1=UBC/XC(1)

call arg(IL1,fi(2),am(2))

call arg(IC1,fi(3),am(3))

KOL=T/DT+1

IF(UPR.EQ.1) GOTO 347

IF(UPR.EQ.2) goto 348

goto 125

347  call mv(am(2),fi(2),f,il1m,kol,dt)

call mv(am(3),fi(3),f,ic1m,kol,dt)

call simp(il1m,t,kol,ild)

call simp(ic1m,t,kol,icd)

WRITE(4,*)'METHOD SIMPSONA'

WRITE(4,*)' ILD   ICD  '

WRITE(4,*)'________________'

WRITE(4,898)ILD,ICD

GOTO 350

348  call mv(am(2),fi(2),f,il1m,kol,dt)

call mv(am(3),fi(3),f,ic1m,kol,dt)

call trap(il1m,t,kol,ild)

call trap(ic1m,t,kol,icd)

WRITE(4,*)'METHOD trapicii'

WRITE(4,*)' ILD   ICD  '

WRITE(4,*)'________________'

WRITE(4,898)ILD,ICD

350  ILQ(KN)=ILD

ICQ(KN)=ICD

C(1)=C(1)+DQ

434  CONTINUE

WRITE(4,*)'IZMENIE DIYSTVUYUSCHIH ZNACHENII PRI IZMENENII Q'

WRITE(4,*)'il=@,ic=#'

CALL GRAFIK1(ILQ,ICQ,40,69)

CALL GRAFIK12(ILQ,ICQ,40,69)