Приложение 3.
ПРОГРАММА ДЛЯ ПЕРЕВОДА ИНДИКТОВЫХ ДАТ В РУССКО-ВИЗАНТИЙСКУЮ ЭРУ ОТ АДАМА.
Исходный файл *txt
Программа написана на языке Фортран.
----------------------------------------------------------------
program ind_date
*---- Вычисление годов от Адама от 1 до 7980=15x19x28 с данным индиктом
*---- кругом Солнцу и кругом Луне
*---- различно для дат от точки перескока индикта до точки перескока
*----- кругов Солнца и Луны и наоборот (т.е. для оставшейся части года).
*
*----- Поэтому дается три варианта пересчета
*----- 1) без поправки кругов Солнца и Луны
*----- 2) с поправкой кругов Солнца и Луны на +1
*----- 3) с поправкой кругов Солнца и Луны на -1
*
*---- При последующем переводе полученных таким образом годов от Адама
*---- на январские года н.э. надо всегда вычитать 5508 (для всех месяцев)
*-----------------------------------------------------------------------
*-------------------------------------------------------------
CHARACTER*1 Q1
*-------------------------------------------------------------
OPEN(3,file='i-
otvet.txt',access='sequential',form='formatted',status='replace')
WRITE(*,*)'=========================================== '
WRITE(*,*)' ENTER INDICT, SUN CIRCLE, MOON CIRCLE '
WRITE(*,*)' (IF VALUE IS UNKNOWN ENTER ZERO) '
WRITE(*,*)' '
WRITE(*,*)'============================================'
301 write(*,*)' '
write(*,*)'Enter INDICT (from 1 to 15 or 0 if unknown)'
read(*,*) indict
write(*,*)'Enter SUN circle (from 1 to 28 or 0 if
unknown)'
read(*,*) isun
write(*,*)'Enter MOON circle (from 1 to 28 or 0 if unknown)'
read(*,*) imoon
302 WRITE(*,*)' '
WRITE(*,*)
'///////////////////////\\\\\\\\\\\\\\\\\\\\\\\'
WRITE(*,*) ' 1: RUN '
WRITE(*,*) ' 2: CHANGE VALUES'
WRITE(*,*) ' 3: EXIT '
5 WRITE(*,*) ' PLEASE, TYPE THE SELECTION NUMBER AND <ENTER>'
READ(*,'(A)') Q1
IF(Q1.NE.'1'.AND.Q1.NE.'2'.AND.Q1.NE.'3') THEN
WRITE(*,*) ' WRONG SELECTION - MUST BE 1, 2 or 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 'TERMINATED BY USER'
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,*)' NO CORRECTION CORRECTION (S+1,M+1)
CORRECTION (S-1,M-1)'
WRITE(3,*)' ',
.'Adam AD(-5508) Adam AD(-5508) ','Adam
AD(-5508)'
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