├── .gitignore ├── MANIFEST.in ├── Makefile ├── README.txt ├── addet.f ├── afin.f ├── airmas.f ├── altaz.f ├── amp.f ├── ampqk.f ├── aop.f ├── aoppa.f ├── aoppat.f ├── aopqk.f ├── atmdsp.f ├── atms.f ├── atmt.f ├── av2m.f ├── bear.f ├── caf2r.f ├── caldj.f ├── calyd.f ├── cc2s.f ├── cc62s.f ├── cd2tf.f ├── cldj.f ├── clyd.f ├── combn.f ├── cr2af.f ├── cr2tf.f ├── cs2c.f ├── cs2c6.f ├── ctf2d.f ├── ctf2r.f ├── daf2r.f ├── dafin.f ├── dat.f ├── dav2m.f ├── dbear.f ├── dbjin.f ├── dc62s.f ├── dcc2s.f ├── dcmpf.f ├── dcs2c.f ├── dd2tf.f ├── de2h.f ├── deuler.f ├── dfltin.f ├── dh2e.f ├── dimxv.f ├── djcal.f ├── djcl.f ├── dm2av.f ├── dmat.f ├── dmoon.f ├── dmxm.f ├── dmxv.f ├── dpav.f ├── dr2af.f ├── dr2tf.f ├── drange.f ├── dranrm.f ├── ds2c6.f ├── ds2tp.f ├── dsep.f ├── dsepv.f ├── dt.f ├── dtf2d.f ├── dtf2r.f ├── dtp2s.f ├── dtp2v.f ├── dtps2c.f ├── dtpv2c.f ├── dtt.f ├── dv2tp.f ├── dvdv.f ├── dvn.f ├── dvxv.f ├── e2h.f ├── earth.f ├── ecleq.f ├── ecmat.f ├── ecor.f ├── eg50.f ├── el2ue.f ├── epb.f ├── epb2d.f ├── epco.f ├── epj.f ├── epj2d.f ├── epv.f ├── eqecl.f ├── eqeqx.f ├── eqgal.f ├── etrms.f ├── euler.f ├── evp.f ├── fitxy.f ├── fk425.f ├── fk45z.f ├── fk524.f ├── fk52h.f ├── fk54z.f ├── fk5hz.f ├── flotin.f ├── galeq.f ├── galsup.f ├── ge50.f ├── geoc.f ├── get_docstring.py ├── gmst.f ├── gmsta.f ├── gresid.F ├── h2e.f ├── h2fk5.f ├── hfk5z.f ├── idchf.f ├── idchi.f ├── imxv.f ├── intin.f ├── invf.f ├── kbj.f ├── lib └── __init__.py ├── m2av.f ├── map.f ├── mappa.f ├── mapqk.f ├── mapqkz.f ├── moon.f ├── mxm.f ├── mxv.f ├── nut.f ├── nutc.f ├── nutc80.f ├── oap.f ├── oapqk.f ├── obs.f ├── pa.f ├── pav.f ├── pcd.f ├── pda2h.f ├── pdq2h.f ├── permut.f ├── pertel.f ├── pertue.f ├── planel.f ├── planet.f ├── plante.f ├── plantu.f ├── pm.f ├── polmo.f ├── prebn.f ├── prec.f ├── preces.f ├── precl.f ├── prenut.f ├── pv2el.f ├── pv2ue.f ├── pvobs.f ├── pxy.f ├── random.F ├── range.f ├── ranorm.f ├── rcc.f ├── rdplan.f ├── refco.f ├── refcoq.f ├── refro.f ├── refv.f ├── refz.f ├── rverot.f ├── rvgalc.f ├── rvlg.f ├── rvlsrd.f ├── rvlsrk.f ├── s2tp.f ├── sep.f ├── sepv.f ├── setup.py ├── sla.c ├── sla_config.h ├── slalib.h ├── slalib.pyf ├── slamac.h ├── smat.f ├── stdeb.cfg ├── subet.f ├── supgal.f ├── svd.f ├── svdcov.f ├── svdsol.f ├── test ├── sla_test.f └── test_slalib.py ├── tp2s.f ├── tp2v.f ├── tps2c.f ├── tpv2c.f ├── ue2el.f ├── ue2pv.f ├── unpcd.f ├── v2tp.f ├── vdv.f ├── veri.f ├── vers.f ├── vn.f ├── vxv.f ├── wait.f ├── xy2xy.f └── zd.f /.gitignore: -------------------------------------------------------------------------------- 1 | *.[oa] 2 | *.so 3 | *.pyc 4 | *~ 5 | TAGS 6 | *egg-info 7 | build/ 8 | docstring_pickle.pkl 9 | MANIFEST 10 | deb_dist 11 | dist 12 | -------------------------------------------------------------------------------- /MANIFEST.in: -------------------------------------------------------------------------------- 1 | include get_docstring.py README.txt stdeb.cfg 2 | include *.h *.c 3 | 4 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for SLALIB 2 | # for Pentium/Linux 3 | # by Scott M. Ransom 4 | 5 | # OS type 6 | OS = Linux 7 | #OS = OSX 8 | 9 | # Linux is the first choice 10 | ifeq ($(OS),Linux) 11 | LIBSUFFIX = .so 12 | LIBCMD = -shared 13 | SYSDIR = /usr 14 | LOCDIR = /usr/local 15 | # else assume Darwin (i.e. OSX) 16 | else 17 | LIBSUFFIX = .dylib 18 | LIBCMD = -dynamiclib 19 | SYSDIR = /sw 20 | LOCDIR = /sw 21 | endif 22 | 23 | CC = gcc 24 | FC = gfortran 25 | #FC = g77 26 | CFLAGS = -O2 -Wall -W -fPIC 27 | CLINKFLAGS = $(CFLAGS) 28 | FFLAGS = -O2 -fPIC 29 | FLINKFLAGS = $(FFLAGS) 30 | 31 | all: slalib 32 | 33 | slalib: libsla$(LIBSUFFIX) 34 | $(FC) -o test/sla_test test/sla_test.f -fno-second-underscore -L. -lsla 35 | test/sla_test 36 | 37 | libsla$(LIBSUFFIX): 38 | $(FC) $(FFLAGS) -fno-second-underscore -c -I. *.f *.F 39 | $(FC) $(LIBCMD) -o libsla$(LIBSUFFIX) -fno-second-underscore *.o 40 | 41 | # Note: a better way to make pyslalib is to use the setup.py file 42 | pyslalib: 43 | f2py -c slalib.pyf -I. *.f *.F 44 | 45 | clean: 46 | rm -f *.o *~ *# 47 | rm -rf build 48 | 49 | cleaner: clean 50 | rm -f test/sla_test libsla.so slalib.so 51 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | pySLALIB v1.0.2 (Dec 2010) 2 | --------------- 3 | 4 | This is archive contains new f2py-generated (and hand-tweaked to 5 | eliminate unnecessary function/subroutine arguments) wrappers for the 6 | Fortran version of P.T. Wallace's SLALIB positional astronomy library. 7 | SLALIB used to be hosted by the STARLINK site, although that service 8 | has been suspended. The version of SLALIB included here is 2.5-4 9 | (with several additional tweaks) and is released under the GPL. 10 | 11 | The python wrappers cover every function in SLALIB and a comprehensive 12 | set of unit tests are available in the test/ directory. The only 13 | external dependency is numpy (http://numpy.scipy.org). These wrappers 14 | are not related to the older (and apparently abandoned) pySLALIB that 15 | was once available on the Web (and which depended on Numeric as 16 | opposed to numpy). 17 | 18 | Installation 19 | ------------ 20 | Most users will only need to do: 21 | > python setup.py install 22 | to generate the wrappers, build, and install the library. 23 | 24 | Once slalib.so has been installed in your PYTHONPATH, you can run the 25 | unittests via: 26 | > python test/test_slalib.py 27 | 28 | Example Usage (using IPython) 29 | ------------- 30 | In [1]: from pyslalib import slalib 31 | 32 | In [2]: slalib.sla_veri() 33 | Out[2]: 2005004 34 | 35 | In [3]: slalib.sla_caldj(1999, 12, 31) 36 | Out[3]: (51543.0, 0) 37 | 38 | In [4]: slalib.sla_etrms(1976.9) 39 | Out[4]: array([ -1.62161710e-06, -3.31007009e-07, -1.43529663e-07]) 40 | 41 | In [5]: slalib.sla_fk45z(1.234, -0.123, 1984) 42 | Out[5]: (1.2446165107316911, -0.12141858395865548) 43 | 44 | In [6]: slalib.sla_dafin("-00 03 34.6", 1) 45 | Out[6]: (12, -0.0010404101596610642, 0) 46 | 47 | In [7]: slalib.sla_obs(0, "GBT") 48 | Out[7]: 49 | ('GBT', 50 | 'Green Bank Telescope ', 51 | 1.3934679949996727, 52 | 0.67078450520692623, 53 | 880.0) 54 | 55 | If you import "sladoc" you can print the original Fortran doc 56 | strings using something like: 57 | 58 | In [1]: from pyslalib import slalib, sladoc 59 | 60 | In [2]: print sladoc['sla_caldj'] 61 | """ 62 | * - - - - - - 63 | * C A L D J 64 | * - - - - - - 65 | * 66 | * Gregorian Calendar to Modified Julian Date 67 | * 68 | * (Includes century default feature: use sla_CLDJ for years 69 | * before 100AD.) 70 | * 71 | * Given: 72 | * IY,IM,ID int year, month, day in Gregorian calendar 73 | * 74 | ... 75 | 76 | Thanks go to Prasanth for adding the docstring capabilities! 77 | 78 | If you would like to build a shared library for linking with other 79 | programs, a simple Makefile is also included that should work with 80 | only minor tweaks for most Unix-like OSs. 81 | 82 | Please let me know if you find any problems. 83 | 84 | Scott 85 | 86 | ---------------------------------- 87 | Scott M. Ransom 88 | http://www.cv.nrao.edu/~sransom -------------------------------------------------------------------------------- /addet.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_ADDET (RM, DM, EQ, RC, DC) 2 | *+ 3 | * - - - - - - 4 | * A D D E T 5 | * - - - - - - 6 | * 7 | * Add the E-terms (elliptic component of annual aberration) 8 | * to a pre IAU 1976 mean place to conform to the old 9 | * catalogue convention (double precision) 10 | * 11 | * Given: 12 | * RM,DM dp RA,Dec (radians) without E-terms 13 | * EQ dp Besselian epoch of mean equator and equinox 14 | * 15 | * Returned: 16 | * RC,DC dp RA,Dec (radians) with E-terms included 17 | * 18 | * Note: 19 | * 20 | * Most star positions from pre-1984 optical catalogues (or 21 | * derived from astrometry using such stars) embody the 22 | * E-terms. If it is necessary to convert a formal mean 23 | * place (for example a pulsar timing position) to one 24 | * consistent with such a star catalogue, then the RA,Dec 25 | * should be adjusted using this routine. 26 | * 27 | * Reference: 28 | * Explanatory Supplement to the Astronomical Ephemeris, 29 | * section 2D, page 48. 30 | * 31 | * Called: sla_ETRMS, sla_DCS2C, sla_DCC2S, sla_DRANRM, sla_DRANGE 32 | * 33 | * P.T.Wallace Starlink 18 March 1999 34 | * 35 | * Copyright (C) 1999 Rutherford Appleton Laboratory 36 | * 37 | * License: 38 | * This program is free software; you can redistribute it and/or modify 39 | * it under the terms of the GNU General Public License as published by 40 | * the Free Software Foundation; either version 2 of the License, or 41 | * (at your option) any later version. 42 | * 43 | * This program is distributed in the hope that it will be useful, 44 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 45 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 46 | * GNU General Public License for more details. 47 | * 48 | * You should have received a copy of the GNU General Public License 49 | * along with this program (see SLA_CONDITIONS); if not, write to the 50 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 51 | * Boston, MA 02111-1307 USA 52 | * 53 | *- 54 | 55 | IMPLICIT NONE 56 | 57 | DOUBLE PRECISION RM,DM,EQ,RC,DC 58 | 59 | DOUBLE PRECISION sla_DRANRM 60 | 61 | DOUBLE PRECISION A(3),V(3) 62 | 63 | INTEGER I 64 | 65 | 66 | 67 | * E-terms vector 68 | CALL sla_ETRMS(EQ,A) 69 | 70 | * Spherical to Cartesian 71 | CALL sla_DCS2C(RM,DM,V) 72 | 73 | * Include the E-terms 74 | DO I=1,3 75 | V(I)=V(I)+A(I) 76 | END DO 77 | 78 | * Cartesian to spherical 79 | CALL sla_DCC2S(V,RC,DC) 80 | 81 | * Bring RA into conventional range 82 | RC=sla_DRANRM(RC) 83 | 84 | END 85 | -------------------------------------------------------------------------------- /airmas.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_AIRMAS (ZD) 2 | *+ 3 | * - - - - - - - 4 | * A I R M A S 5 | * - - - - - - - 6 | * 7 | * Air mass at given zenith distance (double precision) 8 | * 9 | * Given: 10 | * ZD d Observed zenith distance (radians) 11 | * 12 | * The result is an estimate of the air mass, in units of that 13 | * at the zenith. 14 | * 15 | * Notes: 16 | * 17 | * 1) The "observed" zenith distance referred to above means "as 18 | * affected by refraction". 19 | * 20 | * 2) Uses Hardie's (1962) polynomial fit to Bemporad's data for 21 | * the relative air mass, X, in units of thickness at the zenith 22 | * as tabulated by Schoenberg (1929). This is adequate for all 23 | * normal needs as it is accurate to better than 0.1% up to X = 24 | * 6.8 and better than 1% up to X = 10. Bemporad's tabulated 25 | * values are unlikely to be trustworthy to such accuracy 26 | * because of variations in density, pressure and other 27 | * conditions in the atmosphere from those assumed in his work. 28 | * 29 | * 3) The sign of the ZD is ignored. 30 | * 31 | * 4) At zenith distances greater than about ZD = 87 degrees the 32 | * air mass is held constant to avoid arithmetic overflows. 33 | * 34 | * References: 35 | * Hardie, R.H., 1962, in "Astronomical Techniques" 36 | * ed. W.A. Hiltner, University of Chicago Press, p180. 37 | * Schoenberg, E., 1929, Hdb. d. Ap., 38 | * Berlin, Julius Springer, 2, 268. 39 | * 40 | * Original code by P.W.Hill, St Andrews 41 | * 42 | * P.T.Wallace Starlink 18 March 1999 43 | * 44 | * Copyright (C) 1999 Rutherford Appleton Laboratory 45 | * 46 | * License: 47 | * This program is free software; you can redistribute it and/or modify 48 | * it under the terms of the GNU General Public License as published by 49 | * the Free Software Foundation; either version 2 of the License, or 50 | * (at your option) any later version. 51 | * 52 | * This program is distributed in the hope that it will be useful, 53 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 54 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 55 | * GNU General Public License for more details. 56 | * 57 | * You should have received a copy of the GNU General Public License 58 | * along with this program (see SLA_CONDITIONS); if not, write to the 59 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 60 | * Boston, MA 02111-1307 USA 61 | * 62 | *- 63 | 64 | IMPLICIT NONE 65 | 66 | DOUBLE PRECISION ZD 67 | 68 | DOUBLE PRECISION SECZM1 69 | 70 | 71 | SECZM1 = 1D0/(COS(MIN(1.52D0,ABS(ZD))))-1D0 72 | sla_AIRMAS = 1D0 + SECZM1*(0.9981833D0 73 | : - SECZM1*(0.002875D0 + 0.0008083D0*SECZM1)) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /aoppat.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_AOPPAT (DATE, AOPRMS) 2 | *+ 3 | * - - - - - - - 4 | * A O P P A T 5 | * - - - - - - - 6 | * 7 | * Recompute the sidereal time in the apparent to observed place 8 | * star-independent parameter block. 9 | * 10 | * Given: 11 | * DATE d UTC date/time (modified Julian Date, JD-2400000.5) 12 | * (see AOPPA source for comments on leap seconds) 13 | * 14 | * AOPRMS d(14) star-independent apparent-to-observed parameters 15 | * 16 | * (1-12) not required 17 | * (13) longitude + eqn of equinoxes + sidereal DUT 18 | * (14) not required 19 | * 20 | * Returned: 21 | * AOPRMS d(14) star-independent apparent-to-observed parameters: 22 | * 23 | * (1-13) not changed 24 | * (14) local apparent sidereal time (radians) 25 | * 26 | * For more information, see sla_AOPPA. 27 | * 28 | * Called: sla_GMST 29 | * 30 | * P.T.Wallace Starlink 1 July 1993 31 | * 32 | * Copyright (C) 1995 Rutherford Appleton Laboratory 33 | * 34 | * License: 35 | * This program is free software; you can redistribute it and/or modify 36 | * it under the terms of the GNU General Public License as published by 37 | * the Free Software Foundation; either version 2 of the License, or 38 | * (at your option) any later version. 39 | * 40 | * This program is distributed in the hope that it will be useful, 41 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 42 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 43 | * GNU General Public License for more details. 44 | * 45 | * You should have received a copy of the GNU General Public License 46 | * along with this program (see SLA_CONDITIONS); if not, write to the 47 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 48 | * Boston, MA 02111-1307 USA 49 | * 50 | *- 51 | 52 | IMPLICIT NONE 53 | 54 | DOUBLE PRECISION DATE,AOPRMS(14) 55 | 56 | DOUBLE PRECISION sla_GMST 57 | 58 | 59 | 60 | AOPRMS(14) = sla_GMST(DATE)+AOPRMS(13) 61 | 62 | END 63 | -------------------------------------------------------------------------------- /atms.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla__ATMS (RT, TT, DNT, GAMAL, R, DN, RDNDR) 2 | *+ 3 | * - - - - - 4 | * A T M S 5 | * - - - - - 6 | * 7 | * Internal routine used by REFRO 8 | * 9 | * Refractive index and derivative with respect to height for the 10 | * stratosphere. 11 | * 12 | * Given: 13 | * RT d height of tropopause from centre of the Earth (metre) 14 | * TT d temperature at the tropopause (K) 15 | * DNT d refractive index at the tropopause 16 | * GAMAL d constant of the atmospheric model = G*MD/R 17 | * R d current distance from the centre of the Earth (metre) 18 | * 19 | * Returned: 20 | * DN d refractive index at R 21 | * RDNDR d R * rate the refractive index is changing at R 22 | * 23 | * Last revision: 26 December 2004 24 | * 25 | * Copyright P.T.Wallace. All rights reserved. 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | DOUBLE PRECISION RT,TT,DNT,GAMAL,R,DN,RDNDR 48 | 49 | DOUBLE PRECISION B,W 50 | 51 | 52 | B = GAMAL/TT 53 | W = (DNT-1D0)*EXP(-B*(R-RT)) 54 | DN = 1D0+W 55 | RDNDR = -R*B*W 56 | 57 | END 58 | -------------------------------------------------------------------------------- /atmt.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla__ATMT (R0, T0, ALPHA, GAMM2, DELM2, 2 | : C1, C2, C3, C4, C5, C6, R, T, DN, RDNDR) 3 | *+ 4 | * - - - - - 5 | * A T M T 6 | * - - - - - 7 | * 8 | * Internal routine used by REFRO 9 | * 10 | * Refractive index and derivative with respect to height for the 11 | * troposphere. 12 | * 13 | * Given: 14 | * R0 d height of observer from centre of the Earth (metre) 15 | * T0 d temperature at the observer (K) 16 | * ALPHA d alpha ) 17 | * GAMM2 d gamma minus 2 ) see HMNAO paper 18 | * DELM2 d delta minus 2 ) 19 | * C1 d useful term ) 20 | * C2 d useful term ) 21 | * C3 d useful term ) see source 22 | * C4 d useful term ) of sla_REFRO 23 | * C5 d useful term ) 24 | * C6 d useful term ) 25 | * R d current distance from the centre of the Earth (metre) 26 | * 27 | * Returned: 28 | * T d temperature at R (K) 29 | * DN d refractive index at R 30 | * RDNDR d R * rate the refractive index is changing at R 31 | * 32 | * Note that in the optical case C5 and C6 are zero. 33 | * 34 | * Last revision: 26 December 2004 35 | * 36 | * Copyright P.T.Wallace. All rights reserved. 37 | * 38 | * License: 39 | * This program is free software; you can redistribute it and/or modify 40 | * it under the terms of the GNU General Public License as published by 41 | * the Free Software Foundation; either version 2 of the License, or 42 | * (at your option) any later version. 43 | * 44 | * This program is distributed in the hope that it will be useful, 45 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 46 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 47 | * GNU General Public License for more details. 48 | * 49 | * You should have received a copy of the GNU General Public License 50 | * along with this program (see SLA_CONDITIONS); if not, write to the 51 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 52 | * Boston, MA 02111-1307 USA 53 | * 54 | *- 55 | 56 | IMPLICIT NONE 57 | 58 | DOUBLE PRECISION R0,T0,ALPHA,GAMM2,DELM2,C1,C2,C3,C4,C5,C6, 59 | : R,T,DN,RDNDR 60 | 61 | DOUBLE PRECISION TT0,TT0GM2,TT0DM2 62 | 63 | 64 | T = MAX(MIN(T0-ALPHA*(R-R0),320D0),100D0) 65 | TT0 = T/T0 66 | TT0GM2 = TT0**GAMM2 67 | TT0DM2 = TT0**DELM2 68 | DN = 1D0+(C1*TT0GM2-(C2-C5/T)*TT0DM2)*TT0 69 | RDNDR = R*(-C3*TT0GM2+(C4-C6/TT0)*TT0DM2) 70 | 71 | END 72 | -------------------------------------------------------------------------------- /av2m.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_AV2M (AXVEC, RMAT) 2 | *+ 3 | * - - - - - 4 | * A V 2 M 5 | * - - - - - 6 | * 7 | * Form the rotation matrix corresponding to a given axial vector. 8 | * 9 | * (single precision) 10 | * 11 | * A rotation matrix describes a rotation about some arbitrary axis, 12 | * called the Euler axis. The "axial vector" supplied to this routine 13 | * has the same direction as the Euler axis, and its magnitude is the 14 | * amount of rotation in radians. 15 | * 16 | * Given: 17 | * AXVEC r(3) axial vector (radians) 18 | * 19 | * Returned: 20 | * RMAT r(3,3) rotation matrix 21 | * 22 | * If AXVEC is null, the unit matrix is returned. 23 | * 24 | * The reference frame rotates clockwise as seen looking along 25 | * the axial vector from the origin. 26 | * 27 | * Last revision: 26 November 2005 28 | * 29 | * Copyright P.T.Wallace. All rights reserved. 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | REAL AXVEC(3),RMAT(3,3) 52 | 53 | REAL X,Y,Z,PHI,S,C,W 54 | 55 | 56 | 57 | * Rotation angle - magnitude of axial vector - and functions 58 | X = AXVEC(1) 59 | Y = AXVEC(2) 60 | Z = AXVEC(3) 61 | PHI = SQRT(X*X+Y*Y+Z*Z) 62 | S = SIN(PHI) 63 | C = COS(PHI) 64 | W = 1.0-C 65 | 66 | * Euler axis - direction of axial vector (perhaps null) 67 | IF (PHI.NE.0.0) THEN 68 | X = X/PHI 69 | Y = Y/PHI 70 | Z = Z/PHI 71 | END IF 72 | 73 | * Compute the rotation matrix 74 | RMAT(1,1) = X*X*W+C 75 | RMAT(1,2) = X*Y*W+Z*S 76 | RMAT(1,3) = X*Z*W-Y*S 77 | RMAT(2,1) = X*Y*W-Z*S 78 | RMAT(2,2) = Y*Y*W+C 79 | RMAT(2,3) = Y*Z*W+X*S 80 | RMAT(3,1) = X*Z*W+Y*S 81 | RMAT(3,2) = Y*Z*W-X*S 82 | RMAT(3,3) = Z*Z*W+C 83 | 84 | END 85 | -------------------------------------------------------------------------------- /bear.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_BEAR (A1, B1, A2, B2) 2 | *+ 3 | * - - - - - 4 | * B E A R 5 | * - - - - - 6 | * 7 | * Bearing (position angle) of one point on a sphere relative to another 8 | * (single precision) 9 | * 10 | * Given: 11 | * A1,B1 r spherical coordinates of one point 12 | * A2,B2 r spherical coordinates of the other point 13 | * 14 | * (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.) 15 | * 16 | * The result is the bearing (position angle), in radians, of point 17 | * A2,B2 as seen from point A1,B1. It is in the range +/- pi. If 18 | * A2,B2 is due east of A1,B1 the bearing is +pi/2. Zero is returned 19 | * if the two points are coincident. 20 | * 21 | * P.T.Wallace Starlink 23 March 1991 22 | * 23 | * Copyright (C) 1995 Rutherford Appleton Laboratory 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | REAL A1,B1,A2,B2 46 | 47 | REAL DA,X,Y 48 | 49 | 50 | DA=A2-A1 51 | Y=SIN(DA)*COS(B2) 52 | X=SIN(B2)*COS(B1)-COS(B2)*SIN(B1)*COS(DA) 53 | IF (X.NE.0.0.OR.Y.NE.0.0) THEN 54 | sla_BEAR=ATAN2(Y,X) 55 | ELSE 56 | sla_BEAR=0.0 57 | END IF 58 | 59 | END 60 | -------------------------------------------------------------------------------- /caf2r.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CAF2R (IDEG, IAMIN, ASEC, RAD, J) 2 | *+ 3 | * - - - - - - 4 | * C A F 2 R 5 | * - - - - - - 6 | * 7 | * Convert degrees, arcminutes, arcseconds to radians 8 | * (single precision) 9 | * 10 | * Given: 11 | * IDEG int degrees 12 | * IAMIN int arcminutes 13 | * ASEC real arcseconds 14 | * 15 | * Returned: 16 | * RAD real angle in radians 17 | * J int status: 0 = OK 18 | * 1 = IDEG outside range 0-359 19 | * 2 = IAMIN outside range 0-59 20 | * 3 = ASEC outside range 0-59.999... 21 | * 22 | * Notes: 23 | * 24 | * 1) The result is computed even if any of the range checks 25 | * fail. 26 | * 27 | * 2) The sign must be dealt with outside this routine. 28 | * 29 | * P.T.Wallace Starlink 23 August 1996 30 | * 31 | * Copyright (C) 1996 Rutherford Appleton Laboratory 32 | * 33 | * License: 34 | * This program is free software; you can redistribute it and/or modify 35 | * it under the terms of the GNU General Public License as published by 36 | * the Free Software Foundation; either version 2 of the License, or 37 | * (at your option) any later version. 38 | * 39 | * This program is distributed in the hope that it will be useful, 40 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 41 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 42 | * GNU General Public License for more details. 43 | * 44 | * You should have received a copy of the GNU General Public License 45 | * along with this program (see SLA_CONDITIONS); if not, write to the 46 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 47 | * Boston, MA 02111-1307 USA 48 | * 49 | *- 50 | 51 | IMPLICIT NONE 52 | 53 | INTEGER IDEG,IAMIN 54 | REAL ASEC,RAD 55 | INTEGER J 56 | 57 | * Arc seconds to radians 58 | REAL AS2R 59 | PARAMETER (AS2R=0.484813681109535994E-5) 60 | 61 | 62 | 63 | * Preset status 64 | J=0 65 | 66 | * Validate arcsec, arcmin, deg 67 | IF (ASEC.LT.0.0.OR.ASEC.GE.60.0) J=3 68 | IF (IAMIN.LT.0.OR.IAMIN.GT.59) J=2 69 | IF (IDEG.LT.0.OR.IDEG.GT.359) J=1 70 | 71 | * Compute angle 72 | RAD=AS2R*(60.0*(60.0*REAL(IDEG)+REAL(IAMIN))+ASEC) 73 | 74 | END 75 | -------------------------------------------------------------------------------- /caldj.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CALDJ (IY, IM, ID, DJM, J) 2 | *+ 3 | * - - - - - - 4 | * C A L D J 5 | * - - - - - - 6 | * 7 | * Gregorian Calendar to Modified Julian Date 8 | * 9 | * (Includes century default feature: use sla_CLDJ for years 10 | * before 100AD.) 11 | * 12 | * Given: 13 | * IY,IM,ID int year, month, day in Gregorian calendar 14 | * 15 | * Returned: 16 | * DJM dp modified Julian Date (JD-2400000.5) for 0 hrs 17 | * J int status: 18 | * 0 = OK 19 | * 1 = bad year (MJD not computed) 20 | * 2 = bad month (MJD not computed) 21 | * 3 = bad day (MJD computed) 22 | * 23 | * Acceptable years are 00-49, interpreted as 2000-2049, 24 | * 50-99, " " 1950-1999, 25 | * 100 upwards, interpreted literally. 26 | * 27 | * Called: sla_CLDJ 28 | * 29 | * P.T.Wallace Starlink November 1985 30 | * 31 | * Copyright (C) 1995 Rutherford Appleton Laboratory 32 | * 33 | * License: 34 | * This program is free software; you can redistribute it and/or modify 35 | * it under the terms of the GNU General Public License as published by 36 | * the Free Software Foundation; either version 2 of the License, or 37 | * (at your option) any later version. 38 | * 39 | * This program is distributed in the hope that it will be useful, 40 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 41 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 42 | * GNU General Public License for more details. 43 | * 44 | * You should have received a copy of the GNU General Public License 45 | * along with this program (see SLA_CONDITIONS); if not, write to the 46 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 47 | * Boston, MA 02111-1307 USA 48 | * 49 | *- 50 | 51 | IMPLICIT NONE 52 | 53 | INTEGER IY,IM,ID 54 | DOUBLE PRECISION DJM 55 | INTEGER J 56 | 57 | INTEGER NY 58 | 59 | 60 | 61 | 62 | * Default century if appropriate 63 | IF (IY.GE.0.AND.IY.LE.49) THEN 64 | NY=IY+2000 65 | ELSE IF (IY.GE.50.AND.IY.LE.99) THEN 66 | NY=IY+1900 67 | ELSE 68 | NY=IY 69 | END IF 70 | 71 | * Modified Julian Date 72 | CALL sla_CLDJ(NY,IM,ID,DJM,J) 73 | 74 | END 75 | -------------------------------------------------------------------------------- /calyd.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CALYD (IY, IM, ID, NY, ND, J) 2 | *+ 3 | * - - - - - - 4 | * C A L Y D 5 | * - - - - - - 6 | * 7 | * Gregorian calendar date to year and day in year (in a Julian 8 | * calendar aligned to the 20th/21st century Gregorian calendar). 9 | * 10 | * (Includes century default feature: use sla_CLYD for years 11 | * before 100AD.) 12 | * 13 | * Given: 14 | * IY,IM,ID int year, month, day in Gregorian calendar 15 | * (year may optionally omit the century) 16 | * Returned: 17 | * NY int year (re-aligned Julian calendar) 18 | * ND int day in year (1 = January 1st) 19 | * J int status: 20 | * 0 = OK 21 | * 1 = bad year (before -4711) 22 | * 2 = bad month 23 | * 3 = bad day (but conversion performed) 24 | * 25 | * Notes: 26 | * 27 | * 1 This routine exists to support the low-precision routines 28 | * sla_EARTH, sla_MOON and sla_ECOR. 29 | * 30 | * 2 Between 1900 March 1 and 2100 February 28 it returns answers 31 | * which are consistent with the ordinary Gregorian calendar. 32 | * Outside this range there will be a discrepancy which increases 33 | * by one day for every non-leap century year. 34 | * 35 | * 3 Years in the range 50-99 are interpreted as 1950-1999, and 36 | * years in the range 00-49 are interpreted as 2000-2049. 37 | * 38 | * Called: sla_CLYD 39 | * 40 | * P.T.Wallace Starlink 23 November 1994 41 | * 42 | * Copyright (C) 1995 Rutherford Appleton Laboratory 43 | * 44 | * License: 45 | * This program is free software; you can redistribute it and/or modify 46 | * it under the terms of the GNU General Public License as published by 47 | * the Free Software Foundation; either version 2 of the License, or 48 | * (at your option) any later version. 49 | * 50 | * This program is distributed in the hope that it will be useful, 51 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 52 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 53 | * GNU General Public License for more details. 54 | * 55 | * You should have received a copy of the GNU General Public License 56 | * along with this program (see SLA_CONDITIONS); if not, write to the 57 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 58 | * Boston, MA 02111-1307 USA 59 | * 60 | *- 61 | 62 | IMPLICIT NONE 63 | 64 | INTEGER IY,IM,ID,NY,ND,J 65 | 66 | INTEGER I 67 | 68 | 69 | 70 | * Default century if appropriate 71 | IF (IY.GE.0.AND.IY.LE.49) THEN 72 | I=IY+2000 73 | ELSE IF (IY.GE.50.AND.IY.LE.99) THEN 74 | I=IY+1900 75 | ELSE 76 | I=IY 77 | END IF 78 | 79 | * Perform the conversion 80 | CALL sla_CLYD(I,IM,ID,NY,ND,J) 81 | 82 | END 83 | -------------------------------------------------------------------------------- /cc2s.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CC2S (V, A, B) 2 | *+ 3 | * - - - - - 4 | * C C 2 S 5 | * - - - - - 6 | * 7 | * Cartesian to spherical coordinates (single precision) 8 | * 9 | * Given: 10 | * V r(3) x,y,z vector 11 | * 12 | * Returned: 13 | * A,B r spherical coordinates in radians 14 | * 15 | * The spherical coordinates are longitude (+ve anticlockwise looking 16 | * from the +ve latitude pole) and latitude. The Cartesian coordinates 17 | * are right handed, with the x axis at zero longitude and latitude, and 18 | * the z axis at the +ve latitude pole. 19 | * 20 | * If V is null, zero A and B are returned. At either pole, zero A is 21 | * returned. 22 | * 23 | * Last revision: 22 July 2004 24 | * 25 | * Copyright P.T.Wallace. All rights reserved. 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | REAL V(3),A,B 48 | 49 | REAL X,Y,Z,R 50 | 51 | 52 | X = V(1) 53 | Y = V(2) 54 | Z = V(3) 55 | R = SQRT(X*X+Y*Y) 56 | 57 | IF (R.EQ.0.0) THEN 58 | A = 0.0 59 | ELSE 60 | A = ATAN2(Y,X) 61 | END IF 62 | 63 | IF (Z.EQ.0.0) THEN 64 | B = 0.0 65 | ELSE 66 | B = ATAN2(Z,R) 67 | END IF 68 | 69 | END 70 | -------------------------------------------------------------------------------- /cc62s.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CC62S (V, A, B, R, AD, BD, RD) 2 | *+ 3 | * - - - - - - 4 | * C C 6 2 S 5 | * - - - - - - 6 | * 7 | * Conversion of position & velocity in Cartesian coordinates 8 | * to spherical coordinates (single precision) 9 | * 10 | * Given: 11 | * V r(6) Cartesian position & velocity vector 12 | * 13 | * Returned: 14 | * A r longitude (radians) 15 | * B r latitude (radians) 16 | * R r radial coordinate 17 | * AD r longitude derivative (radians per unit time) 18 | * BD r latitude derivative (radians per unit time) 19 | * RD r radial derivative 20 | * 21 | * P.T.Wallace Starlink 28 April 1996 22 | * 23 | * Copyright (C) 1996 Rutherford Appleton Laboratory 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | REAL V(6),A,B,R,AD,BD,RD 46 | 47 | REAL X,Y,Z,XD,YD,ZD,RXY2,RXY,R2,XYP 48 | 49 | 50 | 51 | * Components of position/velocity vector 52 | X=V(1) 53 | Y=V(2) 54 | Z=V(3) 55 | XD=V(4) 56 | YD=V(5) 57 | ZD=V(6) 58 | 59 | * Component of R in XY plane squared 60 | RXY2=X*X+Y*Y 61 | 62 | * Modulus squared 63 | R2=RXY2+Z*Z 64 | 65 | * Protection against null vector 66 | IF (R2.EQ.0.0) THEN 67 | X=XD 68 | Y=YD 69 | Z=ZD 70 | RXY2=X*X+Y*Y 71 | R2=RXY2+Z*Z 72 | END IF 73 | 74 | * Position and velocity in spherical coordinates 75 | RXY=SQRT(RXY2) 76 | XYP=X*XD+Y*YD 77 | IF (RXY2.NE.0.0) THEN 78 | A=ATAN2(Y,X) 79 | B=ATAN2(Z,RXY) 80 | AD=(X*YD-Y*XD)/RXY2 81 | BD=(ZD*RXY2-Z*XYP)/(R2*RXY) 82 | ELSE 83 | A=0.0 84 | IF (Z.NE.0.0) THEN 85 | B=ATAN2(Z,RXY) 86 | ELSE 87 | B=0.0 88 | END IF 89 | AD=0.0 90 | BD=0.0 91 | END IF 92 | R=SQRT(R2) 93 | IF (R.NE.0.0) THEN 94 | RD=(XYP+Z*ZD)/R 95 | ELSE 96 | RD=0.0 97 | END IF 98 | 99 | END 100 | -------------------------------------------------------------------------------- /cd2tf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CD2TF (NDP, DAYS, SIGN, IHMSF) 2 | *+ 3 | * - - - - - - 4 | * C D 2 T F 5 | * - - - - - - 6 | * 7 | * Convert an interval in days into hours, minutes, seconds 8 | * 9 | * (single precision) 10 | * 11 | * Given: 12 | * NDP int number of decimal places of seconds 13 | * DAYS real interval in days 14 | * 15 | * Returned: 16 | * SIGN char '+' or '-' 17 | * IHMSF int(4) hours, minutes, seconds, fraction 18 | * 19 | * Notes: 20 | * 21 | * 1) NDP less than zero is interpreted as zero. 22 | * 23 | * 2) The largest useful value for NDP is determined by the size of 24 | * DAYS, the format of REAL floating-point numbers on the target 25 | * machine, and the risk of overflowing IHMSF(4). On some 26 | * architectures, for DAYS up to 1.0, the available floating- 27 | * point precision corresponds roughly to NDP=3. This is well 28 | * below the ultimate limit of NDP=9 set by the capacity of a 29 | * typical 32-bit IHMSF(4). 30 | * 31 | * 3) The absolute value of DAYS may exceed 1.0. In cases where it 32 | * does not, it is up to the caller to test for and handle the 33 | * case where DAYS is very nearly 1.0 and rounds up to 24 hours, 34 | * by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero. 35 | * 36 | * Called: sla_DD2TF 37 | * 38 | * Last revision: 26 December 2004 39 | * 40 | * Copyright P.T.Wallace. All rights reserved. 41 | * 42 | * License: 43 | * This program is free software; you can redistribute it and/or modify 44 | * it under the terms of the GNU General Public License as published by 45 | * the Free Software Foundation; either version 2 of the License, or 46 | * (at your option) any later version. 47 | * 48 | * This program is distributed in the hope that it will be useful, 49 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 50 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 51 | * GNU General Public License for more details. 52 | * 53 | * You should have received a copy of the GNU General Public License 54 | * along with this program (see SLA_CONDITIONS); if not, write to the 55 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 56 | * Boston, MA 02111-1307 USA 57 | * 58 | *- 59 | 60 | IMPLICIT NONE 61 | 62 | INTEGER NDP 63 | REAL DAYS 64 | CHARACTER SIGN*(*) 65 | INTEGER IHMSF(4) 66 | 67 | 68 | 69 | * Call double precision version 70 | CALL sla_DD2TF(NDP,DBLE(DAYS),SIGN,IHMSF) 71 | 72 | END 73 | -------------------------------------------------------------------------------- /cldj.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CLDJ (IY, IM, ID, DJM, J) 2 | *+ 3 | * - - - - - 4 | * C L D J 5 | * - - - - - 6 | * 7 | * Gregorian Calendar to Modified Julian Date 8 | * 9 | * Given: 10 | * IY,IM,ID int year, month, day in Gregorian calendar 11 | * 12 | * Returned: 13 | * DJM dp modified Julian Date (JD-2400000.5) for 0 hrs 14 | * J int status: 15 | * 0 = OK 16 | * 1 = bad year (MJD not computed) 17 | * 2 = bad month (MJD not computed) 18 | * 3 = bad day (MJD computed) 19 | * 20 | * The year must be -4699 (i.e. 4700BC) or later. 21 | * 22 | * The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55). 23 | * 24 | * Last revision: 27 July 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | INTEGER IY,IM,ID 49 | DOUBLE PRECISION DJM 50 | INTEGER J 51 | 52 | * Month lengths in days 53 | INTEGER MTAB(12) 54 | DATA MTAB / 31,28,31,30,31,30,31,31,30,31,30,31 / 55 | 56 | 57 | 58 | * Preset status. 59 | J = 0 60 | 61 | * Validate year. 62 | IF ( IY .LT. -4699 ) THEN 63 | J = 1 64 | ELSE 65 | 66 | * Validate month. 67 | IF ( IM.GE.1 .AND. IM.LE.12 ) THEN 68 | 69 | * Allow for leap year. 70 | IF ( MOD(IY,4) .EQ. 0 ) THEN 71 | MTAB(2) = 29 72 | ELSE 73 | MTAB(2) = 28 74 | END IF 75 | IF ( MOD(IY,100).EQ.0 .AND. MOD(IY,400).NE.0 ) 76 | : MTAB(2) = 28 77 | 78 | * Validate day. 79 | IF ( ID.LT.1 .OR. ID.GT.MTAB(IM) ) J=3 80 | 81 | * Modified Julian Date. 82 | DJM = DBLE ( ( 1461 * ( IY - (12-IM)/10 + 4712 ) ) / 4 83 | : + ( 306 * MOD ( IM+9, 12 ) + 5 ) / 10 84 | : - ( 3 * ( ( IY - (12-IM)/10 + 4900 ) / 100 ) ) / 4 85 | : + ID - 2399904 ) 86 | 87 | * Bad month. 88 | ELSE 89 | J=2 90 | END IF 91 | 92 | END IF 93 | 94 | END 95 | -------------------------------------------------------------------------------- /cr2af.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CR2AF (NDP, ANGLE, SIGN, IDMSF) 2 | *+ 3 | * - - - - - - 4 | * C R 2 A F 5 | * - - - - - - 6 | * 7 | * Convert an angle in radians into degrees, arcminutes, arcseconds 8 | * (single precision) 9 | * 10 | * Given: 11 | * NDP int number of decimal places of arcseconds 12 | * ANGLE real angle in radians 13 | * 14 | * Returned: 15 | * SIGN char '+' or '-' 16 | * IDMSF int(4) degrees, arcminutes, arcseconds, fraction 17 | * 18 | * Notes: 19 | * 20 | * 1) NDP less than zero is interpreted as zero. 21 | * 22 | * 2) The largest useful value for NDP is determined by the size of 23 | * ANGLE, the format of REAL floating-point numbers on the target 24 | * machine, and the risk of overflowing IDMSF(4). On some 25 | * architectures, for ANGLE up to 2pi, the available floating- 26 | * point precision corresponds roughly to NDP=3. This is well 27 | * below the ultimate limit of NDP=9 set by the capacity of a 28 | * typical 32-bit IDMSF(4). 29 | * 30 | * 3) The absolute value of ANGLE may exceed 2pi. In cases where it 31 | * does not, it is up to the caller to test for and handle the 32 | * case where ANGLE is very nearly 2pi and rounds up to 360 deg, 33 | * by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero. 34 | * 35 | * Called: sla_CD2TF 36 | * 37 | * Last revision: 26 December 2004 38 | * 39 | * Copyright P.T.Wallace. All rights reserved. 40 | * 41 | * License: 42 | * This program is free software; you can redistribute it and/or modify 43 | * it under the terms of the GNU General Public License as published by 44 | * the Free Software Foundation; either version 2 of the License, or 45 | * (at your option) any later version. 46 | * 47 | * This program is distributed in the hope that it will be useful, 48 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 49 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 50 | * GNU General Public License for more details. 51 | * 52 | * You should have received a copy of the GNU General Public License 53 | * along with this program (see SLA_CONDITIONS); if not, write to the 54 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 55 | * Boston, MA 02111-1307 USA 56 | * 57 | *- 58 | 59 | IMPLICIT NONE 60 | 61 | INTEGER NDP 62 | REAL ANGLE 63 | CHARACTER SIGN*(*) 64 | INTEGER IDMSF(4) 65 | 66 | * Hours to degrees * radians to turns 67 | REAL F 68 | PARAMETER (F=15.0/6.283185307179586476925287) 69 | 70 | 71 | 72 | * Scale then use days to h,m,s routine 73 | CALL sla_CD2TF(NDP,ANGLE*F,SIGN,IDMSF) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /cr2tf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CR2TF (NDP, ANGLE, SIGN, IHMSF) 2 | *+ 3 | * - - - - - - 4 | * C R 2 T F 5 | * - - - - - - 6 | * 7 | * Convert an angle in radians into hours, minutes, seconds 8 | * (single precision) 9 | * 10 | * Given: 11 | * NDP int number of decimal places of seconds 12 | * ANGLE real angle in radians 13 | * 14 | * Returned: 15 | * SIGN char '+' or '-' 16 | * IHMSF int(4) hours, minutes, seconds, fraction 17 | * 18 | * Notes: 19 | * 20 | * 1) NDP less than zero is interpreted as zero. 21 | * 22 | * 2) The largest useful value for NDP is determined by the size of 23 | * ANGLE, the format of REAL floating-point numbers on the target 24 | * machine, and the risk of overflowing IHMSF(4). On some 25 | * architectures, for ANGLE up to 2pi, the available floating-point 26 | * precision corresponds roughly to NDP=3. This is well below 27 | * the ultimate limit of NDP=9 set by the capacity of a typical 28 | * 32-bit IHMSF(4). 29 | * 30 | * 3) The absolute value of ANGLE may exceed 2pi. In cases where it 31 | * does not, it is up to the caller to test for and handle the 32 | * case where ANGLE is very nearly 2pi and rounds up to 24 hours, 33 | * by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero. 34 | * 35 | * Called: sla_CD2TF 36 | * 37 | * Last revision: 26 December 2004 38 | * 39 | * Copyright P.T.Wallace. All rights reserved. 40 | * 41 | * License: 42 | * This program is free software; you can redistribute it and/or modify 43 | * it under the terms of the GNU General Public License as published by 44 | * the Free Software Foundation; either version 2 of the License, or 45 | * (at your option) any later version. 46 | * 47 | * This program is distributed in the hope that it will be useful, 48 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 49 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 50 | * GNU General Public License for more details. 51 | * 52 | * You should have received a copy of the GNU General Public License 53 | * along with this program (see SLA_CONDITIONS); if not, write to the 54 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 55 | * Boston, MA 02111-1307 USA 56 | * 57 | *- 58 | 59 | IMPLICIT NONE 60 | 61 | INTEGER NDP 62 | REAL ANGLE 63 | CHARACTER SIGN*(*) 64 | INTEGER IHMSF(4) 65 | 66 | * Turns to radians 67 | REAL T2R 68 | PARAMETER (T2R=6.283185307179586476925287) 69 | 70 | 71 | 72 | * Scale then use days to h,m,s routine 73 | CALL sla_CD2TF(NDP,ANGLE/T2R,SIGN,IHMSF) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /cs2c.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CS2C (A, B, V) 2 | *+ 3 | * - - - - - 4 | * C S 2 C 5 | * - - - - - 6 | * 7 | * Spherical coordinates to direction cosines (single precision) 8 | * 9 | * Given: 10 | * A,B real spherical coordinates in radians 11 | * (RA,Dec), (long,lat) etc. 12 | * 13 | * Returned: 14 | * V real(3) x,y,z unit vector 15 | * 16 | * The spherical coordinates are longitude (+ve anticlockwise looking 17 | * from the +ve latitude pole) and latitude. The Cartesian coordinates 18 | * are right handed, with the x axis at zero longitude and latitude, and 19 | * the z axis at the +ve latitude pole. 20 | * 21 | * Last revision: 22 July 2004 22 | * 23 | * Copyright P.T.Wallace. All rights reserved. 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | REAL A,B,V(3) 46 | 47 | REAL COSB 48 | 49 | 50 | 51 | COSB = COS(B) 52 | 53 | V(1) = COS(A)*COSB 54 | V(2) = SIN(A)*COSB 55 | V(3) = SIN(B) 56 | 57 | END 58 | -------------------------------------------------------------------------------- /cs2c6.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CS2C6 ( A, B, R, AD, BD, RD, V ) 2 | *+ 3 | * - - - - - - 4 | * C S 2 C 6 5 | * - - - - - - 6 | * 7 | * Conversion of position & velocity in spherical coordinates 8 | * to Cartesian coordinates (single precision) 9 | * 10 | * Given: 11 | * A r longitude (radians) 12 | * B r latitude (radians) 13 | * R r radial coordinate 14 | * AD r longitude derivative (radians per unit time) 15 | * BD r latitude derivative (radians per unit time) 16 | * RD r radial derivative 17 | * 18 | * Returned: 19 | * V r(6) Cartesian position & velocity vector 20 | * 21 | * Last revision: 11 September 2005 22 | * 23 | * Copyright P.T.Wallace. All rights reserved. 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | REAL A, B, R, AD, BD, RD, V(6) 46 | 47 | REAL SA, CA, SB, CB, RCB, X, Y, RBD, W 48 | 49 | 50 | 51 | * Useful functions. 52 | SA = SIN(A) 53 | CA = COS(A) 54 | SB = SIN(B) 55 | CB = COS(B) 56 | RCB = R*CB 57 | X = RCB*CA 58 | Y = RCB*SA 59 | RBD = R*BD 60 | W = RBD*SB-CB*RD 61 | 62 | * Position. 63 | V(1) = X 64 | V(2) = Y 65 | V(3) = R*SB 66 | 67 | * Velocity. 68 | V(4) = -Y*AD-W*CA 69 | V(5) = X*AD-W*SA 70 | V(6) = RBD*CB+SB*RD 71 | 72 | END 73 | -------------------------------------------------------------------------------- /ctf2d.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CTF2D (IHOUR, IMIN, SEC, DAYS, J) 2 | *+ 3 | * - - - - - - 4 | * C T F 2 D 5 | * - - - - - - 6 | * 7 | * Convert hours, minutes, seconds to days (single precision) 8 | * 9 | * Given: 10 | * IHOUR int hours 11 | * IMIN int minutes 12 | * SEC real seconds 13 | * 14 | * Returned: 15 | * DAYS real interval in days 16 | * J int status: 0 = OK 17 | * 1 = IHOUR outside range 0-23 18 | * 2 = IMIN outside range 0-59 19 | * 3 = SEC outside range 0-59.999... 20 | * 21 | * Notes: 22 | * 23 | * 1) The result is computed even if any of the range checks 24 | * fail. 25 | * 26 | * 2) The sign must be dealt with outside this routine. 27 | * 28 | * P.T.Wallace Starlink November 1984 29 | * 30 | * Copyright (C) 1995 Rutherford Appleton Laboratory 31 | * 32 | * License: 33 | * This program is free software; you can redistribute it and/or modify 34 | * it under the terms of the GNU General Public License as published by 35 | * the Free Software Foundation; either version 2 of the License, or 36 | * (at your option) any later version. 37 | * 38 | * This program is distributed in the hope that it will be useful, 39 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 40 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 41 | * GNU General Public License for more details. 42 | * 43 | * You should have received a copy of the GNU General Public License 44 | * along with this program (see SLA_CONDITIONS); if not, write to the 45 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 46 | * Boston, MA 02111-1307 USA 47 | * 48 | *- 49 | 50 | IMPLICIT NONE 51 | 52 | INTEGER IHOUR,IMIN 53 | REAL SEC,DAYS 54 | INTEGER J 55 | 56 | * Seconds per day 57 | REAL D2S 58 | PARAMETER (D2S=86400.0) 59 | 60 | 61 | 62 | * Preset status 63 | J=0 64 | 65 | * Validate sec, min, hour 66 | IF (SEC.LT.0.0.OR.SEC.GE.60.0) J=3 67 | IF (IMIN.LT.0.OR.IMIN.GT.59) J=2 68 | IF (IHOUR.LT.0.OR.IHOUR.GT.23) J=1 69 | 70 | * Compute interval 71 | DAYS=(60.0*(60.0*REAL(IHOUR)+REAL(IMIN))+SEC)/D2S 72 | 73 | END 74 | -------------------------------------------------------------------------------- /ctf2r.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_CTF2R (IHOUR, IMIN, SEC, RAD, J) 2 | *+ 3 | * - - - - - - 4 | * C T F 2 R 5 | * - - - - - - 6 | * 7 | * Convert hours, minutes, seconds to radians (single precision) 8 | * 9 | * Given: 10 | * IHOUR int hours 11 | * IMIN int minutes 12 | * SEC real seconds 13 | * 14 | * Returned: 15 | * RAD real angle in radians 16 | * J int status: 0 = OK 17 | * 1 = IHOUR outside range 0-23 18 | * 2 = IMIN outside range 0-59 19 | * 3 = SEC outside range 0-59.999... 20 | * 21 | * Called: 22 | * sla_CTF2D 23 | * 24 | * Notes: 25 | * 26 | * 1) The result is computed even if any of the range checks 27 | * fail. 28 | * 29 | * 2) The sign must be dealt with outside this routine. 30 | * 31 | * P.T.Wallace Starlink November 1984 32 | * 33 | * Copyright (C) 1995 Rutherford Appleton Laboratory 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | INTEGER IHOUR,IMIN 56 | REAL SEC,RAD 57 | INTEGER J 58 | 59 | REAL TURNS 60 | 61 | * Turns to radians 62 | REAL T2R 63 | PARAMETER (T2R=6.283185307179586476925287) 64 | 65 | 66 | 67 | * Convert to turns then radians 68 | CALL sla_CTF2D(IHOUR,IMIN,SEC,TURNS,J) 69 | RAD=T2R*TURNS 70 | 71 | END 72 | -------------------------------------------------------------------------------- /daf2r.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DAF2R (IDEG, IAMIN, ASEC, RAD, J) 2 | *+ 3 | * - - - - - - 4 | * D A F 2 R 5 | * - - - - - - 6 | * 7 | * Convert degrees, arcminutes, arcseconds to radians 8 | * (double precision) 9 | * 10 | * Given: 11 | * IDEG int degrees 12 | * IAMIN int arcminutes 13 | * ASEC dp arcseconds 14 | * 15 | * Returned: 16 | * RAD dp angle in radians 17 | * J int status: 0 = OK 18 | * 1 = IDEG outside range 0-359 19 | * 2 = IAMIN outside range 0-59 20 | * 3 = ASEC outside range 0-59.999... 21 | * 22 | * Notes: 23 | * 1) The result is computed even if any of the range checks 24 | * fail. 25 | * 2) The sign must be dealt with outside this routine. 26 | * 27 | * P.T.Wallace Starlink 23 August 1996 28 | * 29 | * Copyright (C) 1996 Rutherford Appleton Laboratory 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | INTEGER IDEG,IAMIN 52 | DOUBLE PRECISION ASEC,RAD 53 | INTEGER J 54 | 55 | * Arc seconds to radians 56 | DOUBLE PRECISION AS2R 57 | PARAMETER (AS2R=0.484813681109535994D-5) 58 | 59 | 60 | 61 | * Preset status 62 | J=0 63 | 64 | * Validate arcsec, arcmin, deg 65 | IF (ASEC.LT.0D0.OR.ASEC.GE.60D0) J=3 66 | IF (IAMIN.LT.0.OR.IAMIN.GT.59) J=2 67 | IF (IDEG.LT.0.OR.IDEG.GT.359) J=1 68 | 69 | * Compute angle 70 | RAD=AS2R*(60D0*(60D0*DBLE(IDEG)+DBLE(IAMIN))+ASEC) 71 | 72 | END 73 | -------------------------------------------------------------------------------- /dav2m.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DAV2M (AXVEC, RMAT) 2 | *+ 3 | * - - - - - - 4 | * D A V 2 M 5 | * - - - - - - 6 | * 7 | * Form the rotation matrix corresponding to a given axial vector. 8 | * (double precision) 9 | * 10 | * A rotation matrix describes a rotation about some arbitrary axis, 11 | * called the Euler axis. The "axial vector" supplied to this routine 12 | * has the same direction as the Euler axis, and its magnitude is the 13 | * amount of rotation in radians. 14 | * 15 | * Given: 16 | * AXVEC d(3) axial vector (radians) 17 | * 18 | * Returned: 19 | * RMAT d(3,3) rotation matrix 20 | * 21 | * If AXVEC is null, the unit matrix is returned. 22 | * 23 | * The reference frame rotates clockwise as seen looking along 24 | * the axial vector from the origin. 25 | * 26 | * Last revision: 26 November 2005 27 | * 28 | * Copyright P.T.Wallace. All rights reserved. 29 | * 30 | * License: 31 | * This program is free software; you can redistribute it and/or modify 32 | * it under the terms of the GNU General Public License as published by 33 | * the Free Software Foundation; either version 2 of the License, or 34 | * (at your option) any later version. 35 | * 36 | * This program is distributed in the hope that it will be useful, 37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | * GNU General Public License for more details. 40 | * 41 | * You should have received a copy of the GNU General Public License 42 | * along with this program (see SLA_CONDITIONS); if not, write to the 43 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 44 | * Boston, MA 02111-1307 USA 45 | * 46 | *- 47 | 48 | IMPLICIT NONE 49 | 50 | DOUBLE PRECISION AXVEC(3),RMAT(3,3) 51 | 52 | DOUBLE PRECISION X,Y,Z,PHI,S,C,W 53 | 54 | 55 | 56 | * Rotation angle - magnitude of axial vector - and functions 57 | X = AXVEC(1) 58 | Y = AXVEC(2) 59 | Z = AXVEC(3) 60 | PHI = SQRT(X*X+Y*Y+Z*Z) 61 | S = SIN(PHI) 62 | C = COS(PHI) 63 | W = 1D0-C 64 | 65 | * Euler axis - direction of axial vector (perhaps null) 66 | IF (PHI.NE.0D0) THEN 67 | X = X/PHI 68 | Y = Y/PHI 69 | Z = Z/PHI 70 | END IF 71 | 72 | * Compute the rotation matrix 73 | RMAT(1,1) = X*X*W+C 74 | RMAT(1,2) = X*Y*W+Z*S 75 | RMAT(1,3) = X*Z*W-Y*S 76 | RMAT(2,1) = X*Y*W-Z*S 77 | RMAT(2,2) = Y*Y*W+C 78 | RMAT(2,3) = Y*Z*W+X*S 79 | RMAT(3,1) = X*Z*W+Y*S 80 | RMAT(3,2) = Y*Z*W-X*S 81 | RMAT(3,3) = Z*Z*W+C 82 | 83 | END 84 | -------------------------------------------------------------------------------- /dbear.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DBEAR (A1, B1, A2, B2) 2 | *+ 3 | * - - - - - - 4 | * D B E A R 5 | * - - - - - - 6 | * 7 | * Bearing (position angle) of one point on a sphere relative to another 8 | * (double precision) 9 | * 10 | * Given: 11 | * A1,B1 d spherical coordinates of one point 12 | * A2,B2 d spherical coordinates of the other point 13 | * 14 | * (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.) 15 | * 16 | * The result is the bearing (position angle), in radians, of point 17 | * A2,B2 as seen from point A1,B1. It is in the range +/- pi. If 18 | * A2,B2 is due east of A1,B1 the bearing is +pi/2. Zero is returned 19 | * if the two points are coincident. 20 | * 21 | * P.T.Wallace Starlink 23 March 1991 22 | * 23 | * Copyright (C) 1995 Rutherford Appleton Laboratory 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | DOUBLE PRECISION A1,B1,A2,B2 46 | 47 | DOUBLE PRECISION DA,X,Y 48 | 49 | 50 | DA=A2-A1 51 | Y=SIN(DA)*COS(B2) 52 | X=SIN(B2)*COS(B1)-COS(B2)*SIN(B1)*COS(DA) 53 | IF (X.NE.0D0.OR.Y.NE.0D0) THEN 54 | sla_DBEAR=ATAN2(Y,X) 55 | ELSE 56 | sla_DBEAR=0D0 57 | END IF 58 | 59 | END 60 | -------------------------------------------------------------------------------- /dcc2s.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DCC2S (V, A, B) 2 | *+ 3 | * - - - - - - 4 | * D C C 2 S 5 | * - - - - - - 6 | * 7 | * Cartesian to spherical coordinates (double precision) 8 | * 9 | * Given: 10 | * V d(3) x,y,z vector 11 | * 12 | * Returned: 13 | * A,B d spherical coordinates in radians 14 | * 15 | * The spherical coordinates are longitude (+ve anticlockwise looking 16 | * from the +ve latitude pole) and latitude. The Cartesian coordinates 17 | * are right handed, with the x axis at zero longitude and latitude, and 18 | * the z axis at the +ve latitude pole. 19 | * 20 | * If V is null, zero A and B are returned. At either pole, zero A is 21 | * returned. 22 | * 23 | * Last revision: 22 July 2004 24 | * 25 | * Copyright P.T.Wallace. All rights reserved. 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | DOUBLE PRECISION V(3),A,B 48 | 49 | DOUBLE PRECISION X,Y,Z,R 50 | 51 | 52 | X = V(1) 53 | Y = V(2) 54 | Z = V(3) 55 | R = SQRT(X*X+Y*Y) 56 | 57 | IF (R.EQ.0D0) THEN 58 | A = 0D0 59 | ELSE 60 | A = ATAN2(Y,X) 61 | END IF 62 | 63 | IF (Z.EQ.0D0) THEN 64 | B = 0D0 65 | ELSE 66 | B = ATAN2(Z,R) 67 | END IF 68 | 69 | END 70 | -------------------------------------------------------------------------------- /dcs2c.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DCS2C (A, B, V) 2 | *+ 3 | * - - - - - - 4 | * D C S 2 C 5 | * - - - - - - 6 | * 7 | * Spherical coordinates to direction cosines (double precision) 8 | * 9 | * Given: 10 | * A,B d spherical coordinates in radians 11 | * (RA,Dec), (long,lat) etc. 12 | * 13 | * Returned: 14 | * V d(3) x,y,z unit vector 15 | * 16 | * The spherical coordinates are longitude (+ve anticlockwise looking 17 | * from the +ve latitude pole) and latitude. The Cartesian coordinates 18 | * are right handed, with the x axis at zero longitude and latitude, and 19 | * the z axis at the +ve latitude pole. 20 | * 21 | * Last revision: 26 December 2004 22 | * 23 | * Copyright P.T.Wallace. All rights reserved. 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | DOUBLE PRECISION A,B,V(3) 46 | 47 | DOUBLE PRECISION COSB 48 | 49 | 50 | COSB = COS(B) 51 | 52 | V(1) = COS(A)*COSB 53 | V(2) = SIN(A)*COSB 54 | V(3) = SIN(B) 55 | 56 | END 57 | -------------------------------------------------------------------------------- /dimxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DIMXV (DM, VA, VB) 2 | *+ 3 | * - - - - - - 4 | * D I M X V 5 | * - - - - - - 6 | * 7 | * Performs the 3-D backward unitary transformation: 8 | * 9 | * vector VB = (inverse of matrix DM) * vector VA 10 | * 11 | * (double precision) 12 | * 13 | * (n.b. the matrix must be unitary, as this routine assumes that 14 | * the inverse and transpose are identical) 15 | * 16 | * Given: 17 | * DM dp(3,3) matrix 18 | * VA dp(3) vector 19 | * 20 | * Returned: 21 | * VB dp(3) result vector 22 | * 23 | * P.T.Wallace Starlink March 1986 24 | * 25 | * Copyright (C) 1995 Rutherford Appleton Laboratory 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | DOUBLE PRECISION DM(3,3),VA(3),VB(3) 48 | 49 | INTEGER I,J 50 | DOUBLE PRECISION W,VW(3) 51 | 52 | 53 | 54 | * Inverse of matrix DM * vector VA -> vector VW 55 | DO J=1,3 56 | W=0D0 57 | DO I=1,3 58 | W=W+DM(I,J)*VA(I) 59 | END DO 60 | VW(J)=W 61 | END DO 62 | 63 | * Vector VW -> vector VB 64 | DO J=1,3 65 | VB(J)=VW(J) 66 | END DO 67 | 68 | END 69 | -------------------------------------------------------------------------------- /djcal.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DJCAL (NDP, DJM, IYMDF, J) 2 | *+ 3 | * - - - - - - 4 | * D J C A L 5 | * - - - - - - 6 | * 7 | * Modified Julian Date to Gregorian Calendar, expressed 8 | * in a form convenient for formatting messages (namely 9 | * rounded to a specified precision, and with the fields 10 | * stored in a single array) 11 | * 12 | * Given: 13 | * NDP i number of decimal places of days in fraction 14 | * DJM d modified Julian Date (JD-2400000.5) 15 | * 16 | * Returned: 17 | * IYMDF i(4) year, month, day, fraction in Gregorian 18 | * calendar 19 | * J i status: nonzero = out of range 20 | * 21 | * Any date after 4701BC March 1 is accepted. 22 | * 23 | * NDP should be 4 or less if internal overflows are to be avoided 24 | * on machines which use 32-bit integers. 25 | * 26 | * The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55). 27 | * 28 | * Last revision: 22 July 2004 29 | * 30 | * Copyright P.T.Wallace. All rights reserved. 31 | * 32 | * License: 33 | * This program is free software; you can redistribute it and/or modify 34 | * it under the terms of the GNU General Public License as published by 35 | * the Free Software Foundation; either version 2 of the License, or 36 | * (at your option) any later version. 37 | * 38 | * This program is distributed in the hope that it will be useful, 39 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 40 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 41 | * GNU General Public License for more details. 42 | * 43 | * You should have received a copy of the GNU General Public License 44 | * along with this program (see SLA_CONDITIONS); if not, write to the 45 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 46 | * Boston, MA 02111-1307 USA 47 | * 48 | *- 49 | 50 | IMPLICIT NONE 51 | 52 | INTEGER NDP 53 | DOUBLE PRECISION DJM 54 | INTEGER IYMDF(4),J 55 | 56 | INTEGER NFD 57 | DOUBLE PRECISION FD,DF,F,D 58 | INTEGER JD,N4,ND10 59 | 60 | 61 | * Validate. 62 | IF ( DJM.LE.-2395520D0 .OR. DJM.GE.1D9 ) THEN 63 | J = -1 64 | ELSE 65 | J = 0 66 | 67 | * Denominator of fraction. 68 | NFD = 10**MAX(NDP,0) 69 | FD = DBLE(NFD) 70 | 71 | * Round date and express in units of fraction. 72 | DF = ANINT(DJM*FD) 73 | 74 | * Separate day and fraction. 75 | F = MOD(DF,FD) 76 | IF (F.LT.0D0) F = F+FD 77 | D = (DF-F)/FD 78 | 79 | * Express day in Gregorian calendar. 80 | JD = NINT(D)+2400001 81 | 82 | N4 = 4*(JD+((2*((4*JD-17918)/146097)*3)/4+1)/2-37) 83 | ND10 = 10*(MOD(N4-237,1461)/4)+5 84 | 85 | IYMDF(1) = N4/1461-4712 86 | IYMDF(2) = MOD(ND10/306+2,12)+1 87 | IYMDF(3) = MOD(ND10,306)/10+1 88 | IYMDF(4) = NINT(F) 89 | 90 | END IF 91 | 92 | END 93 | -------------------------------------------------------------------------------- /djcl.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DJCL (DJM, IY, IM, ID, FD, J) 2 | *+ 3 | * - - - - - 4 | * D J C L 5 | * - - - - - 6 | * 7 | * Modified Julian Date to Gregorian year, month, day, 8 | * and fraction of a day. 9 | * 10 | * Given: 11 | * DJM dp modified Julian Date (JD-2400000.5) 12 | * 13 | * Returned: 14 | * IY int year 15 | * IM int month 16 | * ID int day 17 | * FD dp fraction of day 18 | * J int status: 19 | * 0 = OK 20 | * -1 = unacceptable date (before 4701BC March 1) 21 | * 22 | * The algorithm is adapted from Hatcher 1984 (QJRAS 25, 53-55). 23 | * 24 | * Last revision: 22 July 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | DOUBLE PRECISION DJM 49 | INTEGER IY,IM,ID 50 | DOUBLE PRECISION FD 51 | INTEGER J 52 | 53 | DOUBLE PRECISION F,D 54 | INTEGER JD,N4,ND10 55 | 56 | 57 | * Check if date is acceptable. 58 | IF ( DJM.LE.-2395520D0 .OR. DJM.GE.1D9 ) THEN 59 | J = -1 60 | ELSE 61 | J = 0 62 | 63 | * Separate day and fraction. 64 | F = MOD(DJM,1D0) 65 | IF (F.LT.0D0) F = F+1D0 66 | D = ANINT(DJM-F) 67 | 68 | * Express day in Gregorian calendar. 69 | JD = NINT(D)+2400001 70 | 71 | N4 = 4*(JD+((6*((4*JD-17918)/146097))/4+1)/2-37) 72 | ND10 = 10*(MOD(N4-237,1461)/4)+5 73 | 74 | IY = N4/1461-4712 75 | IM = MOD(ND10/306+2,12)+1 76 | ID = MOD(ND10,306)/10+1 77 | FD = F 78 | 79 | J=0 80 | 81 | END IF 82 | 83 | END 84 | -------------------------------------------------------------------------------- /dm2av.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DM2AV (RMAT, AXVEC) 2 | *+ 3 | * - - - - - - 4 | * D M 2 A V 5 | * - - - - - - 6 | * 7 | * From a rotation matrix, determine the corresponding axial vector. 8 | * (double precision) 9 | * 10 | * A rotation matrix describes a rotation about some arbitrary axis, 11 | * called the Euler axis. The "axial vector" returned by this routine 12 | * has the same direction as the Euler axis, and its magnitude is the 13 | * amount of rotation in radians. (The magnitude and direction can be 14 | * separated by means of the routine sla_DVN.) 15 | * 16 | * Given: 17 | * RMAT d(3,3) rotation matrix 18 | * 19 | * Returned: 20 | * AXVEC d(3) axial vector (radians) 21 | * 22 | * The reference frame rotates clockwise as seen looking along 23 | * the axial vector from the origin. 24 | * 25 | * If RMAT is null, so is the result. 26 | * 27 | * Last revision: 26 November 2005 28 | * 29 | * Copyright P.T.Wallace. All rights reserved. 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | DOUBLE PRECISION RMAT(3,3),AXVEC(3) 52 | 53 | DOUBLE PRECISION X,Y,Z,S2,C2,PHI,F 54 | 55 | 56 | 57 | X = RMAT(2,3)-RMAT(3,2) 58 | Y = RMAT(3,1)-RMAT(1,3) 59 | Z = RMAT(1,2)-RMAT(2,1) 60 | S2 = SQRT(X*X+Y*Y+Z*Z) 61 | IF (S2.NE.0D0) THEN 62 | C2 = RMAT(1,1)+RMAT(2,2)+RMAT(3,3)-1D0 63 | PHI = ATAN2(S2,C2) 64 | F = PHI/S2 65 | AXVEC(1) = X*F 66 | AXVEC(2) = Y*F 67 | AXVEC(3) = Z*F 68 | ELSE 69 | AXVEC(1) = 0D0 70 | AXVEC(2) = 0D0 71 | AXVEC(3) = 0D0 72 | END IF 73 | 74 | END 75 | -------------------------------------------------------------------------------- /dmxm.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DMXM (A, B, C) 2 | *+ 3 | * - - - - - 4 | * D M X M 5 | * - - - - - 6 | * 7 | * Product of two 3x3 matrices: 8 | * 9 | * matrix C = matrix A x matrix B 10 | * 11 | * (double precision) 12 | * 13 | * Given: 14 | * A dp(3,3) matrix 15 | * B dp(3,3) matrix 16 | * 17 | * Returned: 18 | * C dp(3,3) matrix result 19 | * 20 | * To comply with the ANSI Fortran 77 standard, A, B and C must 21 | * be different arrays. However, the routine is coded so as to 22 | * work properly on many platforms even if this rule is violated. 23 | * 24 | * Last revision: 26 December 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | DOUBLE PRECISION A(3,3),B(3,3),C(3,3) 49 | 50 | INTEGER I,J,K 51 | DOUBLE PRECISION W,WM(3,3) 52 | 53 | 54 | * Multiply into scratch matrix 55 | DO I=1,3 56 | DO J=1,3 57 | W=0D0 58 | DO K=1,3 59 | W=W+A(I,K)*B(K,J) 60 | END DO 61 | WM(I,J)=W 62 | END DO 63 | END DO 64 | 65 | * Return the result 66 | DO J=1,3 67 | DO I=1,3 68 | C(I,J)=WM(I,J) 69 | END DO 70 | END DO 71 | 72 | END 73 | -------------------------------------------------------------------------------- /dmxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DMXV (DM, VA, VB) 2 | *+ 3 | * - - - - - 4 | * D M X V 5 | * - - - - - 6 | * 7 | * Performs the 3-D forward unitary transformation: 8 | * 9 | * vector VB = matrix DM * vector VA 10 | * 11 | * (double precision) 12 | * 13 | * Given: 14 | * DM dp(3,3) matrix 15 | * VA dp(3) vector 16 | * 17 | * Returned: 18 | * VB dp(3) result vector 19 | * 20 | * To comply with the ANSI Fortran 77 standard, VA and VB must be 21 | * different arrays. However, the routine is coded so as to work 22 | * properly on many platforms even if this rule is violated. 23 | * 24 | * Last revision: 26 December 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | DOUBLE PRECISION DM(3,3),VA(3),VB(3) 49 | 50 | INTEGER I,J 51 | DOUBLE PRECISION W,VW(3) 52 | 53 | 54 | * Matrix DM * vector VA -> vector VW 55 | DO J=1,3 56 | W=0D0 57 | DO I=1,3 58 | W=W+DM(J,I)*VA(I) 59 | END DO 60 | VW(J)=W 61 | END DO 62 | 63 | * Vector VW -> vector VB 64 | DO J=1,3 65 | VB(J)=VW(J) 66 | END DO 67 | 68 | END 69 | -------------------------------------------------------------------------------- /dpav.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DPAV ( V1, V2 ) 2 | *+ 3 | * - - - - - 4 | * D P A V 5 | * - - - - - 6 | * 7 | * Position angle of one celestial direction with respect to another. 8 | * 9 | * (double precision) 10 | * 11 | * Given: 12 | * V1 d(3) direction cosines of one point 13 | * V2 d(3) direction cosines of the other point 14 | * 15 | * (The coordinate frames correspond to RA,Dec, Long,Lat etc.) 16 | * 17 | * The result is the bearing (position angle), in radians, of point 18 | * V2 with respect to point V1. It is in the range +/- pi. The 19 | * sense is such that if V2 is a small distance east of V1, the 20 | * bearing is about +pi/2. Zero is returned if the two points 21 | * are coincident. 22 | * 23 | * V1 and V2 need not be unit vectors. 24 | * 25 | * The routine sla_DBEAR performs an equivalent function except 26 | * that the points are specified in the form of spherical 27 | * coordinates. 28 | * 29 | * Last revision: 16 March 2005 30 | * 31 | * Copyright P.T.Wallace. All rights reserved. 32 | * 33 | * License: 34 | * This program is free software; you can redistribute it and/or modify 35 | * it under the terms of the GNU General Public License as published by 36 | * the Free Software Foundation; either version 2 of the License, or 37 | * (at your option) any later version. 38 | * 39 | * This program is distributed in the hope that it will be useful, 40 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 41 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 42 | * GNU General Public License for more details. 43 | * 44 | * You should have received a copy of the GNU General Public License 45 | * along with this program (see SLA_CONDITIONS); if not, write to the 46 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 47 | * Boston, MA 02111-1307 USA 48 | * 49 | *- 50 | 51 | IMPLICIT NONE 52 | 53 | DOUBLE PRECISION V1(3),V2(3) 54 | 55 | DOUBLE PRECISION X1,Y1,Z1,W,X2,Y2,Z2,SQ,CQ 56 | 57 | 58 | 59 | * The unit vector to point 1. 60 | X1 = V1(1) 61 | Y1 = V1(2) 62 | Z1 = V1(3) 63 | W = SQRT(X1*X1+Y1*Y1+Z1*Z1) 64 | IF (W.NE.0D0) THEN 65 | X1 = X1/W 66 | Y1 = Y1/W 67 | Z1 = Z1/W 68 | END IF 69 | 70 | * The vector to point 2. 71 | X2 = V2(1) 72 | Y2 = V2(2) 73 | Z2 = V2(3) 74 | 75 | * Position angle. 76 | SQ = Y2*X1-X2*Y1 77 | CQ = Z2*(X1*X1+Y1*Y1)-Z1*(X2*X1+Y2*Y1) 78 | IF (SQ.EQ.0D0.AND.CQ.EQ.0D0) CQ=1D0 79 | sla_DPAV = ATAN2(SQ,CQ) 80 | 81 | END 82 | -------------------------------------------------------------------------------- /dr2af.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DR2AF (NDP, ANGLE, SIGN, IDMSF) 2 | *+ 3 | * - - - - - - 4 | * D R 2 A F 5 | * - - - - - - 6 | * 7 | * Convert an angle in radians to degrees, arcminutes, arcseconds 8 | * (double precision) 9 | * 10 | * Given: 11 | * NDP i number of decimal places of arcseconds 12 | * ANGLE d angle in radians 13 | * 14 | * Returned: 15 | * SIGN c '+' or '-' 16 | * IDMSF i(4) degrees, arcminutes, arcseconds, fraction 17 | * 18 | * Notes: 19 | * 20 | * 1) NDP less than zero is interpreted as zero. 21 | * 22 | * 2) The largest useful value for NDP is determined by the size 23 | * of ANGLE, the format of DOUBLE PRECISION floating-point 24 | * numbers on the target machine, and the risk of overflowing 25 | * IDMSF(4). On some architectures, for ANGLE up to 2pi, the 26 | * available floating-point precision corresponds roughly to 27 | * NDP=12. However, the practical limit is NDP=9, set by the 28 | * capacity of a typical 32-bit IDMSF(4). 29 | * 30 | * 3) The absolute value of ANGLE may exceed 2pi. In cases where it 31 | * does not, it is up to the caller to test for and handle the 32 | * case where ANGLE is very nearly 2pi and rounds up to 360 deg, 33 | * by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero. 34 | * 35 | * Called: sla_DD2TF 36 | * 37 | * Last revision: 26 December 2004 38 | * 39 | * Copyright P.T.Wallace. All rights reserved. 40 | * 41 | * License: 42 | * This program is free software; you can redistribute it and/or modify 43 | * it under the terms of the GNU General Public License as published by 44 | * the Free Software Foundation; either version 2 of the License, or 45 | * (at your option) any later version. 46 | * 47 | * This program is distributed in the hope that it will be useful, 48 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 49 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 50 | * GNU General Public License for more details. 51 | * 52 | * You should have received a copy of the GNU General Public License 53 | * along with this program (see SLA_CONDITIONS); if not, write to the 54 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 55 | * Boston, MA 02111-1307 USA 56 | * 57 | *- 58 | 59 | IMPLICIT NONE 60 | 61 | INTEGER NDP 62 | DOUBLE PRECISION ANGLE 63 | CHARACTER SIGN*(*) 64 | INTEGER IDMSF(4) 65 | 66 | * Hours to degrees * radians to turns 67 | DOUBLE PRECISION F 68 | PARAMETER (F=15D0/6.283185307179586476925287D0) 69 | 70 | 71 | 72 | * Scale then use days to h,m,s routine 73 | CALL sla_DD2TF(NDP,ANGLE*F,SIGN,IDMSF) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /dr2tf.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DR2TF (NDP, ANGLE, SIGN, IHMSF) 2 | *+ 3 | * - - - - - - 4 | * D R 2 T F 5 | * - - - - - - 6 | * 7 | * Convert an angle in radians to hours, minutes, seconds 8 | * (double precision) 9 | * 10 | * Given: 11 | * NDP i number of decimal places of seconds 12 | * ANGLE d angle in radians 13 | * 14 | * Returned: 15 | * SIGN c '+' or '-' 16 | * IHMSF i(4) hours, minutes, seconds, fraction 17 | * 18 | * Notes: 19 | * 20 | * 1) NDP less than zero is interpreted as zero. 21 | * 22 | * 2) The largest useful value for NDP is determined by the size 23 | * of ANGLE, the format of DOUBLE PRECISION floating-point 24 | * numbers on the target machine, and the risk of overflowing 25 | * IHMSF(4). On some architectures, for ANGLE up to 2pi, the 26 | * available floating-point precision corresponds roughly to 27 | * NDP=12. However, the practical limit is NDP=9, set by the 28 | * capacity of a typical 32-bit IHMSF(4). 29 | * 30 | * 3) The absolute value of ANGLE may exceed 2pi. In cases where it 31 | * does not, it is up to the caller to test for and handle the 32 | * case where ANGLE is very nearly 2pi and rounds up to 24 hours, 33 | * by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero. 34 | * 35 | * Called: sla_DD2TF 36 | * 37 | * Last revision: 26 December 2004 38 | * 39 | * Copyright P.T.Wallace. All rights reserved. 40 | * 41 | * License: 42 | * This program is free software; you can redistribute it and/or modify 43 | * it under the terms of the GNU General Public License as published by 44 | * the Free Software Foundation; either version 2 of the License, or 45 | * (at your option) any later version. 46 | * 47 | * This program is distributed in the hope that it will be useful, 48 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 49 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 50 | * GNU General Public License for more details. 51 | * 52 | * You should have received a copy of the GNU General Public License 53 | * along with this program (see SLA_CONDITIONS); if not, write to the 54 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 55 | * Boston, MA 02111-1307 USA 56 | * 57 | *- 58 | 59 | IMPLICIT NONE 60 | 61 | INTEGER NDP 62 | DOUBLE PRECISION ANGLE 63 | CHARACTER SIGN*(*) 64 | INTEGER IHMSF(4) 65 | 66 | * Turns to radians 67 | DOUBLE PRECISION T2R 68 | PARAMETER (T2R=6.283185307179586476925287D0) 69 | 70 | 71 | 72 | * Scale then use days to h,m,s routine 73 | CALL sla_DD2TF(NDP,ANGLE/T2R,SIGN,IHMSF) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /drange.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DRANGE (ANGLE) 2 | *+ 3 | * - - - - - - - 4 | * D R A N G E 5 | * - - - - - - - 6 | * 7 | * Normalize angle into range +/- pi (double precision) 8 | * 9 | * Given: 10 | * ANGLE dp the angle in radians 11 | * 12 | * The result (double precision) is ANGLE expressed in the range +/- pi. 13 | * 14 | * P.T.Wallace Starlink 23 November 1995 15 | * 16 | * Copyright (C) 1995 Rutherford Appleton Laboratory 17 | * 18 | * License: 19 | * This program is free software; you can redistribute it and/or modify 20 | * it under the terms of the GNU General Public License as published by 21 | * the Free Software Foundation; either version 2 of the License, or 22 | * (at your option) any later version. 23 | * 24 | * This program is distributed in the hope that it will be useful, 25 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 26 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 27 | * GNU General Public License for more details. 28 | * 29 | * You should have received a copy of the GNU General Public License 30 | * along with this program (see SLA_CONDITIONS); if not, write to the 31 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 32 | * Boston, MA 02111-1307 USA 33 | * 34 | *- 35 | 36 | IMPLICIT NONE 37 | 38 | DOUBLE PRECISION ANGLE 39 | 40 | DOUBLE PRECISION DPI,D2PI 41 | PARAMETER (DPI=3.141592653589793238462643D0) 42 | PARAMETER (D2PI=6.283185307179586476925287D0) 43 | 44 | 45 | sla_DRANGE=MOD(ANGLE,D2PI) 46 | IF (ABS(sla_DRANGE).GE.DPI) 47 | : sla_DRANGE=sla_DRANGE-SIGN(D2PI,ANGLE) 48 | 49 | END 50 | -------------------------------------------------------------------------------- /dranrm.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DRANRM (ANGLE) 2 | *+ 3 | * - - - - - - - 4 | * D R A N R M 5 | * - - - - - - - 6 | * 7 | * Normalize angle into range 0-2 pi (double precision) 8 | * 9 | * Given: 10 | * ANGLE dp the angle in radians 11 | * 12 | * The result is ANGLE expressed in the range 0-2 pi. 13 | * 14 | * Last revision: 22 July 2004 15 | * 16 | * Copyright P.T.Wallace. All rights reserved. 17 | * 18 | * License: 19 | * This program is free software; you can redistribute it and/or modify 20 | * it under the terms of the GNU General Public License as published by 21 | * the Free Software Foundation; either version 2 of the License, or 22 | * (at your option) any later version. 23 | * 24 | * This program is distributed in the hope that it will be useful, 25 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 26 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 27 | * GNU General Public License for more details. 28 | * 29 | * You should have received a copy of the GNU General Public License 30 | * along with this program (see SLA_CONDITIONS); if not, write to the 31 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 32 | * Boston, MA 02111-1307 USA 33 | * 34 | *- 35 | 36 | IMPLICIT NONE 37 | 38 | DOUBLE PRECISION ANGLE 39 | 40 | DOUBLE PRECISION D2PI 41 | PARAMETER (D2PI=6.283185307179586476925286766559D0) 42 | 43 | 44 | sla_DRANRM = MOD(ANGLE,D2PI) 45 | IF (sla_DRANRM.LT.0D0) sla_DRANRM = sla_DRANRM+D2PI 46 | 47 | END 48 | -------------------------------------------------------------------------------- /ds2c6.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DS2C6 (A, B, R, AD, BD, RD, V) 2 | *+ 3 | * - - - - - - 4 | * D S 2 C 6 5 | * - - - - - - 6 | * 7 | * Conversion of position & velocity in spherical coordinates 8 | * to Cartesian coordinates 9 | * 10 | * (double precision) 11 | * 12 | * Given: 13 | * A dp longitude (radians) 14 | * B dp latitude (radians) 15 | * R dp radial coordinate 16 | * AD dp longitude derivative (radians per unit time) 17 | * BD dp latitude derivative (radians per unit time) 18 | * RD dp radial derivative 19 | * 20 | * Returned: 21 | * V dp(6) Cartesian position & velocity vector 22 | * 23 | * P.T.Wallace Starlink 10 July 1993 24 | * 25 | * Copyright (C) 1995 Rutherford Appleton Laboratory 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | DOUBLE PRECISION A,B,R,AD,BD,RD,V(6) 48 | 49 | DOUBLE PRECISION SA,CA,SB,CB,RCB,X,Y,RBD,W 50 | 51 | 52 | 53 | * Useful functions 54 | SA=SIN(A) 55 | CA=COS(A) 56 | SB=SIN(B) 57 | CB=COS(B) 58 | RCB=R*CB 59 | X=RCB*CA 60 | Y=RCB*SA 61 | RBD=R*BD 62 | W=RBD*SB-CB*RD 63 | 64 | * Position 65 | V(1)=X 66 | V(2)=Y 67 | V(3)=R*SB 68 | 69 | * Velocity 70 | V(4)=-Y*AD-W*CA 71 | V(5)=X*AD-W*SA 72 | V(6)=RBD*CB+SB*RD 73 | 74 | END 75 | -------------------------------------------------------------------------------- /ds2tp.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DS2TP (RA, DEC, RAZ, DECZ, XI, ETA, J) 2 | *+ 3 | * - - - - - - 4 | * D S 2 T P 5 | * - - - - - - 6 | * 7 | * Projection of spherical coordinates onto tangent plane: 8 | * "gnomonic" projection - "standard coordinates" (double precision) 9 | * 10 | * Given: 11 | * RA,DEC dp spherical coordinates of point to be projected 12 | * RAZ,DECZ dp spherical coordinates of tangent point 13 | * 14 | * Returned: 15 | * XI,ETA dp rectangular coordinates on tangent plane 16 | * J int status: 0 = OK, star on tangent plane 17 | * 1 = error, star too far from axis 18 | * 2 = error, antistar on tangent plane 19 | * 3 = error, antistar too far from axis 20 | * 21 | * P.T.Wallace Starlink 18 July 1996 22 | * 23 | * Copyright (C) 1996 Rutherford Appleton Laboratory 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | DOUBLE PRECISION RA,DEC,RAZ,DECZ,XI,ETA 46 | INTEGER J 47 | 48 | DOUBLE PRECISION SDECZ,SDEC,CDECZ,CDEC, 49 | : RADIF,SRADIF,CRADIF,DENOM 50 | 51 | DOUBLE PRECISION TINY 52 | PARAMETER (TINY=1D-6) 53 | 54 | 55 | * Trig functions 56 | SDECZ=SIN(DECZ) 57 | SDEC=SIN(DEC) 58 | CDECZ=COS(DECZ) 59 | CDEC=COS(DEC) 60 | RADIF=RA-RAZ 61 | SRADIF=SIN(RADIF) 62 | CRADIF=COS(RADIF) 63 | 64 | * Reciprocal of star vector length to tangent plane 65 | DENOM=SDEC*SDECZ+CDEC*CDECZ*CRADIF 66 | 67 | * Handle vectors too far from axis 68 | IF (DENOM.GT.TINY) THEN 69 | J=0 70 | ELSE IF (DENOM.GE.0D0) THEN 71 | J=1 72 | DENOM=TINY 73 | ELSE IF (DENOM.GT.-TINY) THEN 74 | J=2 75 | DENOM=-TINY 76 | ELSE 77 | J=3 78 | END IF 79 | 80 | * Compute tangent plane coordinates (even in dubious cases) 81 | XI=CDEC*SRADIF/DENOM 82 | ETA=(SDEC*CDECZ-CDEC*SDECZ*CRADIF)/DENOM 83 | 84 | END 85 | -------------------------------------------------------------------------------- /dsep.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DSEP (A1, B1, A2, B2) 2 | *+ 3 | * - - - - - 4 | * D S E P 5 | * - - - - - 6 | * 7 | * Angle between two points on a sphere. 8 | * 9 | * (double precision) 10 | * 11 | * Given: 12 | * A1,B1 d spherical coordinates of one point 13 | * A2,B2 d spherical coordinates of the other point 14 | * 15 | * (The spherical coordinates are [RA,Dec], [Long,Lat] etc, in radians.) 16 | * 17 | * The result is the angle, in radians, between the two points. It 18 | * is always positive. 19 | * 20 | * Called: sla_DCS2C, sla_DSEPV 21 | * 22 | * Last revision: 7 May 2000 23 | * 24 | * Copyright P.T.Wallace. All rights reserved. 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | DOUBLE PRECISION A1,B1,A2,B2 47 | 48 | DOUBLE PRECISION V1(3),V2(3) 49 | DOUBLE PRECISION sla_DSEPV 50 | 51 | 52 | 53 | * Convert coordinates from spherical to Cartesian. 54 | CALL sla_DCS2C(A1,B1,V1) 55 | CALL sla_DCS2C(A2,B2,V2) 56 | 57 | * Angle between the vectors. 58 | sla_DSEP = sla_DSEPV(V1,V2) 59 | 60 | END 61 | -------------------------------------------------------------------------------- /dsepv.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DSEPV (V1, V2) 2 | *+ 3 | * - - - - - - 4 | * D S E P V 5 | * - - - - - - 6 | * 7 | * Angle between two vectors. 8 | * 9 | * (double precision) 10 | * 11 | * Given: 12 | * V1 d(3) first vector 13 | * V2 d(3) second vector 14 | * 15 | * The result is the angle, in radians, between the two vectors. It 16 | * is always positive. 17 | * 18 | * Notes: 19 | * 20 | * 1 There is no requirement for the vectors to be unit length. 21 | * 22 | * 2 If either vector is null, zero is returned. 23 | * 24 | * 3 The simplest formulation would use dot product alone. However, 25 | * this would reduce the accuracy for angles near zero and pi. The 26 | * algorithm uses both cross product and dot product, which maintains 27 | * accuracy for all sizes of angle. 28 | * 29 | * Called: sla_DVXV, sla_DVN, sla_DVDV 30 | * 31 | * Last revision: 14 June 2005 32 | * 33 | * Copyright P.T.Wallace. All rights reserved. 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | DOUBLE PRECISION V1(3),V2(3) 56 | 57 | DOUBLE PRECISION V1XV2(3),WV(3),S,C 58 | DOUBLE PRECISION sla_DVDV 59 | 60 | 61 | 62 | * Modulus of cross product = sine multiplied by the two moduli. 63 | CALL sla_DVXV(V1,V2,V1XV2) 64 | CALL sla_DVN(V1XV2,WV,S) 65 | 66 | * Dot product = cosine multiplied by the two moduli. 67 | C = sla_DVDV(V1,V2) 68 | 69 | * Angle between the vectors. 70 | IF ( S.NE.0D0 .OR. C.NE.0D0 ) THEN 71 | sla_DSEPV = ATAN2(S,C) 72 | ELSE 73 | sla_DSEPV = 0D0 74 | END IF 75 | 76 | END 77 | -------------------------------------------------------------------------------- /dtf2d.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DTF2D (IHOUR, IMIN, SEC, DAYS, J) 2 | *+ 3 | * - - - - - - 4 | * D T F 2 D 5 | * - - - - - - 6 | * 7 | * Convert hours, minutes, seconds to days (double precision) 8 | * 9 | * Given: 10 | * IHOUR int hours 11 | * IMIN int minutes 12 | * SEC dp seconds 13 | * 14 | * Returned: 15 | * DAYS dp interval in days 16 | * J int status: 0 = OK 17 | * 1 = IHOUR outside range 0-23 18 | * 2 = IMIN outside range 0-59 19 | * 3 = SEC outside range 0-59.999... 20 | * 21 | * Notes: 22 | * 23 | * 1) The result is computed even if any of the range checks fail. 24 | * 25 | * 2) The sign must be dealt with outside this routine. 26 | * 27 | * P.T.Wallace Starlink July 1984 28 | * 29 | * Copyright (C) 1995 Rutherford Appleton Laboratory 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | INTEGER IHOUR,IMIN 52 | DOUBLE PRECISION SEC,DAYS 53 | INTEGER J 54 | 55 | * Seconds per day 56 | DOUBLE PRECISION D2S 57 | PARAMETER (D2S=86400D0) 58 | 59 | 60 | 61 | * Preset status 62 | J=0 63 | 64 | * Validate sec, min, hour 65 | IF (SEC.LT.0D0.OR.SEC.GE.60D0) J=3 66 | IF (IMIN.LT.0.OR.IMIN.GT.59) J=2 67 | IF (IHOUR.LT.0.OR.IHOUR.GT.23) J=1 68 | 69 | * Compute interval 70 | DAYS=(60D0*(60D0*DBLE(IHOUR)+DBLE(IMIN))+SEC)/D2S 71 | 72 | END 73 | -------------------------------------------------------------------------------- /dtf2r.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DTF2R (IHOUR, IMIN, SEC, RAD, J) 2 | *+ 3 | * - - - - - - 4 | * D T F 2 R 5 | * - - - - - - 6 | * 7 | * Convert hours, minutes, seconds to radians (double precision) 8 | * 9 | * Given: 10 | * IHOUR int hours 11 | * IMIN int minutes 12 | * SEC dp seconds 13 | * 14 | * Returned: 15 | * RAD dp angle in radians 16 | * J int status: 0 = OK 17 | * 1 = IHOUR outside range 0-23 18 | * 2 = IMIN outside range 0-59 19 | * 3 = SEC outside range 0-59.999... 20 | * 21 | * Called: 22 | * sla_DTF2D 23 | * 24 | * Notes: 25 | * 26 | * 1) The result is computed even if any of the range checks fail. 27 | * 28 | * 2) The sign must be dealt with outside this routine. 29 | * 30 | * P.T.Wallace Starlink July 1984 31 | * 32 | * Copyright (C) 1995 Rutherford Appleton Laboratory 33 | * 34 | * License: 35 | * This program is free software; you can redistribute it and/or modify 36 | * it under the terms of the GNU General Public License as published by 37 | * the Free Software Foundation; either version 2 of the License, or 38 | * (at your option) any later version. 39 | * 40 | * This program is distributed in the hope that it will be useful, 41 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 42 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 43 | * GNU General Public License for more details. 44 | * 45 | * You should have received a copy of the GNU General Public License 46 | * along with this program (see SLA_CONDITIONS); if not, write to the 47 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 48 | * Boston, MA 02111-1307 USA 49 | * 50 | *- 51 | 52 | IMPLICIT NONE 53 | 54 | INTEGER IHOUR,IMIN 55 | DOUBLE PRECISION SEC,RAD 56 | INTEGER J 57 | 58 | DOUBLE PRECISION TURNS 59 | 60 | * Turns to radians 61 | DOUBLE PRECISION T2R 62 | PARAMETER (T2R=6.283185307179586476925287D0) 63 | 64 | 65 | 66 | * Convert to turns then radians 67 | CALL sla_DTF2D(IHOUR,IMIN,SEC,TURNS,J) 68 | RAD=T2R*TURNS 69 | 70 | END 71 | -------------------------------------------------------------------------------- /dtp2s.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DTP2S (XI, ETA, RAZ, DECZ, RA, DEC) 2 | *+ 3 | * - - - - - - 4 | * D T P 2 S 5 | * - - - - - - 6 | * 7 | * Transform tangent plane coordinates into spherical 8 | * (double precision) 9 | * 10 | * Given: 11 | * XI,ETA dp tangent plane rectangular coordinates 12 | * RAZ,DECZ dp spherical coordinates of tangent point 13 | * 14 | * Returned: 15 | * RA,DEC dp spherical coordinates (0-2pi,+/-pi/2) 16 | * 17 | * Called: sla_DRANRM 18 | * 19 | * P.T.Wallace Starlink 24 July 1995 20 | * 21 | * Copyright (C) 1995 Rutherford Appleton Laboratory 22 | * 23 | * License: 24 | * This program is free software; you can redistribute it and/or modify 25 | * it under the terms of the GNU General Public License as published by 26 | * the Free Software Foundation; either version 2 of the License, or 27 | * (at your option) any later version. 28 | * 29 | * This program is distributed in the hope that it will be useful, 30 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 31 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32 | * GNU General Public License for more details. 33 | * 34 | * You should have received a copy of the GNU General Public License 35 | * along with this program (see SLA_CONDITIONS); if not, write to the 36 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 37 | * Boston, MA 02111-1307 USA 38 | * 39 | *- 40 | 41 | IMPLICIT NONE 42 | 43 | DOUBLE PRECISION XI,ETA,RAZ,DECZ,RA,DEC 44 | 45 | DOUBLE PRECISION sla_DRANRM 46 | 47 | DOUBLE PRECISION SDECZ,CDECZ,DENOM 48 | 49 | 50 | 51 | SDECZ=SIN(DECZ) 52 | CDECZ=COS(DECZ) 53 | 54 | DENOM=CDECZ-ETA*SDECZ 55 | 56 | RA=sla_DRANRM(ATAN2(XI,DENOM)+RAZ) 57 | DEC=ATAN2(SDECZ+ETA*CDECZ,SQRT(XI*XI+DENOM*DENOM)) 58 | 59 | END 60 | -------------------------------------------------------------------------------- /dtp2v.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DTP2V (XI, ETA, V0, V) 2 | *+ 3 | * - - - - - - 4 | * D T P 2 V 5 | * - - - - - - 6 | * 7 | * Given the tangent-plane coordinates of a star and the direction 8 | * cosines of the tangent point, determine the direction cosines 9 | * of the star. 10 | * 11 | * (double precision) 12 | * 13 | * Given: 14 | * XI,ETA d tangent plane coordinates of star 15 | * V0 d(3) direction cosines of tangent point 16 | * 17 | * Returned: 18 | * V d(3) direction cosines of star 19 | * 20 | * Notes: 21 | * 22 | * 1 If vector V0 is not of unit length, the returned vector V will 23 | * be wrong. 24 | * 25 | * 2 If vector V0 points at a pole, the returned vector V will be 26 | * based on the arbitrary assumption that the RA of the tangent 27 | * point is zero. 28 | * 29 | * 3 This routine is the Cartesian equivalent of the routine sla_DTP2S. 30 | * 31 | * P.T.Wallace Starlink 11 February 1995 32 | * 33 | * Copyright (C) 1995 Rutherford Appleton Laboratory 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | DOUBLE PRECISION XI,ETA,V0(3),V(3) 56 | 57 | DOUBLE PRECISION X,Y,Z,F,R 58 | 59 | 60 | X=V0(1) 61 | Y=V0(2) 62 | Z=V0(3) 63 | F=SQRT(1D0+XI*XI+ETA*ETA) 64 | R=SQRT(X*X+Y*Y) 65 | IF (R.EQ.0D0) THEN 66 | R=1D-20 67 | X=R 68 | END IF 69 | V(1)=(X-(XI*Y+ETA*X*Z)/R)/F 70 | V(2)=(Y+(XI*X-ETA*Y*Z)/R)/F 71 | V(3)=(Z+ETA*R)/F 72 | 73 | END 74 | -------------------------------------------------------------------------------- /dtt.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DTT (UTC) 2 | *+ 3 | * - - - - 4 | * D T T 5 | * - - - - 6 | * 7 | * Increment to be applied to Coordinated Universal Time UTC to give 8 | * Terrestrial Time TT (formerly Ephemeris Time ET) 9 | * 10 | * (double precision) 11 | * 12 | * Given: 13 | * UTC d UTC date as a modified JD (JD-2400000.5) 14 | * 15 | * Result: TT-UTC in seconds 16 | * 17 | * Notes: 18 | * 19 | * 1 The UTC is specified to be a date rather than a time to indicate 20 | * that care needs to be taken not to specify an instant which lies 21 | * within a leap second. Though in most cases UTC can include the 22 | * fractional part, correct behaviour on the day of a leap second 23 | * can only be guaranteed up to the end of the second 23:59:59. 24 | * 25 | * 2 Pre 1972 January 1 a fixed value of 10 + ET-TAI is returned. 26 | * 27 | * 3 See also the routine sla_DT, which roughly estimates ET-UT for 28 | * historical epochs. 29 | * 30 | * Called: sla_DAT 31 | * 32 | * P.T.Wallace Starlink 6 December 1994 33 | * 34 | * Copyright (C) 1995 Rutherford Appleton Laboratory 35 | * 36 | * License: 37 | * This program is free software; you can redistribute it and/or modify 38 | * it under the terms of the GNU General Public License as published by 39 | * the Free Software Foundation; either version 2 of the License, or 40 | * (at your option) any later version. 41 | * 42 | * This program is distributed in the hope that it will be useful, 43 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 44 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 45 | * GNU General Public License for more details. 46 | * 47 | * You should have received a copy of the GNU General Public License 48 | * along with this program (see SLA_CONDITIONS); if not, write to the 49 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 50 | * Boston, MA 02111-1307 USA 51 | * 52 | *- 53 | 54 | IMPLICIT NONE 55 | 56 | DOUBLE PRECISION UTC 57 | 58 | DOUBLE PRECISION sla_DAT 59 | 60 | 61 | sla_DTT=32.184D0+sla_DAT(UTC) 62 | 63 | END 64 | -------------------------------------------------------------------------------- /dv2tp.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DV2TP (V, V0, XI, ETA, J) 2 | *+ 3 | * - - - - - - 4 | * D V 2 T P 5 | * - - - - - - 6 | * 7 | * Given the direction cosines of a star and of the tangent point, 8 | * determine the star's tangent-plane coordinates. 9 | * 10 | * (double precision) 11 | * 12 | * Given: 13 | * V d(3) direction cosines of star 14 | * V0 d(3) direction cosines of tangent point 15 | * 16 | * Returned: 17 | * XI,ETA d tangent plane coordinates of star 18 | * J i status: 0 = OK 19 | * 1 = error, star too far from axis 20 | * 2 = error, antistar on tangent plane 21 | * 3 = error, antistar too far from axis 22 | * 23 | * Notes: 24 | * 25 | * 1 If vector V0 is not of unit length, or if vector V is of zero 26 | * length, the results will be wrong. 27 | * 28 | * 2 If V0 points at a pole, the returned XI,ETA will be based on the 29 | * arbitrary assumption that the RA of the tangent point is zero. 30 | * 31 | * 3 This routine is the Cartesian equivalent of the routine sla_DS2TP. 32 | * 33 | * P.T.Wallace Starlink 27 November 1996 34 | * 35 | * Copyright (C) 1996 Rutherford Appleton Laboratory 36 | * 37 | * License: 38 | * This program is free software; you can redistribute it and/or modify 39 | * it under the terms of the GNU General Public License as published by 40 | * the Free Software Foundation; either version 2 of the License, or 41 | * (at your option) any later version. 42 | * 43 | * This program is distributed in the hope that it will be useful, 44 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 45 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 46 | * GNU General Public License for more details. 47 | * 48 | * You should have received a copy of the GNU General Public License 49 | * along with this program (see SLA_CONDITIONS); if not, write to the 50 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 51 | * Boston, MA 02111-1307 USA 52 | * 53 | *- 54 | 55 | IMPLICIT NONE 56 | 57 | DOUBLE PRECISION V(3),V0(3),XI,ETA 58 | INTEGER J 59 | 60 | DOUBLE PRECISION X,Y,Z,X0,Y0,Z0,R2,R,W,D 61 | 62 | DOUBLE PRECISION TINY 63 | PARAMETER (TINY=1D-6) 64 | 65 | 66 | X=V(1) 67 | Y=V(2) 68 | Z=V(3) 69 | X0=V0(1) 70 | Y0=V0(2) 71 | Z0=V0(3) 72 | R2=X0*X0+Y0*Y0 73 | R=SQRT(R2) 74 | IF (R.EQ.0D0) THEN 75 | R=1D-20 76 | X0=R 77 | END IF 78 | W=X*X0+Y*Y0 79 | D=W+Z*Z0 80 | IF (D.GT.TINY) THEN 81 | J=0 82 | ELSE IF (D.GE.0D0) THEN 83 | J=1 84 | D=TINY 85 | ELSE IF (D.GT.-TINY) THEN 86 | J=2 87 | D=-TINY 88 | ELSE 89 | J=3 90 | END IF 91 | D=D*R 92 | XI=(Y*X0-X*Y0)/D 93 | ETA=(Z*R2-Z0*W)/D 94 | 95 | END 96 | -------------------------------------------------------------------------------- /dvdv.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_DVDV (VA, VB) 2 | *+ 3 | * - - - - - 4 | * D V D V 5 | * - - - - - 6 | * 7 | * Scalar product of two 3-vectors (double precision) 8 | * 9 | * Given: 10 | * VA dp(3) first vector 11 | * VB dp(3) second vector 12 | * 13 | * The result is the scalar product VA.VB (double precision) 14 | * 15 | * P.T.Wallace Starlink November 1984 16 | * 17 | * Copyright (C) 1995 Rutherford Appleton Laboratory 18 | * 19 | * License: 20 | * This program is free software; you can redistribute it and/or modify 21 | * it under the terms of the GNU General Public License as published by 22 | * the Free Software Foundation; either version 2 of the License, or 23 | * (at your option) any later version. 24 | * 25 | * This program is distributed in the hope that it will be useful, 26 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | * GNU General Public License for more details. 29 | * 30 | * You should have received a copy of the GNU General Public License 31 | * along with this program (see SLA_CONDITIONS); if not, write to the 32 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 33 | * Boston, MA 02111-1307 USA 34 | * 35 | *- 36 | 37 | IMPLICIT NONE 38 | 39 | DOUBLE PRECISION VA(3),VB(3) 40 | 41 | 42 | sla_DVDV=VA(1)*VB(1)+VA(2)*VB(2)+VA(3)*VB(3) 43 | 44 | END 45 | -------------------------------------------------------------------------------- /dvn.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DVN (V, UV, VM) 2 | *+ 3 | * - - - - 4 | * D V N 5 | * - - - - 6 | * 7 | * Normalizes a 3-vector also giving the modulus (double precision) 8 | * 9 | * Given: 10 | * V d(3) vector 11 | * 12 | * Returned: 13 | * UV d(3) unit vector in direction of V 14 | * VM d modulus of V 15 | * 16 | * Notes: 17 | * 18 | * 1 If the modulus of V is zero, UV is set to zero as well. 19 | * 20 | * 2 To comply with the ANSI Fortran 77 standard, V and UV must be 21 | * different arrays. However, the routine is coded so as to work 22 | * properly on most platforms even if this rule is violated. 23 | * 24 | * Last revision: 22 July 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | DOUBLE PRECISION V(3),UV(3),VM 49 | 50 | INTEGER I 51 | DOUBLE PRECISION W1,W2 52 | 53 | 54 | * Modulus. 55 | W1 = 0D0 56 | DO I=1,3 57 | W2 = V(I) 58 | W1 = W1+W2*W2 59 | END DO 60 | W1 = SQRT(W1) 61 | VM = W1 62 | 63 | * Normalize the vector. 64 | IF (W1.LE.0D0) W1 = 1D0 65 | DO I=1,3 66 | UV(I) = V(I)/W1 67 | END DO 68 | 69 | END 70 | -------------------------------------------------------------------------------- /dvxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_DVXV (VA, VB, VC) 2 | *+ 3 | * - - - - - 4 | * D V X V 5 | * - - - - - 6 | * 7 | * Vector product of two 3-vectors (double precision) 8 | * 9 | * Given: 10 | * VA dp(3) first vector 11 | * VB dp(3) second vector 12 | * 13 | * Returned: 14 | * VC dp(3) vector result 15 | * 16 | * P.T.Wallace Starlink March 1986 17 | * 18 | * Copyright (C) 1995 Rutherford Appleton Laboratory 19 | * 20 | * License: 21 | * This program is free software; you can redistribute it and/or modify 22 | * it under the terms of the GNU General Public License as published by 23 | * the Free Software Foundation; either version 2 of the License, or 24 | * (at your option) any later version. 25 | * 26 | * This program is distributed in the hope that it will be useful, 27 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 28 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 | * GNU General Public License for more details. 30 | * 31 | * You should have received a copy of the GNU General Public License 32 | * along with this program (see SLA_CONDITIONS); if not, write to the 33 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 34 | * Boston, MA 02111-1307 USA 35 | * 36 | *- 37 | 38 | IMPLICIT NONE 39 | 40 | DOUBLE PRECISION VA(3),VB(3),VC(3) 41 | 42 | DOUBLE PRECISION VW(3) 43 | INTEGER I 44 | 45 | 46 | * Form the vector product VA cross VB 47 | VW(1)=VA(2)*VB(3)-VA(3)*VB(2) 48 | VW(2)=VA(3)*VB(1)-VA(1)*VB(3) 49 | VW(3)=VA(1)*VB(2)-VA(2)*VB(1) 50 | 51 | * Return the result 52 | DO I=1,3 53 | VC(I)=VW(I) 54 | END DO 55 | 56 | END 57 | -------------------------------------------------------------------------------- /ecleq.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_ECLEQ (DL, DB, DATE, DR, DD) 2 | *+ 3 | * - - - - - - 4 | * E C L E Q 5 | * - - - - - - 6 | * 7 | * Transformation from ecliptic coordinates to 8 | * J2000.0 equatorial coordinates (double precision) 9 | * 10 | * Given: 11 | * DL,DB dp ecliptic longitude and latitude 12 | * (mean of date, IAU 1980 theory, radians) 13 | * DATE dp TDB (loosely ET) as Modified Julian Date 14 | * (JD-2400000.5) 15 | * Returned: 16 | * DR,DD dp J2000.0 mean RA,Dec (radians) 17 | * 18 | * Called: 19 | * sla_DCS2C, sla_ECMAT, sla_DIMXV, sla_PREC, sla_EPJ, sla_DCC2S, 20 | * sla_DRANRM, sla_DRANGE 21 | * 22 | * P.T.Wallace Starlink March 1986 23 | * 24 | * Copyright (C) 1995 Rutherford Appleton Laboratory 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | DOUBLE PRECISION DL,DB,DATE,DR,DD 47 | 48 | DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE 49 | 50 | DOUBLE PRECISION RMAT(3,3),V1(3),V2(3) 51 | 52 | 53 | 54 | * Spherical to Cartesian 55 | CALL sla_DCS2C(DL,DB,V1) 56 | 57 | * Ecliptic to equatorial 58 | CALL sla_ECMAT(DATE,RMAT) 59 | CALL sla_DIMXV(RMAT,V1,V2) 60 | 61 | * Mean of date to J2000 62 | CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT) 63 | CALL sla_DIMXV(RMAT,V2,V1) 64 | 65 | * Cartesian to spherical 66 | CALL sla_DCC2S(V1,DR,DD) 67 | 68 | * Express in conventional ranges 69 | DR=sla_DRANRM(DR) 70 | DD=sla_DRANGE(DD) 71 | 72 | END 73 | -------------------------------------------------------------------------------- /ecmat.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_ECMAT (DATE, RMAT) 2 | *+ 3 | * - - - - - - 4 | * E C M A T 5 | * - - - - - - 6 | * 7 | * Form the equatorial to ecliptic rotation matrix - IAU 1980 theory 8 | * (double precision) 9 | * 10 | * Given: 11 | * DATE dp TDB (loosely ET) as Modified Julian Date 12 | * (JD-2400000.5) 13 | * Returned: 14 | * RMAT dp(3,3) matrix 15 | * 16 | * Reference: 17 | * Murray,C.A., Vectorial Astrometry, section 4.3. 18 | * 19 | * Note: 20 | * The matrix is in the sense V(ecl) = RMAT * V(equ); the 21 | * equator, equinox and ecliptic are mean of date. 22 | * 23 | * Called: sla_DEULER 24 | * 25 | * P.T.Wallace Starlink 23 August 1996 26 | * 27 | * Copyright (C) 1996 Rutherford Appleton Laboratory 28 | * 29 | * License: 30 | * This program is free software; you can redistribute it and/or modify 31 | * it under the terms of the GNU General Public License as published by 32 | * the Free Software Foundation; either version 2 of the License, or 33 | * (at your option) any later version. 34 | * 35 | * This program is distributed in the hope that it will be useful, 36 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 37 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 38 | * GNU General Public License for more details. 39 | * 40 | * You should have received a copy of the GNU General Public License 41 | * along with this program (see SLA_CONDITIONS); if not, write to the 42 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 43 | * Boston, MA 02111-1307 USA 44 | * 45 | *- 46 | 47 | IMPLICIT NONE 48 | 49 | DOUBLE PRECISION DATE,RMAT(3,3) 50 | 51 | * Arc seconds to radians 52 | DOUBLE PRECISION AS2R 53 | PARAMETER (AS2R=0.484813681109535994D-5) 54 | 55 | DOUBLE PRECISION T,EPS0 56 | 57 | 58 | 59 | * Interval between basic epoch J2000.0 and current epoch (JC) 60 | T = (DATE-51544.5D0)/36525D0 61 | 62 | * Mean obliquity 63 | EPS0 = AS2R* 64 | : (84381.448D0+(-46.8150D0+(-0.00059D0+0.001813D0*T)*T)*T) 65 | 66 | * Matrix 67 | CALL sla_DEULER('X',EPS0,0D0,0D0,RMAT) 68 | 69 | END 70 | -------------------------------------------------------------------------------- /epb.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EPB (DATE) 2 | *+ 3 | * - - - - 4 | * E P B 5 | * - - - - 6 | * 7 | * Conversion of Modified Julian Date to Besselian Epoch 8 | * (double precision) 9 | * 10 | * Given: 11 | * DATE dp Modified Julian Date (JD - 2400000.5) 12 | * 13 | * The result is the Besselian Epoch. 14 | * 15 | * Reference: 16 | * Lieske,J.H., 1979. Astron.Astrophys.,73,282. 17 | * 18 | * P.T.Wallace Starlink February 1984 19 | * 20 | * Copyright (C) 1995 Rutherford Appleton Laboratory 21 | * 22 | * License: 23 | * This program is free software; you can redistribute it and/or modify 24 | * it under the terms of the GNU General Public License as published by 25 | * the Free Software Foundation; either version 2 of the License, or 26 | * (at your option) any later version. 27 | * 28 | * This program is distributed in the hope that it will be useful, 29 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 30 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 31 | * GNU General Public License for more details. 32 | * 33 | * You should have received a copy of the GNU General Public License 34 | * along with this program (see SLA_CONDITIONS); if not, write to the 35 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 36 | * Boston, MA 02111-1307 USA 37 | * 38 | *- 39 | 40 | IMPLICIT NONE 41 | 42 | DOUBLE PRECISION DATE 43 | 44 | 45 | sla_EPB = 1900D0 + (DATE-15019.81352D0)/365.242198781D0 46 | 47 | END 48 | -------------------------------------------------------------------------------- /epb2d.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EPB2D (EPB) 2 | *+ 3 | * - - - - - - 4 | * E P B 2 D 5 | * - - - - - - 6 | * 7 | * Conversion of Besselian Epoch to Modified Julian Date 8 | * (double precision) 9 | * 10 | * Given: 11 | * EPB dp Besselian Epoch 12 | * 13 | * The result is the Modified Julian Date (JD - 2400000.5). 14 | * 15 | * Reference: 16 | * Lieske,J.H., 1979. Astron.Astrophys.,73,282. 17 | * 18 | * P.T.Wallace Starlink February 1984 19 | * 20 | * Copyright (C) 1995 Rutherford Appleton Laboratory 21 | * 22 | * License: 23 | * This program is free software; you can redistribute it and/or modify 24 | * it under the terms of the GNU General Public License as published by 25 | * the Free Software Foundation; either version 2 of the License, or 26 | * (at your option) any later version. 27 | * 28 | * This program is distributed in the hope that it will be useful, 29 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 30 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 31 | * GNU General Public License for more details. 32 | * 33 | * You should have received a copy of the GNU General Public License 34 | * along with this program (see SLA_CONDITIONS); if not, write to the 35 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 36 | * Boston, MA 02111-1307 USA 37 | * 38 | *- 39 | 40 | IMPLICIT NONE 41 | 42 | DOUBLE PRECISION EPB 43 | 44 | 45 | sla_EPB2D = 15019.81352D0 + (EPB-1900D0)*365.242198781D0 46 | 47 | END 48 | -------------------------------------------------------------------------------- /epco.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EPCO (K0, K, E) 2 | *+ 3 | * - - - - - 4 | * E P C O 5 | * - - - - - 6 | * 7 | * Convert an epoch into the appropriate form - 'B' or 'J' 8 | * 9 | * Given: 10 | * K0 char form of result: 'B'=Besselian, 'J'=Julian 11 | * K char form of given epoch: 'B' or 'J' 12 | * E dp epoch 13 | * 14 | * Called: sla_EPB, sla_EPJ2D, sla_EPJ, sla_EPB2D 15 | * 16 | * Notes: 17 | * 18 | * 1) The result is always either equal to or very close to 19 | * the given epoch E. The routine is required only in 20 | * applications where punctilious treatment of heterogeneous 21 | * mixtures of star positions is necessary. 22 | * 23 | * 2) K0 and K are not validated. They are interpreted as follows: 24 | * 25 | * o If K0 and K are the same the result is E. 26 | * o If K0 is 'B' or 'b' and K isn't, the conversion is J to B. 27 | * o In all other cases, the conversion is B to J. 28 | * 29 | * Note that K0 and K won't match if their cases differ. 30 | * 31 | * P.T.Wallace Starlink 5 September 1993 32 | * 33 | * Copyright (C) 1995 Rutherford Appleton Laboratory 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | CHARACTER*(*) K0,K 56 | DOUBLE PRECISION E 57 | DOUBLE PRECISION sla_EPB,sla_EPJ2D,sla_EPJ,sla_EPB2D 58 | 59 | 60 | IF (K.EQ.K0) THEN 61 | sla_EPCO=E 62 | ELSE IF (K0.EQ.'B'.OR.K0.EQ.'b') THEN 63 | sla_EPCO=sla_EPB(sla_EPJ2D(E)) 64 | ELSE 65 | sla_EPCO=sla_EPJ(sla_EPB2D(E)) 66 | END IF 67 | 68 | END 69 | -------------------------------------------------------------------------------- /epj.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EPJ (DATE) 2 | *+ 3 | * - - - - 4 | * E P J 5 | * - - - - 6 | * 7 | * Conversion of Modified Julian Date to Julian Epoch (double precision) 8 | * 9 | * Given: 10 | * DATE dp Modified Julian Date (JD - 2400000.5) 11 | * 12 | * The result is the Julian Epoch. 13 | * 14 | * Reference: 15 | * Lieske,J.H., 1979. Astron.Astrophys.,73,282. 16 | * 17 | * P.T.Wallace Starlink February 1984 18 | * 19 | * Copyright (C) 1995 Rutherford Appleton Laboratory 20 | * 21 | * License: 22 | * This program is free software; you can redistribute it and/or modify 23 | * it under the terms of the GNU General Public License as published by 24 | * the Free Software Foundation; either version 2 of the License, or 25 | * (at your option) any later version. 26 | * 27 | * This program is distributed in the hope that it will be useful, 28 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 29 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 30 | * GNU General Public License for more details. 31 | * 32 | * You should have received a copy of the GNU General Public License 33 | * along with this program (see SLA_CONDITIONS); if not, write to the 34 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 35 | * Boston, MA 02111-1307 USA 36 | * 37 | *- 38 | 39 | IMPLICIT NONE 40 | 41 | DOUBLE PRECISION DATE 42 | 43 | 44 | sla_EPJ = 2000D0 + (DATE-51544.5D0)/365.25D0 45 | 46 | END 47 | -------------------------------------------------------------------------------- /epj2d.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EPJ2D (EPJ) 2 | *+ 3 | * - - - - - - 4 | * E P J 2 D 5 | * - - - - - - 6 | * 7 | * Conversion of Julian Epoch to Modified Julian Date (double precision) 8 | * 9 | * Given: 10 | * EPJ dp Julian Epoch 11 | * 12 | * The result is the Modified Julian Date (JD - 2400000.5). 13 | * 14 | * Reference: 15 | * Lieske,J.H., 1979. Astron.Astrophys.,73,282. 16 | * 17 | * P.T.Wallace Starlink February 1984 18 | * 19 | * Copyright (C) 1995 Rutherford Appleton Laboratory 20 | * 21 | * License: 22 | * This program is free software; you can redistribute it and/or modify 23 | * it under the terms of the GNU General Public License as published by 24 | * the Free Software Foundation; either version 2 of the License, or 25 | * (at your option) any later version. 26 | * 27 | * This program is distributed in the hope that it will be useful, 28 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 29 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 30 | * GNU General Public License for more details. 31 | * 32 | * You should have received a copy of the GNU General Public License 33 | * along with this program (see SLA_CONDITIONS); if not, write to the 34 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 35 | * Boston, MA 02111-1307 USA 36 | * 37 | *- 38 | 39 | IMPLICIT NONE 40 | 41 | DOUBLE PRECISION EPJ 42 | 43 | 44 | sla_EPJ2D = 51544.5D0 + (EPJ-2000D0)*365.25D0 45 | 46 | END 47 | -------------------------------------------------------------------------------- /eqecl.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_EQECL (DR, DD, DATE, DL, DB) 2 | *+ 3 | * - - - - - - 4 | * E Q E C L 5 | * - - - - - - 6 | * 7 | * Transformation from J2000.0 equatorial coordinates to 8 | * ecliptic coordinates (double precision) 9 | * 10 | * Given: 11 | * DR,DD dp J2000.0 mean RA,Dec (radians) 12 | * DATE dp TDB (loosely ET) as Modified Julian Date 13 | * (JD-2400000.5) 14 | * Returned: 15 | * DL,DB dp ecliptic longitude and latitude 16 | * (mean of date, IAU 1980 theory, radians) 17 | * 18 | * Called: 19 | * sla_DCS2C, sla_PREC, sla_EPJ, sla_DMXV, sla_ECMAT, sla_DCC2S, 20 | * sla_DRANRM, sla_DRANGE 21 | * 22 | * P.T.Wallace Starlink March 1986 23 | * 24 | * Copyright (C) 1995 Rutherford Appleton Laboratory 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | DOUBLE PRECISION DR,DD,DATE,DL,DB 47 | 48 | DOUBLE PRECISION sla_EPJ,sla_DRANRM,sla_DRANGE 49 | 50 | DOUBLE PRECISION RMAT(3,3),V1(3),V2(3) 51 | 52 | 53 | 54 | * Spherical to Cartesian 55 | CALL sla_DCS2C(DR,DD,V1) 56 | 57 | * Mean J2000 to mean of date 58 | CALL sla_PREC(2000D0,sla_EPJ(DATE),RMAT) 59 | CALL sla_DMXV(RMAT,V1,V2) 60 | 61 | * Equatorial to ecliptic 62 | CALL sla_ECMAT(DATE,RMAT) 63 | CALL sla_DMXV(RMAT,V2,V1) 64 | 65 | * Cartesian to spherical 66 | CALL sla_DCC2S(V1,DL,DB) 67 | 68 | * Express in conventional ranges 69 | DL=sla_DRANRM(DL) 70 | DB=sla_DRANGE(DB) 71 | 72 | END 73 | -------------------------------------------------------------------------------- /eqeqx.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_EQEQX (DATE) 2 | *+ 3 | * - - - - - - 4 | * E Q E Q X 5 | * - - - - - - 6 | * 7 | * Equation of the equinoxes (IAU 1994, double precision) 8 | * 9 | * Given: 10 | * DATE dp TDB (loosely ET) as Modified Julian Date 11 | * (JD-2400000.5) 12 | * 13 | * The result is the equation of the equinoxes (double precision) 14 | * in radians: 15 | * 16 | * Greenwich apparent ST = GMST + sla_EQEQX 17 | * 18 | * References: IAU Resolution C7, Recommendation 3 (1994) 19 | * Capitaine, N. & Gontier, A.-M., Astron. Astrophys., 20 | * 275, 645-650 (1993) 21 | * 22 | * Called: sla_NUTC 23 | * 24 | * Patrick Wallace Starlink 23 August 1996 25 | * 26 | * Copyright (C) 1996 Rutherford Appleton Laboratory 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | DOUBLE PRECISION DATE 49 | 50 | * Turns to arc seconds and arc seconds to radians 51 | DOUBLE PRECISION T2AS,AS2R 52 | PARAMETER (T2AS=1296000D0, 53 | : AS2R=0.484813681109535994D-5) 54 | 55 | DOUBLE PRECISION T,OM,DPSI,DEPS,EPS0 56 | 57 | 58 | 59 | * Interval between basic epoch J2000.0 and current epoch (JC) 60 | T=(DATE-51544.5D0)/36525D0 61 | 62 | * Longitude of the mean ascending node of the lunar orbit on the 63 | * ecliptic, measured from the mean equinox of date 64 | OM=AS2R*(450160.280D0+(-5D0*T2AS-482890.539D0 65 | : +(7.455D0+0.008D0*T)*T)*T) 66 | 67 | * Nutation 68 | CALL sla_NUTC(DATE,DPSI,DEPS,EPS0) 69 | 70 | * Equation of the equinoxes 71 | sla_EQEQX=DPSI*COS(EPS0)+AS2R*(0.00264D0*SIN(OM)+ 72 | : 0.000063D0*SIN(OM+OM)) 73 | 74 | END 75 | -------------------------------------------------------------------------------- /etrms.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_ETRMS (EP, EV) 2 | *+ 3 | * - - - - - - 4 | * E T R M S 5 | * - - - - - - 6 | * 7 | * Compute the E-terms (elliptic component of annual aberration) 8 | * vector (double precision) 9 | * 10 | * Given: 11 | * EP dp Besselian epoch 12 | * 13 | * Returned: 14 | * EV dp(3) E-terms as (dx,dy,dz) 15 | * 16 | * Note the use of the J2000 aberration constant (20.49552 arcsec). 17 | * This is a reflection of the fact that the E-terms embodied in 18 | * existing star catalogues were computed from a variety of 19 | * aberration constants. Rather than adopting one of the old 20 | * constants the latest value is used here. 21 | * 22 | * References: 23 | * 1 Smith, C.A. et al., 1989. Astr.J. 97, 265. 24 | * 2 Yallop, B.D. et al., 1989. Astr.J. 97, 274. 25 | * 26 | * P.T.Wallace Starlink 23 August 1996 27 | * 28 | * Copyright (C) 1996 Rutherford Appleton Laboratory 29 | * 30 | * License: 31 | * This program is free software; you can redistribute it and/or modify 32 | * it under the terms of the GNU General Public License as published by 33 | * the Free Software Foundation; either version 2 of the License, or 34 | * (at your option) any later version. 35 | * 36 | * This program is distributed in the hope that it will be useful, 37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | * GNU General Public License for more details. 40 | * 41 | * You should have received a copy of the GNU General Public License 42 | * along with this program (see SLA_CONDITIONS); if not, write to the 43 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 44 | * Boston, MA 02111-1307 USA 45 | * 46 | *- 47 | 48 | IMPLICIT NONE 49 | 50 | DOUBLE PRECISION EP,EV(3) 51 | 52 | * Arcseconds to radians 53 | DOUBLE PRECISION AS2R 54 | PARAMETER (AS2R=0.484813681109535994D-5) 55 | 56 | DOUBLE PRECISION T,E,E0,P,EK,CP 57 | 58 | 59 | 60 | * Julian centuries since B1950 61 | T=(EP-1950D0)*1.00002135903D-2 62 | 63 | * Eccentricity 64 | E=0.01673011D0-(0.00004193D0+0.000000126D0*T)*T 65 | 66 | * Mean obliquity 67 | E0=(84404.836D0-(46.8495D0+(0.00319D0+0.00181D0*T)*T)*T)*AS2R 68 | 69 | * Mean longitude of perihelion 70 | P=(1015489.951D0+(6190.67D0+(1.65D0+0.012D0*T)*T)*T)*AS2R 71 | 72 | * E-terms 73 | EK=E*20.49552D0*AS2R 74 | CP=COS(P) 75 | EV(1)= EK*SIN(P) 76 | EV(2)=-EK*CP*COS(E0) 77 | EV(3)=-EK*CP*SIN(E0) 78 | 79 | END 80 | -------------------------------------------------------------------------------- /geoc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_GEOC (P, H, R, Z) 2 | *+ 3 | * - - - - - 4 | * G E O C 5 | * - - - - - 6 | * 7 | * Convert geodetic position to geocentric (double precision) 8 | * 9 | * Given: 10 | * P dp latitude (geodetic, radians) 11 | * H dp height above reference spheroid (geodetic, metres) 12 | * 13 | * Returned: 14 | * R dp distance from Earth axis (AU) 15 | * Z dp distance from plane of Earth equator (AU) 16 | * 17 | * Notes: 18 | * 19 | * 1 Geocentric latitude can be obtained by evaluating ATAN2(Z,R). 20 | * 21 | * 2 IAU 1976 constants are used. 22 | * 23 | * Reference: 24 | * 25 | * Green,R.M., Spherical Astronomy, CUP 1985, p98. 26 | * 27 | * Last revision: 22 July 2004 28 | * 29 | * Copyright P.T.Wallace. All rights reserved. 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | DOUBLE PRECISION P,H,R,Z 52 | 53 | * Earth equatorial radius (metres) 54 | DOUBLE PRECISION A0 55 | PARAMETER (A0=6378140D0) 56 | 57 | * Reference spheroid flattening factor and useful function 58 | DOUBLE PRECISION F,B 59 | PARAMETER (F=1D0/298.257D0,B=(1D0-F)**2) 60 | 61 | * Astronomical unit in metres 62 | DOUBLE PRECISION AU 63 | PARAMETER (AU=1.49597870D11) 64 | 65 | DOUBLE PRECISION SP,CP,C,S 66 | 67 | 68 | 69 | * Geodetic to geocentric conversion 70 | SP = SIN(P) 71 | CP = COS(P) 72 | C = 1D0/SQRT(CP*CP+B*SP*SP) 73 | S = B*C 74 | R = (A0*C+H)*CP/AU 75 | Z = (A0*S+H)*SP/AU 76 | 77 | END 78 | -------------------------------------------------------------------------------- /get_docstring.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | """Convert SLALIB Fortran comments into python docstrings. 3 | 4 | F2PY doesn't add descriptive docstrings to Fortran functions that it 5 | wraps. This module will read Fortran comments from SLALIB Fortran 6 | files and then save them as docstrings. 7 | """ 8 | # Extract name from the first line; names are sla_*. 9 | # The line just before comment starts with *+ and the line just after 10 | # the last line starts with *- 11 | # Strip off license information? 12 | # Note: 13 | # dh2e.f function name is dh2e but comment head is D E 2 H 14 | import re 15 | import glob 16 | 17 | def get_docstring(): 18 | name_pattern = r"(sla_\w+)" # names are sla_xxxx 19 | name_regex = re.compile(name_pattern) 20 | START = "*+" 21 | END = "*-" 22 | doc_dict = {} 23 | 24 | file_list = glob.glob('*.[fF]') 25 | 26 | print("%d files found." % len(file_list)) 27 | 28 | for i,file_name in enumerate(file_list): 29 | f = open(file_name, "r") 30 | 31 | name_line = f.readline() # first line has name 32 | if name_line[0] == '#': # sla_config line in gresid.F 33 | name_line = f.readline() 34 | matches = name_regex.search(name_line) 35 | if len(matches.groups()) != 1: # there should be only one match 36 | raise ValueError("More than one match for function name.") 37 | name = matches.group() 38 | print("Reading %10s in %s." % (name, file_name)) 39 | 40 | doc = [] 41 | inside = 0 42 | for line in f: 43 | if inside: 44 | doc.append(line) 45 | elif line[0:2] == START: 46 | inside = 1 47 | if line[0:2] == END: 48 | inside = 0 49 | del doc[-1] # delete line with "*-" 50 | break 51 | 52 | # add filename to docstring 53 | str_to_append = "File: "+ file_name + '\n"""' 54 | doc_dict[name.lower()] = "".join(['"""\n']+doc+[str_to_append]) 55 | 56 | f.close() 57 | 58 | print("%d functions read from %d files." % (len(doc_dict), len(file_list))) 59 | return doc_dict 60 | 61 | if __name__ == "__main__": 62 | docstrings = get_docstring() 63 | -------------------------------------------------------------------------------- /imxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_IMXV (RM, VA, VB) 2 | *+ 3 | * - - - - - 4 | * I M X V 5 | * - - - - - 6 | * 7 | * Performs the 3-D backward unitary transformation: 8 | * 9 | * vector VB = (inverse of matrix RM) * vector VA 10 | * 11 | * (single precision) 12 | * 13 | * (n.b. the matrix must be unitary, as this routine assumes that 14 | * the inverse and transpose are identical) 15 | * 16 | * Given: 17 | * RM real(3,3) matrix 18 | * VA real(3) vector 19 | * 20 | * Returned: 21 | * VB real(3) result vector 22 | * 23 | * P.T.Wallace Starlink November 1984 24 | * 25 | * Copyright (C) 1995 Rutherford Appleton Laboratory 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | REAL RM(3,3),VA(3),VB(3) 48 | 49 | INTEGER I,J 50 | REAL W,VW(3) 51 | 52 | 53 | 54 | * Inverse of matrix RM * vector VA -> vector VW 55 | DO J=1,3 56 | W=0.0 57 | DO I=1,3 58 | W=W+RM(I,J)*VA(I) 59 | END DO 60 | VW(J)=W 61 | END DO 62 | 63 | * Vector VW -> vector VB 64 | DO J=1,3 65 | VB(J)=VW(J) 66 | END DO 67 | 68 | END 69 | -------------------------------------------------------------------------------- /kbj.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_KBJ (JB, E, K, J) 2 | *+ 3 | * - - - - 4 | * K B J 5 | * - - - - 6 | * 7 | * Select epoch prefix 'B' or 'J' 8 | * 9 | * Given: 10 | * JB int sla_DBJIN prefix status: 0=none, 1='B', 2='J' 11 | * E dp epoch - Besselian or Julian 12 | * 13 | * Returned: 14 | * K char 'B' or 'J' 15 | * J int status: 0=OK 16 | * 17 | * If JB=0, B is assumed for E < 1984D0, otherwise J. 18 | * 19 | * P.T.Wallace Starlink 31 July 1989 20 | * 21 | * Copyright (C) 1995 Rutherford Appleton Laboratory 22 | * 23 | * License: 24 | * This program is free software; you can redistribute it and/or modify 25 | * it under the terms of the GNU General Public License as published by 26 | * the Free Software Foundation; either version 2 of the License, or 27 | * (at your option) any later version. 28 | * 29 | * This program is distributed in the hope that it will be useful, 30 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 31 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32 | * GNU General Public License for more details. 33 | * 34 | * You should have received a copy of the GNU General Public License 35 | * along with this program (see SLA_CONDITIONS); if not, write to the 36 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 37 | * Boston, MA 02111-1307 USA 38 | * 39 | *- 40 | 41 | IMPLICIT NONE 42 | 43 | INTEGER JB 44 | DOUBLE PRECISION E 45 | CHARACTER K*(*) 46 | INTEGER J 47 | 48 | * Preset status 49 | J=0 50 | 51 | * If prefix given expressly, use it 52 | IF (JB.EQ.1) THEN 53 | K='B' 54 | ELSE IF (JB.EQ.2) THEN 55 | K='J' 56 | 57 | * If no prefix, examine the epoch 58 | ELSE IF (JB.EQ.0) THEN 59 | 60 | * If epoch is pre-1984.0, assume Besselian; otherwise Julian 61 | IF (E.LT.1984D0) THEN 62 | K='B' 63 | ELSE 64 | K='J' 65 | END IF 66 | 67 | * If illegal prefix, return error status 68 | ELSE 69 | K=' ' 70 | J=1 71 | END IF 72 | 73 | END 74 | -------------------------------------------------------------------------------- /lib/__init__.py: -------------------------------------------------------------------------------- 1 | """Python interface to SLALIB. 2 | 3 | This module, pyslalib, is a f2py-generated (and hand-tweaked to 4 | eliminate unnecessary function/subroutine arguments) wrappers for the 5 | Fortran version of P.T. Wallace's SLALIB positional astronomy library. 6 | 7 | The python wrappers cover every function in SLALIB and a comprehensive 8 | set of unit tests are available in the test/ directory of the source 9 | distribution. The only external dependency is numpy. 10 | 11 | The module ``pyslalib.slalib`` contains the f2py wrapped 12 | functions. The dictionary, ``pyslalib.sladoc`` contains documentation 13 | for functions; accessed by using the function name as key. For 14 | example: ``pyslalib.sladoc['sla_dat']`` will return a string 15 | containing the documentation for the ``sla_dat`` function. The 16 | documentation for each function is generated from the comment at the 17 | beginning of the SLALIB Fortran source file. 18 | """ 19 | import pickle 20 | import os 21 | 22 | # Relative path: from .slalib import * 23 | # works for 2.6 and above but we use this form to work on 2.5 24 | from pyslalib import slalib 25 | 26 | # A dictionary with functions as keys and comments in SLALIB 27 | # Fortran files as value strings. Use 28 | dir_name = os.path.dirname(slalib.__file__) 29 | f = open(os.path.join(dir_name,"docstring_pickle.pkl"), "rb") 30 | sladoc = pickle.load(f) 31 | -------------------------------------------------------------------------------- /m2av.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_M2AV (RMAT, AXVEC) 2 | *+ 3 | * - - - - - 4 | * M 2 A V 5 | * - - - - - 6 | * 7 | * From a rotation matrix, determine the corresponding axial vector 8 | * (single precision) 9 | * 10 | * A rotation matrix describes a rotation about some arbitrary axis, 11 | * called the Euler axis. The "axial vector" returned by this routine 12 | * has the same direction as the Euler axis, and its magnitude is the 13 | * amount of rotation in radians. (The magnitude and direction can be 14 | * separated by means of the routine sla_VN.) 15 | * 16 | * Given: 17 | * RMAT r(3,3) rotation matrix 18 | * 19 | * Returned: 20 | * AXVEC r(3) axial vector (radians) 21 | * 22 | * The reference frame rotates clockwise as seen looking along 23 | * the axial vector from the origin. 24 | * 25 | * If RMAT is null, so is the result. 26 | * 27 | * Last revision: 26 November 2005 28 | * 29 | * Copyright P.T.Wallace. All rights reserved. 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | REAL RMAT(3,3),AXVEC(3) 52 | 53 | REAL X,Y,Z,S2,C2,PHI,F 54 | 55 | 56 | 57 | X = RMAT(2,3)-RMAT(3,2) 58 | Y = RMAT(3,1)-RMAT(1,3) 59 | Z = RMAT(1,2)-RMAT(2,1) 60 | S2 = SQRT(X*X+Y*Y+Z*Z) 61 | IF (S2.NE.0.0) THEN 62 | C2 = (RMAT(1,1)+RMAT(2,2)+RMAT(3,3)-1.0) 63 | PHI = ATAN2(S2/2.0,C2/2.0) 64 | F = PHI/S2 65 | AXVEC(1) = X*F 66 | AXVEC(2) = Y*F 67 | AXVEC(3) = Z*F 68 | ELSE 69 | AXVEC(1) = 0.0 70 | AXVEC(2) = 0.0 71 | AXVEC(3) = 0.0 72 | END IF 73 | 74 | END 75 | -------------------------------------------------------------------------------- /mxm.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_MXM (A, B, C) 2 | *+ 3 | * - - - - 4 | * M X M 5 | * - - - - 6 | * 7 | * Product of two 3x3 matrices: 8 | * matrix C = matrix A x matrix B 9 | * 10 | * (single precision) 11 | * 12 | * Given: 13 | * A real(3,3) matrix 14 | * B real(3,3) matrix 15 | * 16 | * Returned: 17 | * C real(3,3) matrix result 18 | * 19 | * To comply with the ANSI Fortran 77 standard, A, B and C must 20 | * be different arrays. However, the routine is coded so as to 21 | * work properly on many platforms even if this rule is violated. 22 | * 23 | * Last revision: 26 December 2004 24 | * 25 | * Copyright P.T.Wallace. All rights reserved. 26 | * 27 | * License: 28 | * This program is free software; you can redistribute it and/or modify 29 | * it under the terms of the GNU General Public License as published by 30 | * the Free Software Foundation; either version 2 of the License, or 31 | * (at your option) any later version. 32 | * 33 | * This program is distributed in the hope that it will be useful, 34 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 35 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 36 | * GNU General Public License for more details. 37 | * 38 | * You should have received a copy of the GNU General Public License 39 | * along with this program (see SLA_CONDITIONS); if not, write to the 40 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 41 | * Boston, MA 02111-1307 USA 42 | * 43 | *- 44 | 45 | IMPLICIT NONE 46 | 47 | REAL A(3,3),B(3,3),C(3,3) 48 | 49 | INTEGER I,J,K 50 | REAL W,WM(3,3) 51 | 52 | 53 | * Multiply into scratch matrix 54 | DO I=1,3 55 | DO J=1,3 56 | W=0.0 57 | DO K=1,3 58 | W=W+A(I,K)*B(K,J) 59 | END DO 60 | WM(I,J)=W 61 | END DO 62 | END DO 63 | 64 | * Return the result 65 | DO J=1,3 66 | DO I=1,3 67 | C(I,J)=WM(I,J) 68 | END DO 69 | END DO 70 | 71 | END 72 | -------------------------------------------------------------------------------- /mxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_MXV (RM, VA, VB) 2 | *+ 3 | * - - - - 4 | * M X V 5 | * - - - - 6 | * 7 | * Performs the 3-D forward unitary transformation: 8 | * 9 | * vector VB = matrix RM * vector VA 10 | * 11 | * (single precision) 12 | * 13 | * Given: 14 | * RM real(3,3) matrix 15 | * VA real(3) vector 16 | * 17 | * Returned: 18 | * VB real(3) result vector 19 | * 20 | * To comply with the ANSI Fortran 77 standard, VA and VB must be 21 | * different arrays. However, the routine is coded so as to work 22 | * properly on many platforms even if this rule is violated. 23 | * 24 | * Last revision: 26 December 2004 25 | * 26 | * Copyright P.T.Wallace. All rights reserved. 27 | * 28 | * License: 29 | * This program is free software; you can redistribute it and/or modify 30 | * it under the terms of the GNU General Public License as published by 31 | * the Free Software Foundation; either version 2 of the License, or 32 | * (at your option) any later version. 33 | * 34 | * This program is distributed in the hope that it will be useful, 35 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 36 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 37 | * GNU General Public License for more details. 38 | * 39 | * You should have received a copy of the GNU General Public License 40 | * along with this program (see SLA_CONDITIONS); if not, write to the 41 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 42 | * Boston, MA 02111-1307 USA 43 | * 44 | *- 45 | 46 | IMPLICIT NONE 47 | 48 | REAL RM(3,3),VA(3),VB(3) 49 | 50 | INTEGER I,J 51 | REAL W,VW(3) 52 | 53 | 54 | * Matrix RM * vector VA -> vector VW 55 | DO J=1,3 56 | W=0.0 57 | DO I=1,3 58 | W=W+RM(J,I)*VA(I) 59 | END DO 60 | VW(J)=W 61 | END DO 62 | 63 | * Vector VW -> vector VB 64 | DO J=1,3 65 | VB(J)=VW(J) 66 | END DO 67 | 68 | END 69 | -------------------------------------------------------------------------------- /nut.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_NUT (DATE, RMATN) 2 | *+ 3 | * - - - - 4 | * N U T 5 | * - - - - 6 | * 7 | * Form the matrix of nutation for a given date - Shirai & Fukushima 8 | * 2001 theory (double precision) 9 | * 10 | * Reference: 11 | * Shirai, T. & Fukushima, T., Astron.J. 121, 3270-3283 (2001). 12 | * 13 | * Given: 14 | * DATE d TDB (loosely ET) as Modified Julian Date 15 | * (=JD-2400000.5) 16 | * Returned: 17 | * RMATN d(3,3) nutation matrix 18 | * 19 | * Notes: 20 | * 21 | * 1 The matrix is in the sense v(true) = rmatn * v(mean) . 22 | * where v(true) is the star vector relative to the true equator and 23 | * equinox of date and v(mean) is the star vector relative to the 24 | * mean equator and equinox of date. 25 | * 26 | * 2 The matrix represents forced nutation (but not free core 27 | * nutation) plus corrections to the IAU~1976 precession model. 28 | * 29 | * 3 Earth attitude predictions made by combining the present nutation 30 | * matrix with IAU~1976 precession are accurate to 1~mas (with 31 | * respect to the ICRS) for a few decades around 2000. 32 | * 33 | * 4 The distinction between the required TDB and TT is always 34 | * negligible. Moreover, for all but the most critical applications 35 | * UTC is adequate. 36 | * 37 | * Called: sla_NUTC, sla_DEULER 38 | * 39 | * Last revision: 1 December 2005 40 | * 41 | * Copyright P.T.Wallace. All rights reserved. 42 | * 43 | * License: 44 | * This program is free software; you can redistribute it and/or modify 45 | * it under the terms of the GNU General Public License as published by 46 | * the Free Software Foundation; either version 2 of the License, or 47 | * (at your option) any later version. 48 | * 49 | * This program is distributed in the hope that it will be useful, 50 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 51 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 52 | * GNU General Public License for more details. 53 | * 54 | * You should have received a copy of the GNU General Public License 55 | * along with this program (see SLA_CONDITIONS); if not, write to the 56 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 57 | * Boston, MA 02111-1307 USA 58 | * 59 | *- 60 | 61 | IMPLICIT NONE 62 | 63 | DOUBLE PRECISION DATE,RMATN(3,3) 64 | 65 | DOUBLE PRECISION DPSI,DEPS,EPS0 66 | 67 | 68 | 69 | * Nutation components and mean obliquity 70 | CALL sla_NUTC(DATE,DPSI,DEPS,EPS0) 71 | 72 | * Rotation matrix 73 | CALL sla_DEULER('XZX',EPS0,-DPSI,-(EPS0+DEPS),RMATN) 74 | 75 | END 76 | -------------------------------------------------------------------------------- /pa.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_PA (HA, DEC, PHI) 2 | *+ 3 | * - - - 4 | * P A 5 | * - - - 6 | * 7 | * HA, Dec to Parallactic Angle (double precision) 8 | * 9 | * Given: 10 | * HA d hour angle in radians (geocentric apparent) 11 | * DEC d declination in radians (geocentric apparent) 12 | * PHI d observatory latitude in radians (geodetic) 13 | * 14 | * The result is in the range -pi to +pi 15 | * 16 | * Notes: 17 | * 18 | * 1) The parallactic angle at a point in the sky is the position 19 | * angle of the vertical, i.e. the angle between the direction to 20 | * the pole and to the zenith. In precise applications care must 21 | * be taken only to use geocentric apparent HA,Dec and to consider 22 | * separately the effects of atmospheric refraction and telescope 23 | * mount errors. 24 | * 25 | * 2) At the pole a zero result is returned. 26 | * 27 | * P.T.Wallace Starlink 16 August 1994 28 | * 29 | * Copyright (C) 1995 Rutherford Appleton Laboratory 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | DOUBLE PRECISION HA,DEC,PHI 52 | 53 | DOUBLE PRECISION CP,SQSZ,CQSZ 54 | 55 | 56 | 57 | CP=COS(PHI) 58 | SQSZ=CP*SIN(HA) 59 | CQSZ=SIN(PHI)*COS(DEC)-CP*SIN(DEC)*COS(HA) 60 | IF (SQSZ.EQ.0D0.AND.CQSZ.EQ.0D0) CQSZ=1D0 61 | sla_PA=ATAN2(SQSZ,CQSZ) 62 | 63 | END 64 | -------------------------------------------------------------------------------- /pav.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_PAV ( V1, V2 ) 2 | *+ 3 | * - - - - 4 | * P A V 5 | * - - - - 6 | * 7 | * Position angle of one celestial direction with respect to another. 8 | * 9 | * (single precision) 10 | * 11 | * Given: 12 | * V1 r(3) direction cosines of one point 13 | * V2 r(3) direction cosines of the other point 14 | * 15 | * (The coordinate frames correspond to RA,Dec, Long,Lat etc.) 16 | * 17 | * The result is the bearing (position angle), in radians, of point 18 | * V2 with respect to point V1. It is in the range +/- pi. The 19 | * sense is such that if V2 is a small distance east of V1, the 20 | * bearing is about +pi/2. Zero is returned if the two points 21 | * are coincident. 22 | * 23 | * V1 and V2 do not have to be unit vectors. 24 | * 25 | * The routine sla_BEAR performs an equivalent function except 26 | * that the points are specified in the form of spherical 27 | * coordinates. 28 | * 29 | * Called: sla_DPAV 30 | * 31 | * Last revision: 11 September 2005 32 | * 33 | * Copyright P.T.Wallace. All rights reserved. 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | REAL V1(3), V2(3) 56 | 57 | INTEGER I 58 | DOUBLE PRECISION D1(3), D2(3) 59 | 60 | DOUBLE PRECISION sla_DPAV 61 | 62 | 63 | * Call the double precision version. 64 | DO I=1,3 65 | D1(I) = V1(I) 66 | D2(I) = V2(I) 67 | END DO 68 | sla_PAV = REAL(sla_DPAV(D1,D2)) 69 | 70 | END 71 | -------------------------------------------------------------------------------- /pcd.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_PCD (DISCO,X,Y) 2 | *+ 3 | * - - - - 4 | * P C D 5 | * - - - - 6 | * 7 | * Apply pincushion/barrel distortion to a tangent-plane [x,y]. 8 | * 9 | * Given: 10 | * DISCO d pincushion/barrel distortion coefficient 11 | * X,Y d tangent-plane coordinates 12 | * 13 | * Returned: 14 | * X,Y d distorted coordinates 15 | * 16 | * Notes: 17 | * 18 | * 1) The distortion is of the form RP = R*(1 + C*R**2), where R is 19 | * the radial distance from the tangent point, C is the DISCO 20 | * argument, and RP is the radial distance in the presence of 21 | * the distortion. 22 | * 23 | * 2) For pincushion distortion, C is +ve; for barrel distortion, 24 | * C is -ve. 25 | * 26 | * 3) For X,Y in units of one projection radius (in the case of 27 | * a photographic plate, the focal length), the following 28 | * DISCO values apply: 29 | * 30 | * Geometry DISCO 31 | * 32 | * astrograph 0.0 33 | * Schmidt -0.3333 34 | * AAT PF doublet +147.069 35 | * AAT PF triplet +178.585 36 | * AAT f/8 +21.20 37 | * JKT f/8 +13.32 38 | * 39 | * 4) There is a companion routine, sla_UNPCD, which performs the 40 | * inverse operation. 41 | * 42 | * P.T.Wallace Starlink 3 September 2000 43 | * 44 | * Copyright (C) 2000 Rutherford Appleton Laboratory 45 | * 46 | * License: 47 | * This program is free software; you can redistribute it and/or modify 48 | * it under the terms of the GNU General Public License as published by 49 | * the Free Software Foundation; either version 2 of the License, or 50 | * (at your option) any later version. 51 | * 52 | * This program is distributed in the hope that it will be useful, 53 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 54 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 55 | * GNU General Public License for more details. 56 | * 57 | * You should have received a copy of the GNU General Public License 58 | * along with this program (see SLA_CONDITIONS); if not, write to the 59 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 60 | * Boston, MA 02111-1307 USA 61 | * 62 | *- 63 | 64 | IMPLICIT NONE 65 | 66 | DOUBLE PRECISION DISCO,X,Y 67 | 68 | DOUBLE PRECISION F 69 | 70 | 71 | 72 | F=1D0+DISCO*(X*X+Y*Y) 73 | X=X*F 74 | Y=Y*F 75 | 76 | END 77 | -------------------------------------------------------------------------------- /prebn.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_PREBN (BEP0, BEP1, RMATP) 2 | *+ 3 | * - - - - - - 4 | * P R E B N 5 | * - - - - - - 6 | * 7 | * Generate the matrix of precession between two epochs, 8 | * using the old, pre-IAU1976, Bessel-Newcomb model, using 9 | * Kinoshita's formulation (double precision) 10 | * 11 | * Given: 12 | * BEP0 dp beginning Besselian epoch 13 | * BEP1 dp ending Besselian epoch 14 | * 15 | * Returned: 16 | * RMATP dp(3,3) precession matrix 17 | * 18 | * The matrix is in the sense V(BEP1) = RMATP * V(BEP0) 19 | * 20 | * Reference: 21 | * Kinoshita, H. (1975) 'Formulas for precession', SAO Special 22 | * Report No. 364, Smithsonian Institution Astrophysical 23 | * Observatory, Cambridge, Massachusetts. 24 | * 25 | * Called: sla_DEULER 26 | * 27 | * P.T.Wallace Starlink 23 August 1996 28 | * 29 | * Copyright (C) 1996 Rutherford Appleton Laboratory 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | DOUBLE PRECISION BEP0,BEP1,RMATP(3,3) 52 | 53 | * Arc seconds to radians 54 | DOUBLE PRECISION AS2R 55 | PARAMETER (AS2R=0.484813681109535994D-5) 56 | 57 | DOUBLE PRECISION BIGT,T,TAS2R,W,ZETA,Z,THETA 58 | 59 | 60 | 61 | * Interval between basic epoch B1850.0 and beginning epoch in TC 62 | BIGT = (BEP0-1850D0)/100D0 63 | 64 | * Interval over which precession required, in tropical centuries 65 | T = (BEP1-BEP0)/100D0 66 | 67 | * Euler angles 68 | TAS2R = T*AS2R 69 | W = 2303.5548D0+(1.39720D0+0.000059D0*BIGT)*BIGT 70 | 71 | ZETA = (W+(0.30242D0-0.000269D0*BIGT+0.017996D0*T)*T)*TAS2R 72 | Z = (W+(1.09478D0+0.000387D0*BIGT+0.018324D0*T)*T)*TAS2R 73 | THETA = (2005.1125D0+(-0.85294D0-0.000365D0*BIGT)*BIGT+ 74 | : (-0.42647D0-0.000365D0*BIGT-0.041802D0*T)*T)*TAS2R 75 | 76 | * Rotation matrix 77 | CALL sla_DEULER('ZYZ',-ZETA,THETA,-Z,RMATP) 78 | 79 | END 80 | -------------------------------------------------------------------------------- /prenut.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_PRENUT (EPOCH, DATE, RMATPN) 2 | *+ 3 | * - - - - - - - 4 | * P R E N U T 5 | * - - - - - - - 6 | * 7 | * Form the matrix of precession and nutation (SF2001) 8 | * (double precision) 9 | * 10 | * Given: 11 | * EPOCH dp Julian Epoch for mean coordinates 12 | * DATE dp Modified Julian Date (JD-2400000.5) 13 | * for true coordinates 14 | * 15 | * Returned: 16 | * RMATPN dp(3,3) combined precession/nutation matrix 17 | * 18 | * Called: sla_PREC, sla_EPJ, sla_NUT, sla_DMXM 19 | * 20 | * Notes: 21 | * 22 | * 1) The epoch and date are TDB (loosely ET). TT will do, or even 23 | * UTC. 24 | * 25 | * 2) The matrix is in the sense V(true) = RMATPN * V(mean) 26 | * 27 | * Last revision: 3 December 2005 28 | * 29 | * Copyright P.T.Wallace. All rights reserved. 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | DOUBLE PRECISION EPOCH,DATE,RMATPN(3,3) 52 | 53 | DOUBLE PRECISION RMATP(3,3),RMATN(3,3),sla_EPJ 54 | 55 | 56 | 57 | * Precession 58 | CALL sla_PREC(EPOCH,sla_EPJ(DATE),RMATP) 59 | 60 | * Nutation 61 | CALL sla_NUT(DATE,RMATN) 62 | 63 | * Combine the matrices: PN = N x P 64 | CALL sla_DMXM(RMATN,RMATP,RMATPN) 65 | 66 | END 67 | -------------------------------------------------------------------------------- /pvobs.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_PVOBS (P, H, STL, PV) 2 | *+ 3 | * - - - - - - 4 | * P V O B S 5 | * - - - - - - 6 | * 7 | * Position and velocity of an observing station (double precision) 8 | * 9 | * Given: 10 | * P dp latitude (geodetic, radians) 11 | * H dp height above reference spheroid (geodetic, metres) 12 | * STL dp local apparent sidereal time (radians) 13 | * 14 | * Returned: 15 | * PV dp(6) position/velocity 6-vector (AU, AU/s, true equator 16 | * and equinox of date) 17 | * 18 | * Called: sla_GEOC 19 | * 20 | * IAU 1976 constants are used. 21 | * 22 | * P.T.Wallace Starlink 14 November 1994 23 | * 24 | * Copyright (C) 1995 Rutherford Appleton Laboratory 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | DOUBLE PRECISION P,H,STL,PV(6) 47 | 48 | DOUBLE PRECISION R,Z,S,C,V 49 | 50 | * Mean sidereal rate (at J2000) in radians per (UT1) second 51 | DOUBLE PRECISION SR 52 | PARAMETER (SR=7.292115855306589D-5) 53 | 54 | 55 | 56 | * Geodetic to geocentric conversion 57 | CALL sla_GEOC(P,H,R,Z) 58 | 59 | * Functions of ST 60 | S=SIN(STL) 61 | C=COS(STL) 62 | 63 | * Speed 64 | V=SR*R 65 | 66 | * Position 67 | PV(1)=R*C 68 | PV(2)=R*S 69 | PV(3)=Z 70 | 71 | * Velocity 72 | PV(4)=-V*S 73 | PV(5)=V*C 74 | PV(6)=0D0 75 | 76 | END 77 | -------------------------------------------------------------------------------- /random.F: -------------------------------------------------------------------------------- 1 | #include 2 | REAL FUNCTION sla_RANDOM (SEED) 3 | *+ 4 | * - - - - - - - 5 | * R A N D O M 6 | * - - - - - - - 7 | * 8 | * Generate pseudo-random real number in the range 0 <= X < 1. 9 | * (single precision) 10 | * 11 | * 12 | * Given: 13 | * SEED real an arbitrary real number 14 | * 15 | * Notes: 16 | * 17 | * 1) The result is a pseudo-random REAL number in the range 18 | * 0 <= sla_RANDOM < 1. 19 | * 20 | * 2) SEED is used first time through only. 21 | * 22 | * Called: RAN or RAND (a REAL function returning a random variate -- 23 | * the precise function which is called depends on which functions 24 | * are available when the library is built). If neither of these 25 | * is available, we use the local substitute RANDOM defined 26 | * in rtl_random.c 27 | * 28 | * P.T.Wallace Starlink 14 October 1991 29 | * 30 | * License: 31 | * This program is free software; you can redistribute it and/or modify 32 | * it under the terms of the GNU General Public License as published by 33 | * the Free Software Foundation; either version 2 of the License, or 34 | * (at your option) any later version. 35 | * 36 | * This program is distributed in the hope that it will be useful, 37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | * GNU General Public License for more details. 40 | * 41 | * You should have received a copy of the GNU General Public License 42 | * along with this program (see SLA_CONDITIONS); if not, write to the 43 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 44 | * Boston, MA 02111-1307 USA 45 | *- 46 | 47 | IMPLICIT NONE 48 | 49 | REAL SEED 50 | 51 | #if HAVE_RAND 52 | REAL RAND 53 | #elif HAVE_RANDOM 54 | REAL RANDOM 55 | #else 56 | error "Can't find random-number function" 57 | #endif 58 | 59 | REAL AS 60 | INTEGER ISEED 61 | LOGICAL FIRST 62 | SAVE FIRST 63 | DATA FIRST /.TRUE./ 64 | 65 | 66 | 67 | * If first time, turn SEED into a large, odd integer 68 | IF (FIRST) THEN 69 | AS=ABS(SEED)+1.0 70 | ISEED=NINT(AS/10.0**(NINT(ALOG10(AS))-6)) 71 | IF (MOD(ISEED,2).EQ.0) ISEED=ISEED+1 72 | FIRST=.FALSE. 73 | #if HAVE_RAND 74 | AS = RAND(ISEED) 75 | #endif 76 | ELSE 77 | ISEED=0 78 | END IF 79 | 80 | * Next pseudo-random number 81 | #if HAVE_RAND 82 | sla_RANDOM=RAND(0) 83 | #elif HAVE_RANDOM 84 | sla_RANDOM=RANDOM(ISEED) 85 | #endif 86 | 87 | END 88 | -------------------------------------------------------------------------------- /range.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_RANGE (ANGLE) 2 | *+ 3 | * - - - - - - 4 | * R A N G E 5 | * - - - - - - 6 | * 7 | * Normalize angle into range +/- pi (single precision) 8 | * 9 | * Given: 10 | * ANGLE dp the angle in radians 11 | * 12 | * The result is ANGLE expressed in the +/- pi (single 13 | * precision). 14 | * 15 | * P.T.Wallace Starlink 23 November 1995 16 | * 17 | * Copyright (C) 1995 Rutherford Appleton Laboratory 18 | * 19 | * License: 20 | * This program is free software; you can redistribute it and/or modify 21 | * it under the terms of the GNU General Public License as published by 22 | * the Free Software Foundation; either version 2 of the License, or 23 | * (at your option) any later version. 24 | * 25 | * This program is distributed in the hope that it will be useful, 26 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | * GNU General Public License for more details. 29 | * 30 | * You should have received a copy of the GNU General Public License 31 | * along with this program (see SLA_CONDITIONS); if not, write to the 32 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 33 | * Boston, MA 02111-1307 USA 34 | * 35 | *- 36 | 37 | IMPLICIT NONE 38 | 39 | REAL ANGLE 40 | 41 | REAL API,A2PI 42 | PARAMETER (API=3.141592653589793238462643) 43 | PARAMETER (A2PI=6.283185307179586476925287) 44 | 45 | 46 | sla_RANGE=MOD(ANGLE,A2PI) 47 | IF (ABS(sla_RANGE).GE.API) 48 | : sla_RANGE=sla_RANGE-SIGN(A2PI,ANGLE) 49 | 50 | END 51 | -------------------------------------------------------------------------------- /ranorm.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_RANORM (ANGLE) 2 | *+ 3 | * - - - - - - - 4 | * R A N O R M 5 | * - - - - - - - 6 | * 7 | * Normalize angle into range 0-2 pi (single precision) 8 | * 9 | * Given: 10 | * ANGLE dp the angle in radians 11 | * 12 | * The result is ANGLE expressed in the range 0-2 pi (single 13 | * precision). 14 | * 15 | * P.T.Wallace Starlink 23 November 1995 16 | * 17 | * Copyright (C) 1995 Rutherford Appleton Laboratory 18 | * 19 | * License: 20 | * This program is free software; you can redistribute it and/or modify 21 | * it under the terms of the GNU General Public License as published by 22 | * the Free Software Foundation; either version 2 of the License, or 23 | * (at your option) any later version. 24 | * 25 | * This program is distributed in the hope that it will be useful, 26 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | * GNU General Public License for more details. 29 | * 30 | * You should have received a copy of the GNU General Public License 31 | * along with this program (see SLA_CONDITIONS); if not, write to the 32 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 33 | * Boston, MA 02111-1307 USA 34 | * 35 | *- 36 | 37 | IMPLICIT NONE 38 | 39 | REAL ANGLE 40 | 41 | REAL A2PI 42 | PARAMETER (A2PI=6.283185307179586476925287) 43 | 44 | 45 | sla_RANORM=MOD(ANGLE,A2PI) 46 | IF (sla_RANORM.LT.0.0) sla_RANORM=sla_RANORM+A2PI 47 | 48 | END 49 | -------------------------------------------------------------------------------- /rverot.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_RVEROT (PHI, RA, DA, ST) 2 | *+ 3 | * - - - - - - - 4 | * R V E R O T 5 | * - - - - - - - 6 | * 7 | * Velocity component in a given direction due to Earth rotation 8 | * (single precision) 9 | * 10 | * Given: 11 | * PHI real latitude of observing station (geodetic) 12 | * RA,DA real apparent RA,DEC 13 | * ST real local apparent sidereal time 14 | * 15 | * PHI, RA, DEC and ST are all in radians. 16 | * 17 | * Result: 18 | * Component of Earth rotation in direction RA,DA (km/s) 19 | * 20 | * Sign convention: 21 | * The result is +ve when the observatory is receding from the 22 | * given point on the sky. 23 | * 24 | * Accuracy: 25 | * The simple algorithm used assumes a spherical Earth, of 26 | * a radius chosen to give results accurate to about 0.0005 km/s 27 | * for observing stations at typical latitudes and heights. For 28 | * applications requiring greater precision, use the routine 29 | * sla_PVOBS. 30 | * 31 | * P.T.Wallace Starlink 20 July 1994 32 | * 33 | * Copyright (C) 1995 Rutherford Appleton Laboratory 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | REAL PHI,RA,DA,ST 56 | 57 | * Nominal mean sidereal speed of Earth equator in km/s (the actual 58 | * value is about 0.4651) 59 | REAL ESPEED 60 | PARAMETER (ESPEED=0.4655) 61 | 62 | 63 | sla_RVEROT=ESPEED*COS(PHI)*SIN(ST-RA)*COS(DA) 64 | 65 | END 66 | -------------------------------------------------------------------------------- /rvgalc.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_RVGALC (R2000, D2000) 2 | *+ 3 | * - - - - - - - 4 | * R V G A L C 5 | * - - - - - - - 6 | * 7 | * Velocity component in a given direction due to the rotation 8 | * of the Galaxy (single precision) 9 | * 10 | * Given: 11 | * R2000,D2000 real J2000.0 mean RA,Dec (radians) 12 | * 13 | * Result: 14 | * Component of dynamical LSR motion in direction R2000,D2000 (km/s) 15 | * 16 | * Sign convention: 17 | * The result is +ve when the dynamical LSR is receding from the 18 | * given point on the sky. 19 | * 20 | * Note: The Local Standard of Rest used here is a point in the 21 | * vicinity of the Sun which is in a circular orbit around 22 | * the Galactic centre. Sometimes called the "dynamical" LSR, 23 | * it is not to be confused with a "kinematical" LSR, which 24 | * is the mean standard of rest of star catalogues or stellar 25 | * populations. 26 | * 27 | * Reference: The orbital speed of 220 km/s used here comes from 28 | * Kerr & Lynden-Bell (1986), MNRAS, 221, p1023. 29 | * 30 | * Called: 31 | * sla_CS2C, sla_VDV 32 | * 33 | * P.T.Wallace Starlink 23 March 1994 34 | * 35 | * Copyright (C) 1995 Rutherford Appleton Laboratory 36 | * 37 | * License: 38 | * This program is free software; you can redistribute it and/or modify 39 | * it under the terms of the GNU General Public License as published by 40 | * the Free Software Foundation; either version 2 of the License, or 41 | * (at your option) any later version. 42 | * 43 | * This program is distributed in the hope that it will be useful, 44 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 45 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 46 | * GNU General Public License for more details. 47 | * 48 | * You should have received a copy of the GNU General Public License 49 | * along with this program (see SLA_CONDITIONS); if not, write to the 50 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 51 | * Boston, MA 02111-1307 USA 52 | * 53 | *- 54 | 55 | IMPLICIT NONE 56 | 57 | REAL R2000,D2000 58 | 59 | REAL VA(3), VB(3) 60 | 61 | REAL sla_VDV 62 | 63 | * 64 | * LSR velocity due to Galactic rotation 65 | * 66 | * Speed = 220 km/s 67 | * Apex = L2,B2 90deg, 0deg 68 | * = RA,Dec 21 12 01.1 +48 19 47 J2000.0 69 | * 70 | * This is expressed in the form of a J2000.0 x,y,z vector: 71 | * 72 | * VA(1) = X = -SPEED*COS(RA)*COS(DEC) 73 | * VA(2) = Y = -SPEED*SIN(RA)*COS(DEC) 74 | * VA(3) = Z = -SPEED*SIN(DEC) 75 | 76 | DATA VA / -108.70408, +97.86251, -164.33610 / 77 | 78 | 79 | 80 | * Convert given J2000 RA,Dec to x,y,z 81 | CALL sla_CS2C(R2000,D2000,VB) 82 | 83 | * Compute dot product with LSR motion vector 84 | sla_RVGALC=sla_VDV(VA,VB) 85 | 86 | END 87 | -------------------------------------------------------------------------------- /rvlg.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_RVLG (R2000, D2000) 2 | *+ 3 | * - - - - - 4 | * R V L G 5 | * - - - - - 6 | * 7 | * Velocity component in a given direction due to the combination 8 | * of the rotation of the Galaxy and the motion of the Galaxy 9 | * relative to the mean motion of the local group (single precision) 10 | * 11 | * Given: 12 | * R2000,D2000 real J2000.0 mean RA,Dec (radians) 13 | * 14 | * Result: 15 | * Component of SOLAR motion in direction R2000,D2000 (km/s) 16 | * 17 | * Sign convention: 18 | * The result is +ve when the Sun is receding from the 19 | * given point on the sky. 20 | * 21 | * Reference: 22 | * IAU Trans 1976, 168, p201. 23 | * 24 | * Called: 25 | * sla_CS2C, sla_VDV 26 | * 27 | * P.T.Wallace Starlink June 1985 28 | * 29 | * Copyright (C) 1995 Rutherford Appleton Laboratory 30 | * 31 | * License: 32 | * This program is free software; you can redistribute it and/or modify 33 | * it under the terms of the GNU General Public License as published by 34 | * the Free Software Foundation; either version 2 of the License, or 35 | * (at your option) any later version. 36 | * 37 | * This program is distributed in the hope that it will be useful, 38 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 39 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 40 | * GNU General Public License for more details. 41 | * 42 | * You should have received a copy of the GNU General Public License 43 | * along with this program (see SLA_CONDITIONS); if not, write to the 44 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 45 | * Boston, MA 02111-1307 USA 46 | * 47 | *- 48 | 49 | IMPLICIT NONE 50 | 51 | REAL R2000,D2000 52 | 53 | REAL VA(3), VB(3) 54 | 55 | REAL sla_VDV 56 | 57 | * 58 | * Solar velocity due to Galactic rotation and translation 59 | * 60 | * Speed = 300 km/s 61 | * 62 | * Apex = L2,B2 90deg, 0deg 63 | * = RA,Dec 21 12 01.1 +48 19 47 J2000.0 64 | * 65 | * This is expressed in the form of a J2000.0 x,y,z vector: 66 | * 67 | * VA(1) = X = -SPEED*COS(RA)*COS(DEC) 68 | * VA(2) = Y = -SPEED*SIN(RA)*COS(DEC) 69 | * VA(3) = Z = -SPEED*SIN(DEC) 70 | 71 | DATA VA / -148.23284, +133.44888, -224.09467 / 72 | 73 | 74 | 75 | * Convert given J2000 RA,Dec to x,y,z 76 | CALL sla_CS2C(R2000,D2000,VB) 77 | 78 | * Compute dot product with Solar motion vector 79 | sla_RVLG=sla_VDV(VA,VB) 80 | 81 | END 82 | -------------------------------------------------------------------------------- /s2tp.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_S2TP (RA, DEC, RAZ, DECZ, XI, ETA, J) 2 | *+ 3 | * - - - - - 4 | * S 2 T P 5 | * - - - - - 6 | * 7 | * Projection of spherical coordinates onto tangent plane: 8 | * "gnomonic" projection - "standard coordinates" 9 | * (single precision) 10 | * 11 | * Given: 12 | * RA,DEC real spherical coordinates of point to be projected 13 | * RAZ,DECZ real spherical coordinates of tangent point 14 | * 15 | * Returned: 16 | * XI,ETA real rectangular coordinates on tangent plane 17 | * J int status: 0 = OK, star on tangent plane 18 | * 1 = error, star too far from axis 19 | * 2 = error, antistar on tangent plane 20 | * 3 = error, antistar too far from axis 21 | * 22 | * P.T.Wallace Starlink 18 July 1996 23 | * 24 | * Copyright (C) 1996 Rutherford Appleton Laboratory 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | REAL RA,DEC,RAZ,DECZ,XI,ETA 47 | INTEGER J 48 | 49 | REAL SDECZ,SDEC,CDECZ,CDEC,RADIF,SRADIF,CRADIF,DENOM 50 | 51 | REAL TINY 52 | PARAMETER (TINY=1E-6) 53 | 54 | 55 | * Trig functions 56 | SDECZ=SIN(DECZ) 57 | SDEC=SIN(DEC) 58 | CDECZ=COS(DECZ) 59 | CDEC=COS(DEC) 60 | RADIF=RA-RAZ 61 | SRADIF=SIN(RADIF) 62 | CRADIF=COS(RADIF) 63 | 64 | * Reciprocal of star vector length to tangent plane 65 | DENOM=SDEC*SDECZ+CDEC*CDECZ*CRADIF 66 | 67 | * Handle vectors too far from axis 68 | IF (DENOM.GT.TINY) THEN 69 | J=0 70 | ELSE IF (DENOM.GE.0.0) THEN 71 | J=1 72 | DENOM=TINY 73 | ELSE IF (DENOM.GT.-TINY) THEN 74 | J=2 75 | DENOM=-TINY 76 | ELSE 77 | J=3 78 | END IF 79 | 80 | * Compute tangent plane coordinates (even in dubious cases) 81 | XI=CDEC*SRADIF/DENOM 82 | ETA=(SDEC*CDECZ-CDEC*SDECZ*CRADIF)/DENOM 83 | 84 | END 85 | -------------------------------------------------------------------------------- /sep.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_SEP (A1, B1, A2, B2) 2 | *+ 3 | * - - - - 4 | * S E P 5 | * - - - - 6 | * 7 | * Angle between two points on a sphere. 8 | * 9 | * (single precision) 10 | * 11 | * Given: 12 | * A1,B1 r spherical coordinates of one point 13 | * A2,B2 r spherical coordinates of the other point 14 | * 15 | * (The spherical coordinates are [RA,Dec], [Long,Lat] etc, in radians.) 16 | * 17 | * The result is the angle, in radians, between the two points. It 18 | * is always positive. 19 | * 20 | * Called: sla_DSEP 21 | * 22 | * Last revision: 7 May 2000 23 | * 24 | * Copyright P.T.Wallace. All rights reserved. 25 | * 26 | * License: 27 | * This program is free software; you can redistribute it and/or modify 28 | * it under the terms of the GNU General Public License as published by 29 | * the Free Software Foundation; either version 2 of the License, or 30 | * (at your option) any later version. 31 | * 32 | * This program is distributed in the hope that it will be useful, 33 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 34 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35 | * GNU General Public License for more details. 36 | * 37 | * You should have received a copy of the GNU General Public License 38 | * along with this program (see SLA_CONDITIONS); if not, write to the 39 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 40 | * Boston, MA 02111-1307 USA 41 | * 42 | *- 43 | 44 | IMPLICIT NONE 45 | 46 | REAL A1,B1,A2,B2 47 | 48 | DOUBLE PRECISION sla_DSEP 49 | 50 | 51 | 52 | * Use double precision version. 53 | sla_SEP = REAL(sla_DSEP(DBLE(A1),DBLE(B1),DBLE(A2),DBLE(B2))) 54 | 55 | END 56 | -------------------------------------------------------------------------------- /sepv.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_SEPV (V1, V2) 2 | *+ 3 | * - - - - - 4 | * S E P V 5 | * - - - - - 6 | * 7 | * Angle between two vectors. 8 | * 9 | * (single precision) 10 | * 11 | * Given: 12 | * V1 r(3) first vector 13 | * V2 r(3) second vector 14 | * 15 | * The result is the angle, in radians, between the two vectors. It 16 | * is always positive. 17 | * 18 | * Notes: 19 | * 20 | * 1 There is no requirement for the vectors to be unit length. 21 | * 22 | * 2 If either vector is null, zero is returned. 23 | * 24 | * 3 The simplest formulation would use dot product alone. However, 25 | * this would reduce the accuracy for angles near zero and pi. The 26 | * algorithm uses both cross product and dot product, which maintains 27 | * accuracy for all sizes of angle. 28 | * 29 | * Called: sla_DSEPV 30 | * 31 | * Last revision: 7 May 2000 32 | * 33 | * Copyright P.T.Wallace. All rights reserved. 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | REAL V1(3),V2(3) 56 | 57 | INTEGER I 58 | DOUBLE PRECISION DV1(3),DV2(3) 59 | DOUBLE PRECISION sla_DSEPV 60 | 61 | 62 | 63 | * Use double precision version. 64 | DO I=1,3 65 | DV1(I) = DBLE(V1(I)) 66 | DV2(I) = DBLE(V2(I)) 67 | END DO 68 | sla_SEPV = REAL(sla_DSEPV(DV1,DV2)) 69 | 70 | END 71 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import glob 3 | from numpy.distutils.core import setup, Extension 4 | import pickle 5 | import get_docstring 6 | 7 | # Generate documentation dictionary and save it in "lib/" 8 | docstring = get_docstring.get_docstring() 9 | f = open("lib/docstring_pickle.pkl", "wb") 10 | pickle.dump(docstring, f) 11 | f.close() 12 | 13 | ext1 = Extension(name = 'pyslalib.slalib', 14 | include_dirs = ['.'], 15 | sources = ['slalib.pyf']+\ 16 | glob.glob("*.f")+\ 17 | glob.glob("*.F")) 18 | 19 | if __name__ == "__main__": 20 | setup(name = 'pySLALIB', 21 | description = "f2py and numpy based wrappers for SLALIB", 22 | version = "1.0.4", 23 | author = "Scott Ransom", 24 | author_email = "sransom@nrao.edu", 25 | packages = ['pyslalib'], 26 | package_dir = {'pyslalib': 'lib'}, 27 | package_data = {'pyslalib': ['docstring_pickle.pkl']}, 28 | ext_modules = [ext1] 29 | ) 30 | -------------------------------------------------------------------------------- /sla_config.h: -------------------------------------------------------------------------------- 1 | /* config.h. Generated by configure. */ 2 | /* config.h.in. Generated from configure.ac by autoheader. */ 3 | 4 | /* Define to alternate name for `main' routine that is called from a `main' in 5 | the Fortran libraries. */ 6 | #define FC_MAIN MAIN__ 7 | 8 | /* Define to 1 if you have the header file. */ 9 | #define HAVE_DLFCN_H 1 10 | 11 | /* True when Fortran main isn't C main */ 12 | #define HAVE_FC_MAIN 1 13 | 14 | /* Define to 1 if you have the header file. */ 15 | #define HAVE_INTTYPES_H 1 16 | 17 | /* Define to 1 if you have the header file. */ 18 | #define HAVE_MEMORY_H 1 19 | 20 | /* Define to 1 if you have the `rand' function. */ 21 | #define HAVE_RAND 1 22 | 23 | /* Define to 1 if you have the `random' function. */ 24 | #define HAVE_RANDOM 1 25 | 26 | /* Define to 1 if you have the header file. */ 27 | #define HAVE_STDINT_H 1 28 | 29 | /* Define to 1 if you have the header file. */ 30 | #define HAVE_STDLIB_H 1 31 | 32 | /* Define to 1 if you have the header file. */ 33 | #define HAVE_STRINGS_H 1 34 | 35 | /* Define to 1 if you have the header file. */ 36 | #define HAVE_STRING_H 1 37 | 38 | /* Define to 1 if you have the header file. */ 39 | #define HAVE_SYS_STAT_H 1 40 | 41 | /* Define to 1 if you have the header file. */ 42 | #define HAVE_SYS_TYPES_H 1 43 | 44 | /* Define to 1 if you have the header file. */ 45 | #define HAVE_UNISTD_H 1 46 | 47 | /* Name of package */ 48 | #define PACKAGE "sla" 49 | 50 | /* Define to the address where bug reports for this package should be sent. */ 51 | #define PACKAGE_BUGREPORT "ussc@star.rl.ac.uk" 52 | 53 | /* Define to the full name of this package. */ 54 | #define PACKAGE_NAME "sla" 55 | 56 | /* Define to the full name and version of this package. */ 57 | #define PACKAGE_STRING "sla 2.5-4" 58 | 59 | /* Define to the one symbol short name of this package. */ 60 | #define PACKAGE_TARNAME "sla" 61 | 62 | /* Define to the version of this package. */ 63 | #define PACKAGE_VERSION "2.5-4" 64 | 65 | /* Define to 1 if you have the ANSI C header files. */ 66 | #define STDC_HEADERS 1 67 | 68 | /* Version number of package */ 69 | #define VERSION "2.5-4" 70 | -------------------------------------------------------------------------------- /stdeb.cfg: -------------------------------------------------------------------------------- 1 | [DEFAULT] 2 | 3 | Build-Depends: python-numpy, gfortran. python-dev 4 | Depends: python-numpy 5 | #Debian-Version: atnf1 6 | -------------------------------------------------------------------------------- /subet.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_SUBET (RC, DC, EQ, RM, DM) 2 | *+ 3 | * - - - - - - 4 | * S U B E T 5 | * - - - - - - 6 | * 7 | * Remove the E-terms (elliptic component of annual aberration) 8 | * from a pre IAU 1976 catalogue RA,Dec to give a mean place 9 | * (double precision) 10 | * 11 | * Given: 12 | * RC,DC dp RA,Dec (radians) with E-terms included 13 | * EQ dp Besselian epoch of mean equator and equinox 14 | * 15 | * Returned: 16 | * RM,DM dp RA,Dec (radians) without E-terms 17 | * 18 | * Called: 19 | * sla_ETRMS, sla_DCS2C, sla_,DVDV, sla_DCC2S, sla_DRANRM 20 | * 21 | * Explanation: 22 | * Most star positions from pre-1984 optical catalogues (or 23 | * derived from astrometry using such stars) embody the 24 | * E-terms. This routine converts such a position to a 25 | * formal mean place (allowing, for example, comparison with a 26 | * pulsar timing position). 27 | * 28 | * Reference: 29 | * Explanatory Supplement to the Astronomical Ephemeris, 30 | * section 2D, page 48. 31 | * 32 | * P.T.Wallace Starlink 10 May 1990 33 | * 34 | * Copyright (C) 1995 Rutherford Appleton Laboratory 35 | * 36 | * License: 37 | * This program is free software; you can redistribute it and/or modify 38 | * it under the terms of the GNU General Public License as published by 39 | * the Free Software Foundation; either version 2 of the License, or 40 | * (at your option) any later version. 41 | * 42 | * This program is distributed in the hope that it will be useful, 43 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 44 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 45 | * GNU General Public License for more details. 46 | * 47 | * You should have received a copy of the GNU General Public License 48 | * along with this program (see SLA_CONDITIONS); if not, write to the 49 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 50 | * Boston, MA 02111-1307 USA 51 | * 52 | *- 53 | 54 | IMPLICIT NONE 55 | 56 | DOUBLE PRECISION RC,DC,EQ,RM,DM 57 | 58 | DOUBLE PRECISION sla_DRANRM,sla_DVDV 59 | DOUBLE PRECISION A(3),V(3),F 60 | 61 | INTEGER I 62 | 63 | 64 | 65 | * E-terms 66 | CALL sla_ETRMS(EQ,A) 67 | 68 | * Spherical to Cartesian 69 | CALL sla_DCS2C(RC,DC,V) 70 | 71 | * Include the E-terms 72 | F=1D0+sla_DVDV(V,A) 73 | DO I=1,3 74 | V(I)=F*V(I)-A(I) 75 | END DO 76 | 77 | * Cartesian to spherical 78 | CALL sla_DCC2S(V,RM,DM) 79 | 80 | * Bring RA into conventional range 81 | RM=sla_DRANRM(RM) 82 | 83 | END 84 | -------------------------------------------------------------------------------- /svdcov.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_SVDCOV (N, NP, NC, W, V, WORK, CVM) 2 | *+ 3 | * - - - - - - - 4 | * S V D C O V 5 | * - - - - - - - 6 | * 7 | * From the W and V matrices from the SVD factorisation of a matrix 8 | * (as obtained from the sla_SVD routine), obtain the covariance matrix. 9 | * 10 | * (double precision) 11 | * 12 | * Given: 13 | * N i number of rows and columns in matrices W and V 14 | * NP i first dimension of array containing matrix V 15 | * NC i first dimension of array to receive CVM 16 | * W d(N) NxN diagonal matrix W (diagonal elements only) 17 | * V d(NP,NP) array containing NxN orthogonal matrix V 18 | * 19 | * Returned: 20 | * WORK d(N) workspace 21 | * CVM d(NC,NC) array to receive covariance matrix 22 | * 23 | * Reference: 24 | * Numerical Recipes, section 14.3. 25 | * 26 | * P.T.Wallace Starlink December 1988 27 | * 28 | * Copyright (C) 1995 Rutherford Appleton Laboratory 29 | * 30 | * License: 31 | * This program is free software; you can redistribute it and/or modify 32 | * it under the terms of the GNU General Public License as published by 33 | * the Free Software Foundation; either version 2 of the License, or 34 | * (at your option) any later version. 35 | * 36 | * This program is distributed in the hope that it will be useful, 37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | * GNU General Public License for more details. 40 | * 41 | * You should have received a copy of the GNU General Public License 42 | * along with this program (see SLA_CONDITIONS); if not, write to the 43 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 44 | * Boston, MA 02111-1307 USA 45 | * 46 | *- 47 | 48 | IMPLICIT NONE 49 | 50 | INTEGER N,NP,NC 51 | DOUBLE PRECISION W(N),V(NP,NP),WORK(N),CVM(NC,NC) 52 | 53 | INTEGER I,J,K 54 | DOUBLE PRECISION S 55 | 56 | 57 | 58 | DO I=1,N 59 | S=W(I) 60 | IF (S.NE.0D0) THEN 61 | WORK(I)=1D0/(S*S) 62 | ELSE 63 | WORK(I)=0D0 64 | END IF 65 | END DO 66 | DO I=1,N 67 | DO J=1,I 68 | S=0D0 69 | DO K=1,N 70 | S=S+V(I,K)*V(J,K)*WORK(K) 71 | END DO 72 | CVM(I,J)=S 73 | CVM(J,I)=S 74 | END DO 75 | END DO 76 | 77 | END 78 | -------------------------------------------------------------------------------- /tp2s.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_TP2S (XI, ETA, RAZ, DECZ, RA, DEC) 2 | *+ 3 | * - - - - - 4 | * T P 2 S 5 | * - - - - - 6 | * 7 | * Transform tangent plane coordinates into spherical 8 | * (single precision) 9 | * 10 | * Given: 11 | * XI,ETA real tangent plane rectangular coordinates 12 | * RAZ,DECZ real spherical coordinates of tangent point 13 | * 14 | * Returned: 15 | * RA,DEC real spherical coordinates (0-2pi,+/-pi/2) 16 | * 17 | * Called: sla_RANORM 18 | * 19 | * P.T.Wallace Starlink 24 July 1995 20 | * 21 | * Copyright (C) 1995 Rutherford Appleton Laboratory 22 | * 23 | * License: 24 | * This program is free software; you can redistribute it and/or modify 25 | * it under the terms of the GNU General Public License as published by 26 | * the Free Software Foundation; either version 2 of the License, or 27 | * (at your option) any later version. 28 | * 29 | * This program is distributed in the hope that it will be useful, 30 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 31 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32 | * GNU General Public License for more details. 33 | * 34 | * You should have received a copy of the GNU General Public License 35 | * along with this program (see SLA_CONDITIONS); if not, write to the 36 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 37 | * Boston, MA 02111-1307 USA 38 | * 39 | *- 40 | 41 | IMPLICIT NONE 42 | 43 | REAL XI,ETA,RAZ,DECZ,RA,DEC 44 | 45 | REAL sla_RANORM 46 | 47 | REAL SDECZ,CDECZ,DENOM 48 | 49 | 50 | 51 | SDECZ=SIN(DECZ) 52 | CDECZ=COS(DECZ) 53 | 54 | DENOM=CDECZ-ETA*SDECZ 55 | 56 | RA=sla_RANORM(ATAN2(XI,DENOM)+RAZ) 57 | DEC=ATAN2(SDECZ+ETA*CDECZ,SQRT(XI*XI+DENOM*DENOM)) 58 | 59 | END 60 | -------------------------------------------------------------------------------- /tp2v.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_TP2V (XI, ETA, V0, V) 2 | *+ 3 | * - - - - - 4 | * T P 2 V 5 | * - - - - - 6 | * 7 | * Given the tangent-plane coordinates of a star and the direction 8 | * cosines of the tangent point, determine the direction cosines 9 | * of the star. 10 | * 11 | * (single precision) 12 | * 13 | * Given: 14 | * XI,ETA r tangent plane coordinates of star 15 | * V0 r(3) direction cosines of tangent point 16 | * 17 | * Returned: 18 | * V r(3) direction cosines of star 19 | * 20 | * Notes: 21 | * 22 | * 1 If vector V0 is not of unit length, the returned vector V will 23 | * be wrong. 24 | * 25 | * 2 If vector V0 points at a pole, the returned vector V will be 26 | * based on the arbitrary assumption that the RA of the tangent 27 | * point is zero. 28 | * 29 | * 3 This routine is the Cartesian equivalent of the routine sla_TP2S. 30 | * 31 | * P.T.Wallace Starlink 11 February 1995 32 | * 33 | * Copyright (C) 1995 Rutherford Appleton Laboratory 34 | * 35 | * License: 36 | * This program is free software; you can redistribute it and/or modify 37 | * it under the terms of the GNU General Public License as published by 38 | * the Free Software Foundation; either version 2 of the License, or 39 | * (at your option) any later version. 40 | * 41 | * This program is distributed in the hope that it will be useful, 42 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 43 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 44 | * GNU General Public License for more details. 45 | * 46 | * You should have received a copy of the GNU General Public License 47 | * along with this program (see SLA_CONDITIONS); if not, write to the 48 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 49 | * Boston, MA 02111-1307 USA 50 | * 51 | *- 52 | 53 | IMPLICIT NONE 54 | 55 | REAL XI,ETA,V0(3),V(3) 56 | 57 | REAL X,Y,Z,F,R 58 | 59 | 60 | X=V0(1) 61 | Y=V0(2) 62 | Z=V0(3) 63 | F=SQRT(1.0+XI*XI+ETA*ETA) 64 | R=SQRT(X*X+Y*Y) 65 | IF (R.EQ.0.0) THEN 66 | R=1E-20 67 | X=R 68 | END IF 69 | V(1)=(X-(XI*Y+ETA*X*Z)/R)/F 70 | V(2)=(Y+(XI*X-ETA*Y*Z)/R)/F 71 | V(3)=(Z+ETA*R)/F 72 | 73 | END 74 | -------------------------------------------------------------------------------- /v2tp.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_V2TP (V, V0, XI, ETA, J) 2 | *+ 3 | * - - - - - 4 | * V 2 T P 5 | * - - - - - 6 | * 7 | * Given the direction cosines of a star and of the tangent point, 8 | * determine the star's tangent-plane coordinates. 9 | * 10 | * (single precision) 11 | * 12 | * Given: 13 | * V r(3) direction cosines of star 14 | * V0 r(3) direction cosines of tangent point 15 | * 16 | * Returned: 17 | * XI,ETA r tangent plane coordinates of star 18 | * J i status: 0 = OK 19 | * 1 = error, star too far from axis 20 | * 2 = error, antistar on tangent plane 21 | * 3 = error, antistar too far from axis 22 | * 23 | * Notes: 24 | * 25 | * 1 If vector V0 is not of unit length, or if vector V is of zero 26 | * length, the results will be wrong. 27 | * 28 | * 2 If V0 points at a pole, the returned XI,ETA will be based on the 29 | * arbitrary assumption that the RA of the tangent point is zero. 30 | * 31 | * 3 This routine is the Cartesian equivalent of the routine sla_S2TP. 32 | * 33 | * P.T.Wallace Starlink 27 November 1996 34 | * 35 | * Copyright (C) 1996 Rutherford Appleton Laboratory 36 | * 37 | * License: 38 | * This program is free software; you can redistribute it and/or modify 39 | * it under the terms of the GNU General Public License as published by 40 | * the Free Software Foundation; either version 2 of the License, or 41 | * (at your option) any later version. 42 | * 43 | * This program is distributed in the hope that it will be useful, 44 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 45 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 46 | * GNU General Public License for more details. 47 | * 48 | * You should have received a copy of the GNU General Public License 49 | * along with this program (see SLA_CONDITIONS); if not, write to the 50 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 51 | * Boston, MA 02111-1307 USA 52 | * 53 | *- 54 | 55 | IMPLICIT NONE 56 | 57 | REAL V(3),V0(3),XI,ETA 58 | INTEGER J 59 | 60 | REAL X,Y,Z,X0,Y0,Z0,R2,R,W,D 61 | 62 | REAL TINY 63 | PARAMETER (TINY=1E-6) 64 | 65 | 66 | X=V(1) 67 | Y=V(2) 68 | Z=V(3) 69 | X0=V0(1) 70 | Y0=V0(2) 71 | Z0=V0(3) 72 | R2=X0*X0+Y0*Y0 73 | R=SQRT(R2) 74 | IF (R.EQ.0.0) THEN 75 | R=1E-20 76 | X0=R 77 | END IF 78 | W=X*X0+Y*Y0 79 | D=W+Z*Z0 80 | IF (D.GT.TINY) THEN 81 | J=0 82 | ELSE IF (D.GE.0.0) THEN 83 | J=1 84 | D=TINY 85 | ELSE IF (D.GT.-TINY) THEN 86 | J=2 87 | D=-TINY 88 | ELSE 89 | J=3 90 | END IF 91 | D=D*R 92 | XI=(Y*X0-X*Y0)/D 93 | ETA=(Z*R2-Z0*W)/D 94 | 95 | END 96 | -------------------------------------------------------------------------------- /vdv.f: -------------------------------------------------------------------------------- 1 | REAL FUNCTION sla_VDV (VA, VB) 2 | *+ 3 | * - - - - 4 | * V D V 5 | * - - - - 6 | * 7 | * Scalar product of two 3-vectors (single precision) 8 | * 9 | * Given: 10 | * VA real(3) first vector 11 | * VB real(3) second vector 12 | * 13 | * The result is the scalar product VA.VB (single precision) 14 | * 15 | * P.T.Wallace Starlink November 1984 16 | * 17 | * Copyright (C) 1995 Rutherford Appleton Laboratory 18 | * 19 | * License: 20 | * This program is free software; you can redistribute it and/or modify 21 | * it under the terms of the GNU General Public License as published by 22 | * the Free Software Foundation; either version 2 of the License, or 23 | * (at your option) any later version. 24 | * 25 | * This program is distributed in the hope that it will be useful, 26 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | * GNU General Public License for more details. 29 | * 30 | * You should have received a copy of the GNU General Public License 31 | * along with this program (see SLA_CONDITIONS); if not, write to the 32 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 33 | * Boston, MA 02111-1307 USA 34 | * 35 | *- 36 | 37 | IMPLICIT NONE 38 | 39 | REAL VA(3),VB(3) 40 | 41 | 42 | sla_VDV=VA(1)*VB(1)+VA(2)*VB(2)+VA(3)*VB(3) 43 | 44 | END 45 | -------------------------------------------------------------------------------- /veri.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION sla_VERI () 2 | *+ 3 | * - - - - - 4 | * V E R I 5 | * - - - - - 6 | * 7 | * Report the SLALIB version number as an integer. 8 | * 9 | * Given: 10 | * None 11 | * 12 | * The result is the SLALIB version number as an integer m*1e6+n*1e3+r, 13 | * where m is the major version, n the minor version and r the release 14 | * number. 15 | * 16 | * Notes: 17 | * 18 | * To obtain the version number in a printable form, see 19 | * subroutine sla_vers(version). 20 | * 21 | * The sla_veri subroutine was introduced in SLALIB version 2.5-1, so 22 | * if this function is absent, one can only tell that the release 23 | * predates that one. 24 | * 25 | * Norman Gray Starlink 8 April 2005 26 | * 27 | * Copyright (C) 2005 Council for the Central Laboratory of the 28 | * Research Councils 29 | * 30 | * Licence: 31 | * This program is free software; you can redistribute it and/or modify 32 | * it under the terms of the GNU General Public License as published by 33 | * the Free Software Foundation; either version 2 of the License, or 34 | * (at your option) any later version. 35 | * 36 | * This program is distributed in the hope that it will be useful, 37 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 38 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 39 | * GNU General Public License for more details. 40 | * 41 | * You should have received a copy of the GNU General Public License 42 | * along with this program (see SLA_CONDITIONS); if not, write to the 43 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 44 | * Boston, MA 02111-1307 USA 45 | * 46 | *- 47 | 48 | IMPLICIT NONE 49 | 50 | sla_VERI=2005004 51 | 52 | END 53 | -------------------------------------------------------------------------------- /vers.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_VERS (VERSION) 2 | *+ 3 | * - - - - - 4 | * V E R S 5 | * - - - - - 6 | * 7 | * Report the SLALIB version number. 8 | * 9 | * Given: 10 | * None 11 | * 12 | * Returned: 13 | * VERSION c*(*) Version number, in the form 'm.n-r'. 14 | * The major version is m, the minor version n, and 15 | * release r. The string passed in should be at least 16 | * 8 characters in length, to account for the (remote) 17 | * possibility that these numbers will ever go to 18 | * two digits. 19 | * 20 | * Notes: 21 | * 22 | * To obtain the version number in a more easily processed form, see 23 | * function sla_veri(). 24 | * 25 | * The sla_vers subroutine was introduced in SLALIB version 2.5-1, so 26 | * if this function is absent, one can only tell that the release 27 | * predates that one. 28 | * 29 | * Norman Gray Starlink 8 April 2005 30 | * 31 | * Copyright (C) 2005 Council for the Central Laboratory of the 32 | * Research Councils 33 | * 34 | * Licence: 35 | * This program is free software; you can redistribute it and/or modify 36 | * it under the terms of the GNU General Public License as published by 37 | * the Free Software Foundation; either version 2 of the License, or 38 | * (at your option) any later version. 39 | * 40 | * This program is distributed in the hope that it will be useful, 41 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 42 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 43 | * GNU General Public License for more details. 44 | * 45 | * You should have received a copy of the GNU General Public License 46 | * along with this program (see SLA_CONDITIONS); if not, write to the 47 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 48 | * Boston, MA 02111-1307 USA 49 | * 50 | *- 51 | 52 | IMPLICIT NONE 53 | 54 | CHARACTER VERSION*(*) 55 | 56 | VERSION='2.5-4' 57 | 58 | END 59 | -------------------------------------------------------------------------------- /vn.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_VN (V, UV, VM) 2 | *+ 3 | * - - - 4 | * V N 5 | * - - - 6 | * 7 | * Normalizes a 3-vector also giving the modulus (single precision) 8 | * 9 | * Given: 10 | * V real(3) vector 11 | * 12 | * Returned: 13 | * UV real(3) unit vector in direction of V 14 | * VM real modulus of V 15 | * 16 | * If the modulus of V is zero, UV is set to zero as well 17 | * 18 | * P.T.Wallace Starlink 23 November 1995 19 | * 20 | * Copyright (C) 1995 Rutherford Appleton Laboratory 21 | * 22 | * License: 23 | * This program is free software; you can redistribute it and/or modify 24 | * it under the terms of the GNU General Public License as published by 25 | * the Free Software Foundation; either version 2 of the License, or 26 | * (at your option) any later version. 27 | * 28 | * This program is distributed in the hope that it will be useful, 29 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 30 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 31 | * GNU General Public License for more details. 32 | * 33 | * You should have received a copy of the GNU General Public License 34 | * along with this program (see SLA_CONDITIONS); if not, write to the 35 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 36 | * Boston, MA 02111-1307 USA 37 | * 38 | *- 39 | 40 | IMPLICIT NONE 41 | 42 | REAL V(3),UV(3),VM 43 | 44 | INTEGER I 45 | REAL W1,W2 46 | 47 | 48 | * Modulus 49 | W1=0.0 50 | DO I=1,3 51 | W2=V(I) 52 | W1=W1+W2*W2 53 | END DO 54 | W1=SQRT(W1) 55 | VM=W1 56 | 57 | * Normalize the vector 58 | IF (W1.LE.0.0) W1=1.0 59 | DO I=1,3 60 | UV(I)=V(I)/W1 61 | END DO 62 | 63 | END 64 | -------------------------------------------------------------------------------- /vxv.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_VXV (VA, VB, VC) 2 | *+ 3 | * - - - - 4 | * V X V 5 | * - - - - 6 | * 7 | * Vector product of two 3-vectors (single precision) 8 | * 9 | * Given: 10 | * VA real(3) first vector 11 | * VB real(3) second vector 12 | * 13 | * Returned: 14 | * VC real(3) vector result 15 | * 16 | * P.T.Wallace Starlink March 1986 17 | * 18 | * Copyright (C) 1995 Rutherford Appleton Laboratory 19 | * 20 | * License: 21 | * This program is free software; you can redistribute it and/or modify 22 | * it under the terms of the GNU General Public License as published by 23 | * the Free Software Foundation; either version 2 of the License, or 24 | * (at your option) any later version. 25 | * 26 | * This program is distributed in the hope that it will be useful, 27 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 28 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 | * GNU General Public License for more details. 30 | * 31 | * You should have received a copy of the GNU General Public License 32 | * along with this program (see SLA_CONDITIONS); if not, write to the 33 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 34 | * Boston, MA 02111-1307 USA 35 | * 36 | *- 37 | 38 | IMPLICIT NONE 39 | 40 | REAL VA(3),VB(3),VC(3) 41 | 42 | REAL VW(3) 43 | INTEGER I 44 | 45 | 46 | * Form the vector product VA cross VB 47 | VW(1)=VA(2)*VB(3)-VA(3)*VB(2) 48 | VW(2)=VA(3)*VB(1)-VA(1)*VB(3) 49 | VW(3)=VA(1)*VB(2)-VA(2)*VB(1) 50 | 51 | * Return the result 52 | DO I=1,3 53 | VC(I)=VW(I) 54 | END DO 55 | 56 | END 57 | -------------------------------------------------------------------------------- /wait.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_WAIT (DELAY) 2 | *+ 3 | * - - - - - 4 | * W A I T 5 | * - - - - - 6 | * 7 | * Interval wait 8 | * 9 | * !!! Version for: SPARC/SunOS4, 10 | * SPARC/Solaris2, 11 | * DEC Mips/Ultrix 12 | * DEC AXP/Digital Unix 13 | * Intel/Linux 14 | * Convex 15 | * 16 | * Given: 17 | * DELAY real delay in seconds 18 | * 19 | * Called: SLEEP (a Fortran Intrinsic on all obove platforms) 20 | * 21 | * P.T.Wallace Starlink 22 January 1998 22 | * 23 | * Copyright (C) 1998 Rutherford Appleton Laboratory 24 | * 25 | * License: 26 | * This program is free software; you can redistribute it and/or modify 27 | * it under the terms of the GNU General Public License as published by 28 | * the Free Software Foundation; either version 2 of the License, or 29 | * (at your option) any later version. 30 | * 31 | * This program is distributed in the hope that it will be useful, 32 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 33 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 34 | * GNU General Public License for more details. 35 | * 36 | * You should have received a copy of the GNU General Public License 37 | * along with this program (see SLA_CONDITIONS); if not, write to the 38 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 39 | * Boston, MA 02111-1307 USA 40 | * 41 | *- 42 | 43 | IMPLICIT NONE 44 | 45 | REAL DELAY 46 | 47 | CALL SLEEP(NINT(DELAY)) 48 | 49 | END 50 | -------------------------------------------------------------------------------- /xy2xy.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE sla_XY2XY (X1,Y1,COEFFS,X2,Y2) 2 | *+ 3 | * - - - - - - 4 | * X Y 2 X Y 5 | * - - - - - - 6 | * 7 | * Transform one [X,Y] into another using a linear model of the type 8 | * produced by the sla_FITXY routine. 9 | * 10 | * Given: 11 | * X1 d x-coordinate 12 | * Y1 d y-coordinate 13 | * COEFFS d(6) transformation coefficients (see note) 14 | * 15 | * Returned: 16 | * X2 d x-coordinate 17 | * Y2 d y-coordinate 18 | * 19 | * The model relates two sets of [X,Y] coordinates as follows. 20 | * Naming the elements of COEFFS: 21 | * 22 | * COEFFS(1) = A 23 | * COEFFS(2) = B 24 | * COEFFS(3) = C 25 | * COEFFS(4) = D 26 | * COEFFS(5) = E 27 | * COEFFS(6) = F 28 | * 29 | * the present routine performs the transformation: 30 | * 31 | * X2 = A + B*X1 + C*Y1 32 | * Y2 = D + E*X1 + F*Y1 33 | * 34 | * See also sla_FITXY, sla_PXY, sla_INVF, sla_DCMPF 35 | * 36 | * P.T.Wallace Starlink 5 December 1994 37 | * 38 | * Copyright (C) 1995 Rutherford Appleton Laboratory 39 | * 40 | * License: 41 | * This program is free software; you can redistribute it and/or modify 42 | * it under the terms of the GNU General Public License as published by 43 | * the Free Software Foundation; either version 2 of the License, or 44 | * (at your option) any later version. 45 | * 46 | * This program is distributed in the hope that it will be useful, 47 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 48 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 49 | * GNU General Public License for more details. 50 | * 51 | * You should have received a copy of the GNU General Public License 52 | * along with this program (see SLA_CONDITIONS); if not, write to the 53 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 54 | * Boston, MA 02111-1307 USA 55 | * 56 | *- 57 | 58 | IMPLICIT NONE 59 | 60 | DOUBLE PRECISION X1,Y1,COEFFS(6),X2,Y2 61 | 62 | 63 | X2=COEFFS(1)+COEFFS(2)*X1+COEFFS(3)*Y1 64 | Y2=COEFFS(4)+COEFFS(5)*X1+COEFFS(6)*Y1 65 | 66 | END 67 | -------------------------------------------------------------------------------- /zd.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION sla_ZD (HA, DEC, PHI) 2 | *+ 3 | * - - - 4 | * Z D 5 | * - - - 6 | * 7 | * HA, Dec to Zenith Distance (double precision) 8 | * 9 | * Given: 10 | * HA d Hour Angle in radians 11 | * DEC d declination in radians 12 | * PHI d observatory latitude in radians 13 | * 14 | * The result is in the range 0 to pi. 15 | * 16 | * Notes: 17 | * 18 | * 1) The latitude must be geodetic. In critical applications, 19 | * corrections for polar motion should be applied. 20 | * 21 | * 2) In some applications it will be important to specify the 22 | * correct type of hour angle and declination in order to 23 | * produce the required type of zenith distance. In particular, 24 | * it may be important to distinguish between the zenith distance 25 | * as affected by refraction, which would require the "observed" 26 | * HA,Dec, and the zenith distance in vacuo, which would require 27 | * the "topocentric" HA,Dec. If the effects of diurnal aberration 28 | * can be neglected, the "apparent" HA,Dec may be used instead of 29 | * the topocentric HA,Dec. 30 | * 31 | * 3) No range checking of arguments is done. 32 | * 33 | * 4) In applications which involve many zenith distance calculations, 34 | * rather than calling the present routine it will be more efficient 35 | * to use inline code, having previously computed fixed terms such 36 | * as sine and cosine of latitude, and perhaps sine and cosine of 37 | * declination. 38 | * 39 | * P.T.Wallace Starlink 3 April 1994 40 | * 41 | * Copyright (C) 1995 Rutherford Appleton Laboratory 42 | * 43 | * License: 44 | * This program is free software; you can redistribute it and/or modify 45 | * it under the terms of the GNU General Public License as published by 46 | * the Free Software Foundation; either version 2 of the License, or 47 | * (at your option) any later version. 48 | * 49 | * This program is distributed in the hope that it will be useful, 50 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 51 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 52 | * GNU General Public License for more details. 53 | * 54 | * You should have received a copy of the GNU General Public License 55 | * along with this program (see SLA_CONDITIONS); if not, write to the 56 | * Free Software Foundation, Inc., 59 Temple Place, Suite 330, 57 | * Boston, MA 02111-1307 USA 58 | * 59 | *- 60 | 61 | IMPLICIT NONE 62 | 63 | DOUBLE PRECISION HA,DEC,PHI 64 | 65 | DOUBLE PRECISION SH,CH,SD,CD,SP,CP,X,Y,Z 66 | 67 | 68 | SH=SIN(HA) 69 | CH=COS(HA) 70 | SD=SIN(DEC) 71 | CD=COS(DEC) 72 | SP=SIN(PHI) 73 | CP=COS(PHI) 74 | X=CH*CD*SP-SD*CP 75 | Y=SH*CD 76 | Z=CH*CD*CP+SD*SP 77 | sla_ZD=ATAN2(SQRT(X*X+Y*Y),Z) 78 | 79 | END 80 | --------------------------------------------------------------------------------