copy

LICENSE

@@ -1,4 +1,4 @@
-                    GNU GENERAL PUBLIC LICENSE
+GNU GENERAL PUBLIC LICENSE
                        Version 3, 29 June 2007
 
  Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
@@ -672,4 +672,3 @@ may consider it more useful to permit linking proprietary applications with
 the library.  If this is what you want to do, use the GNU Lesser General
 Public License instead of this License.  But first, please read
 <http://www.gnu.org/philosophy/why-not-lgpl.html>.
-

Makefile

@@ -0,0 +1,24 @@
+PROGRAM = bta_control
+LDFLAGS = -lcrypt -lm -lsla
+SRCS = bta_shdata.c bta_control.c cmdlnopts.c parceargs.c usefull_macros.c ch4run.c
+SRCS += angle_functions.c bta_print.c
+CC = gcc
+DEFINES = -D_XOPEN_SOURCE=666 -DEBUG
+#-DEMULATION
+CXX = gcc
+CFLAGS = -Wall -Werror -Wextra $(DEFINES) -pthread
+OBJS = $(SRCS:.c=.o)
+all : $(PROGRAM)
+$(PROGRAM) : $(OBJS)
+	$(CC) $(CFLAGS) $(OBJS) $(LDFLAGS) -o $(PROGRAM)
+
+# some addition dependencies
+# %.o: %.c
+#        $(CC) $(LDFLAGS) $(CFLAGS) $< -o $@
+#$(SRCS) : %.c : %.h $(INDEPENDENT_HEADERS)
+#        @touch $@
+
+clean:
+	/bin/rm -f *.o *~
+depend:
+	$(CXX) -MM $(CXX.SRCS)

Readme.md

@@ -0,0 +1 @@
+Simple CLI BTA client

angle_functions.c

@@ -0,0 +1,270 @@
+/*
+ * angle_functions.c - different functions for angles/times processing in different format
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#define _GNU_SOURCE 666  // strcasecmp
+#include <assert.h>
+#include <math.h>
+#include <stdlib.h>
+#include <limits.h>
+#include <time.h>
+#include <string.h>
+//#include <slalib.h>  // SLA library files in  bad format
+#include <slamac.h>  // SLA macros
+#include "cmdlnopts.h"
+#include "bta_shdata.h"
+#include "angle_functions.h"
+#include "usefull_macros.h"
+
+extern void sla_caldj(int*, int*, int*, double*, int*);
+extern void sla_amp(double*, double*, double*, double*, double*, double*);
+extern void sla_map(double*, double*, double*, double*, double*,double*, double*, double*, double*, double*);
+void slacaldj(int y, int m, int d, double *djm, int *j){
+	int iy = y, im = m, id = d;
+	sla_caldj(&iy, &im, &id, djm, j);
+}
+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);
+}
+void slamap(double rm, double dm, double pr, double pd,
+             double px, double rv, double eq, double date,
+             double *ra, double *da){
+	double r = rm, d = dm, p1 = pr, p2 = pd, ppx = px, prv = rv, equi = eq, dd = date;
+	sla_map(&r, &d, &p1, &p2, &ppx, &prv, &equi, &dd, ra, da);
+}
+
+/**
+ *  convert angle in seconds into degrees
+ * @return angle in range [0..360]
+ */
+double sec_to_degr(double sec){
+	double sign = 1.;
+	if(sec < 0.){
+		sign = -1.;
+		sec = -sec;
+	}
+	int d = ((int)sec / 3600.);
+	sec -= ((double)d) * 3600.;
+	d %= 360;
+	double angle = sign * (((double)d) + sec / 3600.);
+	if(angle < 0.) angle += 360.;
+	return (angle);
+}
+
+/**
+ * Carefull atoi (int32_t)
+ * @param num (o)  - returning value (or NULL if you wish only check number) - allocated by user
+ * @param str (io) - pointer to string with number must not be NULL (return remain string or NULL if all processed)
+ * @return TRUE if conversion sone without errors, FALSE otherwise
+ * ALSO return FALSE (but set num to readed integer) and not modify str if find "." after integer
+ */
+bool myatoi(int32_t *num, char **str){
+	long long tmp;
+	char *endptr;
+	assert(str);
+	assert(num);
+	assert(*str);
+	*num = 0;
+	tmp = strtoll(*str, &endptr, 0);
+	if(endptr == *str || errno == ERANGE)
+		return FALSE;
+	if(tmp < INT_MIN || tmp > INT_MAX){
+		WARNX(_("Integer out of range"));
+		return FALSE;
+	}
+	*num = (int32_t)tmp;
+	if(endptr && *endptr == '.') return FALSE; // double number
+	*str = endptr;
+	return TRUE;
+}
+
+// the same as myatoi but for double
+bool myatod(double *num, char **str){
+	double tmp;
+	char *endptr;
+	assert(str);
+	assert(num);
+	assert(*str);
+	tmp = strtod(*str, &endptr);
+	if(endptr == *str || errno == ERANGE)
+		return FALSE;
+	*num = tmp;
+	*str = endptr;
+	return TRUE;
+}
+
+/**
+ * try to convert first numbers in string into integer or double
+ * @arg i (o)  - readed integer
+ * @arg d (o)  - readed double
+ * @arg s (io) - string to convert (modified)
+ * @return 0 in case of error; 1 if number is integer & 2 if number is double
+ */
+int getIntDbl(int32_t *i, double *d, char **s){
+	//DBG("str: %s", *s);
+	int32_t i0; double d0;
+	if(!myatoi(&i0, s)){ // bad number or double
+		if(!myatod(&d0, s))
+			return 0;
+		*d = d0;
+		//DBG("got dbl: %g", d0);
+		return 2;
+	}
+	*i = i0;
+	//DBG("got int: %d", i0);
+	return 1;
+}
+
+/**
+ * Convert string "[+-][DD][MM'][SS.S'']into degrees
+ * available formats:
+ * dd[.d]       - degrees
+ * mm[.m]'      - arc minutes
+ * ss[.s]''     - arc seconds
+ * dd:mm[.m]    - dd degrees & mm minutes
+ * dd:mm:ss[.s] - dd degrees & mm minutes & ss seconds
+ * also delimeter can be space, comma or semicolon
+ *
+ * @param ang (o) - angle in radians or exit with help message
+ * @param str (i) - string with angle
+ * @return NULL if false or str remainder ('\0' if all string processed) if OK
+ */
+char *get_degrees(double *ret, char *str){
+	if(!ret || !str){
+		WARNX(_("Wrong get_radians() argument"));
+		return NULL;
+	}
+	const char delimeters[] = ": ,;";
+	char *str_ori = str;
+	double sign = 1., degr = 0., min = 0., sec = 0., d;
+	int32_t i;
+	int res;
+	while(*str){ // check sign & omit leading shit
+		char c = *str;
+		if(c > '0'-1 && c < '9'+1) break;
+		++str;
+		if(c == '+') break;
+		if(c == '-'){ sign = -1.; break;}
+	}
+	// now check string
+	res = getIntDbl(&i, &d, &str);
+#define assignresult(dst) do{dst = (res == 2) ? fabs(d) : (double)abs(i);}while(0)
+	if(!res || !str) goto badfmt;
+	if(*str == 0 || res == 2){ // argument - only one number or double
+		assignresult(degr);
+		goto allOK;
+	}
+	// we have something else
+	if(str[0] == '\''){ // one number in format "xx'" or "xx''"
+		if(str[1] == 0){ // minutes
+			assignresult(min);
+			goto allOK;
+		}else if(str[1] == '\'' && str[2] == 0){ // seconds
+			assignresult(sec);
+			goto allOK;
+		}else goto badfmt;
+	}
+	if(strchr(delimeters, (int)*str)){ // dd:mm[:ss]?
+		assignresult(degr);
+		if(res == 2) goto allOK; // we get double - next number isn't our
+		++str;
+		res = getIntDbl(&i, &d, &str);
+		if(!res) goto badfmt;
+		assignresult(min);
+		if(res == 2) goto allOK;
+	}else goto badfmt;
+	if(str && *str){ // there's something remain - ss.ss?
+		if(!strchr(delimeters, (int)*str)) goto badfmt;
+		++str;
+		res = getIntDbl(&i, &d, &str);
+		if(!res) goto badfmt;
+		assignresult(sec);
+	}
+#undef assignresult
+allOK:
+	*ret = sign*(degr + min/60. + sec/3600.);
+	DBG("Got %g:%g:%g = %g", sign*degr, min, sec, *ret);
+	return str;
+badfmt:
+	WARNX(_("Bad angle format: %s"), str_ori);
+	return NULL;
+}
+
+/**
+ * Calculate apparent place for given coordinates
+ * @param r,d (i)            - RA/Decl for given epoch (if --epoch given) or for 2000.0
+ *                             (RA in hours, Decl in degrees)
+ * @param appRA, appDecl (o) - calculated apparent place
+ */
+bool calc_AP(double r, double d, double *appRA, double *appDecl){
+	double mjd = 51544.5; // mjd2000
+	// convert to radians
+	r *= DH2R;
+	d *= DD2R;
+	double ra2000 = r, decl2000 = d; // coordinates for 2000.0
+	const double jd0 = 2400000.5; // JD for MJD==0
+	// epoch given - calculate it
+	if(GP->epoch){
+		DBG("Epoch: %s", GP->epoch);
+		char *str = GP->epoch;
+		if(strcasecmp(str, "now") == 0 || strcmp(str, "1") == 0){ // now
+			mjd = JDate - jd0;
+		}else{ // check given data
+			double year, add = 0.;
+			int y, m, d, err;
+			if(!myatod(&year, &str)) goto baddate;
+			if(fabs(year - ((int)year)) < 0.001){
+				y = (int)year; m = 1; d = 1;
+			}else{
+				time_t t = (year - 1970.) * 31557600.0; // date in UNIX time format
+				struct tm tms;
+				if(!gmtime_r(&t, &tms)) goto baddate;
+				y = 1900 + tms.tm_year;
+				m = tms.tm_mon + 1;
+				d = tms.tm_mday;
+				add = ((double)tms.tm_hour + (double)tms.tm_min/60.0 + tms.tm_sec/3600.0) / 24.;
+			}
+			slacaldj(y, m, d, &mjd, &err);
+			if(err){
+				WARNX(_("slacaldj(): Wrong %s!"), (err == 1) ? "year" :
+					(err == 2? "month" : "day"));
+				return FALSE;
+			}
+			mjd += add;
+		}
+		DBG("slaamp(%g, %g, %g, 2000.0, ra, dec)", r,d,mjd);
+		slaamp(r, d, mjd, 2000.0, &ra2000, &decl2000);
+		DBG("2000: %g, %g", ra2000*DR2H, decl2000*DR2D);
+	}
+	// proper motion on  R.A./Decl (mas/year)
+	double pmra = GP->pmra/1000.*DAS2R, pmdecl = GP->pmdecl/1000.*DAS2R;
+	mjd = JDate - jd0;
+	slamap(ra2000, decl2000, pmra, pmdecl, 0., 0., 2000.0, mjd, &r, &d);
+	DBG("APP: %g, %g", r*DR2H, d*DR2D);
+	r *= DR2S;
+	d *= DR2AS;
+	if(appRA) *appRA = r;
+	if(appDecl) *appDecl = d;
+	return TRUE;
+baddate:
+	WARNX(_("Epoch should be \"now\" (or omit) or Julian year (don't use this arg for 2000.0)"));
+	return FALSE;
+}
+

angle_functions.h

@@ -0,0 +1,41 @@
+/*
+ * angle_functions.h
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#pragma once
+#ifndef __ANGLE_FUNCTIONS_H__
+#define __ANGLE_FUNCTIONS_H__
+
+#include <stdbool.h>
+
+#ifndef TRUE
+	#define TRUE true
+#endif
+
+#ifndef FALSE
+	#define FALSE false
+#endif
+
+double sec_to_degr(double sec);
+char *get_degrees(double *ret, char *str);
+bool calc_AP(double r, double d, double *appRA, double *appDecl);
+bool myatod(double *num, char **str);
+bool myatoi(int32_t *num, char **str);
+
+#endif // __ANGLE_FUNCTIONS_H__

bta_control.c

@@ -0,0 +1,712 @@
+/*
+ * bta_control.c
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#define _GNU_SOURCE 666 // for strcasestr
+#include <assert.h>
+#include <signal.h>
+#include <strings.h>
+#include <string.h>
+#include <pthread.h>
+#include <math.h>
+
+#include "bta_shdata.h"
+#include "cmdlnopts.h"
+#include "usefull_macros.h"
+#include "ch4run.h"
+#include "bta_control.h"
+#include "angle_functions.h"
+#include "bta_print.h"
+
+
+#ifndef PIDFILE
+#define PIDFILE  "/tmp/bta_control.pid"
+#endif
+
+// constants for choosing move/goto (move for near objects)
+const double Amove = 1800.;   // +-30'
+const double Zmove = 3600.;   // +-60'
+// arcseconds to radians
+#define AS2R  (M_PI/180./3600.)
+
+glob_pars *GP = NULL;
+#define PRINT(...) do{if(!GP->quiet) printf(__VA_ARGS__);}while(0)
+
+// ACS command wrapper
+#ifdef EMULATION
+#define ACS_CMD(a)   do{green(#a); printf("\n");}while(0)
+#else
+#define ACS_CMD(a)   do{red(#a); printf("\n");}while(0)
+// Uncomment only in final release
+// #define ACS_CMD(a)   do{DBG(#a "\n"); a; }while(0)
+#endif
+
+
+#ifndef EMULATION
+typedef struct{
+	uint32_t keylev;
+	uint32_t codelev;
+} passhash;
+#endif
+
+void signals(int sig){
+	if(sig)
+		WARNX(_("Get signal %d, quit.\n"), sig);
+	else
+		sig = -1;
+	unlink(PIDFILE);
+	restore_console();
+	exit(sig);
+}
+
+
+volatile int tmout = 0;
+pthread_t athread;
+void *tmout_thread(void *buf){
+	int selfd = -1, *sec = (int*)buf;
+	struct timeval tv;
+	tv.tv_sec  = *sec;
+	tv.tv_usec = 0;
+	errno = 0;
+	while(selfd < 0){
+		selfd = select(0, NULL, NULL, NULL, &tv);
+		if(selfd < 0 && errno != EINTR){
+			WARN(_("Error while select()"));
+			tmout = 1;
+			return NULL;
+		}
+	}
+	tmout = 1;
+	return NULL;
+}
+
+/**
+ * run thread with pause [delay] (in seconds), at its end set variable tmout
+ */
+void set_timeout(int delay){
+	static int run = 0;
+	static int *arg = NULL;
+	if(!arg) arg = MALLOC(int, 1);
+	if(run && (pthread_kill(athread, 0) != ESRCH)){ // another timeout process detected - kill it
+		pthread_cancel(athread);
+		pthread_join(athread, NULL);
+	}
+	tmout = 0;
+	run = 1;
+	*arg = delay;
+	if(pthread_create(&athread, NULL, tmout_thread, (void*)arg)){
+		WARN(_("Can't create timeout thread!"));
+		tmout = 1;
+		return;
+	}
+	;
+}
+char indi[] = "|/-\\";
+char *iptr = indi;
+#define WAIT_EVENT(evt, max_delay)  do{int __ = 0; set_timeout(max_delay); \
+		PRINT(" "); while(!tmout && !evt){\
+		usleep(100000); if(!*(++iptr)) iptr = indi; if(++__%10==0) PRINT("\b. "); \
+		PRINT("\b%c", *iptr);}; PRINT("\n");}while(0)
+
+
+#ifndef EMULATION
+void get_passhash(passhash *p){
+	int fd = -1, i, c, nlev = 0;
+	char *filename = GP->passfile;
+	if(filename){ // user give filename with [stored?] hash
+		struct stat statbuf;
+		if((fd = open(filename, O_RDWR | O_CREAT,  S_IRUSR | S_IWUSR)) < 0)
+			ERR(_("Can't open %s for reading"), filename);
+		if(fstat (fd, &statbuf) < 0)
+			ERR(_("Can't stat %s"), filename);
+		if(!S_ISREG(statbuf.st_mode))
+			ERR(_("%s is not regular file"), filename);
+		if(statbuf.st_mode != (S_IRUSR | S_IWUSR)){ // wrong mode
+			if(chmod(filename, S_IRUSR | S_IWUSR))
+				ERR(_("Can't change permissions of %s to 0600"), filename);
+		}
+		if(8 == read(fd, p, 8)){  // check password, if it is good, return
+			for(i = 5; i > 0; --i){
+				if(p->codelev == code_Lev(i)) break;
+			}
+			if(i){
+				set_acckey(p->keylev);
+				close(fd);
+				return;
+			}
+		}
+	}
+	// ask user to enter password
+	setup_con(); // hide echo
+	for(i = 3; i > 0; --i){ // try 3 times
+		char pass[256]; int k = 0;
+		printf("Enter password, you have %d tr%s\n", i, (i > 1) ? "ies":"y");
+		while ((c = mygetchar()) != '\n' && c != EOF && k < 255){
+			if(c == '\b' || c == 127){ // use DEL and BACKSPACE to erase previous symbol
+				if(k) --k;
+				printf("\b \b");
+			}else{
+				pass[k++] = c;
+				printf("*");
+			}
+			fflush(stdout);
+		}
+		pass[k] = 0;
+		printf("\n");
+		if((nlev = find_lev_passwd(pass, &p->keylev, &p->codelev)))
+			break;
+		printf(_("No, not this\n"));
+	}
+	restore_console();
+	if(nlev == 0)
+		ERRX(_("Tries excess!"));
+	set_acckey(p->keylev);
+	DBG("OK, level %d", nlev);
+	if(fd > 0){
+		PRINT(_("Store\n"));
+		if(0 != lseek(fd, 0, SEEK_SET)){
+			WARN(_("Can't seek to start of %s"), filename);
+		}else if(8 != write(fd, p, 8))
+			WARN(_("Can't store password hash in %s"), filename);
+		close(fd);
+	}
+}
+#endif // EMULATION
+
+/***************************************************************
+ * All functions for changing telescope parameters are boolean *
+ * returning TRUE in case of succsess or FALSE if failed       *
+ ***************************************************************/
+
+/**
+ * move P2 to the given angle relative to current position +- P2_ANGLE_THRES
+ */
+void cmd_P2moveto(double p2shift){
+	double p2vel = 45.*60., p2dt, p2mintime = 4.5, p2secs = fabs(p2shift) * 3600.;
+	if(fabs(p2shift) < P2_ANGLE_THRES) return;
+	p2dt = p2secs / p2vel;
+	if(p2dt < p2mintime){
+		p2vel = p2secs / p2mintime;
+		if(p2vel < 1.) p2vel = 1;
+		p2dt = p2secs / p2vel;
+	}
+	if(p2shift < 0) p2vel = -p2vel;
+	DBG("p2vel=%g, p2dt = %g", p2vel, p2dt);
+	ACS_CMD(MoveP2To(p2vel, p2dt));
+#ifndef EMULATION
+	PRINT(_("Moving P2 "));
+	// wait until P2 stops, set to guiding or timeout ends
+	WAIT_EVENT(((fabs(vel_P) < 1.) || (P2_State == P2_On)), p2dt + 1.);
+	if(tmout && P2_State != P2_Off){
+		WARNX(_("Timeout reached, stop P2"));
+		ACS_CMD(MoveP2(0));
+	}
+#endif
+}
+
+/**
+ * move P2 to given angle or at given delta
+ * @param angle    angle to move (in degrees) with suffix "rel" for relative moving
+ */
+bool moveP2(char *arg){
+	if(!arg) return FALSE;
+	int p2rel = 0;
+	char *eptr = NULL;
+	int badarg = 0;
+	if((eptr = strcasestr(arg, "rel"))){
+		if(eptr == arg){
+			badarg = 1;
+			goto bdrg;
+		}else{
+			if(eptr[-1] < '0' || eptr[-1] > '9') eptr[-1] = 0; // omit last non-number
+			else *eptr = 0;
+			eptr = NULL;
+			p2rel = 1;
+		}
+	}
+	double p2angle;
+	if(!get_degrees(&p2angle, arg)) badarg = 1;
+	else{ // now check if there a good angle
+		if(p2angle < -360. || p2angle > 360.) badarg = 1;
+		else if(eptr){
+			if(strcasecmp(eptr, "rel") == 0)
+				p2rel = 1;
+			else // wrong degrees format
+				badarg = 1;
+		}
+	}
+bdrg:
+	if(badarg){
+		WARNX(_("Key p2move should be in format angle[rel],\n\tangle - from -360 to +360"
+			"\n\twrite \"rel\" after angle for relative moving"));
+			return FALSE;
+	}
+	// now get information about current angle & check target angle
+	double p2val = sec_to_degr(val_P);
+	DBG("p2 now is at %g", p2val);
+	if(p2rel) p2angle += p2val;
+	if(p2angle < 0.) p2angle += 360.;
+	else if(p2angle > 360.) p2angle -= 360.;
+	if(p2angle > P2_LOW_ES && p2angle < P2_HIGH_ES){ // prohibited angle
+		WARNX(_("Target angle (%g) is in prohibited zone (between %g & %g degrees)"),
+			p2angle, P2_LOW_ES, P2_HIGH_ES);
+		return FALSE;
+	}
+	if(P2_State != P2_Off && P2_State != P2_On){
+		WARNX(_("P2 is already moving!"));
+		if(!GP->force) return FALSE;
+		WARNX(_("Force stop"));
+		ACS_CMD(MoveP2(0)); // stop P2
+#ifndef EMULATION
+		if(P2_State != P2_Off){
+			PRINT(_("Wait for P2 stop "));
+			WAIT_EVENT(P2_State == P2_Off, 5);
+			if(tmout && P2_State != P2_Off){
+				WARNX(_("Timeout reached, can't stop P2"));
+				return 0;
+			}
+		}
+#endif
+	}
+	DBG("Move P2 to %gdegr", p2angle);
+	if(fabs(p2angle - p2val) < P2_ANGLE_THRES){
+		WARNX(_("Zero moving (< %g)"), P2_ANGLE_THRES);
+		return TRUE;
+	}
+	int i;
+	for(i = 0; i < 3; ++i){
+		if(i) PRINT(_("Try %d. "), i+1);
+		cmd_P2moveto(p2angle - p2val);
+		p2val = sec_to_degr(val_P);
+		if(fabs(p2angle - p2val) < P2_ANGLE_THRES) break;
+	}
+	if(fabs(p2angle - p2val) > P2_ANGLE_THRES){
+		WARNX(_("Error moving P2: have %gdegr, need %gdegr"), p2val, p2angle);
+		return FALSE;
+	}
+	return TRUE;
+}
+
+/**
+ * set P2 mode: stop or track
+ */
+bool setP2mode(char *arg){
+	int _U_ mode;
+	if(!arg) goto badarg;
+	if(strcasecmp(arg, "stop") == 0) mode = P2_Off;
+	else if(strcasecmp(arg, "track") == 0) mode = P2_On;
+	else goto badarg;
+	DBG("Set P2 mode to %s", (mode == P2_Off) ? "stop" : "track");
+	ACS_CMD(SetPMode(mode));
+#ifndef EMULATION
+	if(P2_State != mode){
+		PRINT(_("Wait for given mode "));
+		WAIT_EVENT(P2_State == mode, 5);
+		if(tmout && P2_State != mode){
+			WARNX(_("Timeout reached, can't set P2 mode"));
+			return FALSE;
+		}
+	}
+#endif
+	return TRUE;
+badarg:
+	WARNX(_("Parameter should be \"stop\" or \"track\""));
+	return FALSE;
+}
+
+void cmd_Fmoveto(double f){
+	const double FOC_HVEL = 0.63, FOC_LVEL = 0.13;
+	int _U_ fspeed;
+	if(f < 1. || f > 199.) return;
+	double fshift = f - val_F, fvel, _U_ fdt;
+	if(fabs(fshift) > 1.){
+		fvel = FOC_HVEL;
+		fspeed = (fshift > 0) ? Foc_Hplus : Foc_Hminus;
+	}else if(fabs(fshift) > 0.05){
+		fvel = FOC_LVEL;
+		fspeed = (fshift > 0) ? Foc_Lplus : Foc_Lminus;
+	} else{
+		WARNX(_("Can't move for such small distance (%gmm)"), fshift);
+		return;
+	}
+	fdt = fabs(fshift) / fvel;
+	ACS_CMD(MoveFocus(fspeed, fdt));
+#ifndef EMULATION
+	PRINT(_("Moving Focus "));
+	WAIT_EVENT((fabs(vel_F) < 0.01 || Foc_State == Foc_Off), fdt + 1.);
+	if(tmout && Foc_State != Foc_Off){
+		WARNX(_("Timeout reached, stop focus"));
+		ACS_CMD(MoveFocus(Foc_Off, 0.));
+	}
+#endif
+}
+
+/**
+ * move focus to given position
+ */
+bool moveFocus(double val){
+	if(val < 1. || val > 199.){
+		WARNX(_("Focus value should be between 1mm & 199mm"));
+		return FALSE;
+	}
+	if(Foc_State != Foc_Off){
+		WARNX(_("Focus is already moving!"));
+		if(!GP->force) return FALSE;
+		WARNX(_("Force stop"));
+		ACS_CMD(MoveFocus(Foc_Off, 0.));
+	}
+#ifndef EMULATION
+	if(Foc_State != Foc_Off){
+		PRINT(_("Wait for focus stop "));
+		WAIT_EVENT(Foc_State == Foc_Off, 3);
+		if(tmout && Foc_State != Foc_Off){
+			WARNX(_("Timeout reached, can't stop focus motor"));
+			return FALSE;
+		}
+	}
+#endif
+	DBG("Move focus to %g", val);
+	if(fabs(val - val_F) < FOCUS_THRES){
+		WARNX(_("Zero moving (< %g)"), FOCUS_THRES);
+		return TRUE;
+	}
+	int i;
+	for(i = 0; i < 3; ++i){
+		if(i) PRINT(_("Try %d. "), i+1);
+		cmd_Fmoveto(val);
+		if(fabs(val - val_F) < FOCUS_THRES) break;
+	}
+	if(fabs(val - val_F) > FOCUS_THRES){
+		WARNX(_("Error moving focus: have %gmm, need %gmm"), val_F, val);
+		return FALSE;
+	}
+	return TRUE;
+}
+
+/**
+ * set new equatorial/horizontal coordinates
+ * @param coordinates: both RA&Decl/A&Z with any delimeter
+ *   format RA:    hh[delimeter]mm[delimeter]ss.s - suitable for get_degrees() but in hours
+ *   format DECL:  suitable for get_degrees() but with prefix +/- if goes first
+ *   format A/Z:   suitable for get_degrees(), AZIMUTH GOES FIRST!
+ * @param isEQ: TRUE if equatorial coordinates, FALSE if horizontal
+ */
+bool setCoords(char *coords, bool isEQ){
+	if(!coords) return FALSE;
+	char *ra = NULL, *dec = NULL, *ptr = coords;
+	double r, d;
+	if(isEQ){
+		// find RA & DEC parameters in string
+		// 1. find first number or +/-
+		while(*ptr){
+			char p = *ptr;
+			if(p > '0'-1 && p < '9'+1){
+				ra = ptr;
+				break;
+			}
+			else if(p == '+' || p == '-'){
+				dec = ptr;
+				break;
+			}
+			++ptr;
+		}
+	}else ra = ptr;
+	if(!*ptr || (!ra && !dec /*WTF?*/)) goto badcrds;
+	if(ra){ // first was RA/AZ
+		dec = get_degrees(&r, ra);
+		if(!dec || !*dec || !(ptr = get_degrees(&d, dec))) goto badcrds;
+		if(*ptr) goto badcrds; // something after last number
+	}else{ // first was Decl
+		ra  = get_degrees(&d, dec);
+		if(!ra || !*ra || !(ptr = get_degrees(&r, ra))) goto badcrds;
+		if(*ptr) goto badcrds;
+	}
+	if(isEQ){ // RA/Decl
+		if(r < 0. || r > 24. || d > 90. || d < -90.) goto badcrds;
+		double appRA, appDecl;
+		// calculate apparent place according to other cmdline arguments
+		if(!calc_AP(r, d, &appRA, &appDecl)) goto badcrds;
+		DBG("Set RA/Decl to %g, %g", appRA/3600, appDecl/3600);
+		ACS_CMD(SetRADec(appRA, appDecl));
+#ifndef EMULATION
+		if(InpAlpha != r || InpDelta != d){
+			PRINT(_("Wait for command result"));
+			WAIT_EVENT((InpAlpha == r && InpDelta == d), 3);
+			if(InpAlpha != r || InpDelta != d){
+				WARNX(_("Can't send data to system!"));
+				return FALSE;
+			}
+		}
+#endif
+	}else{ // A/Z: r==A, d==Z
+		if(r < -360. || r > 360. || d < 0. || d > 90.) goto badcrds;
+		// convert A/Z into arcsec
+		r *= 3600;
+		d *= 3600;
+		DBG("Set A/Z to %g, %g", r/3600, d/3600);
+		ACS_CMD(SetAzimZ(r, d));
+#ifndef EMULATION
+		if(InpAzim != r || InpZdist != d){
+			PRINT(_("Wait for command result"));
+			WAIT_EVENT((InpAzim == r && InpZdist == d), 3);
+			if(InpAzim != r || InpZdist != d){
+				WARNX(_("Can't send data to system!"));
+				return FALSE;
+			}
+		}
+#endif
+	}
+	return TRUE;
+badcrds:
+	if(isEQ)
+		WARNX(_("Wrong coordinates: \"%s\"; should be \"hh mm ss.ss +/-dd mm ss.ss\" (any order)"), coords);
+	else
+		WARNX(_("Wrong coordinates: \"%s\"; should be \"[+/-]dd mm ss.ss dd mm ss.ss\" (Az first)"), coords);
+	return FALSE;
+}
+
+/**
+ * reverce Azimuth traveling
+ */
+bool azreverce(){
+	bool ret = TRUE;
+	int mode = Az_Mode;
+	if(mode == Rev_Off) mode = Rev_On;
+	else mode = Rev_On;
+	ACS_CMD(SetAzRevers(mode));
+	PRINT(_("Turn %s azimuth reverce "), (mode == Rev_Off) ? "off" : "on");
+#ifndef EMULATION
+	WAIT_EVENT((Az_Mode == mode), 3);
+	if(Az_Mode != mode) ret = FALSE;
+#endif
+	return ret;
+}
+
+bool testauto(){
+	if(Tel_Mode != Automatic){
+		WARNX(_("Can't stop telescope: not automatic mode!"));
+		return FALSE;
+	}
+	return TRUE;
+}
+
+bool stop_telescope(){
+	if(!testauto()) return FALSE;
+	if(Sys_Mode == SysStop){
+		WARNX(_("Already stoped"));
+		return TRUE;
+	}
+	ACS_CMD(StopTeleskope());
+	WAIT_EVENT((Sys_Mode == SysStop), 3);
+	if(Tel_Mode != SysStop){
+		WARNX(_("Can't stop telescope"));
+		return FALSE;
+	}
+	return TRUE;
+}
+
+/**
+ * move telecope to object by entered coordinates
+ */
+bool gotopos(bool isradec){
+	if(!testauto()) return FALSE;
+	if(Sys_Mode != SysStop && !stop_telescope()) return FALSE;
+	if(isradec){
+		if((fabs(val_A - InpAzim) < Amove && fabs(val_Z - InpZdist) < Zmove)){ // move back to last coords
+				ACS_CMD(MoveToObject());
+		}else{
+			ACS_CMD(GoToObject());
+		}
+		ACS_CMD(SetSysTarg(TagObject));
+	}else{
+		ACS_CMD(GoToAzimZ());
+		ACS_CMD(SetSysTarg(TagPosition));
+	}
+	DBG("start");
+	usleep(500000);
+	ACS_CMD(StartTeleskope());
+#ifndef EMULATION
+	PRINT("Go");
+	WAIT_EVENT((Sys_Mode != SysStop && Sys_Mode != SysWait), 5);
+	if(tmout){
+		WARNX(_("Can't move telescope"));
+		return FALSE;
+	}
+	PRINT("Wait for tracking");
+	//  Wait with timeout 15min
+	WAIT_EVENT((Sys_Mode == SysTrkOk), 900);
+	if(tmout){
+		WARNX(_("Eror during telescope pointing"));
+		return FALSE;
+   }
+#endif
+	return TRUE;
+}
+
+/**
+ * set PCS state (TRUE == on)
+ */
+bool PCS_state(bool on){
+	int _U_ newstate = PC_Off;
+	if(on){
+		if(Pos_Corr == PC_On) return TRUE;
+		ACS_CMD(SwitchPosCorr(PC_On));
+		newstate = PC_On;
+	}else{
+		if(Pos_Corr == PC_Off) return TRUE;
+		ACS_CMD(SwitchPosCorr(PC_Off));
+	}
+#ifndef EMULATION
+		WAIT_EVENT((Pos_Corr == newstate), 3);
+		if(tmout){
+			WARNX(_("Can't set new PCS state"));
+			return FALSE;
+		}
+#endif
+	return TRUE;
+}
+
+/**
+ * make small position correction for angles dx, dy (in arcseconds)
+ * format: "dx,dy" with any 1-char delimeter
+ * if isAZ == TRUE, dx is dA, dy is dZ
+ * else dx is dRA, dy is dDecl
+ */
+bool run_correction(char *dxdy, bool isAZ){
+	double dx, dy;
+	char *eptr = dxdy;
+	if(!myatod(&dx, &eptr) || !*eptr || !*(++eptr)) goto badang;
+	if(!myatod(&dy, &eptr)) goto badang;
+	DBG("dx: %g, dy: %g", dx, dy);
+	if(!testauto() || dx > CORR_MAX_ANGLE || dy > CORR_MAX_ANGLE) return FALSE;
+	if(isAZ){
+#ifndef EMULATION
+		double targA = val_A+dx, targZ = val_Z+dy;
+#endif
+		ACS_CMD(DoAZcorr(dx / sin(val_Z * AS2R), dy));// transform dA to "telescope coordinates"
+#ifndef EMULATION
+		WAIT_EVENT((fabs(val_A - targA) < CORR_THRES && fabs(val_Z - targZ) < CORR_THRES), 10);
+#endif
+	}else{
+#ifndef EMULATION
+		double targA = val_Alp+dx, targD = val_Del+dy;
+#endif
+		ACS_CMD(DoADcorr(dx, dy));
+#ifndef EMULATION
+		WAIT_EVENT((fabs(val_Alp - targA) < CORR_THRES && fabs(val_Del - targD) < CORR_THRES), 10);
+#endif
+	}
+#ifndef EMULATION
+	if(tmout){
+		WARNX(_("Can't do correction (or angle is too large)"));
+		return FALSE;
+	}
+#endif
+	return TRUE;
+badang:
+	WARNX(_("Bad format, need \"dx,dy\" in arcseconds"));
+	return FALSE;
+}
+
+int main(int argc, char **argv){
+	check4running(argv, PIDFILE, NULL);
+	int retcode = 0;
+	initial_setup();
+	info_level showinfo = NO_INFO;
+#ifndef EMULATION
+	passhash pass = {0,0};
+#endif
+	int needblock = 0, needqueue = 0;
+	GP = parce_args(argc, argv);
+	assert(GP);
+	signal(SIGTERM, signals); // kill (-15) - quit
+	signal(SIGHUP, signals);  // hup - quit
+	signal(SIGINT, signals);  // ctrl+C - quit
+	signal(SIGQUIT, signals); // ctrl+\ - quit
+	signal(SIGTSTP, SIG_IGN); // ignore ctrl+Z
+	setbuf(stdout, NULL);
+	if(GP->getinfo){
+		needblock = 1;
+		char *infostr = GP->getinfo;
+		if(strcmp(infostr, "1") == 0){ // show ALL args
+			showinfo = ALL_INFO;
+		}else{
+			showinfo = get_infolevel(infostr);
+		}
+	}
+	if(showinfo == NO_INFO){
+		if(GP->infoargs){
+			showinfo = REQUESTED_LIST;
+			needblock = 1;
+		}else if(GP->getinfo) show_infolevels();
+	}
+	if(GP->p2move || GP->p2mode || GP->focmove > 0. || GP->eqcrds || GP->horcrds
+		|| GP->azrev || GP->telstop || GP->gotoRaDec || GP->gotoAZ || GP->PCSoff
+		|| GP->corrAZ || GP->corrRAD){
+		needqueue = 1;
+	}
+	if(needqueue){
+		needblock = 1;
+	}
+	if(needblock){
+		if(!get_shm_block(&sdat, ClientSide))
+			ERRX(_("Can't find shared memory block"));
+	}
+	if(needqueue) get_cmd_queue(&ucmd, ClientSide);
+	if(needblock){
+		if(!check_shm_block(&sdat))
+			ERRX(_("There's no connection to BTA!"));
+#ifndef EMULATION
+		double last = M_time;
+		PRINT(_("Test multicast connection\n"));
+		WAIT_EVENT((fabs(M_time - last) > 0.02), 5);
+		if(tmout)
+			ERRX(_("Multicasts stale!"));
+		if(needqueue) get_passhash(&pass);
+#endif
+	}
+	if(showinfo != NO_INFO) bta_print(showinfo, GP->infoargs);
+	else if(GP->listinfo) bta_print(NO_INFO, NULL); // show arguments available
+#define RUN(arg)     do{if(!arg) retcode = 1;}while(0)
+#define RUNBLK(arg)  do{if(!arg) return 1;}while(0)
+	if(GP->telstop)      RUN(stop_telescope());
+	if(GP->eqcrds)       RUNBLK(setCoords(GP->eqcrds, TRUE));
+	else if(GP->horcrds) RUNBLK(setCoords(GP->horcrds, FALSE));
+	if(GP->p2move)       RUN(moveP2(GP->p2move));
+	if(GP->p2mode)       RUN(setP2mode(GP->p2mode));
+	if(GP->focmove > 0.) RUN(moveFocus(GP->focmove));
+	if(GP->azrev)        RUN(azreverce());
+	if(GP->PCSoff)       RUNBLK(PCS_state(FALSE));
+	else if(needqueue)   RUNBLK(PCS_state(TRUE));
+	if(GP->gotoRaDec)    RUNBLK(gotopos(TRUE));
+	else if(GP->gotoAZ)  RUNBLK(gotopos(FALSE));
+	else if(GP->corrAZ)  RUN(run_correction(GP->corrAZ, TRUE));
+	else if(GP->corrRAD) RUN(run_correction(GP->corrRAD, FALSE));
+#undef RUN
+#undef RUNBLK
+	unlink(PIDFILE);
+	restore_console();
+	return retcode;
+}
+
+
+/*
+ * Добавить:
+  * коррекция положения по A/Z или RA/Dec
+ */

bta_control.h

@@ -0,0 +1,36 @@
+/*
+ * bta_control.h - main definitions
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#pragma once
+#ifndef __BTA_CONTROL_H__
+#define __BTA_CONTROL_H__
+
+// end-switches position (in degr); prohibited angles are in range [P2_LOW_ES .. P2_HIGH_ES]
+#define P2_LOW_ES       (21.0)
+#define P2_HIGH_ES      (90.0)
+// angle threshold (for p2 move) in degrees
+#define P2_ANGLE_THRES  (0.01)
+#define FOCUS_THRES     (0.01)
+// max angles for correction of telescope (5' = 300'')
+#define CORR_MAX_ANGLE  (300)
+// correction threshold
+#define CORR_THRES      (0.1)
+
+#endif // __BTA_CONTROL_H__

bta_print.c

@@ -0,0 +1,744 @@
+/* Print some BTA NewACS data (or write  to file)
+ *
+ * copyright: Vladimir Shergin <vsher@sao.ru>
+ *
+ * Usage:
+ *         bta_print [time_step] [file_name]
+ * Where:
+ *         time_step - writing period in sec., >=1.0
+ *                      <1.0 - once and exit (default)
+ *         file_name - name of file to write to,
+ *                      "-" - stdout (default)
+ */
+/*
+ * bta_print.c
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+
+/**
+ * Modified by E.E. as part of common BTA ACS management system
+ */
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <errno.h>
+#include <math.h>
+#include <string.h>
+#include <signal.h>
+#include <time.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <sys/times.h>
+#include <ctype.h>
+
+#include <crypt.h>
+
+#include "bta_shdata.h"
+#include "bta_print.h"
+#include "usefull_macros.h"
+
+#define BUFSZ 255
+static char buf[BUFSZ+1];
+
+typedef struct{
+	const char *name;
+	const info_level lvl;
+}levelstr;
+
+const levelstr const infolevels_str[] = {
+	{"coordinates", BASIC_COORDS},
+	{"coords", BASIC_COORDS},
+	{"extcrds", EXTENDED_COORDS},
+	{"morecrds", EXTENDED_COORDS},
+	{"meteo", METEO_INFO},
+	{"time", TIME_INFO},
+	{"acs", ACS_INFO},
+	{"system", ACS_INFO},
+	{NULL, NO_INFO}
+};
+
+typedef struct{
+	const char *name;
+	const int pos_idx;
+}parstr;
+
+// ./btatest -l|awk "{print  \"\tPAR_\"\$1\",\" }"
+typedef enum{
+	PAR_M_time,
+	PAR_S_time,
+	PAR_JDate,
+	PAR_Tel_Mode,
+	PAR_Tel_Focus,
+	PAR_Tel_Taget,
+	PAR_P2_Mode,
+	PAR_PCS_Coeffs,
+	PAR_code_KOST,
+	PAR_Az_Reverce,
+	PAR_Az_EndSw,
+	PAR_Zen_EndSw,
+	PAR_P2_EndSw,
+	PAR_Worm_A,
+	PAR_Worm_Z,
+	PAR_Lock_Flags,
+	PAR_Oil_Pres,
+	PAR_Oil_Temp,
+	PAR_Oil_Cool_Temp,
+	PAR_CurAlpha,
+	PAR_CurDelta,
+	PAR_SrcAlpha,
+	PAR_SrcDelta,
+	PAR_InpAlpha,
+	PAR_InpDelta,
+	PAR_CurAzim,
+	PAR_CurZenD,
+	PAR_InpAzim,
+	PAR_InpZenD,
+	PAR_CurPA,
+	PAR_SrcPA,
+	PAR_InpPA,
+	PAR_TelPA,
+	PAR_ValFoc,
+	PAR_ValAzim,
+	PAR_ValZenD,
+	PAR_ValP2,
+	PAR_ValDome,
+	PAR_DiffAzim,
+	PAR_DiffZenD,
+	PAR_DiffP2,
+	PAR_DiffDome,
+	PAR_VelAzim,
+	PAR_VelZenD,
+	PAR_VelP2,
+	PAR_VelPA,
+	PAR_VelDome,
+	PAR_CorrPCS,
+	PAR_Refraction,
+	PAR_CorrAlpha,
+	PAR_CorrDelta,
+	PAR_CorrAzim,
+	PAR_CorrZenD,
+	PAR_Foc_State,
+	PAR_ValTout,
+	PAR_ValTind,
+	PAR_ValTmir,
+	PAR_ValPres,
+	PAR_ValWind,
+	PAR_Blast10,
+	PAR_Blast15,
+	PAR_Precipitation,
+	PAR_ValHumd,
+	PAR_bta_pars_end
+}bta_pars;
+
+uint8_t parameters_to_show[PAR_bta_pars_end] = {0};
+
+// ./btatest -l|awk "{print  \"\t\{\\\"\"\$1\"\\\", PAR_\"\$1\"\},\" }"
+const parstr const parameters_str[] = {
+	{"M_time", PAR_M_time},
+	{"S_time", PAR_S_time},
+	{"JDate", PAR_JDate},
+	{"Tel_Mode", PAR_Tel_Mode},
+	{"Tel_Focus", PAR_Tel_Focus},
+	{"Tel_Taget", PAR_Tel_Taget},
+	{"P2_Mode", PAR_P2_Mode},
+	{"PCS_Coeffs", PAR_PCS_Coeffs},
+	{"code_KOST", PAR_code_KOST},
+	{"Az_Reverce", PAR_Az_Reverce},
+	{"Az_EndSw", PAR_Az_EndSw},
+	{"Zen_EndSw", PAR_Zen_EndSw},
+	{"P2_EndSw", PAR_P2_EndSw},
+	{"Worm_A", PAR_Worm_A},
+	{"Worm_Z", PAR_Worm_Z},
+	{"Lock_Flags", PAR_Lock_Flags},
+	{"Oil_Pres", PAR_Oil_Pres},
+	{"Oil_Temp", PAR_Oil_Temp},
+	{"Oil_Cool_Temp", PAR_Oil_Cool_Temp},
+	{"CurAlpha", PAR_CurAlpha},
+	{"CurDelta", PAR_CurDelta},
+	{"SrcAlpha", PAR_SrcAlpha},
+	{"SrcDelta", PAR_SrcDelta},
+	{"InpAlpha", PAR_InpAlpha},
+	{"InpDelta", PAR_InpDelta},
+	{"CurAzim", PAR_CurAzim},
+	{"CurZenD", PAR_CurZenD},
+	{"InpAzim", PAR_InpAzim},
+	{"InpZenD", PAR_InpZenD},
+	{"CurPA", PAR_CurPA},
+	{"SrcPA", PAR_SrcPA},
+	{"InpPA", PAR_InpPA},
+	{"TelPA", PAR_TelPA},
+	{"ValFoc", PAR_ValFoc},
+	{"ValAzim", PAR_ValAzim},
+	{"ValZenD", PAR_ValZenD},
+	{"ValP2", PAR_ValP2},
+	{"ValDome", PAR_ValDome},
+	{"DiffAzim", PAR_DiffAzim},
+	{"DiffZenD", PAR_DiffZenD},
+	{"DiffP2", PAR_DiffP2},
+	{"DiffDome", PAR_DiffDome},
+	{"VelAzim", PAR_VelAzim},
+	{"VelZenD", PAR_VelZenD},
+	{"VelP2", PAR_VelP2},
+	{"VelPA", PAR_VelPA},
+	{"VelDome", PAR_VelDome},
+	{"CorrPCS", PAR_CorrPCS},
+	{"Refraction", PAR_Refraction},
+	{"CorrAlpha", PAR_CorrAlpha},
+	{"CorrDelta", PAR_CorrDelta},
+	{"CorrAzim", PAR_CorrAzim},
+	{"CorrZenD", PAR_CorrZenD},
+	{"Foc_State", PAR_Foc_State},
+	{"ValTout", PAR_ValTout},
+	{"ValTind", PAR_ValTind},
+	{"ValTmir", PAR_ValTmir},
+	{"ValPres", PAR_ValPres},
+	{"ValWind", PAR_ValWind},
+	{"Blast10", PAR_Blast10},
+	{"Blast15", PAR_Blast15},
+	{"Precipitation", PAR_Precipitation},
+	{"ValHumd", PAR_ValHumd},
+	{NULL, 0}
+};
+
+
+
+char *time_asc(double t){
+	int h, min;
+	double sec;
+	h   = (int)(t/3600.);
+	min = (int)((t - (double)h*3600.)/60.);
+	sec = t - (double)h*3600. - (double)min*60.;
+	h %= 24;
+	if(sec>59.99) sec=59.99;
+	snprintf(buf, BUFSZ, "%02d:%02d:%05.2f", h,min,sec);
+	return buf;
+}
+
+char *angle_asc(double a){
+	char s;
+	int d, min;
+	double sec;
+	if (a >= 0.)
+		s = '+';
+	else {
+		s = '-'; a = -a;
+	}
+	d   = (int)(a/3600.);
+	min = (int)((a - (double)d*3600.)/60.);
+	sec = a - (double)d*3600. - (double)min*60.;
+	d %= 360;
+	if(sec>59.9) sec=59.9;
+	snprintf (buf, BUFSZ, "%c%02d:%02d:%04.1f", s,d,min,sec);
+	return buf;
+}
+
+char *angle_fmt(double a, char *format){
+	char s, *p;
+	int d, min, n;
+	double sec, msec;
+	char *newformat = MALLOC(char, strlen(format) + 3);
+	sprintf(newformat, "%s", format);
+	if (a >= 0.)
+		s = '+';
+	else {
+		s = '-'; a = -a;
+	}
+	d   = (int)(a/3600.);
+	min = (int)((a - (double)d*3600.)/60.);
+	sec = a - (double)d*3600. - (double)min*60.;
+	d %= 360;
+	if ((p = strchr(format,'.')) == NULL)
+		msec=59.;
+	else if (*(p+2) == 'f' ) {
+		n = *(p+1) - '0';
+		msec = 60. - pow(10.,(double)(-n));
+	} else
+		msec=60.;
+	if(sec>msec) sec=msec;
+	if (strstr(format,"%c"))
+		snprintf(buf, BUFSZ, newformat, s,d,min,sec);
+	else
+		snprintf(buf, BUFSZ, newformat, d,min,sec);
+	free(newformat);
+	return buf;
+}
+
+#ifndef M_PI
+#define M_PI (3.14159265358979323846)
+#endif
+
+#define R2D  (180./M_PI)     // rad. to degr.
+#define D2R  (M_PI/180.)     // degr. to rad.
+#define R2S  (648000./M_PI)  // rad. to sec
+#define S2R  (M_PI/648000.)  // sec. to rad.
+#define S360 (1296000.)    // sec in 360degr
+
+
+// By google maps: 43.646683 (43 38 48.0588), 41.440681 (41 26 26.4516)
+// (real coordinates should be measured relative to mass center, not geoid)
+const double longitude = 149189.175;   // SAO longitude 41 26 29.175 (-2:45:45.945)
+const double Fi = 157152.7;            // SAO latitude 43 39 12.7
+const double cos_fi = 0.7235272793;    // Cos of SAO latitude
+const double sin_fi = 0.6902957888;    // Sin  ---  ""  -----
+
+void calc_AZ(double alpha, double delta, double stime, double *az, double *zd){
+	double sin_t,cos_t, sin_d,cos_d,  cos_z;
+	double t, d, z, a, x, y;
+
+	t = (stime - alpha) * 15.;
+	if (t < 0.)
+	t += S360;      // +360degr
+	t *= S2R;          // -> rad
+	d = delta * S2R;
+	sincos(t, &sin_t, &cos_t);
+	sincos(d, &sin_d, &cos_d);
+
+	cos_z = cos_fi * cos_d * cos_t + sin_fi * sin_d;
+	z = acos(cos_z);
+
+	y = cos_d * sin_t;
+	x = cos_d * sin_fi * cos_t - cos_fi * sin_d;
+	a = atan2(y, x);
+
+	*zd = z * R2S;
+	*az = a * R2S;
+}
+
+double calc_PA(double alpha, double delta, double stime){
+	double sin_t,cos_t, sin_d,cos_d;
+	double t, d, p, sp, cp;
+
+	t = (stime - alpha) * 15.;
+	if (t < 0.)
+		t += S360;      // +360degr
+	t *= S2R;          // -> rad
+	d = delta * S2R;
+	sin_t = sin(t);
+	cos_t = cos(t);
+	sin_d = sin(d);
+	cos_d = cos(d);
+
+	sp = sin_t * cos_fi;
+	cp = sin_fi * cos_d - sin_d * cos_fi * cos_t;
+	p = atan2(sp, cp);
+	if (p < 0.0)
+		p += 2.0*M_PI;
+
+	return(p * R2S);
+}
+
+void calc_AD(double az, double zd, double stime, double *alpha, double *delta){
+	double sin_d, sin_a,cos_a, sin_z,cos_z;
+	double t, d, z, a, x, y;
+	a = az * S2R;
+	z = zd * S2R;
+	sin_a = sin(a);
+	cos_a = cos(a);
+	sin_z = sin(z);
+	cos_z = cos(z);
+
+	y = sin_z * sin_a;
+	x = cos_a * sin_fi * sin_z + cos_fi * cos_z;
+	t = atan2(y, x);
+	if (t < 0.0)
+		t += 2.0*M_PI;
+
+	sin_d = sin_fi * cos_z - cos_fi * cos_a * sin_z;
+	d = asin(sin_d);
+
+	*delta = d * R2S;
+	*alpha = (stime - t * R2S / 15.);
+	if (*alpha < 0.0)
+		*alpha += S360/15.;      // +24h
+}
+
+void my_sleep(double dt){
+	int nfd;
+	struct timeval tv;
+	tv.tv_sec = (int)dt;
+	tv.tv_usec = (int)((dt - tv.tv_sec)*1000000.);
+slipping:
+	nfd = select(0, (fd_set *)NULL,(fd_set *)NULL,(fd_set *)NULL, &tv);
+	if(nfd < 0) {
+		if(errno == EINTR)
+		/*On  Linux,  timeout  is  modified to reflect the amount of
+		time not slept; most other implementations DO NOT do this!*/
+			goto slipping;
+		fprintf(stderr,"Error in mydelay(){ select() }. %s\n",strerror(errno));
+	}
+}
+
+/**
+ * print requested information
+ * @param lvl      - requested information level
+ * @param par_list - list of parameters (any separator) if lvl == REQUESTED_LIST
+ * @return 0 in case of some error
+ */
+int bta_print(info_level lvl, char *par_list){
+	int i, verb = 1, sel = 0;
+	char *value = NULL;
+	DBG("lvl: 0x%X, list: %s", lvl, par_list);
+	if(lvl == NO_INFO && par_list) lvl = REQUESTED_LIST;
+	else if(lvl == REQUESTED_LIST && !par_list) return 0;
+	if(lvl == REQUESTED_LIST){
+		parstr *ptr = (parstr*)parameters_str;
+		while(ptr->name){
+			if(strstr(par_list, ptr->name))
+				parameters_to_show[ptr->pos_idx] = 1;
+			++ptr;
+		}
+		lvl = ALL_INFO;
+		sel = 1;
+	}
+	if(lvl == NO_INFO){ // show all parameters but without values
+		lvl = ALL_INFO;
+		verb = 0;
+	}
+#define FMSG(par,hlp, ...)  do{if(!sel || parameters_to_show[PAR_ ## par]){printf("\n" #par);if(verb){printf("=\""); \
+		printf(__VA_ARGS__);printf("\"");}else printf(" (" hlp ")");}}while(0)
+#define SMSG(par,hlp, str)  do{if(!sel || parameters_to_show[PAR_ ## par]){printf("\n" #par); if(verb)printf("=\"%s\"",str);\
+		else printf(" (" hlp ")");}}while(0)
+
+/****************************** TIME_INFO *************************************/
+	if(lvl & TIME_INFO){
+		SMSG(M_time, "mean solar time", time_asc(M_time + DUT1));
+#ifdef EE_time
+		SMSG(S_time, "mean sidereal time", time_asc(S_time - EE_time));
+		FMSG(JDate, "julian date", "%.6f", JDate);
+#else
+		SMSG(S_time, "mean sidereal time", time_asc(S_time));
+#endif
+	}
+
+/******************************** ACS_INFO ************************************/
+	if(lvl & ACS_INFO){
+		if(verb){
+			if(Tel_Hardware == Hard_Off) value = "Off";
+			else if(Tel_Mode != Automatic) value = "Manual";
+			else{
+				switch(Sys_Mode){
+					default:
+					case SysStop    :  value = "Stopped";   break;
+					case SysWait    :  value = "Waiting";   break;
+					case SysPointAZ :
+					case SysPointAD :  value = "Pointing";  break;
+					case SysTrkStop :
+					case SysTrkStart:
+					case SysTrkMove :
+					case SysTrkSeek :  value = "Seeking";   break;
+					case SysTrkOk   :  value = "Tracking";  break;
+					case SysTrkCorr :  value = "Correction";break;
+					case SysTest    :  value = "Testing";   break;
+				}
+			}
+		}
+		SMSG(Tel_Mode, "telescope mode", value);
+		if(verb){
+			switch(Tel_Focus){
+				default:
+				case Prime    :  value = "Prime";     break;
+				case Nasmyth1 :  value = "Nasmyth1";  break;
+				case Nasmyth2 :  value = "Nasmyth2";  break;
+			}
+		}
+		SMSG(Tel_Focus, "focus mode", value);
+		if(verb){
+			switch(Sys_Target) {
+				default:
+				case TagObject   :  value = "Object";   break;
+				case TagPosition :  value = "A/Z-Pos."; break;
+				case TagNest     :  value = "Nest";     break;
+				case TagZenith   :  value = "Zenith";   break;
+				case TagHorizon  :  value = "Horizon";  break;
+			}
+		}
+		SMSG(Tel_Taget, "current or last telescope target", value);
+		if(verb){
+			if(Tel_Hardware == Hard_On)
+				switch (P2_State) {
+					default:
+					case P2_Off   :  value = "Stop";    break;
+					case P2_On    :  value = "Track";   break;
+					case P2_Plus  :  value = "Move+";   break;
+					case P2_Minus :  value = "Move-";   break;
+				}
+			else value = "Off";
+		}
+		SMSG(P2_Mode, "P2 rotator mode", value);
+		if(!sel || parameters_to_show[PAR_PCS_Coeffs]){
+			printf("\nPCS_Coeffs");
+			if(verb){
+				printf("=\"");
+				if(Pos_Corr){
+					for(i = 0; i < 8; ++i){
+						printf("%.2f%s", PosCor_Coeff[i], (i == 7) ? "\"" : ",");
+					}
+				}else{
+					printf("Off\"");
+				}
+			}else printf(" (Precision Correction System coefficients");
+		}
+		if(!sel || parameters_to_show[PAR_code_KOST]){
+			printf("\ncode_KOST");
+			if(verb){
+				printf("=\"0x%04X", code_KOST);
+				if(code_KOST){
+					printf(": ");
+					if(code_KOST & 0x8000) printf("A>0 ");
+					if(code_KOST & 0x4000) printf("PowerOn ");
+					if(code_KOST & 0x2000) printf("Guiding ");
+					if(code_KOST & 0x1000) printf("P2On ");
+					if(code_KOST & 0x01F0){
+						printf("CorrSpd=");
+						if(code_KOST & 0x0010) printf("0.2");
+						else if(code_KOST & 0x0020) printf("0.4");
+						else if(code_KOST & 0x0040) printf("1.0");
+						else if(code_KOST & 0x0080) printf("2.0");
+						else if(code_KOST & 0x0100) printf("5.0");
+						printf("''/s ");
+					}
+					if(code_KOST & 0x000F){
+						if(code_KOST & 0x0001) printf("Z+");
+						else if(code_KOST & 0x0002) printf("Z-");
+						else if(code_KOST & 0x0004) printf("A+");
+						else if(code_KOST & 0x0008) printf("A-");
+					}
+				}
+				printf("\"");
+			}else printf(" (syscodes)");
+		}
+		if(verb){
+			if(Az_Mode) value = "On";
+			else value = "Off";
+		}
+		SMSG(Az_Reverce, "reverce of azimuth direction", value);
+		if(!sel || parameters_to_show[PAR_Az_EndSw]){
+			printf("\nAz_EndSw");
+			if(verb){
+				printf("=\"");
+				if(switch_A){
+					if(switch_A & Sw_minus_A)   printf("A<0 ");
+					if(switch_A & Sw_plus240_A) printf("A=+240 ");
+					if(switch_A & Sw_minus240_A)printf("A=-240 ");
+					if(switch_A & Sw_minus45_A) printf("horizon");
+				}else printf("Off");
+				printf("\"");
+			}else printf(" (Azimuth end-switches)");
+		}
+		if(!sel || parameters_to_show[PAR_Zen_EndSw]){
+			printf("\nZen_EndSw");
+			if(verb){
+				printf("=\"");
+				if(switch_Z){
+					if(switch_Z & Sw_0_Z)  printf("Zenith ");
+					if(switch_Z & Sw_5_Z)  printf("Z<=5 ");
+					if(switch_Z & Sw_20_Z) printf("Z<=20 ");
+					if(switch_Z & Sw_60_Z) printf("Z>=60 ");
+					if(switch_Z & Sw_80_Z) printf("Z>=80 ");
+					if(switch_Z & Sw_90_Z) printf("Z=90 ");
+				}else printf("Off");
+				printf("\"");
+			}else printf(" (Zenith end-switches)");
+		}
+		if(!sel || parameters_to_show[PAR_P2_EndSw]){
+			printf("\nP2_EndSw");
+			if(verb){
+				printf("=\"");
+				if(switch_P){
+					if(switch_P & Sw_22_P) printf("22degr ");
+					if(switch_P & Sw_89_P) printf("89degr ");
+					if(switch_P & Sw_Sm_P) printf("SMOKE");
+				}else  printf("Off");
+				printf("\"");
+			}else printf(" (P2 end-switches)");
+		}
+		FMSG(Worm_A, "worm A position", "%gmkm", worm_A);
+		FMSG(Worm_Z, "worm Z position", "%gmkm", worm_Z);
+		if(verb && !sel){
+			for(i = 0; i < MesgNum; ++i){
+				switch (Sys_Mesg(i).type){
+					case MesgInfor  : value = "information"; break;
+					case MesgWarn   : value = "warning";     break;
+					case MesgFault  : value = "FAULT";       break;
+					case MesgLog    : value = "log";         break;
+					default         : value = NULL;
+				}
+				if(!value) continue;
+				printf("\nMessage[%d](num=%d, status=\"%s\")=\"%s\"", i,
+					Sys_Mesg(i).seq_num, value, Sys_Mesg(i).text);
+			}
+		}
+		if(!sel || parameters_to_show[PAR_Lock_Flags]){
+			printf("\nLock_Flags");
+			if(verb){
+				printf("=\"");
+				if(LockFlags){
+					if(A_Locked) printf("A ");
+					if(Z_Locked) printf("Z ");
+					if(P_Locked) printf("P2 ");
+					if(F_Locked) printf("F ");
+					if(D_Locked) printf("D ");
+				}else printf("Off");
+				printf("\"");
+			}else printf(" (locked motors)");
+		}
+		FMSG(Oil_Pres, "oil pressure in A,Z & tank (Pa)", "p(A)=%.1f, p(Z)=%.1f, p(tank)=%.1f", PressOilA, PressOilZ, PressOilTank);
+		FMSG(Oil_Temp, "oil temperature (degrC)", "%.1f", OilTemper1);
+		FMSG(Oil_Cool_Temp, "oil coolant themperature (degrC)", "%.1f", OilTemper2);
+	}
+/************************* BASIC_COORDS ***************************************/
+	if(lvl & BASIC_COORDS){ // basic coordinates: cur, src, inp, tel
+		SMSG(CurAlpha, "current", time_asc(CurAlpha));
+		SMSG(CurDelta, "current", angle_asc(CurDelta));
+		SMSG(SrcAlpha, "source", time_asc(SrcAlpha));
+		SMSG(SrcDelta, "source", angle_asc(SrcDelta));
+		SMSG(InpAlpha, "input", time_asc(InpAlpha));
+		SMSG(InpDelta, "input", angle_asc(InpDelta));
+
+		SMSG(CurAzim, "current", angle_fmt(tag_A,"%c%03d:%02d:%04.1f"));
+		SMSG(CurZenD, "current", angle_fmt(tag_Z,"%02d:%02d:%04.1f"));
+		SMSG(InpAzim, "input", angle_fmt(InpAzim,"%c%03d:%02d:%04.1f"));
+		SMSG(InpZenD, "input", angle_fmt(InpZdist,"%02d:%02d:%04.1f"));
+		SMSG(CurPA, "current", angle_fmt(tag_P,"%03d:%02d:%04.1f"));
+		SMSG(SrcPA, "source", angle_fmt(calc_PA(SrcAlpha,SrcDelta,S_time),"%03d:%02d:%04.1f"));
+		SMSG(InpPA, "input", angle_fmt(calc_PA(InpAlpha,InpDelta,S_time),"%03d:%02d:%04.1f"));
+		SMSG(TelPA, "telescope", angle_fmt(calc_PA(val_Alp, val_Del, S_time),"%03d:%02d:%04.1f"));
+
+		FMSG(ValFoc, "focus value", "%0.2f", val_F);
+	}
+	if(lvl & EXTENDED_COORDS){
+		SMSG(ValAzim, "from encoder", angle_fmt(val_A,"%c%03d:%02d:%04.1f"));
+		SMSG(ValZenD, "from encoder", angle_fmt(val_Z,"%02d:%02d:%04.1f"));
+		SMSG(ValP2, "from encoder", angle_fmt(val_P,"%03d:%02d:%04.1f"));
+		SMSG(ValDome, "from encoder", angle_fmt(val_D,"%c%03d:%02d:%04.1f"));
+
+		SMSG(DiffAzim, "A difference", angle_fmt(Diff_A,"%c%03d:%02d:%04.1f"));
+		SMSG(DiffZenD, "Z difference", angle_fmt(Diff_Z,"%c%02d:%02d:%04.1f"));
+		SMSG(DiffP2, "P2 difference", angle_fmt(Diff_P,"%c%03d:%02d:%04.1f"));
+		SMSG(DiffDome, "DomeAz difference", angle_fmt(val_A-val_D,"%c%03d:%02d:%04.1f"));
+
+		SMSG(VelAzim, "A velocity", angle_fmt(vel_A,"%c%02d:%02d:%04.1f"));
+		SMSG(VelZenD, "Z velocity", angle_fmt(vel_Z,"%c%02d:%02d:%04.1f"));
+		SMSG(VelP2, "P2 velocity", angle_fmt(vel_P,"%c%02d:%02d:%04.1f"));
+		SMSG(VelPA, "object PA velocity", angle_fmt(vel_objP,"%c%02d:%02d:%04.1f"));
+		SMSG(VelDome, "DomeAz velocity", angle_fmt(vel_D,"%c%02d:%02d:%04.1f"));
+
+		double corAlp = 0.,corDel = 0.,corA = 0.,corZ = 0.;
+		double PCSA = 0., PCSZ = 0., refr = 0.;
+		if(verb){
+			if(Sys_Mode == SysTrkSeek || Sys_Mode == SysTrkOk || Sys_Mode == SysTrkCorr){
+				double curA,curZ,srcA,srcZ;
+				corAlp = CurAlpha-SrcAlpha;
+				corDel = CurDelta-SrcDelta;
+				if(corAlp >  23*3600.) corAlp -= 24*3600.;
+				if(corAlp < -23*3600.) corAlp += 24*3600.;
+				calc_AZ(SrcAlpha, SrcDelta, S_time, &srcA, &srcZ);
+				calc_AZ(CurAlpha, CurDelta, S_time, &curA, &curZ);
+				corA = curA - srcA;
+				corZ = curZ - srcZ;
+				PCSA = tel_cor_A; PCSZ = tel_cor_Z; refr = tel_ref_Z;
+			}
+		}
+		FMSG(CorrPCS, "Point Correction System value",
+			"A=%s, Z=%s", angle_fmt(PCSA, "%c%01d:%02d:%04.1f"),
+			angle_fmt(PCSZ, "%c%01d:%02d:%04.1f"));
+		SMSG(Refraction, "calculated refraction value", angle_fmt(refr, "%c%01d:%02d:%04.1f"));
+		SMSG(CorrAlpha, "correction by RA", angle_fmt(corAlp,"%c%01d:%02d:%05.2f"));
+		SMSG(CorrDelta, "correction by Decl", angle_fmt(corDel,"%c%01d:%02d:%04.1f"));
+		SMSG(CorrAzim, "correction by A", angle_fmt(corA,"%c%01d:%02d:%04.1f"));
+		SMSG(CorrZenD, "correction by Z", angle_fmt(corZ,"%c%01d:%02d:%04.1f"));
+		if(verb){
+			switch(Foc_State){
+				case Foc_Hminus :
+				case Foc_Hplus  : value = "fast move"; break;
+				case Foc_Lminus :
+				case Foc_Lplus  : value = "slow move"; break;
+				default         : value = "stopped";
+			}
+		}
+		SMSG(Foc_State, "focus motor state", value);
+	}
+/************************** METEO_INFO ****************************************/
+	if(lvl & METEO_INFO){
+		FMSG(ValTout, "outern temperature (DegrC)", "%+05.1f", val_T1);
+		FMSG(ValTind, "indome temperature (DegrC)", "%+05.1f", val_T2);
+		FMSG(ValTmir, "mirror temperature (DegrC)", "%+05.1f", val_T3);
+		FMSG(ValPres, "atm. pressure (mmHg)", "%+05.1f", val_B);
+		FMSG(ValWind, "wind speed (m/s)", "%04.1f", val_Wnd);
+		double w10 = -1., w15 = -1., pre = -1.;
+		if(verb){
+			if(Wnd10_time > 0.1 && Wnd10_time <= M_time){
+				w10 = (M_time-Wnd10_time)/60.;
+				w15 = (M_time-Wnd15_time)/60.;
+			}
+			if(Precip_time > 0.1 && Precip_time <= M_time)
+				pre = (M_time-Precip_time)/60.;
+		}
+		FMSG(Blast10, "wind blast >=10m/s (minutes ago)", "%.1f", w10);
+		FMSG(Blast15, "wind blast >=15m/s (minutes ago)", "%.1f", w15);
+		FMSG(Precipitation, "last precipitation (minutes ago)", "%.1f", pre);
+		FMSG(ValHumd, "Humidity, %%", "%04.1f", val_Hmd);
+	}
+// FMSG("", "", "", ));
+/******************************************************************************/
+	printf("\n");
+#undef SMSG
+#undef FMSG
+	return 1;
+}
+
+void show_infolevels(){
+	printf("\n\t\tList of information levels: \n\tall");
+	levelstr *sptr = (levelstr *)infolevels_str;
+	info_level lastlvl = NO_INFO;
+	int start = 1; // 1 - first message, 0 - first message in line, 2 - next message in line
+	for(; ; ++sptr){
+		info_level l = sptr->lvl;
+		if(lastlvl == l){ // more variants
+			if(start != 2){
+				printf(" (");
+				start = 2;
+			}else
+				printf(" ,");
+		}else{
+			if(start == 2) printf(")");
+			printf("\n");
+			start = 0;
+			lastlvl = l;
+		}
+		if(!sptr->name) break;
+		if(start != 2) printf("\t");
+		printf(sptr->name);
+	}
+}
+
+info_level get_infolevel(char* infostr){
+	FNAME();
+	info_level ret = NO_INFO;
+	if(strcasestr(infostr, "all")) return ALL_INFO;
+	levelstr *sptr = (levelstr *)infolevels_str;
+	for(; sptr->name; ++sptr){
+		if(strcasestr(infostr, sptr->name))
+			ret |= sptr->lvl;
+	}
+	return ret;
+}

bta_print.h

@@ -0,0 +1,41 @@
+/*
+ * bta_print.h
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+
+#pragma once
+#ifndef __BTA_PRINT_H__
+#define __BTA_PRINT_H__
+
+typedef enum{
+	 NO_INFO          = 0      // don't show anything
+	,BASIC_COORDS     = 1      // show basic coordinates
+	,METEO_INFO       = 2      // meteo info
+	,TIME_INFO        = 4      // all info about time
+	,ACS_INFO         = 8      // extended ACS information
+	,EXTENDED_COORDS  = 0x11   // extended coords (val, spd, corr) + basic
+	,ALL_INFO         = 0xff   // all information available
+	,REQUESTED_LIST   = 0x8000 // show only parameters given in list
+} info_level;
+
+int bta_print (info_level lvl, char *par_list);
+void show_infolevels();
+info_level get_infolevel(char* infostr);
+
+#endif // __BTA_PRINT_H__

bta_shdata.c

@@ -0,0 +1,344 @@
+#include "bta_shdata.h"
+#include "usefull_macros.h"
+
+#pragma pack(push, 4)
+// Main command channel (level 5)
+struct CMD_Queue mcmd = {{"Mcmd"}, 0200,0,-1,0};
+// Operator command channel (level 4)
+struct CMD_Queue ocmd = {{"Ocmd"}, 0200,0,-1,0};
+// User command channel (level 2/3)
+struct CMD_Queue ucmd = {{"Ucmd"}, 0200,0,-1,0};
+
+static char msg[80];
+#define PERR(...)  do{sprintf(msg, __VA_ARGS__); perror(msg);} while(0)
+
+#ifndef BTA_MODULE
+struct BTA_Data *sdt;
+struct BTA_Local *sdtl;
+
+struct SHM_Block sdat = {
+	{"Sdat"},
+	sizeof(struct BTA_Data),
+	2048,0444,
+	SHM_RDONLY,
+	bta_data_init,
+	bta_data_check,
+	bta_data_close,
+	ClientSide,-1,NULL
+};
+
+int snd_id = -1;        // client sender ID
+int cmd_src_pid = 0;    // next command source PID
+uint32_t cmd_src_ip = 0;// next command source IP
+
+/**
+ * Init data
+ */
+void bta_data_init() {
+	sdt = (struct BTA_Data *)sdat.addr;
+	sdtl = (struct BTA_Local *)(sdat.addr+sizeof(struct BTA_Data));
+	if(sdat.side == ClientSide) {
+		if(sdt->magic != sdat.key.code) {
+			WARN("Wrong shared data (maybe server turned off)");
+		}
+		if(sdt->version == 0) {
+			WARN("Null shared data version (maybe server turned off)");
+		}
+		else if(sdt->version != BTA_Data_Ver) {
+			WARN("Wrong shared data version: I'am - %d, but server - %d ...",
+				BTA_Data_Ver, sdt->version );
+		}
+		if(sdt->size != sdat.size) {
+			if(sdt->size > sdat.size) {
+				WARN("Wrong shared area size: I needs - %d, but server - %d ...",
+					sdat.size, sdt->size );
+			} else {
+				WARN("Attention! Too little shared data structure!");
+				WARN("I needs - %d, but server gives only %d ...",
+					sdat.size, sdt->size );
+				WARN("May be server's version too old!?");
+			}
+		}
+		return;
+	}
+	/* ServerSide */
+	if(sdt->magic == sdat.key.code  &&
+		sdt->version == BTA_Data_Ver &&
+		sdt->size == sdat.size)
+		return;
+	memset(sdat.addr, 0, sdat.maxsize);
+	sdt->magic = sdat.key.code;
+	sdt->version = BTA_Data_Ver;
+	sdt->size = sdat.size;
+	Tel_Hardware = Hard_On;
+	Pos_Corr = PC_On;
+	TrkOk_Mode = UseDiffVel | UseDiffAZ ;
+	inp_B = 591.;
+	Pressure  = 595.;
+	PEP_code_A = 0x002aaa;
+	PEP_code_Z = 0x002aaa;
+	PEP_code_P = 0x002aaa;
+	PEP_code_F = 0x002aaa;
+	PEP_code_D = 0x002aaa;
+	DomeSEW_N = 1;
+}
+
+int  bta_data_check() {
+	return( (sdt->magic == sdat.key.code) && (sdt->version == BTA_Data_Ver) );
+}
+
+void bta_data_close() {
+	if(sdat.side == ServerSide) {
+		sdt->magic = 0;
+		sdt->version = 0;
+	}
+}
+
+/**
+ * Allocate shared memory segment
+ */
+int get_shm_block( struct SHM_Block *sb, int server) {
+	int getsize = (server)? sb->maxsize : sb->size;
+	// first try to find existing one
+	sb->id = shmget(sb->key.code, getsize, sb->mode);
+	if(sb->id < 0 && errno == ENOENT && server){
+		// if no - try to create a new one
+		int cresize = sb->maxsize;
+		if(sb->size > cresize){
+			WARN("Wrong shm maxsize(%d) < realsize(%d)",sb->maxsize,sb->size);
+			cresize = sb->size;
+		}
+		sb->id = shmget(sb->key.code, cresize, IPC_CREAT|IPC_EXCL|sb->mode);
+	}
+	if(sb->id < 0){
+		if(server)
+			PERR("Can't create shared memory segment '%s'",sb->key.name);
+		else
+			PERR("Can't find shared segment '%s' (maybe no server process) ",sb->key.name);
+		return 0;
+	}
+	// attach it to our memory space
+	sb->addr = (unsigned char *) shmat(sb->id, NULL, sb->atflag);
+	if((long)sb->addr == -1){
+		PERR("Can't attach shared memory segment '%s'",sb->key.name);
+		return 0;
+	}
+	if(server && (shmctl(sb->id, SHM_LOCK, NULL) < 0)){
+		PERR("Can't prevents swapping of shared memory segment '%s'",sb->key.name);
+		return 0;
+	}
+	DBG("Create & attach shared memory segment '%s' %dbytes at %lx",
+		sb->key.name, sb->size, (uint64_t)sb->addr);
+	sb->side = server;
+	if(sb->init != NULL)
+		sb->init();
+	return 1;
+}
+
+int close_shm_block(struct SHM_Block *sb){
+	int ret;
+	if(sb->close != NULL)
+		sb->close();
+	if(sb->side == ServerSide) {
+	//      ret = shmctl(sb->id, SHM_UNLOCK, NULL);
+		ret = shmctl(sb->id, IPC_RMID, NULL);
+	}
+	ret = shmdt (sb->addr);
+	return(ret);
+}
+
+/**
+ * Create|Find command queue
+ */
+void get_cmd_queue(struct CMD_Queue *cq, int server){
+	if (!server && cq->id >= 0) { //if already in use set current
+		snd_id = cq->id;
+		return;
+	}
+	// first try to find existing one
+	cq->id = msgget(cq->key.code, cq->mode);
+	// if no - try to create a new one
+	if(cq->id<0 && errno == ENOENT && server)
+		cq->id = msgget(cq->key.code, IPC_CREAT|IPC_EXCL|cq->mode);
+	if(cq->id<0){
+		if(server)
+			PERR("Can't create comand queue '%s'",cq->key.name);
+		else
+			PERR("Can't find comand queue '%s' (maybe no server process) ",cq->key.name);
+		return;
+	}
+	cq->side = server;
+	if(server){
+		char buf[120];  /* выбросить все команды из очереди */
+		while(msgrcv(cq->id, (struct msgbuf *)buf, 112, 0, IPC_NOWAIT) > 0);
+	}else
+		snd_id = cq->id;
+	cq->acckey = 0;
+}
+
+#endif // BTA_MODULE
+
+
+int check_shm_block( struct SHM_Block *sb) {
+	if(sb->check)
+		return(sb->check());
+	else return(0);
+}
+
+/**
+ * Set access key in current channel
+ */
+void set_acckey(uint32_t newkey){
+	if(snd_id < 0) return;
+	if(ucmd.id == snd_id)      ucmd.acckey = newkey;
+	else if(ocmd.id == snd_id) ocmd.acckey = newkey;
+	else if(mcmd.id == snd_id) mcmd.acckey = newkey;
+}
+
+/**
+ * Setup source data for one following command if default values
+ * (IP == 0 - local, PID = current) not suits
+ */
+void set_cmd_src(uint32_t ip, int pid) {
+	cmd_src_pid = pid;
+	cmd_src_ip = ip;
+}
+
+#pragma pack(push, 4)
+/**
+ * Send client commands to server
+ */
+void send_cmd(int cmd_code, char *buf, int size) {
+	struct my_msgbuf mbuf;
+	if(snd_id < 0) return;
+	if(size > 100) size = 100;
+	if(cmd_code > 0)
+		mbuf.mtype = cmd_code;
+	else
+		return;
+	if(ucmd.id == snd_id)      mbuf.acckey = ucmd.acckey;
+	else if(ocmd.id == snd_id) mbuf.acckey = ocmd.acckey;
+	else if(mcmd.id == snd_id) mbuf.acckey = mcmd.acckey;
+
+	mbuf.src_pid = cmd_src_pid ? cmd_src_pid : getpid();
+	mbuf.src_ip = cmd_src_ip;
+	cmd_src_pid = cmd_src_ip = 0;
+
+	if(size > 0)
+		memcpy(mbuf.mtext, buf, size);
+	else {
+		mbuf.mtext[0] = 0;
+		size = 1;
+	}
+	msgsnd(snd_id, (struct msgbuf *)&mbuf, size+12, IPC_NOWAIT);
+}
+
+void send_cmd_noarg(int cmd_code) {
+	send_cmd(cmd_code, NULL, 0);
+}
+void send_cmd_str(int cmd_code, char *arg) {
+	send_cmd(cmd_code, arg, strlen(arg)+1);
+}
+void send_cmd_i1(int cmd_code, int32_t arg1) {
+	send_cmd(cmd_code, (char *)&arg1, sizeof(int32_t));
+}
+void send_cmd_i2(int cmd_code, int32_t arg1, int32_t arg2) {
+	int32_t ibuf[2];
+	ibuf[0] = arg1;
+	ibuf[1] = arg2;
+	send_cmd(cmd_code, (char *)ibuf, 2*sizeof(int32_t));
+}
+void send_cmd_i3(int cmd_code, int32_t arg1, int32_t arg2, int32_t arg3) {
+	int32_t ibuf[3];
+	ibuf[0] = arg1;
+	ibuf[1] = arg2;
+	ibuf[2] = arg3;
+	send_cmd(cmd_code, (char *)ibuf, 3*sizeof(int32_t));
+}
+void send_cmd_i4(int cmd_code, int32_t arg1, int32_t arg2, int32_t arg3, int32_t arg4) {
+	int32_t ibuf[4];
+	ibuf[0] = arg1;
+	ibuf[1] = arg2;
+	ibuf[2] = arg3;
+	ibuf[3] = arg4;
+	send_cmd(cmd_code, (char *)ibuf, 4*sizeof(int32_t));
+}
+void send_cmd_d1(int32_t cmd_code, double arg1) {
+	send_cmd(cmd_code, (char *)&arg1, sizeof(double));
+}
+void send_cmd_d2(int cmd_code, double arg1, double arg2) {
+	double dbuf[2];
+	dbuf[0] = arg1;
+	dbuf[1] = arg2;
+	send_cmd(cmd_code, (char *)dbuf, 2*sizeof(double));
+}
+void send_cmd_i1d1(int cmd_code, int32_t arg1, double arg2) {
+	struct {
+		int32_t ival;
+		double dval;
+	} buf;
+	buf.ival = arg1;
+	buf.dval = arg2;
+	send_cmd(cmd_code, (char *)&buf, sizeof(buf));
+}
+void send_cmd_i2d1(int cmd_code, int32_t arg1, int32_t arg2, double arg3) {
+	struct {
+		int32_t ival[2];
+		double dval;
+	} buf;
+	buf.ival[0] = arg1;
+	buf.ival[1] = arg2;
+	buf.dval = arg3;
+	send_cmd(cmd_code, (char *)&buf, sizeof(buf));
+}
+void send_cmd_i3d1(int cmd_code, int32_t arg1, int32_t arg2, int32_t arg3, double arg4) {
+	struct {
+		int32_t ival[3];
+		double dval;
+	} buf;
+	buf.ival[0] = arg1;
+	buf.ival[1] = arg2;
+	buf.ival[2] = arg3;
+	buf.dval = arg4;
+	send_cmd(cmd_code, (char *)&buf, sizeof(buf));
+}
+
+void encode_lev_passwd(char *passwd, int nlev, uint32_t *keylev, uint32_t *codlev){
+	char salt[4];
+	char *encr;
+	union {
+		uint32_t ui;
+		char c[4];
+	} key, cod;
+	sprintf(salt,"L%1d",nlev);
+	encr = (char *)crypt(passwd, salt);
+	cod.c[0] = encr[2];
+	key.c[0] = encr[3];
+	cod.c[1] = encr[4];
+	key.c[1] = encr[5];
+	cod.c[2] = encr[6];
+	key.c[2] = encr[7];
+	cod.c[3] = encr[8];
+	key.c[3] = encr[9];
+	*keylev = key.ui;
+	*codlev = cod.ui;
+}
+
+int find_lev_passwd(char *passwd, uint32_t *keylev, uint32_t *codlev){
+	int nlev;
+	for(nlev = 5; nlev > 0; --nlev){
+		encode_lev_passwd(passwd, nlev, keylev, codlev);
+		if(*codlev == code_Lev(nlev)) break;
+	}
+	return(nlev);
+}
+
+int check_lev_passwd(char *passwd){
+	uint32_t keylev,codlev;
+	int nlev;
+	nlev = find_lev_passwd(passwd, &keylev, &codlev);
+	if(nlev > 0) set_acckey(keylev);
+	return(nlev);
+}
+
+#pragma pack(pop)

bta_shdata.h

@@ -0,0 +1,850 @@
+#pragma once
+#ifndef __BTA_SHDATA_H__
+#define __BTA_SHDATA_H__
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <stdint.h>
+#include <string.h>
+#include <sys/ipc.h>
+#include <sys/shm.h>
+#include <sys/msg.h>
+#include <errno.h>
+
+#pragma pack(push, 4)
+/*
+ * Shared memory block
+ */
+struct SHM_Block {
+	union {
+		char  name[5];       // memory segment identificator
+		key_t code;
+	} key;
+	int32_t size;             // size of memory used
+	int32_t maxsize;          // size when created
+	int32_t mode;             // access mode (rwxrwxrwx)
+	int32_t atflag;           // connection mode (SHM_RDONLY  or 0)
+	void (*init)();           // init function
+	int32_t  (*check)();      // test function
+	void (*close)();          // deinit function
+	int32_t side;             // connection type: client/server
+	int32_t id;               // connection identificator
+	uint8_t *addr;            // connection address
+};
+
+extern struct SHM_Block sdat;
+
+/*
+ * Command queue descriptor
+ */
+struct CMD_Queue {
+	union {
+		char  name[5];    // queue key
+		key_t code;
+	} key;
+	int32_t mode;       // access mode (rwxrwxrwx)
+	int32_t side;       // connection type (Sender/Receiver - server/client)
+	int32_t id;         // connection identificator
+	uint32_t acckey;    // access key (for transmission from client to server)
+};
+
+extern struct CMD_Queue mcmd;
+extern struct CMD_Queue ocmd;
+extern struct CMD_Queue ucmd;
+
+void send_cmd_noarg(int);
+void send_cmd_str(int, char *);
+void send_cmd_i1(int, int32_t);
+void send_cmd_i2(int, int32_t, int32_t);
+void send_cmd_i3(int, int32_t, int32_t, int32_t);
+void send_cmd_i4(int, int32_t, int32_t, int32_t, int32_t);
+void send_cmd_d1(int, double);
+void send_cmd_d2(int, double, double);
+void send_cmd_i1d1(int, int32_t, double);
+void send_cmd_i2d1(int, int32_t, int32_t, double);
+void send_cmd_i3d1(int, int32_t, int32_t, int32_t, double);
+
+/*******************************************************************************
+*                             Command list                                     *
+*******************************************************************************/
+/*      name                             code  args          type   */
+// Stop telescope
+#define StopTel                           1
+#define StopTeleskope()   send_cmd_noarg( 1 )
+// High/low speed
+#define StartHS                           2
+#define StartHighSpeed()  send_cmd_noarg( 2 )
+#define StartLS                           3
+#define StartLowSpeed()   send_cmd_noarg( 3 )
+// Timer setup (Ch7_15 or SysTimer)
+#define SetTmr                            4
+#define SetTimerMode(T)   send_cmd_i1   ( 4, (int)(T))
+// Simulation (modeling) mode
+#define SetModMod                         5
+#define SetModelMode(M)   send_cmd_i1   ( 5, (int)(M))
+// Azimuth speed code
+#define SetCodA                           6
+#define SetPKN_A(iA,sA)   send_cmd_i2   ( 6, (int)(iA),(int)(sA))
+// Zenith speed code
+#define SetCodZ                           7
+#define SetPKN_Z(iZ)      send_cmd_i1   ( 7, (int)(iZ))
+// Parangle speed code
+#define SetCodP                           8
+#define SetPKN_P(iP)      send_cmd_i1   ( 8, (int)(iP))
+// Set Az velocity
+#define SetVA                             9
+#define SetSpeedA(vA)     send_cmd_d1   ( 9, (double)(vA))
+// Set Z velocity
+#define SetVZ                            10
+#define SetSpeedZ(vZ)     send_cmd_d1   (10, (double)(vZ))
+// Set P velocity
+#define SetVP                            11
+#define SetSpeedP(vP)     send_cmd_d1   (11, (double)(vP))
+// Set new polar coordinates
+#define SetAD                            12
+#define SetRADec(Alp,Del) send_cmd_d2   (12, (double)(Alp),(double)(Del))
+// Set new azimutal coordinates
+#define SetAZ                            13
+#define SetAzimZ(A,Z)     send_cmd_d2   (13, (double)(A),(double)(Z))
+// Goto new object by polar coords
+#define GoToAD                           14
+#define GoToObject()      send_cmd_noarg(14 )
+// Start steering to object by polar coords
+#define MoveToAD                         15
+#define MoveToObject()    send_cmd_noarg(15 )
+// Go to object by azimutal coords
+#define GoToAZ                           16
+#define GoToAzimZ()       send_cmd_noarg(16 )
+// Set A&Z for simulation
+#define WriteAZ                          17
+#define WriteModelAZ()    send_cmd_noarg(17 )
+// Set P2 mode
+#define SetModP                          18
+#define SetPMode(pmod)    send_cmd_i1   (18, (int)(pmod))
+// Move(+-1)/Stop(0) P2
+#define P2Move                           19
+#define MoveP2(dir)       send_cmd_i1   (19, (int)(dir))
+// Move(+-2,+-1)/Stop(0) focus
+#define FocMove                          20
+#define MoveFocus(speed,time) send_cmd_i1d1(20,(int)(speed),(double)(time))
+// Use/don't use pointing correction system
+#define UsePCorr                         21
+#define SwitchPosCorr(pc_flag) send_cmd_i1 (21, (int)(pc_flag))
+// Tracking flags
+#define SetTrkFlags                      22
+#define SetTrkOkMode(trk_flags) send_cmd_i1 (22, (int)(trk_flags))
+// Set focus (0 - primary, 1 - N1, 2 - N2)
+#define SetTFoc                          23
+#define SetTelFocus(N)    send_cmd_i1  ( 23, (int)(N))
+// Set intrinsic move parameters by RA/Decl
+#define SetVAD                           24
+#define SetVelAD(VAlp,VDel) send_cmd_d2 (24, (double)(VAlp),(double)(VDel))
+// Reverse Azimuth direction when pointing
+#define SetRevA                          25
+#define SetAzRevers(amod) send_cmd_i1   (25, (int)(amod))
+// Set P2 velocity
+#define SetVP2                           26
+#define SetVelP2(vP2) send_cmd_d1       (26, (double)(vP2))
+// Set pointing target
+#define SetTarg                          27
+#define SetSysTarg(Targ) send_cmd_i1    (27, (int)(Targ))
+// Send message to all clients (+write into protocol)
+#define SendMsg                          28
+#define SendMessage(Mesg) send_cmd_str  (28, (char *)(Mesg))
+// RA/Decl user correction
+#define CorrAD                           29
+#define DoADcorr(dAlp,dDel) send_cmd_d2 (29, (double)(dAlp),(double)(dDel))
+// A/Z user correction
+#define CorrAZ                           30
+#define DoAZcorr(dA,dZ)    send_cmd_d2  (30, (double)(dA),(double)(dZ))
+// sec A/Z user correction speed
+#define SetVCAZ                          31
+#define SetVCorr(vA,vZ)   send_cmd_d2   (31, (double)(vA),(double)(vZ))
+// move P2 with given velocity for a given time
+#define P2MoveTo                         32
+#define MoveP2To(vP2,time) send_cmd_d2  (32, (double)(vP2),(double)(time))
+// Go to t/Decl position
+#define GoToTD                           33
+#define GoToSat()        send_cmd_noarg (33 )
+// Move to t/Decl
+#define MoveToTD                         34
+#define MoveToSat()      send_cmd_noarg (34 )
+// Empty command for synchronisation
+#define NullCom                          35
+#define SyncCom()        send_cmd_noarg (35 )
+// Button "Start"
+#define StartTel                         36
+#define StartTeleskope()  send_cmd_noarg(36 )
+// Set telescope mode
+#define SetTMod                          37
+#define SetTelMode(M)     send_cmd_i1  ( 37, (int)(M))
+// Turn telescope on (oil etc)
+#define TelOn                            38
+#define TeleskopeOn()     send_cmd_noarg(38 )
+// Dome mode
+#define SetModD                          39
+#define SetDomeMode(dmod) send_cmd_i1   (39, (int)(dmod))
+// Move(+-3,+-2,+-1)/Stop(0) dome
+#define DomeMove                         40
+#define MoveDome(speed,time) send_cmd_i1d1(40,(int)(speed),(double)(time))
+// Set account password
+#define SetPass                          41
+#define SetPasswd(LPass)   send_cmd_str (41, (char *)(LPass))
+// Set code of access level
+#define SetLevC                          42
+#define SetLevCode(Nlev,Cod) send_cmd_i2(42, (int)(Nlev),(int)(Cod))
+// Set key for access level
+#define SetLevK                          43
+#define SetLevKey(Nlev,Key)  send_cmd_i2(43, (int)(Nlev),(int)(Key))
+// Setup network
+#define SetNet                           44
+#define SetNetAcc(Mask,Addr) send_cmd_i2(44, (int)(Mask),(int)(Addr))
+// Input meteo data
+#define SetMet                           45
+#define SetMeteo(m_id,m_val) send_cmd_i1d1(45,(int)(m_id),(double)(m_val))
+// Cancel meteo data
+#define TurnMetOff                       46
+#define TurnMeteoOff(m_id)   send_cmd_i1 (46, (int)(m_id))
+// Set time correction (IERS DUT1=UT1-UTC)
+#define SetDUT1                          47
+#define SetDtime(dT)         send_cmd_d1 (47, (double)(dT))
+// Set polar motion (IERS polar motion)
+#define SetPM                            48
+#define SetPolMot(Xp,Yp)     send_cmd_d2 (48, (double)(Xp),(double)(Yp))
+// Get SEW parameter
+#define GetSEW                           49
+#define GetSEWparam(Ndrv,Indx,Cnt) send_cmd_i3(49,(int)(Ndrv),(int)(Indx),(int)(Cnt))
+// Set SEW parameter
+#define PutSEW                           50
+#define PutSEWparam(Ndrv,Indx,Key,Val) send_cmd_i4(50,(int)(Ndrv),(int)(Indx),(int)(Key),(int)(Val))
+// Set lock flags
+#define SetLocks                         51
+#define SetLockFlags(f)      send_cmd_i1 (SetLocks, (int)(f))
+// Clear lock flags
+#define ClearLocks                       52
+#define ClearLockFlags(f)    send_cmd_i1 (ClearLocks, (int)(f))
+// Set PEP-RK bits
+#define SetRKbits                        53
+#define AddRKbits(f)         send_cmd_i1 (SetRKbits, (int)(f))
+// Clear PEP-RK bits
+#define ClrRKbits                        54
+#define ClearRKbits(f)       send_cmd_i1 (ClrRKbits, (int)(f))
+// Set SEW dome motor number (for indication)
+#define SetSEWnd                         55
+#define SetDomeDrive(ND)     send_cmd_i1 (SetSEWnd, (int)(ND))
+// Turn SEW controllers of dome on/off
+#define SEWsDome                         56
+#define DomeSEW(OnOff)       send_cmd_i1 (SEWsDome, (int)(OnOff))
+
+
+/*******************************************************************************
+*                         BTA data structure definitions                       *
+*******************************************************************************/
+
+#define ServPID  (sdt->pid) // PID of main program
+// model
+#define UseModel  (sdt->model) // model variants
+enum{
+	 NoModel = 0  // OFF
+	,CheckModel   // control motors by model
+	,DriveModel   // "blind" management without real sensors
+	,FullModel    // full model without telescope
+};
+// timer
+#define ClockType (sdt->timer) // which timer to use
+enum{
+	 Ch7_15 = 0 // Inner timer with synchronisation by CH7_15
+	,SysTimer   // System timer (synchronisation unknown)
+	,ExtSynchro // External synchronisation (bta_time or xntpd)
+};
+// system
+#define Sys_Mode (sdt->system) // main system mode
+enum{
+	 SysStop = 0 // Stop
+	,SysWait     // Wait for start (pointing)
+	,SysPointAZ  // Pointing by A/Z
+	,SysPointAD  // Pointing by RA/Decl
+	,SysTrkStop  // Tracking stop
+	,SysTrkStart // Start tracking (acceleration to nominal velocity)
+	,SysTrkMove  // Tracking move to object
+	,SysTrkSeek  // Tracking in seeking mode
+	,SysTrkOk    // Tracking OK
+	,SysTrkCorr  // Correction of tracking position
+	,SysTest     // Test
+};
+// sys_target
+#define Sys_Target (sdt->sys_target) // system pointing target
+enum{
+	 TagPosition = 0 // point by A/Z
+	,TagObject       // point by RA/Decl
+	,TagNest         // point to "nest"
+	,TagZenith       // point to zenith
+	,TagHorizon      // point to horizon
+	,TagStatObj      // point to statinary object (t/Decl)
+};
+// tel_focus
+#define Tel_Focus (sdt->tel_focus) // telescope focus type
+enum{
+	 Prime = 0
+	,Nasmyth1
+	,Nasmyth2
+};
+// PCS
+#define  PosCor_Coeff  (sdt->pc_coeff) // pointing correction system coefficients
+// tel_state
+#define  Tel_State (sdt->tel_state) // telescope state
+#define  Req_State (sdt->req_state) // required state
+enum{
+	 Stopping = 0
+	,Pointing
+	,Tracking
+};
+// tel_hard_state
+#define  Tel_Hardware (sdt->tel_hard_state) // Power state
+enum{
+	 Hard_Off = 0
+	,Hard_On
+};
+// tel_mode
+#define  Tel_Mode (sdt->tel_mode) // telescope mode
+enum{
+	 Automatic = 0 // Automatic (normal) mode
+	,Manual    = 1 // manual mode
+	,ZenHor    = 2 // work when Z<5 || Z>80
+	,A_Move    = 4 // hand move by A
+	,Z_Move    = 8 // hand move by Z
+	,Balance  =0x10// balancing
+};
+// az_mode
+#define Az_Mode (sdt->az_mode) // azimuth reverce
+enum{
+	 Rev_Off = 0  // move by nearest way
+	,Rev_On       // move by longest way
+};
+// p2_state
+#define P2_State (sdt->p2_state) // P2 motor state
+#define  P2_Mode (sdt->p2_req_mode)
+enum{
+	 P2_Off = 0    // Stop
+	,P2_On         // Guiding
+	,P2_Plus       // Move to +
+	,P2_Minus = -2 // Move to -
+};
+// focus_state
+#define Foc_State (sdt->focus_state) // focus motor state
+enum{
+	 Foc_Hminus = -2// fast "-" move
+	,Foc_Lminus     // slow "-" move
+	,Foc_Off        // Off
+	,Foc_Lplus      // slow "+" move
+	,Foc_Hplus      // fast "+" move
+};
+// dome_state
+#define Dome_State (sdt->dome_state) // dome motors state
+enum{
+	 D_Hminus = -3 // speeds: low, medium, high
+	,D_Mminus
+	,D_Lminus
+	,D_Off         // off
+	,D_Lplus
+	,D_Mplus
+	,D_Hplus
+	,D_On = 7      // auto
+};
+// pcor_mode
+#define Pos_Corr (sdt->pcor_mode) // pointing correction mode
+enum{
+	 PC_Off = 0
+	,PC_On
+};
+// trkok_mode
+#define TrkOk_Mode (sdt->trkok_mode) // tracking mode
+enum{
+	 UseDiffVel = 1 // Isodrome (correction by real motors speed)
+	,UseDiffAZ  = 2 // Tracking by coordinate difference
+	,UseDFlt    = 4 // Turn on digital filter
+};
+// input RA/Decl values
+#define  InpAlpha  (sdt->i_alpha)
+#define  InpDelta  (sdt->i_delta)
+// current source RA/Decl values
+#define  SrcAlpha  (sdt->s_alpha)
+#define  SrcDelta  (sdt->s_delta)
+// intrinsic object velocity
+#define  VelAlpha  (sdt->v_alpha)
+#define  VelDelta  (sdt->v_delta)
+// input A/Z values
+#define  InpAzim   (sdt->i_azim)
+#define  InpZdist  (sdt->i_zdist)
+// calculated values
+#define  CurAlpha  (sdt->c_alpha)
+#define  CurDelta  (sdt->c_delta)
+// current values (from sensors)
+#define  tag_A  (sdt->tag_a)
+#define  tag_Z  (sdt->tag_z)
+#define  tag_P  (sdt->tag_p)
+ // calculated corrections
+#define  pos_cor_A  (sdt->pcor_a)
+#define  pos_cor_Z  (sdt->pcor_z)
+#define  refract_Z  (sdt->refr_z)
+// reverse calculation corr.
+#define  tel_cor_A  (sdt->tcor_a)
+#define  tel_cor_Z  (sdt->tcor_z)
+#define  tel_ref_Z  (sdt->tref_z)
+// coords difference
+#define  Diff_A  (sdt->diff_a)
+#define  Diff_Z  (sdt->diff_z)
+#define  Diff_P  (sdt->diff_p)
+// base object velocity
+#define  vel_objA (sdt->vbasea)
+#define  vel_objZ (sdt->vbasez)
+#define  vel_objP (sdt->vbasep)
+// correction by real speed
+#define diff_vA  (sdt->diffva)
+#define diff_vZ  (sdt->diffvz)
+#define diff_vP  (sdt->diffvp)
+// motor speed
+#define  speedA  (sdt->speeda)
+#define  speedZ  (sdt->speedz)
+#define  speedP  (sdt->speedp)
+// last precipitation time
+#define  Precip_time (sdt->m_time_precip)
+// reserved
+#define  Reserve (sdt->reserve)
+// real motor speed (''/sec)
+#define  req_speedA (sdt->rspeeda)
+#define  req_speedZ (sdt->rspeedz)
+#define  req_speedP (sdt->rspeedp)
+// model speed
+#define  mod_vel_A  (sdt->simvela)
+#define  mod_vel_Z  (sdt->simvelz)
+#define  mod_vel_P  (sdt->simvelp)
+#define  mod_vel_F  (sdt->simvelf)
+#define  mod_vel_D  (sdt->simvelf)
+// telescope & hand correction state
+/*
+ * 0x8000 - ÁÚÉÍÕÔ ÐÏÌÏÖÉÔÅÌØÎÙÊ
+ * 0x4000 - ÏÔÒÁÂÏÔËÁ ×ËÌ.
+ * 0x2000 - ÒÅÖÉÍ ×ÅÄÅÎÉÑ
+ * 0x1000 - ÏÔÒÁÂÏÔËÁ P2 ×ËÌ.
+ * 0x01F0 - ÓË.ËÏÒÒ. 0.2 0.4 1.0 2.0 5.0("/ÓÅË)
+ * 0x000F - ÎÁÐÒ.ËÏÒÒ. +Z -Z +A -A
+ */
+#define  code_KOST (sdt->kost)
+// different time (UTC, stellar, local)
+#define  M_time  (sdt->m_time)
+#define  S_time  (sdt->s_time)
+#define  L_time  (sdt->l_time)
+// PPNDD sensor (rough) code
+#define  ppndd_A  (sdt->ppndd_a)
+#define  ppndd_Z  (sdt->ppndd_z)
+#define  ppndd_P  (sdt->ppndd_p)
+#define  ppndd_B  (sdt->ppndd_b)  // atm. pressure
+// DUP sensor (precise) code (Gray code)
+#define  dup_A  (sdt->dup_a)
+#define  dup_Z  (sdt->dup_z)
+#define  dup_P  (sdt->dup_p)
+#define  dup_F  (sdt->dup_f)
+#define  dup_D  (sdt->dup_d)
+// binary 14-digit precise code
+#define  low_A  (sdt->low_a)
+#define  low_Z  (sdt->low_z)
+#define  low_P  (sdt->low_p)
+#define  low_F  (sdt->low_f)
+#define  low_D  (sdt->low_d)
+// binary 23-digit rough code
+#define  code_A  (sdt->code_a)
+#define  code_Z  (sdt->code_z)
+#define  code_P  (sdt->code_p)
+#define  code_B  (sdt->code_b)
+#define  code_F  (sdt->code_f)
+#define  code_D  (sdt->code_d)
+// ADC PCL818 (8-channel) codes
+#define  ADC(N) (sdt->adc[(N)])
+#define  code_T1 ADC(0)        // External temperature code
+#define  code_T2 ADC(1)        // In-dome temperature code
+#define  code_T3 ADC(2)        // Mirror temperature code
+#define  code_Wnd ADC(3)       // Wind speed code
+// calculated values
+#define  val_A  (sdt->val_a)    // A, ''
+#define  val_Z  (sdt->val_z)    // Z, ''
+#define  val_P  (sdt->val_p)    // P, ''
+#define  val_B  (sdt->val_b)    // atm. pressure, mm.hg.
+#define  val_F  (sdt->val_f)    // focus, mm
+#define  val_D  (sdt->val_d)    // Dome Az, ''
+#define  val_T1 (sdt->val_t1)   // ext. T, degrC
+#define  val_T2 (sdt->val_t2)   // in-dome T, degrC
+#define  val_T3 (sdt->val_t3)   // mirror T, degrC
+#define  val_Wnd (sdt->val_wnd) // wind speed, m/s
+// RA/Decl calculated by A/Z
+#define  val_Alp  (sdt->val_alp)
+#define  val_Del  (sdt->val_del)
+// measured speed
+#define  vel_A  (sdt->vel_a)
+#define  vel_Z  (sdt->vel_z)
+#define  vel_P  (sdt->vel_p)
+#define  vel_F  (sdt->vel_f)
+#define  vel_D  (sdt->vel_d)
+// system messages queue
+#define MesgNum 3
+#define MesgLen 39
+// message type
+enum{
+	 MesgEmpty = 0
+	,MesgInfor
+	,MesgWarn
+	,MesgFault
+	,MesgLog
+};
+#define Sys_Mesg(N) (sdt->sys_msg_buf[N])
+// access levels
+#define  code_Lev1   (sdt->code_lev[0]) // remote observer - only information
+#define  code_Lev2   (sdt->code_lev[1]) // local observer - input coordinates
+#define  code_Lev3   (sdt->code_lev[2]) // main observer - correction by A/Z, P2/F management
+#define  code_Lev4   (sdt->code_lev[3]) // operator - start/stop telescope, testing
+#define  code_Lev5   (sdt->code_lev[4]) // main operator - full access
+#define  code_Lev(x) (sdt->code_lev[(x-1)])
+// network settings
+#define  NetMask    (sdt->netmask)  // subnet mask (usually 255.255.255.0)
+#define  NetWork    (sdt->netaddr)  // subnet address (for ex.: 192.168.3.0)
+#define  ACSMask    (sdt->acsmask)  // ACS network mask (for ex.: 255.255.255.0)
+#define  ACSNet     (sdt->acsaddr)  // ACS subnet address (for ex.: 192.168.13.0)
+// meteo data
+#define  MeteoMode (sdt->meteo_stat)
+enum{
+	 INPUT_B   = 1    // pressure
+	,INPUT_T1  = 2    // external T
+	,INPUT_T2  = 4    // in-dome T
+	,INPUT_T3  = 8    // mirror T
+	,INPUT_WND = 0x10 // wind speed
+	,INPUT_HMD = 0x20 // humidity
+};
+#define  SENSOR_B   (INPUT_B  <<8)  // external data flags
+#define  SENSOR_T1  (INPUT_T1 <<8)
+#define  SENSOR_T2  (INPUT_T2 <<8)
+#define  SENSOR_T3  (INPUT_T3 <<8)
+#define  SENSOR_WND (INPUT_WND<<8)
+#define  SENSOR_HMD (INPUT_HMD<<8)
+#define  ADC_B      (INPUT_B  <<16)  // reading from ADC flags
+#define  ADC_T1     (INPUT_T1 <<16)
+#define  ADC_T2     (INPUT_T2 <<16)
+#define  ADC_T3     (INPUT_T3 <<16)
+#define  ADC_WND    (INPUT_WND<<16)
+#define  ADC_HMD    (INPUT_HMD<<16)
+#define  NET_B      (INPUT_B  <<24)  // got by network flags
+#define  NET_T1     (INPUT_T1 <<24)
+#define  NET_WND    (INPUT_WND<<24)
+#define  NET_HMD    (INPUT_HMD<<24)
+// input meteo values
+#define  inp_B  (sdt->inp_b)    // atm.pressure (mm.hg)
+#define  inp_T1 (sdt->inp_t1)   // ext T
+#define  inp_T2 (sdt->inp_t2)   // in-dome T
+#define  inp_T3 (sdt->inp_t3)   // mirror T
+#define  inp_Wnd (sdt->inp_wnd) // wind
+// values used for refraction calculation
+#define  Temper      (sdt->temper)
+#define  Pressure    (sdt->press)
+// last wind gust time
+#define  Wnd10_time  (sdt->m_time10)
+#define  Wnd15_time  (sdt->m_time15)
+// IERS DUT1
+#define  DUT1  (sdt->dut1)
+// sensors reading time
+#define  A_time  (sdt->a_time)
+#define  Z_time  (sdt->z_time)
+#define  P_time  (sdt->p_time)
+// input speeds
+#define  speedAin  (sdt->speedain)
+#define  speedZin  (sdt->speedzin)
+#define  speedPin  (sdt->speedpin)
+// acceleration (''/sec^2)
+#define  acc_A  (sdt->acc_a)
+#define  acc_Z  (sdt->acc_z)
+#define  acc_P  (sdt->acc_p)
+#define  acc_F  (sdt->acc_f)
+#define  acc_D  (sdt->acc_d)
+// SEW code
+#define  code_SEW  (sdt->code_sew)
+// sew data
+#define  statusSEW(Drv) (sdt->sewdrv[(Drv)-1].status)
+#define  statusSEW1     (sdt->sewdrv[0].status)
+#define  statusSEW2     (sdt->sewdrv[1].status)
+#define  statusSEW3     (sdt->sewdrv[2].status)
+#define  speedSEW(Drv) (sdt->sewdrv[(Drv)-1].set_speed)
+#define  speedSEW1     (sdt->sewdrv[0].set_speed)
+#define  speedSEW2     (sdt->sewdrv[1].set_speed)
+#define  speedSEW3     (sdt->sewdrv[2].set_speed)
+#define  vel_SEW(Drv) (sdt->sewdrv[(Drv)-1].mes_speed)
+#define  vel_SEW1     (sdt->sewdrv[0].mes_speed)
+#define  vel_SEW2     (sdt->sewdrv[1].mes_speed)
+#define  vel_SEW3     (sdt->sewdrv[2].mes_speed)
+#define  currentSEW(Drv) (sdt->sewdrv[(Drv)-1].current)
+#define  currentSEW1     (sdt->sewdrv[0].current)
+#define  currentSEW2     (sdt->sewdrv[1].current)
+#define  currentSEW3     (sdt->sewdrv[2].current)
+#define  indexSEW(Drv) (sdt->sewdrv[(Drv)-1].index)
+#define  indexSEW1     (sdt->sewdrv[0].index)
+#define  indexSEW2     (sdt->sewdrv[1].index)
+#define  indexSEW3     (sdt->sewdrv[2].index)
+#define  valueSEW(Drv) (sdt->sewdrv[(Drv)-1].value.l)
+#define  valueSEW1     (sdt->sewdrv[0].value.l)
+#define  valueSEW2     (sdt->sewdrv[1].value.l)
+#define  valueSEW3     (sdt->sewdrv[2].value.l)
+#define  bvalSEW(Drv,Nb) (sdt->sewdrv[(Drv)-1].value.b[Nb])
+// 23-digit PEP-controllers code
+#define  PEP_code_A  (sdt->pep_code_a)
+#define  PEP_code_Z  (sdt->pep_code_z)
+#define  PEP_code_P  (sdt->pep_code_p)
+// PEP end-switches code
+#define  switch_A  (sdt->pep_sw_a)
+enum{
+	 Sw_minus_A    = 1  // negative A value
+	,Sw_plus240_A  = 2  // end switch +240degr
+	,Sw_minus240_A = 4  // end switch -240degr
+	,Sw_minus45_A  = 8  // "horizon" end switch
+};
+#define  switch_Z  (sdt->pep_sw_z)
+enum{
+	 Sw_0_Z    = 1
+	,Sw_5_Z    = 2
+	,Sw_20_Z   = 4
+	,Sw_60_Z   = 8
+	,Sw_80_Z   = 0x10
+	,Sw_90_Z   = 0x20
+};
+#define  switch_P  (sdt->pep_sw_p)
+enum{
+	 Sw_No_P = 0    // no switches
+	,Sw_22_P = 1    // 22degr
+	,Sw_89_P = 2    // 89degr
+	,Sw_Sm_P = 0x80 // Primary focus smoke sensor
+};
+// PEP codes
+#define  PEP_code_F    (sdt->pep_code_f)
+#define  PEP_code_D    (sdt->pep_code_d)
+#define  PEP_code_Rin  (sdt->pep_code_ri)
+#define  PEP_code_Rout (sdt->pep_code_ro)
+// PEP flags
+#define PEP_A_On  (sdt->pep_on[0])
+#define PEP_A_Off (PEP_A_On==0)
+#define PEP_Z_On  (sdt->pep_on[1])
+#define PEP_Z_Off (PEP_Z_On==0)
+#define PEP_P_On  (sdt->pep_on[2])
+#define PEP_P_Off (PEP_P_On==0)
+#define PEP_F_On  (sdt->pep_on[3])
+#define PEP_F_Off (PEP_F_On==0)
+#define PEP_D_On  (sdt->pep_on[4])
+#define PEP_D_Off (PEP_D_On==0)
+#define PEP_R_On  (sdt->pep_on[5])
+#define PEP_R_Off ((PEP_R_On&1)==0)
+#define PEP_R_Inp ((PEP_R_On&2)!=0)
+#define PEP_K_On  (sdt->pep_on[6])
+#define PEP_K_Off ((PEP_K_On&1)==0)
+#define PEP_K_Inp ((PEP_K_On&2)!=0)
+// IERS polar motion
+#define  polarX (sdt->xpol)
+#define  polarY (sdt->ypol)
+// current Julian date, sidereal time correction by "Equation of the Equinoxes"
+#define JDate   (sdt->jdate)
+#define EE_time (sdt->eetime)
+// humidity value (%%) & hand input
+#define  val_Hmd (sdt->val_hmd)
+#define  inp_Hmd (sdt->val_hmd)
+// worm position, mkm
+#define  worm_A (sdt->worm_a)
+#define  worm_Z (sdt->worm_z)
+// locking flags
+#define LockFlags  (sdt->lock_flags)
+enum{
+	 Lock_A = 1
+	,Lock_Z = 2
+	,Lock_P = 4
+	,Lock_F = 8
+	,Lock_D = 0x10
+};
+#define A_Locked   (LockFlags&Lock_A)
+#define Z_Locked   (LockFlags&Lock_Z)
+#define P_Locked   (LockFlags&Lock_P)
+#define F_Locked   (LockFlags&Lock_F)
+#define D_Locked   (LockFlags&Lock_D)
+// SEW dome divers speed
+#define Dome_Speed (sdt->sew_dome_speed)
+// SEW dome drive number (for indication)
+#define DomeSEW_N  (sdt->sew_dome_num)
+// SEW dome driver parameters
+#define  statusSEWD  (sdt->sewdomedrv.status)    // controller status
+#define  speedSEWD   (sdt->sewdomedrv.set_speed) // speed, rpm
+#define  vel_SEWD    (sdt->sewdomedrv.mes_speed) /*ÉÚÍÅÒÅÎÎÁÑ ÓËÏÒÏÓÔØ ÏÂ/ÍÉÎ (rpm)*/
+#define  currentSEWD (sdt->sewdomedrv.current)   // current, A
+#define  indexSEWD   (sdt->sewdomedrv.index)     // parameter index
+#define  valueSEWD   (sdt->sewdomedrv.value.l)   // parameter value
+// dome PEP codes
+#define PEP_code_Din  (sdt->pep_code_di) // data in
+#define PEP_Dome_SEW_Ok   0x200
+#define PEP_Dome_Cable_Ok 0x100
+#define PEP_code_Dout (sdt->pep_code_do) // data out
+#define PEP_Dome_SEW_On   0x10
+#define PEP_Dome_SEW_Off  0x20
+
+
+/*******************************************************************************
+*                         BTA data structure                                   *
+*******************************************************************************/
+
+#define BTA_Data_Ver 2
+struct BTA_Data {
+	int32_t magic;                 // magic value
+	int32_t version;               // BTA_Data_Ver
+	int32_t size;                  // sizeof(struct BTA_Data)
+	int32_t pid;                   // main process PID
+	int32_t model;                 // model modes
+	int32_t timer;                 // timer selected
+	int32_t system;                // main system mode
+	int32_t sys_target;            // system pointing target
+	int32_t tel_focus;             // telescope focus type
+	double pc_coeff[8];            // pointing correction system coefficients
+	int32_t tel_state;             // telescope state
+	int32_t req_state;             // new (required) state
+	int32_t tel_hard_state;        // Power state
+	int32_t tel_mode;              // telescope mode
+	int32_t az_mode;               // azimuth reverce
+	int32_t p2_state;              // P2 motor state
+	int32_t p2_req_mode;           // P2 required state
+	int32_t focus_state;           // focus motor state
+	int32_t dome_state;            // dome motors state
+	int32_t pcor_mode;             // pointing correction mode
+	int32_t trkok_mode;            // tracking mode
+	double i_alpha, i_delta;       // input values
+	double s_alpha, s_delta;       // source
+	double v_alpha, v_delta;       // intrinsic vel.
+	double i_azim, i_zdist;        // input A/Z
+	double c_alpha, c_delta;       // calculated values
+	double tag_a, tag_z, tag_p;    // current values (from sensors)
+	double pcor_a, pcor_z, refr_z; // calculated corrections
+	double tcor_a, tcor_z, tref_z; // reverse calculation corr.
+	double diff_a, diff_z, diff_p; // coords difference
+	double vbasea,vbasez,vbasep;   // base object velocity
+	double diffva,diffvz,diffvp;   // correction by real speed
+	double speeda,speedz,speedp;   // motor speed
+	double m_time_precip;          // last precipitation time
+	uint8_t reserve[16];           // reserved
+	double rspeeda, rspeedz, rspeedp; // real motor speed (''/sec)
+	double simvela, simvelz, simvelp, simvelf, simveld; // model speed
+	uint32_t kost;                 // telescope & hand correction state
+	double m_time, s_time, l_time; // different time (UTC, stellar, local)
+	uint32_t ppndd_a, ppndd_z, ppndd_p, ppndd_b; // PPNDD sensor (rough) code
+	uint32_t dup_a, dup_z, dup_p, dup_f, dup_d;  // DUP sensor (precise) code (Gray code)
+	uint32_t low_a, low_z, low_p, low_f, low_d;  // binary 14-digit precise code
+	uint32_t code_a, code_z, code_p, code_b, code_f, code_d; // binary 23-digit rough code
+	uint32_t adc[8];               // ADC PCL818 (8-channel) codes
+	double val_a, val_z, val_p, val_b, val_f, val_d;
+	double val_t1, val_t2, val_t3, val_wnd; // calculated values
+	double val_alp, val_del;       // RA/Decl calculated by A/Z
+	double vel_a, vel_z, vel_p, vel_f, vel_d; // measured speed
+	// system messages queue
+	struct SysMesg {
+		int32_t seq_num;
+		char type;                  // message type
+		char text[MesgLen];         // message itself
+	} sys_msg_buf[MesgNum];
+	// access levels
+	uint32_t code_lev[5];
+	// network settings
+	uint32_t netmask, netaddr, acsmask, acsaddr;
+	int32_t meteo_stat;            // meteo data
+	double inp_b, inp_t1, inp_t2, inp_t3, inp_wnd; // input meteo values
+	double temper, press;          // values used for refraction calculation
+	double m_time10, m_time15;     // last wind gust time
+	double dut1; // IERS DUT1  (src: ftp://maia.usno.navy.mil/ser7/ser7.dat), DUT1 = UT1-UTC
+	double a_time, z_time, p_time; // sensors reading time
+	double speedain, speedzin, speedpin; // input speeds
+	double acc_a, acc_z, acc_p, acc_f, acc_d; // acceleration (''/sec^2)
+	uint32_t code_sew;             // SEW code
+	struct SEWdata {               // sew data
+		int32_t status;
+		double set_speed;          // target speed, rpm
+		double mes_speed;          // measured speed, rpm
+		double current;            // measured current, A
+		int32_t index;             // parameter number
+		union{                     // parameter code
+			uint8_t b[4];
+			uint32_t l;
+		} value;
+	} sewdrv[3];
+	uint32_t pep_code_a, pep_code_z, pep_code_p; // 23-digit PEP-controllers code
+	uint32_t pep_sw_a, pep_sw_z, pep_sw_p; // PEP end-switches code
+	uint32_t pep_code_f, pep_code_d, pep_code_ri, pep_code_ro; // PEP codes
+	uint8_t pep_on[10];                // PEP flags
+	double xpol, ypol;                 // IERS polar motion (src: ftp://maia.usno.navy.mil/ser7/ser7.dat)
+	double  jdate, eetime;             // current Julian date, sidereal time correction by "Equation of the Equinoxes"
+	double val_hmd, inp_hmd;           // humidity value (%%) & hand input
+	double worm_a, worm_z;             // worm position, mkm
+	/* ÆÌÁÇÉ ÂÌÏËÉÒÏ×ËÉ ÕÐÒÁ×ÌÅÎÉÑ ÕÚÌÁÍÉ */
+	uint32_t lock_flags;               // locking flags
+	int32_t sew_dome_speed;            // SEW dome divers speed: D_Lplus, D_Hminus etc
+	int32_t sew_dome_num;              // SEW dome drive number (for indication)
+	struct SEWdata  sewdomedrv;        // SEW dome driver parameters
+	uint32_t pep_code_di, pep_code_do; // dome PEP codes
+};
+
+extern struct BTA_Data *sdt;
+
+/*******************************************************************************
+*                       Local data structure                                   *
+*******************************************************************************/
+// Oil pressure, MPa
+#define PressOilA    (sdtl->pr_oil_a)
+#define PressOilZ    (sdtl->pr_oil_z)
+#define PressOilTank (sdtl->pr_oil_t)
+// Oil themperature, degrC
+#define OilTemper1   (sdtl->t_oil_1)  // oil
+#define OilTemper2   (sdtl->t_oil_2)  // water
+
+// Local data structure
+struct BTA_Local {
+	uint8_t reserve[120];        // reserved data
+	double pr_oil_a,pr_oil_z,pr_oil_t; // Oil pressure
+	double t_oil_1,t_oil_2;            // Oil themperature
+};
+
+/**
+ * Message buffer structure
+ */
+struct my_msgbuf {
+	int32_t mtype;    // message type
+	uint32_t acckey;  // client access key
+	uint32_t src_pid; // source PID
+	uint32_t src_ip;  // IP of command source or 0 for local
+	char mtext[100];  // message itself
+};
+
+extern struct BTA_Local *sdtl;
+extern int snd_id;
+extern int cmd_src_pid;
+extern uint32_t cmd_src_ip;
+
+#define ClientSide 0
+#define ServerSide 1
+
+#ifndef BTA_MODULE
+void bta_data_init();
+int  bta_data_check();
+void bta_data_close();
+int get_shm_block( struct SHM_Block *sb, int server);
+int close_shm_block(struct SHM_Block *sb);
+void get_cmd_queue( struct CMD_Queue *cq, int server);
+#endif
+
+int check_shm_block( struct SHM_Block *sb);
+
+void encode_lev_passwd(char *passwd, int nlev, uint32_t *keylev, uint32_t *codlev);
+int find_lev_passwd(char *passwd, uint32_t *keylev, uint32_t *codlev);
+int check_lev_passwd(char *passwd);
+void set_acckey(uint32_t newkey);
+
+// restore packing
+#pragma pack(pop)
+//#pragma GCC diagnostic pop
+
+#endif // __BTA_SHDATA_H__

ch4run.c

@@ -0,0 +1,140 @@
+/*
+ * ch4run.c - functions for checking whether this process already run
+ *
+ * Copyright 2013 Edward V. Emelianoff <eddy@sao.ru>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+
+#include "ch4run.h"
+#include <stdio.h>		// printf, fopen, ...
+#include <unistd.h>		// getpid
+#include <stdio.h>		// perror
+#include <sys/types.h>	// opendir
+#include <dirent.h>		// opendir
+#include <sys/stat.h>	// stat
+#include <fcntl.h>		// fcntl
+#include <stdlib.h>		// exit
+#include <string.h>		// memset
+
+/**
+ * read process name from /proc/PID/cmdline
+ * @param pid - PID of interesting process
+ * @return filename or NULL if not found
+ * 		don't use this function twice for different names without copying
+ * 		its returning by strdup, because `name` contains in static array
+ */
+char *readname(pid_t pid){
+	static char name[256];
+	char *pp = name, byte, path[256];
+	FILE *file;
+	int cntr = 0;
+	size_t sz;
+	snprintf (path, 255, PROC_BASE "/%d/cmdline", pid);
+	file = fopen(path, "r");
+	if(!file) return NULL; // there's no such file
+	do{	// read basename
+		sz = fread(&byte, 1, 1, file);
+		if(sz != 1) break;
+		if(byte != '/') *pp++ = byte;
+		else{
+			pp = name;
+			cntr = 0;
+		}
+	}while(byte && cntr++ < 255);
+	name[cntr] = 0;
+	fclose(file);
+	return name;
+}
+
+void iffound_default(pid_t pid){
+	fprintf(stderr, "\nFound running process (pid=%d), exit.\n", pid);
+	exit(0);
+}
+
+/**
+ * check wether there is a same running process
+ * exit if there is a running process or error
+ * Checking have 3 steps:
+ * 		1) lock executable file
+ * 		2) check pidfile (if you run a copy?)
+ * 		3) check /proc for executables with the same name (no/wrong pidfile)
+ * @param argv - argument of main() or NULL for non-locking, call this function before getopt()
+ * @param pidfilename - name of pidfile or NULL if none
+ * @param iffound - action to run if file found or NULL for exit(0)
+ */
+void check4running(char **argv, char *pidfilename, void (*iffound)(pid_t pid)){
+	DIR *dir;
+	FILE *pidfile, *fself;
+	struct dirent *de;
+	struct stat s_buf;
+	pid_t pid = 0, self;
+	struct flock fl;
+	char *name, *myname;
+	if(!iffound) iffound = iffound_default;
+	if(argv){ // block self
+		fself = fopen(argv[0], "r"); // open self binary to lock
+		memset(&fl, 0, sizeof(struct flock));
+		fl.l_type = F_WRLCK;
+		if(fcntl(fileno(fself), F_GETLK, &fl) == -1){ // check locking
+			perror("fcntl");
+			exit(1);
+		}
+		if(fl.l_type != F_UNLCK){ // file is locking - exit
+			printf("Found locker, PID = %d!\n", fl.l_pid);
+			exit(1);
+		}
+		fl.l_type = F_RDLCK;
+		if(fcntl(fileno(fself), F_SETLKW, &fl) == -1){
+			perror("fcntl");
+			exit(1);
+		}
+	}
+	self = getpid(); // get self PID
+	if(!(dir = opendir(PROC_BASE))){ // open /proc directory
+		perror(PROC_BASE);
+		exit(1);
+	}
+	if(!(name = readname(self))){ // error reading self name
+		perror("Can't read self name");
+		exit(1);
+	}
+	myname = strdup(name);
+	if(pidfilename && stat(pidfilename, &s_buf) == 0){ // pidfile exists
+		pidfile = fopen(pidfilename, "r");
+		if(pidfile){
+			if(fscanf(pidfile, "%d", &pid) > 0){ // read PID of (possibly) running process
+				if((name = readname(pid)) && strncmp(name, myname, 255) == 0)
+					iffound(pid);
+			}
+			fclose(pidfile);
+		}
+	}
+	// There is no pidfile or it consists a wrong record
+	while((de = readdir(dir))){ // scan /proc
+		if(!(pid = (pid_t)atoi(de->d_name)) || pid == self) // pass non-PID files and self
+			continue;
+		if((name = readname(pid)) && strncmp(name, myname, 255) == 0)
+			iffound(pid);
+	}
+	closedir(dir);
+	if(pidfilename){
+		pidfile = fopen(pidfilename, "w");
+		fprintf(pidfile, "%d\n", self); // write self PID to pidfile
+		fclose(pidfile);
+	}
+	free(myname);
+}

ch4run.h

@@ -0,0 +1,28 @@
+/*
+ * daemon.h
+ *
+ * Copyright 2015 Edward V. Emelianov <eddy@sao.ru, edward.emelianoff@gmail.com>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#ifndef PROC_BASE
+#define PROC_BASE "/proc"
+#endif
+
+#include <unistd.h>  // pid_t
+
+void iffound_default(pid_t pid);
+void check4running(char **argv, char *pidfilename, void (*iffound)(pid_t pid));

cmdlnopts.c

@@ -0,0 +1,109 @@
+/*
+ * cmdlnopts.c - the only function that parce cmdln args and returns glob parameters
+ *
+ * Copyright 2013 Edward V. Emelianoff <eddy@sao.ru>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#include "cmdlnopts.h"
+#include "usefull_macros.h"
+#include <assert.h>
+
+/*
+ * here are global parameters initialisation
+ */
+glob_pars G;  // internal global parameters structure
+int help = 0; // whether to show help string
+
+glob_pars Gdefault = {
+	 .passfile       = NULL
+	,.force          = 0
+	,.p2move         = NULL
+	,.p2mode         = NULL
+	,.focmove        = -1.
+	,.eqcrds         = NULL
+	,.horcrds        = NULL
+	,.azrev          = 0
+	,.telstop        = 0
+	,.gotoRaDec      = 0
+	,.gotoAZ         = 0
+	,.epoch          = NULL
+	,.pmra           = 0.
+	,.pmdecl         = 0.
+	,.PCSoff         = 0
+	,.corrAZ         = 0
+	,.corrRAD        = 0
+	,.quiet          = 0
+	,.getinfo        = NULL
+	,.infoargs       = NULL
+	,.listinfo       = 0
+};
+
+/*
+ * Define command line options by filling structure:
+ *	name	has_arg	flag	val		type		argptr			help
+*/
+myoption cmdlnopts[] = {
+	{"help",	0,	NULL,	'h',	arg_int,	APTR(&help),		N_("show this help")},
+	{"passfile",1,	NULL,	'p',	arg_string,	APTR(&G.passfile),	N_("file with password hash (in/out)")},
+	{"force",	0,	NULL,	'f',	arg_int,	APTR(&G.force),		N_("force command executions")},
+	{"p2move",	1,	NULL,	'P',	arg_string,	APTR(&G.p2move),	N_("move P2 (arg: angle[rel])")},
+	{"p2mode",  1,	NULL,	'M',	arg_string,	APTR(&G.p2mode),	N_("set P2 mode (arg: stop/track)")},
+	{"focmove",	1,	NULL,	'F',	arg_double,	APTR(&G.focmove),	N_("move focus to given value")},
+	{"eq-crds",	1,	NULL,	'e',	arg_string,	APTR(&G.eqcrds),	N_("set new equatorial coordinates")},
+	{"hor-crds",1,	NULL,	'a',	arg_string,	APTR(&G.horcrds),	N_("set new horizontal coordinates")},
+	{"az-reverce",0,NULL,	'R',	arg_int,	APTR(&G.azrev),		N_("switch Az reverce")},
+	{"stop-tel",0,	NULL,	'S',	arg_int,	APTR(&G.telstop),	N_("stop telescope")},
+	{"gotoradec",0,	NULL,	'G',	arg_int,	APTR(&G.gotoRaDec),	N_("go to last entered RA/Decl")},
+	{"gotoaz",	0,	NULL,	'A',	arg_int,	APTR(&G.gotoAZ),	N_("go to last entered A/Z")},
+	{"epoch",   2,	NULL,	'E',	arg_string,	APTR(&G.epoch),		N_("epoch for given RA/Decl (without argument is \"now\")")},
+	{"pm-ra",	1,	NULL,	'x',	arg_double,	APTR(&G.pmra),		N_("proper motion by R.A.  (mas/year)")},
+	{"pm-decl",	1,	NULL,	'y',	arg_double,	APTR(&G.pmdecl),	N_("proper motion by Decl. (mas/year)")},
+	{"pcs-off",	0,	NULL,	'O',	arg_int,	APTR(&G.PCSoff),	N_("turn OFF pointing correction system")},
+	{"az-corr",	1,	NULL,	1,		arg_string,	APTR(&G.corrAZ),	N_("run correction by A/Z (arg in arcsec: dA,dZ)")},
+	{"rad-corr",1,	NULL,	1,		arg_string,	APTR(&G.corrRAD),	N_("run correction by RA/Decl (arg in arcsec: dRA,dDecl)")},
+	{"quiet",	0,	NULL,	'q',	arg_int,	APTR(&G.quiet),		N_("almost no messages into stdout")},
+	{"get-info",2,	NULL,	'I',	arg_string,	APTR(&G.getinfo),	N_("show information (default: all, \"help\" for list)")},
+	{"info-args",1,	NULL,	'i',	arg_string,	APTR(&G.infoargs),	N_("show values of given ACS parameters")},
+	{"list-info",0,	NULL,	'l',	arg_string,	APTR(&G.listinfo),	N_("list all ACS parameters available")},
+	// ...
+	end_option
+};
+
+/**
+ * Parce command line options and return dynamically allocated structure
+ * 		to global parameters
+ * @param argc - copy of argc from main
+ * @param argv - copy of argv from main
+ * @return allocated structure with global parameters
+ */
+glob_pars *parce_args(int argc, char **argv){
+	int i;
+	void *ptr;
+	ptr = memcpy(&G, &Gdefault, sizeof(G)); assert(ptr);
+	// format of help: "Usage: progname [args]\n"
+	change_helpstring("Usage: %s [args]\n\n\tWhere args are:\n");
+	// parse arguments
+	parceargs(&argc, &argv, cmdlnopts);
+	if(help) showhelp(-1, cmdlnopts);
+	if(argc > 0){
+		printf("\nIgnore argument[s]:\n");
+		for (i = 0; i < argc; i++)
+			printf("\t%s\n", argv[i]);
+	}
+	return &G;
+}
+

cmdlnopts.h

@@ -0,0 +1,59 @@
+/*
+ * cmdlnopts.h - comand line options for parceargs
+ *
+ * Copyright 2013 Edward V. Emelianoff <eddy@sao.ru>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+
+#pragma once
+#ifndef __CMDLNOPTS_H__
+#define __CMDLNOPTS_H__
+
+#include "parceargs.h"
+
+/*
+ * here are some typedef's for global data
+ */
+
+typedef struct{
+	char *passfile; // filename with password
+	int force;      // force command running (stop p2 if moving etc)
+	char *p2move;   // rotate p2 arguments: angle[rel]
+	char *p2mode;   // set P2 mode (stop/track)
+	double focmove; // move focus to given value
+	char *eqcrds;   // set new equatorial coordinates
+	char *horcrds;  // set new horizontal coordinates
+	int azrev;      // reverse A/Z
+	int telstop;    // stop telescope
+	int gotoRaDec;  // goto last entered RA/Decl
+	int gotoAZ;     // goto last entered A/Z
+	char *epoch;    // epoch for given coordinates (vararg: year or "now" if present, "now" if absent)
+	double pmra;    // proper motion by R.A. (mas/year)
+	double pmdecl;  // proper motion by Decl (mas/year)
+	int PCSoff;     // turn OFF PCS for current moving
+	char *corrAZ;   // run correction by A/Z
+	char *corrRAD;  // run correction by RA/Decl
+	int quiet;      // ==1 - no messages to stdout
+	char *getinfo;  // level of requested information (meteo, coords, etc)
+	char *infoargs; // list of requested information (certain parameters)
+	int listinfo;   // show list of information parameters available
+}glob_pars;
+
+glob_pars *parce_args(int argc, char **argv);
+extern glob_pars *GP;
+
+#endif // __CMDLNOPTS_H__

parceargs.c

@@ -0,0 +1,297 @@
+/*
+ * parceargs.c - parcing command line arguments & print help
+ *
+ * Copyright 2013 Edward V. Emelianoff <eddy@sao.ru>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+
+#include <stdio.h>	// DBG
+#include <getopt.h>	// getopt_long
+#include <stdlib.h>	// calloc, exit, strtoll
+#include <assert.h>	// assert
+#include <string.h> // strdup, strchr, strlen
+#include <limits.h> // INT_MAX & so on
+#include <libintl.h>// gettext
+#include <ctype.h>	// isalpha
+#include <stdlib.h> // strtoll
+#include "parceargs.h"
+
+// macro to print help messages
+#ifndef PRNT
+	#define PRNT(x) gettext(x)
+#endif
+
+char *helpstring = "%s\n";
+
+/**
+ * Change standard help header
+ * MAY consist ONE "%s" for progname
+ * @param str (i) - new format
+ */
+void change_helpstring(char *s){
+	int pcount = 0, scount = 0;
+	char *str = s;
+	// check `helpstring` and set it to default in case of error
+	for(; pcount < 2; str += 2){
+		if(!(str = strchr(str, '%'))) break;
+		if(str[1] != '%') pcount++; // increment '%' counter if it isn't "%%"
+		else{
+			str += 2; // pass next '%'
+			continue;
+		}
+		if(str[1] == 's') scount++; // increment "%s" counter
+	};
+	if(pcount > 1 || pcount != scount){ // amount of pcount and/or scount wrong
+		fprintf(stderr, "Wrong helpstring!\n");
+		exit(-1);
+	}
+	helpstring = s;
+}
+
+/**
+ * Carefull atoll/atoi
+ * @param num (o) - returning value (or NULL if you wish only check number) - allocated by user
+ * @param str (i) - string with number must not be NULL
+ * @param t   (i) - T_INT for integer or T_LLONG for long long (if argtype would be wided, may add more)
+ * @return TRUE if conversion sone without errors, FALSE otherwise
+ */
+static bool myatoll(void *num, char *str, argtype t){
+	long long tmp, *llptr;
+	int *iptr;
+	char *endptr;
+	assert(str);
+	assert(num);
+	tmp = strtoll(str, &endptr, 0);
+	if(endptr == str || *str == '\0' || *endptr != '\0')
+		return FALSE;
+	switch(t){
+		case arg_longlong:
+			llptr = (long long*) num;
+			*llptr = tmp;
+		break;
+		case arg_int:
+		default:
+			if(tmp < INT_MIN || tmp > INT_MAX){
+				fprintf(stderr, "Integer out of range\n");
+				return FALSE;
+			}
+			iptr = (int*)num;
+			*iptr = (int)tmp;
+	}
+	return TRUE;
+}
+
+// the same as myatoll but for double
+// There's no NAN & INF checking here (what if they would be needed?)
+static bool myatod(void *num, const char *str, argtype t){
+	double tmp, *dptr;
+	float *fptr;
+	char *endptr;
+	assert(str);
+	tmp = strtod(str, &endptr);
+	if(endptr == str || *str == '\0' || *endptr != '\0')
+		return FALSE;
+	switch(t){
+		case arg_double:
+			dptr = (double *) num;
+			*dptr = tmp;
+		break;
+		case arg_float:
+		default:
+			fptr = (float *) num;
+			*fptr = (float)tmp;
+		break;
+	}
+	return TRUE;
+}
+
+/**
+ * Get index of current option in array options
+ * @param opt (i) - returning val of getopt_long
+ * @param options (i) - array of options
+ * @return index in array
+ */
+int get_optind(int opt, myoption *options){
+	int oind;
+	myoption *opts = options;
+	assert(opts);
+	for(oind = 0; opts->name && opts->val != opt; oind++, opts++);
+	if(!opts->name || opts->val != opt) // no such parameter
+	showhelp(-1, options);
+	return oind;
+}
+
+/**
+ * Parce command line arguments
+ * ! If arg is string, then value will be strdup'ed!
+ *
+ * @param argc (io) - address of argc of main(), return value of argc stay after `getopt`
+ * @param argv (io) - address of argv of main(), return pointer to argv stay after `getopt`
+ * BE CAREFUL! if you wanna use full argc & argv, save their original values before
+ * 		calling this function
+ * @param options (i) - array of `myoption` for arguments parcing
+ *
+ * @exit: in case of error this function show help & make `exit(-1)`
+  */
+void parceargs(int *argc, char ***argv, myoption *options){
+	char *short_options, *soptr;
+	struct option *long_options, *loptr;
+	size_t optsize, i;
+	myoption *opts = options;
+	// check whether there is at least one options
+	assert(opts);
+	assert(opts[0].name);
+	// first we count how much values are in opts
+	for(optsize = 0; opts->name; optsize++, opts++);
+	// now we can allocate memory
+	short_options = calloc(optsize * 3 + 1, 1); // multiply by three for '::' in case of args in opts
+	long_options = calloc(optsize + 1, sizeof(struct option));
+	opts = options; loptr = long_options; soptr = short_options;
+	// fill short/long parameters and make a simple checking
+	for(i = 0; i < optsize; i++, loptr++, opts++){
+		// check
+		assert(opts->name); // check name
+		if(opts->has_arg){
+			assert(opts->type != arg_none); // check error with arg type
+			assert(opts->argptr);  // check pointer
+		}
+		if(opts->type != arg_none) // if there is a flag without arg, check its pointer
+			assert(opts->argptr);
+		// fill long_options
+		// don't do memcmp: what if there would be different alignment?
+		loptr->name		= opts->name;
+		loptr->has_arg	= opts->has_arg;
+		loptr->flag		= opts->flag;
+		loptr->val		= opts->val;
+		// fill short options if they are:
+		if(!opts->flag){
+			*soptr++ = opts->val;
+			if(opts->has_arg) // add ':' if option has required argument
+				*soptr++ = ':';
+			if(opts->has_arg == 2) // add '::' if option has optional argument
+				*soptr++ = ':';
+		}
+	}
+	// now we have both long_options & short_options and can parse `getopt_long`
+	while(1){
+		int opt;
+		int oindex = 0, optind = 0; // oindex - number of option in argv, optind - number in options[]
+		if((opt = getopt_long(*argc, *argv, short_options, long_options, &oindex)) == -1) break;
+		if(opt == '?'){
+			opt = optopt;
+			optind = get_optind(opt, options);
+			if(options[optind].has_arg == 1) showhelp(optind, options); // need argument
+		}
+		else{
+			if(opt == 0 || oindex > 0) optind = oindex;
+			else optind = get_optind(opt, options);
+		}
+		opts = &options[optind];
+		if(opt == 0 && opts->has_arg == 0) continue; // only long option changing integer flag
+		// now check option
+		if(opts->has_arg == 1) assert(optarg);
+		bool result = TRUE;
+		// even if there is no argument, but argptr != NULL, think that optarg = "1"
+		if(!optarg) optarg = "1";
+		switch(opts->type){
+			default:
+			case arg_none:
+				if(opts->argptr) *((int*)opts->argptr) = 1; // set argptr to 1
+			break;
+			case arg_int:
+				result = myatoll(opts->argptr, optarg, arg_int);
+			break;
+			case arg_longlong:
+				result = myatoll(opts->argptr, optarg, arg_longlong);
+			break;
+			case arg_double:
+				result = myatod(opts->argptr, optarg, arg_double);
+			break;
+			case arg_float:
+				result = myatod(opts->argptr, optarg, arg_float);
+			break;
+			case arg_string:
+				result = (*((char **)opts->argptr) = strdup(optarg));
+			break;
+			case arg_function:
+				result = ((argfn)opts->argptr)(optarg, optind);
+			break;
+		}
+		if(!result){
+			showhelp(optind, options);
+		}
+	}
+	*argc -= optind;
+	*argv += optind;
+}
+
+/**
+ * Show help information based on myoption->help values
+ * @param oindex (i)  - if non-negative, show only help by myoption[oindex].help
+ * @param options (i) - array of `myoption`
+ *
+ * @exit:  run `exit(-1)` !!!
+ */
+void showhelp(int oindex, myoption *options){
+	// ATTENTION: string `help` prints through macro PRNT(), by default it is gettext,
+	// but you can redefine it before `#include "parceargs.h"`
+	int max_opt_len = 0; // max len of options substring - for right indentation
+	const int bufsz = 255;
+	char buf[bufsz+1];
+	myoption *opts = options;
+	assert(opts);
+	assert(opts[0].name); // check whether there is at least one options
+	if(oindex > -1){ // print only one message
+		opts = &options[oindex];
+		printf("  ");
+		if(!opts->flag && isalpha(opts->val)) printf("-%c, ", opts->val);
+		printf("--%s", opts->name);
+		if(opts->has_arg == 1) printf("=arg");
+		else if(opts->has_arg == 2) printf("[=arg]");
+		printf("  %s\n", PRNT(opts->help));
+		exit(-1);
+	}
+	// header, by default is just "progname\n"
+	printf("\n");
+	if(strstr(helpstring, "%s")) // print progname
+		printf(helpstring, __progname);
+	else // only text
+		printf("%s", helpstring);
+	printf("\n");
+	// count max_opt_len
+	do{
+		int L = strlen(opts->name);
+		if(max_opt_len < L) max_opt_len = L;
+	}while((++opts)->name);
+	max_opt_len += 15; // format: '-S , --long[=arg]' - get addition 14 symbols
+	opts = options;
+	// Now print all help
+	do{
+		int p = sprintf(buf, "  "); // a little indent
+		if(!opts->flag && isalpha(opts->val)) // .val is short argument
+			p += snprintf(buf+p, bufsz-p, "-%c, ", opts->val);
+		p += snprintf(buf+p, bufsz-p, "--%s", opts->name);
+		if(opts->has_arg == 1) // required argument
+			p += snprintf(buf+p, bufsz-p, "=arg");
+		else if(opts->has_arg == 2) // optional argument
+			p += snprintf(buf+p, bufsz-p, "[=arg]");
+		assert(p <= max_opt_len); // there would be magic if p > max_opt_len
+		printf("%-*s%s\n", max_opt_len+1, buf, PRNT(opts->help)); // write options & at least 2 spaces after
+	}while((++opts)->name);
+	printf("\n\n");
+	exit(-1);
+}

parceargs.h

@@ -0,0 +1,105 @@
+/*
+ * parceargs.h - headers for parcing command line arguments
+ *
+ * Copyright 2013 Edward V. Emelianoff <eddy@sao.ru>
+ *
+ * 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; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02110-1301, USA.
+ */
+#pragma once
+#ifndef __PARCEARGS_H__
+#define __PARCEARGS_H__
+
+#include <stdbool.h>// bool
+#include <stdlib.h>
+
+#ifndef TRUE
+	#define TRUE true
+#endif
+
+#ifndef FALSE
+	#define FALSE false
+#endif
+
+// macro for argptr
+#define APTR(x)   ((void*)x)
+
+// if argptr is a function:
+typedef  bool(*argfn)(void *arg, int N);
+
+/*
+ * type of getopt's argument
+ * WARNING!
+ * My function change value of flags by pointer, so if you want to use another type
+ * make a latter conversion, example:
+ * 		char charg;
+ * 		int iarg;
+ * 		myoption opts[] = {
+ * 		{"value", 1, NULL, 'v', arg_int, &iarg, "char val"}, ..., end_option};
+ * 		..(parce args)..
+ * 		charg = (char) iarg;
+ */
+typedef enum {
+	arg_none = 0,	// no arg
+	arg_int,		// integer
+	arg_longlong,	// long long
+	arg_double,		// double
+	arg_float,		// float
+	arg_string,		// char *
+	arg_function	// parce_args will run function `bool (*fn)(char *optarg, int N)`
+} argtype;
+
+/*
+ * Structure for getopt_long & help
+ * BE CAREFUL: .argptr is pointer to data or pointer to function,
+ * 		conversion depends on .type
+ *
+ * ATTENTION: string `help` prints through macro PRNT(), bu default it is gettext,
+ * but you can redefine it before `#include "parceargs.h"`
+ *
+ * if arg is string, then value wil be strdup'ed like that:
+ * 		char *str;
+ * 		myoption opts[] = {{"string", 1, NULL, 's', arg_string, &str, "string val"}, ..., end_option};
+ *		*(opts[1].str) = strdup(optarg);
+ * in other cases argptr should be address of some variable (or pointer to allocated memory)
+ *
+ * NON-NULL argptr should be written inside macro APTR(argptr) or directly: (void*)argptr
+ *
+ * !!!LAST VALUE OF ARRAY SHOULD BE `end_option` or ZEROS !!!
+ *
+ */
+typedef struct{
+	// these are from struct option:
+	const char *name;		// long option's name
+	int         has_arg;	// 0 - no args, 1 - nesessary arg, 2 - optionally arg
+	int        *flag;		// NULL to return val, pointer to int - to set its value of val (function returns 0)
+	int         val;		// short opt name (if flag == NULL) or flag's value
+	// and these are mine:
+	argtype     type;		// type of argument
+	void       *argptr;		// pointer to variable to assign optarg value or function `bool (*fn)(char *optarg, int N)`
+	char       *help;		// help string which would be shown in function `showhelp` or NULL
+} myoption;
+
+// last string of array (all zeros)
+#define end_option {0,0,0,0,0,0,0}
+
+
+extern const char *__progname;
+
+void showhelp(int oindex, myoption *options);
+void parceargs(int *argc, char ***argv, myoption *options);
+void change_helpstring(char *s);
+
+#endif // __PARCEARGS_H__

slalib/Makefile

@@ -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
+
+install:
+	cp slalib.h slamac.h /usr/include
+	cp libsla.so /usr/lib
+
+clean:
+	rm -f *.o *~ *#
+	rm -rf build
+

slalib/README

@@ -0,0 +1,6 @@
+clone of https://github.com/scottransom/pyslalib.git with deleted unnesessary files
+
+just do make && su -c "make install"
+
+don't use header file slalib.h still it's wrong
+

slalib/addet.f

@@ -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

slalib/afin.f

@@ -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

slalib/airmas.f

@@ -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

slalib/altaz.f

@@ -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

slalib/amp.f

@@ -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

slalib/ampqk.f

@@ -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

slalib/aop.f

@@ -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

slalib/aoppa.f

@@ -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

slalib/aoppat.f

@@ -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

slalib/aopqk.f

@@ -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

slalib/atmdsp.f

@@ -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

slalib/atms.f

@@ -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

slalib/atmt.f

@@ -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

slalib/av2m.f

@@ -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

slalib/bear.f

@@ -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

slalib/caf2r.f

@@ -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

slalib/caldj.f

@@ -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

slalib/calyd.f

@@ -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

slalib/cc2s.f

@@ -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

slalib/cc62s.f

@@ -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

slalib/cd2tf.f

@@ -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

slalib/cldj.f

@@ -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

slalib/clyd.f

@@ -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

slalib/combn.f

@@ -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

slalib/cr2af.f

@@ -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

slalib/cr2tf.f

@@ -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

slalib/cs2c.f

@@ -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

slalib/cs2c6.f

@@ -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

slalib/ctf2d.f

@@ -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

slalib/ctf2r.f

@@ -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

slalib/daf2r.f

@@ -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

slalib/dafin.f

@@ -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

slalib/dat.f

@@ -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

slalib/dav2m.f

@@ -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

slalib/dbear.f

@@ -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

slalib/dbjin.f

@@ -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

slalib/dc62s.f

@@ -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

slalib/dcc2s.f

@@ -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

slalib/dcmpf.f

@@ -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

slalib/dcs2c.f

@@ -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

slalib/dd2tf.f

@@ -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

slalib/de2h.f

@@ -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

slalib/deuler.f

@@ -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

slalib/dfltin.f

@@ -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

slalib/dh2e.f

@@ -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

slalib/dimxv.f

@@ -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

slalib/djcal.f

@@ -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

slalib/djcl.f

@@ -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

slalib/dm2av.f

@@ -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

slalib/dmat.f

@@ -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

slalib/dmoon.f

@@ -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

slalib/dmxm.f

@@ -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

slalib/dmxv.f

@@ -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

slalib/dpav.f

@@ -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

slalib/dr2af.f

@@ -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

slalib/dr2tf.f

@@ -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

slalib/drange.f

@@ -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

slalib/dranrm.f

@@ -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

slalib/ds2c6.f

@@ -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

slalib/ds2tp.f

@@ -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

slalib/dsep.f

@@ -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

slalib/dsepv.f

@@ -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

slalib/dt.f

@@ -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

slalib/dtf2d.f

@@ -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

slalib/dtf2r.f

@@ -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

slalib/dtp2s.f

@@ -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

slalib/dtp2v.f

@@ -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

slalib/dtps2c.f

@@ -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

slalib/dtpv2c.f

@@ -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

slalib/dtt.f

@@ -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

slalib/dv2tp.f

@@ -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

slalib/dvdv.f

@@ -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

slalib/dvn.f

@@ -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

slalib/dvxv.f

@@ -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

slalib/e2h.f

@@ -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

slalib/earth.f

@@ -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

slalib/ecleq.f

@@ -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

slalib/ecmat.f

@@ -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

slalib/ecor.f

@@ -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

slalib/eg50.f

@@ -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

slalib/el2ue.f

@@ -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