mirror of
https://github.com/eddyem/apogee_control.git
synced 2025-12-06 02:35:16 +03:00
add J2000 coordinates calculation
This commit is contained in:
eddyem
parent
6fd081e768
commit
a910538d33
@ -45,6 +45,9 @@ set(MO_FILE ${LCPATH}/LC_MESSAGES/${PROJ}.mo)
|
||||
set(RU_FILE ${LCPATH}/ru.po)
|
||||
find_package(PkgConfig REQUIRED)
|
||||
set(MODULES cfitsio>=3.0 apogeec>=1.71 libusb>=0.1.10)
|
||||
if(NOT DEFINED NOBTA)
|
||||
set(MODULES ${MODULES} sla)
|
||||
endif()
|
||||
if(DEFINED USEPNG)
|
||||
set(MODULES ${MODULES} libpng>=1.2)
|
||||
add_definitions(-DUSEPNG)
|
||||
|
||||
8
README
8
README
@ -1,6 +1,6 @@
|
||||
This utilite depends on library libapogee & C-wrapper over it
|
||||
|
||||
First, you should install a fresest version of libapogee from directory "libapogee"
|
||||
First, you should install a latest version of libapogee from directory "libapogee"
|
||||
or from original site: http://www.randomfactory.com/downloads/
|
||||
If you will meet a bug in link stage ("can't find -lboost_regex-mt") cd to directory
|
||||
libapogee-[version]/apogee and run
|
||||
@ -9,12 +9,14 @@ after this small fix cd .. and run make again.
|
||||
|
||||
Second, you should install apogee_C_wrapper (cd to this directory and do as README sais).
|
||||
|
||||
Third, install apogee_control itself:
|
||||
Third, install libsla.so (if using BTA module)
|
||||
|
||||
And install apogee_control itself:
|
||||
|
||||
1. mkdir mk && cd mk
|
||||
2. cmake ..
|
||||
3. make
|
||||
4. [su -c "make install"] or just copy file takepic wherever you want
|
||||
4. [su -c "make install"] or just copy file apogee_control wherever you want
|
||||
|
||||
File bta_print.c needed to fill specific FITS keys for BTA telescope
|
||||
If your want use this outside SAO RAS localnet, write:
|
||||
|
||||
37
bta_print.c
37
bta_print.c
@ -33,6 +33,32 @@
|
||||
#include "camtools.h"
|
||||
#include "bta_print.h"
|
||||
#include "macros.h"
|
||||
#include <slamac.h> // SLA macros
|
||||
|
||||
extern void sla_amp(double*, double*, double*, double*, double*, double*);
|
||||
|
||||
void slaamp(double ra, double da, double date, double eq, double *rm, double *dm ){
|
||||
double r = ra, d = da, mjd = date, equi = eq;
|
||||
sla_amp(&r, &d, &mjd, &equi, rm, dm);
|
||||
}
|
||||
const double jd0 = 2400000.5; // JD for MJD==0
|
||||
/**
|
||||
* convert apparent coordinates (nowadays) to mean (JD2000)
|
||||
* appRA, appDecl in seconds
|
||||
* r, d in seconds
|
||||
*/
|
||||
void calc_mean(double appRA, double appDecl, double *r, double *d){
|
||||
double ra, dec;
|
||||
appRA *= DS2R;
|
||||
appDecl *= DAS2R;
|
||||
DBG("appRa: %g, appDecl: %g", appRA, appDecl);
|
||||
double mjd = JDate - jd0;
|
||||
slaamp(appRA, appDecl, mjd, 2000.0, &ra, &dec);
|
||||
ra *= DR2S;
|
||||
dec *= DR2AS;
|
||||
if(r) *r = ra;
|
||||
if(d) *d = dec;
|
||||
}
|
||||
|
||||
#define CMNTSZ 79
|
||||
char comment[CMNTSZ + 1];
|
||||
@ -186,6 +212,17 @@ void write_bta_data(fitsfile *fp){
|
||||
dtmp = val_Alp / 3600.; FTKEY(TDOUBLE, "T_RA", &dtmp);
|
||||
CMNT("Telescope Decl.: %s", angle_asc(val_Del));
|
||||
dtmp = val_Del / 3600.; FTKEY(TDOUBLE, "T_DEC", &dtmp);
|
||||
double a2000, d2000;
|
||||
calc_mean(InpAlpha, InpDelta, &a2000, &d2000);
|
||||
CMNT("R.A. given by user (for J2000): %s", time_asc(a2000));
|
||||
FTKEY(TDOUBLE, "INPRA0", &a2000);
|
||||
CMNT("Decl. given by user (for J2000): %s", angle_asc(d2000));
|
||||
FTKEY(TDOUBLE, "INPDEC0", &d2000);
|
||||
calc_mean(CurAlpha, CurDelta, &a2000, &d2000);
|
||||
CMNT("Current R.A. (for J2000): %s", time_asc(a2000));
|
||||
FTKEY(TDOUBLE, "CURRA0", &a2000);
|
||||
CMNT("Current Decl. (for J2000): %s", angle_asc(d2000));
|
||||
FTKEY(TDOUBLE, "CURDEC0", &d2000);
|
||||
// A / Azimuth
|
||||
CMNT("Current object Azimuth: %s", angle_asc(tag_A));
|
||||
dtmp = tag_A / 3600.; FTKEY(TDOUBLE, "A", &dtmp);
|
||||
|
||||
@ -48,9 +48,9 @@ void print_fits_header(fitsfile *fptr __attribute((unused)), int datatype,
|
||||
void _ll(char* r, void* p){snprintf(r, 80, "%lld", *(long long*)p);}
|
||||
void _f(char* r, void* p){snprintf(r, 80, "%g", *(float*)p);}
|
||||
void _d(char* r, void* p){snprintf(r, 80, "%g", *(double*)p);}
|
||||
void _fc(char* r, void* p){snprintf(r, 80, "(%.4g, %.4g)",
|
||||
void _fc(char* r, void* p){snprintf(r, 80, "(%.8g, %.8g)",
|
||||
((float*)p)[0], ((float*)p)[1]);}
|
||||
void _dc(char* r, void* p){snprintf(r, 80, "(%.4g, %.4g)",
|
||||
void _dc(char* r, void* p){snprintf(r, 80, "(%.8g, %.8g)",
|
||||
((double*)p)[0], ((double*)p)[1]);}
|
||||
void _log(char* r, void* p){snprintf(r, 80, "'%s'", (int*)p ? "true" : "false");}
|
||||
void _str(char* r, void* p){snprintf(r, 80, "'%s'", (char*)p);}
|
||||
|
||||
BIN
doc/doc.pdf
Normal file
BIN
doc/doc.pdf
Normal file
Binary file not shown.
309
doc/doc.tex
Normal file
309
doc/doc.tex
Normal file
@ -0,0 +1,309 @@
|
||||
\documentclass[a4paper,12pt]{extarticle}
|
||||
\usepackage[koi8-r]{inputenc}
|
||||
\usepackage[english,russian]{babel}
|
||||
\usepackage{hyperref}
|
||||
\usepackage{ifpdf} % проверка pdflatex/latex
|
||||
\ifpdf
|
||||
\usepackage[pdftex]{graphicx}
|
||||
\usepackage{cmap}
|
||||
\ExecuteOptions{pdftex}
|
||||
\else
|
||||
\usepackage[dvips]{graphicx}
|
||||
\fi
|
||||
\textwidth=17.5cm
|
||||
\oddsidemargin=-.3cm
|
||||
\evensidemargin=-1.2cm
|
||||
\topmargin=-1cm
|
||||
\textheight=24cm
|
||||
\begin{document}
|
||||
\title{Описание параметров командной строки интерфейса управления ПЗС-камерами Apogee}
|
||||
\author{Емельянов Э.В.}
|
||||
\maketitle
|
||||
|
||||
Утилита \verb'apogee_control' предназначена для работы с рядом ПЗС-камер фирмы Apogee Imaging
|
||||
Systems (протестирована на камерах Apogee Alta и Apogee Aspen). Позволяет управлять параметрами
|
||||
ПЗС-камер, получать изображение с камер, отображать его на экране и\slash или сохранять в FITS-файл.
|
||||
При работе на компьютере в сети САО РАН с запущенной системой \verb'bta_control_net' утилита также
|
||||
добавляет в FITS-заголовок файла сведения о телескопе.
|
||||
|
||||
Помимо работы с ПЗС-камерами утилита может также управлять турелями фирмы Apogee.
|
||||
|
||||
\section{Сборка и установка}
|
||||
Утилита использует библиотеку
|
||||
\verb'libapogee'\footnote{\url{http://www.randomfactory.com/downloads/}}, а т.к. сама библиотека
|
||||
написана на C++, дополнительно используется промежуточный интерфейс к С. Библиотека и сишный
|
||||
интерфейс находятся в одном репозитории с утилитой. Скачать их можно командой
|
||||
\begin{verbatim}
|
||||
git clone https://github.com/eddyem/apogee_control.git
|
||||
\end{verbatim}
|
||||
В результате весь репозиторий будет сохранен в директорию \verb'apogee_control'. Внутри нее в
|
||||
директории \verb'libapogee' находится несколько версий библиотек. Для работы с камерами Aspen
|
||||
необходимо установить наиболее свежую.
|
||||
\subsection{Установка libapogee}
|
||||
Распаковываем библиотеку и входим в корневую директорию архива:
|
||||
\begin{verbatim}
|
||||
tar -zxf libapogee-3.0.3179.tgz
|
||||
cd libapogee-3.0.3179/
|
||||
\end{verbatim}
|
||||
Затем конфигурируем, собираем и устанавливаем:
|
||||
\begin{verbatim}
|
||||
./configure && make && su -c "make install"
|
||||
\end{verbatim}
|
||||
В случае нехватки каких-либо библиотек на стадии \verb'./configure' появятся сообщения об ошибке,
|
||||
недостающее необходимо установить.
|
||||
|
||||
\subsection{Установка С-интерфейса к библиотеке}
|
||||
Сишный интерфейс к \verb'libapogee' находится в директории \verb'apogee_C_wrapper' репозитория.
|
||||
Система сборки интерфейса и самой утилиты основана на \verb'cmake'. Для сборки интерфейса выполняем:
|
||||
\begin{verbatim}
|
||||
mkdir mk && cd mk
|
||||
cmake .. && make && su -c "make install"
|
||||
\end{verbatim}
|
||||
Для отображения отладочных сообщений на стадии \verb'cmake' можно указать
|
||||
\begin{verbatim}
|
||||
cmake .. -DEBUG=1
|
||||
\end{verbatim}
|
||||
|
||||
\subsection{Установка утилиты}
|
||||
Код самой утилиты находится в корневой директории репозитория. Для установки выполняем те же
|
||||
действия, что и в случае С-интерфейса:
|
||||
\begin{verbatim}
|
||||
mkdir mk && cd mk
|
||||
cmake .. && make && su -c "make install"
|
||||
\end{verbatim}
|
||||
Для \verb'cmake' в данном случае доступны следующие ключи:
|
||||
\begin{description}
|
||||
\item[-DNOBTA=1] отключить вывод параметров телескопа БТА в заголовок FITS-файла, даже если на
|
||||
компьютере с утилитой запущен демон \verb'bta_control_net';
|
||||
\item[-DUSERAW=1] сохранять изображения в <<сырой>> бинарный формат помимо FITS;
|
||||
\item[-DUSEPNG=1] сохранять изображения в формат PNG помимо FITS;
|
||||
\item[-DEBUG=1] отображать отладочные сообщения;
|
||||
\item[-DTELLAT=<lat>] установить широту телескопа для отображения в заголовке FITS-файла;
|
||||
\item[-DTELLONG=<long>] установить долготу телескопа;
|
||||
\item[-DTELALT=<alt>] задать высоту расположения телескопа относительно уровня моря.
|
||||
\end{description}
|
||||
При записи в заголовок FITS-файла данных АСУ БТА утилита также вычисляет атмосферные параметры по
|
||||
Риду Д.\,Мейеру (Reed D.\,Meyer): воздушную массу, долю водяных паров, плотность столба атмосферы,
|
||||
плотность столба водяного пара. Кроме того, существует возможность сохранять текущие
|
||||
метеорологические параметры и некоторые параметры АСУ в \verb'HISTORY' FITS-файла.
|
||||
|
||||
\section{Работа с утилитой}
|
||||
Сообщения, выдаваемые утилитой, локализованы при помощи \verb'gettext' (однако, по мере разработки
|
||||
возможны некоторые пробелы в локализации). Общая справка по параметрам командной строки выводится
|
||||
при запуске утилиты без параметров.
|
||||
|
||||
На дату написания данного руководства полный список параметров следующий:
|
||||
\begin{verbatim}
|
||||
Использование: apogee_control [опции] [префикс выходных файлов]
|
||||
Опции:
|
||||
-A, --author=author автор программы
|
||||
-c, --cooler-off отключить холодильник
|
||||
-d, --dark не открывать затвор при экспозиции ("темновые")
|
||||
-D, --display-image Отобразить на экране полученное изображение
|
||||
-E, --ether-subnet Subnet fot ethernet camera discovery
|
||||
-f, --no-flash не засвечивать матрицу перед экспозицией
|
||||
-F, --fan-speed=F Установить скорость вентиляторов в F (0..3)
|
||||
-g, --wheel-get получить сведения о турели
|
||||
-G, --wheel-go=N переместить турель в N-ю позицию
|
||||
-H, --time-interval=T интервал времени между последовательными записями в лог
|
||||
и HISTORY (в секундах)
|
||||
-h, --hbin=N биннинг N пикселей по горизонтали
|
||||
-I, --image-type=type тип изображения
|
||||
-i, --instrument=instr название прибора
|
||||
-L, --log-only не сохранять изображения, лишь вести запись статистки
|
||||
-l, --tlog вести запись рабочих температур в файл temp_log
|
||||
-M, --msg-id open camera by its MSG-ID
|
||||
-N, --ncam=N работать с N-й камерой
|
||||
-n, --nframes=N N кадров в серии
|
||||
-O, --object=obj название объекта
|
||||
-o, --observer=obs имена наблюдателей
|
||||
-P, --prog-id=prname название программы наблюдений
|
||||
-p, --pause-len=ptime выдержать ptime секунд между экспозициями
|
||||
-r, --speed-set=N установить скорость считывания в N
|
||||
-R, --reset Полный сброс
|
||||
-S, --sleep перейти в спящий режим
|
||||
-s, --only-stat не сохранять изображение, а только отобразить статистику
|
||||
-T, --only-temp только задать/получить температуру
|
||||
-t, --set-temp=degr задать рабочую температуру degr градусов
|
||||
-v, --vbin=N биннинг N пикселей по вертикали
|
||||
-w, --wheel-num=N установить номер турели в N
|
||||
-W, --wakeup возобновить питание
|
||||
-x, --exp=exptime время экспозиции exptime мс
|
||||
-X, --xclip=X0[,X1] выбрать диапазон для считывания [X0:X1]
|
||||
-Y, --xclip=Y0[,Y1] выбрать диапазон для считывания [Y0:Y1]
|
||||
--flipX отразить изображение вертикально (относительно оси X)
|
||||
--flipY отразить изображение горизонтально (относительно оси Y)
|
||||
--noclean не очищать матрицу после считывания
|
||||
--pre-exp выполнить предварительную нулевую экспозицию для очистки матрицы
|
||||
--shutter-open открыть затвор
|
||||
--shutter-close заткрыть затвор
|
||||
--test-headers не открывать устройство, лишь отобразить шапку FITS
|
||||
--twelve-bit работать в 12-битном режиме
|
||||
\end{verbatim}
|
||||
Некоторые (наиболее редко используемые) параметры имеют только <<длинный>> формат параметра.
|
||||
\subsection{Управление параметрами камеры и кадра}
|
||||
\begin{description}
|
||||
\item[-c, -{}-cooler-off] отключить подачу напряжения на элемент Пельтье (для выхода ПЗС на
|
||||
комнатную температуру);
|
||||
\item[-d, -{}-dark] снимать <<темновые>> кадры --- не открывать затвор при экспозиции;
|
||||
\item[-E, -{}-ether-subnet=subn] задать подсеть (в виде маски адресов или конкретного IP-адреса)
|
||||
при работе с сетевой версией Apogee Aspen, например, \verb'-E 192.168.0.255' для поиска
|
||||
камеры в сети \verb'192.168.0.0/24';
|
||||
\item[-M, -{}-msg-id=ID] попытаться подключиться к камере с конкретным идентификатором, данный
|
||||
идентификатор выдается утилитой при подключении к камере, пример:
|
||||
\begin{verbatim}
|
||||
apogee_control -M interface=ethernet,deviceType=camera,
|
||||
address=192.168.99.121,port=80,mac=000951ffffff81ffffffed22,
|
||||
interfaceStatus=Available,id=0x1a3,firmwareRev=0x132,model=Aspen-16M
|
||||
\end{verbatim}
|
||||
данный параметр позволяет ускорить процесс работы с сетевыми камерами;
|
||||
\item[-f, -{}-no-flash] не выполнять предварительную засветку ПЗС встроенным ИК-светодиодом
|
||||
при экспозиции (работает не для всех камер);
|
||||
\item[-F, -{}-fan-speed=F] принудительно установить скорость вращения вентиляторов, величина
|
||||
скорости изменяется от 0~(выключены) до 3~(наибольшая скорость);
|
||||
\item[-h, -{}-hbin=N] горизонтальный биннинг (предельное значение N зависит от типа ПЗС);
|
||||
\item[-v, -{}-vbin=N] вертикальный биннинг (предельное значение N зависит от типа ПЗС);
|
||||
\item[-N, -{}-ncam=N] если обнаружено несколько ПЗС-камер, работать с N-й;
|
||||
\item[-n, -{}-nframes=N] провести серию снимков из N~кадров;
|
||||
\item[-p, -{}-pause-len=ptime] выдержать \verb'ptime' секунд паузы между кадрами при работе с
|
||||
серией кадров;
|
||||
\item[-r, -{}-speed-set=N] устаревший параметр для задания скорости считывания (не работает
|
||||
с большинством современных камер);
|
||||
\item[-{}-twelve-bit] двенадцатибитный режим работы (высокая скорость считывания);
|
||||
\item[-R, -{}-reset] полный сброс параметров камеры (работает не на всех камерах);
|
||||
\item[-S, -{}-sleep] перевод камеры в спящий режим (работает не на всех камерах);
|
||||
\item[-T, -{}-only-temp] только задать\slash отобразить температуру узлов камеры;
|
||||
\item[-t, -{}-set-temp=degr] установить температуру чипа ПЗС в \verb'degr' градусов Цельсия;
|
||||
\item[-W, -{}-wakeup] выйти из спящего режима (работает не на всех камерах);
|
||||
\item[-x, -{}-exp=exptime] установить время экспозиции каждого кадра в \verb'exptime' миллисекунд;
|
||||
\item[-X, -{}-xclip=X0$\lbrack$,X1$\rbrack$] выбрать поддиапазон для считывания по оси~X;
|
||||
\item[-Y, -{}-xclip=Y0$\lbrack$,Y1$\rbrack$] выбрать поддиапазон для считывания по оси~Y;
|
||||
\item[-{}-flipX] отразить изображение вертикально (относительно оси X);
|
||||
\item[-{}-flipY] отразить изображение горизонтально (относительно оси Y);
|
||||
\item[-{}-noclean] не очищать матрицу после считывания (т.е. не удалять остаточный сигнал, работает
|
||||
не на всех камерах);
|
||||
\item[-{}-pre-exp] выполнить предварительную нулевую экспозицию (бывает необходимо для того,
|
||||
чтобы параметры камеры наверняка успели правильно выставиться перед выполнением основных
|
||||
экспозиций; без этого параметра возможны излишние шумы или даже повреждение кадра вследствие
|
||||
начала считывания не с нулевой позиции);
|
||||
\item[-{}-shutter-open] открыть затвор;
|
||||
\item[-{}-shutter-close] заткрыть затвор.
|
||||
\end{description}
|
||||
\subsection{Управление параметрами заголовка FITS-Файлов}
|
||||
Часть параметров заголовка формируемых FITS-файлов задается аргументами командной строки:
|
||||
\begin{description}
|
||||
\item[-A, -{}-author=author] автор программы (\verb'AUTHOR');
|
||||
\item[-I, -{}-image-type=type] тип изображения (\verb'IMAGETYP');
|
||||
\item[-i, -{}-instrument=instr] название прибора (\verb'INSTRUME');
|
||||
\item[-O, -{}-object=obj] название объекта (\verb'OBJECT');
|
||||
\item[-o, -{}-observer=obs] имена наблюдателей (\verb'OBSERVER');
|
||||
\item[-P, -{}-prog-id=prname] название программы наблюдений (\verb'PROG-ID');
|
||||
\item[-{}-test-headers] не снимать ни единого кадра, а только отобразить заголовок,
|
||||
который писался бы в формируемый FITS-файл (некоторые параметры будут неверными ввиду
|
||||
отсутствия изображения).
|
||||
\end{description}
|
||||
Если не указывать ключ \verb'-I', при съемке обычных кадров в поле \verb'IMAGETYP' заголовка
|
||||
FITS-файла будет указано: <<object>>; если же задать ключ \verb'-d' для съемки темновых, тип будет
|
||||
установлен в <<dark>>; при установки нулевой экспозиции (\verb'-x 0') в качестве типа изображения
|
||||
будет указано <<bias>>.
|
||||
|
||||
Содержимое многих ключей заголовка FITS-файла не соответствует стандарту и будет исправлено при
|
||||
дальнейших модификациях утилиты.
|
||||
|
||||
\subsection{Работа с турелями Apogee}
|
||||
\begin{description}
|
||||
\item[-g, -{}-wheel-get] получить сведения о турели;
|
||||
\item[-G, -{}-wheel-go=N] переместить турель в N-ю позицию;
|
||||
\item[-w, -{}-wheel-num=N] если к компьютеру подключено несколько турелей, выбрать N-ю для
|
||||
дальнейшей работы.
|
||||
\end{description}
|
||||
|
||||
\subsection{Статистика, логгирование и сохранение\slash отображение}
|
||||
После съемки очередного кадра в командной строке выводится основная статистическая информация
|
||||
по изображению. Изображение в дальнейшем может быть уничтожено, сохранено и\slash или отображено
|
||||
на экране.
|
||||
|
||||
Если утилита \verb'apogee_control' вызывается без указания префикса выходных файлов, изображения
|
||||
только отображаются на экране (если не указано противного). Помимо этого, утилита способна
|
||||
сохранять статистические параметры отснятых кадров в лог-файл (скажем, для получения простых
|
||||
температурных зависимостей).
|
||||
|
||||
\begin{description}
|
||||
\item[-D, -{}-display-image] данный параметр позволяет отображать отснятые изображения даже если
|
||||
указан префикс файла для сохранения; чтобы закрыть окно с последним изображением серии,
|
||||
необходимо либо нажать в окне клавишу ESC, либо в консоли сочетание Ctrl+C. Окно с изображением
|
||||
можно масштабировать, также при помощи колеса мыши с зажатой клавишей Ctrl можно масштабировать
|
||||
само изображение внутри окна, а средней кнопкой мыши перемещать его. По нажатию правой кнопки
|
||||
мыши появляется меню, позволяющее восстановить исходный масштаб изображения или закрыть окно;
|
||||
\item[-H, -{}-time-interval=T] интервал времени между последовательными записями в лог
|
||||
и HISTORY (в секундах);
|
||||
\item[-L, -{}-log-only] не сохранять изображения, лишь вести запись статистки в лог;
|
||||
\item[-l, -{}-tlog] отдельно вести запись рабочих температур в файл \verb'temp_log';
|
||||
\item[-s, -{}-only-stat] не сохранять изображение, а только отобразить статистику.
|
||||
\end{description}
|
||||
|
||||
|
||||
\section{Заголовки FITS-файлов}
|
||||
Набор генерируемых утилитой заголовков FITS-файлов зависит от того, скомпилирована ли утилита с
|
||||
поддержкой АСУ БТА и запущен ли на компьютере демон АСУ. Минимальный общий набор заголовков
|
||||
следующий:
|
||||
\begin{description}
|
||||
\item[FILE] название оригинального файла;
|
||||
\item[INSTRUME] название прибора (по умолчанию <<direct imaging>>);
|
||||
\item[PXSIZE] размер пикселя в мкм вида <<H x V>>;
|
||||
\item[XPIXELSZ, YPIXELSZ] горизонтальный и вертикальный размер пикселя в мкм (число с плавающей
|
||||
точкой);
|
||||
\item[VIEW\_FIELD] поле зрения камеры в пикселях;
|
||||
\item[CRVAL1, CRVAL2] (-1);
|
||||
\item[IMAGETYP] тип изображения;
|
||||
\item[DATAMAX, DATAMIN] наибольшее и наименьшее значение в рабочем диапазоне (для 16 бит этого
|
||||
65535 и 0 соответственно);
|
||||
\item[STATMAX, STATMIN] статистические максимум и минимум по изображению;
|
||||
\item[STATAVR, STATSTD] среднее и среднеквадратическое значения по изображению;
|
||||
\item[TEMP0, TEMP1] температура чипа ПЗС на момент начала и окончания экспозиции соответственно
|
||||
($^\circ C$);
|
||||
\item[TEMPBODY] температура горячего спая Пельтье на время окончания экспозиции ($^\circ C$);
|
||||
\item[CAMTEMP] температура чипа в Кельвинах на окончание экспозиции;
|
||||
\item[EXPTIME] время экспозиции в секундах;
|
||||
\item[DATE] дата и время запуска утилиты, UTC;
|
||||
\item[DATE-OBS] местные дата и время записи файла;
|
||||
\item[XBIN, YBIN] биннинг.
|
||||
\end{description}
|
||||
|
||||
При поддержке АСУ БТА набор заголовков дополняется следующими:
|
||||
\begin{description}
|
||||
\item[TELESCOP] название телескопа (<<BTA 6m telescope>>);
|
||||
\item[ORIGIN] название организации (<<SAO RAS>>);
|
||||
\item[OBSERVAT] название обсерватории (<<Special Astrophysical Observatory, Russia>>)
|
||||
\item[ALT\_OBS] высота над уровнем моря (2070);
|
||||
\item[LONG\_OBS] долгота в градусах (41.4414);
|
||||
\item[LAT\_OBS] широта в градусах (43.6535);
|
||||
\item[ST] звездное время в секундах (в комментарии также указано в строковом формате);
|
||||
\item[UT] UTC в секундах (в комментарии также указано в строковом формате);
|
||||
\item[JD] юлианская дата (пока что -- в неправильном формате);
|
||||
\item[FOCUS] фокус: <<Prime>> или <<Nesmith>>;
|
||||
\item[VAL\_F] значение отсчета фокуса в миллиметрах;
|
||||
\item[EQUINOX] эпоха значений RA/DEC (обычно -- дата получения изображения в годах);
|
||||
\item[RA, DEC] полярные координаты объекта на эпоху EQUINOX;
|
||||
\item[S\_RA, S\_DEC] введенные пользователем координаты;
|
||||
\item[T\_RA, T\_DEC] координаты телескопа;
|
||||
\item[A, Z] горизонтальные координаты видимого места объекта;
|
||||
\item[ROTANGLE] параллактический угол;
|
||||
\item[VAL\_A, VAL\_Z] горизонтальные координаты телескопа;
|
||||
\item[VAL\_P] значение отсчетов с поворотного стола P2 (в градусах);
|
||||
\item[VAL\_D] азимут купола;
|
||||
\item[OUTTEMP] внешняя температура;
|
||||
\item[DOMETEMP] температура в подкупольном;
|
||||
\item[MIRRTEMP] температура зеркала;
|
||||
\item[PRESSURE] атмосферное давление, мм.рт.ст.;
|
||||
\item[WIND] скорость ветра;
|
||||
\item[HUM] влажность;
|
||||
\item[AIRMASS] воздушная масса;
|
||||
\item[WVAM] воздушная масса водяных паров;
|
||||
\item[ATMDENS] давление атмосферного столба;
|
||||
\item[WVDENS] давление столба водяных паров.
|
||||
\end{description}
|
||||
|
||||
\end{document}
|
||||
|
||||
|
||||
44
slalib/Makefile
Normal file
44
slalib/Makefile
Normal file
@ -0,0 +1,44 @@
|
||||
# Makefile for SLALIB
|
||||
# for Pentium/Linux
|
||||
# by Scott M. Ransom
|
||||
|
||||
# OS type
|
||||
OS = Linux
|
||||
#OS = OSX
|
||||
|
||||
# Linux is the first choice
|
||||
ifeq ($(OS),Linux)
|
||||
LIBSUFFIX = .so
|
||||
LIBCMD = -shared
|
||||
SYSDIR = /usr
|
||||
LOCDIR = /usr/local
|
||||
# else assume Darwin (i.e. OSX)
|
||||
else
|
||||
LIBSUFFIX = .dylib
|
||||
LIBCMD = -dynamiclib
|
||||
SYSDIR = /sw
|
||||
LOCDIR = /sw
|
||||
endif
|
||||
|
||||
CC = gcc
|
||||
FC = gfortran
|
||||
#FC = g77
|
||||
CFLAGS = -O2 -Wall -W -fPIC
|
||||
CLINKFLAGS = $(CFLAGS)
|
||||
FFLAGS = -O2 -fPIC
|
||||
FLINKFLAGS = $(FFLAGS)
|
||||
|
||||
all: libsla
|
||||
|
||||
libsla:
|
||||
$(FC) $(FFLAGS) -fno-underscoring -c -I. *.f *.F
|
||||
$(FC) $(LIBCMD) -o libsla$(LIBSUFFIX) -fno-underscoring *.o
|
||||
|
||||
clean:
|
||||
rm -f *.o *~ *#
|
||||
rm -rf build
|
||||
|
||||
install:
|
||||
cp sla.pc /usr/share/pkgconfig
|
||||
cp libsla$(LIBSUFFIX) /usr/lib
|
||||
cp slamac.h /usr/include
|
||||
1
slalib/README
Normal file
1
slalib/README
Normal file
@ -0,0 +1 @@
|
||||
clone of https://github.com/scottransom/pyslalib.git with deleted unnesessary files
|
||||
84
slalib/addet.f
Normal file
84
slalib/addet.f
Normal file
@ -0,0 +1,84 @@
|
||||
SUBROUTINE sla_ADDET (RM, DM, EQ, RC, DC)
|
||||
*+
|
||||
* - - - - - -
|
||||
* A D D E T
|
||||
* - - - - - -
|
||||
*
|
||||
* Add the E-terms (elliptic component of annual aberration)
|
||||
* to a pre IAU 1976 mean place to conform to the old
|
||||
* catalogue convention (double precision)
|
||||
*
|
||||
* Given:
|
||||
* RM,DM dp RA,Dec (radians) without E-terms
|
||||
* EQ dp Besselian epoch of mean equator and equinox
|
||||
*
|
||||
* Returned:
|
||||
* RC,DC dp RA,Dec (radians) with E-terms included
|
||||
*
|
||||
* Note:
|
||||
*
|
||||
* Most star positions from pre-1984 optical catalogues (or
|
||||
* derived from astrometry using such stars) embody the
|
||||
* E-terms. If it is necessary to convert a formal mean
|
||||
* place (for example a pulsar timing position) to one
|
||||
* consistent with such a star catalogue, then the RA,Dec
|
||||
* should be adjusted using this routine.
|
||||
*
|
||||
* Reference:
|
||||
* Explanatory Supplement to the Astronomical Ephemeris,
|
||||
* section 2D, page 48.
|
||||
*
|
||||
* Called: sla_ETRMS, sla_DCS2C, sla_DCC2S, sla_DRANRM, sla_DRANGE
|
||||
*
|
||||
* P.T.Wallace Starlink 18 March 1999
|
||||
*
|
||||
* Copyright (C) 1999 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RM,DM,EQ,RC,DC
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM
|
||||
|
||||
DOUBLE PRECISION A(3),V(3)
|
||||
|
||||
INTEGER I
|
||||
|
||||
|
||||
|
||||
* E-terms vector
|
||||
CALL sla_ETRMS(EQ,A)
|
||||
|
||||
* Spherical to Cartesian
|
||||
CALL sla_DCS2C(RM,DM,V)
|
||||
|
||||
* Include the E-terms
|
||||
DO I=1,3
|
||||
V(I)=V(I)+A(I)
|
||||
END DO
|
||||
|
||||
* Cartesian to spherical
|
||||
CALL sla_DCC2S(V,RC,DC)
|
||||
|
||||
* Bring RA into conventional range
|
||||
RC=sla_DRANRM(RC)
|
||||
|
||||
END
|
||||
119
slalib/afin.f
Normal file
119
slalib/afin.f
Normal file
@ -0,0 +1,119 @@
|
||||
SUBROUTINE sla_AFIN (STRING, IPTR, A, J)
|
||||
*+
|
||||
* - - - - -
|
||||
* A F I N
|
||||
* - - - - -
|
||||
*
|
||||
* Sexagesimal character string to angle (single precision)
|
||||
*
|
||||
* Given:
|
||||
* STRING c*(*) string containing deg, arcmin, arcsec fields
|
||||
* IPTR i pointer to start of decode (1st = 1)
|
||||
*
|
||||
* Returned:
|
||||
* IPTR i advanced past the decoded angle
|
||||
* A r angle in radians
|
||||
* J i status: 0 = OK
|
||||
* +1 = default, A unchanged
|
||||
* -1 = bad degrees )
|
||||
* -2 = bad arcminutes ) (note 3)
|
||||
* -3 = bad arcseconds )
|
||||
*
|
||||
* Example:
|
||||
*
|
||||
* argument before after
|
||||
*
|
||||
* STRING '-57 17 44.806 12 34 56.7' unchanged
|
||||
* IPTR 1 16 (points to 12...)
|
||||
* A ? -1.00000
|
||||
* J ? 0
|
||||
*
|
||||
* A further call to sla_AFIN, without adjustment of IPTR, will
|
||||
* decode the second angle, 12deg 34min 56.7sec.
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The first three "fields" in STRING are degrees, arcminutes,
|
||||
* arcseconds, separated by spaces or commas. The degrees field
|
||||
* may be signed, but not the others. The decoding is carried
|
||||
* out by the DFLTIN routine and is free-format.
|
||||
*
|
||||
* 2) Successive fields may be absent, defaulting to zero. For
|
||||
* zero status, the only combinations allowed are degrees alone,
|
||||
* degrees and arcminutes, and all three fields present. If all
|
||||
* three fields are omitted, a status of +1 is returned and A is
|
||||
* unchanged. In all other cases A is changed.
|
||||
*
|
||||
* 3) Range checking:
|
||||
*
|
||||
* The degrees field is not range checked. However, it is
|
||||
* expected to be integral unless the other two fields are
|
||||
* absent.
|
||||
*
|
||||
* The arcminutes field is expected to be 0-59, and integral if
|
||||
* the arcseconds field is present. If the arcseconds field
|
||||
* is absent, the arcminutes is expected to be 0-59.9999...
|
||||
*
|
||||
* The arcseconds field is expected to be 0-59.9999...
|
||||
*
|
||||
* 4) Decoding continues even when a check has failed. Under these
|
||||
* circumstances the field takes the supplied value, defaulting
|
||||
* to zero, and the result A is computed and returned.
|
||||
*
|
||||
* 5) Further fields after the three expected ones are not treated
|
||||
* as an error. The pointer IPTR is left in the correct state
|
||||
* for further decoding with the present routine or with DFLTIN
|
||||
* etc. See the example, above.
|
||||
*
|
||||
* 6) If STRING contains hours, minutes, seconds instead of degrees
|
||||
* etc, or if the required units are turns (or days) instead of
|
||||
* radians, the result A should be multiplied as follows:
|
||||
*
|
||||
* for to obtain multiply
|
||||
* STRING A in A by
|
||||
*
|
||||
* d ' " radians 1 = 1.0
|
||||
* d ' " turns 1/2pi = 0.1591549430918953358
|
||||
* h m s radians 15 = 15.0
|
||||
* h m s days 15/2pi = 2.3873241463784300365
|
||||
*
|
||||
* Called: sla_DAFIN
|
||||
*
|
||||
* P.T.Wallace Starlink 13 September 1990
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) STRING
|
||||
INTEGER IPTR
|
||||
REAL A
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION AD
|
||||
|
||||
|
||||
|
||||
* Call the double precision version
|
||||
CALL sla_DAFIN(STRING,IPTR,AD,J)
|
||||
IF (J.LE.0) A=REAL(AD)
|
||||
|
||||
END
|
||||
75
slalib/airmas.f
Normal file
75
slalib/airmas.f
Normal file
@ -0,0 +1,75 @@
|
||||
DOUBLE PRECISION FUNCTION sla_AIRMAS (ZD)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* A I R M A S
|
||||
* - - - - - - -
|
||||
*
|
||||
* Air mass at given zenith distance (double precision)
|
||||
*
|
||||
* Given:
|
||||
* ZD d Observed zenith distance (radians)
|
||||
*
|
||||
* The result is an estimate of the air mass, in units of that
|
||||
* at the zenith.
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The "observed" zenith distance referred to above means "as
|
||||
* affected by refraction".
|
||||
*
|
||||
* 2) Uses Hardie's (1962) polynomial fit to Bemporad's data for
|
||||
* the relative air mass, X, in units of thickness at the zenith
|
||||
* as tabulated by Schoenberg (1929). This is adequate for all
|
||||
* normal needs as it is accurate to better than 0.1% up to X =
|
||||
* 6.8 and better than 1% up to X = 10. Bemporad's tabulated
|
||||
* values are unlikely to be trustworthy to such accuracy
|
||||
* because of variations in density, pressure and other
|
||||
* conditions in the atmosphere from those assumed in his work.
|
||||
*
|
||||
* 3) The sign of the ZD is ignored.
|
||||
*
|
||||
* 4) At zenith distances greater than about ZD = 87 degrees the
|
||||
* air mass is held constant to avoid arithmetic overflows.
|
||||
*
|
||||
* References:
|
||||
* Hardie, R.H., 1962, in "Astronomical Techniques"
|
||||
* ed. W.A. Hiltner, University of Chicago Press, p180.
|
||||
* Schoenberg, E., 1929, Hdb. d. Ap.,
|
||||
* Berlin, Julius Springer, 2, 268.
|
||||
*
|
||||
* Original code by P.W.Hill, St Andrews
|
||||
*
|
||||
* P.T.Wallace Starlink 18 March 1999
|
||||
*
|
||||
* Copyright (C) 1999 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION ZD
|
||||
|
||||
DOUBLE PRECISION SECZM1
|
||||
|
||||
|
||||
SECZM1 = 1D0/(COS(MIN(1.52D0,ABS(ZD))))-1D0
|
||||
sla_AIRMAS = 1D0 + SECZM1*(0.9981833D0
|
||||
: - SECZM1*(0.002875D0 + 0.0008083D0*SECZM1))
|
||||
|
||||
END
|
||||
162
slalib/altaz.f
Normal file
162
slalib/altaz.f
Normal file
@ -0,0 +1,162 @@
|
||||
SUBROUTINE sla_ALTAZ (HA, DEC, PHI,
|
||||
: AZ, AZD, AZDD, EL, ELD, ELDD, PA, PAD, PADD)
|
||||
*+
|
||||
* - - - - - -
|
||||
* A L T A Z
|
||||
* - - - - - -
|
||||
*
|
||||
* Positions, velocities and accelerations for an altazimuth
|
||||
* telescope mount.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* HA d hour angle
|
||||
* DEC d declination
|
||||
* PHI d observatory latitude
|
||||
*
|
||||
* Returned:
|
||||
* AZ d azimuth
|
||||
* AZD d " velocity
|
||||
* AZDD d " acceleration
|
||||
* EL d elevation
|
||||
* ELD d " velocity
|
||||
* ELDD d " acceleration
|
||||
* PA d parallactic angle
|
||||
* PAD d " " velocity
|
||||
* PADD d " " acceleration
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) Natural units are used throughout. HA, DEC, PHI, AZ, EL
|
||||
* and ZD are in radians. The velocities and accelerations
|
||||
* assume constant declination and constant rate of change of
|
||||
* hour angle (as for tracking a star); the units of AZD, ELD
|
||||
* and PAD are radians per radian of HA, while the units of AZDD,
|
||||
* ELDD and PADD are radians per radian of HA squared. To
|
||||
* convert into practical degree- and second-based units:
|
||||
*
|
||||
* angles * 360/2pi -> degrees
|
||||
* velocities * (2pi/86400)*(360/2pi) -> degree/sec
|
||||
* accelerations * ((2pi/86400)**2)*(360/2pi) -> degree/sec/sec
|
||||
*
|
||||
* Note that the seconds here are sidereal rather than SI. One
|
||||
* sidereal second is about 0.99727 SI seconds.
|
||||
*
|
||||
* The velocity and acceleration factors assume the sidereal
|
||||
* tracking case. Their respective numerical values are (exactly)
|
||||
* 1/240 and (approximately) 1/3300236.9.
|
||||
*
|
||||
* 2) Azimuth is returned in the range 0-2pi; north is zero,
|
||||
* and east is +pi/2. Elevation and parallactic angle are
|
||||
* returned in the range +/-pi. Parallactic angle is +ve for
|
||||
* a star west of the meridian and is the angle NP-star-zenith.
|
||||
*
|
||||
* 3) The latitude is geodetic as opposed to geocentric. The
|
||||
* hour angle and declination are topocentric. Refraction and
|
||||
* deficiencies in the telescope mounting are ignored. The
|
||||
* purpose of the routine is to give the general form of the
|
||||
* quantities. The details of a real telescope could profoundly
|
||||
* change the results, especially close to the zenith.
|
||||
*
|
||||
* 4) No range checking of arguments is carried out.
|
||||
*
|
||||
* 5) In applications which involve many such calculations, rather
|
||||
* than calling the present routine it will be more efficient to
|
||||
* use inline code, having previously computed fixed terms such
|
||||
* as sine and cosine of latitude, and (for tracking a star)
|
||||
* sine and cosine of declination.
|
||||
*
|
||||
* This revision: 29 October 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION HA,DEC,PHI,AZ,AZD,AZDD,EL,ELD,ELDD,PA,PAD,PADD
|
||||
|
||||
DOUBLE PRECISION DPI,D2PI,TINY
|
||||
PARAMETER (DPI=3.1415926535897932384626433832795D0,
|
||||
: D2PI=6.283185307179586476925286766559D0,
|
||||
: TINY=1D-30)
|
||||
|
||||
DOUBLE PRECISION SH,CH,SD,CD,SP,CP,CHCD,SDCP,X,Y,Z,RSQ,R,A,E,C,S,
|
||||
: Q,QD,AD,ED,EDR,ADD,EDD,QDD
|
||||
|
||||
|
||||
* Useful functions
|
||||
SH=SIN(HA)
|
||||
CH=COS(HA)
|
||||
SD=SIN(DEC)
|
||||
CD=COS(DEC)
|
||||
SP=SIN(PHI)
|
||||
CP=COS(PHI)
|
||||
CHCD=CH*CD
|
||||
SDCP=SD*CP
|
||||
X=-CHCD*SP+SDCP
|
||||
Y=-SH*CD
|
||||
Z=CHCD*CP+SD*SP
|
||||
RSQ=X*X+Y*Y
|
||||
R=SQRT(RSQ)
|
||||
|
||||
* Azimuth and elevation
|
||||
IF (RSQ.EQ.0D0) THEN
|
||||
A=0D0
|
||||
ELSE
|
||||
A=ATAN2(Y,X)
|
||||
END IF
|
||||
IF (A.LT.0D0) A=A+D2PI
|
||||
E=ATAN2(Z,R)
|
||||
|
||||
* Parallactic angle
|
||||
C=CD*SP-CH*SDCP
|
||||
S=SH*CP
|
||||
IF (C*C+S*S.GT.0) THEN
|
||||
Q=ATAN2(S,C)
|
||||
ELSE
|
||||
Q=DPI-HA
|
||||
END IF
|
||||
|
||||
* Velocities and accelerations (clamped at zenith/nadir)
|
||||
IF (RSQ.LT.TINY) THEN
|
||||
RSQ=TINY
|
||||
R=SQRT(RSQ)
|
||||
END IF
|
||||
QD=-X*CP/RSQ
|
||||
AD=SP+Z*QD
|
||||
ED=CP*Y/R
|
||||
EDR=ED/R
|
||||
ADD=EDR*(Z*SP+(2D0-RSQ)*QD)
|
||||
EDD=-R*QD*AD
|
||||
QDD=EDR*(SP+2D0*Z*QD)
|
||||
|
||||
* Results
|
||||
AZ=A
|
||||
AZD=AD
|
||||
AZDD=ADD
|
||||
EL=E
|
||||
ELD=ED
|
||||
ELDD=EDD
|
||||
PA=Q
|
||||
PAD=QD
|
||||
PADD=QDD
|
||||
|
||||
END
|
||||
88
slalib/amp.f
Normal file
88
slalib/amp.f
Normal file
@ -0,0 +1,88 @@
|
||||
SUBROUTINE sla_AMP (RA, DA, DATE, EQ, RM, DM)
|
||||
*+
|
||||
* - - - -
|
||||
* A M P
|
||||
* - - - -
|
||||
*
|
||||
* Convert star RA,Dec from geocentric apparent to mean place
|
||||
*
|
||||
* The mean coordinate system is the post IAU 1976 system,
|
||||
* loosely called FK5.
|
||||
*
|
||||
* Given:
|
||||
* RA d apparent RA (radians)
|
||||
* DA d apparent Dec (radians)
|
||||
* DATE d TDB for apparent place (JD-2400000.5)
|
||||
* EQ d equinox: Julian epoch of mean place
|
||||
*
|
||||
* Returned:
|
||||
* RM d mean RA (radians)
|
||||
* DM d mean Dec (radians)
|
||||
*
|
||||
* References:
|
||||
* 1984 Astronomical Almanac, pp B39-B41.
|
||||
* (also Lederle & Schwan, Astron. Astrophys. 134,
|
||||
* 1-6, 1984)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The distinction between the required TDB and TT is always
|
||||
* negligible. Moreover, for all but the most critical
|
||||
* applications UTC is adequate.
|
||||
*
|
||||
* 2) Iterative techniques are used for the aberration and light
|
||||
* deflection corrections so that the routines sla_AMP (or
|
||||
* sla_AMPQK) and sla_MAP (or sla_MAPQK) are accurate inverses;
|
||||
* even at the edge of the Sun's disc the discrepancy is only
|
||||
* about 1 nanoarcsecond.
|
||||
*
|
||||
* 3) Where multiple apparent places are to be converted to mean
|
||||
* places, for a fixed date and equinox, it is more efficient to
|
||||
* use the sla_MAPPA routine to compute the required parameters
|
||||
* once, followed by one call to sla_AMPQK per star.
|
||||
*
|
||||
* 4) The accuracy is sub-milliarcsecond, limited by the
|
||||
* precession-nutation model (IAU 1976 precession, Shirai &
|
||||
* Fukushima 2001 forced nutation and precession corrections).
|
||||
*
|
||||
* 5) The accuracy is further limited by the routine sla_EVP, called
|
||||
* by sla_MAPPA, which computes the Earth position and velocity
|
||||
* using the methods of Stumpff. The maximum error is about
|
||||
* 0.3 mas.
|
||||
*
|
||||
* Called: sla_MAPPA, sla_AMPQK
|
||||
*
|
||||
* P.T.Wallace Starlink 17 September 2001
|
||||
*
|
||||
* Copyright (C) 2001 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RA,DA,DATE,EQ,RM,DM
|
||||
|
||||
DOUBLE PRECISION AMPRMS(21)
|
||||
|
||||
|
||||
|
||||
CALL sla_MAPPA(EQ,DATE,AMPRMS)
|
||||
CALL sla_AMPQK(RA,DA,AMPRMS,RM,DM)
|
||||
|
||||
END
|
||||
139
slalib/ampqk.f
Normal file
139
slalib/ampqk.f
Normal file
@ -0,0 +1,139 @@
|
||||
SUBROUTINE sla_AMPQK (RA, DA, AMPRMS, RM, DM)
|
||||
*+
|
||||
* - - - - - -
|
||||
* A M P Q K
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert star RA,Dec from geocentric apparent to mean place
|
||||
*
|
||||
* The mean coordinate system is the post IAU 1976 system,
|
||||
* loosely called FK5.
|
||||
*
|
||||
* Use of this routine is appropriate when efficiency is important
|
||||
* and where many star positions are all to be transformed for
|
||||
* one epoch and equinox. The star-independent parameters can be
|
||||
* obtained by calling the sla_MAPPA routine.
|
||||
*
|
||||
* Given:
|
||||
* RA d apparent RA (radians)
|
||||
* DA d apparent Dec (radians)
|
||||
*
|
||||
* AMPRMS d(21) star-independent mean-to-apparent parameters:
|
||||
*
|
||||
* (1) time interval for proper motion (Julian years)
|
||||
* (2-4) barycentric position of the Earth (AU)
|
||||
* (5-7) heliocentric direction of the Earth (unit vector)
|
||||
* (8) (grav rad Sun)*2/(Sun-Earth distance)
|
||||
* (9-11) ABV: barycentric Earth velocity in units of c
|
||||
* (12) sqrt(1-v**2) where v=modulus(ABV)
|
||||
* (13-21) precession/nutation (3,3) matrix
|
||||
*
|
||||
* Returned:
|
||||
* RM d mean RA (radians)
|
||||
* DM d mean Dec (radians)
|
||||
*
|
||||
* References:
|
||||
* 1984 Astronomical Almanac, pp B39-B41.
|
||||
* (also Lederle & Schwan, Astron. Astrophys. 134,
|
||||
* 1-6, 1984)
|
||||
*
|
||||
* Note:
|
||||
*
|
||||
* Iterative techniques are used for the aberration and
|
||||
* light deflection corrections so that the routines
|
||||
* sla_AMP (or sla_AMPQK) and sla_MAP (or sla_MAPQK) are
|
||||
* accurate inverses; even at the edge of the Sun's disc
|
||||
* the discrepancy is only about 1 nanoarcsecond.
|
||||
*
|
||||
* Called: sla_DCS2C, sla_DIMXV, sla_DVDV, sla_DVN, sla_DCC2S,
|
||||
* sla_DRANRM
|
||||
*
|
||||
* P.T.Wallace Starlink 7 May 2000
|
||||
*
|
||||
* Copyright (C) 2000 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RA,DA,AMPRMS(21),RM,DM
|
||||
|
||||
INTEGER I,J
|
||||
|
||||
DOUBLE PRECISION GR2E,AB1,EHN(3),ABV(3),P3(3),P2(3),
|
||||
: AB1P1,P1DV,P1DVP1,P1(3),W,PDE,PDEP1,P(3)
|
||||
|
||||
DOUBLE PRECISION sla_DVDV,sla_DRANRM
|
||||
|
||||
|
||||
|
||||
* Unpack scalar and vector parameters
|
||||
GR2E = AMPRMS(8)
|
||||
AB1 = AMPRMS(12)
|
||||
DO I=1,3
|
||||
EHN(I) = AMPRMS(I+4)
|
||||
ABV(I) = AMPRMS(I+8)
|
||||
END DO
|
||||
|
||||
* Apparent RA,Dec to Cartesian
|
||||
CALL sla_DCS2C(RA,DA,P3)
|
||||
|
||||
* Precession and nutation
|
||||
CALL sla_DIMXV(AMPRMS(13),P3,P2)
|
||||
|
||||
* Aberration
|
||||
AB1P1 = AB1+1D0
|
||||
DO I=1,3
|
||||
P1(I) = P2(I)
|
||||
END DO
|
||||
DO J=1,2
|
||||
P1DV = sla_DVDV(P1,ABV)
|
||||
P1DVP1 = 1D0+P1DV
|
||||
W = 1D0+P1DV/AB1P1
|
||||
DO I=1,3
|
||||
P1(I) = (P1DVP1*P2(I)-W*ABV(I))/AB1
|
||||
END DO
|
||||
CALL sla_DVN(P1,P3,W)
|
||||
DO I=1,3
|
||||
P1(I) = P3(I)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
* Light deflection
|
||||
DO I=1,3
|
||||
P(I) = P1(I)
|
||||
END DO
|
||||
DO J=1,5
|
||||
PDE = sla_DVDV(P,EHN)
|
||||
PDEP1 = 1D0+PDE
|
||||
W = PDEP1-GR2E*PDE
|
||||
DO I=1,3
|
||||
P(I) = (PDEP1*P1(I)-GR2E*EHN(I))/W
|
||||
END DO
|
||||
CALL sla_DVN(P,P2,W)
|
||||
DO I=1,3
|
||||
P(I) = P2(I)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
* Mean RA,Dec
|
||||
CALL sla_DCC2S(P,RM,DM)
|
||||
RM = sla_DRANRM(RM)
|
||||
|
||||
END
|
||||
191
slalib/aop.f
Normal file
191
slalib/aop.f
Normal file
@ -0,0 +1,191 @@
|
||||
SUBROUTINE sla_AOP ( RAP, DAP, DATE, DUT, ELONGM, PHIM, HM,
|
||||
: XP, YP, TDK, PMB, RH, WL, TLR,
|
||||
: AOB, ZOB, HOB, DOB, ROB )
|
||||
*+
|
||||
* - - - -
|
||||
* A O P
|
||||
* - - - -
|
||||
*
|
||||
* Apparent to observed place, for sources distant from the solar
|
||||
* system.
|
||||
*
|
||||
* Given:
|
||||
* RAP d geocentric apparent right ascension
|
||||
* DAP d geocentric apparent declination
|
||||
* DATE d UTC date/time (Modified Julian Date, JD-2400000.5)
|
||||
* DUT d delta UT: UT1-UTC (UTC seconds)
|
||||
* ELONGM d mean longitude of the observer (radians, east +ve)
|
||||
* PHIM d mean geodetic latitude of the observer (radians)
|
||||
* HM d observer's height above sea level (metres)
|
||||
* XP d polar motion x-coordinate (radians)
|
||||
* YP d polar motion y-coordinate (radians)
|
||||
* TDK d local ambient temperature (K; std=273.15D0)
|
||||
* PMB d local atmospheric pressure (mb; std=1013.25D0)
|
||||
* RH d local relative humidity (in the range 0D0-1D0)
|
||||
* WL d effective wavelength (micron, e.g. 0.55D0)
|
||||
* TLR d tropospheric lapse rate (K/metre, e.g. 0.0065D0)
|
||||
*
|
||||
* Returned:
|
||||
* AOB d observed azimuth (radians: N=0,E=90)
|
||||
* ZOB d observed zenith distance (radians)
|
||||
* HOB d observed Hour Angle (radians)
|
||||
* DOB d observed Declination (radians)
|
||||
* ROB d observed Right Ascension (radians)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) This routine returns zenith distance rather than elevation
|
||||
* in order to reflect the fact that no allowance is made for
|
||||
* depression of the horizon.
|
||||
*
|
||||
* 2) The accuracy of the result is limited by the corrections for
|
||||
* refraction. Providing the meteorological parameters are
|
||||
* known accurately and there are no gross local effects, the
|
||||
* predicted apparent RA,Dec should be within about 0.1 arcsec
|
||||
* for a zenith distance of less than 70 degrees. Even at a
|
||||
* topocentric zenith distance of 90 degrees, the accuracy in
|
||||
* elevation should be better than 1 arcmin; useful results
|
||||
* are available for a further 3 degrees, beyond which the
|
||||
* sla_REFRO routine returns a fixed value of the refraction.
|
||||
* The complementary routines sla_AOP (or sla_AOPQK) and sla_OAP
|
||||
* (or sla_OAPQK) are self-consistent to better than 1 micro-
|
||||
* arcsecond all over the celestial sphere.
|
||||
*
|
||||
* 3) It is advisable to take great care with units, as even
|
||||
* unlikely values of the input parameters are accepted and
|
||||
* processed in accordance with the models used.
|
||||
*
|
||||
* 4) "Apparent" place means the geocentric apparent right ascension
|
||||
* and declination, which is obtained from a catalogue mean place
|
||||
* by allowing for space motion, parallax, precession, nutation,
|
||||
* annual aberration, and the Sun's gravitational lens effect. For
|
||||
* star positions in the FK5 system (i.e. J2000), these effects can
|
||||
* be applied by means of the sla_MAP etc routines. Starting from
|
||||
* other mean place systems, additional transformations will be
|
||||
* needed; for example, FK4 (i.e. B1950) mean places would first
|
||||
* have to be converted to FK5, which can be done with the
|
||||
* sla_FK425 etc routines.
|
||||
*
|
||||
* 5) "Observed" Az,El means the position that would be seen by a
|
||||
* perfect theodolite located at the observer. This is obtained
|
||||
* from the geocentric apparent RA,Dec by allowing for Earth
|
||||
* orientation and diurnal aberration, rotating from equator
|
||||
* to horizon coordinates, and then adjusting for refraction.
|
||||
* The HA,Dec is obtained by rotating back into equatorial
|
||||
* coordinates, using the geodetic latitude corrected for polar
|
||||
* motion, and is the position that would be seen by a perfect
|
||||
* equatorial located at the observer and with its polar axis
|
||||
* aligned to the Earth's axis of rotation (n.b. not to the
|
||||
* refracted pole). Finally, the RA is obtained by subtracting
|
||||
* the HA from the local apparent ST.
|
||||
*
|
||||
* 6) To predict the required setting of a real telescope, the
|
||||
* observed place produced by this routine would have to be
|
||||
* adjusted for the tilt of the azimuth or polar axis of the
|
||||
* mounting (with appropriate corrections for mount flexures),
|
||||
* for non-perpendicularity between the mounting axes, for the
|
||||
* position of the rotator axis and the pointing axis relative
|
||||
* to it, for tube flexure, for gear and encoder errors, and
|
||||
* finally for encoder zero points. Some telescopes would, of
|
||||
* course, exhibit other properties which would need to be
|
||||
* accounted for at the appropriate point in the sequence.
|
||||
*
|
||||
* 7) This routine takes time to execute, due mainly to the
|
||||
* rigorous integration used to evaluate the refraction.
|
||||
* For processing multiple stars for one location and time,
|
||||
* call sla_AOPPA once followed by one call per star to sla_AOPQK.
|
||||
* Where a range of times within a limited period of a few hours
|
||||
* is involved, and the highest precision is not required, call
|
||||
* sla_AOPPA once, followed by a call to sla_AOPPAT each time the
|
||||
* time changes, followed by one call per star to sla_AOPQK.
|
||||
*
|
||||
* 8) The DATE argument is UTC expressed as an MJD. This is,
|
||||
* strictly speaking, wrong, because of leap seconds. However,
|
||||
* as long as the delta UT and the UTC are consistent there
|
||||
* are no difficulties, except during a leap second. In this
|
||||
* case, the start of the 61st second of the final minute should
|
||||
* begin a new MJD day and the old pre-leap delta UT should
|
||||
* continue to be used. As the 61st second completes, the MJD
|
||||
* should revert to the start of the day as, simultaneously,
|
||||
* the delta UTC changes by one second to its post-leap new value.
|
||||
*
|
||||
* 9) The delta UT (UT1-UTC) is tabulated in IERS circulars and
|
||||
* elsewhere. It increases by exactly one second at the end of
|
||||
* each UTC leap second, introduced in order to keep delta UT
|
||||
* within +/- 0.9 seconds.
|
||||
*
|
||||
* 10) IMPORTANT -- TAKE CARE WITH THE LONGITUDE SIGN CONVENTION.
|
||||
* The longitude required by the present routine is east-positive,
|
||||
* in accordance with geographical convention (and right-handed).
|
||||
* In particular, note that the longitudes returned by the
|
||||
* sla_OBS routine are west-positive, following astronomical
|
||||
* usage, and must be reversed in sign before use in the present
|
||||
* routine.
|
||||
*
|
||||
* 11) The polar coordinates XP,YP can be obtained from IERS
|
||||
* circulars and equivalent publications. The maximum amplitude
|
||||
* is about 0.3 arcseconds. If XP,YP values are unavailable,
|
||||
* use XP=YP=0D0. See page B60 of the 1988 Astronomical Almanac
|
||||
* for a definition of the two angles.
|
||||
*
|
||||
* 12) The height above sea level of the observing station, HM,
|
||||
* can be obtained from the Astronomical Almanac (Section J
|
||||
* in the 1988 edition), or via the routine sla_OBS. If P,
|
||||
* the pressure in millibars, is available, an adequate
|
||||
* estimate of HM can be obtained from the expression
|
||||
*
|
||||
* HM ~ -29.3D0*TSL*LOG(P/1013.25D0).
|
||||
*
|
||||
* where TSL is the approximate sea-level air temperature in K
|
||||
* (see Astrophysical Quantities, C.W.Allen, 3rd edition,
|
||||
* section 52). Similarly, if the pressure P is not known,
|
||||
* it can be estimated from the height of the observing
|
||||
* station, HM, as follows:
|
||||
*
|
||||
* P ~ 1013.25D0*EXP(-HM/(29.3D0*TSL)).
|
||||
*
|
||||
* Note, however, that the refraction is nearly proportional to the
|
||||
* pressure and that an accurate P value is important for precise
|
||||
* work.
|
||||
*
|
||||
* 13) The azimuths etc produced by the present routine are with
|
||||
* respect to the celestial pole. Corrections to the terrestrial
|
||||
* pole can be computed using sla_POLMO.
|
||||
*
|
||||
* Called: sla_AOPPA, sla_AOPQK
|
||||
*
|
||||
* Last revision: 2 December 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RAP,DAP,DATE,DUT,ELONGM,PHIM,HM,
|
||||
: XP,YP,TDK,PMB,RH,WL,TLR,AOB,ZOB,HOB,DOB,ROB
|
||||
|
||||
DOUBLE PRECISION AOPRMS(14)
|
||||
|
||||
|
||||
CALL sla_AOPPA(DATE,DUT,ELONGM,PHIM,HM,XP,YP,TDK,PMB,RH,WL,TLR,
|
||||
: AOPRMS)
|
||||
CALL sla_AOPQK(RAP,DAP,AOPRMS,AOB,ZOB,HOB,DOB,ROB)
|
||||
|
||||
END
|
||||
193
slalib/aoppa.f
Normal file
193
slalib/aoppa.f
Normal file
@ -0,0 +1,193 @@
|
||||
SUBROUTINE sla_AOPPA ( DATE, DUT, ELONGM, PHIM, HM,
|
||||
: XP, YP, TDK, PMB, RH, WL, TLR, AOPRMS )
|
||||
*+
|
||||
* - - - - - -
|
||||
* A O P P A
|
||||
* - - - - - -
|
||||
*
|
||||
* Precompute apparent to observed place parameters required by
|
||||
* sla_AOPQK and sla_OAPQK.
|
||||
*
|
||||
* Given:
|
||||
* DATE d UTC date/time (modified Julian Date, JD-2400000.5)
|
||||
* DUT d delta UT: UT1-UTC (UTC seconds)
|
||||
* ELONGM d mean longitude of the observer (radians, east +ve)
|
||||
* PHIM d mean geodetic latitude of the observer (radians)
|
||||
* HM d observer's height above sea level (metres)
|
||||
* XP d polar motion x-coordinate (radians)
|
||||
* YP d polar motion y-coordinate (radians)
|
||||
* TDK d local ambient temperature (K; std=273.15D0)
|
||||
* PMB d local atmospheric pressure (mb; std=1013.25D0)
|
||||
* RH d local relative humidity (in the range 0D0-1D0)
|
||||
* WL d effective wavelength (micron, e.g. 0.55D0)
|
||||
* TLR d tropospheric lapse rate (K/metre, e.g. 0.0065D0)
|
||||
*
|
||||
* Returned:
|
||||
* AOPRMS d(14) star-independent apparent-to-observed parameters:
|
||||
*
|
||||
* (1) geodetic latitude (radians)
|
||||
* (2,3) sine and cosine of geodetic latitude
|
||||
* (4) magnitude of diurnal aberration vector
|
||||
* (5) height (HM)
|
||||
* (6) ambient temperature (TDK)
|
||||
* (7) pressure (PMB)
|
||||
* (8) relative humidity (RH)
|
||||
* (9) wavelength (WL)
|
||||
* (10) lapse rate (TLR)
|
||||
* (11,12) refraction constants A and B (radians)
|
||||
* (13) longitude + eqn of equinoxes + sidereal DUT (radians)
|
||||
* (14) local apparent sidereal time (radians)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) It is advisable to take great care with units, as even
|
||||
* unlikely values of the input parameters are accepted and
|
||||
* processed in accordance with the models used.
|
||||
*
|
||||
* 2) The DATE argument is UTC expressed as an MJD. This is,
|
||||
* strictly speaking, improper, because of leap seconds. However,
|
||||
* as long as the delta UT and the UTC are consistent there
|
||||
* are no difficulties, except during a leap second. In this
|
||||
* case, the start of the 61st second of the final minute should
|
||||
* begin a new MJD day and the old pre-leap delta UT should
|
||||
* continue to be used. As the 61st second completes, the MJD
|
||||
* should revert to the start of the day as, simultaneously,
|
||||
* the delta UTC changes by one second to its post-leap new value.
|
||||
*
|
||||
* 3) The delta UT (UT1-UTC) is tabulated in IERS circulars and
|
||||
* elsewhere. It increases by exactly one second at the end of
|
||||
* each UTC leap second, introduced in order to keep delta UT
|
||||
* within +/- 0.9 seconds.
|
||||
*
|
||||
* 4) IMPORTANT -- TAKE CARE WITH THE LONGITUDE SIGN CONVENTION.
|
||||
* The longitude required by the present routine is east-positive,
|
||||
* in accordance with geographical convention (and right-handed).
|
||||
* In particular, note that the longitudes returned by the
|
||||
* sla_OBS routine are west-positive, following astronomical
|
||||
* usage, and must be reversed in sign before use in the present
|
||||
* routine.
|
||||
*
|
||||
* 5) The polar coordinates XP,YP can be obtained from IERS
|
||||
* circulars and equivalent publications. The maximum amplitude
|
||||
* is about 0.3 arcseconds. If XP,YP values are unavailable,
|
||||
* use XP=YP=0D0. See page B60 of the 1988 Astronomical Almanac
|
||||
* for a definition of the two angles.
|
||||
*
|
||||
* 6) The height above sea level of the observing station, HM,
|
||||
* can be obtained from the Astronomical Almanac (Section J
|
||||
* in the 1988 edition), or via the routine sla_OBS. If P,
|
||||
* the pressure in millibars, is available, an adequate
|
||||
* estimate of HM can be obtained from the expression
|
||||
*
|
||||
* HM ~ -29.3D0*TSL*LOG(P/1013.25D0).
|
||||
*
|
||||
* where TSL is the approximate sea-level air temperature in K
|
||||
* (see Astrophysical Quantities, C.W.Allen, 3rd edition,
|
||||
* section 52). Similarly, if the pressure P is not known,
|
||||
* it can be estimated from the height of the observing
|
||||
* station, HM, as follows:
|
||||
*
|
||||
* P ~ 1013.25D0*EXP(-HM/(29.3D0*TSL)).
|
||||
*
|
||||
* Note, however, that the refraction is nearly proportional to the
|
||||
* pressure and that an accurate P value is important for precise
|
||||
* work.
|
||||
*
|
||||
* 7) Repeated, computationally-expensive, calls to sla_AOPPA for
|
||||
* times that are very close together can be avoided by calling
|
||||
* sla_AOPPA just once and then using sla_AOPPAT for the subsequent
|
||||
* times. Fresh calls to sla_AOPPA will be needed only when
|
||||
* changes in the precession have grown to unacceptable levels or
|
||||
* when anything affecting the refraction has changed.
|
||||
*
|
||||
* Called: sla_GEOC, sla_REFCO, sla_EQEQX, sla_AOPPAT
|
||||
*
|
||||
* Last revision: 2 December 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE,DUT,ELONGM,PHIM,HM,XP,YP,TDK,PMB,
|
||||
: RH,WL,TLR,AOPRMS(14)
|
||||
|
||||
DOUBLE PRECISION sla_EQEQX
|
||||
|
||||
* 2Pi
|
||||
DOUBLE PRECISION D2PI
|
||||
PARAMETER (D2PI=6.283185307179586476925287D0)
|
||||
|
||||
* Seconds of time to radians
|
||||
DOUBLE PRECISION S2R
|
||||
PARAMETER (S2R=7.272205216643039903848712D-5)
|
||||
|
||||
* Speed of light (AU per day)
|
||||
DOUBLE PRECISION C
|
||||
PARAMETER (C=173.14463331D0)
|
||||
|
||||
* Ratio between solar and sidereal time
|
||||
DOUBLE PRECISION SOLSID
|
||||
PARAMETER (SOLSID=1.00273790935D0)
|
||||
|
||||
DOUBLE PRECISION CPHIM,XT,YT,ZT,XC,YC,ZC,ELONG,PHI,UAU,VAU
|
||||
|
||||
|
||||
|
||||
* Observer's location corrected for polar motion
|
||||
CPHIM = COS(PHIM)
|
||||
XT = COS(ELONGM)*CPHIM
|
||||
YT = SIN(ELONGM)*CPHIM
|
||||
ZT = SIN(PHIM)
|
||||
XC = XT-XP*ZT
|
||||
YC = YT+YP*ZT
|
||||
ZC = XP*XT-YP*YT+ZT
|
||||
IF (XC.EQ.0D0.AND.YC.EQ.0D0) THEN
|
||||
ELONG = 0D0
|
||||
ELSE
|
||||
ELONG = ATAN2(YC,XC)
|
||||
END IF
|
||||
PHI = ATAN2(ZC,SQRT(XC*XC+YC*YC))
|
||||
AOPRMS(1) = PHI
|
||||
AOPRMS(2) = SIN(PHI)
|
||||
AOPRMS(3) = COS(PHI)
|
||||
|
||||
* Magnitude of the diurnal aberration vector
|
||||
CALL sla_GEOC(PHI,HM,UAU,VAU)
|
||||
AOPRMS(4) = D2PI*UAU*SOLSID/C
|
||||
|
||||
* Copy the refraction parameters and compute the A & B constants
|
||||
AOPRMS(5) = HM
|
||||
AOPRMS(6) = TDK
|
||||
AOPRMS(7) = PMB
|
||||
AOPRMS(8) = RH
|
||||
AOPRMS(9) = WL
|
||||
AOPRMS(10) = TLR
|
||||
CALL sla_REFCO(HM,TDK,PMB,RH,WL,PHI,TLR,1D-10,
|
||||
: AOPRMS(11),AOPRMS(12))
|
||||
|
||||
* Longitude + equation of the equinoxes + sidereal equivalent of DUT
|
||||
* (ignoring change in equation of the equinoxes between UTC and TDB)
|
||||
AOPRMS(13) = ELONG+sla_EQEQX(DATE)+DUT*SOLSID*S2R
|
||||
|
||||
* Sidereal time
|
||||
CALL sla_AOPPAT(DATE,AOPRMS)
|
||||
|
||||
END
|
||||
62
slalib/aoppat.f
Normal file
62
slalib/aoppat.f
Normal file
@ -0,0 +1,62 @@
|
||||
SUBROUTINE sla_AOPPAT (DATE, AOPRMS)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* A O P P A T
|
||||
* - - - - - - -
|
||||
*
|
||||
* Recompute the sidereal time in the apparent to observed place
|
||||
* star-independent parameter block.
|
||||
*
|
||||
* Given:
|
||||
* DATE d UTC date/time (modified Julian Date, JD-2400000.5)
|
||||
* (see AOPPA source for comments on leap seconds)
|
||||
*
|
||||
* AOPRMS d(14) star-independent apparent-to-observed parameters
|
||||
*
|
||||
* (1-12) not required
|
||||
* (13) longitude + eqn of equinoxes + sidereal DUT
|
||||
* (14) not required
|
||||
*
|
||||
* Returned:
|
||||
* AOPRMS d(14) star-independent apparent-to-observed parameters:
|
||||
*
|
||||
* (1-13) not changed
|
||||
* (14) local apparent sidereal time (radians)
|
||||
*
|
||||
* For more information, see sla_AOPPA.
|
||||
*
|
||||
* Called: sla_GMST
|
||||
*
|
||||
* P.T.Wallace Starlink 1 July 1993
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE,AOPRMS(14)
|
||||
|
||||
DOUBLE PRECISION sla_GMST
|
||||
|
||||
|
||||
|
||||
AOPRMS(14) = sla_GMST(DATE)+AOPRMS(13)
|
||||
|
||||
END
|
||||
259
slalib/aopqk.f
Normal file
259
slalib/aopqk.f
Normal file
@ -0,0 +1,259 @@
|
||||
SUBROUTINE sla_AOPQK (RAP, DAP, AOPRMS, AOB, ZOB, HOB, DOB, ROB)
|
||||
*+
|
||||
* - - - - - -
|
||||
* A O P Q K
|
||||
* - - - - - -
|
||||
*
|
||||
* Quick apparent to observed place (but see note 8, below, for
|
||||
* remarks about speed).
|
||||
*
|
||||
* Given:
|
||||
* RAP d geocentric apparent right ascension
|
||||
* DAP d geocentric apparent declination
|
||||
* AOPRMS d(14) star-independent apparent-to-observed parameters:
|
||||
*
|
||||
* (1) geodetic latitude (radians)
|
||||
* (2,3) sine and cosine of geodetic latitude
|
||||
* (4) magnitude of diurnal aberration vector
|
||||
* (5) height (HM)
|
||||
* (6) ambient temperature (T)
|
||||
* (7) pressure (P)
|
||||
* (8) relative humidity (RH)
|
||||
* (9) wavelength (WL)
|
||||
* (10) lapse rate (TLR)
|
||||
* (11,12) refraction constants A and B (radians)
|
||||
* (13) longitude + eqn of equinoxes + sidereal DUT (radians)
|
||||
* (14) local apparent sidereal time (radians)
|
||||
*
|
||||
* Returned:
|
||||
* AOB d observed azimuth (radians: N=0,E=90)
|
||||
* ZOB d observed zenith distance (radians)
|
||||
* HOB d observed Hour Angle (radians)
|
||||
* DOB d observed Declination (radians)
|
||||
* ROB d observed Right Ascension (radians)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) This routine returns zenith distance rather than elevation
|
||||
* in order to reflect the fact that no allowance is made for
|
||||
* depression of the horizon.
|
||||
*
|
||||
* 2) The accuracy of the result is limited by the corrections for
|
||||
* refraction. Providing the meteorological parameters are
|
||||
* known accurately and there are no gross local effects, the
|
||||
* observed RA,Dec predicted by this routine should be within
|
||||
* about 0.1 arcsec for a zenith distance of less than 70 degrees.
|
||||
* Even at a topocentric zenith distance of 90 degrees, the
|
||||
* accuracy in elevation should be better than 1 arcmin; useful
|
||||
* results are available for a further 3 degrees, beyond which
|
||||
* the sla_REFRO routine returns a fixed value of the refraction.
|
||||
* The complementary routines sla_AOP (or sla_AOPQK) and sla_OaAP
|
||||
* (or sla_OAPQK) are self-consistent to better than 1 micro-
|
||||
* arcsecond all over the celestial sphere.
|
||||
*
|
||||
* 3) It is advisable to take great care with units, as even
|
||||
* unlikely values of the input parameters are accepted and
|
||||
* processed in accordance with the models used.
|
||||
*
|
||||
* 4) "Apparent" place means the geocentric apparent right ascension
|
||||
* and declination, which is obtained from a catalogue mean place
|
||||
* by allowing for space motion, parallax, precession, nutation,
|
||||
* annual aberration, and the Sun's gravitational lens effect. For
|
||||
* star positions in the FK5 system (i.e. J2000), these effects can
|
||||
* be applied by means of the sla_MAP etc routines. Starting from
|
||||
* other mean place systems, additional transformations will be
|
||||
* needed; for example, FK4 (i.e. B1950) mean places would first
|
||||
* have to be converted to FK5, which can be done with the
|
||||
* sla_FK425 etc routines.
|
||||
*
|
||||
* 5) "Observed" Az,El means the position that would be seen by a
|
||||
* perfect theodolite located at the observer. This is obtained
|
||||
* from the geocentric apparent RA,Dec by allowing for Earth
|
||||
* orientation and diurnal aberration, rotating from equator
|
||||
* to horizon coordinates, and then adjusting for refraction.
|
||||
* The HA,Dec is obtained by rotating back into equatorial
|
||||
* coordinates, using the geodetic latitude corrected for polar
|
||||
* motion, and is the position that would be seen by a perfect
|
||||
* equatorial located at the observer and with its polar axis
|
||||
* aligned to the Earth's axis of rotation (n.b. not to the
|
||||
* refracted pole). Finally, the RA is obtained by subtracting
|
||||
* the HA from the local apparent ST.
|
||||
*
|
||||
* 6) To predict the required setting of a real telescope, the
|
||||
* observed place produced by this routine would have to be
|
||||
* adjusted for the tilt of the azimuth or polar axis of the
|
||||
* mounting (with appropriate corrections for mount flexures),
|
||||
* for non-perpendicularity between the mounting axes, for the
|
||||
* position of the rotator axis and the pointing axis relative
|
||||
* to it, for tube flexure, for gear and encoder errors, and
|
||||
* finally for encoder zero points. Some telescopes would, of
|
||||
* course, exhibit other properties which would need to be
|
||||
* accounted for at the appropriate point in the sequence.
|
||||
*
|
||||
* 7) The star-independent apparent-to-observed-place parameters
|
||||
* in AOPRMS may be computed by means of the sla_AOPPA routine.
|
||||
* If nothing has changed significantly except the time, the
|
||||
* sla_AOPPAT routine may be used to perform the requisite
|
||||
* partial recomputation of AOPRMS.
|
||||
*
|
||||
* 8) At zenith distances beyond about 76 degrees, the need for
|
||||
* special care with the corrections for refraction causes a
|
||||
* marked increase in execution time. Moreover, the effect
|
||||
* gets worse with increasing zenith distance. Adroit
|
||||
* programming in the calling application may allow the
|
||||
* problem to be reduced. Prepare an alternative AOPRMS array,
|
||||
* computed for zero air-pressure; this will disable the
|
||||
* refraction corrections and cause rapid execution. Using
|
||||
* this AOPRMS array, a preliminary call to the present routine
|
||||
* will, depending on the application, produce a rough position
|
||||
* which may be enough to establish whether the full, slow
|
||||
* calculation (using the real AOPRMS array) is worthwhile.
|
||||
* For example, there would be no need for the full calculation
|
||||
* if the preliminary call had already established that the
|
||||
* source was well below the elevation limits for a particular
|
||||
* telescope.
|
||||
*
|
||||
* 9) The azimuths etc produced by the present routine are with
|
||||
* respect to the celestial pole. Corrections to the terrestrial
|
||||
* pole can be computed using sla_POLMO.
|
||||
*
|
||||
* Called: sla_DCS2C, sla_REFZ, sla_REFRO, sla_DCC2S, sla_DRANRM
|
||||
*
|
||||
* P.T.Wallace Starlink 24 October 2003
|
||||
*
|
||||
* Copyright (C) 2003 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RAP,DAP,AOPRMS(14),AOB,ZOB,HOB,DOB,ROB
|
||||
|
||||
* Breakpoint for fast/slow refraction algorithm:
|
||||
* ZD greater than arctan(4), (see sla_REFCO routine)
|
||||
* or vector Z less than cosine(arctan(Z)) = 1/sqrt(17)
|
||||
DOUBLE PRECISION ZBREAK
|
||||
PARAMETER (ZBREAK=0.242535625D0)
|
||||
|
||||
INTEGER I
|
||||
|
||||
DOUBLE PRECISION SPHI,CPHI,ST,V(3),XHD,YHD,ZHD,DIURAB,F,
|
||||
: XHDT,YHDT,ZHDT,XAET,YAET,ZAET,AZOBS,
|
||||
: ZDT,REFA,REFB,ZDOBS,DZD,DREF,CE,
|
||||
: XAEO,YAEO,ZAEO,HMOBS,DCOBS,RAOBS
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM
|
||||
|
||||
|
||||
|
||||
* Sin, cos of latitude
|
||||
SPHI = AOPRMS(2)
|
||||
CPHI = AOPRMS(3)
|
||||
|
||||
* Local apparent sidereal time
|
||||
ST = AOPRMS(14)
|
||||
|
||||
* Apparent RA,Dec to Cartesian -HA,Dec
|
||||
CALL sla_DCS2C(RAP-ST,DAP,V)
|
||||
XHD = V(1)
|
||||
YHD = V(2)
|
||||
ZHD = V(3)
|
||||
|
||||
* Diurnal aberration
|
||||
DIURAB = AOPRMS(4)
|
||||
F = (1D0-DIURAB*YHD)
|
||||
XHDT = F*XHD
|
||||
YHDT = F*(YHD+DIURAB)
|
||||
ZHDT = F*ZHD
|
||||
|
||||
* Cartesian -HA,Dec to Cartesian Az,El (S=0,E=90)
|
||||
XAET = SPHI*XHDT-CPHI*ZHDT
|
||||
YAET = YHDT
|
||||
ZAET = CPHI*XHDT+SPHI*ZHDT
|
||||
|
||||
* Azimuth (N=0,E=90)
|
||||
IF (XAET.EQ.0D0.AND.YAET.EQ.0D0) THEN
|
||||
AZOBS = 0D0
|
||||
ELSE
|
||||
AZOBS = ATAN2(YAET,-XAET)
|
||||
END IF
|
||||
|
||||
* Topocentric zenith distance
|
||||
ZDT = ATAN2(SQRT(XAET*XAET+YAET*YAET),ZAET)
|
||||
|
||||
*
|
||||
* Refraction
|
||||
* ----------
|
||||
|
||||
* Fast algorithm using two constant model
|
||||
REFA = AOPRMS(11)
|
||||
REFB = AOPRMS(12)
|
||||
CALL sla_REFZ(ZDT,REFA,REFB,ZDOBS)
|
||||
|
||||
* Large zenith distance?
|
||||
IF (COS(ZDOBS).LT.ZBREAK) THEN
|
||||
|
||||
* Yes: use rigorous algorithm
|
||||
|
||||
* Initialize loop (maximum of 10 iterations)
|
||||
I = 1
|
||||
DZD = 1D1
|
||||
DO WHILE (ABS(DZD).GT.1D-10.AND.I.LE.10)
|
||||
|
||||
* Compute refraction using current estimate of observed ZD
|
||||
CALL sla_REFRO(ZDOBS,AOPRMS(5),AOPRMS(6),AOPRMS(7),
|
||||
: AOPRMS(8),AOPRMS(9),AOPRMS(1),
|
||||
: AOPRMS(10),1D-8,DREF)
|
||||
|
||||
* Remaining discrepancy
|
||||
DZD = ZDOBS+DREF-ZDT
|
||||
|
||||
* Update the estimate
|
||||
ZDOBS = ZDOBS-DZD
|
||||
|
||||
* Increment the iteration counter
|
||||
I = I+1
|
||||
END DO
|
||||
END IF
|
||||
|
||||
* To Cartesian Az/ZD
|
||||
CE = SIN(ZDOBS)
|
||||
XAEO = -COS(AZOBS)*CE
|
||||
YAEO = SIN(AZOBS)*CE
|
||||
ZAEO = COS(ZDOBS)
|
||||
|
||||
* Cartesian Az/ZD to Cartesian -HA,Dec
|
||||
V(1) = SPHI*XAEO+CPHI*ZAEO
|
||||
V(2) = YAEO
|
||||
V(3) = -CPHI*XAEO+SPHI*ZAEO
|
||||
|
||||
* To spherical -HA,Dec
|
||||
CALL sla_DCC2S(V,HMOBS,DCOBS)
|
||||
|
||||
* Right Ascension
|
||||
RAOBS = sla_DRANRM(ST+HMOBS)
|
||||
|
||||
* Return the results
|
||||
AOB = AZOBS
|
||||
ZOB = ZDOBS
|
||||
HOB = -HMOBS
|
||||
DOB = DCOBS
|
||||
ROB = RAOBS
|
||||
|
||||
END
|
||||
140
slalib/atmdsp.f
Normal file
140
slalib/atmdsp.f
Normal file
@ -0,0 +1,140 @@
|
||||
SUBROUTINE sla_ATMDSP (TDK, PMB, RH, WL1, A1, B1, WL2, A2, B2)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* A T M D S P
|
||||
* - - - - - - -
|
||||
*
|
||||
* Apply atmospheric-dispersion adjustments to refraction coefficients.
|
||||
*
|
||||
* Given:
|
||||
* TDK d ambient temperature, K
|
||||
* PMB d ambient pressure, millibars
|
||||
* RH d ambient relative humidity, 0-1
|
||||
* WL1 d reference wavelength, micrometre (0.4D0 recommended)
|
||||
* A1 d refraction coefficient A for wavelength WL1 (radians)
|
||||
* B1 d refraction coefficient B for wavelength WL1 (radians)
|
||||
* WL2 d wavelength for which adjusted A,B required
|
||||
*
|
||||
* Returned:
|
||||
* A2 d refraction coefficient A for wavelength WL2 (radians)
|
||||
* B2 d refraction coefficient B for wavelength WL2 (radians)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 To use this routine, first call sla_REFCO specifying WL1 as the
|
||||
* wavelength. This yields refraction coefficients A1,B1, correct
|
||||
* for that wavelength. Subsequently, calls to sla_ATMDSP specifying
|
||||
* different wavelengths will produce new, slightly adjusted
|
||||
* refraction coefficients which apply to the specified wavelength.
|
||||
*
|
||||
* 2 Most of the atmospheric dispersion happens between 0.7 micrometre
|
||||
* and the UV atmospheric cutoff, and the effect increases strongly
|
||||
* towards the UV end. For this reason a blue reference wavelength
|
||||
* is recommended, for example 0.4 micrometres.
|
||||
*
|
||||
* 3 The accuracy, for this set of conditions:
|
||||
*
|
||||
* height above sea level 2000 m
|
||||
* latitude 29 deg
|
||||
* pressure 793 mb
|
||||
* temperature 17 degC
|
||||
* humidity 50%
|
||||
* lapse rate 0.0065 degC/m
|
||||
* reference wavelength 0.4 micrometre
|
||||
* star elevation 15 deg
|
||||
*
|
||||
* is about 2.5 mas RMS between 0.3 and 1.0 micrometres, and stays
|
||||
* within 4 mas for the whole range longward of 0.3 micrometres
|
||||
* (compared with a total dispersion from 0.3 to 20.0 micrometres
|
||||
* of about 11 arcsec). These errors are typical for ordinary
|
||||
* conditions and the given elevation; in extreme conditions values
|
||||
* a few times this size may occur, while at higher elevations the
|
||||
* errors become much smaller.
|
||||
*
|
||||
* 4 If either wavelength exceeds 100 micrometres, the radio case
|
||||
* is assumed and the returned refraction coefficients are the
|
||||
* same as the given ones. Note that radio refraction coefficients
|
||||
* cannot be turned into optical values using this routine, nor
|
||||
* vice versa.
|
||||
*
|
||||
* 5 The algorithm consists of calculation of the refractivity of the
|
||||
* air at the observer for the two wavelengths, using the methods
|
||||
* of the sla_REFRO routine, and then scaling of the two refraction
|
||||
* coefficients according to classical refraction theory. This
|
||||
* amounts to scaling the A coefficient in proportion to (n-1) and
|
||||
* the B coefficient almost in the same ratio (see R.M.Green,
|
||||
* "Spherical Astronomy", Cambridge University Press, 1985).
|
||||
*
|
||||
* Last revision 2 December 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION TDK,PMB,RH,WL1,A1,B1,WL2,A2,B2
|
||||
|
||||
DOUBLE PRECISION F,TDKOK,PMBOK,RHOK,
|
||||
: PSAT,PWO,W1,WLOK,WLSQ,W2,DN1,DN2
|
||||
|
||||
|
||||
* Check for radio wavelengths
|
||||
IF (WL1.GT.100D0.OR.WL2.GT.100D0) THEN
|
||||
|
||||
* Radio: no dispersion
|
||||
A2 = A1
|
||||
B2 = B1
|
||||
ELSE
|
||||
|
||||
* Optical: keep arguments within safe bounds
|
||||
TDKOK = MIN(MAX(TDK,100D0),500D0)
|
||||
PMBOK = MIN(MAX(PMB,0D0),10000D0)
|
||||
RHOK = MIN(MAX(RH,0D0),1D0)
|
||||
|
||||
* Atmosphere parameters at the observer
|
||||
PSAT = 10D0**(-8.7115D0+0.03477D0*TDKOK)
|
||||
PWO = RHOK*PSAT
|
||||
W1 = 11.2684D-6*PWO
|
||||
|
||||
* Refractivity at the observer for first wavelength
|
||||
WLOK = MAX(WL1,0.1D0)
|
||||
WLSQ = WLOK*WLOK
|
||||
W2 = 77.5317D-6+(0.43909D-6+0.00367D-6/WLSQ)/WLSQ
|
||||
DN1 = (W2*PMBOK-W1)/TDKOK
|
||||
|
||||
* Refractivity at the observer for second wavelength
|
||||
WLOK = MAX(WL2,0.1D0)
|
||||
WLSQ = WLOK*WLOK
|
||||
W2 = 77.5317D-6+(0.43909D-6+0.00367D-6/WLSQ)/WLSQ
|
||||
DN2 = (W2*PMBOK-W1)/TDKOK
|
||||
|
||||
* Scale the refraction coefficients (see Green 4.31, p93)
|
||||
IF (DN1.NE.0D0) THEN
|
||||
F = DN2/DN1
|
||||
A2 = A1*F
|
||||
B2 = B1*F
|
||||
IF (DN1.NE.A1) B2=B2*(1D0+DN1*(DN1-DN2)/(2D0*(DN1-A1)))
|
||||
ELSE
|
||||
A2 = A1
|
||||
B2 = B1
|
||||
END IF
|
||||
END IF
|
||||
|
||||
END
|
||||
57
slalib/atms.f
Normal file
57
slalib/atms.f
Normal file
@ -0,0 +1,57 @@
|
||||
SUBROUTINE sla__ATMS (RT, TT, DNT, GAMAL, R, DN, RDNDR)
|
||||
*+
|
||||
* - - - - -
|
||||
* A T M S
|
||||
* - - - - -
|
||||
*
|
||||
* Internal routine used by REFRO
|
||||
*
|
||||
* Refractive index and derivative with respect to height for the
|
||||
* stratosphere.
|
||||
*
|
||||
* Given:
|
||||
* RT d height of tropopause from centre of the Earth (metre)
|
||||
* TT d temperature at the tropopause (K)
|
||||
* DNT d refractive index at the tropopause
|
||||
* GAMAL d constant of the atmospheric model = G*MD/R
|
||||
* R d current distance from the centre of the Earth (metre)
|
||||
*
|
||||
* Returned:
|
||||
* DN d refractive index at R
|
||||
* RDNDR d R * rate the refractive index is changing at R
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RT,TT,DNT,GAMAL,R,DN,RDNDR
|
||||
|
||||
DOUBLE PRECISION B,W
|
||||
|
||||
|
||||
B = GAMAL/TT
|
||||
W = (DNT-1D0)*EXP(-B*(R-RT))
|
||||
DN = 1D0+W
|
||||
RDNDR = -R*B*W
|
||||
|
||||
END
|
||||
71
slalib/atmt.f
Normal file
71
slalib/atmt.f
Normal file
@ -0,0 +1,71 @@
|
||||
SUBROUTINE sla__ATMT (R0, T0, ALPHA, GAMM2, DELM2,
|
||||
: C1, C2, C3, C4, C5, C6, R, T, DN, RDNDR)
|
||||
*+
|
||||
* - - - - -
|
||||
* A T M T
|
||||
* - - - - -
|
||||
*
|
||||
* Internal routine used by REFRO
|
||||
*
|
||||
* Refractive index and derivative with respect to height for the
|
||||
* troposphere.
|
||||
*
|
||||
* Given:
|
||||
* R0 d height of observer from centre of the Earth (metre)
|
||||
* T0 d temperature at the observer (K)
|
||||
* ALPHA d alpha )
|
||||
* GAMM2 d gamma minus 2 ) see HMNAO paper
|
||||
* DELM2 d delta minus 2 )
|
||||
* C1 d useful term )
|
||||
* C2 d useful term )
|
||||
* C3 d useful term ) see source
|
||||
* C4 d useful term ) of sla_REFRO
|
||||
* C5 d useful term )
|
||||
* C6 d useful term )
|
||||
* R d current distance from the centre of the Earth (metre)
|
||||
*
|
||||
* Returned:
|
||||
* T d temperature at R (K)
|
||||
* DN d refractive index at R
|
||||
* RDNDR d R * rate the refractive index is changing at R
|
||||
*
|
||||
* Note that in the optical case C5 and C6 are zero.
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION R0,T0,ALPHA,GAMM2,DELM2,C1,C2,C3,C4,C5,C6,
|
||||
: R,T,DN,RDNDR
|
||||
|
||||
DOUBLE PRECISION TT0,TT0GM2,TT0DM2
|
||||
|
||||
|
||||
T = MAX(MIN(T0-ALPHA*(R-R0),320D0),100D0)
|
||||
TT0 = T/T0
|
||||
TT0GM2 = TT0**GAMM2
|
||||
TT0DM2 = TT0**DELM2
|
||||
DN = 1D0+(C1*TT0GM2-(C2-C5/T)*TT0DM2)*TT0
|
||||
RDNDR = R*(-C3*TT0GM2+(C4-C6/TT0)*TT0DM2)
|
||||
|
||||
END
|
||||
84
slalib/av2m.f
Normal file
84
slalib/av2m.f
Normal file
@ -0,0 +1,84 @@
|
||||
SUBROUTINE sla_AV2M (AXVEC, RMAT)
|
||||
*+
|
||||
* - - - - -
|
||||
* A V 2 M
|
||||
* - - - - -
|
||||
*
|
||||
* Form the rotation matrix corresponding to a given axial vector.
|
||||
*
|
||||
* (single precision)
|
||||
*
|
||||
* A rotation matrix describes a rotation about some arbitrary axis,
|
||||
* called the Euler axis. The "axial vector" supplied to this routine
|
||||
* has the same direction as the Euler axis, and its magnitude is the
|
||||
* amount of rotation in radians.
|
||||
*
|
||||
* Given:
|
||||
* AXVEC r(3) axial vector (radians)
|
||||
*
|
||||
* Returned:
|
||||
* RMAT r(3,3) rotation matrix
|
||||
*
|
||||
* If AXVEC is null, the unit matrix is returned.
|
||||
*
|
||||
* The reference frame rotates clockwise as seen looking along
|
||||
* the axial vector from the origin.
|
||||
*
|
||||
* Last revision: 26 November 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL AXVEC(3),RMAT(3,3)
|
||||
|
||||
REAL X,Y,Z,PHI,S,C,W
|
||||
|
||||
|
||||
|
||||
* Rotation angle - magnitude of axial vector - and functions
|
||||
X = AXVEC(1)
|
||||
Y = AXVEC(2)
|
||||
Z = AXVEC(3)
|
||||
PHI = SQRT(X*X+Y*Y+Z*Z)
|
||||
S = SIN(PHI)
|
||||
C = COS(PHI)
|
||||
W = 1.0-C
|
||||
|
||||
* Euler axis - direction of axial vector (perhaps null)
|
||||
IF (PHI.NE.0.0) THEN
|
||||
X = X/PHI
|
||||
Y = Y/PHI
|
||||
Z = Z/PHI
|
||||
END IF
|
||||
|
||||
* Compute the rotation matrix
|
||||
RMAT(1,1) = X*X*W+C
|
||||
RMAT(1,2) = X*Y*W+Z*S
|
||||
RMAT(1,3) = X*Z*W-Y*S
|
||||
RMAT(2,1) = X*Y*W-Z*S
|
||||
RMAT(2,2) = Y*Y*W+C
|
||||
RMAT(2,3) = Y*Z*W+X*S
|
||||
RMAT(3,1) = X*Z*W+Y*S
|
||||
RMAT(3,2) = Y*Z*W-X*S
|
||||
RMAT(3,3) = Z*Z*W+C
|
||||
|
||||
END
|
||||
59
slalib/bear.f
Normal file
59
slalib/bear.f
Normal file
@ -0,0 +1,59 @@
|
||||
REAL FUNCTION sla_BEAR (A1, B1, A2, B2)
|
||||
*+
|
||||
* - - - - -
|
||||
* B E A R
|
||||
* - - - - -
|
||||
*
|
||||
* Bearing (position angle) of one point on a sphere relative to another
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* A1,B1 r spherical coordinates of one point
|
||||
* A2,B2 r spherical coordinates of the other point
|
||||
*
|
||||
* (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.)
|
||||
*
|
||||
* The result is the bearing (position angle), in radians, of point
|
||||
* A2,B2 as seen from point A1,B1. It is in the range +/- pi. If
|
||||
* A2,B2 is due east of A1,B1 the bearing is +pi/2. Zero is returned
|
||||
* if the two points are coincident.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 March 1991
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL A1,B1,A2,B2
|
||||
|
||||
REAL DA,X,Y
|
||||
|
||||
|
||||
DA=A2-A1
|
||||
Y=SIN(DA)*COS(B2)
|
||||
X=SIN(B2)*COS(B1)-COS(B2)*SIN(B1)*COS(DA)
|
||||
IF (X.NE.0.0.OR.Y.NE.0.0) THEN
|
||||
sla_BEAR=ATAN2(Y,X)
|
||||
ELSE
|
||||
sla_BEAR=0.0
|
||||
END IF
|
||||
|
||||
END
|
||||
74
slalib/caf2r.f
Normal file
74
slalib/caf2r.f
Normal file
@ -0,0 +1,74 @@
|
||||
SUBROUTINE sla_CAF2R (IDEG, IAMIN, ASEC, RAD, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C A F 2 R
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert degrees, arcminutes, arcseconds to radians
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* IDEG int degrees
|
||||
* IAMIN int arcminutes
|
||||
* ASEC real arcseconds
|
||||
*
|
||||
* Returned:
|
||||
* RAD real angle in radians
|
||||
* J int status: 0 = OK
|
||||
* 1 = IDEG outside range 0-359
|
||||
* 2 = IAMIN outside range 0-59
|
||||
* 3 = ASEC outside range 0-59.999...
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is computed even if any of the range checks
|
||||
* fail.
|
||||
*
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IDEG,IAMIN
|
||||
REAL ASEC,RAD
|
||||
INTEGER J
|
||||
|
||||
* Arc seconds to radians
|
||||
REAL AS2R
|
||||
PARAMETER (AS2R=0.484813681109535994E-5)
|
||||
|
||||
|
||||
|
||||
* Preset status
|
||||
J=0
|
||||
|
||||
* Validate arcsec, arcmin, deg
|
||||
IF (ASEC.LT.0.0.OR.ASEC.GE.60.0) J=3
|
||||
IF (IAMIN.LT.0.OR.IAMIN.GT.59) J=2
|
||||
IF (IDEG.LT.0.OR.IDEG.GT.359) J=1
|
||||
|
||||
* Compute angle
|
||||
RAD=AS2R*(60.0*(60.0*REAL(IDEG)+REAL(IAMIN))+ASEC)
|
||||
|
||||
END
|
||||
74
slalib/caldj.f
Normal file
74
slalib/caldj.f
Normal file
@ -0,0 +1,74 @@
|
||||
SUBROUTINE sla_CALDJ (IY, IM, ID, DJM, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C A L D J
|
||||
* - - - - - -
|
||||
*
|
||||
* Gregorian Calendar to Modified Julian Date
|
||||
*
|
||||
* (Includes century default feature: use sla_CLDJ for years
|
||||
* before 100AD.)
|
||||
*
|
||||
* Given:
|
||||
* IY,IM,ID int year, month, day in Gregorian calendar
|
||||
*
|
||||
* Returned:
|
||||
* DJM dp modified Julian Date (JD-2400000.5) for 0 hrs
|
||||
* J int status:
|
||||
* 0 = OK
|
||||
* 1 = bad year (MJD not computed)
|
||||
* 2 = bad month (MJD not computed)
|
||||
* 3 = bad day (MJD computed)
|
||||
*
|
||||
* Acceptable years are 00-49, interpreted as 2000-2049,
|
||||
* 50-99, " " 1950-1999,
|
||||
* 100 upwards, interpreted literally.
|
||||
*
|
||||
* Called: sla_CLDJ
|
||||
*
|
||||
* P.T.Wallace Starlink November 1985
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IY,IM,ID
|
||||
DOUBLE PRECISION DJM
|
||||
INTEGER J
|
||||
|
||||
INTEGER NY
|
||||
|
||||
|
||||
|
||||
|
||||
* Default century if appropriate
|
||||
IF (IY.GE.0.AND.IY.LE.49) THEN
|
||||
NY=IY+2000
|
||||
ELSE IF (IY.GE.50.AND.IY.LE.99) THEN
|
||||
NY=IY+1900
|
||||
ELSE
|
||||
NY=IY
|
||||
END IF
|
||||
|
||||
* Modified Julian Date
|
||||
CALL sla_CLDJ(NY,IM,ID,DJM,J)
|
||||
|
||||
END
|
||||
82
slalib/calyd.f
Normal file
82
slalib/calyd.f
Normal file
@ -0,0 +1,82 @@
|
||||
SUBROUTINE sla_CALYD (IY, IM, ID, NY, ND, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C A L Y D
|
||||
* - - - - - -
|
||||
*
|
||||
* Gregorian calendar date to year and day in year (in a Julian
|
||||
* calendar aligned to the 20th/21st century Gregorian calendar).
|
||||
*
|
||||
* (Includes century default feature: use sla_CLYD for years
|
||||
* before 100AD.)
|
||||
*
|
||||
* Given:
|
||||
* IY,IM,ID int year, month, day in Gregorian calendar
|
||||
* (year may optionally omit the century)
|
||||
* Returned:
|
||||
* NY int year (re-aligned Julian calendar)
|
||||
* ND int day in year (1 = January 1st)
|
||||
* J int status:
|
||||
* 0 = OK
|
||||
* 1 = bad year (before -4711)
|
||||
* 2 = bad month
|
||||
* 3 = bad day (but conversion performed)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 This routine exists to support the low-precision routines
|
||||
* sla_EARTH, sla_MOON and sla_ECOR.
|
||||
*
|
||||
* 2 Between 1900 March 1 and 2100 February 28 it returns answers
|
||||
* which are consistent with the ordinary Gregorian calendar.
|
||||
* Outside this range there will be a discrepancy which increases
|
||||
* by one day for every non-leap century year.
|
||||
*
|
||||
* 3 Years in the range 50-99 are interpreted as 1950-1999, and
|
||||
* years in the range 00-49 are interpreted as 2000-2049.
|
||||
*
|
||||
* Called: sla_CLYD
|
||||
*
|
||||
* P.T.Wallace Starlink 23 November 1994
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IY,IM,ID,NY,ND,J
|
||||
|
||||
INTEGER I
|
||||
|
||||
|
||||
|
||||
* Default century if appropriate
|
||||
IF (IY.GE.0.AND.IY.LE.49) THEN
|
||||
I=IY+2000
|
||||
ELSE IF (IY.GE.50.AND.IY.LE.99) THEN
|
||||
I=IY+1900
|
||||
ELSE
|
||||
I=IY
|
||||
END IF
|
||||
|
||||
* Perform the conversion
|
||||
CALL sla_CLYD(I,IM,ID,NY,ND,J)
|
||||
|
||||
END
|
||||
69
slalib/cc2s.f
Normal file
69
slalib/cc2s.f
Normal file
@ -0,0 +1,69 @@
|
||||
SUBROUTINE sla_CC2S (V, A, B)
|
||||
*+
|
||||
* - - - - -
|
||||
* C C 2 S
|
||||
* - - - - -
|
||||
*
|
||||
* Cartesian to spherical coordinates (single precision)
|
||||
*
|
||||
* Given:
|
||||
* V r(3) x,y,z vector
|
||||
*
|
||||
* Returned:
|
||||
* A,B r spherical coordinates in radians
|
||||
*
|
||||
* The spherical coordinates are longitude (+ve anticlockwise looking
|
||||
* from the +ve latitude pole) and latitude. The Cartesian coordinates
|
||||
* are right handed, with the x axis at zero longitude and latitude, and
|
||||
* the z axis at the +ve latitude pole.
|
||||
*
|
||||
* If V is null, zero A and B are returned. At either pole, zero A is
|
||||
* returned.
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL V(3),A,B
|
||||
|
||||
REAL X,Y,Z,R
|
||||
|
||||
|
||||
X = V(1)
|
||||
Y = V(2)
|
||||
Z = V(3)
|
||||
R = SQRT(X*X+Y*Y)
|
||||
|
||||
IF (R.EQ.0.0) THEN
|
||||
A = 0.0
|
||||
ELSE
|
||||
A = ATAN2(Y,X)
|
||||
END IF
|
||||
|
||||
IF (Z.EQ.0.0) THEN
|
||||
B = 0.0
|
||||
ELSE
|
||||
B = ATAN2(Z,R)
|
||||
END IF
|
||||
|
||||
END
|
||||
99
slalib/cc62s.f
Normal file
99
slalib/cc62s.f
Normal file
@ -0,0 +1,99 @@
|
||||
SUBROUTINE sla_CC62S (V, A, B, R, AD, BD, RD)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C C 6 2 S
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of position & velocity in Cartesian coordinates
|
||||
* to spherical coordinates (single precision)
|
||||
*
|
||||
* Given:
|
||||
* V r(6) Cartesian position & velocity vector
|
||||
*
|
||||
* Returned:
|
||||
* A r longitude (radians)
|
||||
* B r latitude (radians)
|
||||
* R r radial coordinate
|
||||
* AD r longitude derivative (radians per unit time)
|
||||
* BD r latitude derivative (radians per unit time)
|
||||
* RD r radial derivative
|
||||
*
|
||||
* P.T.Wallace Starlink 28 April 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL V(6),A,B,R,AD,BD,RD
|
||||
|
||||
REAL X,Y,Z,XD,YD,ZD,RXY2,RXY,R2,XYP
|
||||
|
||||
|
||||
|
||||
* Components of position/velocity vector
|
||||
X=V(1)
|
||||
Y=V(2)
|
||||
Z=V(3)
|
||||
XD=V(4)
|
||||
YD=V(5)
|
||||
ZD=V(6)
|
||||
|
||||
* Component of R in XY plane squared
|
||||
RXY2=X*X+Y*Y
|
||||
|
||||
* Modulus squared
|
||||
R2=RXY2+Z*Z
|
||||
|
||||
* Protection against null vector
|
||||
IF (R2.EQ.0.0) THEN
|
||||
X=XD
|
||||
Y=YD
|
||||
Z=ZD
|
||||
RXY2=X*X+Y*Y
|
||||
R2=RXY2+Z*Z
|
||||
END IF
|
||||
|
||||
* Position and velocity in spherical coordinates
|
||||
RXY=SQRT(RXY2)
|
||||
XYP=X*XD+Y*YD
|
||||
IF (RXY2.NE.0.0) THEN
|
||||
A=ATAN2(Y,X)
|
||||
B=ATAN2(Z,RXY)
|
||||
AD=(X*YD-Y*XD)/RXY2
|
||||
BD=(ZD*RXY2-Z*XYP)/(R2*RXY)
|
||||
ELSE
|
||||
A=0.0
|
||||
IF (Z.NE.0.0) THEN
|
||||
B=ATAN2(Z,RXY)
|
||||
ELSE
|
||||
B=0.0
|
||||
END IF
|
||||
AD=0.0
|
||||
BD=0.0
|
||||
END IF
|
||||
R=SQRT(R2)
|
||||
IF (R.NE.0.0) THEN
|
||||
RD=(XYP+Z*ZD)/R
|
||||
ELSE
|
||||
RD=0.0
|
||||
END IF
|
||||
|
||||
END
|
||||
72
slalib/cd2tf.f
Normal file
72
slalib/cd2tf.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_CD2TF (NDP, DAYS, SIGN, IHMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C D 2 T F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an interval in days into hours, minutes, seconds
|
||||
*
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP int number of decimal places of seconds
|
||||
* DAYS real interval in days
|
||||
*
|
||||
* Returned:
|
||||
* SIGN char '+' or '-'
|
||||
* IHMSF int(4) hours, minutes, seconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size of
|
||||
* DAYS, the format of REAL floating-point numbers on the target
|
||||
* machine, and the risk of overflowing IHMSF(4). On some
|
||||
* architectures, for DAYS up to 1.0, the available floating-
|
||||
* point precision corresponds roughly to NDP=3. This is well
|
||||
* below the ultimate limit of NDP=9 set by the capacity of a
|
||||
* typical 32-bit IHMSF(4).
|
||||
*
|
||||
* 3) The absolute value of DAYS may exceed 1.0. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where DAYS is very nearly 1.0 and rounds up to 24 hours,
|
||||
* by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
|
||||
*
|
||||
* Called: sla_DD2TF
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
REAL DAYS
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IHMSF(4)
|
||||
|
||||
|
||||
|
||||
* Call double precision version
|
||||
CALL sla_DD2TF(NDP,DBLE(DAYS),SIGN,IHMSF)
|
||||
|
||||
END
|
||||
94
slalib/cldj.f
Normal file
94
slalib/cldj.f
Normal file
@ -0,0 +1,94 @@
|
||||
SUBROUTINE sla_CLDJ (IY, IM, ID, DJM, J)
|
||||
*+
|
||||
* - - - - -
|
||||
* C L D J
|
||||
* - - - - -
|
||||
*
|
||||
* Gregorian Calendar to Modified Julian Date
|
||||
*
|
||||
* Given:
|
||||
* IY,IM,ID int year, month, day in Gregorian calendar
|
||||
*
|
||||
* Returned:
|
||||
* DJM dp modified Julian Date (JD-2400000.5) for 0 hrs
|
||||
* J int status:
|
||||
* 0 = OK
|
||||
* 1 = bad year (MJD not computed)
|
||||
* 2 = bad month (MJD not computed)
|
||||
* 3 = bad day (MJD computed)
|
||||
*
|
||||
* The year must be -4699 (i.e. 4700BC) or later.
|
||||
*
|
||||
* The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55).
|
||||
*
|
||||
* Last revision: 27 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IY,IM,ID
|
||||
DOUBLE PRECISION DJM
|
||||
INTEGER J
|
||||
|
||||
* Month lengths in days
|
||||
INTEGER MTAB(12)
|
||||
DATA MTAB / 31,28,31,30,31,30,31,31,30,31,30,31 /
|
||||
|
||||
|
||||
|
||||
* Preset status.
|
||||
J = 0
|
||||
|
||||
* Validate year.
|
||||
IF ( IY .LT. -4699 ) THEN
|
||||
J = 1
|
||||
ELSE
|
||||
|
||||
* Validate month.
|
||||
IF ( IM.GE.1 .AND. IM.LE.12 ) THEN
|
||||
|
||||
* Allow for leap year.
|
||||
IF ( MOD(IY,4) .EQ. 0 ) THEN
|
||||
MTAB(2) = 29
|
||||
ELSE
|
||||
MTAB(2) = 28
|
||||
END IF
|
||||
IF ( MOD(IY,100).EQ.0 .AND. MOD(IY,400).NE.0 )
|
||||
: MTAB(2) = 28
|
||||
|
||||
* Validate day.
|
||||
IF ( ID.LT.1 .OR. ID.GT.MTAB(IM) ) J=3
|
||||
|
||||
* Modified Julian Date.
|
||||
DJM = DBLE ( ( 1461 * ( IY - (12-IM)/10 + 4712 ) ) / 4
|
||||
: + ( 306 * MOD ( IM+9, 12 ) + 5 ) / 10
|
||||
: - ( 3 * ( ( IY - (12-IM)/10 + 4900 ) / 100 ) ) / 4
|
||||
: + ID - 2399904 )
|
||||
|
||||
* Bad month.
|
||||
ELSE
|
||||
J=2
|
||||
END IF
|
||||
|
||||
END IF
|
||||
|
||||
END
|
||||
118
slalib/clyd.f
Normal file
118
slalib/clyd.f
Normal file
@ -0,0 +1,118 @@
|
||||
SUBROUTINE sla_CLYD (IY, IM, ID, NY, ND, JSTAT)
|
||||
*+
|
||||
* - - - - -
|
||||
* C L Y D
|
||||
* - - - - -
|
||||
*
|
||||
* Gregorian calendar to year and day in year (in a Julian calendar
|
||||
* aligned to the 20th/21st century Gregorian calendar).
|
||||
*
|
||||
* Given:
|
||||
* IY,IM,ID i year, month, day in Gregorian calendar
|
||||
*
|
||||
* Returned:
|
||||
* NY i year (re-aligned Julian calendar)
|
||||
* ND i day in year (1 = January 1st)
|
||||
* JSTAT i status:
|
||||
* 0 = OK
|
||||
* 1 = bad year (before -4711)
|
||||
* 2 = bad month
|
||||
* 3 = bad day (but conversion performed)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 This routine exists to support the low-precision routines
|
||||
* sla_EARTH, sla_MOON and sla_ECOR.
|
||||
*
|
||||
* 2 Between 1900 March 1 and 2100 February 28 it returns answers
|
||||
* which are consistent with the ordinary Gregorian calendar.
|
||||
* Outside this range there will be a discrepancy which increases
|
||||
* by one day for every non-leap century year.
|
||||
*
|
||||
* 3 The essence of the algorithm is first to express the Gregorian
|
||||
* date as a Julian Day Number and then to convert this back to
|
||||
* a Julian calendar date, with day-in-year instead of month and
|
||||
* day. See 12.92-1 and 12.95-1 in the reference.
|
||||
*
|
||||
* Reference: Explanatory Supplement to the Astronomical Almanac,
|
||||
* ed P.K.Seidelmann, University Science Books (1992),
|
||||
* p604-606.
|
||||
*
|
||||
* P.T.Wallace Starlink 26 November 1994
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IY,IM,ID,NY,ND,JSTAT
|
||||
|
||||
INTEGER I,J,K,L,N
|
||||
|
||||
* Month lengths in days
|
||||
INTEGER MTAB(12)
|
||||
DATA MTAB/31,28,31,30,31,30,31,31,30,31,30,31/
|
||||
|
||||
|
||||
|
||||
* Preset status
|
||||
JSTAT=0
|
||||
|
||||
* Validate year
|
||||
IF (IY.GE.-4711) THEN
|
||||
|
||||
* Validate month
|
||||
IF (IM.GE.1.AND.IM.LE.12) THEN
|
||||
|
||||
* Allow for (Gregorian) leap year
|
||||
IF (MOD(IY,4).EQ.0.AND.
|
||||
: (MOD(IY,100).NE.0.OR.MOD(IY,400).EQ.0)) THEN
|
||||
MTAB(2)=29
|
||||
ELSE
|
||||
MTAB(2)=28
|
||||
END IF
|
||||
|
||||
* Validate day
|
||||
IF (ID.LT.1.OR.ID.GT.MTAB(IM)) JSTAT=3
|
||||
|
||||
* Perform the conversion
|
||||
I=(14-IM)/12
|
||||
K=IY-I
|
||||
J=(1461*(K+4800))/4+(367*(IM-2+12*I))/12
|
||||
: -(3*((K+4900)/100))/4+ID-30660
|
||||
K=(J-1)/1461
|
||||
L=J-1461*K
|
||||
N=(L-1)/365-L/1461
|
||||
J=((80*(L-365*N+30))/2447)/11
|
||||
I=N+J
|
||||
ND=59+L-365*I+((4-N)/4)*(1-J)
|
||||
NY=4*K+I-4716
|
||||
|
||||
* Bad month
|
||||
ELSE
|
||||
JSTAT=2
|
||||
END IF
|
||||
ELSE
|
||||
|
||||
* Bad year
|
||||
JSTAT=1
|
||||
END IF
|
||||
|
||||
END
|
||||
159
slalib/combn.f
Normal file
159
slalib/combn.f
Normal file
@ -0,0 +1,159 @@
|
||||
SUBROUTINE sla_COMBN ( NSEL, NCAND, LIST, J )
|
||||
*+
|
||||
* - - - - - -
|
||||
* C O M B N
|
||||
* - - - - - -
|
||||
*
|
||||
* Generate the next combination, a subset of a specified size chosen
|
||||
* from a specified number of items.
|
||||
*
|
||||
* Given:
|
||||
* NSEL i number of items (subset size)
|
||||
* NCAND i number of candidates (set size)
|
||||
*
|
||||
* Given and returned:
|
||||
* LIST i(NSEL) latest combination, LIST(1)=0 to initialize
|
||||
*
|
||||
* Returned:
|
||||
* J i status: -1 = illegal NSEL or NCAND
|
||||
* 0 = OK
|
||||
* +1 = no more combinations available
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NSEL and NCAND must both be at least 1, and NSEL must be less
|
||||
* than or equal to NCAND.
|
||||
*
|
||||
* 2) This routine returns, in the LIST array, a subset of NSEL integers
|
||||
* chosen from the range 1 to NCAND inclusive, in ascending order.
|
||||
* Before calling the routine for the first time, the caller must set
|
||||
* the first element of the LIST array to zero (any value less than 1
|
||||
* will do) to cause initialization.
|
||||
*
|
||||
* 2) The first combination to be generated is:
|
||||
*
|
||||
* LIST(1)=1, LIST(2)=2, ..., LIST(NSEL)=NSEL
|
||||
*
|
||||
* This is also the combination returned for the "finished" (J=1)
|
||||
* case.
|
||||
*
|
||||
* The final permutation to be generated is:
|
||||
*
|
||||
* LIST(1)=NCAND, LIST(2)=NCAND-1, ..., LIST(NSEL)=NCAND-NSEL+1
|
||||
*
|
||||
* 3) If the "finished" (J=1) status is ignored, the routine
|
||||
* continues to deliver combinations, the pattern repeating
|
||||
* every NCAND!/(NSEL!*(NCAND-NSEL)!) calls.
|
||||
*
|
||||
* 4) The algorithm is by R.F.Warren-Smith (private communication).
|
||||
*
|
||||
* P.T.Wallace Starlink 25 August 1999
|
||||
*
|
||||
* Copyright (C) 1999 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NSEL,NCAND,LIST(NSEL),J
|
||||
|
||||
INTEGER I,LISTI,NMAX,M
|
||||
LOGICAL MORE
|
||||
|
||||
|
||||
* Validate, and set status.
|
||||
IF (NSEL.LT.1.OR.NCAND.LT.1.OR.NSEL.GT.NCAND) THEN
|
||||
J = -1
|
||||
GO TO 9999
|
||||
ELSE
|
||||
J = 0
|
||||
END IF
|
||||
|
||||
* Just starting?
|
||||
IF (LIST(1).LT.1) THEN
|
||||
|
||||
* Yes: return 1,2,3...
|
||||
DO I=1,NSEL
|
||||
LIST(I) = I
|
||||
END DO
|
||||
|
||||
ELSE
|
||||
|
||||
* No: find the first selection that we can increment.
|
||||
|
||||
* Start with the first list item.
|
||||
I = 1
|
||||
|
||||
* Loop.
|
||||
MORE = .TRUE.
|
||||
DO WHILE (MORE)
|
||||
|
||||
* Current list item.
|
||||
LISTI = LIST(I)
|
||||
|
||||
* Is this the final list item?
|
||||
IF (I.GE.NSEL) THEN
|
||||
|
||||
* Yes: comparison value is number of candidates plus one.
|
||||
NMAX = NCAND+1
|
||||
ELSE
|
||||
|
||||
* No: comparison value is next list item.
|
||||
NMAX = LIST(I+1)
|
||||
END IF
|
||||
|
||||
* Can the current item be incremented?
|
||||
IF (NMAX-LISTI.GT.1) THEN
|
||||
|
||||
* Yes: increment it.
|
||||
LIST(I) = LISTI+1
|
||||
|
||||
* Reinitialize the preceding items.
|
||||
DO M=1,I-1
|
||||
LIST(M) = M
|
||||
END DO
|
||||
|
||||
* Break.
|
||||
MORE = .FALSE.
|
||||
ELSE
|
||||
|
||||
* Can't increment the current item: is it the final one?
|
||||
IF (I.GE.NSEL) THEN
|
||||
|
||||
* Yes: set the status.
|
||||
J = 1
|
||||
|
||||
* Restart the sequence.
|
||||
DO I=1,NSEL
|
||||
LIST(I) = I
|
||||
END DO
|
||||
|
||||
* Break.
|
||||
MORE = .FALSE.
|
||||
ELSE
|
||||
|
||||
* No: next list item.
|
||||
I = I+1
|
||||
END IF
|
||||
END IF
|
||||
END DO
|
||||
END IF
|
||||
9999 CONTINUE
|
||||
|
||||
END
|
||||
75
slalib/cr2af.f
Normal file
75
slalib/cr2af.f
Normal file
@ -0,0 +1,75 @@
|
||||
SUBROUTINE sla_CR2AF (NDP, ANGLE, SIGN, IDMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C R 2 A F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an angle in radians into degrees, arcminutes, arcseconds
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP int number of decimal places of arcseconds
|
||||
* ANGLE real angle in radians
|
||||
*
|
||||
* Returned:
|
||||
* SIGN char '+' or '-'
|
||||
* IDMSF int(4) degrees, arcminutes, arcseconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size of
|
||||
* ANGLE, the format of REAL floating-point numbers on the target
|
||||
* machine, and the risk of overflowing IDMSF(4). On some
|
||||
* architectures, for ANGLE up to 2pi, the available floating-
|
||||
* point precision corresponds roughly to NDP=3. This is well
|
||||
* below the ultimate limit of NDP=9 set by the capacity of a
|
||||
* typical 32-bit IDMSF(4).
|
||||
*
|
||||
* 3) The absolute value of ANGLE may exceed 2pi. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where ANGLE is very nearly 2pi and rounds up to 360 deg,
|
||||
* by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero.
|
||||
*
|
||||
* Called: sla_CD2TF
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
REAL ANGLE
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IDMSF(4)
|
||||
|
||||
* Hours to degrees * radians to turns
|
||||
REAL F
|
||||
PARAMETER (F=15.0/6.283185307179586476925287)
|
||||
|
||||
|
||||
|
||||
* Scale then use days to h,m,s routine
|
||||
CALL sla_CD2TF(NDP,ANGLE*F,SIGN,IDMSF)
|
||||
|
||||
END
|
||||
75
slalib/cr2tf.f
Normal file
75
slalib/cr2tf.f
Normal file
@ -0,0 +1,75 @@
|
||||
SUBROUTINE sla_CR2TF (NDP, ANGLE, SIGN, IHMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C R 2 T F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an angle in radians into hours, minutes, seconds
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP int number of decimal places of seconds
|
||||
* ANGLE real angle in radians
|
||||
*
|
||||
* Returned:
|
||||
* SIGN char '+' or '-'
|
||||
* IHMSF int(4) hours, minutes, seconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size of
|
||||
* ANGLE, the format of REAL floating-point numbers on the target
|
||||
* machine, and the risk of overflowing IHMSF(4). On some
|
||||
* architectures, for ANGLE up to 2pi, the available floating-point
|
||||
* precision corresponds roughly to NDP=3. This is well below
|
||||
* the ultimate limit of NDP=9 set by the capacity of a typical
|
||||
* 32-bit IHMSF(4).
|
||||
*
|
||||
* 3) The absolute value of ANGLE may exceed 2pi. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where ANGLE is very nearly 2pi and rounds up to 24 hours,
|
||||
* by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
|
||||
*
|
||||
* Called: sla_CD2TF
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
REAL ANGLE
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IHMSF(4)
|
||||
|
||||
* Turns to radians
|
||||
REAL T2R
|
||||
PARAMETER (T2R=6.283185307179586476925287)
|
||||
|
||||
|
||||
|
||||
* Scale then use days to h,m,s routine
|
||||
CALL sla_CD2TF(NDP,ANGLE/T2R,SIGN,IHMSF)
|
||||
|
||||
END
|
||||
57
slalib/cs2c.f
Normal file
57
slalib/cs2c.f
Normal file
@ -0,0 +1,57 @@
|
||||
SUBROUTINE sla_CS2C (A, B, V)
|
||||
*+
|
||||
* - - - - -
|
||||
* C S 2 C
|
||||
* - - - - -
|
||||
*
|
||||
* Spherical coordinates to direction cosines (single precision)
|
||||
*
|
||||
* Given:
|
||||
* A,B real spherical coordinates in radians
|
||||
* (RA,Dec), (long,lat) etc.
|
||||
*
|
||||
* Returned:
|
||||
* V real(3) x,y,z unit vector
|
||||
*
|
||||
* The spherical coordinates are longitude (+ve anticlockwise looking
|
||||
* from the +ve latitude pole) and latitude. The Cartesian coordinates
|
||||
* are right handed, with the x axis at zero longitude and latitude, and
|
||||
* the z axis at the +ve latitude pole.
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL A,B,V(3)
|
||||
|
||||
REAL COSB
|
||||
|
||||
|
||||
|
||||
COSB = COS(B)
|
||||
|
||||
V(1) = COS(A)*COSB
|
||||
V(2) = SIN(A)*COSB
|
||||
V(3) = SIN(B)
|
||||
|
||||
END
|
||||
72
slalib/cs2c6.f
Normal file
72
slalib/cs2c6.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_CS2C6 ( A, B, R, AD, BD, RD, V )
|
||||
*+
|
||||
* - - - - - -
|
||||
* C S 2 C 6
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of position & velocity in spherical coordinates
|
||||
* to Cartesian coordinates (single precision)
|
||||
*
|
||||
* Given:
|
||||
* A r longitude (radians)
|
||||
* B r latitude (radians)
|
||||
* R r radial coordinate
|
||||
* AD r longitude derivative (radians per unit time)
|
||||
* BD r latitude derivative (radians per unit time)
|
||||
* RD r radial derivative
|
||||
*
|
||||
* Returned:
|
||||
* V r(6) Cartesian position & velocity vector
|
||||
*
|
||||
* Last revision: 11 September 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL A, B, R, AD, BD, RD, V(6)
|
||||
|
||||
REAL SA, CA, SB, CB, RCB, X, Y, RBD, W
|
||||
|
||||
|
||||
|
||||
* Useful functions.
|
||||
SA = SIN(A)
|
||||
CA = COS(A)
|
||||
SB = SIN(B)
|
||||
CB = COS(B)
|
||||
RCB = R*CB
|
||||
X = RCB*CA
|
||||
Y = RCB*SA
|
||||
RBD = R*BD
|
||||
W = RBD*SB-CB*RD
|
||||
|
||||
* Position.
|
||||
V(1) = X
|
||||
V(2) = Y
|
||||
V(3) = R*SB
|
||||
|
||||
* Velocity.
|
||||
V(4) = -Y*AD-W*CA
|
||||
V(5) = X*AD-W*SA
|
||||
V(6) = RBD*CB+SB*RD
|
||||
|
||||
END
|
||||
73
slalib/ctf2d.f
Normal file
73
slalib/ctf2d.f
Normal file
@ -0,0 +1,73 @@
|
||||
SUBROUTINE sla_CTF2D (IHOUR, IMIN, SEC, DAYS, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C T F 2 D
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert hours, minutes, seconds to days (single precision)
|
||||
*
|
||||
* Given:
|
||||
* IHOUR int hours
|
||||
* IMIN int minutes
|
||||
* SEC real seconds
|
||||
*
|
||||
* Returned:
|
||||
* DAYS real interval in days
|
||||
* J int status: 0 = OK
|
||||
* 1 = IHOUR outside range 0-23
|
||||
* 2 = IMIN outside range 0-59
|
||||
* 3 = SEC outside range 0-59.999...
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is computed even if any of the range checks
|
||||
* fail.
|
||||
*
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink November 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IHOUR,IMIN
|
||||
REAL SEC,DAYS
|
||||
INTEGER J
|
||||
|
||||
* Seconds per day
|
||||
REAL D2S
|
||||
PARAMETER (D2S=86400.0)
|
||||
|
||||
|
||||
|
||||
* Preset status
|
||||
J=0
|
||||
|
||||
* Validate sec, min, hour
|
||||
IF (SEC.LT.0.0.OR.SEC.GE.60.0) J=3
|
||||
IF (IMIN.LT.0.OR.IMIN.GT.59) J=2
|
||||
IF (IHOUR.LT.0.OR.IHOUR.GT.23) J=1
|
||||
|
||||
* Compute interval
|
||||
DAYS=(60.0*(60.0*REAL(IHOUR)+REAL(IMIN))+SEC)/D2S
|
||||
|
||||
END
|
||||
71
slalib/ctf2r.f
Normal file
71
slalib/ctf2r.f
Normal file
@ -0,0 +1,71 @@
|
||||
SUBROUTINE sla_CTF2R (IHOUR, IMIN, SEC, RAD, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* C T F 2 R
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert hours, minutes, seconds to radians (single precision)
|
||||
*
|
||||
* Given:
|
||||
* IHOUR int hours
|
||||
* IMIN int minutes
|
||||
* SEC real seconds
|
||||
*
|
||||
* Returned:
|
||||
* RAD real angle in radians
|
||||
* J int status: 0 = OK
|
||||
* 1 = IHOUR outside range 0-23
|
||||
* 2 = IMIN outside range 0-59
|
||||
* 3 = SEC outside range 0-59.999...
|
||||
*
|
||||
* Called:
|
||||
* sla_CTF2D
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is computed even if any of the range checks
|
||||
* fail.
|
||||
*
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink November 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IHOUR,IMIN
|
||||
REAL SEC,RAD
|
||||
INTEGER J
|
||||
|
||||
REAL TURNS
|
||||
|
||||
* Turns to radians
|
||||
REAL T2R
|
||||
PARAMETER (T2R=6.283185307179586476925287)
|
||||
|
||||
|
||||
|
||||
* Convert to turns then radians
|
||||
CALL sla_CTF2D(IHOUR,IMIN,SEC,TURNS,J)
|
||||
RAD=T2R*TURNS
|
||||
|
||||
END
|
||||
72
slalib/daf2r.f
Normal file
72
slalib/daf2r.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_DAF2R (IDEG, IAMIN, ASEC, RAD, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D A F 2 R
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert degrees, arcminutes, arcseconds to radians
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* IDEG int degrees
|
||||
* IAMIN int arcminutes
|
||||
* ASEC dp arcseconds
|
||||
*
|
||||
* Returned:
|
||||
* RAD dp angle in radians
|
||||
* J int status: 0 = OK
|
||||
* 1 = IDEG outside range 0-359
|
||||
* 2 = IAMIN outside range 0-59
|
||||
* 3 = ASEC outside range 0-59.999...
|
||||
*
|
||||
* Notes:
|
||||
* 1) The result is computed even if any of the range checks
|
||||
* fail.
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IDEG,IAMIN
|
||||
DOUBLE PRECISION ASEC,RAD
|
||||
INTEGER J
|
||||
|
||||
* Arc seconds to radians
|
||||
DOUBLE PRECISION AS2R
|
||||
PARAMETER (AS2R=0.484813681109535994D-5)
|
||||
|
||||
|
||||
|
||||
* Preset status
|
||||
J=0
|
||||
|
||||
* Validate arcsec, arcmin, deg
|
||||
IF (ASEC.LT.0D0.OR.ASEC.GE.60D0) J=3
|
||||
IF (IAMIN.LT.0.OR.IAMIN.GT.59) J=2
|
||||
IF (IDEG.LT.0.OR.IDEG.GT.359) J=1
|
||||
|
||||
* Compute angle
|
||||
RAD=AS2R*(60D0*(60D0*DBLE(IDEG)+DBLE(IAMIN))+ASEC)
|
||||
|
||||
END
|
||||
180
slalib/dafin.f
Normal file
180
slalib/dafin.f
Normal file
@ -0,0 +1,180 @@
|
||||
SUBROUTINE sla_DAFIN (STRING, IPTR, A, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D A F I N
|
||||
* - - - - - -
|
||||
*
|
||||
* Sexagesimal character string to angle (double precision)
|
||||
*
|
||||
* Given:
|
||||
* STRING c*(*) string containing deg, arcmin, arcsec fields
|
||||
* IPTR i pointer to start of decode (1st = 1)
|
||||
*
|
||||
* Returned:
|
||||
* IPTR i advanced past the decoded angle
|
||||
* A d angle in radians
|
||||
* J i status: 0 = OK
|
||||
* +1 = default, A unchanged
|
||||
* -1 = bad degrees )
|
||||
* -2 = bad arcminutes ) (note 3)
|
||||
* -3 = bad arcseconds )
|
||||
*
|
||||
* Example:
|
||||
*
|
||||
* argument before after
|
||||
*
|
||||
* STRING '-57 17 44.806 12 34 56.7' unchanged
|
||||
* IPTR 1 16 (points to 12...)
|
||||
* A ? -1.00000D0
|
||||
* J ? 0
|
||||
*
|
||||
* A further call to sla_DAFIN, without adjustment of IPTR, will
|
||||
* decode the second angle, 12deg 34min 56.7sec.
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The first three "fields" in STRING are degrees, arcminutes,
|
||||
* arcseconds, separated by spaces or commas. The degrees field
|
||||
* may be signed, but not the others. The decoding is carried
|
||||
* out by the DFLTIN routine and is free-format.
|
||||
*
|
||||
* 2) Successive fields may be absent, defaulting to zero. For
|
||||
* zero status, the only combinations allowed are degrees alone,
|
||||
* degrees and arcminutes, and all three fields present. If all
|
||||
* three fields are omitted, a status of +1 is returned and A is
|
||||
* unchanged. In all other cases A is changed.
|
||||
*
|
||||
* 3) Range checking:
|
||||
*
|
||||
* The degrees field is not range checked. However, it is
|
||||
* expected to be integral unless the other two fields are absent.
|
||||
*
|
||||
* The arcminutes field is expected to be 0-59, and integral if
|
||||
* the arcseconds field is present. If the arcseconds field
|
||||
* is absent, the arcminutes is expected to be 0-59.9999...
|
||||
*
|
||||
* The arcseconds field is expected to be 0-59.9999...
|
||||
*
|
||||
* 4) Decoding continues even when a check has failed. Under these
|
||||
* circumstances the field takes the supplied value, defaulting
|
||||
* to zero, and the result A is computed and returned.
|
||||
*
|
||||
* 5) Further fields after the three expected ones are not treated
|
||||
* as an error. The pointer IPTR is left in the correct state
|
||||
* for further decoding with the present routine or with DFLTIN
|
||||
* etc. See the example, above.
|
||||
*
|
||||
* 6) If STRING contains hours, minutes, seconds instead of degrees
|
||||
* etc, or if the required units are turns (or days) instead of
|
||||
* radians, the result A should be multiplied as follows:
|
||||
*
|
||||
* for to obtain multiply
|
||||
* STRING A in A by
|
||||
*
|
||||
* d ' " radians 1 = 1D0
|
||||
* d ' " turns 1/2pi = 0.1591549430918953358D0
|
||||
* h m s radians 15 = 15D0
|
||||
* h m s days 15/2pi = 2.3873241463784300365D0
|
||||
*
|
||||
* Called: sla_DFLTIN
|
||||
*
|
||||
* P.T.Wallace Starlink 1 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) STRING
|
||||
INTEGER IPTR
|
||||
DOUBLE PRECISION A
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION AS2R
|
||||
PARAMETER (AS2R=4.84813681109535993589914102358D-6)
|
||||
INTEGER JF,JD,JM,JS
|
||||
DOUBLE PRECISION DEG,ARCMIN,ARCSEC
|
||||
|
||||
|
||||
|
||||
* Preset the status to OK
|
||||
JF=0
|
||||
|
||||
* Defaults
|
||||
DEG=0D0
|
||||
ARCMIN=0D0
|
||||
ARCSEC=0D0
|
||||
|
||||
* Decode degrees, arcminutes, arcseconds
|
||||
CALL sla_DFLTIN(STRING,IPTR,DEG,JD)
|
||||
IF (JD.GT.1) THEN
|
||||
JF=-1
|
||||
ELSE
|
||||
CALL sla_DFLTIN(STRING,IPTR,ARCMIN,JM)
|
||||
IF (JM.LT.0.OR.JM.GT.1) THEN
|
||||
JF=-2
|
||||
ELSE
|
||||
CALL sla_DFLTIN(STRING,IPTR,ARCSEC,JS)
|
||||
IF (JS.LT.0.OR.JS.GT.1) THEN
|
||||
JF=-3
|
||||
|
||||
* See if the combination of fields is credible
|
||||
ELSE IF (JD.GT.0) THEN
|
||||
* No degrees: arcmin, arcsec ought also to be absent
|
||||
IF (JM.EQ.0) THEN
|
||||
* Suspect arcmin
|
||||
JF=-2
|
||||
ELSE IF (JS.EQ.0) THEN
|
||||
* Suspect arcsec
|
||||
JF=-3
|
||||
ELSE
|
||||
* All three fields absent
|
||||
JF=1
|
||||
END IF
|
||||
* Degrees present: if arcsec present so ought arcmin to be
|
||||
ELSE IF (JM.NE.0.AND.JS.EQ.0) THEN
|
||||
JF=-3
|
||||
|
||||
* Tests for range and integrality
|
||||
|
||||
* Degrees
|
||||
ELSE IF (JM.EQ.0.AND.DINT(DEG).NE.DEG) THEN
|
||||
JF=-1
|
||||
* Arcminutes
|
||||
ELSE IF ((JS.EQ.0.AND.DINT(ARCMIN).NE.ARCMIN).OR.
|
||||
: ARCMIN.GE.60D0) THEN
|
||||
JF=-2
|
||||
* Arcseconds
|
||||
ELSE IF (ARCSEC.GE.60D0) THEN
|
||||
JF=-3
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
||||
* Unless all three fields absent, compute angle value
|
||||
IF (JF.LE.0) THEN
|
||||
A=AS2R*(60D0*(60D0*ABS(DEG)+ARCMIN)+ARCSEC)
|
||||
IF (JD.LT.0) A=-A
|
||||
END IF
|
||||
|
||||
* Return the status
|
||||
J=JF
|
||||
|
||||
END
|
||||
252
slalib/dat.f
Normal file
252
slalib/dat.f
Normal file
@ -0,0 +1,252 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DAT (UTC)
|
||||
*+
|
||||
* - - - -
|
||||
* D A T
|
||||
* - - - -
|
||||
*
|
||||
* Increment to be applied to Coordinated Universal Time UTC to give
|
||||
* International Atomic Time TAI (double precision)
|
||||
*
|
||||
* Given:
|
||||
* UTC d UTC date as a modified JD (JD-2400000.5)
|
||||
*
|
||||
* Result: TAI-UTC in seconds
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The UTC is specified to be a date rather than a time to indicate
|
||||
* that care needs to be taken not to specify an instant which lies
|
||||
* within a leap second. Though in most cases UTC can include the
|
||||
* fractional part, correct behaviour on the day of a leap second
|
||||
* can only be guaranteed up to the end of the second 23:59:59.
|
||||
*
|
||||
* 2 For epochs from 1961 January 1 onwards, the expressions from the
|
||||
* file ftp://maia.usno.navy.mil/ser7/tai-utc.dat are used.
|
||||
*
|
||||
* 3 The 5ms time step at 1961 January 1 is taken from 2.58.1 (p87) of
|
||||
* the 1992 Explanatory Supplement.
|
||||
*
|
||||
* 4 UTC began at 1960 January 1.0 (JD 2436934.5) and it is improper
|
||||
* to call the routine with an earlier epoch. However, if this
|
||||
* is attempted, the TAI-UTC expression for the year 1960 is used.
|
||||
*
|
||||
*
|
||||
* :-----------------------------------------:
|
||||
* : :
|
||||
* : IMPORTANT :
|
||||
* : :
|
||||
* : This routine must be updated on each :
|
||||
* : occasion that a leap second is :
|
||||
* : announced :
|
||||
* : :
|
||||
* : Latest leap second: 2015 July 1 :
|
||||
* : :
|
||||
* :-----------------------------------------:
|
||||
*
|
||||
* Last revision: 31 January 2015
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION UTC
|
||||
|
||||
DOUBLE PRECISION DT
|
||||
|
||||
|
||||
|
||||
IF (.FALSE.) THEN
|
||||
|
||||
* - - - - - - - - - - - - - - - - - - - - - - *
|
||||
* Add new code here on each occasion that a *
|
||||
* leap second is announced, and update the *
|
||||
* preamble comments appropriately. *
|
||||
* - - - - - - - - - - - - - - - - - - - - - - *
|
||||
|
||||
* 2015 July 1
|
||||
ELSE IF (UTC.GE.57204D0) THEN
|
||||
DT=36D0
|
||||
|
||||
* 2012 July 1
|
||||
ELSE IF (UTC.GE.56109D0) THEN
|
||||
DT=35D0
|
||||
|
||||
* 2009 January 1
|
||||
ELSE IF (UTC.GE.54832D0) THEN
|
||||
DT=34D0
|
||||
|
||||
* 2006 January 1
|
||||
ELSE IF (UTC.GE.53736D0) THEN
|
||||
DT=33D0
|
||||
|
||||
* 1999 January 1
|
||||
ELSE IF (UTC.GE.51179D0) THEN
|
||||
DT=32D0
|
||||
|
||||
* 1997 July 1
|
||||
ELSE IF (UTC.GE.50630D0) THEN
|
||||
DT=31D0
|
||||
|
||||
* 1996 January 1
|
||||
ELSE IF (UTC.GE.50083D0) THEN
|
||||
DT=30D0
|
||||
|
||||
* 1994 July 1
|
||||
ELSE IF (UTC.GE.49534D0) THEN
|
||||
DT=29D0
|
||||
|
||||
* 1993 July 1
|
||||
ELSE IF (UTC.GE.49169D0) THEN
|
||||
DT=28D0
|
||||
|
||||
* 1992 July 1
|
||||
ELSE IF (UTC.GE.48804D0) THEN
|
||||
DT=27D0
|
||||
|
||||
* 1991 January 1
|
||||
ELSE IF (UTC.GE.48257D0) THEN
|
||||
DT=26D0
|
||||
|
||||
* 1990 January 1
|
||||
ELSE IF (UTC.GE.47892D0) THEN
|
||||
DT=25D0
|
||||
|
||||
* 1988 January 1
|
||||
ELSE IF (UTC.GE.47161D0) THEN
|
||||
DT=24D0
|
||||
|
||||
* 1985 July 1
|
||||
ELSE IF (UTC.GE.46247D0) THEN
|
||||
DT=23D0
|
||||
|
||||
* 1983 July 1
|
||||
ELSE IF (UTC.GE.45516D0) THEN
|
||||
DT=22D0
|
||||
|
||||
* 1982 July 1
|
||||
ELSE IF (UTC.GE.45151D0) THEN
|
||||
DT=21D0
|
||||
|
||||
* 1981 July 1
|
||||
ELSE IF (UTC.GE.44786D0) THEN
|
||||
DT=20D0
|
||||
|
||||
* 1980 January 1
|
||||
ELSE IF (UTC.GE.44239D0) THEN
|
||||
DT=19D0
|
||||
|
||||
* 1979 January 1
|
||||
ELSE IF (UTC.GE.43874D0) THEN
|
||||
DT=18D0
|
||||
|
||||
* 1978 January 1
|
||||
ELSE IF (UTC.GE.43509D0) THEN
|
||||
DT=17D0
|
||||
|
||||
* 1977 January 1
|
||||
ELSE IF (UTC.GE.43144D0) THEN
|
||||
DT=16D0
|
||||
|
||||
* 1976 January 1
|
||||
ELSE IF (UTC.GE.42778D0) THEN
|
||||
DT=15D0
|
||||
|
||||
* 1975 January 1
|
||||
ELSE IF (UTC.GE.42413D0) THEN
|
||||
DT=14D0
|
||||
|
||||
* 1974 January 1
|
||||
ELSE IF (UTC.GE.42048D0) THEN
|
||||
DT=13D0
|
||||
|
||||
* 1973 January 1
|
||||
ELSE IF (UTC.GE.41683D0) THEN
|
||||
DT=12D0
|
||||
|
||||
* 1972 July 1
|
||||
ELSE IF (UTC.GE.41499D0) THEN
|
||||
DT=11D0
|
||||
|
||||
* 1972 January 1
|
||||
ELSE IF (UTC.GE.41317D0) THEN
|
||||
DT=10D0
|
||||
|
||||
* 1968 February 1
|
||||
ELSE IF (UTC.GE.39887D0) THEN
|
||||
DT=4.2131700D0+(UTC-39126D0)*0.002592D0
|
||||
|
||||
* 1966 January 1
|
||||
ELSE IF (UTC.GE.39126D0) THEN
|
||||
DT=4.3131700D0+(UTC-39126D0)*0.002592D0
|
||||
|
||||
* 1965 September 1
|
||||
ELSE IF (UTC.GE.39004D0) THEN
|
||||
DT=3.8401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1965 July 1
|
||||
ELSE IF (UTC.GE.38942D0) THEN
|
||||
DT=3.7401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1965 March 1
|
||||
ELSE IF (UTC.GE.38820D0) THEN
|
||||
DT=3.6401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1965 January 1
|
||||
ELSE IF (UTC.GE.38761D0) THEN
|
||||
DT=3.5401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1964 September 1
|
||||
ELSE IF (UTC.GE.38639D0) THEN
|
||||
DT=3.4401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1964 April 1
|
||||
ELSE IF (UTC.GE.38486D0) THEN
|
||||
DT=3.3401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1964 January 1
|
||||
ELSE IF (UTC.GE.38395D0) THEN
|
||||
DT=3.2401300D0+(UTC-38761D0)*0.001296D0
|
||||
|
||||
* 1963 November 1
|
||||
ELSE IF (UTC.GE.38334D0) THEN
|
||||
DT=1.9458580D0+(UTC-37665D0)*0.0011232D0
|
||||
|
||||
* 1962 January 1
|
||||
ELSE IF (UTC.GE.37665D0) THEN
|
||||
DT=1.8458580D0+(UTC-37665D0)*0.0011232D0
|
||||
|
||||
* 1961 August 1
|
||||
ELSE IF (UTC.GE.37512D0) THEN
|
||||
DT=1.3728180D0+(UTC-37300D0)*0.001296D0
|
||||
|
||||
* 1961 January 1
|
||||
ELSE IF (UTC.GE.37300D0) THEN
|
||||
DT=1.4228180D0+(UTC-37300D0)*0.001296D0
|
||||
|
||||
* Before that
|
||||
ELSE
|
||||
DT=1.4178180D0+(UTC-37300D0)*0.001296D0
|
||||
|
||||
END IF
|
||||
|
||||
sla_DAT=DT
|
||||
|
||||
END
|
||||
83
slalib/dav2m.f
Normal file
83
slalib/dav2m.f
Normal file
@ -0,0 +1,83 @@
|
||||
SUBROUTINE sla_DAV2M (AXVEC, RMAT)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D A V 2 M
|
||||
* - - - - - -
|
||||
*
|
||||
* Form the rotation matrix corresponding to a given axial vector.
|
||||
* (double precision)
|
||||
*
|
||||
* A rotation matrix describes a rotation about some arbitrary axis,
|
||||
* called the Euler axis. The "axial vector" supplied to this routine
|
||||
* has the same direction as the Euler axis, and its magnitude is the
|
||||
* amount of rotation in radians.
|
||||
*
|
||||
* Given:
|
||||
* AXVEC d(3) axial vector (radians)
|
||||
*
|
||||
* Returned:
|
||||
* RMAT d(3,3) rotation matrix
|
||||
*
|
||||
* If AXVEC is null, the unit matrix is returned.
|
||||
*
|
||||
* The reference frame rotates clockwise as seen looking along
|
||||
* the axial vector from the origin.
|
||||
*
|
||||
* Last revision: 26 November 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION AXVEC(3),RMAT(3,3)
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,PHI,S,C,W
|
||||
|
||||
|
||||
|
||||
* Rotation angle - magnitude of axial vector - and functions
|
||||
X = AXVEC(1)
|
||||
Y = AXVEC(2)
|
||||
Z = AXVEC(3)
|
||||
PHI = SQRT(X*X+Y*Y+Z*Z)
|
||||
S = SIN(PHI)
|
||||
C = COS(PHI)
|
||||
W = 1D0-C
|
||||
|
||||
* Euler axis - direction of axial vector (perhaps null)
|
||||
IF (PHI.NE.0D0) THEN
|
||||
X = X/PHI
|
||||
Y = Y/PHI
|
||||
Z = Z/PHI
|
||||
END IF
|
||||
|
||||
* Compute the rotation matrix
|
||||
RMAT(1,1) = X*X*W+C
|
||||
RMAT(1,2) = X*Y*W+Z*S
|
||||
RMAT(1,3) = X*Z*W-Y*S
|
||||
RMAT(2,1) = X*Y*W-Z*S
|
||||
RMAT(2,2) = Y*Y*W+C
|
||||
RMAT(2,3) = Y*Z*W+X*S
|
||||
RMAT(3,1) = X*Z*W+Y*S
|
||||
RMAT(3,2) = Y*Z*W-X*S
|
||||
RMAT(3,3) = Z*Z*W+C
|
||||
|
||||
END
|
||||
59
slalib/dbear.f
Normal file
59
slalib/dbear.f
Normal file
@ -0,0 +1,59 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DBEAR (A1, B1, A2, B2)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D B E A R
|
||||
* - - - - - -
|
||||
*
|
||||
* Bearing (position angle) of one point on a sphere relative to another
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* A1,B1 d spherical coordinates of one point
|
||||
* A2,B2 d spherical coordinates of the other point
|
||||
*
|
||||
* (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.)
|
||||
*
|
||||
* The result is the bearing (position angle), in radians, of point
|
||||
* A2,B2 as seen from point A1,B1. It is in the range +/- pi. If
|
||||
* A2,B2 is due east of A1,B1 the bearing is +pi/2. Zero is returned
|
||||
* if the two points are coincident.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 March 1991
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION A1,B1,A2,B2
|
||||
|
||||
DOUBLE PRECISION DA,X,Y
|
||||
|
||||
|
||||
DA=A2-A1
|
||||
Y=SIN(DA)*COS(B2)
|
||||
X=SIN(B2)*COS(B1)-COS(B2)*SIN(B1)*COS(DA)
|
||||
IF (X.NE.0D0.OR.Y.NE.0D0) THEN
|
||||
sla_DBEAR=ATAN2(Y,X)
|
||||
ELSE
|
||||
sla_DBEAR=0D0
|
||||
END IF
|
||||
|
||||
END
|
||||
130
slalib/dbjin.f
Normal file
130
slalib/dbjin.f
Normal file
@ -0,0 +1,130 @@
|
||||
SUBROUTINE sla_DBJIN (STRING, NSTRT, DRESLT, J1, J2)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D B J I N
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert free-format input into double precision floating point,
|
||||
* using DFLTIN but with special syntax extensions.
|
||||
*
|
||||
* The purpose of the syntax extensions is to help cope with mixed
|
||||
* FK4 and FK5 data. In addition to the syntax accepted by DFLTIN,
|
||||
* the following two extensions are recognized by DBJIN:
|
||||
*
|
||||
* 1) A valid non-null field preceded by the character 'B'
|
||||
* (or 'b') is accepted.
|
||||
*
|
||||
* 2) A valid non-null field preceded by the character 'J'
|
||||
* (or 'j') is accepted.
|
||||
*
|
||||
* The calling program is notified of the incidence of either of these
|
||||
* extensions through an supplementary status argument. The rest of
|
||||
* the arguments are as for DFLTIN.
|
||||
*
|
||||
* Given:
|
||||
* STRING char string containing field to be decoded
|
||||
* NSTRT int pointer to 1st character of field in string
|
||||
*
|
||||
* Returned:
|
||||
* NSTRT int incremented
|
||||
* DRESLT double result
|
||||
* J1 int DFLTIN status: -1 = -OK
|
||||
* 0 = +OK
|
||||
* +1 = null field
|
||||
* +2 = error
|
||||
* J2 int syntax flag: 0 = normal DFLTIN syntax
|
||||
* +1 = 'B' or 'b'
|
||||
* +2 = 'J' or 'j'
|
||||
*
|
||||
* Called: sla_DFLTIN
|
||||
*
|
||||
* For details of the basic syntax, see sla_DFLTIN.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 November 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) STRING
|
||||
INTEGER NSTRT
|
||||
DOUBLE PRECISION DRESLT
|
||||
INTEGER J1,J2
|
||||
|
||||
INTEGER J2A,LENSTR,NA,J1A,NB,J1B
|
||||
CHARACTER C
|
||||
|
||||
|
||||
|
||||
* Preset syntax flag
|
||||
J2A=0
|
||||
|
||||
* Length of string
|
||||
LENSTR=LEN(STRING)
|
||||
|
||||
* Pointer to current character
|
||||
NA=NSTRT
|
||||
|
||||
* Attempt normal decode
|
||||
CALL sla_DFLTIN(STRING,NA,DRESLT,J1A)
|
||||
|
||||
* Proceed only if pointer still within string
|
||||
IF (NA.GE.1.AND.NA.LE.LENSTR) THEN
|
||||
|
||||
* See if DFLTIN reported a null field
|
||||
IF (J1A.EQ.1) THEN
|
||||
|
||||
* It did: examine character it stuck on
|
||||
C=STRING(NA:NA)
|
||||
IF (C.EQ.'B'.OR.C.EQ.'b') THEN
|
||||
* 'B' - provisionally note
|
||||
J2A=1
|
||||
ELSE IF (C.EQ.'J'.OR.C.EQ.'j') THEN
|
||||
* 'J' - provisionally note
|
||||
J2A=2
|
||||
END IF
|
||||
|
||||
* Following B or J, attempt to decode a number
|
||||
IF (J2A.EQ.1.OR.J2A.EQ.2) THEN
|
||||
NB=NA+1
|
||||
CALL sla_DFLTIN(STRING,NB,DRESLT,J1B)
|
||||
|
||||
* If successful, copy pointer and status
|
||||
IF (J1B.LE.0) THEN
|
||||
NA=NB
|
||||
J1A=J1B
|
||||
* If not, forget about the B or J
|
||||
ELSE
|
||||
J2A=0
|
||||
END IF
|
||||
|
||||
END IF
|
||||
|
||||
END IF
|
||||
|
||||
END IF
|
||||
|
||||
* Return argument values and exit
|
||||
NSTRT=NA
|
||||
J1=J1A
|
||||
J2=J2A
|
||||
|
||||
END
|
||||
99
slalib/dc62s.f
Normal file
99
slalib/dc62s.f
Normal file
@ -0,0 +1,99 @@
|
||||
SUBROUTINE sla_DC62S (V, A, B, R, AD, BD, RD)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D C 6 2 S
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of position & velocity in Cartesian coordinates
|
||||
* to spherical coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V d(6) Cartesian position & velocity vector
|
||||
*
|
||||
* Returned:
|
||||
* A d longitude (radians)
|
||||
* B d latitude (radians)
|
||||
* R d radial coordinate
|
||||
* AD d longitude derivative (radians per unit time)
|
||||
* BD d latitude derivative (radians per unit time)
|
||||
* RD d radial derivative
|
||||
*
|
||||
* P.T.Wallace Starlink 28 April 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V(6),A,B,R,AD,BD,RD
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,XD,YD,ZD,RXY2,RXY,R2,XYP
|
||||
|
||||
|
||||
|
||||
* Components of position/velocity vector
|
||||
X=V(1)
|
||||
Y=V(2)
|
||||
Z=V(3)
|
||||
XD=V(4)
|
||||
YD=V(5)
|
||||
ZD=V(6)
|
||||
|
||||
* Component of R in XY plane squared
|
||||
RXY2=X*X+Y*Y
|
||||
|
||||
* Modulus squared
|
||||
R2=RXY2+Z*Z
|
||||
|
||||
* Protection against null vector
|
||||
IF (R2.EQ.0D0) THEN
|
||||
X=XD
|
||||
Y=YD
|
||||
Z=ZD
|
||||
RXY2=X*X+Y*Y
|
||||
R2=RXY2+Z*Z
|
||||
END IF
|
||||
|
||||
* Position and velocity in spherical coordinates
|
||||
RXY=SQRT(RXY2)
|
||||
XYP=X*XD+Y*YD
|
||||
IF (RXY2.NE.0D0) THEN
|
||||
A=ATAN2(Y,X)
|
||||
B=ATAN2(Z,RXY)
|
||||
AD=(X*YD-Y*XD)/RXY2
|
||||
BD=(ZD*RXY2-Z*XYP)/(R2*RXY)
|
||||
ELSE
|
||||
A=0D0
|
||||
IF (Z.NE.0D0) THEN
|
||||
B=ATAN2(Z,RXY)
|
||||
ELSE
|
||||
B=0D0
|
||||
END IF
|
||||
AD=0D0
|
||||
BD=0D0
|
||||
END IF
|
||||
R=SQRT(R2)
|
||||
IF (R.NE.0D0) THEN
|
||||
RD=(XYP+Z*ZD)/R
|
||||
ELSE
|
||||
RD=0D0
|
||||
END IF
|
||||
|
||||
END
|
||||
69
slalib/dcc2s.f
Normal file
69
slalib/dcc2s.f
Normal file
@ -0,0 +1,69 @@
|
||||
SUBROUTINE sla_DCC2S (V, A, B)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D C C 2 S
|
||||
* - - - - - -
|
||||
*
|
||||
* Cartesian to spherical coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V d(3) x,y,z vector
|
||||
*
|
||||
* Returned:
|
||||
* A,B d spherical coordinates in radians
|
||||
*
|
||||
* The spherical coordinates are longitude (+ve anticlockwise looking
|
||||
* from the +ve latitude pole) and latitude. The Cartesian coordinates
|
||||
* are right handed, with the x axis at zero longitude and latitude, and
|
||||
* the z axis at the +ve latitude pole.
|
||||
*
|
||||
* If V is null, zero A and B are returned. At either pole, zero A is
|
||||
* returned.
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V(3),A,B
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,R
|
||||
|
||||
|
||||
X = V(1)
|
||||
Y = V(2)
|
||||
Z = V(3)
|
||||
R = SQRT(X*X+Y*Y)
|
||||
|
||||
IF (R.EQ.0D0) THEN
|
||||
A = 0D0
|
||||
ELSE
|
||||
A = ATAN2(Y,X)
|
||||
END IF
|
||||
|
||||
IF (Z.EQ.0D0) THEN
|
||||
B = 0D0
|
||||
ELSE
|
||||
B = ATAN2(Z,R)
|
||||
END IF
|
||||
|
||||
END
|
||||
159
slalib/dcmpf.f
Normal file
159
slalib/dcmpf.f
Normal file
@ -0,0 +1,159 @@
|
||||
SUBROUTINE sla_DCMPF (COEFFS,XZ,YZ,XS,YS,PERP,ORIENT)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D C M P F
|
||||
* - - - - - -
|
||||
*
|
||||
* Decompose an [X,Y] linear fit into its constituent parameters:
|
||||
* zero points, scales, nonperpendicularity and orientation.
|
||||
*
|
||||
* Given:
|
||||
* COEFFS d(6) transformation coefficients (see note)
|
||||
*
|
||||
* Returned:
|
||||
* XZ d x zero point
|
||||
* YZ d y zero point
|
||||
* XS d x scale
|
||||
* YS d y scale
|
||||
* PERP d nonperpendicularity (radians)
|
||||
* ORIENT d orientation (radians)
|
||||
*
|
||||
* Called: sla_DRANGE
|
||||
*
|
||||
* The model relates two sets of [X,Y] coordinates as follows.
|
||||
* Naming the elements of COEFFS:
|
||||
*
|
||||
* COEFFS(1) = A
|
||||
* COEFFS(2) = B
|
||||
* COEFFS(3) = C
|
||||
* COEFFS(4) = D
|
||||
* COEFFS(5) = E
|
||||
* COEFFS(6) = F
|
||||
*
|
||||
* the model transforms coordinates [X1,Y1] into coordinates
|
||||
* [X2,Y2] as follows:
|
||||
*
|
||||
* X2 = A + B*X1 + C*Y1
|
||||
* Y2 = D + E*X1 + F*Y1
|
||||
*
|
||||
* The transformation can be decomposed into four steps:
|
||||
*
|
||||
* 1) Zero points:
|
||||
*
|
||||
* x' = XZ + X1
|
||||
* y' = YZ + Y1
|
||||
*
|
||||
* 2) Scales:
|
||||
*
|
||||
* x'' = XS*x'
|
||||
* y'' = YS*y'
|
||||
*
|
||||
* 3) Nonperpendicularity:
|
||||
*
|
||||
* x''' = cos(PERP/2)*x'' + sin(PERP/2)*y''
|
||||
* y''' = sin(PERP/2)*x'' + cos(PERP/2)*y''
|
||||
*
|
||||
* 4) Orientation:
|
||||
*
|
||||
* X2 = cos(ORIENT)*x''' + sin(ORIENT)*y'''
|
||||
* Y2 =-sin(ORIENT)*y''' + cos(ORIENT)*y'''
|
||||
*
|
||||
* See also sla_FITXY, sla_PXY, sla_INVF, sla_XY2XY
|
||||
*
|
||||
* P.T.Wallace Starlink 19 December 2001
|
||||
*
|
||||
* Copyright (C) 2001 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION COEFFS(6),XZ,YZ,XS,YS,PERP,ORIENT
|
||||
|
||||
DOUBLE PRECISION A,B,C,D,E,F,RB2E2,RC2F2,XSC,YSC,P1,P2,P,WS,WC,
|
||||
: OR,HP,SHP,CHP,SOR,COR,DET,X0,Y0,sla_DRANGE
|
||||
|
||||
|
||||
|
||||
* Copy the six coefficients.
|
||||
A = COEFFS(1)
|
||||
B = COEFFS(2)
|
||||
C = COEFFS(3)
|
||||
D = COEFFS(4)
|
||||
E = COEFFS(5)
|
||||
F = COEFFS(6)
|
||||
|
||||
* Scales.
|
||||
RB2E2 = SQRT(B*B+E*E)
|
||||
RC2F2 = SQRT(C*C+F*F)
|
||||
IF (B*F-C*E.GE.0D0) THEN
|
||||
XSC = RB2E2
|
||||
ELSE
|
||||
B = -B
|
||||
E = -E
|
||||
XSC = -RB2E2
|
||||
END IF
|
||||
YSC = RC2F2
|
||||
|
||||
* Non-perpendicularity.
|
||||
IF (C.NE.0D0.OR.F.NE.0D0) THEN
|
||||
P1 = ATAN2(C,F)
|
||||
ELSE
|
||||
P1 = 0D0
|
||||
END IF
|
||||
IF (E.NE.0D0.OR.B.NE.0D0) THEN
|
||||
P2 = ATAN2(E,B)
|
||||
ELSE
|
||||
P2 = 0D0
|
||||
END IF
|
||||
P = sla_DRANGE(P1+P2)
|
||||
|
||||
* Orientation.
|
||||
WS = C*RB2E2-E*RC2F2
|
||||
WC = B*RC2F2+F*RB2E2
|
||||
IF (WS.NE.0D0.OR.WC.NE.0D0) THEN
|
||||
OR = ATAN2(WS,WC)
|
||||
ELSE
|
||||
OR = 0D0
|
||||
END IF
|
||||
|
||||
* Zero points.
|
||||
HP = P/2D0
|
||||
SHP = SIN(HP)
|
||||
CHP = COS(HP)
|
||||
SOR = SIN(OR)
|
||||
COR = COS(OR)
|
||||
DET = XSC*YSC*(CHP+SHP)*(CHP-SHP)
|
||||
IF (ABS(DET).GT.0D0) THEN
|
||||
X0 = YSC*(A*(CHP*COR-SHP*SOR)-D*(CHP*SOR+SHP*COR))/DET
|
||||
Y0 = XSC*(A*(CHP*SOR-SHP*COR)+D*(CHP*COR+SHP*SOR))/DET
|
||||
ELSE
|
||||
X0 = 0D0
|
||||
Y0 = 0D0
|
||||
END IF
|
||||
|
||||
* Results.
|
||||
XZ = X0
|
||||
YZ = Y0
|
||||
XS = XSC
|
||||
YS = YSC
|
||||
PERP = P
|
||||
ORIENT = OR
|
||||
|
||||
END
|
||||
56
slalib/dcs2c.f
Normal file
56
slalib/dcs2c.f
Normal file
@ -0,0 +1,56 @@
|
||||
SUBROUTINE sla_DCS2C (A, B, V)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D C S 2 C
|
||||
* - - - - - -
|
||||
*
|
||||
* Spherical coordinates to direction cosines (double precision)
|
||||
*
|
||||
* Given:
|
||||
* A,B d spherical coordinates in radians
|
||||
* (RA,Dec), (long,lat) etc.
|
||||
*
|
||||
* Returned:
|
||||
* V d(3) x,y,z unit vector
|
||||
*
|
||||
* The spherical coordinates are longitude (+ve anticlockwise looking
|
||||
* from the +ve latitude pole) and latitude. The Cartesian coordinates
|
||||
* are right handed, with the x axis at zero longitude and latitude, and
|
||||
* the z axis at the +ve latitude pole.
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION A,B,V(3)
|
||||
|
||||
DOUBLE PRECISION COSB
|
||||
|
||||
|
||||
COSB = COS(B)
|
||||
|
||||
V(1) = COS(A)*COSB
|
||||
V(2) = SIN(A)*COSB
|
||||
V(3) = SIN(B)
|
||||
|
||||
END
|
||||
106
slalib/dd2tf.f
Normal file
106
slalib/dd2tf.f
Normal file
@ -0,0 +1,106 @@
|
||||
SUBROUTINE sla_DD2TF (NDP, DAYS, SIGN, IHMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D D 2 T F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an interval in days into hours, minutes, seconds
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP i number of decimal places of seconds
|
||||
* DAYS d interval in days
|
||||
*
|
||||
* Returned:
|
||||
* SIGN c '+' or '-'
|
||||
* IHMSF i(4) hours, minutes, seconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size
|
||||
* of DAYS, the format of DOUBLE PRECISION floating-point numbers
|
||||
* on the target machine, and the risk of overflowing IHMSF(4).
|
||||
* On some architectures, for DAYS up to 1D0, the available
|
||||
* floating-point precision corresponds roughly to NDP=12.
|
||||
* However, the practical limit is NDP=9, set by the capacity of
|
||||
* a typical 32-bit IHMSF(4).
|
||||
*
|
||||
* 3) The absolute value of DAYS may exceed 1D0. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where DAYS is very nearly 1D0 and rounds up to 24 hours,
|
||||
* by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
DOUBLE PRECISION DAYS
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IHMSF(4)
|
||||
|
||||
* Days to seconds
|
||||
DOUBLE PRECISION D2S
|
||||
PARAMETER (D2S=86400D0)
|
||||
|
||||
INTEGER NRS,N
|
||||
DOUBLE PRECISION RS,RM,RH,A,AH,AM,AS,AF
|
||||
|
||||
|
||||
|
||||
* Handle sign
|
||||
IF (DAYS.GE.0D0) THEN
|
||||
SIGN='+'
|
||||
ELSE
|
||||
SIGN='-'
|
||||
END IF
|
||||
|
||||
* Field units in terms of least significant figure
|
||||
NRS=1
|
||||
DO N=1,NDP
|
||||
NRS=NRS*10
|
||||
END DO
|
||||
RS=DBLE(NRS)
|
||||
RM=RS*60D0
|
||||
RH=RM*60D0
|
||||
|
||||
* Round interval and express in smallest units required
|
||||
A=ANINT(RS*D2S*ABS(DAYS))
|
||||
|
||||
* Separate into fields
|
||||
AH=AINT(A/RH)
|
||||
A=A-AH*RH
|
||||
AM=AINT(A/RM)
|
||||
A=A-AM*RM
|
||||
AS=AINT(A/RS)
|
||||
AF=A-AS*RS
|
||||
|
||||
* Return results
|
||||
IHMSF(1)=MAX(NINT(AH),0)
|
||||
IHMSF(2)=MAX(MIN(NINT(AM),59),0)
|
||||
IHMSF(3)=MAX(MIN(NINT(AS),59),0)
|
||||
IHMSF(4)=MAX(NINT(MIN(AF,RS-1D0)),0)
|
||||
|
||||
END
|
||||
106
slalib/de2h.f
Normal file
106
slalib/de2h.f
Normal file
@ -0,0 +1,106 @@
|
||||
SUBROUTINE sla_DE2H (HA, DEC, PHI, AZ, EL)
|
||||
*+
|
||||
* - - - - -
|
||||
* D E 2 H
|
||||
* - - - - -
|
||||
*
|
||||
* Equatorial to horizon coordinates: HA,Dec to Az,El
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* HA d hour angle
|
||||
* DEC d declination
|
||||
* PHI d observatory latitude
|
||||
*
|
||||
* Returned:
|
||||
* AZ d azimuth
|
||||
* EL d elevation
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) All the arguments are angles in radians.
|
||||
*
|
||||
* 2) Azimuth is returned in the range 0-2pi; north is zero,
|
||||
* and east is +pi/2. Elevation is returned in the range
|
||||
* +/-pi/2.
|
||||
*
|
||||
* 3) The latitude must be geodetic. In critical applications,
|
||||
* corrections for polar motion should be applied.
|
||||
*
|
||||
* 4) In some applications it will be important to specify the
|
||||
* correct type of hour angle and declination in order to
|
||||
* produce the required type of azimuth and elevation. In
|
||||
* particular, it may be important to distinguish between
|
||||
* elevation as affected by refraction, which would
|
||||
* require the "observed" HA,Dec, and the elevation
|
||||
* in vacuo, which would require the "topocentric" HA,Dec.
|
||||
* If the effects of diurnal aberration can be neglected, the
|
||||
* "apparent" HA,Dec may be used instead of the topocentric
|
||||
* HA,Dec.
|
||||
*
|
||||
* 5) No range checking of arguments is carried out.
|
||||
*
|
||||
* 6) In applications which involve many such calculations, rather
|
||||
* than calling the present routine it will be more efficient to
|
||||
* use inline code, having previously computed fixed terms such
|
||||
* as sine and cosine of latitude, and (for tracking a star)
|
||||
* sine and cosine of declination.
|
||||
*
|
||||
* P.T.Wallace Starlink 9 July 1994
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION HA,DEC,PHI,AZ,EL
|
||||
|
||||
DOUBLE PRECISION D2PI
|
||||
PARAMETER (D2PI=6.283185307179586476925286766559D0)
|
||||
|
||||
DOUBLE PRECISION SH,CH,SD,CD,SP,CP,X,Y,Z,R,A
|
||||
|
||||
|
||||
* Useful trig functions
|
||||
SH=SIN(HA)
|
||||
CH=COS(HA)
|
||||
SD=SIN(DEC)
|
||||
CD=COS(DEC)
|
||||
SP=SIN(PHI)
|
||||
CP=COS(PHI)
|
||||
|
||||
* Az,El as x,y,z
|
||||
X=-CH*CD*SP+SD*CP
|
||||
Y=-SH*CD
|
||||
Z=CH*CD*CP+SD*SP
|
||||
|
||||
* To spherical
|
||||
R=SQRT(X*X+Y*Y)
|
||||
IF (R.EQ.0D0) THEN
|
||||
A=0D0
|
||||
ELSE
|
||||
A=ATAN2(Y,X)
|
||||
END IF
|
||||
IF (A.LT.0D0) A=A+D2PI
|
||||
AZ=A
|
||||
EL=ATAN2(Z,R)
|
||||
|
||||
END
|
||||
180
slalib/deuler.f
Normal file
180
slalib/deuler.f
Normal file
@ -0,0 +1,180 @@
|
||||
SUBROUTINE sla_DEULER (ORDER, PHI, THETA, PSI, RMAT)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D E U L E R
|
||||
* - - - - - - -
|
||||
*
|
||||
* Form a rotation matrix from the Euler angles - three successive
|
||||
* rotations about specified Cartesian axes (double precision)
|
||||
*
|
||||
* Given:
|
||||
* ORDER c*(*) specifies about which axes the rotations occur
|
||||
* PHI d 1st rotation (radians)
|
||||
* THETA d 2nd rotation ( " )
|
||||
* PSI d 3rd rotation ( " )
|
||||
*
|
||||
* Returned:
|
||||
* RMAT d(3,3) rotation matrix
|
||||
*
|
||||
* A rotation is positive when the reference frame rotates
|
||||
* anticlockwise as seen looking towards the origin from the
|
||||
* positive region of the specified axis.
|
||||
*
|
||||
* The characters of ORDER define which axes the three successive
|
||||
* rotations are about. A typical value is 'ZXZ', indicating that
|
||||
* RMAT is to become the direction cosine matrix corresponding to
|
||||
* rotations of the reference frame through PHI radians about the
|
||||
* old Z-axis, followed by THETA radians about the resulting X-axis,
|
||||
* then PSI radians about the resulting Z-axis.
|
||||
*
|
||||
* The axis names can be any of the following, in any order or
|
||||
* combination: X, Y, Z, uppercase or lowercase, 1, 2, 3. Normal
|
||||
* axis labelling/numbering conventions apply; the xyz (=123)
|
||||
* triad is right-handed. Thus, the 'ZXZ' example given above
|
||||
* could be written 'zxz' or '313' (or even 'ZxZ' or '3xZ'). ORDER
|
||||
* is terminated by length or by the first unrecognized character.
|
||||
*
|
||||
* Fewer than three rotations are acceptable, in which case the later
|
||||
* angle arguments are ignored. If all rotations are zero, the
|
||||
* identity matrix is produced.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 May 1997
|
||||
*
|
||||
* Copyright (C) 1997 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) ORDER
|
||||
DOUBLE PRECISION PHI,THETA,PSI,RMAT(3,3)
|
||||
|
||||
INTEGER J,I,L,N,K
|
||||
DOUBLE PRECISION RESULT(3,3),ROTN(3,3),ANGLE,S,C,W,WM(3,3)
|
||||
CHARACTER AXIS
|
||||
|
||||
|
||||
|
||||
* Initialize result matrix
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
IF (I.NE.J) THEN
|
||||
RESULT(I,J) = 0D0
|
||||
ELSE
|
||||
RESULT(I,J) = 1D0
|
||||
END IF
|
||||
END DO
|
||||
END DO
|
||||
|
||||
* Establish length of axis string
|
||||
L = LEN(ORDER)
|
||||
|
||||
* Look at each character of axis string until finished
|
||||
DO N=1,3
|
||||
IF (N.LE.L) THEN
|
||||
|
||||
* Initialize rotation matrix for the current rotation
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
IF (I.NE.J) THEN
|
||||
ROTN(I,J) = 0D0
|
||||
ELSE
|
||||
ROTN(I,J) = 1D0
|
||||
END IF
|
||||
END DO
|
||||
END DO
|
||||
|
||||
* Pick up the appropriate Euler angle and take sine & cosine
|
||||
IF (N.EQ.1) THEN
|
||||
ANGLE = PHI
|
||||
ELSE IF (N.EQ.2) THEN
|
||||
ANGLE = THETA
|
||||
ELSE
|
||||
ANGLE = PSI
|
||||
END IF
|
||||
S = SIN(ANGLE)
|
||||
C = COS(ANGLE)
|
||||
|
||||
* Identify the axis
|
||||
AXIS = ORDER(N:N)
|
||||
IF (AXIS.EQ.'X'.OR.
|
||||
: AXIS.EQ.'x'.OR.
|
||||
: AXIS.EQ.'1') THEN
|
||||
|
||||
* Matrix for x-rotation
|
||||
ROTN(2,2) = C
|
||||
ROTN(2,3) = S
|
||||
ROTN(3,2) = -S
|
||||
ROTN(3,3) = C
|
||||
|
||||
ELSE IF (AXIS.EQ.'Y'.OR.
|
||||
: AXIS.EQ.'y'.OR.
|
||||
: AXIS.EQ.'2') THEN
|
||||
|
||||
* Matrix for y-rotation
|
||||
ROTN(1,1) = C
|
||||
ROTN(1,3) = -S
|
||||
ROTN(3,1) = S
|
||||
ROTN(3,3) = C
|
||||
|
||||
ELSE IF (AXIS.EQ.'Z'.OR.
|
||||
: AXIS.EQ.'z'.OR.
|
||||
: AXIS.EQ.'3') THEN
|
||||
|
||||
* Matrix for z-rotation
|
||||
ROTN(1,1) = C
|
||||
ROTN(1,2) = S
|
||||
ROTN(2,1) = -S
|
||||
ROTN(2,2) = C
|
||||
|
||||
ELSE
|
||||
|
||||
* Unrecognized character - fake end of string
|
||||
L = 0
|
||||
|
||||
END IF
|
||||
|
||||
* Apply the current rotation (matrix ROTN x matrix RESULT)
|
||||
DO I=1,3
|
||||
DO J=1,3
|
||||
W = 0D0
|
||||
DO K=1,3
|
||||
W = W+ROTN(I,K)*RESULT(K,J)
|
||||
END DO
|
||||
WM(I,J) = W
|
||||
END DO
|
||||
END DO
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
RESULT(I,J) = WM(I,J)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
END IF
|
||||
|
||||
END DO
|
||||
|
||||
* Copy the result
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
RMAT(I,J) = RESULT(I,J)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
END
|
||||
297
slalib/dfltin.f
Normal file
297
slalib/dfltin.f
Normal file
@ -0,0 +1,297 @@
|
||||
SUBROUTINE sla_DFLTIN (STRING, NSTRT, DRESLT, JFLAG)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D F L T I N
|
||||
* - - - - - - -
|
||||
*
|
||||
* Convert free-format input into double precision floating point
|
||||
*
|
||||
* Given:
|
||||
* STRING c string containing number to be decoded
|
||||
* NSTRT i pointer to where decoding is to start
|
||||
* DRESLT d current value of result
|
||||
*
|
||||
* Returned:
|
||||
* NSTRT i advanced to next number
|
||||
* DRESLT d result
|
||||
* JFLAG i status: -1 = -OK, 0 = +OK, 1 = null, 2 = error
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The reason DFLTIN has separate OK status values for +
|
||||
* and - is to enable minus zero to be detected. This is
|
||||
* of crucial importance when decoding mixed-radix numbers.
|
||||
* For example, an angle expressed as deg, arcmin, arcsec
|
||||
* may have a leading minus sign but a zero degrees field.
|
||||
*
|
||||
* 2 A TAB is interpreted as a space, and lowercase characters
|
||||
* are interpreted as uppercase.
|
||||
*
|
||||
* 3 The basic format is the sequence of fields #^.^@#^, where
|
||||
* # is a sign character + or -, ^ means a string of decimal
|
||||
* digits, and @, which indicates an exponent, means D or E.
|
||||
* Various combinations of these fields can be omitted, and
|
||||
* embedded blanks are permissible in certain places.
|
||||
*
|
||||
* 4 Spaces:
|
||||
*
|
||||
* . Leading spaces are ignored.
|
||||
*
|
||||
* . Embedded spaces are allowed only after +, -, D or E,
|
||||
* and after the decomal point if the first sequence of
|
||||
* digits is absent.
|
||||
*
|
||||
* . Trailing spaces are ignored; the first signifies
|
||||
* end of decoding and subsequent ones are skipped.
|
||||
*
|
||||
* 5 Delimiters:
|
||||
*
|
||||
* . Any character other than +,-,0-9,.,D,E or space may be
|
||||
* used to signal the end of the number and terminate
|
||||
* decoding.
|
||||
*
|
||||
* . Comma is recognized by DFLTIN as a special case; it
|
||||
* is skipped, leaving the pointer on the next character.
|
||||
* See 13, below.
|
||||
*
|
||||
* 6 Both signs are optional. The default is +.
|
||||
*
|
||||
* 7 The mantissa ^.^ defaults to 1.
|
||||
*
|
||||
* 8 The exponent @#^ defaults to D0.
|
||||
*
|
||||
* 9 The strings of decimal digits may be of any length.
|
||||
*
|
||||
* 10 The decimal point is optional for whole numbers.
|
||||
*
|
||||
* 11 A "null result" occurs when the string of characters being
|
||||
* decoded does not begin with +,-,0-9,.,D or E, or consists
|
||||
* entirely of spaces. When this condition is detected, JFLAG
|
||||
* is set to 1 and DRESLT is left untouched.
|
||||
*
|
||||
* 12 NSTRT = 1 for the first character in the string.
|
||||
*
|
||||
* 13 On return from DFLTIN, NSTRT is set ready for the next
|
||||
* decode - following trailing blanks and any comma. If a
|
||||
* delimiter other than comma is being used, NSTRT must be
|
||||
* incremented before the next call to DFLTIN, otherwise
|
||||
* all subsequent calls will return a null result.
|
||||
*
|
||||
* 14 Errors (JFLAG=2) occur when:
|
||||
*
|
||||
* . a +, -, D or E is left unsatisfied; or
|
||||
*
|
||||
* . the decimal point is present without at least
|
||||
* one decimal digit before or after it; or
|
||||
*
|
||||
* . an exponent more than 100 has been presented.
|
||||
*
|
||||
* 15 When an error has been detected, NSTRT is left
|
||||
* pointing to the character following the last
|
||||
* one used before the error came to light. This
|
||||
* may be after the point at which a more sophisticated
|
||||
* program could have detected the error. For example,
|
||||
* DFLTIN does not detect that '1D999' is unacceptable
|
||||
* (on a computer where this is so) until the entire number
|
||||
* has been decoded.
|
||||
*
|
||||
* 16 Certain highly unlikely combinations of mantissa &
|
||||
* exponent can cause arithmetic faults during the
|
||||
* decode, in some cases despite the fact that they
|
||||
* together could be construed as a valid number.
|
||||
*
|
||||
* 17 Decoding is left to right, one pass.
|
||||
*
|
||||
* 18 See also FLOTIN and INTIN
|
||||
*
|
||||
* Called: sla__IDCHF
|
||||
*
|
||||
* P.T.Wallace Starlink 18 March 1999
|
||||
*
|
||||
* Copyright (C) 1999 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) STRING
|
||||
INTEGER NSTRT
|
||||
DOUBLE PRECISION DRESLT
|
||||
INTEGER JFLAG
|
||||
|
||||
INTEGER NPTR,MSIGN,NEXP,NDP,NVEC,NDIGIT,ISIGNX,J
|
||||
DOUBLE PRECISION DMANT,DIGIT
|
||||
|
||||
|
||||
|
||||
* Current character
|
||||
NPTR=NSTRT
|
||||
|
||||
* Set defaults: mantissa & sign, exponent & sign, decimal place count
|
||||
DMANT=0D0
|
||||
MSIGN=1
|
||||
NEXP=0
|
||||
ISIGNX=1
|
||||
NDP=0
|
||||
|
||||
* Look for sign
|
||||
100 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO ( 400, 100, 800, 500, 300, 200, 9110, 9100, 9110),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Negative
|
||||
200 CONTINUE
|
||||
MSIGN=-1
|
||||
|
||||
* Look for first leading decimal
|
||||
300 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO ( 400, 300, 800, 500, 9200, 9200, 9200, 9200, 9210),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Accept leading decimals
|
||||
400 CONTINUE
|
||||
DMANT=DMANT*1D1+DIGIT
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO ( 400, 1310, 900, 600, 1300, 1300, 1300, 1300, 1310),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Look for decimal when none preceded the point
|
||||
500 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO ( 700, 500, 9200, 9200, 9200, 9200, 9200, 9200, 9210),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Look for trailing decimals
|
||||
600 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO ( 700, 1310, 900, 1300, 1300, 1300, 1300, 1300, 1310),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Accept trailing decimals
|
||||
700 CONTINUE
|
||||
NDP=NDP+1
|
||||
DMANT=DMANT*1D1+DIGIT
|
||||
GO TO 600
|
||||
|
||||
* Exponent symbol first in field: default mantissa to 1
|
||||
800 CONTINUE
|
||||
DMANT=1D0
|
||||
|
||||
* Look for sign of exponent
|
||||
900 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO (1200, 900, 9200, 9200, 1100, 1000, 9200, 9200, 9210),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Exponent negative
|
||||
1000 CONTINUE
|
||||
ISIGNX=-1
|
||||
|
||||
* Look for first digit of exponent
|
||||
1100 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO (1200, 1100, 9200, 9200, 9200, 9200, 9200, 9200, 9210),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Use exponent digit
|
||||
1200 CONTINUE
|
||||
NEXP=NEXP*10+NDIGIT
|
||||
IF (NEXP.GT.100) GO TO 9200
|
||||
|
||||
* Look for subsequent digits of exponent
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO (1200, 1310, 1300, 1300, 1300, 1300, 1300, 1300, 1310),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
* Combine exponent and decimal place count
|
||||
1300 CONTINUE
|
||||
NPTR=NPTR-1
|
||||
1310 CONTINUE
|
||||
NEXP=NEXP*ISIGNX-NDP
|
||||
|
||||
* Skip if net exponent negative
|
||||
IF (NEXP.LT.0) GO TO 1500
|
||||
|
||||
* Positive exponent: scale up
|
||||
1400 CONTINUE
|
||||
IF (NEXP.LT.10) GO TO 1410
|
||||
DMANT=DMANT*1D10
|
||||
NEXP=NEXP-10
|
||||
GO TO 1400
|
||||
1410 CONTINUE
|
||||
IF (NEXP.LT.1) GO TO 1600
|
||||
DMANT=DMANT*1D1
|
||||
NEXP=NEXP-1
|
||||
GO TO 1410
|
||||
|
||||
* Negative exponent: scale down
|
||||
1500 CONTINUE
|
||||
IF (NEXP.GT.-10) GO TO 1510
|
||||
DMANT=DMANT/1D10
|
||||
NEXP=NEXP+10
|
||||
GO TO 1500
|
||||
1510 CONTINUE
|
||||
IF (NEXP.GT.-1) GO TO 1600
|
||||
DMANT=DMANT/1D1
|
||||
NEXP=NEXP+1
|
||||
GO TO 1510
|
||||
|
||||
* Get result & status
|
||||
1600 CONTINUE
|
||||
J=0
|
||||
IF (MSIGN.EQ.1) GO TO 1610
|
||||
J=-1
|
||||
DMANT=-DMANT
|
||||
1610 CONTINUE
|
||||
DRESLT=DMANT
|
||||
|
||||
* Skip to end of field
|
||||
1620 CONTINUE
|
||||
CALL sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
|
||||
GO TO (1720, 1620, 1720, 1720, 1720, 1720, 9900, 1720, 9900),NVEC
|
||||
* 0-9 SP D/E . + - , ELSE END
|
||||
|
||||
1720 CONTINUE
|
||||
NPTR=NPTR-1
|
||||
GO TO 9900
|
||||
|
||||
|
||||
* Exits
|
||||
|
||||
* Null field
|
||||
9100 CONTINUE
|
||||
NPTR=NPTR-1
|
||||
9110 CONTINUE
|
||||
J=1
|
||||
GO TO 9900
|
||||
|
||||
* Errors
|
||||
9200 CONTINUE
|
||||
NPTR=NPTR-1
|
||||
9210 CONTINUE
|
||||
J=2
|
||||
|
||||
* Return
|
||||
9900 CONTINUE
|
||||
NSTRT=NPTR
|
||||
JFLAG=J
|
||||
|
||||
END
|
||||
100
slalib/dh2e.f
Normal file
100
slalib/dh2e.f
Normal file
@ -0,0 +1,100 @@
|
||||
SUBROUTINE sla_DH2E (AZ, EL, PHI, HA, DEC)
|
||||
*+
|
||||
* - - - - -
|
||||
* D E 2 H
|
||||
* - - - - -
|
||||
*
|
||||
* Horizon to equatorial coordinates: Az,El to HA,Dec
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* AZ d azimuth
|
||||
* EL d elevation
|
||||
* PHI d observatory latitude
|
||||
*
|
||||
* Returned:
|
||||
* HA d hour angle
|
||||
* DEC d declination
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) All the arguments are angles in radians.
|
||||
*
|
||||
* 2) The sign convention for azimuth is north zero, east +pi/2.
|
||||
*
|
||||
* 3) HA is returned in the range +/-pi. Declination is returned
|
||||
* in the range +/-pi/2.
|
||||
*
|
||||
* 4) The latitude is (in principle) geodetic. In critical
|
||||
* applications, corrections for polar motion should be applied.
|
||||
*
|
||||
* 5) In some applications it will be important to specify the
|
||||
* correct type of elevation in order to produce the required
|
||||
* type of HA,Dec. In particular, it may be important to
|
||||
* distinguish between the elevation as affected by refraction,
|
||||
* which will yield the "observed" HA,Dec, and the elevation
|
||||
* in vacuo, which will yield the "topocentric" HA,Dec. If the
|
||||
* effects of diurnal aberration can be neglected, the
|
||||
* topocentric HA,Dec may be used as an approximation to the
|
||||
* "apparent" HA,Dec.
|
||||
*
|
||||
* 6) No range checking of arguments is done.
|
||||
*
|
||||
* 7) In applications which involve many such calculations, rather
|
||||
* than calling the present routine it will be more efficient to
|
||||
* use inline code, having previously computed fixed terms such
|
||||
* as sine and cosine of latitude.
|
||||
*
|
||||
* P.T.Wallace Starlink 21 February 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION AZ,EL,PHI,HA,DEC
|
||||
|
||||
DOUBLE PRECISION SA,CA,SE,CE,SP,CP,X,Y,Z,R
|
||||
|
||||
|
||||
* Useful trig functions
|
||||
SA=SIN(AZ)
|
||||
CA=COS(AZ)
|
||||
SE=SIN(EL)
|
||||
CE=COS(EL)
|
||||
SP=SIN(PHI)
|
||||
CP=COS(PHI)
|
||||
|
||||
* HA,Dec as x,y,z
|
||||
X=-CA*CE*SP+SE*CP
|
||||
Y=-SA*CE
|
||||
Z=CA*CE*CP+SE*SP
|
||||
|
||||
* To HA,Dec
|
||||
R=SQRT(X*X+Y*Y)
|
||||
IF (R.EQ.0D0) THEN
|
||||
HA=0D0
|
||||
ELSE
|
||||
HA=ATAN2(Y,X)
|
||||
END IF
|
||||
DEC=ATAN2(Z,R)
|
||||
|
||||
END
|
||||
68
slalib/dimxv.f
Normal file
68
slalib/dimxv.f
Normal file
@ -0,0 +1,68 @@
|
||||
SUBROUTINE sla_DIMXV (DM, VA, VB)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D I M X V
|
||||
* - - - - - -
|
||||
*
|
||||
* Performs the 3-D backward unitary transformation:
|
||||
*
|
||||
* vector VB = (inverse of matrix DM) * vector VA
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* (n.b. the matrix must be unitary, as this routine assumes that
|
||||
* the inverse and transpose are identical)
|
||||
*
|
||||
* Given:
|
||||
* DM dp(3,3) matrix
|
||||
* VA dp(3) vector
|
||||
*
|
||||
* Returned:
|
||||
* VB dp(3) result vector
|
||||
*
|
||||
* P.T.Wallace Starlink March 1986
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DM(3,3),VA(3),VB(3)
|
||||
|
||||
INTEGER I,J
|
||||
DOUBLE PRECISION W,VW(3)
|
||||
|
||||
|
||||
|
||||
* Inverse of matrix DM * vector VA -> vector VW
|
||||
DO J=1,3
|
||||
W=0D0
|
||||
DO I=1,3
|
||||
W=W+DM(I,J)*VA(I)
|
||||
END DO
|
||||
VW(J)=W
|
||||
END DO
|
||||
|
||||
* Vector VW -> vector VB
|
||||
DO J=1,3
|
||||
VB(J)=VW(J)
|
||||
END DO
|
||||
|
||||
END
|
||||
92
slalib/djcal.f
Normal file
92
slalib/djcal.f
Normal file
@ -0,0 +1,92 @@
|
||||
SUBROUTINE sla_DJCAL (NDP, DJM, IYMDF, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D J C A L
|
||||
* - - - - - -
|
||||
*
|
||||
* Modified Julian Date to Gregorian Calendar, expressed
|
||||
* in a form convenient for formatting messages (namely
|
||||
* rounded to a specified precision, and with the fields
|
||||
* stored in a single array)
|
||||
*
|
||||
* Given:
|
||||
* NDP i number of decimal places of days in fraction
|
||||
* DJM d modified Julian Date (JD-2400000.5)
|
||||
*
|
||||
* Returned:
|
||||
* IYMDF i(4) year, month, day, fraction in Gregorian
|
||||
* calendar
|
||||
* J i status: nonzero = out of range
|
||||
*
|
||||
* Any date after 4701BC March 1 is accepted.
|
||||
*
|
||||
* NDP should be 4 or less if internal overflows are to be avoided
|
||||
* on machines which use 32-bit integers.
|
||||
*
|
||||
* The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55).
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
DOUBLE PRECISION DJM
|
||||
INTEGER IYMDF(4),J
|
||||
|
||||
INTEGER NFD
|
||||
DOUBLE PRECISION FD,DF,F,D
|
||||
INTEGER JD,N4,ND10
|
||||
|
||||
|
||||
* Validate.
|
||||
IF ( DJM.LE.-2395520D0 .OR. DJM.GE.1D9 ) THEN
|
||||
J = -1
|
||||
ELSE
|
||||
J = 0
|
||||
|
||||
* Denominator of fraction.
|
||||
NFD = 10**MAX(NDP,0)
|
||||
FD = DBLE(NFD)
|
||||
|
||||
* Round date and express in units of fraction.
|
||||
DF = ANINT(DJM*FD)
|
||||
|
||||
* Separate day and fraction.
|
||||
F = MOD(DF,FD)
|
||||
IF (F.LT.0D0) F = F+FD
|
||||
D = (DF-F)/FD
|
||||
|
||||
* Express day in Gregorian calendar.
|
||||
JD = NINT(D)+2400001
|
||||
|
||||
N4 = 4*(JD+((2*((4*JD-17918)/146097)*3)/4+1)/2-37)
|
||||
ND10 = 10*(MOD(N4-237,1461)/4)+5
|
||||
|
||||
IYMDF(1) = N4/1461-4712
|
||||
IYMDF(2) = MOD(ND10/306+2,12)+1
|
||||
IYMDF(3) = MOD(ND10,306)/10+1
|
||||
IYMDF(4) = NINT(F)
|
||||
|
||||
END IF
|
||||
|
||||
END
|
||||
83
slalib/djcl.f
Normal file
83
slalib/djcl.f
Normal file
@ -0,0 +1,83 @@
|
||||
SUBROUTINE sla_DJCL (DJM, IY, IM, ID, FD, J)
|
||||
*+
|
||||
* - - - - -
|
||||
* D J C L
|
||||
* - - - - -
|
||||
*
|
||||
* Modified Julian Date to Gregorian year, month, day,
|
||||
* and fraction of a day.
|
||||
*
|
||||
* Given:
|
||||
* DJM dp modified Julian Date (JD-2400000.5)
|
||||
*
|
||||
* Returned:
|
||||
* IY int year
|
||||
* IM int month
|
||||
* ID int day
|
||||
* FD dp fraction of day
|
||||
* J int status:
|
||||
* 0 = OK
|
||||
* -1 = unacceptable date (before 4701BC March 1)
|
||||
*
|
||||
* The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55).
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DJM
|
||||
INTEGER IY,IM,ID
|
||||
DOUBLE PRECISION FD
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION F,D
|
||||
INTEGER JD,N4,ND10
|
||||
|
||||
|
||||
* Check if date is acceptable.
|
||||
IF ( DJM.LE.-2395520D0 .OR. DJM.GE.1D9 ) THEN
|
||||
J = -1
|
||||
ELSE
|
||||
J = 0
|
||||
|
||||
* Separate day and fraction.
|
||||
F = MOD(DJM,1D0)
|
||||
IF (F.LT.0D0) F = F+1D0
|
||||
D = ANINT(DJM-F)
|
||||
|
||||
* Express day in Gregorian calendar.
|
||||
JD = NINT(D)+2400001
|
||||
|
||||
N4 = 4*(JD+((6*((4*JD-17918)/146097))/4+1)/2-37)
|
||||
ND10 = 10*(MOD(N4-237,1461)/4)+5
|
||||
|
||||
IY = N4/1461-4712
|
||||
IM = MOD(ND10/306+2,12)+1
|
||||
ID = MOD(ND10,306)/10+1
|
||||
FD = F
|
||||
|
||||
J=0
|
||||
|
||||
END IF
|
||||
|
||||
END
|
||||
74
slalib/dm2av.f
Normal file
74
slalib/dm2av.f
Normal file
@ -0,0 +1,74 @@
|
||||
SUBROUTINE sla_DM2AV (RMAT, AXVEC)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D M 2 A V
|
||||
* - - - - - -
|
||||
*
|
||||
* From a rotation matrix, determine the corresponding axial vector.
|
||||
* (double precision)
|
||||
*
|
||||
* A rotation matrix describes a rotation about some arbitrary axis,
|
||||
* called the Euler axis. The "axial vector" returned by this routine
|
||||
* has the same direction as the Euler axis, and its magnitude is the
|
||||
* amount of rotation in radians. (The magnitude and direction can be
|
||||
* separated by means of the routine sla_DVN.)
|
||||
*
|
||||
* Given:
|
||||
* RMAT d(3,3) rotation matrix
|
||||
*
|
||||
* Returned:
|
||||
* AXVEC d(3) axial vector (radians)
|
||||
*
|
||||
* The reference frame rotates clockwise as seen looking along
|
||||
* the axial vector from the origin.
|
||||
*
|
||||
* If RMAT is null, so is the result.
|
||||
*
|
||||
* Last revision: 26 November 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RMAT(3,3),AXVEC(3)
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,S2,C2,PHI,F
|
||||
|
||||
|
||||
|
||||
X = RMAT(2,3)-RMAT(3,2)
|
||||
Y = RMAT(3,1)-RMAT(1,3)
|
||||
Z = RMAT(1,2)-RMAT(2,1)
|
||||
S2 = SQRT(X*X+Y*Y+Z*Z)
|
||||
IF (S2.NE.0D0) THEN
|
||||
C2 = RMAT(1,1)+RMAT(2,2)+RMAT(3,3)-1D0
|
||||
PHI = ATAN2(S2,C2)
|
||||
F = PHI/S2
|
||||
AXVEC(1) = X*F
|
||||
AXVEC(2) = Y*F
|
||||
AXVEC(3) = Z*F
|
||||
ELSE
|
||||
AXVEC(1) = 0D0
|
||||
AXVEC(2) = 0D0
|
||||
AXVEC(3) = 0D0
|
||||
END IF
|
||||
|
||||
END
|
||||
157
slalib/dmat.f
Normal file
157
slalib/dmat.f
Normal file
@ -0,0 +1,157 @@
|
||||
SUBROUTINE sla_DMAT (N, A, Y, D, JF, IW)
|
||||
*+
|
||||
* - - - - -
|
||||
* D M A T
|
||||
* - - - - -
|
||||
*
|
||||
* Matrix inversion & solution of simultaneous equations
|
||||
* (double precision)
|
||||
*
|
||||
* For the set of n simultaneous equations in n unknowns:
|
||||
* A.Y = X
|
||||
*
|
||||
* where:
|
||||
* A is a non-singular N x N matrix
|
||||
* Y is the vector of N unknowns
|
||||
* X is the known vector
|
||||
*
|
||||
* DMATRX computes:
|
||||
* the inverse of matrix A
|
||||
* the determinant of matrix A
|
||||
* the vector of N unknowns
|
||||
*
|
||||
* Arguments:
|
||||
*
|
||||
* symbol type dimension before after
|
||||
*
|
||||
* N i no. of unknowns unchanged
|
||||
* A d (N,N) matrix inverse
|
||||
* Y d (N) known vector solution vector
|
||||
* D d - determinant
|
||||
* * JF i - singularity flag
|
||||
* IW i (N) - workspace
|
||||
*
|
||||
* * JF is the singularity flag. If the matrix is non-singular, JF=0
|
||||
* is returned. If the matrix is singular, JF=-1 & D=0D0 are
|
||||
* returned. In the latter case, the contents of array A on return
|
||||
* are undefined.
|
||||
*
|
||||
* Algorithm:
|
||||
* Gaussian elimination with partial pivoting.
|
||||
*
|
||||
* Speed:
|
||||
* Very fast.
|
||||
*
|
||||
* Accuracy:
|
||||
* Fairly accurate - errors 1 to 4 times those of routines optimized
|
||||
* for accuracy.
|
||||
*
|
||||
* P.T.Wallace Starlink 4 December 2001
|
||||
*
|
||||
* Copyright (C) 2001 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER N
|
||||
DOUBLE PRECISION A(N,N),Y(N),D
|
||||
INTEGER JF
|
||||
INTEGER IW(N)
|
||||
|
||||
DOUBLE PRECISION SFA
|
||||
PARAMETER (SFA=1D-20)
|
||||
|
||||
INTEGER K,IMX,I,J,NP1MK,KI
|
||||
DOUBLE PRECISION AMX,T,AKK,YK,AIK
|
||||
|
||||
|
||||
JF=0
|
||||
D=1D0
|
||||
DO K=1,N
|
||||
AMX=DABS(A(K,K))
|
||||
IMX=K
|
||||
IF (K.NE.N) THEN
|
||||
DO I=K+1,N
|
||||
T=DABS(A(I,K))
|
||||
IF (T.GT.AMX) THEN
|
||||
AMX=T
|
||||
IMX=I
|
||||
END IF
|
||||
END DO
|
||||
END IF
|
||||
IF (AMX.LT.SFA) THEN
|
||||
JF=-1
|
||||
ELSE
|
||||
IF (IMX.NE.K) THEN
|
||||
DO J=1,N
|
||||
T=A(K,J)
|
||||
A(K,J)=A(IMX,J)
|
||||
A(IMX,J)=T
|
||||
END DO
|
||||
T=Y(K)
|
||||
Y(K)=Y(IMX)
|
||||
Y(IMX)=T
|
||||
D=-D
|
||||
END IF
|
||||
IW(K)=IMX
|
||||
AKK=A(K,K)
|
||||
D=D*AKK
|
||||
IF (DABS(D).LT.SFA) THEN
|
||||
JF=-1
|
||||
ELSE
|
||||
AKK=1D0/AKK
|
||||
A(K,K)=AKK
|
||||
DO J=1,N
|
||||
IF (J.NE.K) A(K,J)=A(K,J)*AKK
|
||||
END DO
|
||||
YK=Y(K)*AKK
|
||||
Y(K)=YK
|
||||
DO I=1,N
|
||||
AIK=A(I,K)
|
||||
IF (I.NE.K) THEN
|
||||
DO J=1,N
|
||||
IF (J.NE.K) A(I,J)=A(I,J)-AIK*A(K,J)
|
||||
END DO
|
||||
Y(I)=Y(I)-AIK*YK
|
||||
END IF
|
||||
END DO
|
||||
DO I=1,N
|
||||
IF (I.NE.K) A(I,K)=-A(I,K)*AKK
|
||||
END DO
|
||||
END IF
|
||||
END IF
|
||||
END DO
|
||||
IF (JF.NE.0) THEN
|
||||
D=0D0
|
||||
ELSE
|
||||
DO K=1,N
|
||||
NP1MK=N+1-K
|
||||
KI=IW(NP1MK)
|
||||
IF (NP1MK.NE.KI) THEN
|
||||
DO I=1,N
|
||||
T=A(I,NP1MK)
|
||||
A(I,NP1MK)=A(I,KI)
|
||||
A(I,KI)=T
|
||||
END DO
|
||||
END IF
|
||||
END DO
|
||||
END IF
|
||||
|
||||
END
|
||||
658
slalib/dmoon.f
Normal file
658
slalib/dmoon.f
Normal file
@ -0,0 +1,658 @@
|
||||
SUBROUTINE sla_DMOON (DATE, PV)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D M O O N
|
||||
* - - - - - -
|
||||
*
|
||||
* Approximate geocentric position and velocity of the Moon
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DATE D TDB (loosely ET) as a Modified Julian Date
|
||||
* (JD-2400000.5)
|
||||
*
|
||||
* Returned:
|
||||
* PV D(6) Moon x,y,z,xdot,ydot,zdot, mean equator and
|
||||
* equinox of date (AU, AU/s)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 This routine is a full implementation of the algorithm
|
||||
* published by Meeus (see reference).
|
||||
*
|
||||
* 2 Meeus quotes accuracies of 10 arcsec in longitude, 3 arcsec in
|
||||
* latitude and 0.2 arcsec in HP (equivalent to about 20 km in
|
||||
* distance). Comparison with JPL DE200 over the interval
|
||||
* 1960-2025 gives RMS errors of 3.7 arcsec and 83 mas/hour in
|
||||
* longitude, 2.3 arcsec and 48 mas/hour in latitude, 11 km
|
||||
* and 81 mm/s in distance. The maximum errors over the same
|
||||
* interval are 18 arcsec and 0.50 arcsec/hour in longitude,
|
||||
* 11 arcsec and 0.24 arcsec/hour in latitude, 40 km and 0.29 m/s
|
||||
* in distance.
|
||||
*
|
||||
* 3 The original algorithm is expressed in terms of the obsolete
|
||||
* timescale Ephemeris Time. Either TDB or TT can be used, but
|
||||
* not UT without incurring significant errors (30 arcsec at
|
||||
* the present time) due to the Moon's 0.5 arcsec/sec movement.
|
||||
*
|
||||
* 4 The algorithm is based on pre IAU 1976 standards. However,
|
||||
* the result has been moved onto the new (FK5) equinox, an
|
||||
* adjustment which is in any case much smaller than the
|
||||
* intrinsic accuracy of the procedure.
|
||||
*
|
||||
* 5 Velocity is obtained by a complete analytical differentiation
|
||||
* of the Meeus model.
|
||||
*
|
||||
* Reference:
|
||||
* Meeus, l'Astronomie, June 1984, p348.
|
||||
*
|
||||
* P.T.Wallace Starlink 22 January 1998
|
||||
*
|
||||
* Copyright (C) 1998 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE,PV(6)
|
||||
|
||||
* Degrees, arcseconds and seconds of time to radians
|
||||
DOUBLE PRECISION D2R,DAS2R,DS2R
|
||||
PARAMETER (D2R=0.0174532925199432957692369D0,
|
||||
: DAS2R=4.848136811095359935899141D-6,
|
||||
: DS2R=7.272205216643039903848712D-5)
|
||||
|
||||
* Seconds per Julian century (86400*36525)
|
||||
DOUBLE PRECISION CJ
|
||||
PARAMETER (CJ=3155760000D0)
|
||||
|
||||
* Julian epoch of B1950
|
||||
DOUBLE PRECISION B1950
|
||||
PARAMETER (B1950=1949.9997904423D0)
|
||||
|
||||
* Earth equatorial radius in AU ( = 6378.137 / 149597870 )
|
||||
DOUBLE PRECISION ERADAU
|
||||
PARAMETER (ERADAU=4.2635212653763D-5)
|
||||
|
||||
DOUBLE PRECISION T,THETA,SINOM,COSOM,DOMCOM,WA,DWA,WB,DWB,WOM,
|
||||
: DWOM,SINWOM,COSWOM,V,DV,COEFF,EMN,EMPN,DN,FN,EN,
|
||||
: DEN,DTHETA,FTHETA,EL,DEL,B,DB,BF,DBF,P,DP,SP,R,
|
||||
: DR,X,Y,Z,XD,YD,ZD,SEL,CEL,SB,CB,RCB,RBD,W,EPJ,
|
||||
: EQCOR,EPS,SINEPS,COSEPS,ES,EC
|
||||
INTEGER N,I
|
||||
|
||||
*
|
||||
* Coefficients for fundamental arguments
|
||||
*
|
||||
* at J1900: T**0, T**1, T**2, T**3
|
||||
* at epoch: T**0, T**1
|
||||
*
|
||||
* Units are degrees for position and Julian centuries for time
|
||||
*
|
||||
|
||||
* Moon's mean longitude
|
||||
DOUBLE PRECISION ELP0,ELP1,ELP2,ELP3,ELP,DELP
|
||||
PARAMETER (ELP0=270.434164D0,
|
||||
: ELP1=481267.8831D0,
|
||||
: ELP2=-0.001133D0,
|
||||
: ELP3=0.0000019D0)
|
||||
|
||||
* Sun's mean anomaly
|
||||
DOUBLE PRECISION EM0,EM1,EM2,EM3,EM,DEM
|
||||
PARAMETER (EM0=358.475833D0,
|
||||
: EM1=35999.0498D0,
|
||||
: EM2=-0.000150D0,
|
||||
: EM3=-0.0000033D0)
|
||||
|
||||
* Moon's mean anomaly
|
||||
DOUBLE PRECISION EMP0,EMP1,EMP2,EMP3,EMP,DEMP
|
||||
PARAMETER (EMP0=296.104608D0,
|
||||
: EMP1=477198.8491D0,
|
||||
: EMP2=0.009192D0,
|
||||
: EMP3=0.0000144D0)
|
||||
|
||||
* Moon's mean elongation
|
||||
DOUBLE PRECISION D0,D1,D2,D3,D,DD
|
||||
PARAMETER (D0=350.737486D0,
|
||||
: D1=445267.1142D0,
|
||||
: D2=-0.001436D0,
|
||||
: D3=0.0000019D0)
|
||||
|
||||
* Mean distance of the Moon from its ascending node
|
||||
DOUBLE PRECISION F0,F1,F2,F3,F,DF
|
||||
PARAMETER (F0=11.250889D0,
|
||||
: F1=483202.0251D0,
|
||||
: F2=-0.003211D0,
|
||||
: F3=-0.0000003D0)
|
||||
|
||||
* Longitude of the Moon's ascending node
|
||||
DOUBLE PRECISION OM0,OM1,OM2,OM3,OM,DOM
|
||||
PARAMETER (OM0=259.183275D0,
|
||||
: OM1=-1934.1420D0,
|
||||
: OM2=0.002078D0,
|
||||
: OM3=0.0000022D0)
|
||||
|
||||
* Coefficients for (dimensionless) E factor
|
||||
DOUBLE PRECISION E1,E2,E,DE,ESQ,DESQ
|
||||
PARAMETER (E1=-0.002495D0,E2=-0.00000752D0)
|
||||
|
||||
* Coefficients for periodic variations etc
|
||||
DOUBLE PRECISION PAC,PA0,PA1
|
||||
PARAMETER (PAC=0.000233D0,PA0=51.2D0,PA1=20.2D0)
|
||||
DOUBLE PRECISION PBC
|
||||
PARAMETER (PBC=-0.001778D0)
|
||||
DOUBLE PRECISION PCC
|
||||
PARAMETER (PCC=0.000817D0)
|
||||
DOUBLE PRECISION PDC
|
||||
PARAMETER (PDC=0.002011D0)
|
||||
DOUBLE PRECISION PEC,PE0,PE1,PE2
|
||||
PARAMETER (PEC=0.003964D0,
|
||||
: PE0=346.560D0,PE1=132.870D0,PE2=-0.0091731D0)
|
||||
DOUBLE PRECISION PFC
|
||||
PARAMETER (PFC=0.001964D0)
|
||||
DOUBLE PRECISION PGC
|
||||
PARAMETER (PGC=0.002541D0)
|
||||
DOUBLE PRECISION PHC
|
||||
PARAMETER (PHC=0.001964D0)
|
||||
DOUBLE PRECISION PIC
|
||||
PARAMETER (PIC=-0.024691D0)
|
||||
DOUBLE PRECISION PJC,PJ0,PJ1
|
||||
PARAMETER (PJC=-0.004328D0,PJ0=275.05D0,PJ1=-2.30D0)
|
||||
DOUBLE PRECISION CW1
|
||||
PARAMETER (CW1=0.0004664D0)
|
||||
DOUBLE PRECISION CW2
|
||||
PARAMETER (CW2=0.0000754D0)
|
||||
|
||||
*
|
||||
* Coefficients for Moon position
|
||||
*
|
||||
* Tx(N) = coefficient of L, B or P term (deg)
|
||||
* ITx(N,1-5) = coefficients of M, M', D, F, E**n in argument
|
||||
*
|
||||
INTEGER NL,NB,NP
|
||||
PARAMETER (NL=50,NB=45,NP=31)
|
||||
DOUBLE PRECISION TL(NL),TB(NB),TP(NP)
|
||||
INTEGER ITL(5,NL),ITB(5,NB),ITP(5,NP)
|
||||
*
|
||||
* Longitude
|
||||
* M M' D F n
|
||||
DATA TL( 1)/ +6.288750D0 /,
|
||||
: (ITL(I, 1),I=1,5)/ +0, +1, +0, +0, 0 /
|
||||
DATA TL( 2)/ +1.274018D0 /,
|
||||
: (ITL(I, 2),I=1,5)/ +0, -1, +2, +0, 0 /
|
||||
DATA TL( 3)/ +0.658309D0 /,
|
||||
: (ITL(I, 3),I=1,5)/ +0, +0, +2, +0, 0 /
|
||||
DATA TL( 4)/ +0.213616D0 /,
|
||||
: (ITL(I, 4),I=1,5)/ +0, +2, +0, +0, 0 /
|
||||
DATA TL( 5)/ -0.185596D0 /,
|
||||
: (ITL(I, 5),I=1,5)/ +1, +0, +0, +0, 1 /
|
||||
DATA TL( 6)/ -0.114336D0 /,
|
||||
: (ITL(I, 6),I=1,5)/ +0, +0, +0, +2, 0 /
|
||||
DATA TL( 7)/ +0.058793D0 /,
|
||||
: (ITL(I, 7),I=1,5)/ +0, -2, +2, +0, 0 /
|
||||
DATA TL( 8)/ +0.057212D0 /,
|
||||
: (ITL(I, 8),I=1,5)/ -1, -1, +2, +0, 1 /
|
||||
DATA TL( 9)/ +0.053320D0 /,
|
||||
: (ITL(I, 9),I=1,5)/ +0, +1, +2, +0, 0 /
|
||||
DATA TL(10)/ +0.045874D0 /,
|
||||
: (ITL(I,10),I=1,5)/ -1, +0, +2, +0, 1 /
|
||||
DATA TL(11)/ +0.041024D0 /,
|
||||
: (ITL(I,11),I=1,5)/ -1, +1, +0, +0, 1 /
|
||||
DATA TL(12)/ -0.034718D0 /,
|
||||
: (ITL(I,12),I=1,5)/ +0, +0, +1, +0, 0 /
|
||||
DATA TL(13)/ -0.030465D0 /,
|
||||
: (ITL(I,13),I=1,5)/ +1, +1, +0, +0, 1 /
|
||||
DATA TL(14)/ +0.015326D0 /,
|
||||
: (ITL(I,14),I=1,5)/ +0, +0, +2, -2, 0 /
|
||||
DATA TL(15)/ -0.012528D0 /,
|
||||
: (ITL(I,15),I=1,5)/ +0, +1, +0, +2, 0 /
|
||||
DATA TL(16)/ -0.010980D0 /,
|
||||
: (ITL(I,16),I=1,5)/ +0, -1, +0, +2, 0 /
|
||||
DATA TL(17)/ +0.010674D0 /,
|
||||
: (ITL(I,17),I=1,5)/ +0, -1, +4, +0, 0 /
|
||||
DATA TL(18)/ +0.010034D0 /,
|
||||
: (ITL(I,18),I=1,5)/ +0, +3, +0, +0, 0 /
|
||||
DATA TL(19)/ +0.008548D0 /,
|
||||
: (ITL(I,19),I=1,5)/ +0, -2, +4, +0, 0 /
|
||||
DATA TL(20)/ -0.007910D0 /,
|
||||
: (ITL(I,20),I=1,5)/ +1, -1, +2, +0, 1 /
|
||||
DATA TL(21)/ -0.006783D0 /,
|
||||
: (ITL(I,21),I=1,5)/ +1, +0, +2, +0, 1 /
|
||||
DATA TL(22)/ +0.005162D0 /,
|
||||
: (ITL(I,22),I=1,5)/ +0, +1, -1, +0, 0 /
|
||||
DATA TL(23)/ +0.005000D0 /,
|
||||
: (ITL(I,23),I=1,5)/ +1, +0, +1, +0, 1 /
|
||||
DATA TL(24)/ +0.004049D0 /,
|
||||
: (ITL(I,24),I=1,5)/ -1, +1, +2, +0, 1 /
|
||||
DATA TL(25)/ +0.003996D0 /,
|
||||
: (ITL(I,25),I=1,5)/ +0, +2, +2, +0, 0 /
|
||||
DATA TL(26)/ +0.003862D0 /,
|
||||
: (ITL(I,26),I=1,5)/ +0, +0, +4, +0, 0 /
|
||||
DATA TL(27)/ +0.003665D0 /,
|
||||
: (ITL(I,27),I=1,5)/ +0, -3, +2, +0, 0 /
|
||||
DATA TL(28)/ +0.002695D0 /,
|
||||
: (ITL(I,28),I=1,5)/ -1, +2, +0, +0, 1 /
|
||||
DATA TL(29)/ +0.002602D0 /,
|
||||
: (ITL(I,29),I=1,5)/ +0, +1, -2, -2, 0 /
|
||||
DATA TL(30)/ +0.002396D0 /,
|
||||
: (ITL(I,30),I=1,5)/ -1, -2, +2, +0, 1 /
|
||||
DATA TL(31)/ -0.002349D0 /,
|
||||
: (ITL(I,31),I=1,5)/ +0, +1, +1, +0, 0 /
|
||||
DATA TL(32)/ +0.002249D0 /,
|
||||
: (ITL(I,32),I=1,5)/ -2, +0, +2, +0, 2 /
|
||||
DATA TL(33)/ -0.002125D0 /,
|
||||
: (ITL(I,33),I=1,5)/ +1, +2, +0, +0, 1 /
|
||||
DATA TL(34)/ -0.002079D0 /,
|
||||
: (ITL(I,34),I=1,5)/ +2, +0, +0, +0, 2 /
|
||||
DATA TL(35)/ +0.002059D0 /,
|
||||
: (ITL(I,35),I=1,5)/ -2, -1, +2, +0, 2 /
|
||||
DATA TL(36)/ -0.001773D0 /,
|
||||
: (ITL(I,36),I=1,5)/ +0, +1, +2, -2, 0 /
|
||||
DATA TL(37)/ -0.001595D0 /,
|
||||
: (ITL(I,37),I=1,5)/ +0, +0, +2, +2, 0 /
|
||||
DATA TL(38)/ +0.001220D0 /,
|
||||
: (ITL(I,38),I=1,5)/ -1, -1, +4, +0, 1 /
|
||||
DATA TL(39)/ -0.001110D0 /,
|
||||
: (ITL(I,39),I=1,5)/ +0, +2, +0, +2, 0 /
|
||||
DATA TL(40)/ +0.000892D0 /,
|
||||
: (ITL(I,40),I=1,5)/ +0, +1, -3, +0, 0 /
|
||||
DATA TL(41)/ -0.000811D0 /,
|
||||
: (ITL(I,41),I=1,5)/ +1, +1, +2, +0, 1 /
|
||||
DATA TL(42)/ +0.000761D0 /,
|
||||
: (ITL(I,42),I=1,5)/ -1, -2, +4, +0, 1 /
|
||||
DATA TL(43)/ +0.000717D0 /,
|
||||
: (ITL(I,43),I=1,5)/ -2, +1, +0, +0, 2 /
|
||||
DATA TL(44)/ +0.000704D0 /,
|
||||
: (ITL(I,44),I=1,5)/ -2, +1, -2, +0, 2 /
|
||||
DATA TL(45)/ +0.000693D0 /,
|
||||
: (ITL(I,45),I=1,5)/ +1, -2, +2, +0, 1 /
|
||||
DATA TL(46)/ +0.000598D0 /,
|
||||
: (ITL(I,46),I=1,5)/ -1, +0, +2, -2, 1 /
|
||||
DATA TL(47)/ +0.000550D0 /,
|
||||
: (ITL(I,47),I=1,5)/ +0, +1, +4, +0, 0 /
|
||||
DATA TL(48)/ +0.000538D0 /,
|
||||
: (ITL(I,48),I=1,5)/ +0, +4, +0, +0, 0 /
|
||||
DATA TL(49)/ +0.000521D0 /,
|
||||
: (ITL(I,49),I=1,5)/ -1, +0, +4, +0, 1 /
|
||||
DATA TL(50)/ +0.000486D0 /,
|
||||
: (ITL(I,50),I=1,5)/ +0, +2, -1, +0, 0 /
|
||||
*
|
||||
* Latitude
|
||||
* M M' D F n
|
||||
DATA TB( 1)/ +5.128189D0 /,
|
||||
: (ITB(I, 1),I=1,5)/ +0, +0, +0, +1, 0 /
|
||||
DATA TB( 2)/ +0.280606D0 /,
|
||||
: (ITB(I, 2),I=1,5)/ +0, +1, +0, +1, 0 /
|
||||
DATA TB( 3)/ +0.277693D0 /,
|
||||
: (ITB(I, 3),I=1,5)/ +0, +1, +0, -1, 0 /
|
||||
DATA TB( 4)/ +0.173238D0 /,
|
||||
: (ITB(I, 4),I=1,5)/ +0, +0, +2, -1, 0 /
|
||||
DATA TB( 5)/ +0.055413D0 /,
|
||||
: (ITB(I, 5),I=1,5)/ +0, -1, +2, +1, 0 /
|
||||
DATA TB( 6)/ +0.046272D0 /,
|
||||
: (ITB(I, 6),I=1,5)/ +0, -1, +2, -1, 0 /
|
||||
DATA TB( 7)/ +0.032573D0 /,
|
||||
: (ITB(I, 7),I=1,5)/ +0, +0, +2, +1, 0 /
|
||||
DATA TB( 8)/ +0.017198D0 /,
|
||||
: (ITB(I, 8),I=1,5)/ +0, +2, +0, +1, 0 /
|
||||
DATA TB( 9)/ +0.009267D0 /,
|
||||
: (ITB(I, 9),I=1,5)/ +0, +1, +2, -1, 0 /
|
||||
DATA TB(10)/ +0.008823D0 /,
|
||||
: (ITB(I,10),I=1,5)/ +0, +2, +0, -1, 0 /
|
||||
DATA TB(11)/ +0.008247D0 /,
|
||||
: (ITB(I,11),I=1,5)/ -1, +0, +2, -1, 1 /
|
||||
DATA TB(12)/ +0.004323D0 /,
|
||||
: (ITB(I,12),I=1,5)/ +0, -2, +2, -1, 0 /
|
||||
DATA TB(13)/ +0.004200D0 /,
|
||||
: (ITB(I,13),I=1,5)/ +0, +1, +2, +1, 0 /
|
||||
DATA TB(14)/ +0.003372D0 /,
|
||||
: (ITB(I,14),I=1,5)/ -1, +0, -2, +1, 1 /
|
||||
DATA TB(15)/ +0.002472D0 /,
|
||||
: (ITB(I,15),I=1,5)/ -1, -1, +2, +1, 1 /
|
||||
DATA TB(16)/ +0.002222D0 /,
|
||||
: (ITB(I,16),I=1,5)/ -1, +0, +2, +1, 1 /
|
||||
DATA TB(17)/ +0.002072D0 /,
|
||||
: (ITB(I,17),I=1,5)/ -1, -1, +2, -1, 1 /
|
||||
DATA TB(18)/ +0.001877D0 /,
|
||||
: (ITB(I,18),I=1,5)/ -1, +1, +0, +1, 1 /
|
||||
DATA TB(19)/ +0.001828D0 /,
|
||||
: (ITB(I,19),I=1,5)/ +0, -1, +4, -1, 0 /
|
||||
DATA TB(20)/ -0.001803D0 /,
|
||||
: (ITB(I,20),I=1,5)/ +1, +0, +0, +1, 1 /
|
||||
DATA TB(21)/ -0.001750D0 /,
|
||||
: (ITB(I,21),I=1,5)/ +0, +0, +0, +3, 0 /
|
||||
DATA TB(22)/ +0.001570D0 /,
|
||||
: (ITB(I,22),I=1,5)/ -1, +1, +0, -1, 1 /
|
||||
DATA TB(23)/ -0.001487D0 /,
|
||||
: (ITB(I,23),I=1,5)/ +0, +0, +1, +1, 0 /
|
||||
DATA TB(24)/ -0.001481D0 /,
|
||||
: (ITB(I,24),I=1,5)/ +1, +1, +0, +1, 1 /
|
||||
DATA TB(25)/ +0.001417D0 /,
|
||||
: (ITB(I,25),I=1,5)/ -1, -1, +0, +1, 1 /
|
||||
DATA TB(26)/ +0.001350D0 /,
|
||||
: (ITB(I,26),I=1,5)/ -1, +0, +0, +1, 1 /
|
||||
DATA TB(27)/ +0.001330D0 /,
|
||||
: (ITB(I,27),I=1,5)/ +0, +0, -1, +1, 0 /
|
||||
DATA TB(28)/ +0.001106D0 /,
|
||||
: (ITB(I,28),I=1,5)/ +0, +3, +0, +1, 0 /
|
||||
DATA TB(29)/ +0.001020D0 /,
|
||||
: (ITB(I,29),I=1,5)/ +0, +0, +4, -1, 0 /
|
||||
DATA TB(30)/ +0.000833D0 /,
|
||||
: (ITB(I,30),I=1,5)/ +0, -1, +4, +1, 0 /
|
||||
DATA TB(31)/ +0.000781D0 /,
|
||||
: (ITB(I,31),I=1,5)/ +0, +1, +0, -3, 0 /
|
||||
DATA TB(32)/ +0.000670D0 /,
|
||||
: (ITB(I,32),I=1,5)/ +0, -2, +4, +1, 0 /
|
||||
DATA TB(33)/ +0.000606D0 /,
|
||||
: (ITB(I,33),I=1,5)/ +0, +0, +2, -3, 0 /
|
||||
DATA TB(34)/ +0.000597D0 /,
|
||||
: (ITB(I,34),I=1,5)/ +0, +2, +2, -1, 0 /
|
||||
DATA TB(35)/ +0.000492D0 /,
|
||||
: (ITB(I,35),I=1,5)/ -1, +1, +2, -1, 1 /
|
||||
DATA TB(36)/ +0.000450D0 /,
|
||||
: (ITB(I,36),I=1,5)/ +0, +2, -2, -1, 0 /
|
||||
DATA TB(37)/ +0.000439D0 /,
|
||||
: (ITB(I,37),I=1,5)/ +0, +3, +0, -1, 0 /
|
||||
DATA TB(38)/ +0.000423D0 /,
|
||||
: (ITB(I,38),I=1,5)/ +0, +2, +2, +1, 0 /
|
||||
DATA TB(39)/ +0.000422D0 /,
|
||||
: (ITB(I,39),I=1,5)/ +0, -3, +2, -1, 0 /
|
||||
DATA TB(40)/ -0.000367D0 /,
|
||||
: (ITB(I,40),I=1,5)/ +1, -1, +2, +1, 1 /
|
||||
DATA TB(41)/ -0.000353D0 /,
|
||||
: (ITB(I,41),I=1,5)/ +1, +0, +2, +1, 1 /
|
||||
DATA TB(42)/ +0.000331D0 /,
|
||||
: (ITB(I,42),I=1,5)/ +0, +0, +4, +1, 0 /
|
||||
DATA TB(43)/ +0.000317D0 /,
|
||||
: (ITB(I,43),I=1,5)/ -1, +1, +2, +1, 1 /
|
||||
DATA TB(44)/ +0.000306D0 /,
|
||||
: (ITB(I,44),I=1,5)/ -2, +0, +2, -1, 2 /
|
||||
DATA TB(45)/ -0.000283D0 /,
|
||||
: (ITB(I,45),I=1,5)/ +0, +1, +0, +3, 0 /
|
||||
*
|
||||
* Parallax
|
||||
* M M' D F n
|
||||
DATA TP( 1)/ +0.950724D0 /,
|
||||
: (ITP(I, 1),I=1,5)/ +0, +0, +0, +0, 0 /
|
||||
DATA TP( 2)/ +0.051818D0 /,
|
||||
: (ITP(I, 2),I=1,5)/ +0, +1, +0, +0, 0 /
|
||||
DATA TP( 3)/ +0.009531D0 /,
|
||||
: (ITP(I, 3),I=1,5)/ +0, -1, +2, +0, 0 /
|
||||
DATA TP( 4)/ +0.007843D0 /,
|
||||
: (ITP(I, 4),I=1,5)/ +0, +0, +2, +0, 0 /
|
||||
DATA TP( 5)/ +0.002824D0 /,
|
||||
: (ITP(I, 5),I=1,5)/ +0, +2, +0, +0, 0 /
|
||||
DATA TP( 6)/ +0.000857D0 /,
|
||||
: (ITP(I, 6),I=1,5)/ +0, +1, +2, +0, 0 /
|
||||
DATA TP( 7)/ +0.000533D0 /,
|
||||
: (ITP(I, 7),I=1,5)/ -1, +0, +2, +0, 1 /
|
||||
DATA TP( 8)/ +0.000401D0 /,
|
||||
: (ITP(I, 8),I=1,5)/ -1, -1, +2, +0, 1 /
|
||||
DATA TP( 9)/ +0.000320D0 /,
|
||||
: (ITP(I, 9),I=1,5)/ -1, +1, +0, +0, 1 /
|
||||
DATA TP(10)/ -0.000271D0 /,
|
||||
: (ITP(I,10),I=1,5)/ +0, +0, +1, +0, 0 /
|
||||
DATA TP(11)/ -0.000264D0 /,
|
||||
: (ITP(I,11),I=1,5)/ +1, +1, +0, +0, 1 /
|
||||
DATA TP(12)/ -0.000198D0 /,
|
||||
: (ITP(I,12),I=1,5)/ +0, -1, +0, +2, 0 /
|
||||
DATA TP(13)/ +0.000173D0 /,
|
||||
: (ITP(I,13),I=1,5)/ +0, +3, +0, +0, 0 /
|
||||
DATA TP(14)/ +0.000167D0 /,
|
||||
: (ITP(I,14),I=1,5)/ +0, -1, +4, +0, 0 /
|
||||
DATA TP(15)/ -0.000111D0 /,
|
||||
: (ITP(I,15),I=1,5)/ +1, +0, +0, +0, 1 /
|
||||
DATA TP(16)/ +0.000103D0 /,
|
||||
: (ITP(I,16),I=1,5)/ +0, -2, +4, +0, 0 /
|
||||
DATA TP(17)/ -0.000084D0 /,
|
||||
: (ITP(I,17),I=1,5)/ +0, +2, -2, +0, 0 /
|
||||
DATA TP(18)/ -0.000083D0 /,
|
||||
: (ITP(I,18),I=1,5)/ +1, +0, +2, +0, 1 /
|
||||
DATA TP(19)/ +0.000079D0 /,
|
||||
: (ITP(I,19),I=1,5)/ +0, +2, +2, +0, 0 /
|
||||
DATA TP(20)/ +0.000072D0 /,
|
||||
: (ITP(I,20),I=1,5)/ +0, +0, +4, +0, 0 /
|
||||
DATA TP(21)/ +0.000064D0 /,
|
||||
: (ITP(I,21),I=1,5)/ -1, +1, +2, +0, 1 /
|
||||
DATA TP(22)/ -0.000063D0 /,
|
||||
: (ITP(I,22),I=1,5)/ +1, -1, +2, +0, 1 /
|
||||
DATA TP(23)/ +0.000041D0 /,
|
||||
: (ITP(I,23),I=1,5)/ +1, +0, +1, +0, 1 /
|
||||
DATA TP(24)/ +0.000035D0 /,
|
||||
: (ITP(I,24),I=1,5)/ -1, +2, +0, +0, 1 /
|
||||
DATA TP(25)/ -0.000033D0 /,
|
||||
: (ITP(I,25),I=1,5)/ +0, +3, -2, +0, 0 /
|
||||
DATA TP(26)/ -0.000030D0 /,
|
||||
: (ITP(I,26),I=1,5)/ +0, +1, +1, +0, 0 /
|
||||
DATA TP(27)/ -0.000029D0 /,
|
||||
: (ITP(I,27),I=1,5)/ +0, +0, -2, +2, 0 /
|
||||
DATA TP(28)/ -0.000029D0 /,
|
||||
: (ITP(I,28),I=1,5)/ +1, +2, +0, +0, 1 /
|
||||
DATA TP(29)/ +0.000026D0 /,
|
||||
: (ITP(I,29),I=1,5)/ -2, +0, +2, +0, 2 /
|
||||
DATA TP(30)/ -0.000023D0 /,
|
||||
: (ITP(I,30),I=1,5)/ +0, +1, -2, +2, 0 /
|
||||
DATA TP(31)/ +0.000019D0 /,
|
||||
: (ITP(I,31),I=1,5)/ -1, -1, +4, +0, 1 /
|
||||
|
||||
|
||||
|
||||
* Centuries since J1900
|
||||
T=(DATE-15019.5D0)/36525D0
|
||||
|
||||
*
|
||||
* Fundamental arguments (radians) and derivatives (radians per
|
||||
* Julian century) for the current epoch
|
||||
*
|
||||
|
||||
* Moon's mean longitude
|
||||
ELP=D2R*MOD(ELP0+(ELP1+(ELP2+ELP3*T)*T)*T,360D0)
|
||||
DELP=D2R*(ELP1+(2D0*ELP2+3D0*ELP3*T)*T)
|
||||
|
||||
* Sun's mean anomaly
|
||||
EM=D2R*MOD(EM0+(EM1+(EM2+EM3*T)*T)*T,360D0)
|
||||
DEM=D2R*(EM1+(2D0*EM2+3D0*EM3*T)*T)
|
||||
|
||||
* Moon's mean anomaly
|
||||
EMP=D2R*MOD(EMP0+(EMP1+(EMP2+EMP3*T)*T)*T,360D0)
|
||||
DEMP=D2R*(EMP1+(2D0*EMP2+3D0*EMP3*T)*T)
|
||||
|
||||
* Moon's mean elongation
|
||||
D=D2R*MOD(D0+(D1+(D2+D3*T)*T)*T,360D0)
|
||||
DD=D2R*(D1+(2D0*D2+3D0*D3*T)*T)
|
||||
|
||||
* Mean distance of the Moon from its ascending node
|
||||
F=D2R*MOD(F0+(F1+(F2+F3*T)*T)*T,360D0)
|
||||
DF=D2R*(F1+(2D0*F2+3D0*F3*T)*T)
|
||||
|
||||
* Longitude of the Moon's ascending node
|
||||
OM=D2R*MOD(OM0+(OM1+(OM2+OM3*T)*T)*T,360D0)
|
||||
DOM=D2R*(OM1+(2D0*OM2+3D0*OM3*T)*T)
|
||||
SINOM=SIN(OM)
|
||||
COSOM=COS(OM)
|
||||
DOMCOM=DOM*COSOM
|
||||
|
||||
* Add the periodic variations
|
||||
THETA=D2R*(PA0+PA1*T)
|
||||
WA=SIN(THETA)
|
||||
DWA=D2R*PA1*COS(THETA)
|
||||
THETA=D2R*(PE0+(PE1+PE2*T)*T)
|
||||
WB=PEC*SIN(THETA)
|
||||
DWB=D2R*PEC*(PE1+2D0*PE2*T)*COS(THETA)
|
||||
ELP=ELP+D2R*(PAC*WA+WB+PFC*SINOM)
|
||||
DELP=DELP+D2R*(PAC*DWA+DWB+PFC*DOMCOM)
|
||||
EM=EM+D2R*PBC*WA
|
||||
DEM=DEM+D2R*PBC*DWA
|
||||
EMP=EMP+D2R*(PCC*WA+WB+PGC*SINOM)
|
||||
DEMP=DEMP+D2R*(PCC*DWA+DWB+PGC*DOMCOM)
|
||||
D=D+D2R*(PDC*WA+WB+PHC*SINOM)
|
||||
DD=DD+D2R*(PDC*DWA+DWB+PHC*DOMCOM)
|
||||
WOM=OM+D2R*(PJ0+PJ1*T)
|
||||
DWOM=DOM+D2R*PJ1
|
||||
SINWOM=SIN(WOM)
|
||||
COSWOM=COS(WOM)
|
||||
F=F+D2R*(WB+PIC*SINOM+PJC*SINWOM)
|
||||
DF=DF+D2R*(DWB+PIC*DOMCOM+PJC*DWOM*COSWOM)
|
||||
|
||||
* E-factor, and square
|
||||
E=1D0+(E1+E2*T)*T
|
||||
DE=E1+2D0*E2*T
|
||||
ESQ=E*E
|
||||
DESQ=2D0*E*DE
|
||||
|
||||
*
|
||||
* Series expansions
|
||||
*
|
||||
|
||||
* Longitude
|
||||
V=0D0
|
||||
DV=0D0
|
||||
DO N=NL,1,-1
|
||||
COEFF=TL(N)
|
||||
EMN=DBLE(ITL(1,N))
|
||||
EMPN=DBLE(ITL(2,N))
|
||||
DN=DBLE(ITL(3,N))
|
||||
FN=DBLE(ITL(4,N))
|
||||
I=ITL(5,N)
|
||||
IF (I.EQ.0) THEN
|
||||
EN=1D0
|
||||
DEN=0D0
|
||||
ELSE IF (I.EQ.1) THEN
|
||||
EN=E
|
||||
DEN=DE
|
||||
ELSE
|
||||
EN=ESQ
|
||||
DEN=DESQ
|
||||
END IF
|
||||
THETA=EMN*EM+EMPN*EMP+DN*D+FN*F
|
||||
DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF
|
||||
FTHETA=SIN(THETA)
|
||||
V=V+COEFF*FTHETA*EN
|
||||
DV=DV+COEFF*(COS(THETA)*DTHETA*EN+FTHETA*DEN)
|
||||
END DO
|
||||
EL=ELP+D2R*V
|
||||
DEL=(DELP+D2R*DV)/CJ
|
||||
|
||||
* Latitude
|
||||
V=0D0
|
||||
DV=0D0
|
||||
DO N=NB,1,-1
|
||||
COEFF=TB(N)
|
||||
EMN=DBLE(ITB(1,N))
|
||||
EMPN=DBLE(ITB(2,N))
|
||||
DN=DBLE(ITB(3,N))
|
||||
FN=DBLE(ITB(4,N))
|
||||
I=ITB(5,N)
|
||||
IF (I.EQ.0) THEN
|
||||
EN=1D0
|
||||
DEN=0D0
|
||||
ELSE IF (I.EQ.1) THEN
|
||||
EN=E
|
||||
DEN=DE
|
||||
ELSE
|
||||
EN=ESQ
|
||||
DEN=DESQ
|
||||
END IF
|
||||
THETA=EMN*EM+EMPN*EMP+DN*D+FN*F
|
||||
DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF
|
||||
FTHETA=SIN(THETA)
|
||||
V=V+COEFF*FTHETA*EN
|
||||
DV=DV+COEFF*(COS(THETA)*DTHETA*EN+FTHETA*DEN)
|
||||
END DO
|
||||
BF=1D0-CW1*COSOM-CW2*COSWOM
|
||||
DBF=CW1*DOM*SINOM+CW2*DWOM*SINWOM
|
||||
B=D2R*V*BF
|
||||
DB=D2R*(DV*BF+V*DBF)/CJ
|
||||
|
||||
* Parallax
|
||||
V=0D0
|
||||
DV=0D0
|
||||
DO N=NP,1,-1
|
||||
COEFF=TP(N)
|
||||
EMN=DBLE(ITP(1,N))
|
||||
EMPN=DBLE(ITP(2,N))
|
||||
DN=DBLE(ITP(3,N))
|
||||
FN=DBLE(ITP(4,N))
|
||||
I=ITP(5,N)
|
||||
IF (I.EQ.0) THEN
|
||||
EN=1D0
|
||||
DEN=0D0
|
||||
ELSE IF (I.EQ.1) THEN
|
||||
EN=E
|
||||
DEN=DE
|
||||
ELSE
|
||||
EN=ESQ
|
||||
DEN=DESQ
|
||||
END IF
|
||||
THETA=EMN*EM+EMPN*EMP+DN*D+FN*F
|
||||
DTHETA=EMN*DEM+EMPN*DEMP+DN*DD+FN*DF
|
||||
FTHETA=COS(THETA)
|
||||
V=V+COEFF*FTHETA*EN
|
||||
DV=DV+COEFF*(-SIN(THETA)*DTHETA*EN+FTHETA*DEN)
|
||||
END DO
|
||||
P=D2R*V
|
||||
DP=D2R*DV/CJ
|
||||
|
||||
*
|
||||
* Transformation into final form
|
||||
*
|
||||
|
||||
* Parallax to distance (AU, AU/sec)
|
||||
SP=SIN(P)
|
||||
R=ERADAU/SP
|
||||
DR=-R*DP*COS(P)/SP
|
||||
|
||||
* Longitude, latitude to x,y,z (AU)
|
||||
SEL=SIN(EL)
|
||||
CEL=COS(EL)
|
||||
SB=SIN(B)
|
||||
CB=COS(B)
|
||||
RCB=R*CB
|
||||
RBD=R*DB
|
||||
W=RBD*SB-CB*DR
|
||||
X=RCB*CEL
|
||||
Y=RCB*SEL
|
||||
Z=R*SB
|
||||
XD=-Y*DEL-W*CEL
|
||||
YD=X*DEL-W*SEL
|
||||
ZD=RBD*CB+SB*DR
|
||||
|
||||
* Julian centuries since J2000
|
||||
T=(DATE-51544.5D0)/36525D0
|
||||
|
||||
* Fricke equinox correction
|
||||
EPJ=2000D0+T*100D0
|
||||
EQCOR=DS2R*(0.035D0+0.00085D0*(EPJ-B1950))
|
||||
|
||||
* Mean obliquity (IAU 1976)
|
||||
EPS=DAS2R*(84381.448D0+(-46.8150D0+(-0.00059D0+0.001813D0*T)*T)*T)
|
||||
|
||||
* To the equatorial system, mean of date, FK5 system
|
||||
SINEPS=SIN(EPS)
|
||||
COSEPS=COS(EPS)
|
||||
ES=EQCOR*SINEPS
|
||||
EC=EQCOR*COSEPS
|
||||
PV(1)=X-EC*Y+ES*Z
|
||||
PV(2)=EQCOR*X+Y*COSEPS-Z*SINEPS
|
||||
PV(3)=Y*SINEPS+Z*COSEPS
|
||||
PV(4)=XD-EC*YD+ES*ZD
|
||||
PV(5)=EQCOR*XD+YD*COSEPS-ZD*SINEPS
|
||||
PV(6)=YD*SINEPS+ZD*COSEPS
|
||||
|
||||
END
|
||||
72
slalib/dmxm.f
Normal file
72
slalib/dmxm.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_DMXM (A, B, C)
|
||||
*+
|
||||
* - - - - -
|
||||
* D M X M
|
||||
* - - - - -
|
||||
*
|
||||
* Product of two 3x3 matrices:
|
||||
*
|
||||
* matrix C = matrix A x matrix B
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* A dp(3,3) matrix
|
||||
* B dp(3,3) matrix
|
||||
*
|
||||
* Returned:
|
||||
* C dp(3,3) matrix result
|
||||
*
|
||||
* To comply with the ANSI Fortran 77 standard, A, B and C must
|
||||
* be different arrays. However, the routine is coded so as to
|
||||
* work properly on many platforms even if this rule is violated.
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION A(3,3),B(3,3),C(3,3)
|
||||
|
||||
INTEGER I,J,K
|
||||
DOUBLE PRECISION W,WM(3,3)
|
||||
|
||||
|
||||
* Multiply into scratch matrix
|
||||
DO I=1,3
|
||||
DO J=1,3
|
||||
W=0D0
|
||||
DO K=1,3
|
||||
W=W+A(I,K)*B(K,J)
|
||||
END DO
|
||||
WM(I,J)=W
|
||||
END DO
|
||||
END DO
|
||||
|
||||
* Return the result
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
C(I,J)=WM(I,J)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
END
|
||||
68
slalib/dmxv.f
Normal file
68
slalib/dmxv.f
Normal file
@ -0,0 +1,68 @@
|
||||
SUBROUTINE sla_DMXV (DM, VA, VB)
|
||||
*+
|
||||
* - - - - -
|
||||
* D M X V
|
||||
* - - - - -
|
||||
*
|
||||
* Performs the 3-D forward unitary transformation:
|
||||
*
|
||||
* vector VB = matrix DM * vector VA
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DM dp(3,3) matrix
|
||||
* VA dp(3) vector
|
||||
*
|
||||
* Returned:
|
||||
* VB dp(3) result vector
|
||||
*
|
||||
* To comply with the ANSI Fortran 77 standard, VA and VB must be
|
||||
* different arrays. However, the routine is coded so as to work
|
||||
* properly on many platforms even if this rule is violated.
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DM(3,3),VA(3),VB(3)
|
||||
|
||||
INTEGER I,J
|
||||
DOUBLE PRECISION W,VW(3)
|
||||
|
||||
|
||||
* Matrix DM * vector VA -> vector VW
|
||||
DO J=1,3
|
||||
W=0D0
|
||||
DO I=1,3
|
||||
W=W+DM(J,I)*VA(I)
|
||||
END DO
|
||||
VW(J)=W
|
||||
END DO
|
||||
|
||||
* Vector VW -> vector VB
|
||||
DO J=1,3
|
||||
VB(J)=VW(J)
|
||||
END DO
|
||||
|
||||
END
|
||||
81
slalib/dpav.f
Normal file
81
slalib/dpav.f
Normal file
@ -0,0 +1,81 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DPAV ( V1, V2 )
|
||||
*+
|
||||
* - - - - -
|
||||
* D P A V
|
||||
* - - - - -
|
||||
*
|
||||
* Position angle of one celestial direction with respect to another.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V1 d(3) direction cosines of one point
|
||||
* V2 d(3) direction cosines of the other point
|
||||
*
|
||||
* (The coordinate frames correspond to RA,Dec, Long,Lat etc.)
|
||||
*
|
||||
* The result is the bearing (position angle), in radians, of point
|
||||
* V2 with respect to point V1. It is in the range +/- pi. The
|
||||
* sense is such that if V2 is a small distance east of V1, the
|
||||
* bearing is about +pi/2. Zero is returned if the two points
|
||||
* are coincident.
|
||||
*
|
||||
* V1 and V2 need not be unit vectors.
|
||||
*
|
||||
* The routine sla_DBEAR performs an equivalent function except
|
||||
* that the points are specified in the form of spherical
|
||||
* coordinates.
|
||||
*
|
||||
* Last revision: 16 March 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V1(3),V2(3)
|
||||
|
||||
DOUBLE PRECISION X1,Y1,Z1,W,X2,Y2,Z2,SQ,CQ
|
||||
|
||||
|
||||
|
||||
* The unit vector to point 1.
|
||||
X1 = V1(1)
|
||||
Y1 = V1(2)
|
||||
Z1 = V1(3)
|
||||
W = SQRT(X1*X1+Y1*Y1+Z1*Z1)
|
||||
IF (W.NE.0D0) THEN
|
||||
X1 = X1/W
|
||||
Y1 = Y1/W
|
||||
Z1 = Z1/W
|
||||
END IF
|
||||
|
||||
* The vector to point 2.
|
||||
X2 = V2(1)
|
||||
Y2 = V2(2)
|
||||
Z2 = V2(3)
|
||||
|
||||
* Position angle.
|
||||
SQ = Y2*X1-X2*Y1
|
||||
CQ = Z2*(X1*X1+Y1*Y1)-Z1*(X2*X1+Y2*Y1)
|
||||
IF (SQ.EQ.0D0.AND.CQ.EQ.0D0) CQ=1D0
|
||||
sla_DPAV = ATAN2(SQ,CQ)
|
||||
|
||||
END
|
||||
75
slalib/dr2af.f
Normal file
75
slalib/dr2af.f
Normal file
@ -0,0 +1,75 @@
|
||||
SUBROUTINE sla_DR2AF (NDP, ANGLE, SIGN, IDMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D R 2 A F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an angle in radians to degrees, arcminutes, arcseconds
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP i number of decimal places of arcseconds
|
||||
* ANGLE d angle in radians
|
||||
*
|
||||
* Returned:
|
||||
* SIGN c '+' or '-'
|
||||
* IDMSF i(4) degrees, arcminutes, arcseconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size
|
||||
* of ANGLE, the format of DOUBLE PRECISION floating-point
|
||||
* numbers on the target machine, and the risk of overflowing
|
||||
* IDMSF(4). On some architectures, for ANGLE up to 2pi, the
|
||||
* available floating-point precision corresponds roughly to
|
||||
* NDP=12. However, the practical limit is NDP=9, set by the
|
||||
* capacity of a typical 32-bit IDMSF(4).
|
||||
*
|
||||
* 3) The absolute value of ANGLE may exceed 2pi. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where ANGLE is very nearly 2pi and rounds up to 360 deg,
|
||||
* by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero.
|
||||
*
|
||||
* Called: sla_DD2TF
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
DOUBLE PRECISION ANGLE
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IDMSF(4)
|
||||
|
||||
* Hours to degrees * radians to turns
|
||||
DOUBLE PRECISION F
|
||||
PARAMETER (F=15D0/6.283185307179586476925287D0)
|
||||
|
||||
|
||||
|
||||
* Scale then use days to h,m,s routine
|
||||
CALL sla_DD2TF(NDP,ANGLE*F,SIGN,IDMSF)
|
||||
|
||||
END
|
||||
75
slalib/dr2tf.f
Normal file
75
slalib/dr2tf.f
Normal file
@ -0,0 +1,75 @@
|
||||
SUBROUTINE sla_DR2TF (NDP, ANGLE, SIGN, IHMSF)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D R 2 T F
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert an angle in radians to hours, minutes, seconds
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* NDP i number of decimal places of seconds
|
||||
* ANGLE d angle in radians
|
||||
*
|
||||
* Returned:
|
||||
* SIGN c '+' or '-'
|
||||
* IHMSF i(4) hours, minutes, seconds, fraction
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) NDP less than zero is interpreted as zero.
|
||||
*
|
||||
* 2) The largest useful value for NDP is determined by the size
|
||||
* of ANGLE, the format of DOUBLE PRECISION floating-point
|
||||
* numbers on the target machine, and the risk of overflowing
|
||||
* IHMSF(4). On some architectures, for ANGLE up to 2pi, the
|
||||
* available floating-point precision corresponds roughly to
|
||||
* NDP=12. However, the practical limit is NDP=9, set by the
|
||||
* capacity of a typical 32-bit IHMSF(4).
|
||||
*
|
||||
* 3) The absolute value of ANGLE may exceed 2pi. In cases where it
|
||||
* does not, it is up to the caller to test for and handle the
|
||||
* case where ANGLE is very nearly 2pi and rounds up to 24 hours,
|
||||
* by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero.
|
||||
*
|
||||
* Called: sla_DD2TF
|
||||
*
|
||||
* Last revision: 26 December 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER NDP
|
||||
DOUBLE PRECISION ANGLE
|
||||
CHARACTER SIGN*(*)
|
||||
INTEGER IHMSF(4)
|
||||
|
||||
* Turns to radians
|
||||
DOUBLE PRECISION T2R
|
||||
PARAMETER (T2R=6.283185307179586476925287D0)
|
||||
|
||||
|
||||
|
||||
* Scale then use days to h,m,s routine
|
||||
CALL sla_DD2TF(NDP,ANGLE/T2R,SIGN,IHMSF)
|
||||
|
||||
END
|
||||
49
slalib/drange.f
Normal file
49
slalib/drange.f
Normal file
@ -0,0 +1,49 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DRANGE (ANGLE)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D R A N G E
|
||||
* - - - - - - -
|
||||
*
|
||||
* Normalize angle into range +/- pi (double precision)
|
||||
*
|
||||
* Given:
|
||||
* ANGLE dp the angle in radians
|
||||
*
|
||||
* The result (double precision) is ANGLE expressed in the range +/- pi.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 November 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION ANGLE
|
||||
|
||||
DOUBLE PRECISION DPI,D2PI
|
||||
PARAMETER (DPI=3.141592653589793238462643D0)
|
||||
PARAMETER (D2PI=6.283185307179586476925287D0)
|
||||
|
||||
|
||||
sla_DRANGE=MOD(ANGLE,D2PI)
|
||||
IF (ABS(sla_DRANGE).GE.DPI)
|
||||
: sla_DRANGE=sla_DRANGE-SIGN(D2PI,ANGLE)
|
||||
|
||||
END
|
||||
47
slalib/dranrm.f
Normal file
47
slalib/dranrm.f
Normal file
@ -0,0 +1,47 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DRANRM (ANGLE)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D R A N R M
|
||||
* - - - - - - -
|
||||
*
|
||||
* Normalize angle into range 0-2 pi (double precision)
|
||||
*
|
||||
* Given:
|
||||
* ANGLE dp the angle in radians
|
||||
*
|
||||
* The result is ANGLE expressed in the range 0-2 pi.
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION ANGLE
|
||||
|
||||
DOUBLE PRECISION D2PI
|
||||
PARAMETER (D2PI=6.283185307179586476925286766559D0)
|
||||
|
||||
|
||||
sla_DRANRM = MOD(ANGLE,D2PI)
|
||||
IF (sla_DRANRM.LT.0D0) sla_DRANRM = sla_DRANRM+D2PI
|
||||
|
||||
END
|
||||
74
slalib/ds2c6.f
Normal file
74
slalib/ds2c6.f
Normal file
@ -0,0 +1,74 @@
|
||||
SUBROUTINE sla_DS2C6 (A, B, R, AD, BD, RD, V)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D S 2 C 6
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of position & velocity in spherical coordinates
|
||||
* to Cartesian coordinates
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* A dp longitude (radians)
|
||||
* B dp latitude (radians)
|
||||
* R dp radial coordinate
|
||||
* AD dp longitude derivative (radians per unit time)
|
||||
* BD dp latitude derivative (radians per unit time)
|
||||
* RD dp radial derivative
|
||||
*
|
||||
* Returned:
|
||||
* V dp(6) Cartesian position & velocity vector
|
||||
*
|
||||
* P.T.Wallace Starlink 10 July 1993
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION A,B,R,AD,BD,RD,V(6)
|
||||
|
||||
DOUBLE PRECISION SA,CA,SB,CB,RCB,X,Y,RBD,W
|
||||
|
||||
|
||||
|
||||
* Useful functions
|
||||
SA=SIN(A)
|
||||
CA=COS(A)
|
||||
SB=SIN(B)
|
||||
CB=COS(B)
|
||||
RCB=R*CB
|
||||
X=RCB*CA
|
||||
Y=RCB*SA
|
||||
RBD=R*BD
|
||||
W=RBD*SB-CB*RD
|
||||
|
||||
* Position
|
||||
V(1)=X
|
||||
V(2)=Y
|
||||
V(3)=R*SB
|
||||
|
||||
* Velocity
|
||||
V(4)=-Y*AD-W*CA
|
||||
V(5)=X*AD-W*SA
|
||||
V(6)=RBD*CB+SB*RD
|
||||
|
||||
END
|
||||
84
slalib/ds2tp.f
Normal file
84
slalib/ds2tp.f
Normal file
@ -0,0 +1,84 @@
|
||||
SUBROUTINE sla_DS2TP (RA, DEC, RAZ, DECZ, XI, ETA, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D S 2 T P
|
||||
* - - - - - -
|
||||
*
|
||||
* Projection of spherical coordinates onto tangent plane:
|
||||
* "gnomonic" projection - "standard coordinates" (double precision)
|
||||
*
|
||||
* Given:
|
||||
* RA,DEC dp spherical coordinates of point to be projected
|
||||
* RAZ,DECZ dp spherical coordinates of tangent point
|
||||
*
|
||||
* Returned:
|
||||
* XI,ETA dp rectangular coordinates on tangent plane
|
||||
* J int status: 0 = OK, star on tangent plane
|
||||
* 1 = error, star too far from axis
|
||||
* 2 = error, antistar on tangent plane
|
||||
* 3 = error, antistar too far from axis
|
||||
*
|
||||
* P.T.Wallace Starlink 18 July 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION RA,DEC,RAZ,DECZ,XI,ETA
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION SDECZ,SDEC,CDECZ,CDEC,
|
||||
: RADIF,SRADIF,CRADIF,DENOM
|
||||
|
||||
DOUBLE PRECISION TINY
|
||||
PARAMETER (TINY=1D-6)
|
||||
|
||||
|
||||
* Trig functions
|
||||
SDECZ=SIN(DECZ)
|
||||
SDEC=SIN(DEC)
|
||||
CDECZ=COS(DECZ)
|
||||
CDEC=COS(DEC)
|
||||
RADIF=RA-RAZ
|
||||
SRADIF=SIN(RADIF)
|
||||
CRADIF=COS(RADIF)
|
||||
|
||||
* Reciprocal of star vector length to tangent plane
|
||||
DENOM=SDEC*SDECZ+CDEC*CDECZ*CRADIF
|
||||
|
||||
* Handle vectors too far from axis
|
||||
IF (DENOM.GT.TINY) THEN
|
||||
J=0
|
||||
ELSE IF (DENOM.GE.0D0) THEN
|
||||
J=1
|
||||
DENOM=TINY
|
||||
ELSE IF (DENOM.GT.-TINY) THEN
|
||||
J=2
|
||||
DENOM=-TINY
|
||||
ELSE
|
||||
J=3
|
||||
END IF
|
||||
|
||||
* Compute tangent plane coordinates (even in dubious cases)
|
||||
XI=CDEC*SRADIF/DENOM
|
||||
ETA=(SDEC*CDECZ-CDEC*SDECZ*CRADIF)/DENOM
|
||||
|
||||
END
|
||||
60
slalib/dsep.f
Normal file
60
slalib/dsep.f
Normal file
@ -0,0 +1,60 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DSEP (A1, B1, A2, B2)
|
||||
*+
|
||||
* - - - - -
|
||||
* D S E P
|
||||
* - - - - -
|
||||
*
|
||||
* Angle between two points on a sphere.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* A1,B1 d spherical coordinates of one point
|
||||
* A2,B2 d spherical coordinates of the other point
|
||||
*
|
||||
* (The spherical coordinates are [RA,Dec], [Long,Lat] etc, in radians.)
|
||||
*
|
||||
* The result is the angle, in radians, between the two points. It
|
||||
* is always positive.
|
||||
*
|
||||
* Called: sla_DCS2C, sla_DSEPV
|
||||
*
|
||||
* Last revision: 7 May 2000
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION A1,B1,A2,B2
|
||||
|
||||
DOUBLE PRECISION V1(3),V2(3)
|
||||
DOUBLE PRECISION sla_DSEPV
|
||||
|
||||
|
||||
|
||||
* Convert coordinates from spherical to Cartesian.
|
||||
CALL sla_DCS2C(A1,B1,V1)
|
||||
CALL sla_DCS2C(A2,B2,V2)
|
||||
|
||||
* Angle between the vectors.
|
||||
sla_DSEP = sla_DSEPV(V1,V2)
|
||||
|
||||
END
|
||||
76
slalib/dsepv.f
Normal file
76
slalib/dsepv.f
Normal file
@ -0,0 +1,76 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DSEPV (V1, V2)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D S E P V
|
||||
* - - - - - -
|
||||
*
|
||||
* Angle between two vectors.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V1 d(3) first vector
|
||||
* V2 d(3) second vector
|
||||
*
|
||||
* The result is the angle, in radians, between the two vectors. It
|
||||
* is always positive.
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 There is no requirement for the vectors to be unit length.
|
||||
*
|
||||
* 2 If either vector is null, zero is returned.
|
||||
*
|
||||
* 3 The simplest formulation would use dot product alone. However,
|
||||
* this would reduce the accuracy for angles near zero and pi. The
|
||||
* algorithm uses both cross product and dot product, which maintains
|
||||
* accuracy for all sizes of angle.
|
||||
*
|
||||
* Called: sla_DVXV, sla_DVN, sla_DVDV
|
||||
*
|
||||
* Last revision: 14 June 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V1(3),V2(3)
|
||||
|
||||
DOUBLE PRECISION V1XV2(3),WV(3),S,C
|
||||
DOUBLE PRECISION sla_DVDV
|
||||
|
||||
|
||||
|
||||
* Modulus of cross product = sine multiplied by the two moduli.
|
||||
CALL sla_DVXV(V1,V2,V1XV2)
|
||||
CALL sla_DVN(V1XV2,WV,S)
|
||||
|
||||
* Dot product = cosine multiplied by the two moduli.
|
||||
C = sla_DVDV(V1,V2)
|
||||
|
||||
* Angle between the vectors.
|
||||
IF ( S.NE.0D0 .OR. C.NE.0D0 ) THEN
|
||||
sla_DSEPV = ATAN2(S,C)
|
||||
ELSE
|
||||
sla_DSEPV = 0D0
|
||||
END IF
|
||||
|
||||
END
|
||||
96
slalib/dt.f
Normal file
96
slalib/dt.f
Normal file
@ -0,0 +1,96 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DT (EPOCH)
|
||||
*+
|
||||
* - - -
|
||||
* D T
|
||||
* - - -
|
||||
*
|
||||
* Estimate the offset between dynamical time and Universal Time
|
||||
* for a given historical epoch.
|
||||
*
|
||||
* Given:
|
||||
* EPOCH d (Julian) epoch (e.g. 1850D0)
|
||||
*
|
||||
* The result is a rough estimate of ET-UT (after 1984, TT-UT) at
|
||||
* the given epoch, in seconds.
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 Depending on the epoch, one of three parabolic approximations
|
||||
* is used:
|
||||
*
|
||||
* before 979 Stephenson & Morrison's 390 BC to AD 948 model
|
||||
* 979 to 1708 Stephenson & Morrison's 948 to 1600 model
|
||||
* after 1708 McCarthy & Babcock's post-1650 model
|
||||
*
|
||||
* The breakpoints are chosen to ensure continuity: they occur
|
||||
* at places where the adjacent models give the same answer as
|
||||
* each other.
|
||||
*
|
||||
* 2 The accuracy is modest, with errors of up to 20 sec during
|
||||
* the interval since 1650, rising to perhaps 30 min by 1000 BC.
|
||||
* Comparatively accurate values from AD 1600 are tabulated in
|
||||
* the Astronomical Almanac (see section K8 of the 1995 AA).
|
||||
*
|
||||
* 3 The use of double-precision for both argument and result is
|
||||
* purely for compatibility with other SLALIB time routines.
|
||||
*
|
||||
* 4 The models used are based on a lunar tidal acceleration value
|
||||
* of -26.00 arcsec per century.
|
||||
*
|
||||
* Reference: Explanatory Supplement to the Astronomical Almanac,
|
||||
* ed P.K.Seidelmann, University Science Books (1992),
|
||||
* section 2.553, p83. This contains references to
|
||||
* the Stephenson & Morrison and McCarthy & Babcock
|
||||
* papers.
|
||||
*
|
||||
* P.T.Wallace Starlink 1 March 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION EPOCH
|
||||
DOUBLE PRECISION T,W,S
|
||||
|
||||
|
||||
* Centuries since 1800
|
||||
T=(EPOCH-1800D0)/100D0
|
||||
|
||||
* Select model
|
||||
IF (EPOCH.GE.1708.185161980887D0) THEN
|
||||
|
||||
* Post-1708: use McCarthy & Babcock
|
||||
W=T-0.19D0
|
||||
S=5.156D0+13.3066D0*W*W
|
||||
ELSE IF (EPOCH.GE.979.0258204760233D0) THEN
|
||||
|
||||
* 979-1708: use Stephenson & Morrison's 948-1600 model
|
||||
S=25.5D0*T*T
|
||||
ELSE
|
||||
|
||||
* Pre-979: use Stephenson & Morrison's 390 BC to AD 948 model
|
||||
S=1360.0D0+(320D0+44.3D0*T)*T
|
||||
END IF
|
||||
|
||||
* Result
|
||||
sla_DT=S
|
||||
|
||||
END
|
||||
72
slalib/dtf2d.f
Normal file
72
slalib/dtf2d.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_DTF2D (IHOUR, IMIN, SEC, DAYS, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D T F 2 D
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert hours, minutes, seconds to days (double precision)
|
||||
*
|
||||
* Given:
|
||||
* IHOUR int hours
|
||||
* IMIN int minutes
|
||||
* SEC dp seconds
|
||||
*
|
||||
* Returned:
|
||||
* DAYS dp interval in days
|
||||
* J int status: 0 = OK
|
||||
* 1 = IHOUR outside range 0-23
|
||||
* 2 = IMIN outside range 0-59
|
||||
* 3 = SEC outside range 0-59.999...
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is computed even if any of the range checks fail.
|
||||
*
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink July 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IHOUR,IMIN
|
||||
DOUBLE PRECISION SEC,DAYS
|
||||
INTEGER J
|
||||
|
||||
* Seconds per day
|
||||
DOUBLE PRECISION D2S
|
||||
PARAMETER (D2S=86400D0)
|
||||
|
||||
|
||||
|
||||
* Preset status
|
||||
J=0
|
||||
|
||||
* Validate sec, min, hour
|
||||
IF (SEC.LT.0D0.OR.SEC.GE.60D0) J=3
|
||||
IF (IMIN.LT.0.OR.IMIN.GT.59) J=2
|
||||
IF (IHOUR.LT.0.OR.IHOUR.GT.23) J=1
|
||||
|
||||
* Compute interval
|
||||
DAYS=(60D0*(60D0*DBLE(IHOUR)+DBLE(IMIN))+SEC)/D2S
|
||||
|
||||
END
|
||||
70
slalib/dtf2r.f
Normal file
70
slalib/dtf2r.f
Normal file
@ -0,0 +1,70 @@
|
||||
SUBROUTINE sla_DTF2R (IHOUR, IMIN, SEC, RAD, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D T F 2 R
|
||||
* - - - - - -
|
||||
*
|
||||
* Convert hours, minutes, seconds to radians (double precision)
|
||||
*
|
||||
* Given:
|
||||
* IHOUR int hours
|
||||
* IMIN int minutes
|
||||
* SEC dp seconds
|
||||
*
|
||||
* Returned:
|
||||
* RAD dp angle in radians
|
||||
* J int status: 0 = OK
|
||||
* 1 = IHOUR outside range 0-23
|
||||
* 2 = IMIN outside range 0-59
|
||||
* 3 = SEC outside range 0-59.999...
|
||||
*
|
||||
* Called:
|
||||
* sla_DTF2D
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is computed even if any of the range checks fail.
|
||||
*
|
||||
* 2) The sign must be dealt with outside this routine.
|
||||
*
|
||||
* P.T.Wallace Starlink July 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IHOUR,IMIN
|
||||
DOUBLE PRECISION SEC,RAD
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION TURNS
|
||||
|
||||
* Turns to radians
|
||||
DOUBLE PRECISION T2R
|
||||
PARAMETER (T2R=6.283185307179586476925287D0)
|
||||
|
||||
|
||||
|
||||
* Convert to turns then radians
|
||||
CALL sla_DTF2D(IHOUR,IMIN,SEC,TURNS,J)
|
||||
RAD=T2R*TURNS
|
||||
|
||||
END
|
||||
59
slalib/dtp2s.f
Normal file
59
slalib/dtp2s.f
Normal file
@ -0,0 +1,59 @@
|
||||
SUBROUTINE sla_DTP2S (XI, ETA, RAZ, DECZ, RA, DEC)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D T P 2 S
|
||||
* - - - - - -
|
||||
*
|
||||
* Transform tangent plane coordinates into spherical
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* XI,ETA dp tangent plane rectangular coordinates
|
||||
* RAZ,DECZ dp spherical coordinates of tangent point
|
||||
*
|
||||
* Returned:
|
||||
* RA,DEC dp spherical coordinates (0-2pi,+/-pi/2)
|
||||
*
|
||||
* Called: sla_DRANRM
|
||||
*
|
||||
* P.T.Wallace Starlink 24 July 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION XI,ETA,RAZ,DECZ,RA,DEC
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM
|
||||
|
||||
DOUBLE PRECISION SDECZ,CDECZ,DENOM
|
||||
|
||||
|
||||
|
||||
SDECZ=SIN(DECZ)
|
||||
CDECZ=COS(DECZ)
|
||||
|
||||
DENOM=CDECZ-ETA*SDECZ
|
||||
|
||||
RA=sla_DRANRM(ATAN2(XI,DENOM)+RAZ)
|
||||
DEC=ATAN2(SDECZ+ETA*CDECZ,SQRT(XI*XI+DENOM*DENOM))
|
||||
|
||||
END
|
||||
73
slalib/dtp2v.f
Normal file
73
slalib/dtp2v.f
Normal file
@ -0,0 +1,73 @@
|
||||
SUBROUTINE sla_DTP2V (XI, ETA, V0, V)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D T P 2 V
|
||||
* - - - - - -
|
||||
*
|
||||
* Given the tangent-plane coordinates of a star and the direction
|
||||
* cosines of the tangent point, determine the direction cosines
|
||||
* of the star.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* XI,ETA d tangent plane coordinates of star
|
||||
* V0 d(3) direction cosines of tangent point
|
||||
*
|
||||
* Returned:
|
||||
* V d(3) direction cosines of star
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 If vector V0 is not of unit length, the returned vector V will
|
||||
* be wrong.
|
||||
*
|
||||
* 2 If vector V0 points at a pole, the returned vector V will be
|
||||
* based on the arbitrary assumption that the RA of the tangent
|
||||
* point is zero.
|
||||
*
|
||||
* 3 This routine is the Cartesian equivalent of the routine sla_DTP2S.
|
||||
*
|
||||
* P.T.Wallace Starlink 11 February 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION XI,ETA,V0(3),V(3)
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,F,R
|
||||
|
||||
|
||||
X=V0(1)
|
||||
Y=V0(2)
|
||||
Z=V0(3)
|
||||
F=SQRT(1D0+XI*XI+ETA*ETA)
|
||||
R=SQRT(X*X+Y*Y)
|
||||
IF (R.EQ.0D0) THEN
|
||||
R=1D-20
|
||||
X=R
|
||||
END IF
|
||||
V(1)=(X-(XI*Y+ETA*X*Z)/R)/F
|
||||
V(2)=(Y+(XI*X-ETA*Y*Z)/R)/F
|
||||
V(3)=(Z+ETA*R)/F
|
||||
|
||||
END
|
||||
108
slalib/dtps2c.f
Normal file
108
slalib/dtps2c.f
Normal file
@ -0,0 +1,108 @@
|
||||
SUBROUTINE sla_DTPS2C (XI, ETA, RA, DEC, RAZ1, DECZ1,
|
||||
: RAZ2, DECZ2, N)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D T P S 2 C
|
||||
* - - - - - - -
|
||||
*
|
||||
* From the tangent plane coordinates of a star of known RA,Dec,
|
||||
* determine the RA,Dec of the tangent point.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* XI,ETA d tangent plane rectangular coordinates
|
||||
* RA,DEC d spherical coordinates
|
||||
*
|
||||
* Returned:
|
||||
* RAZ1,DECZ1 d spherical coordinates of tangent point, solution 1
|
||||
* RAZ2,DECZ2 d spherical coordinates of tangent point, solution 2
|
||||
* N i number of solutions:
|
||||
* 0 = no solutions returned (note 2)
|
||||
* 1 = only the first solution is useful (note 3)
|
||||
* 2 = both solutions are useful (note 3)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The RAZ1 and RAZ2 values are returned in the range 0-2pi.
|
||||
*
|
||||
* 2 Cases where there is no solution can only arise near the poles.
|
||||
* For example, it is clearly impossible for a star at the pole
|
||||
* itself to have a non-zero XI value, and hence it is
|
||||
* meaningless to ask where the tangent point would have to be
|
||||
* to bring about this combination of XI and DEC.
|
||||
*
|
||||
* 3 Also near the poles, cases can arise where there are two useful
|
||||
* solutions. The argument N indicates whether the second of the
|
||||
* two solutions returned is useful. N=1 indicates only one useful
|
||||
* solution, the usual case; under these circumstances, the second
|
||||
* solution corresponds to the "over-the-pole" case, and this is
|
||||
* reflected in the values of RAZ2 and DECZ2 which are returned.
|
||||
*
|
||||
* 4 The DECZ1 and DECZ2 values are returned in the range +/-pi, but
|
||||
* in the usual, non-pole-crossing, case, the range is +/-pi/2.
|
||||
*
|
||||
* 5 This routine is the spherical equivalent of the routine sla_DTPV2C.
|
||||
*
|
||||
* Called: sla_DRANRM
|
||||
*
|
||||
* P.T.Wallace Starlink 5 June 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION XI,ETA,RA,DEC,RAZ1,DECZ1,RAZ2,DECZ2
|
||||
INTEGER N
|
||||
|
||||
DOUBLE PRECISION X2,Y2,SD,CD,SDF,R2,R,S,C
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM
|
||||
|
||||
|
||||
X2=XI*XI
|
||||
Y2=ETA*ETA
|
||||
SD=SIN(DEC)
|
||||
CD=COS(DEC)
|
||||
SDF=SD*SQRT(1D0+X2+Y2)
|
||||
R2=CD*CD*(1D0+Y2)-SD*SD*X2
|
||||
IF (R2.GE.0D0) THEN
|
||||
R=SQRT(R2)
|
||||
S=SDF-ETA*R
|
||||
C=SDF*ETA+R
|
||||
IF (XI.EQ.0D0.AND.R.EQ.0D0) R=1D0
|
||||
RAZ1=sla_DRANRM(RA-ATAN2(XI,R))
|
||||
DECZ1=ATAN2(S,C)
|
||||
R=-R
|
||||
S=SDF-ETA*R
|
||||
C=SDF*ETA+R
|
||||
RAZ2=sla_DRANRM(RA-ATAN2(XI,R))
|
||||
DECZ2=ATAN2(S,C)
|
||||
IF (ABS(SDF).LT.1D0) THEN
|
||||
N=1
|
||||
ELSE
|
||||
N=2
|
||||
END IF
|
||||
ELSE
|
||||
N=0
|
||||
END IF
|
||||
|
||||
END
|
||||
100
slalib/dtpv2c.f
Normal file
100
slalib/dtpv2c.f
Normal file
@ -0,0 +1,100 @@
|
||||
SUBROUTINE sla_DTPV2C (XI, ETA, V, V01, V02, N)
|
||||
*+
|
||||
* - - - - - - -
|
||||
* D T P V 2 C
|
||||
* - - - - - - -
|
||||
*
|
||||
* Given the tangent-plane coordinates of a star and its direction
|
||||
* cosines, determine the direction cosines of the tangent-point.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* XI,ETA d tangent plane coordinates of star
|
||||
* V d(3) direction cosines of star
|
||||
*
|
||||
* Returned:
|
||||
* V01 d(3) direction cosines of tangent point, solution 1
|
||||
* V02 d(3) direction cosines of tangent point, solution 2
|
||||
* N i number of solutions:
|
||||
* 0 = no solutions returned (note 2)
|
||||
* 1 = only the first solution is useful (note 3)
|
||||
* 2 = both solutions are useful (note 3)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The vector V must be of unit length or the result will be wrong.
|
||||
*
|
||||
* 2 Cases where there is no solution can only arise near the poles.
|
||||
* For example, it is clearly impossible for a star at the pole
|
||||
* itself to have a non-zero XI value, and hence it is meaningless
|
||||
* to ask where the tangent point would have to be.
|
||||
*
|
||||
* 3 Also near the poles, cases can arise where there are two useful
|
||||
* solutions. The argument N indicates whether the second of the
|
||||
* two solutions returned is useful. N=1 indicates only one useful
|
||||
* solution, the usual case; under these circumstances, the second
|
||||
* solution can be regarded as valid if the vector V02 is interpreted
|
||||
* as the "over-the-pole" case.
|
||||
*
|
||||
* 4 This routine is the Cartesian equivalent of the routine sla_DTPS2C.
|
||||
*
|
||||
* P.T.Wallace Starlink 5 June 1995
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION XI,ETA,V(3),V01(3),V02(3)
|
||||
INTEGER N
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,RXY2,XI2,ETA2P1,SDF,R2,R,C
|
||||
|
||||
|
||||
X=V(1)
|
||||
Y=V(2)
|
||||
Z=V(3)
|
||||
RXY2=X*X+Y*Y
|
||||
XI2=XI*XI
|
||||
ETA2P1=ETA*ETA+1D0
|
||||
SDF=Z*SQRT(XI2+ETA2P1)
|
||||
R2=RXY2*ETA2P1-Z*Z*XI2
|
||||
IF (R2.GT.0D0) THEN
|
||||
R=SQRT(R2)
|
||||
C=(SDF*ETA+R)/(ETA2P1*SQRT(RXY2*(R2+XI2)))
|
||||
V01(1)=C*(X*R+Y*XI)
|
||||
V01(2)=C*(Y*R-X*XI)
|
||||
V01(3)=(SDF-ETA*R)/ETA2P1
|
||||
R=-R
|
||||
C=(SDF*ETA+R)/(ETA2P1*SQRT(RXY2*(R2+XI2)))
|
||||
V02(1)=C*(X*R+Y*XI)
|
||||
V02(2)=C*(Y*R-X*XI)
|
||||
V02(3)=(SDF-ETA*R)/ETA2P1
|
||||
IF (ABS(SDF).LT.1D0) THEN
|
||||
N=1
|
||||
ELSE
|
||||
N=2
|
||||
END IF
|
||||
ELSE
|
||||
N=0
|
||||
END IF
|
||||
|
||||
END
|
||||
63
slalib/dtt.f
Normal file
63
slalib/dtt.f
Normal file
@ -0,0 +1,63 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DTT (UTC)
|
||||
*+
|
||||
* - - - -
|
||||
* D T T
|
||||
* - - - -
|
||||
*
|
||||
* Increment to be applied to Coordinated Universal Time UTC to give
|
||||
* Terrestrial Time TT (formerly Ephemeris Time ET)
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* UTC d UTC date as a modified JD (JD-2400000.5)
|
||||
*
|
||||
* Result: TT-UTC in seconds
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The UTC is specified to be a date rather than a time to indicate
|
||||
* that care needs to be taken not to specify an instant which lies
|
||||
* within a leap second. Though in most cases UTC can include the
|
||||
* fractional part, correct behaviour on the day of a leap second
|
||||
* can only be guaranteed up to the end of the second 23:59:59.
|
||||
*
|
||||
* 2 Pre 1972 January 1 a fixed value of 10 + ET-TAI is returned.
|
||||
*
|
||||
* 3 See also the routine sla_DT, which roughly estimates ET-UT for
|
||||
* historical epochs.
|
||||
*
|
||||
* Called: sla_DAT
|
||||
*
|
||||
* P.T.Wallace Starlink 6 December 1994
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION UTC
|
||||
|
||||
DOUBLE PRECISION sla_DAT
|
||||
|
||||
|
||||
sla_DTT=32.184D0+sla_DAT(UTC)
|
||||
|
||||
END
|
||||
95
slalib/dv2tp.f
Normal file
95
slalib/dv2tp.f
Normal file
@ -0,0 +1,95 @@
|
||||
SUBROUTINE sla_DV2TP (V, V0, XI, ETA, J)
|
||||
*+
|
||||
* - - - - - -
|
||||
* D V 2 T P
|
||||
* - - - - - -
|
||||
*
|
||||
* Given the direction cosines of a star and of the tangent point,
|
||||
* determine the star's tangent-plane coordinates.
|
||||
*
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V d(3) direction cosines of star
|
||||
* V0 d(3) direction cosines of tangent point
|
||||
*
|
||||
* Returned:
|
||||
* XI,ETA d tangent plane coordinates of star
|
||||
* J i status: 0 = OK
|
||||
* 1 = error, star too far from axis
|
||||
* 2 = error, antistar on tangent plane
|
||||
* 3 = error, antistar too far from axis
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 If vector V0 is not of unit length, or if vector V is of zero
|
||||
* length, the results will be wrong.
|
||||
*
|
||||
* 2 If V0 points at a pole, the returned XI,ETA will be based on the
|
||||
* arbitrary assumption that the RA of the tangent point is zero.
|
||||
*
|
||||
* 3 This routine is the Cartesian equivalent of the routine sla_DS2TP.
|
||||
*
|
||||
* P.T.Wallace Starlink 27 November 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V(3),V0(3),XI,ETA
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION X,Y,Z,X0,Y0,Z0,R2,R,W,D
|
||||
|
||||
DOUBLE PRECISION TINY
|
||||
PARAMETER (TINY=1D-6)
|
||||
|
||||
|
||||
X=V(1)
|
||||
Y=V(2)
|
||||
Z=V(3)
|
||||
X0=V0(1)
|
||||
Y0=V0(2)
|
||||
Z0=V0(3)
|
||||
R2=X0*X0+Y0*Y0
|
||||
R=SQRT(R2)
|
||||
IF (R.EQ.0D0) THEN
|
||||
R=1D-20
|
||||
X0=R
|
||||
END IF
|
||||
W=X*X0+Y*Y0
|
||||
D=W+Z*Z0
|
||||
IF (D.GT.TINY) THEN
|
||||
J=0
|
||||
ELSE IF (D.GE.0D0) THEN
|
||||
J=1
|
||||
D=TINY
|
||||
ELSE IF (D.GT.-TINY) THEN
|
||||
J=2
|
||||
D=-TINY
|
||||
ELSE
|
||||
J=3
|
||||
END IF
|
||||
D=D*R
|
||||
XI=(Y*X0-X*Y0)/D
|
||||
ETA=(Z*R2-Z0*W)/D
|
||||
|
||||
END
|
||||
44
slalib/dvdv.f
Normal file
44
slalib/dvdv.f
Normal file
@ -0,0 +1,44 @@
|
||||
DOUBLE PRECISION FUNCTION sla_DVDV (VA, VB)
|
||||
*+
|
||||
* - - - - -
|
||||
* D V D V
|
||||
* - - - - -
|
||||
*
|
||||
* Scalar product of two 3-vectors (double precision)
|
||||
*
|
||||
* Given:
|
||||
* VA dp(3) first vector
|
||||
* VB dp(3) second vector
|
||||
*
|
||||
* The result is the scalar product VA.VB (double precision)
|
||||
*
|
||||
* P.T.Wallace Starlink November 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION VA(3),VB(3)
|
||||
|
||||
|
||||
sla_DVDV=VA(1)*VB(1)+VA(2)*VB(2)+VA(3)*VB(3)
|
||||
|
||||
END
|
||||
69
slalib/dvn.f
Normal file
69
slalib/dvn.f
Normal file
@ -0,0 +1,69 @@
|
||||
SUBROUTINE sla_DVN (V, UV, VM)
|
||||
*+
|
||||
* - - - -
|
||||
* D V N
|
||||
* - - - -
|
||||
*
|
||||
* Normalizes a 3-vector also giving the modulus (double precision)
|
||||
*
|
||||
* Given:
|
||||
* V d(3) vector
|
||||
*
|
||||
* Returned:
|
||||
* UV d(3) unit vector in direction of V
|
||||
* VM d modulus of V
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 If the modulus of V is zero, UV is set to zero as well.
|
||||
*
|
||||
* 2 To comply with the ANSI Fortran 77 standard, V and UV must be
|
||||
* different arrays. However, the routine is coded so as to work
|
||||
* properly on most platforms even if this rule is violated.
|
||||
*
|
||||
* Last revision: 22 July 2004
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION V(3),UV(3),VM
|
||||
|
||||
INTEGER I
|
||||
DOUBLE PRECISION W1,W2
|
||||
|
||||
|
||||
* Modulus.
|
||||
W1 = 0D0
|
||||
DO I=1,3
|
||||
W2 = V(I)
|
||||
W1 = W1+W2*W2
|
||||
END DO
|
||||
W1 = SQRT(W1)
|
||||
VM = W1
|
||||
|
||||
* Normalize the vector.
|
||||
IF (W1.LE.0D0) W1 = 1D0
|
||||
DO I=1,3
|
||||
UV(I) = V(I)/W1
|
||||
END DO
|
||||
|
||||
END
|
||||
56
slalib/dvxv.f
Normal file
56
slalib/dvxv.f
Normal file
@ -0,0 +1,56 @@
|
||||
SUBROUTINE sla_DVXV (VA, VB, VC)
|
||||
*+
|
||||
* - - - - -
|
||||
* D V X V
|
||||
* - - - - -
|
||||
*
|
||||
* Vector product of two 3-vectors (double precision)
|
||||
*
|
||||
* Given:
|
||||
* VA dp(3) first vector
|
||||
* VB dp(3) second vector
|
||||
*
|
||||
* Returned:
|
||||
* VC dp(3) vector result
|
||||
*
|
||||
* P.T.Wallace Starlink March 1986
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION VA(3),VB(3),VC(3)
|
||||
|
||||
DOUBLE PRECISION VW(3)
|
||||
INTEGER I
|
||||
|
||||
|
||||
* Form the vector product VA cross VB
|
||||
VW(1)=VA(2)*VB(3)-VA(3)*VB(2)
|
||||
VW(2)=VA(3)*VB(1)-VA(1)*VB(3)
|
||||
VW(3)=VA(1)*VB(2)-VA(2)*VB(1)
|
||||
|
||||
* Return the result
|
||||
DO I=1,3
|
||||
VC(I)=VW(I)
|
||||
END DO
|
||||
|
||||
END
|
||||
106
slalib/e2h.f
Normal file
106
slalib/e2h.f
Normal file
@ -0,0 +1,106 @@
|
||||
SUBROUTINE sla_E2H (HA, DEC, PHI, AZ, EL)
|
||||
*+
|
||||
* - - - -
|
||||
* E 2 H
|
||||
* - - - -
|
||||
*
|
||||
* Equatorial to horizon coordinates: HA,Dec to Az,El
|
||||
*
|
||||
* (single precision)
|
||||
*
|
||||
* Given:
|
||||
* HA r hour angle
|
||||
* DEC r declination
|
||||
* PHI r observatory latitude
|
||||
*
|
||||
* Returned:
|
||||
* AZ r azimuth
|
||||
* EL r elevation
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) All the arguments are angles in radians.
|
||||
*
|
||||
* 2) Azimuth is returned in the range 0-2pi; north is zero,
|
||||
* and east is +pi/2. Elevation is returned in the range
|
||||
* +/-pi/2.
|
||||
*
|
||||
* 3) The latitude must be geodetic. In critical applications,
|
||||
* corrections for polar motion should be applied.
|
||||
*
|
||||
* 4) In some applications it will be important to specify the
|
||||
* correct type of hour angle and declination in order to
|
||||
* produce the required type of azimuth and elevation. In
|
||||
* particular, it may be important to distinguish between
|
||||
* elevation as affected by refraction, which would
|
||||
* require the "observed" HA,Dec, and the elevation
|
||||
* in vacuo, which would require the "topocentric" HA,Dec.
|
||||
* If the effects of diurnal aberration can be neglected, the
|
||||
* "apparent" HA,Dec may be used instead of the topocentric
|
||||
* HA,Dec.
|
||||
*
|
||||
* 5) No range checking of arguments is carried out.
|
||||
*
|
||||
* 6) In applications which involve many such calculations, rather
|
||||
* than calling the present routine it will be more efficient to
|
||||
* use inline code, having previously computed fixed terms such
|
||||
* as sine and cosine of latitude, and (for tracking a star)
|
||||
* sine and cosine of declination.
|
||||
*
|
||||
* P.T.Wallace Starlink 9 July 1994
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL HA,DEC,PHI,AZ,EL
|
||||
|
||||
REAL R2PI
|
||||
PARAMETER (R2PI=6.283185307179586476925286766559)
|
||||
|
||||
REAL SH,CH,SD,CD,SP,CP,X,Y,Z,R,A
|
||||
|
||||
|
||||
* Useful trig functions
|
||||
SH=SIN(HA)
|
||||
CH=COS(HA)
|
||||
SD=SIN(DEC)
|
||||
CD=COS(DEC)
|
||||
SP=SIN(PHI)
|
||||
CP=COS(PHI)
|
||||
|
||||
* Az,El as x,y,z
|
||||
X=-CH*CD*SP+SD*CP
|
||||
Y=-SH*CD
|
||||
Z=CH*CD*CP+SD*SP
|
||||
|
||||
* To spherical
|
||||
R=SQRT(X*X+Y*Y)
|
||||
IF (R.EQ.0.0) THEN
|
||||
A=0.0
|
||||
ELSE
|
||||
A=ATAN2(Y,X)
|
||||
END IF
|
||||
IF (A.LT.0.0) A=A+R2PI
|
||||
AZ=A
|
||||
EL=ATAN2(Z,R)
|
||||
|
||||
END
|
||||
129
slalib/earth.f
Normal file
129
slalib/earth.f
Normal file
@ -0,0 +1,129 @@
|
||||
SUBROUTINE sla_EARTH (IY, ID, FD, PV)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E A R T H
|
||||
* - - - - - -
|
||||
*
|
||||
* Approximate heliocentric position and velocity of the Earth
|
||||
*
|
||||
* Given:
|
||||
* IY I year
|
||||
* ID I day in year (1 = Jan 1st)
|
||||
* FD R fraction of day
|
||||
*
|
||||
* Returned:
|
||||
* PV R(6) Earth position & velocity vector
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The date and time is TDB (loosely ET) in a Julian calendar
|
||||
* which has been aligned to the ordinary Gregorian
|
||||
* calendar for the interval 1900 March 1 to 2100 February 28.
|
||||
* The year and day can be obtained by calling sla_CALYD or
|
||||
* sla_CLYD.
|
||||
*
|
||||
* 2 The Earth heliocentric 6-vector is mean equator and equinox
|
||||
* of date. Position part, PV(1-3), is in AU; velocity part,
|
||||
* PV(4-6), is in AU/sec.
|
||||
*
|
||||
* 3 Max/RMS errors 1950-2050:
|
||||
* 13/5 E-5 AU = 19200/7600 km in position
|
||||
* 47/26 E-10 AU/s = 0.0070/0.0039 km/s in speed
|
||||
*
|
||||
* 4 More accurate results are obtainable with the routines sla_EVP
|
||||
* and sla_EPV.
|
||||
*
|
||||
* Last revision: 5 April 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
INTEGER IY,ID
|
||||
REAL FD,PV(6)
|
||||
|
||||
INTEGER IY4
|
||||
REAL TWOPI,SPEED,REMB,SEMB,YI,YF,T,ELM,GAMMA,EM,ELT,EPS0,
|
||||
: E,ESQ,V,R,ELMM,COSELT,SINEPS,COSEPS,W1,W2,SELMM,CELMM
|
||||
|
||||
PARAMETER (TWOPI=6.28318530718)
|
||||
|
||||
* Mean orbital speed of Earth, AU/s
|
||||
PARAMETER (SPEED=1.9913E-7)
|
||||
|
||||
* Mean Earth:EMB distance and speed, AU and AU/s
|
||||
PARAMETER (REMB=3.12E-5,SEMB=8.31E-11)
|
||||
|
||||
|
||||
|
||||
* Whole years & fraction of year, and years since J1900.0
|
||||
YI=FLOAT(IY-1900)
|
||||
IY4=MOD(MOD(IY,4)+4,4)
|
||||
YF=(FLOAT(4*(ID-1/(IY4+1))-IY4-2)+4.0*FD)/1461.0
|
||||
T=YI+YF
|
||||
|
||||
* Geometric mean longitude of Sun
|
||||
* (cf 4.881627938+6.283319509911*T MOD 2PI)
|
||||
ELM=MOD(4.881628+TWOPI*YF+0.00013420*T,TWOPI)
|
||||
|
||||
* Mean longitude of perihelion
|
||||
GAMMA=4.908230+3.0005E-4*T
|
||||
|
||||
* Mean anomaly
|
||||
EM=ELM-GAMMA
|
||||
|
||||
* Mean obliquity
|
||||
EPS0=0.40931975-2.27E-6*T
|
||||
|
||||
* Eccentricity
|
||||
E=0.016751-4.2E-7*T
|
||||
ESQ=E*E
|
||||
|
||||
* True anomaly
|
||||
V=EM+2.0*E*SIN(EM)+1.25*ESQ*SIN(2.0*EM)
|
||||
|
||||
* True ecliptic longitude
|
||||
ELT=V+GAMMA
|
||||
|
||||
* True distance
|
||||
R=(1.0-ESQ)/(1.0+E*COS(V))
|
||||
|
||||
* Moon's mean longitude
|
||||
ELMM=MOD(4.72+83.9971*T,TWOPI)
|
||||
|
||||
* Useful functions
|
||||
COSELT=COS(ELT)
|
||||
SINEPS=SIN(EPS0)
|
||||
COSEPS=COS(EPS0)
|
||||
W1=-R*SIN(ELT)
|
||||
W2=-SPEED*(COSELT+E*COS(GAMMA))
|
||||
SELMM=SIN(ELMM)
|
||||
CELMM=COS(ELMM)
|
||||
|
||||
* Earth position and velocity
|
||||
PV(1)=-R*COSELT-REMB*CELMM
|
||||
PV(2)=(W1-REMB*SELMM)*COSEPS
|
||||
PV(3)=W1*SINEPS
|
||||
PV(4)=SPEED*(SIN(ELT)+E*SIN(GAMMA))+SEMB*SELMM
|
||||
PV(5)=(W2-SEMB*CELMM)*COSEPS
|
||||
PV(6)=W2*SINEPS
|
||||
|
||||
END
|
||||
72
slalib/ecleq.f
Normal file
72
slalib/ecleq.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_ECLEQ (DL, DB, DATE, DR, DD)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E C L E Q
|
||||
* - - - - - -
|
||||
*
|
||||
* Transformation from ecliptic coordinates to
|
||||
* J2000.0 equatorial coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DL,DB dp ecliptic longitude and latitude
|
||||
* (mean of date, IAU 1980 theory, radians)
|
||||
* DATE dp TDB (loosely ET) as Modified Julian Date
|
||||
* (JD-2400000.5)
|
||||
* Returned:
|
||||
* DR,DD dp J2000.0 mean RA,Dec (radians)
|
||||
*
|
||||
* Called:
|
||||
* sla_DCS2C, sla_ECMAT, sla_DIMXV, sla_PREC, sla_EPJ, sla_DCC2S,
|
||||
* sla_DRANRM, sla_DRANGE
|
||||
*
|
||||
* P.T.Wallace Starlink March 1986
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DL,DB,DATE,DR,DD
|
||||
|
||||
DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE
|
||||
|
||||
DOUBLE PRECISION RMAT(3,3),V1(3),V2(3)
|
||||
|
||||
|
||||
|
||||
* Spherical to Cartesian
|
||||
CALL sla_DCS2C(DL,DB,V1)
|
||||
|
||||
* Ecliptic to equatorial
|
||||
CALL sla_ECMAT(DATE,RMAT)
|
||||
CALL sla_DIMXV(RMAT,V1,V2)
|
||||
|
||||
* Mean of date to J2000
|
||||
CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT)
|
||||
CALL sla_DIMXV(RMAT,V2,V1)
|
||||
|
||||
* Cartesian to spherical
|
||||
CALL sla_DCC2S(V1,DR,DD)
|
||||
|
||||
* Express in conventional ranges
|
||||
DR=sla_DRANRM(DR)
|
||||
DD=sla_DRANGE(DD)
|
||||
|
||||
END
|
||||
69
slalib/ecmat.f
Normal file
69
slalib/ecmat.f
Normal file
@ -0,0 +1,69 @@
|
||||
SUBROUTINE sla_ECMAT (DATE, RMAT)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E C M A T
|
||||
* - - - - - -
|
||||
*
|
||||
* Form the equatorial to ecliptic rotation matrix - IAU 1980 theory
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DATE dp TDB (loosely ET) as Modified Julian Date
|
||||
* (JD-2400000.5)
|
||||
* Returned:
|
||||
* RMAT dp(3,3) matrix
|
||||
*
|
||||
* Reference:
|
||||
* Murray,C.A., Vectorial Astrometry, section 4.3.
|
||||
*
|
||||
* Note:
|
||||
* The matrix is in the sense V(ecl) = RMAT * V(equ); the
|
||||
* equator, equinox and ecliptic are mean of date.
|
||||
*
|
||||
* Called: sla_DEULER
|
||||
*
|
||||
* P.T.Wallace Starlink 23 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE,RMAT(3,3)
|
||||
|
||||
* Arc seconds to radians
|
||||
DOUBLE PRECISION AS2R
|
||||
PARAMETER (AS2R=0.484813681109535994D-5)
|
||||
|
||||
DOUBLE PRECISION T,EPS0
|
||||
|
||||
|
||||
|
||||
* Interval between basic epoch J2000.0 and current epoch (JC)
|
||||
T = (DATE-51544.5D0)/36525D0
|
||||
|
||||
* Mean obliquity
|
||||
EPS0 = AS2R*
|
||||
: (84381.448D0+(-46.8150D0+(-0.00059D0+0.001813D0*T)*T)*T)
|
||||
|
||||
* Matrix
|
||||
CALL sla_DEULER('X',EPS0,0D0,0D0,RMAT)
|
||||
|
||||
END
|
||||
95
slalib/ecor.f
Normal file
95
slalib/ecor.f
Normal file
@ -0,0 +1,95 @@
|
||||
SUBROUTINE sla_ECOR (RM, DM, IY, ID, FD, RV, TL)
|
||||
*+
|
||||
* - - - - -
|
||||
* E C O R
|
||||
* - - - - -
|
||||
*
|
||||
* Component of Earth orbit velocity and heliocentric
|
||||
* light time in a given direction (single precision)
|
||||
*
|
||||
* Given:
|
||||
* RM,DM real mean RA, Dec of date (radians)
|
||||
* IY int year
|
||||
* ID int day in year (1 = Jan 1st)
|
||||
* FD real fraction of day
|
||||
*
|
||||
* Returned:
|
||||
* RV real component of Earth orbital velocity (km/sec)
|
||||
* TL real component of heliocentric light time (sec)
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1 The date and time is TDB (loosely ET) in a Julian calendar
|
||||
* which has been aligned to the ordinary Gregorian
|
||||
* calendar for the interval 1900 March 1 to 2100 February 28.
|
||||
* The year and day can be obtained by calling sla_CALYD or
|
||||
* sla_CLYD.
|
||||
*
|
||||
* 2 Sign convention:
|
||||
*
|
||||
* The velocity component is +ve when the Earth is receding from
|
||||
* the given point on the sky. The light time component is +ve
|
||||
* when the Earth lies between the Sun and the given point on
|
||||
* the sky.
|
||||
*
|
||||
* 3 Accuracy:
|
||||
*
|
||||
* The velocity component is usually within 0.004 km/s of the
|
||||
* correct value and is never in error by more than 0.007 km/s.
|
||||
* The error in light time correction is about 0.03s at worst,
|
||||
* but is usually better than 0.01s. For applications requiring
|
||||
* higher accuracy, see the sla_EVP and sla_EPV routines.
|
||||
*
|
||||
* Called: sla_EARTH, sla_CS2C, sla_VDV
|
||||
*
|
||||
* Last revision: 5 April 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL RM,DM
|
||||
INTEGER IY,ID
|
||||
REAL FD,RV,TL
|
||||
|
||||
REAL sla_VDV
|
||||
|
||||
REAL PV(6),V(3),AUKM,AUSEC
|
||||
|
||||
* AU to km and light sec (1985 Almanac)
|
||||
PARAMETER (AUKM=1.4959787066E8,
|
||||
: AUSEC=499.0047837)
|
||||
|
||||
|
||||
|
||||
* Sun:Earth position & velocity vector
|
||||
CALL sla_EARTH(IY,ID,FD,PV)
|
||||
|
||||
* Star position vector
|
||||
CALL sla_CS2C(RM,DM,V)
|
||||
|
||||
* Velocity component
|
||||
RV=-AUKM*sla_VDV(PV(4),V)
|
||||
|
||||
* Light time component
|
||||
TL=AUSEC*sla_VDV(PV(1),V)
|
||||
|
||||
END
|
||||
107
slalib/eg50.f
Normal file
107
slalib/eg50.f
Normal file
@ -0,0 +1,107 @@
|
||||
SUBROUTINE sla_EG50 (DR, DD, DL, DB)
|
||||
*+
|
||||
* - - - - -
|
||||
* E G 5 0
|
||||
* - - - - -
|
||||
*
|
||||
* Transformation from B1950.0 'FK4' equatorial coordinates to
|
||||
* IAU 1958 galactic coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DR,DD dp B1950.0 'FK4' RA,Dec
|
||||
*
|
||||
* Returned:
|
||||
* DL,DB dp galactic longitude and latitude L2,B2
|
||||
*
|
||||
* (all arguments are radians)
|
||||
*
|
||||
* Called:
|
||||
* sla_DCS2C, sla_DMXV, sla_DCC2S, sla_SUBET, sla_DRANRM, sla_DRANGE
|
||||
*
|
||||
* Note:
|
||||
* The equatorial coordinates are B1950.0 'FK4'. Use the
|
||||
* routine sla_EQGAL if conversion from J2000.0 coordinates
|
||||
* is required.
|
||||
*
|
||||
* Reference:
|
||||
* Blaauw et al, Mon.Not.R.Astron.Soc.,121,123 (1960)
|
||||
*
|
||||
* P.T.Wallace Starlink 5 September 1993
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DR,DD,DL,DB
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM,sla_DRANGE
|
||||
|
||||
DOUBLE PRECISION V1(3),V2(3),R,D
|
||||
|
||||
*
|
||||
* L2,B2 system of galactic coordinates
|
||||
*
|
||||
* P = 192.25 RA of galactic north pole (mean B1950.0)
|
||||
* Q = 62.6 inclination of galactic to mean B1950.0 equator
|
||||
* R = 33 longitude of ascending node
|
||||
*
|
||||
* P,Q,R are degrees
|
||||
*
|
||||
*
|
||||
* Equatorial to galactic rotation matrix
|
||||
*
|
||||
* The Euler angles are P, Q, 90-R, about the z then y then
|
||||
* z axes.
|
||||
*
|
||||
* +CP.CQ.SR-SP.CR +SP.CQ.SR+CP.CR -SQ.SR
|
||||
*
|
||||
* -CP.CQ.CR-SP.SR -SP.CQ.CR+CP.SR +SQ.CR
|
||||
*
|
||||
* +CP.SQ +SP.SQ +CQ
|
||||
*
|
||||
|
||||
DOUBLE PRECISION RMAT(3,3)
|
||||
DATA RMAT(1,1),RMAT(1,2),RMAT(1,3),
|
||||
: RMAT(2,1),RMAT(2,2),RMAT(2,3),
|
||||
: RMAT(3,1),RMAT(3,2),RMAT(3,3) /
|
||||
: -0.066988739415D0,-0.872755765852D0,-0.483538914632D0,
|
||||
: +0.492728466075D0,-0.450346958020D0,+0.744584633283D0,
|
||||
: -0.867600811151D0,-0.188374601723D0,+0.460199784784D0 /
|
||||
|
||||
|
||||
|
||||
* Remove E-terms
|
||||
CALL sla_SUBET(DR,DD,1950D0,R,D)
|
||||
|
||||
* Spherical to Cartesian
|
||||
CALL sla_DCS2C(R,D,V1)
|
||||
|
||||
* Rotate to galactic
|
||||
CALL sla_DMXV(RMAT,V1,V2)
|
||||
|
||||
* Cartesian to spherical
|
||||
CALL sla_DCC2S(V2,DL,DB)
|
||||
|
||||
* Express angles in conventional ranges
|
||||
DL=sla_DRANRM(DL)
|
||||
DB=sla_DRANGE(DB)
|
||||
|
||||
END
|
||||
328
slalib/el2ue.f
Normal file
328
slalib/el2ue.f
Normal file
@ -0,0 +1,328 @@
|
||||
SUBROUTINE sla_EL2UE (DATE, JFORM, EPOCH, ORBINC, ANODE,
|
||||
: PERIH, AORQ, E, AORL, DM,
|
||||
: U, JSTAT)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E L 2 U E
|
||||
* - - - - - -
|
||||
*
|
||||
* Transform conventional osculating orbital elements into "universal"
|
||||
* form.
|
||||
*
|
||||
* Given:
|
||||
* DATE d epoch (TT MJD) of osculation (Note 3)
|
||||
* JFORM i choice of element set (1-3, Note 6)
|
||||
* EPOCH d epoch (TT MJD) of the elements
|
||||
* ORBINC d inclination (radians)
|
||||
* ANODE d longitude of the ascending node (radians)
|
||||
* PERIH d longitude or argument of perihelion (radians)
|
||||
* AORQ d mean distance or perihelion distance (AU)
|
||||
* E d eccentricity
|
||||
* AORL d mean anomaly or longitude (radians, JFORM=1,2 only)
|
||||
* DM d daily motion (radians, JFORM=1 only)
|
||||
*
|
||||
* Returned:
|
||||
* U d(13) universal orbital elements (Note 1)
|
||||
*
|
||||
* (1) combined mass (M+m)
|
||||
* (2) total energy of the orbit (alpha)
|
||||
* (3) reference (osculating) epoch (t0)
|
||||
* (4-6) position at reference epoch (r0)
|
||||
* (7-9) velocity at reference epoch (v0)
|
||||
* (10) heliocentric distance at reference epoch
|
||||
* (11) r0.v0
|
||||
* (12) date (t)
|
||||
* (13) universal eccentric anomaly (psi) of date, approx
|
||||
*
|
||||
* JSTAT i status: 0 = OK
|
||||
* -1 = illegal JFORM
|
||||
* -2 = illegal E
|
||||
* -3 = illegal AORQ
|
||||
* -4 = illegal DM
|
||||
* -5 = numerical error
|
||||
*
|
||||
* Called: sla_UE2PV, sla_PV2UE
|
||||
*
|
||||
* Notes
|
||||
*
|
||||
* 1 The "universal" elements are those which define the orbit for the
|
||||
* purposes of the method of universal variables (see reference).
|
||||
* They consist of the combined mass of the two bodies, an epoch,
|
||||
* and the position and velocity vectors (arbitrary reference frame)
|
||||
* at that epoch. The parameter set used here includes also various
|
||||
* quantities that can, in fact, be derived from the other
|
||||
* information. This approach is taken to avoiding unnecessary
|
||||
* computation and loss of accuracy. The supplementary quantities
|
||||
* are (i) alpha, which is proportional to the total energy of the
|
||||
* orbit, (ii) the heliocentric distance at epoch, (iii) the
|
||||
* outwards component of the velocity at the given epoch, (iv) an
|
||||
* estimate of psi, the "universal eccentric anomaly" at a given
|
||||
* date and (v) that date.
|
||||
*
|
||||
* 2 The companion routine is sla_UE2PV. This takes the set of numbers
|
||||
* that the present routine outputs and uses them to derive the
|
||||
* object's position and velocity. A single prediction requires one
|
||||
* call to the present routine followed by one call to sla_UE2PV;
|
||||
* for convenience, the two calls are packaged as the routine
|
||||
* sla_PLANEL. Multiple predictions may be made by again calling the
|
||||
* present routine once, but then calling sla_UE2PV multiple times,
|
||||
* which is faster than multiple calls to sla_PLANEL.
|
||||
*
|
||||
* 3 DATE is the epoch of osculation. It is in the TT timescale
|
||||
* (formerly Ephemeris Time, ET) and is a Modified Julian Date
|
||||
* (JD-2400000.5).
|
||||
*
|
||||
* 4 The supplied orbital elements are with respect to the J2000
|
||||
* ecliptic and equinox. The position and velocity parameters
|
||||
* returned in the array U are with respect to the mean equator and
|
||||
* equinox of epoch J2000, and are for the perihelion prior to the
|
||||
* specified epoch.
|
||||
*
|
||||
* 5 The universal elements returned in the array U are in canonical
|
||||
* units (solar masses, AU and canonical days).
|
||||
*
|
||||
* 6 Three different element-format options are available:
|
||||
*
|
||||
* Option JFORM=1, suitable for the major planets:
|
||||
*
|
||||
* EPOCH = epoch of elements (TT MJD)
|
||||
* ORBINC = inclination i (radians)
|
||||
* ANODE = longitude of the ascending node, big omega (radians)
|
||||
* PERIH = longitude of perihelion, curly pi (radians)
|
||||
* AORQ = mean distance, a (AU)
|
||||
* E = eccentricity, e (range 0 to <1)
|
||||
* AORL = mean longitude L (radians)
|
||||
* DM = daily motion (radians)
|
||||
*
|
||||
* Option JFORM=2, suitable for minor planets:
|
||||
*
|
||||
* EPOCH = epoch of elements (TT MJD)
|
||||
* ORBINC = inclination i (radians)
|
||||
* ANODE = longitude of the ascending node, big omega (radians)
|
||||
* PERIH = argument of perihelion, little omega (radians)
|
||||
* AORQ = mean distance, a (AU)
|
||||
* E = eccentricity, e (range 0 to <1)
|
||||
* AORL = mean anomaly M (radians)
|
||||
*
|
||||
* Option JFORM=3, suitable for comets:
|
||||
*
|
||||
* EPOCH = epoch of perihelion (TT MJD)
|
||||
* ORBINC = inclination i (radians)
|
||||
* ANODE = longitude of the ascending node, big omega (radians)
|
||||
* PERIH = argument of perihelion, little omega (radians)
|
||||
* AORQ = perihelion distance, q (AU)
|
||||
* E = eccentricity, e (range 0 to 10)
|
||||
*
|
||||
* 7 Unused elements (DM for JFORM=2, AORL and DM for JFORM=3) are
|
||||
* not accessed.
|
||||
*
|
||||
* 8 The algorithm was originally adapted from the EPHSLA program of
|
||||
* D.H.P.Jones (private communication, 1996). The method is based
|
||||
* on Stumpff's Universal Variables.
|
||||
*
|
||||
* Reference: Everhart & Pitkin, Am.J.Phys. 51, 712 (1983).
|
||||
*
|
||||
* Last revision: 8 September 2005
|
||||
*
|
||||
* Copyright P.T.Wallace. All rights reserved.
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE
|
||||
INTEGER JFORM
|
||||
DOUBLE PRECISION EPOCH,ORBINC,ANODE,PERIH,AORQ,E,AORL,DM,U(13)
|
||||
INTEGER JSTAT
|
||||
|
||||
* Gaussian gravitational constant (exact)
|
||||
DOUBLE PRECISION GCON
|
||||
PARAMETER (GCON=0.01720209895D0)
|
||||
|
||||
* Sin and cos of J2000 mean obliquity (IAU 1976)
|
||||
DOUBLE PRECISION SE,CE
|
||||
PARAMETER (SE=0.3977771559319137D0,
|
||||
: CE=0.9174820620691818D0)
|
||||
|
||||
INTEGER J
|
||||
|
||||
DOUBLE PRECISION PHT,ARGPH,Q,W,CM,ALPHA,PHS,SW,CW,SI,CI,SO,CO,
|
||||
: X,Y,Z,PX,PY,PZ,VX,VY,VZ,DT,FC,FP,PSI,
|
||||
: UL(13),PV(6)
|
||||
|
||||
|
||||
|
||||
* Validate arguments.
|
||||
IF (JFORM.LT.1.OR.JFORM.GT.3) THEN
|
||||
JSTAT = -1
|
||||
GO TO 9999
|
||||
END IF
|
||||
IF (E.LT.0D0.OR.E.GT.10D0.OR.(E.GE.1D0.AND.JFORM.NE.3)) THEN
|
||||
JSTAT = -2
|
||||
GO TO 9999
|
||||
END IF
|
||||
IF (AORQ.LE.0D0) THEN
|
||||
JSTAT = -3
|
||||
GO TO 9999
|
||||
END IF
|
||||
IF (JFORM.EQ.1.AND.DM.LE.0D0) THEN
|
||||
JSTAT = -4
|
||||
GO TO 9999
|
||||
END IF
|
||||
|
||||
*
|
||||
* Transform elements into standard form:
|
||||
*
|
||||
* PHT = epoch of perihelion passage
|
||||
* ARGPH = argument of perihelion (little omega)
|
||||
* Q = perihelion distance (q)
|
||||
* CM = combined mass, M+m (mu)
|
||||
|
||||
IF (JFORM.EQ.1) THEN
|
||||
|
||||
* Major planet.
|
||||
PHT = EPOCH-(AORL-PERIH)/DM
|
||||
ARGPH = PERIH-ANODE
|
||||
Q = AORQ*(1D0-E)
|
||||
W = DM/GCON
|
||||
CM = W*W*AORQ*AORQ*AORQ
|
||||
|
||||
ELSE IF (JFORM.EQ.2) THEN
|
||||
|
||||
* Minor planet.
|
||||
PHT = EPOCH-AORL*SQRT(AORQ*AORQ*AORQ)/GCON
|
||||
ARGPH = PERIH
|
||||
Q = AORQ*(1D0-E)
|
||||
CM = 1D0
|
||||
|
||||
ELSE
|
||||
|
||||
* Comet.
|
||||
PHT = EPOCH
|
||||
ARGPH = PERIH
|
||||
Q = AORQ
|
||||
CM = 1D0
|
||||
|
||||
END IF
|
||||
|
||||
* The universal variable alpha. This is proportional to the total
|
||||
* energy of the orbit: -ve for an ellipse, zero for a parabola,
|
||||
* +ve for a hyperbola.
|
||||
|
||||
ALPHA = CM*(E-1D0)/Q
|
||||
|
||||
* Speed at perihelion.
|
||||
|
||||
PHS = SQRT(ALPHA+2D0*CM/Q)
|
||||
|
||||
* In a Cartesian coordinate system which has the x-axis pointing
|
||||
* to perihelion and the z-axis normal to the orbit (such that the
|
||||
* object orbits counter-clockwise as seen from +ve z), the
|
||||
* perihelion position and velocity vectors are:
|
||||
*
|
||||
* position [Q,0,0]
|
||||
* velocity [0,PHS,0]
|
||||
*
|
||||
* To express the results in J2000 equatorial coordinates we make a
|
||||
* series of four rotations of the Cartesian axes:
|
||||
*
|
||||
* axis Euler angle
|
||||
*
|
||||
* 1 z argument of perihelion (little omega)
|
||||
* 2 x inclination (i)
|
||||
* 3 z longitude of the ascending node (big omega)
|
||||
* 4 x J2000 obliquity (epsilon)
|
||||
*
|
||||
* In each case the rotation is clockwise as seen from the +ve end of
|
||||
* the axis concerned.
|
||||
|
||||
* Functions of the Euler angles.
|
||||
SW = SIN(ARGPH)
|
||||
CW = COS(ARGPH)
|
||||
SI = SIN(ORBINC)
|
||||
CI = COS(ORBINC)
|
||||
SO = SIN(ANODE)
|
||||
CO = COS(ANODE)
|
||||
|
||||
* Position at perihelion (AU).
|
||||
X = Q*CW
|
||||
Y = Q*SW
|
||||
Z = Y*SI
|
||||
Y = Y*CI
|
||||
PX = X*CO-Y*SO
|
||||
Y = X*SO+Y*CO
|
||||
PY = Y*CE-Z*SE
|
||||
PZ = Y*SE+Z*CE
|
||||
|
||||
* Velocity at perihelion (AU per canonical day).
|
||||
X = -PHS*SW
|
||||
Y = PHS*CW
|
||||
Z = Y*SI
|
||||
Y = Y*CI
|
||||
VX = X*CO-Y*SO
|
||||
Y = X*SO+Y*CO
|
||||
VY = Y*CE-Z*SE
|
||||
VZ = Y*SE+Z*CE
|
||||
|
||||
* Time from perihelion to date (in Canonical Days: a canonical day
|
||||
* is 58.1324409... days, defined as 1/GCON).
|
||||
|
||||
DT = (DATE-PHT)*GCON
|
||||
|
||||
* First approximation to the Universal Eccentric Anomaly, PSI,
|
||||
* based on the circle (FC) and parabola (FP) values.
|
||||
|
||||
FC = DT/Q
|
||||
W = (3D0*DT+SQRT(9D0*DT*DT+8D0*Q*Q*Q))**(1D0/3D0)
|
||||
FP = W-2D0*Q/W
|
||||
PSI = (1D0-E)*FC+E*FP
|
||||
|
||||
* Assemble local copy of element set.
|
||||
UL(1) = CM
|
||||
UL(2) = ALPHA
|
||||
UL(3) = PHT
|
||||
UL(4) = PX
|
||||
UL(5) = PY
|
||||
UL(6) = PZ
|
||||
UL(7) = VX
|
||||
UL(8) = VY
|
||||
UL(9) = VZ
|
||||
UL(10) = Q
|
||||
UL(11) = 0D0
|
||||
UL(12) = DATE
|
||||
UL(13) = PSI
|
||||
|
||||
* Predict position+velocity at epoch of osculation.
|
||||
CALL sla_UE2PV(DATE,UL,PV,J)
|
||||
IF (J.NE.0) GO TO 9010
|
||||
|
||||
* Convert back to universal elements.
|
||||
CALL sla_PV2UE(PV,DATE,CM-1D0,U,J)
|
||||
IF (J.NE.0) GO TO 9010
|
||||
|
||||
* OK exit.
|
||||
JSTAT = 0
|
||||
GO TO 9999
|
||||
|
||||
* Quasi-impossible numerical errors.
|
||||
9010 CONTINUE
|
||||
JSTAT = -5
|
||||
|
||||
9999 CONTINUE
|
||||
END
|
||||
47
slalib/epb.f
Normal file
47
slalib/epb.f
Normal file
@ -0,0 +1,47 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EPB (DATE)
|
||||
*+
|
||||
* - - - -
|
||||
* E P B
|
||||
* - - - -
|
||||
*
|
||||
* Conversion of Modified Julian Date to Besselian Epoch
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DATE dp Modified Julian Date (JD - 2400000.5)
|
||||
*
|
||||
* The result is the Besselian Epoch.
|
||||
*
|
||||
* Reference:
|
||||
* Lieske,J.H., 1979. Astron.Astrophys.,73,282.
|
||||
*
|
||||
* P.T.Wallace Starlink February 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE
|
||||
|
||||
|
||||
sla_EPB = 1900D0 + (DATE-15019.81352D0)/365.242198781D0
|
||||
|
||||
END
|
||||
47
slalib/epb2d.f
Normal file
47
slalib/epb2d.f
Normal file
@ -0,0 +1,47 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EPB2D (EPB)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E P B 2 D
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of Besselian Epoch to Modified Julian Date
|
||||
* (double precision)
|
||||
*
|
||||
* Given:
|
||||
* EPB dp Besselian Epoch
|
||||
*
|
||||
* The result is the Modified Julian Date (JD - 2400000.5).
|
||||
*
|
||||
* Reference:
|
||||
* Lieske,J.H., 1979. Astron.Astrophys.,73,282.
|
||||
*
|
||||
* P.T.Wallace Starlink February 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION EPB
|
||||
|
||||
|
||||
sla_EPB2D = 15019.81352D0 + (EPB-1900D0)*365.242198781D0
|
||||
|
||||
END
|
||||
68
slalib/epco.f
Normal file
68
slalib/epco.f
Normal file
@ -0,0 +1,68 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EPCO (K0, K, E)
|
||||
*+
|
||||
* - - - - -
|
||||
* E P C O
|
||||
* - - - - -
|
||||
*
|
||||
* Convert an epoch into the appropriate form - 'B' or 'J'
|
||||
*
|
||||
* Given:
|
||||
* K0 char form of result: 'B'=Besselian, 'J'=Julian
|
||||
* K char form of given epoch: 'B' or 'J'
|
||||
* E dp epoch
|
||||
*
|
||||
* Called: sla_EPB, sla_EPJ2D, sla_EPJ, sla_EPB2D
|
||||
*
|
||||
* Notes:
|
||||
*
|
||||
* 1) The result is always either equal to or very close to
|
||||
* the given epoch E. The routine is required only in
|
||||
* applications where punctilious treatment of heterogeneous
|
||||
* mixtures of star positions is necessary.
|
||||
*
|
||||
* 2) K0 and K are not validated. They are interpreted as follows:
|
||||
*
|
||||
* o If K0 and K are the same the result is E.
|
||||
* o If K0 is 'B' or 'b' and K isn't, the conversion is J to B.
|
||||
* o In all other cases, the conversion is B to J.
|
||||
*
|
||||
* Note that K0 and K won't match if their cases differ.
|
||||
*
|
||||
* P.T.Wallace Starlink 5 September 1993
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) K0,K
|
||||
DOUBLE PRECISION E
|
||||
DOUBLE PRECISION sla_EPB,sla_EPJ2D,sla_EPJ,sla_EPB2D
|
||||
|
||||
|
||||
IF (K.EQ.K0) THEN
|
||||
sla_EPCO=E
|
||||
ELSE IF (K0.EQ.'B'.OR.K0.EQ.'b') THEN
|
||||
sla_EPCO=sla_EPB(sla_EPJ2D(E))
|
||||
ELSE
|
||||
sla_EPCO=sla_EPJ(sla_EPB2D(E))
|
||||
END IF
|
||||
|
||||
END
|
||||
46
slalib/epj.f
Normal file
46
slalib/epj.f
Normal file
@ -0,0 +1,46 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EPJ (DATE)
|
||||
*+
|
||||
* - - - -
|
||||
* E P J
|
||||
* - - - -
|
||||
*
|
||||
* Conversion of Modified Julian Date to Julian Epoch (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DATE dp Modified Julian Date (JD - 2400000.5)
|
||||
*
|
||||
* The result is the Julian Epoch.
|
||||
*
|
||||
* Reference:
|
||||
* Lieske,J.H., 1979. Astron.Astrophys.,73,282.
|
||||
*
|
||||
* P.T.Wallace Starlink February 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE
|
||||
|
||||
|
||||
sla_EPJ = 2000D0 + (DATE-51544.5D0)/365.25D0
|
||||
|
||||
END
|
||||
46
slalib/epj2d.f
Normal file
46
slalib/epj2d.f
Normal file
@ -0,0 +1,46 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EPJ2D (EPJ)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E P J 2 D
|
||||
* - - - - - -
|
||||
*
|
||||
* Conversion of Julian Epoch to Modified Julian Date (double precision)
|
||||
*
|
||||
* Given:
|
||||
* EPJ dp Julian Epoch
|
||||
*
|
||||
* The result is the Modified Julian Date (JD - 2400000.5).
|
||||
*
|
||||
* Reference:
|
||||
* Lieske,J.H., 1979. Astron.Astrophys.,73,282.
|
||||
*
|
||||
* P.T.Wallace Starlink February 1984
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION EPJ
|
||||
|
||||
|
||||
sla_EPJ2D = 51544.5D0 + (EPJ-2000D0)*365.25D0
|
||||
|
||||
END
|
||||
2508
slalib/epv.f
Normal file
2508
slalib/epv.f
Normal file
File diff suppressed because it is too large
Load Diff
72
slalib/eqecl.f
Normal file
72
slalib/eqecl.f
Normal file
@ -0,0 +1,72 @@
|
||||
SUBROUTINE sla_EQECL (DR, DD, DATE, DL, DB)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E Q E C L
|
||||
* - - - - - -
|
||||
*
|
||||
* Transformation from J2000.0 equatorial coordinates to
|
||||
* ecliptic coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DR,DD dp J2000.0 mean RA,Dec (radians)
|
||||
* DATE dp TDB (loosely ET) as Modified Julian Date
|
||||
* (JD-2400000.5)
|
||||
* Returned:
|
||||
* DL,DB dp ecliptic longitude and latitude
|
||||
* (mean of date, IAU 1980 theory, radians)
|
||||
*
|
||||
* Called:
|
||||
* sla_DCS2C, sla_PREC, sla_EPJ, sla_DMXV, sla_ECMAT, sla_DCC2S,
|
||||
* sla_DRANRM, sla_DRANGE
|
||||
*
|
||||
* P.T.Wallace Starlink March 1986
|
||||
*
|
||||
* Copyright (C) 1995 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DR,DD,DATE,DL,DB
|
||||
|
||||
DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE
|
||||
|
||||
DOUBLE PRECISION RMAT(3,3),V1(3),V2(3)
|
||||
|
||||
|
||||
|
||||
* Spherical to Cartesian
|
||||
CALL sla_DCS2C(DR,DD,V1)
|
||||
|
||||
* Mean J2000 to mean of date
|
||||
CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT)
|
||||
CALL sla_DMXV(RMAT,V1,V2)
|
||||
|
||||
* Equatorial to ecliptic
|
||||
CALL sla_ECMAT(DATE,RMAT)
|
||||
CALL sla_DMXV(RMAT,V2,V1)
|
||||
|
||||
* Cartesian to spherical
|
||||
CALL sla_DCC2S(V1,DL,DB)
|
||||
|
||||
* Express in conventional ranges
|
||||
DL=sla_DRANRM(DL)
|
||||
DB=sla_DRANGE(DB)
|
||||
|
||||
END
|
||||
74
slalib/eqeqx.f
Normal file
74
slalib/eqeqx.f
Normal file
@ -0,0 +1,74 @@
|
||||
DOUBLE PRECISION FUNCTION sla_EQEQX (DATE)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E Q E Q X
|
||||
* - - - - - -
|
||||
*
|
||||
* Equation of the equinoxes (IAU 1994, double precision)
|
||||
*
|
||||
* Given:
|
||||
* DATE dp TDB (loosely ET) as Modified Julian Date
|
||||
* (JD-2400000.5)
|
||||
*
|
||||
* The result is the equation of the equinoxes (double precision)
|
||||
* in radians:
|
||||
*
|
||||
* Greenwich apparent ST = GMST + sla_EQEQX
|
||||
*
|
||||
* References: IAU Resolution C7, Recommendation 3 (1994)
|
||||
* Capitaine, N. & Gontier, A.-M., Astron. Astrophys.,
|
||||
* 275, 645-650 (1993)
|
||||
*
|
||||
* Called: sla_NUTC
|
||||
*
|
||||
* Patrick Wallace Starlink 23 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DATE
|
||||
|
||||
* Turns to arc seconds and arc seconds to radians
|
||||
DOUBLE PRECISION T2AS,AS2R
|
||||
PARAMETER (T2AS=1296000D0,
|
||||
: AS2R=0.484813681109535994D-5)
|
||||
|
||||
DOUBLE PRECISION T,OM,DPSI,DEPS,EPS0
|
||||
|
||||
|
||||
|
||||
* Interval between basic epoch J2000.0 and current epoch (JC)
|
||||
T=(DATE-51544.5D0)/36525D0
|
||||
|
||||
* Longitude of the mean ascending node of the lunar orbit on the
|
||||
* ecliptic, measured from the mean equinox of date
|
||||
OM=AS2R*(450160.280D0+(-5D0*T2AS-482890.539D0
|
||||
: +(7.455D0+0.008D0*T)*T)*T)
|
||||
|
||||
* Nutation
|
||||
CALL sla_NUTC(DATE,DPSI,DEPS,EPS0)
|
||||
|
||||
* Equation of the equinoxes
|
||||
sla_EQEQX=DPSI*COS(EPS0)+AS2R*(0.00264D0*SIN(OM)+
|
||||
: 0.000063D0*SIN(OM+OM))
|
||||
|
||||
END
|
||||
96
slalib/eqgal.f
Normal file
96
slalib/eqgal.f
Normal file
@ -0,0 +1,96 @@
|
||||
SUBROUTINE sla_EQGAL (DR, DD, DL, DB)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E Q G A L
|
||||
* - - - - - -
|
||||
*
|
||||
* Transformation from J2000.0 equatorial coordinates to
|
||||
* IAU 1958 galactic coordinates (double precision)
|
||||
*
|
||||
* Given:
|
||||
* DR,DD dp J2000.0 RA,Dec
|
||||
*
|
||||
* Returned:
|
||||
* DL,DB dp galactic longitude and latitude L2,B2
|
||||
*
|
||||
* (all arguments are radians)
|
||||
*
|
||||
* Called:
|
||||
* sla_DCS2C, sla_DMXV, sla_DCC2S, sla_DRANRM, sla_DRANGE
|
||||
*
|
||||
* Note:
|
||||
* The equatorial coordinates are J2000.0. Use the routine
|
||||
* sla_EG50 if conversion from B1950.0 'FK4' coordinates is
|
||||
* required.
|
||||
*
|
||||
* Reference:
|
||||
* Blaauw et al, Mon.Not.R.Astron.Soc.,121,123 (1960)
|
||||
*
|
||||
* P.T.Wallace Starlink 21 September 1998
|
||||
*
|
||||
* Copyright (C) 1998 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION DR,DD,DL,DB
|
||||
|
||||
DOUBLE PRECISION sla_DRANRM,sla_DRANGE
|
||||
|
||||
DOUBLE PRECISION V1(3),V2(3)
|
||||
|
||||
*
|
||||
* L2,B2 system of galactic coordinates
|
||||
*
|
||||
* P = 192.25 RA of galactic north pole (mean B1950.0)
|
||||
* Q = 62.6 inclination of galactic to mean B1950.0 equator
|
||||
* R = 33 longitude of ascending node
|
||||
*
|
||||
* P,Q,R are degrees
|
||||
*
|
||||
* Equatorial to galactic rotation matrix (J2000.0), obtained by
|
||||
* applying the standard FK4 to FK5 transformation, for zero proper
|
||||
* motion in FK5, to the columns of the B1950 equatorial to
|
||||
* galactic rotation matrix:
|
||||
*
|
||||
DOUBLE PRECISION RMAT(3,3)
|
||||
DATA RMAT(1,1),RMAT(1,2),RMAT(1,3),
|
||||
: RMAT(2,1),RMAT(2,2),RMAT(2,3),
|
||||
: RMAT(3,1),RMAT(3,2),RMAT(3,3)/
|
||||
: -0.054875539726D0,-0.873437108010D0,-0.483834985808D0,
|
||||
: +0.494109453312D0,-0.444829589425D0,+0.746982251810D0,
|
||||
: -0.867666135858D0,-0.198076386122D0,+0.455983795705D0/
|
||||
|
||||
|
||||
|
||||
* Spherical to Cartesian
|
||||
CALL sla_DCS2C(DR,DD,V1)
|
||||
|
||||
* Equatorial to galactic
|
||||
CALL sla_DMXV(RMAT,V1,V2)
|
||||
|
||||
* Cartesian to spherical
|
||||
CALL sla_DCC2S(V2,DL,DB)
|
||||
|
||||
* Express in conventional ranges
|
||||
DL=sla_DRANRM(DL)
|
||||
DB=sla_DRANGE(DB)
|
||||
|
||||
END
|
||||
79
slalib/etrms.f
Normal file
79
slalib/etrms.f
Normal file
@ -0,0 +1,79 @@
|
||||
SUBROUTINE sla_ETRMS (EP, EV)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E T R M S
|
||||
* - - - - - -
|
||||
*
|
||||
* Compute the E-terms (elliptic component of annual aberration)
|
||||
* vector (double precision)
|
||||
*
|
||||
* Given:
|
||||
* EP dp Besselian epoch
|
||||
*
|
||||
* Returned:
|
||||
* EV dp(3) E-terms as (dx,dy,dz)
|
||||
*
|
||||
* Note the use of the J2000 aberration constant (20.49552 arcsec).
|
||||
* This is a reflection of the fact that the E-terms embodied in
|
||||
* existing star catalogues were computed from a variety of
|
||||
* aberration constants. Rather than adopting one of the old
|
||||
* constants the latest value is used here.
|
||||
*
|
||||
* References:
|
||||
* 1 Smith, C.A. et al., 1989. Astr.J. 97, 265.
|
||||
* 2 Yallop, B.D. et al., 1989. Astr.J. 97, 274.
|
||||
*
|
||||
* P.T.Wallace Starlink 23 August 1996
|
||||
*
|
||||
* Copyright (C) 1996 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
DOUBLE PRECISION EP,EV(3)
|
||||
|
||||
* Arcseconds to radians
|
||||
DOUBLE PRECISION AS2R
|
||||
PARAMETER (AS2R=0.484813681109535994D-5)
|
||||
|
||||
DOUBLE PRECISION T,E,E0,P,EK,CP
|
||||
|
||||
|
||||
|
||||
* Julian centuries since B1950
|
||||
T=(EP-1950D0)*1.00002135903D-2
|
||||
|
||||
* Eccentricity
|
||||
E=0.01673011D0-(0.00004193D0+0.000000126D0*T)*T
|
||||
|
||||
* Mean obliquity
|
||||
E0=(84404.836D0-(46.8495D0+(0.00319D0+0.00181D0*T)*T)*T)*AS2R
|
||||
|
||||
* Mean longitude of perihelion
|
||||
P=(1015489.951D0+(6190.67D0+(1.65D0+0.012D0*T)*T)*T)*AS2R
|
||||
|
||||
* E-terms
|
||||
EK=E*20.49552D0*AS2R
|
||||
CP=COS(P)
|
||||
EV(1)= EK*SIN(P)
|
||||
EV(2)=-EK*CP*COS(E0)
|
||||
EV(3)=-EK*CP*SIN(E0)
|
||||
|
||||
END
|
||||
85
slalib/euler.f
Normal file
85
slalib/euler.f
Normal file
@ -0,0 +1,85 @@
|
||||
SUBROUTINE sla_EULER (ORDER, PHI, THETA, PSI, RMAT)
|
||||
*+
|
||||
* - - - - - -
|
||||
* E U L E R
|
||||
* - - - - - -
|
||||
*
|
||||
* Form a rotation matrix from the Euler angles - three successive
|
||||
* rotations about specified Cartesian axes (single precision)
|
||||
*
|
||||
* Given:
|
||||
* ORDER c*(*) specifies about which axes the rotations occur
|
||||
* PHI r 1st rotation (radians)
|
||||
* THETA r 2nd rotation ( " )
|
||||
* PSI r 3rd rotation ( " )
|
||||
*
|
||||
* Returned:
|
||||
* RMAT r(3,3) rotation matrix
|
||||
*
|
||||
* A rotation is positive when the reference frame rotates
|
||||
* anticlockwise as seen looking towards the origin from the
|
||||
* positive region of the specified axis.
|
||||
*
|
||||
* The characters of ORDER define which axes the three successive
|
||||
* rotations are about. A typical value is 'ZXZ', indicating that
|
||||
* RMAT is to become the direction cosine matrix corresponding to
|
||||
* rotations of the reference frame through PHI radians about the
|
||||
* old Z-axis, followed by THETA radians about the resulting X-axis,
|
||||
* then PSI radians about the resulting Z-axis.
|
||||
*
|
||||
* The axis names can be any of the following, in any order or
|
||||
* combination: X, Y, Z, uppercase or lowercase, 1, 2, 3. Normal
|
||||
* axis labelling/numbering conventions apply; the xyz (=123)
|
||||
* triad is right-handed. Thus, the 'ZXZ' example given above
|
||||
* could be written 'zxz' or '313' (or even 'ZxZ' or '3xZ'). ORDER
|
||||
* is terminated by length or by the first unrecognized character.
|
||||
*
|
||||
* Fewer than three rotations are acceptable, in which case the later
|
||||
* angle arguments are ignored. If all rotations are zero, the
|
||||
* identity matrix is produced.
|
||||
*
|
||||
* Called: sla_DEULER
|
||||
*
|
||||
* P.T.Wallace Starlink 23 May 1997
|
||||
*
|
||||
* Copyright (C) 1997 Rutherford Appleton Laboratory
|
||||
*
|
||||
* License:
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program (see SLA_CONDITIONS); if not, write to the
|
||||
* Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA
|
||||
*
|
||||
*-
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
CHARACTER*(*) ORDER
|
||||
REAL PHI,THETA,PSI,RMAT(3,3)
|
||||
|
||||
INTEGER J,I
|
||||
DOUBLE PRECISION W(3,3)
|
||||
|
||||
|
||||
|
||||
* Compute matrix in double precision
|
||||
CALL sla_DEULER(ORDER,DBLE(PHI),DBLE(THETA),DBLE(PSI),W)
|
||||
|
||||
* Copy the result
|
||||
DO J=1,3
|
||||
DO I=1,3
|
||||
RMAT(I,J) = REAL(W(I,J))
|
||||
END DO
|
||||
END DO
|
||||
|
||||
END
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
x
Reference in New Issue
Block a user