?????????????? ?????? ? ????????? ?????????? ??????? ?????

program kontur
!******* 1. Объявление внутренних массивов схемы *****
integer, parameter:: nv=400 ! максимальное число ветвей
character (len = 4 ) namv(nv),name0 ! имена ветвей
integer np1(nv),np2(nv) ! номера начала и конца ветвей
character (len=8) symnp1(nv),symnp2(nv), nameyz ! имена нач. и кон. узлов
integer yzpar,kp,kv ! число узловых пар, узлов и ветвей
real ev(nv), jv(nv), zv(nv,nv) ! параметры ветвей
real er(nv), jr(nv), zr(nv,nv) ! параметры схемы
real Yr(nv,nv), Uv(nv), Iv(nv) ! узловые сопр. токи и напр. ветвей
real Csoed(nv,nv),Asoed(nv,nv) ! матрицы соединений
!*******объявления для транслятора****
character (len = 20) words(7*nv) ! Массив слов текста
character (len = 80) st,namefile ! Строка текста
character (len = 20) name1 ! текст для числа
integer wbegin, wend, neww, lst
!объявления для интерфейса
character(len=80)::CFIL1=' '
character(len=50)::help='программа расчета R-цепи'
integer, parameter :: units = 1 ! Номер устройства для файла
!****** 2. Создание интерфейса пользователя ******
ipovtor=1 ! флаг повторения расчета
osnov: do while (ipovtor==1)
kv=0 ! текущая ветвь
zv=0;ev=0;jv=0;np1=0;np2=0;Csoed=0;Asoed=0 ! обнуление массивов
er=0;jr=0;zr=0;Yr=0;Uv=0;Iv=0
call swgopt('center','position')
CALL SWGHLP (help)
CALL SWGWTH (-30)
CALL WGINI ('vert', IP)
call wgcmd (IP, 'открыть блокнот','polyglot.exe',ID) ! запуск текстового редактора
CALL WGLAB (IP, 'файл с данными:', ID)
CALL WGFIL (IP, 'открыть файл', CFIL1, '*.cir', ID_FIL1)
CALL WGOK (IP, ID_OK); CALL WGQUIT (IP, ID_Q)
CALL WGFIN
call GWGFIL(ID_FIL1,CFIL1)
!****** 3. Ввод строки из входного файла, выделение слов в строке ******
CALL CPU_TIME (rt1)
! Запишем все слова строки в массив words
open(units,file=trim(CFIL1))
do while ( 1==1) ! Цикл обработки строк
neww = 0 ! neww - число слов в строке
read(units,'(a)',end=10,iostat=ios)st ! Ввод строки текста
write(*, *) st ! Контрольный вывод
st=adjustl(st) ! левое выравнивание
if (index(st,'*')==1) cycle ! чтобы игнорировать строку начин. с "*"
if (st(1:4)=='.end') exit
lst = len_trim(st) ! Длина строки без хвостовых пробелов
k=index(st,';') ! чтобы игнорировать часть строки начин. с ";"
if (k==1) cycle
if (k>=1) lst = len_trim(st(1:k-1))
if (index(st(1:1),'.')/=0) cycle
wbegin = 0 ! wbegin - начало текущего слова в строке
do j = 1, lst ! Просмотр всех символов строки
if (st(j:j) == ' ') then
if (wbegin > 0) call addword( words, st, wbegin, wend, neww )
88