ЦАРЬ СЛАВЯН
Шрифт:
Приложение 3
ПРОГРАММА ДЛЯ ПЕРЕВОДА ИНДИКТОВЫХ ДАТ В РУССКО-ВИЗАНТИЙСКУЮ ЭРУ ОТ АДАМА
Программа написана на языке Фортран.
*_______________________________________________
program ind_date
*_______________________________________________
* Вычисление годов от Адама от 1 до 7980 = 15x19x28 с данным
* индиктом, кругом Солнцу и кругом Луне различно для дат
* от точки перескока индикта до точки перескока
* кругов Солнцу и Луне и дат оставшейся
*
* Поэтому дается три варианта пересчета
* 1) без поправки кругов Солнцу и Луне
* 2) с поправкой кругов Солнцу и Луне на +1
* 3) с поправкой кругов Солнцу и Луне на -1
*
* При переводе полученных таким образом годов
* от Адама на года н. э. вычитается 5508 для всех
* месяцев года.
*_______________________________________________
CHARACTER*1 Q1
*_______________________________________________
OPEN(3,file='otvet.txt',access='sequential',
form='formatted',status='replace')
WRITE(*,*)'============================== '
WRITE(*,*)' ВВЕДИТЕ ИНДИКТ, КРУГ СОЛНЦУ И КРУГ ЛУНЕ '
WRITE(*,*)' (ЕСЛИ ЗНАЧЕНИЕ НЕИЗВЕСТНО, ВВЕДИТЕ НОЛЬ) '
WRITE(*,*)'
WRITE(*,*)'======================= '
301 write(*,*)' '
write(*,*)'Введите ИНДИКТ (от 1 до 15; 0 если неизвестен)'
read(*,*) indict
write(*,*)'Введите КРУГ СОЛНЦУ (от 1 до 28; 0 если неизвестен)'
read(*,*) isun
write(*,*)'Введите КРУГ ЛУНЕ (от 1 до 28; 0 если неизвестен)'
read(*,*) imoon
302 WRITE(*,*)' '
WRITE(*,*)
'///////////////////////\\\\\\\\\\\\\\\\\\\\\\\'
WRITE(*,*) ' 1: ПУСК '
WRITE(*,*) ' 2: ИЗМЕНИТЬ ЗНАЧЕНИЯ'
WRITE(*,*) ' 3: ЗАКОНЧИТЬ РАБОТУ'
5 WRITE(*,*) ' ВВЕДИТЕ НУЖНОЕ ЧИСЛО И НАЖМИТЕ КЛАВИШУ <ВВОД>'
READ(*,'(A)') Q1
IF(Q1.NE.'1'.AND.Q1.NE.'2'.AND.Q1.NE.'3') THEN
WRITE(*,*) ' НЕВЕРНОЕ ЗНАЧЕНИЕ? ДОЛЖНО БЫТЬ 1, 2 ИЛИ 3'
GOTO 5
ENDIF
ivvod=ICHAR(Q1)-ICHAR('0')
IF (ivvod.EQ.1) GO TO 303
IF (ivvod.EQ.2) GO TO 301
IF (ivvod.EQ.3) STOP 'ЗАВЕРШЕНО ПОЛЬЗОВАТЕЛЕМ'
GO TO 302
303 CONTINUE
*____________проверяем данные на правильность _____________________
IF ((indict.LT.0).OR.(indict.GE.16)) GOTO 100
IF ((isun.LT.0).OR.(isun.GE.29)) GOTO 100
IF ((imoon.LT.0).OR.(imoon.GE.20)) GOTO 100
GOTO 200! данные введены правильно
100 WRITE(3,*)' WRONG INPUT DATA: '! данные введены неверно
WRITE(*,*) ' WRONG INPUT DATA: '
WRITE(3,*) 'indict= ',indict,' isun= ',isun,
' imoon=',imoon
STOP
*____________ начало расчетов ___________________________
200 CONTINUE
WRITE(3,*)' indict = ',indict
WRITE(3,*)' Sun = ',isun
WRITE(3,*)' Moon = ',imoon
WRITE(3,*)' '
WRITE(3,*)' '
WRITE(3,*)'БЕЗ
WRITE(3,*)'от АДАМА, Н.Э./от АДАМА, Н.Э. /от АДАМА, Н.Э.'
WRITE(3,*)'_____________________________________________'
WRITE(3,*)''
indx=0
isx=0
imx=0
DO iadam=1,7980
IF (iadam.EQ.6690) THEN
write(*,*) iadam
END IF
iAD=iadam-5508
indx=indx+1
isx=isx+1
imx=imx+1
IF (indx.EQ.16) indx=1
IF (isx.EQ.29) isx=1
IF (imx.EQ.20) imx=1
indy=indict
IF (indy.EQ.0) indy=indx ! нулевые значения -
! произвольные
IF (indx.EQ.indy) THEN
*______ БЕЗ ПОПРАВКИ: табличные круги Солнца и Луны такие же,
*______ как в источнике
isy=isun
imy=imoon
IF (isun.EQ.0) isy=isx
IF (imoon.EQ.0) imy=imx
IF ((isx.EQ.isy).AND.(imx.EQ.imy)) THEN
WRITE(3,*)iadam,' ',iAD
WRITE(3,*)''
END IF
*______ С ПОПРАВКОЙ: круги Солнца и Луны ПОДПРАВЛЯЮТСЯ НА +1
IF (isun.NE.0) isy=isun+1
IF (isy.EQ.29) isy=1
IF (imoon.NE.0) imy=imoon+1
IF (imy.EQ.20) imy=1
IF ((isx.EQ.isy).AND.(imx.EQ.imy)) THEN
WRITE(3,*)' ',iadam,' ', iAD
WRITE(3,*)''
END IF
*______ С ПОПРАВКОЙ: круги Солнца и Луны ПОДПРАВЛЯЮТСЯ НА -1
IF (isun.NE.0) isy=isun-1
IF (isy.EQ.0) isy=28
IF (imoon.NE.0) imy=imoon-1
IF (imy.EQ.0) imy=19
IF ((isx.EQ.isy).AND.(imx.EQ.imy)) THEN
WRITE(3,*)' ',iadam,' ',iAD
WRITE(3,*)''
END IF
END IF
END DO
WRITE (3,*)'___________________________________________'
WRITE(3,*)'END OF CALCULATIONS'
WRITE(*,*)'END OF CALCULATIONS'
CLOSE(3)
STOP
END
Литература [1]
1
Список в целом упорядочен по алфавиту, но в конце добавлено несколько книг не в алфавитном порядке. Книги авторов по новой хронологии перечислены внизу отдельным списком.