Приложение 3. ПРОГРАММА ДЛЯ ПЕРЕВОДА ИНДИКТОВЫХ ДАТ В РУССКО-ВИЗАНТИЙСКУЮ ЭРУ ОТ АДАМА. Программа написана на языке Фортран. ---------------------------------------------------------------- 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 ' 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