Программа MAIN и подпрограмма FCN. 
Явная СДУ PROGRAM MAIN

USE MSIMSL; USE INCL_GRF; USE DESCRIBE IMPLICIT NONE; real: htnach=0.5d-6, htrab EXTERNAL FCN.

NAMELIST/LST/ nwK, rKatvn, tWKr, tWKz, tlzwwr, shrzbl<, udSoprl<, sO & ^Disk/DvrvDna^shrzbD^dSoprD^dPID^mas, roProv, DiamPr, TizPr, DIProv & _/ht_/tkon_/UcO_/emk_/LTiristor, RTiristor_/xkon_/nlntervX_/FmO_/zl_/xl_/Fml_/z2_/kratnPrt_/poligrf pi=DCONST ('pi'); piu2=pi+pi; rmu=4d-7*pi !Выч. пи, 2*пи, мю OPEN (7_/file='main.dat'); OPEN (8_/file='main.ch') Юткрывание файлов READ (7,LST); WRITE (8,LST) !Чтение исх.данн.и их запись в файл с результатами ALLOCATE (FDATA (5,nlntervX+l), XDATA (nlntervX+l) & !Распределение массивов _/BREAK (5_/nlntervX+l), CSCOEF (5,4,nlntervX+l)).

!Бл.2 Подготовка начальных данных:

Vd=0d0; App=.false.; uch=l; ndur=3; htrab=ht.

WcO=emk*UcO**2/2dO; RabMex=0d0; xz=0d0; XA=0d0; TA=0d0; Fapp=.false. Rlulk2Z=0d0; RDuld2Z=0d0; tZap=0d0; Wdg=0d0; prop=.false.

FemZap=0d0; n=0; Fmexz=Fm0;PARAM (4)=5000 massD=YdPID*pi*(rDnar**2-rDvn**2)*hDisk; massPodv=massD+Amas dx=Xkon/nlntervX; x=-dx ! Бл. З DO i=l_/nlntervX+l; x=x+dx; XDATA (i)=x ! Блоки 4, 5, 6 CALL ParameterJDM.

FDATA (l, i)=LlPer; FDATA (2,i)=RlPer; FDATA (3,i)=vziPer FDATA (4,i)=LdPer; FDATA (5,i)=RdPer ENDDO! Bce положения диска.

! Бл.7: В этом цикле строятся сплайны 5шт для L1, R1,M, LD, RD соответственно DO i=l, 5.

CALL DCSAKM (nlntervX+l, XDATA_/FDATA (i:i:)_/BREAK (i:i_/:)_/CSCOEF (i:i_/:_/:)).

ENDDO.

!Заполнение массивов для построения графиков L1, R1,M, LD, RD от хода х: dx=Xkon/20; x=-dx;

ПО.

DO n=l, 21; x=x+dx; XARR (n)=x;

DO k=l, 5; YARR (k, n)=DCSVAL (x, nlntervX, BREAK (k:k:), CSCOEF (k:k:)); ENDDO ENDDO.

(Построение графиков L1, R1,M, LD, RD в зависимости от хода диска:

CALL GRF_TXT (21,XARR, 5, YARR (1:5,1:21), delenx, deleny,.true. & _/comm_mashtab_/name=^,3aB-TH от хода х: Инд-ть и Акт.сопр.перв.конт; Вз.инд.&.

&кат.и диска; Инд. и Акт.сопр.диска'Дхи='1- L1; 2- R1; 3- vziK_D; 4- LD;&.

& 5- RD', path='c:TMPFiglDM').

x=0d0; CALL CalculatingSpline! Выч-е napaMeTpoB: Ll, Rl, vzi, dvzdx, LD, SoprD для x=0 Y=0d0; Y (3)=UcO; t=0d0; tend=0d0; k=l; XARR (1)=0.; il=0d0; i2=0d0; uc=UcO Fmex=FmO; ido=l; ht=htnach.

YARR=0.;YARR (3,l)=Uc0; YARR (7,l)=vzi; YARR (8,l)=FmO; d=Ll*Ld-vzi*vzi 100 FORMAT (' k t, MC ТокК, А ТокД, А Uc, B V, m/c x, mm &.

& Fem, H Погр._;о.е. vzi, MKl" H Fmex, H') ktek=l; write (8,100); n=l !Бл.8 write (8,105) k, t, il, i2, uc, Vd, x, Fern, pogr, vzi, Fmex DO; tend=tend+ht; k=k+l !Бл.9 CALL DIVPRK (ido, ndur, FCN, t, tend, tol, PARAM, Y).

!Бл.10 Если есть перемещение диска, то выч-я новые параметры Ll, Rl, vzi, dvzdx, !LD, SoprD для текущего хода х; затем решается САУ (1.32) отн. токов il, i2: if (dvigen) then; x=Y (5); CALL CalculatingSpline d=Ll*Ld-vzi**2 !Выч-е определителя САУ (1.32) endif.

il=(Y (l)*Ld-Y (2)*vzi)/d; i2=(Y (2)*Ll-Y (l)*vzi)/d ktek=ktek+l; Fem=il*i2*dvzdx; uc=Y (3) ! Бл.11 !Бл. 12,13:

IF (ktek>4)THEN; ktek=4; TA (1:3)=TA (2:4); XA (1:3)=XA (2:4);ENDIF TA (ktek)=t; XA (ktek)=x !Бл.14 IF (.NOT.dvigen) THEN! Бл.15 if (Fem>FmO) then! Бл.16.

ttr=tZap+(t-tZap)*(FmO-FemZap)/(Fem-FemZap) !Бл.24 tend=ttr.

CALL DIVPRK (ido, ndur, FCN, t, tend, tol, PARAM, Y).

uc=Y (3); il=(Y (l)*Ld-Y (2)*vzi)/d; i2=(Y (2)*Ll-Y (l)*vzi)/d; Fem=il*i2*dvzdx ido=3; CALL DIVPRK (ido, ndur, FCN, t, tend, tol, PARAM, Y) ndur=5; ido=l; dvigen=.true.; TA (ktek)=t; uc=Y (3); ht=htrab write (8," ('Время Tpor. ttr=', lpel0.3,'c. Остальные величины при Ur:')") t write (8,105) k, t, il, i2, uc, Vd, x, Fem, pogr, vzi, Fmex endif! Бл.17:

ELSE !T.e. имеется движение:

Vd=Y (4).

if (Vd<0d0) exit! Бл.19.

if (x>xkon) then; xAppr=xkon; stp=.true.; App=.true.; endif! Бл.18, 21 if (uch==l.AND.x>xl) then; xAppr=xl; Fapp=.true.; endif! Бл.20, 22 if (App.OR.Fapp) then! Бл.23.

CALL DCSAKM (ktek, XA, TA, BREAKl, CSCOEFl); tend=DCSVAL (xAppr, 3, BREAKl, CSCOEFl) CALL DIVPRK (ido, ndur, FCN, t, tend, tol, PARAM, Y) x=Y (5); Vd=Y (4); CALL CalculatingSpline! Выч-е Ll, Rl, vzi, dvzdx, LD, SoprD d=Ll*Ld-vzi**2.

uc=Y (3); il=(Y (l)*Ld-Y (2)*vzi)/d; i2=(Y (2)*Ll-Y (l)*vzi)/d; Fem=il*i2*dvzdx TA (ktek)=t; XA (ktek)=x endif ENDIF.

XARR (k)=tend; YARR (l, k)=il; YARR (2,k)=i2; YARR (3,k)=Uc; YARR (4,k)=Vd !Бл.25.

YARR (5,k)=x; YARR (6,k)=Fem; YARR (7,k)=vzi; TokD2=i2**2; TokK2=il**2.

RDuld2=soprD*TokD2; Rlulk2=Rl*TokK2.

Wdg=Wdg+(Rlulk2+Rlulk2Z+RDuld2+RDuld2Z)*(t-tZap)/2dO.

if (uch==l) Fmex=FmO+zl*x; if (uch==2) Fmex=Fml+z2*(x-xl); YARR (8,k)=Fmex.

Wkin=massPodv*Vd**2/2dO; Wc=emk*uc**2/2dO.

RabMex=RabMex+(Fmex+Fmexz)*(x-xz)/2dO.

Wmagn=(Ld*TokD2+Ll*TokK2)/2dO+vzi*i2*il.

Wsum=Wmagn+Wdg+Wkin+RabMex+Wc.

pogr=(WcO-Wsum)/WcO; YARR (9,k)=pogr.

If (ABS (pogr)>epsPogr) then; !Бл.2б:

print*,'pogr>espPogr; STOP' ;write (8,*)'pogr>espPogr; STOP';stop !Бл.27 endif.

Rlulk2Z=Rlulk2; RDuld2Z=RDuld2; tZap=t; xZ=x; FmexZ=Fmex; FemZap=Fem if (Fapp)then; FmexZ=Fml; Fapp=.false.; uch=2; k=k+l; XARR (k)=XARR (k-l); YARR (l:9,k)=YARR (l:9,k-l).

YARR (8,k)=FmexZ !Вводится доп. точка для отобр. скачка мех. хар-ки на графике endif.

if (n==0.OR.n==20) then; write (8,100); n=l; endif! Печать заголовка таблицы if (k/kratnPrt*kratnPrt==k.OR.k==2) then; !Бл.28 n=n+l; write (8,10S) k, t, il, i2, uc, Vd, x, Fem, pogr, vzi, Fmex endif.

105 FORMAT (i4,3pf7.3,lp4el2.3,3pf7.3,0pf9.1,lpell.2,6pf8.2,0pfl0.1) if (stp.OR.t>=tkon) then! Бл.29, 30.

if (stp) write (8," ('Время срабат.:'Дре10.3,'с. Остальные величины:')") t write (8,105) k, t, il, i2, uc, Vd, x, Fem, pogr, vzi, Fmex; exit endif ENDDO.

CALL GRF_TXT (k, XARR, 9, YARR (l:9:k), 2.0,1.5,poligrf 8c false., пате='Зависимости от времени при срабатывании ИДМ' 8с, txtl='ltokK, 2-TokD, 3-Uc, 4-V, 5-Х, 6-Fem, 8c 8c 7-VziK_D 8-Fmex, H 9-pogr, o.e.', path='c:TMPFiglDM').

END PROGRAM MAIN.