Листинг


Автор сообщения: Markab
Дата и время сообщения: 23 April 2007 at 12:13:54:

В ответ на сообщение: Re: Вспышки новых звезд в восточных летописях

///Как я и подозревал, листинг Вы не хотите показать. Если в таких элементарных расчетах Вы врете на полградуса, почему я должен верить Вашим остальным расчетам.///

Я действительно в пятницу в спешке ошибся (забыл закомментировать строки координат, закомментировал только формылы расчета) и взял для новых формул пересчета координаты на J1950. Когда два месяца назад писал программу, я считал и по старому МАСовскому соглашению, и по новому, получается одно и то же. Естественно результаты расчета выборочно проверялись:
http://hea.iki.rssi.ru/AZT22/RUS/cgi-bin/c_prec4.htm

Не нужно верить, берите и проверяйте, тем более, что все данные и источники я выложил. Правда сразу хочу предупредить, что дело гиблое и даже если бы я ошибся на 1 градус(!) во всех рассчетах, то на итоговый результат это никак не повлияло.

Вот листинг, который Вы так хотели, а то будете потом говорить, что я набивал координаты в ручную из веб-калькулятора.

 
PROGRAM GALACT_COORDINAT
IMPLICIT NONE

REAL*8 A1(700), A2(700), A3(700), D1(700), D2(700), D3(700), SD(700), BG(700)
REAL*8 ALF, DEL, Apol, Npol, L0, L, B, B1, B2, LC, LS, Agal, Dgal
INTEGER*4 I, J, NUMBER, CN(20), CN2(20), K, X, Y
CHARACTER*97 LINE(700)
CHARACTER*12 LSS, BSS , PS, S0
CHARACTER*4 S1, S2, IS


OPEN(1, FILE='Ncatalog.txt', STATUS='UNKNOWN', FORM='FORMATTED')
!OPEN(1, FILE='Zand.txt', STATUS='UNKNOWN', FORM='FORMATTED')

DO I = 1, 700
READ(1, FMT = 10, ERR = 8) LINE(I)
10 FORMAT(A97)
END DO
8 NUMBER = I -1


DO J = 1, NUMBER

! J2000.0
! Прямое восхождение
READ(LINE(J)(30:31), *, ERR = 13)A1(J)
READ(LINE(J)(32:33), *, ERR = 13)A2(J)
READ(LINE(J)(34:36), *, ERR = 13)A3(J)

! Склонения
READ(LINE(J)(39:40), *, ERR = 13)D1(J)
READ(LINE(J)(41:42), *, ERR = 13)D2(J)
READ(LINE(J)(43:44), *, ERR = 13)D3(J)

! Знак склонения
IF(LINE(J)(38:38) .eq. '-')THEN
SD(J)=-1 ; ELSE ; SD(J)=1
END IF

! J1950.0
! Прямое восхождение
! READ(LINE(J)(12:13), *, ERR = 13)A1(J)
! READ(LINE(J)(14:15), *, ERR = 13)A2(J)
! READ(LINE(J)(16:18), *, ERR = 13)A3(J)

! Склонения
! READ(LINE(J)(21:22), *, ERR = 13)D1(J)
! READ(LINE(J)(23:24), *, ERR = 13)D2(J)
! READ(LINE(J)(25:26), *, ERR = 13)D3(J)

! Знак склонения
! IF(LINE(J)(20:20) .eq. '-')THEN
! SD(J)=-1 ; ELSE ; SD(J)=1
! END IF

END DO

CLOSE(1)

OPEN(1, file='stars.dat', STATUS='UNKNOWN', FORM='FORMATTED')

! ЭКВАТОРИАЛЬНЫЕ КООРДИНАТЫ

DO I = 1, NUMBER

! Перевод прямого восхождения в градусы
ALF = 15*A1(I) +A2(I)/4.0 +A3(I)/240.
! Перевод склонения в градусы
DEL = SD(I)* (D1(I) +D2(I)/60.0 + D3(I)/3600.0)

! J2000 Куликовский-Сурдин
Agal = 192.85948 ; Dgal = 27.12825 ; L0 = 32.93152
B = ASIND( SIND(DEL)*SIND(Dgal) +COSD(DEL)*COSD(ALF -Agal)*COSD(Dgal))
LC = COSD(DEL)*SIND(ALF -Agal)/COSD(B)
LS = (SIND(DEL)*COSD(Dgal) - COSD(DEL)*COSD(ALF -Agal)*SIND(Dgal) )/COSD(B)

! J1950 Александрович
! Apol = 282.25 ; Npol = 62.6 ; L0 = 32.9315
! B = ASIND( SIND(DEL)*COSD(Npol) -COSD(DEL)*SIND(Npol)*SIND(ALF -Apol) )
! LC = COSD(DEL)*COSD(ALF -Apol)/COSD(B)
! LS = (SIND(DEL)*SIND(Npol) + COSD(DEL)*COSD(Npol)*SIND(ALF -Apol) )/COSD(B)


IF(LC .GT. 0)THEN
IF(LS .GT. 0)THEN
L = ACOSD(LC) +L0 ! cos(+) ; sin(+)
ELSE
L = 360 -ACOSD(LC) +L0 ! cos(-) ; sin(+)
END IF
END IF

IF(LC .LT. 0)THEN
IF(LS .GT. 0)THEN ! cos(+) ; sin(-)
L = ACOSD(LC) +L0
ELSE
L = 180 +ATAND(LS/LC) +L0 ! cos(-) ; sin(-)
END IF
END IF

IF(L .GE. 360)THEN
L = L -360
END IF

BG(I) = B

WRITE(LSS,'(1PG12.5)')L
WRITE(BSS,'(1PG12.4)')B
WRITE(1,*)LSS, BSS,' ', LINE(I)(1:10)

END DO

CLOSE(1)
!STOP

DO I = 1, NUMBER

DO K = 1, 9
B1 = (K -1)*10
B2 = K*10
B = ABS(BG(I))
IF(B1 .LE. B .AND. B .LT. B2)THEN ; CN(K) = CN(K) +1 ; END IF
END DO

DO K = 1, 18
B1 = (K -1)*5
B2 = K*5
B = ABS(BG(I))
IF(B1 .LE. B .AND. B .LT. B2)THEN ; CN2(K) = CN2(K) +1 ; END IF
END DO

END DO

OPEN(1, file='S10.dat', STATUS='UNKNOWN', FORM='FORMATTED')
DO I = 1, 9
B = (10.*I +10.*(I-1))/2

WRITE(S0,'(1PG10.3)')B
WRITE(S1,'(I4)')10*(I-1)
WRITE(S2,'(I4)')10*I
WRITE(IS,'(I4)')CN(I)
WRITE(PS,'(1PG10.3)')(CN(I)*100./NUMBER)

WRITE(*,*)S0, S1//'-'//S2,' ', IS,' ',PS
WRITE(1,*)S0, S1//'-'//S2,' ', IS,' ',PS


END DO
CLOSE(1)

OPEN(1, file='S5.dat', STATUS='UNKNOWN', FORM='FORMATTED')
DO I = 1, 18
B = (5.*I +5.*(I-1))/2

WRITE(S0,'(1PG10.3)')B
WRITE(S1,'(I4)')5*(I-1)
WRITE(S2,'(I4)')5*I
WRITE(IS,'(I4)')CN2(I)
WRITE(PS,'(1PG10.3)')(CN2(I)*100./NUMBER)

WRITE(*,*)S0, S1//'-'//S2,' ', IS,' ',PS
WRITE(1,*)S0, S1//'-'//S2,' ', IS,' ',PS

END DO
CLOSE(1)

! Проверка
!DO I = 1, 18
! X = X +CN(I)
! Y = Y +CN2(I)
!END DO
!WRITE(*,*)X, Y, Number

STOP
13 WRITE(*,*)'Error of read file'

END PROGRAM




2595. Вспышки новых звезд в восточных летописях - Markab 12:32 19.04.07 (63)
К списку тем на странице