Index: trunk/MagicSoft/Cosy/incl/afil.h =================================================================== --- trunk/MagicSoft/Cosy/incl/afil.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/afil.h (revision 731) @@ -0,0 +1,100 @@ +/*----------------------------------------------------------------------------- +afil.h -- Acceptance filtering of CAN messages + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.7 of 99/12/07 + +Based on their Id's received CAN messages are accepted or rejected. +CAN frames for which the filter is open will always be accepted. +A close request to the filter may not honored as it is possible +that the filter is not implemented. + +-----------------------------------------------------------------------------*/ + +#ifndef afil_DEFINED +#define afil_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" +#include "icanconf.h" + + +/*-------- Acceptance Filtering of CAN Ids ---------------------------------*/ + +#if ICAN_FILTER == 1 + +/* */ +extern BYTE_t id_filter[]; + +/* Initialize the acceptance filter for CAN identifiers */ +extern void init_afil(void); + +/* Return true if CAN message with given Id is accepted */ +extern int accept_afil(WORD_t); + +/* Open the acceptance filter for a given id, so messages received + with this id will pass the acceptance test */ +extern void open_afil(WORD_t); + +/* Close the acceptance filter for a given id, so messages received + with this id will not pass the acceptance test */ +extern void close_afil(WORD_t); + +/* Open the acceptance filter for a given range of ids, so messages received + with ids in that range will pass the acceptance test */ +extern void ropen_afil(WORD_t, WORD_t); + +/* Close the acceptance filter for a given range of ids, so messages received + with ids in that range will not pass the acceptance test */ +extern void rclose_afil(WORD_t, WORD_t); + +/* Get the current state of the filter mask for a given id. */ +extern int get_afil_mask(WORD_t); + +/* Set the filter mask for a given id. */ +extern void set_afil_mask(WORD_t, WORD_t); + +/* Set the acceptance filter mask for a given range of ids. + You may set the mask to a value in the range 0..(2^BITS_PER_ID)-1. */ +void rset_afil_mask(WORD_t, WORD_t, WORD_t); + +/* Open the sniff acceptance filter for a given range of ids, so messages received + with ids in that range will pass the acceptance test */ +extern void ropen_sniff_fil(BYTE_t, WORD_t, WORD_t); + +/* Close the sniff acceptance filter for a given range of ids, so messages received + with ids in that range will not pass the acceptance test */ +extern void rclose_sniff_fil(BYTE_t, WORD_t, WORD_t); + +#endif /* ICAN_FILTER == 1 */ + +#if ICAN_FILTER == 0 /* filtering not implemented; dummies */ +#define init_afil() +#define accept_afil(id) 1 /* accept everything */ +#define open_afil(id) +#define close_afil(id) +#define ropen_afil(idl, idh) +#define rclose_afil(idl, idh) +#endif /* ICAN_FILTER == 0 */ + + + +#define CAN_2_0_A 1 +#define CAN_2_0_B 2 + +extern void initSniffFil(void); +extern void rangeSetSniffFil(BYTE_t canSpec, WORD_t idl, WORD_t idh, BYTE_t value); +extern int getSniffFil(BYTE_t canSpec, LWORD_t id); + +#ifdef __cplusplus +} +#endif + +#endif /* !afil_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/bcan.h =================================================================== --- trunk/MagicSoft/Cosy/incl/bcan.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/bcan.h (revision 731) @@ -0,0 +1,430 @@ +/*----------------------------------------------------------------------------- +bcan.h -- Interface to Basic CAN Controller Chip PCA82C200 + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.18 of 00/03/30 + +Prototypes for functions in bcan.c. +Macros for descriptor word, CAN identifiers, RTR bits, and data length codes. +Defintions of register addresses and values for the Basic CAN controller. + +-----------------------------------------------------------------------------*/ + +#ifndef bcan_DEFINED +#define bcan_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" + +/*-------- COBs CAN Communication Objects ----------------------------------*/ + +/* COBs (CAN Communication Objects) consists of the following data: + WORD_t desc; + BYTE_t data[8]; + The format of the descriptor word follows that of the PCA82C200 controller: + desc >> 5 is the 11-bit identifier + desc & 0x0010 is set iff the RTR bit is set + desc & 0x000f is the data length code DLC + There are at most 8 data bytes in data[] (DLC <= 8). +*/ + +/* RTR bit in COB descriptor */ +#define COBD_RTR 0x0010 + +/* Get RTR bit from COB descriptor */ +#define cobd_get_rtr(desc) ((desc) & COBD_RTR) + +/* Get data length code from COB descriptor */ +#define cobd_get_dlc(desc) ((desc) & 0x000f) + +/* Get real data length */ +#define cobd_get_len(desc) (((desc) & COBD_RTR) ? 0 : \ + (((desc) & 0x08) ? 8 : (desc) & 0x07)) + +/* Get id and RTR bit from COB descriptor */ +#define cobd_get_id_rtr(desc) ((desc) & 0xfff0) + +/* Get RTR bit and data length code from COB descriptor */ +#define cobd_get_rtr_dlc(desc) ((desc) & 0x001f) + +/* Get identifier from COB descriptor */ +#define cobd_get_id(desc) ((desc) >> 5) /* numerical value of id */ + +/* Shift identifier for oring into COB descriptor */ +#define cobd_id_to_desc(id) ((id) << 5) + +/* Set COB descriptor from Id, and data length code, with or without RTR */ +#define cobd_set(id, dlc) (((id) << 5) | (0x000f & (WORD_t)(dlc))) +#define cobd_setrtr(id, dlc) (((id) << 5) | COBD_RTR | (0x000f & (WORD_t)(dlc))) + + +/*-------- Definitions of registers ----------------------------------------*/ + +/* + * 82C200 and SJA1000 in BasicCAN Mode + */ + +/* PCA82C200 Address Allocation */ +#define BCAN_CR 0 /* control register */ +#define BCAN_CMR 1 /* command register */ +#define BCAN_SR 2 /* status register */ +#define BCAN_IR 3 /* interrupt register */ +#define BCAN_AC 4 /* acceptance code register */ +#define BCAN_AM 5 /* acceptance mask register */ +#define BCAN_BT0 6 /* bus timing register 0 */ +#define BCAN_BT1 7 /* bus timing register 1 */ +#define BCAN_OCR 8 /* output control register */ +#define BCAN_TDESC1 10 /* first descriptor transmit buffer */ +#define BCAN_TDESC2 11 /* second descriptor transmit buffer */ +#define BCAN_TDATA 12 /* start data transmit buffer */ +#define BCAN_RDESC1 20 /* first descriptor receive buffer */ +#define BCAN_RDESC2 21 /* second descriptor receive buffer */ +#define BCAN_RDATA 22 /* start data receive buffer */ +#define BCAN_CDR 31 /* clock divider */ + + +/* Control Register Bits */ +#define BCAN_CR_OIE 0x10 /* Overrun Interrupt Enable */ +#define BCAN_CR_EIE 0x08 /* Error Interrupt Enable */ +#define BCAN_CR_TIE 0x04 /* Transmit Interrupt Enable */ +#define BCAN_CR_RIE 0x02 /* Receive Interrupt Enable */ +#define BCAN_CR_RR 0x01 /* Reset Request */ + +/* Command Register Bits */ +#define BCAN_CMR_GTS 0x10 /* Goto Sleep */ +#define BCAN_CMR_COS 0x08 /* Clear Overrun Status */ +#define BCAN_CMR_RRB 0x04 /* Release Receive Buffer */ +#define BCAN_CMR_AT 0x02 /* Abort Transmission */ +#define BCAN_CMR_TR 0x01 /* Transmission Request */ + +/* Status Register Bits */ +#define BCAN_SR_BS 0x80 /* Bus Status */ +#define BCAN_SR_ES 0x40 /* Error Status */ +#define BCAN_SR_TS 0x20 /* Transmit Status */ +#define BCAN_SR_RS 0x10 /* Receive Status */ +#define BCAN_SR_TCS 0x08 /* Transmission Complete Status */ +#define BCAN_SR_TBS 0x04 /* Transmit Buffer Status */ +#define BCAN_SR_DO 0x02 /* Data Overrun */ +#define BCAN_SR_RBS 0x01 /* Receive Buffer Status */ + +/* Interrupt Register Bits */ +#define BCAN_IR_WUI 0x10 /* Wake-Up Interrupt */ +#define BCAN_IR_OI 0x08 /* Overrun Interrupt */ +#define BCAN_IR_EI 0x04 /* Error Interrupt */ +#define BCAN_IR_TI 0x02 /* Transmit Interrupt */ +#define BCAN_IR_RI 0x01 /* Receive Interrupt */ + + +/* + * JSA1000 in PeliCAN mode + */ + +/* PeliCAN mode address allocation */ +#define PCAN_MODR 0 /* Mode register (rw) */ +#define PCAN_CMR 1 /* Command register (wo) */ +#define PCAN_SR 2 /* Status register (ro) */ +#define PCAN_IR 3 /* Interrupt register (ro) */ +#define PCAN_IER 4 /* Interrupt enable register (rw) */ +#define PCAN_BTR0 6 /* Bus timing register 0 (ro, rw) */ +#define PCAN_BTR1 7 /* Bus timing register 1 (ro, rw) */ +#define PCAN_OCR 8 /* Output control register 1 (ro, rw) */ +#define PCAN_TESTR 9 /* Test register */ +#define PCAN_ALCR 11 /* Arbitration lost capture reg (ro) */ +#define PCAN_ECCR 12 /* Error code capture register (ro) */ +#define PCAN_EWLR 13 /* Error warning limit register (ro, rw) */ +#define PCAN_RXERR 14 /* Rx error counter register (ro, rw) */ +#define PCAN_TXERR 15 /* Tx error counter register (ro, rw) */ +#define PCAN_ACR0 16 /* acceptance code register 0 (-, rw) */ +#define PCAN_ACR1 17 /* acceptance code register 1 (-, rw) */ +#define PCAN_ACR2 18 /* acceptance code register 2 (-, rw) */ +#define PCAN_ACR3 19 /* acceptance code register 3 (-, rw) */ +#define PCAN_AMR0 20 /* acceptance mask register 0 (-, rw) */ +#define PCAN_AMR1 21 /* acceptance mask register 1 (-, rw) */ +#define PCAN_AMR2 22 /* acceptance mask register 2 (-, rw) */ +#define PCAN_AMR3 23 /* acceptance mask register 3 (-, rw) */ +#define PCAN_RXFI 16 /* Rx Frame info SFF, EFF (ro, -) */ +#define PCAN_RXID1 17 /* Rx Identifier 1 SFF, EFF (ro, -) */ +#define PCAN_RXID2 18 /* Rx Identifier 2 SFF, EFF (ro, -) */ +#define PCAN_RXID3 19 /* Rx Identifier 3 EFF (ro, -) */ +#define PCAN_RXID4 20 /* Rx Identifier 4 EFF (ro, -) */ +#define PCAN_RXSFFD 19 /* Rx standard frame data (ro, -) */ +#define PCAN_RXEFFD 21 /* Rx extended frame data (ro, -) */ +#define PCAN_TXFI 16 /* Tx Frame info SFF, EFF (wo, -) */ +#define PCAN_TXID1 17 /* Tx Identifier 1 SFF, EFF (wo, -) */ +#define PCAN_TXID2 18 /* Tx Identifier 2 SFF, EFF (wo, -) */ +#define PCAN_TXID3 19 /* Tx Identifier 3 EFF (wo, -) */ +#define PCAN_TXID4 20 /* Tx Identifier 4 EFF (wo, -) */ +#define PCAN_TXSFFD 19 /* Tx standard frame data (wo, -) */ +#define PCAN_TXEFFD 21 /* Tx extended frame data (wo, -) */ +#define PCAN_RXMCR 29 /* Rx message counter register (ro) */ +#define PCAN_RXBSAR 30 /* Rx buffer start address register (ro, rw) */ +#define PCAN_CDR 31 /* Clock divider register ('rw', rw)*/ + +#define PCAN_RXFI_RAM 96 /* RAM mirror of RXFI */ +#define PCAN_TXFI_RAM 96 /* RAM mirror of TXFI */ +#define PCAN_TXID1_RAM 97 /* RAM mirror Tx Identifier 1 SFF, EFF */ +#define PCAN_TXID2_RAM 98 /* RAM mirror Tx Identifier 2 SFF, EFF */ +#define PCAN_TXID3_RAM 99 /* RAM mirror Tx Identifier 3 EFF */ +#define PCAN_TXID4_RAM 100 /* RAM mirror Tx Identifier 4 EFF */ +#define PCAN_TXSFFD_RAM 99 /* RAM mirror Tx standard frame data */ +#define PCAN_TXEFFD_RAM 101 /* RAM mirror Tx extended frame data */ + + +/* Mode Register Bits */ +#define PCAN_MODR_SM (1<<4) /* Sleep mode */ +#define PCAN_MODR_AFM (1<<3) /* Acceptance filter mode */ +#define PCAN_MODR_STM (1<<2) /* Self test mode */ +#define PCAN_MODR_LOM (1<<1) /* Listen only mode */ +#define PCAN_MODR_RM (1<<0) /* Reset mode */ + +/* Command Register Bits */ +#define PCAN_CMR_SRR (1<<4) /* Self reception request */ +#define PCAN_CMR_CDO (1<<3) /* Clear data overrun */ +#define PCAN_CMR_RRB (1<<2) /* Release receive buffer */ +#define PCAN_CMR_AT (1<<1) /* Abort transmission */ +#define PCAN_CMR_TR (1<<0) /* Transmission request */ + +/* Status Register Bits */ +#define PCAN_SR_BS (1<<7) /* Bus status */ +#define PCAN_SR_ES (1<<6) /* Error status */ +#define PCAN_SR_TS (1<<5) /* Transmit status */ +#define PCAN_SR_RS (1<<4) /* Receive status */ +#define PCAN_SR_TCS (1<<3) /* Transmission complete status */ +#define PCAN_SR_TBS (1<<2) /* Transmit buffer status */ +#define PCAN_SR_DOS (1<<1) /* Data overrun status */ +#define PCAN_SR_RBS (1<<0) /* Receive buffer status */ + +/* Interrupt Register Bits */ +#define PCAN_IR_BEI (1<<7) /* Bus-eror interrupt */ +#define PCAN_IR_ALI (1<<6) /* Arbitration lost interrupt */ +#define PCAN_IR_EPI (1<<5) /* Error-passive interrupt */ +#define PCAN_IR_WUI (1<<4) /* Wake-up interrupt */ +#define PCAN_IR_DOI (1<<3) /* Data-overrun interrupt */ +#define PCAN_IR_EI (1<<2) /* Error interrupt */ +#define PCAN_IR_TI (1<<1) /* Transmit interrupt */ +#define PCAN_IR_RI (1<<0) /* Receive interrupt */ + +/* Interrupt enable register bits */ +#define PCAN_IER_BEIE (1<<7) /* Bus-eror interrupt enable */ +#define PCAN_IER_ALIE (1<<6) /* Arbitration lost interrupt enable */ +#define PCAN_IER_EPIE (1<<5) /* Error-passive interrupt enable */ +#define PCAN_IER_WUIE (1<<4) /* Wake-up interrupt enable */ +#define PCAN_IER_DOIE (1<<3) /* Data-overrun interrupt enable */ +#define PCAN_IER_EIE (1<<2) /* Error warning interrupt enable */ +#define PCAN_IER_TIE (1<<1) /* Transmit interrupt enable */ +#define PCAN_IER_RIE (1<<0) /* Receive interrupt enable */ + +/* Clock divider register bits */ +#define PCAN_CDR_PCAN (1<<7) /* Enable PCAN mode */ +#define PCAN_CDR_CBP (1<<6) /* Enable Rx input comparator bypass */ +#define PCAN_CDR_RXINTEN (1<<5) /* Enable RXINT output at TX1 */ +#define PCAN_CDR_CLKOFF (1<<3) /* Disable clock output */ + +/* Bit definitions for Rx/Tx Frame info */ +#define PCAN_FINFO_FF (1<<7) /* Frame format bit */ +#define PCAN_FINFO_EFF (1<<7) /* Extended frame indication */ +#define PCAN_FINFO_RTR (1<<6) /* RTR frame bit */ +#define PCAN_FINFO_DLC_MASK (0x0f) /* Data length code mask */ + + + +/* + * BasicCAN, PeliCAN common definitions. + */ + +/* Values of acceptance code/mask registers */ +#define ACM_ALL word_from_bytes(0x00,0xff) /* accept all ids */ + +/* Values of output control register */ +#define OCR_PUSHPULL 0xfa /* push/pull */ + +/* Admissable bus timing values (BTR1=msb, BTR0=lsb) */ +#ifdef OSC_16MHZ /* if using a 16 MHz oscillator */ +#define BTR_1MB 0x2300 /* 1 MBaud */ +#if 0 +#define BTR_1MB 0x1400 /* 1 MBaud */ /* The better value */ +#endif +#define BTR_800KB 0x2500 /* 800 KBaud */ +#define BTR_500KB 0x1c00 /* 500 KBaud */ +#define BTR_250KB 0x1c01 /* 250 KBaud */ +#define BTR_125KB 0x1c03 /* 125 KBaud */ +#define BTR_100KB 0x34c7 /* 100 KBaud */ +#define BTR_62_5KB 0xbac7 /* 62.5 KBaud */ +#define BTR_50KB 0x34cf /* 50 KBaud */ +#define BTR_20KB 0x7fcf /* 20 KBaud */ +#define BTR_10KB 0x7fdf /* 10 KBaud */ +#endif + +/* Admissable values in clock divider register */ +#ifdef OSC_16MHZ /* if using a 16 MHz oscillator */ +#define CDR_16MHZ 0x07 /* 16 MHz output */ +#define CDR_8MHZ 0x00 /* 8 MHz output (division by 2) */ +#define CDR_4MHZ 0x01 /* 4 MHz output (division by 4) */ +#define CDR_2MHZ 0x03 /* 2 MHz output (division by 8) */ +#endif + +/*-------- Gloal variables in bcan.c ---------------------------------------*/ + +/* Indicates that we are using SJA1000 in pelican mode */ +extern short pcan_mode; + +/* ----------------------- BulkBuffer-Stuff --------------------------*/ +/* must be greater than length of biggest message type!!! */ +#define BULK_LEFT_FREE 14 + +#define DEFAULT_MAX_BULK_BUF_BYTE_COUNT MSGLEN +/* we need a minimum size of bulk buffer to generate messages */ +/* of a certain format (not bounde, but allocated buffer!) */ +/* to satisfy the message-handling inside the asm isr */ +#define DEFAULT_MIN_BULK_BUF_BYTE_COUNT 20 +#define DEFAULT_BULK_PREALLOC_COUNT 20 + +/* Timer value for elapsed (e.g.) ms to determine */ +/* if it is time to send current BulkBuffer. Will */ +/* be maintained in timer.c */ +extern LWORD_t bulkBufTim; + +void configBulkBuffer(unsigned short, unsigned char, unsigned char); + +/* ----------------------- SniffBuffer-Stuff --------------------------*/ +/* must be greater than length of biggest message type!!! */ +#define SNIFF_LEFT_FREE 26 + +#define DEFAULT_MAX_SNIFF_BUF_BYTE_COUNT MSGLEN +/* we need a minimum size of sniff buffer to generate messages */ +/* of a certain format (not bounde, but allocated buffer!) */ +/* to satisfy the message-handling inside the asm isr */ +#define DEFAULT_MIN_SNIFF_BUF_BYTE_COUNT 20 +#define DEFAULT_SNIFF_PREALLOC_COUNT 20 + +/* Timer value for elapsed (e.g.) ms to determine */ +/* if it is time to send current SniffBuffer. Will */ +/* be maintained in timer.c */ +extern LWORD_t sniffBufTim; + +void configSniffBuffer(unsigned short, unsigned char, unsigned char); +void configSniffBufferEcho(unsigned short); +/* valid values for echo2sniff, configured by configSniffBufferEcho: */ +#define SNIFF_ECHO_FROM_CANLOOK (1 << 0) +#define SNIFF_ECHO_FROM_PLAINQ (1 << 1) +#define SNIFF_ECHO_FROM_FASTQ (1 << 2) +#define SNIFF_RX_FROM_CAN (1 << 3) + + +/* message-commands inside sniff-message */ +#define SNIFF_MS_ECHO_FROM_PLAIN_STD 3 +#define SNIFF_MS_ECHO_FROM_PLAIN_XTD 4 /* not yet used */ +#define SNIFF_MS_ECHO_FROM_FAST_STD 5 +#define SNIFF_MS_ECHO_FROM_FAST_XTD 6 +#define SNIFF_MS_ECHO_FROM_CANLOOK_STD 7 +#define SNIFF_MS_ECHO_FROM_CANLOOK_XTD 8 +#define SNIFF_MS_CAN_RX_STD 9 +#define SNIFF_MS_CAN_RX_XTD 10 +#define SNIFF_MS_MSG_LOST 0x80 +#define SNIFF_MS_UNKNOWN 0xff + + +/* -----------------------Busload-Statistic-Stuff --------------------------*/ +#define BUS_LOAD_STAT_SEND_TO_HOST (1 << 0) +#define BUS_LOAD_STAT_INTEGR_TIME_ELAPSED (1 << 1) +#define BUS_LOAD_STAT_ENABLED (1 << 7) + +#define BUS_LOAD_REQUEST_ALL 0 +#define BUS_LOAD_REQUEST_STD 1 +#define BUS_LOAD_REQUEST_XTD 2 +#define BUS_LOAD_REQUEST_RX 3 +#define BUS_LOAD_REQUEST_TX 4 + +void resetBusLoad(void); +void configBusLoad(WORD_t, BYTE_t); +void sendBusLoadToHost(void); +void busLoadUpdate(void); +void checkBusLoadStatistic(void); + +void resetBusLoadSniff(void); +void configBusLoadSniff(WORD_t, BYTE_t); +void sendBusLoadToHostSniff(void); +void busLoadUpdateSniff(void); +void checkBusLoadStatisticSniff(void); + +/*-------- Functions in bcan.c ---------------------------------------------*/ + +/* Switch to bus-on state */ +extern void buson_bcan(void); + +/* Reset: Switch to bus-off state */ +extern void busoff_bcan(void); + +/* Set bus timing registers (assumed state: bus-off) */ +extern void write_btr_bcan(WORD_t); + +/* Set error waring limit */ +void write_ewl_bcan( BYTE_t ewl); + +/* Control bus-error reporting */ +void switch_berr_bcan( BYTE_t state); + +/* provide access to berrs_to_go outside bcan.c */ +BYTE_t getBerrsToGo(void); + +/* Control listen only mode */ +void switch_lom_bcan( BYTE_t state); + +/* Control self test mode */ +void switch_stm_bcan( BYTE_t state); + +/* Set hardware acceptance filter */ +extern void write_acm_bcan(WORD_t); + +/* Set extended hardware acceptance filter */ +void write_ext_acm_bcan(int mode, LWORD_t ac, LWORD_t am); + +/* Abort current transmission */ +extern void sendabort_bcan(void); + +/* Flush the transmit queue. */ +extern void flush_tx_bcan(void); + +/* Initialize the BCAN controller. The controller is left in the bus-off + state. To start communication buson_bcan() must be called. + All interrupt sources are accepted. All messages pass the acceptance + filter. The bus timing and the clock divider registers are initialized + with the parameters to the function. */ +extern void init_bcan(WORD_t, WORD_t, WORD_t, WORD_t); + +/* Service of BCAN message pool -- to be called cyclically */ +extern void serv_bcan(void); + +/* Interrupt service for PCA82C200. */ +extern void isr_bcan(void); +#ifdef ASSHACK +extern void a_isr_bcan(void); +extern void a_isr_bcan_end(void); +#endif + + +/* Request to send a CAN message: Fill the transmit buffer of the + CAN chip and issue a transmit request. + Return values: 1 okay, transmit request accepted by controller + 0 remote request successful + -1 transmit request failed (no buffer, no mem) +*/ +extern int sendreq_bcan( + int, /* transmit request specifier */ + WORD_t, /* request id */ + WORD_t, /* descriptor (id, rtr, dlc) */ + BYTE_t * /* data bytes */ +); + +#ifdef __cplusplus +} +#endif + +#endif /* !bcan_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/cal.h =================================================================== --- trunk/MagicSoft/Cosy/incl/cal.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/cal.h (revision 731) @@ -0,0 +1,127 @@ +/*----------------------------------------------------------------------------- +cal.h -- CAN Application Layer CAL + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.9 of 98/07/31 + +CALO: CAN Application Layer Object + +CALO's receive CAN messages. Using only the identifier and the RTR bit +of a CAN message CAL forwards a message to the appropriate CALO. +CALO's are either waiting on an event (e.g., CAN message, timer, user +request) or are ready to do work. The latter objects are maintained on a +queue until they have finished their work. + +Prototypes of functions defined in cal.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef cal_DEFINED +#define cal_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" + + +#ifdef FIRMWARE +/* CAN Application Layer Object */ +struct calo { + WORD_t id; /* identifier (handle) of object */ + WORD_t head; /* head of CAN messages received */ + OBJECT obj; /* object specific data */ + void (*mhdl)(); /* CAL handler for received message */ + struct calo *nxtrx; /* next on rx id hash queue */ + struct calo *nxtcal; /* next on CAL id hash queue */ +}; + +#define NIL_CALO (struct calo *)0 + +/* Identifiers (handles) of CAL objects -- not to be confused with + CAN message Ids -- are 11 bit numbers. Ids of requests issued to + ICANOS are 16 bit words with the lower bits equal to the + Id of the requesting CAL Object. CALID_MASK is used in retrieving + the CAL Object Id from the request Id. */ +#define CALID_MASK 0x07ff + +/* Nil CAN message head (descriptor) */ +#define NIL_CAN_HEAD 0xffff /* invalid descriptor */ + +#endif /* FIRMWARE */ + +/* CAN Identifiers used by CAL (cf. CiA/DS204-1, Annex I) */ +#define ID_START_STOP 0 /* Node Start, Stop, Disconnect */ +#define ID_CMS_NIL 0 /* invalid CMS Id */ +#define ID_CMS_MIN 1 /* range of CMS */ +#define ID_CMS_MAX 1760 /* identifiers */ +#define ID_GUARD_NIL 0 /* invalid guard Id */ +#define ID_GUARD_MIN 1761 /* range of guarding */ +#define ID_GUARD_MAX 2015 /* identifiers */ +#define ID_LMT_S 2020 /* from LMT Slave */ +#define ID_LMT_M 2021 /* from LMT Master */ +#define ID_NMT_IDENTIFY 2022 /* Identify Node Protocol */ +#define ID_DBT_S 2023 /* from DBT Slave */ +#define ID_DBT_M 2024 /* from DBT Master */ +#define ID_NMT_S 2025 /* from NMT Slave */ +#define ID_NMT_M 2026 /* from NMT Master */ +#define ID_SELFTEST 2027 /* for module selftest */ +#define ID_MIN 0 /* range of identifiers */ +#define ID_MAX 2031 /* controlled by CiA */ + + +/*--------- Prototypes of CAL User Functions -------------------------------*/ + +#ifdef FIRMWARE + +/* Initialize CAL */ +extern void InitCal( + WORD_t, /* req. clock period */ + WORD_t, /* bus timing */ + WORD_t, /* timeout interval */ + void (*)(), /* user handler for NMT Slave ind/con */ + void (*)(), /* user handler for DBT Slave ind/con */ + void (*)() /* user handler for LMT Slave ind/con */ +); + +/* Free the resources held by CAL */ +extern void DeleteCal(void); + +/* Execute CAL */ +extern void RunCal(void); + +/*--------- Enable/Disable Remote Services ---------------------------------*/ + +#define EnableCAN() buson_bcan() +#define DisableCAN() busoff_bcan() + +/*--------- Prototypes of CAL internal functions ---------------------------*/ + +/* Create a CAL object. */ +extern struct calo *NewCalO(void); + +/* Delete a CAL object. */ +extern void DeleteCalO(struct calo *); + +/* Get a CAL object by its Id (handle). */ +extern struct calo *GetCalO(WORD_t); + +/* Assign CAN message head to a CAL Object */ +extern int AssignCalO(struct calo *, WORD_t); + +/* Unassign CAN message head from a CAL Object */ +extern void UnassignCalO(struct calo *); + +#endif /* FIRMWARE */ + +#ifdef __cplusplus +} +#endif + +#endif /* !cal_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/calconf.h =================================================================== --- trunk/MagicSoft/Cosy/incl/calconf.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/calconf.h (revision 731) @@ -0,0 +1,111 @@ +/*----------------------------------------------------------------------------- +calconf.h -- CAL Configuration + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.15 of 99/06/18 + +Macros defining the capabilities of the CAL implementation. + +-----------------------------------------------------------------------------*/ + + +#ifndef calconf_DEFINED +#define calconf_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +/* ICANOS configuration is also needed */ +#include "icanconf.h" + +/*------- Capabilities, CAL Classes implemented ----------------------------*/ + +/* CAPS_NET bits: Capabilities a CAL network may have */ +#define CAP_NET_MNGMT 0x01 /* Network Management */ +#define CAP_NET_ERROR 0x02 /* Network Error */ +#define CAP_NET_CONFIG 0x04 /* Network Configuration */ + +/* CAPS_NODE bits: Capabilities a NMT Slave may have */ +#define CAP_NODE_MNGMT 0x01 /* Node Management capability */ +#define CAP_NODE_ERROR 0x02 /* Node Error capability */ +#define CAP_NODE_CONFIG 0x04 /* Node Configuration capability */ +#define CAP_NODE_MASTER 0x10 /* NMT Master capability */ + +/* CAPS_DBT bits: Capabilities a DBT Slave may have */ +#define CAP_DBT_DISTRIB 0x01 /* Distribution capability */ +#define CAP_DBT_CONSIST 0x02 /* Consistency capability */ +#define CAP_DBT_MASTER 0x10 /* DBT Master capability */ + +/* CAPS_LMT bits: Capabilities a LMT Slave may have */ +#define CAP_LMT_BASIC 0x01 /* LMT class 1 */ +#define CAP_LMT_ADDR 0x02 /* LMT class 2 (with LMT address) */ +#define CAP_LMT_MASTER 0x10 /* LMT Master capability */ + +/* CAPS_CMS bits: Kinds of CMS objects supported */ +#define CAP_CMS_BVAR1 0x01 /* CMS Basic Variables using 1 COB */ +#define CAP_CMS_BVAR2 0x02 /* CMS Basic Variables using 2 COB's */ +#define CAP_CMS_MVAR 0x04 /* CMS Multiplexed Variables */ +#define CAP_CMS_EVT1 0x08 /* CMS Events using 1 COB */ +#define CAP_CMS_EVT2 0x10 /* CMS Events using 2 COB's */ +#define CAP_CMS_DOM 0x20 /* CMS Domains (Basic and Multiplexed) */ + +/* The following definitions determine what the node implements. + NOTE: The values chosen will effect the code size. */ + +/* Default Node Class */ +#ifndef CAPS_NODE +#define CAPS_NODE CAP_NODE_MNGMT + CAP_NODE_ERROR \ + /* + CAP_NODE_CONFIG */ + CAP_NODE_MASTER +#endif + +/* Network implementation - only relevant when CAP_NODE_MASTER defined + in CAPS_NODE */ +#ifndef CAPS_NET +#define CAPS_NET CAP_NET_MNGMT +#endif + +/* DBT implementation */ +#ifndef CAPS_DBT +#define CAPS_DBT CAP_DBT_DISTRIB + CAP_DBT_CONSIST + CAP_DBT_MASTER +#endif + +/* LMT implementation */ +#ifndef CAPS_LMT +#define CAPS_LMT CAP_LMT_BASIC + CAP_LMT_ADDR +#endif + +/* CMS implementation */ +#ifndef CAPS_CMS +#define CAPS_CMS CAP_CMS_BVAR1 + CAP_CMS_BVAR1 + CAP_CMS_EVT1 \ + + CAP_CMS_EVT2 + CAP_CMS_DOM + CAP_CMS_MVAR +#endif + +/* Does the node have the capability to store parameters in + non-volatile memory? */ +#define CAPS_STORE 1 /* 1: yes, 0: no */ + +/*------- Memory functions -------------------------------------------------*/ + +/* Compare and copy arrays of unsigned characters */ +extern int umemcmp(unsigned char *, unsigned char *, int); +extern void umemcpy(unsigned char *, unsigned char *, int); +extern void umemset(unsigned char *, unsigned char, int); + +/*------- Interfacing to CANopen Object dictionary ------------------------*/ +/* + * #define this, if CAL and CANopen runs on the same + * system (without DPM like on VMOD-ICAN /CAN-104) + */ +#ifdef BIGBOX +#define CAL_CANOPEN_CLAMPED +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* !calconf_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/calif.h =================================================================== --- trunk/MagicSoft/Cosy/incl/calif.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/calif.h (revision 731) @@ -0,0 +1,32 @@ +/*----------------------------------------------------------------------------- +calif.h -- CAL Interface + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.3 of 96/04/18 + +-----------------------------------------------------------------------------*/ + + +#ifndef calif_DEFINED +#define calif_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "calconf.h" +#include "mcal.h" +#include "cal.h" +#include "cms.h" +#include "dbts.h" +#include "nmts.h" +#include "lmts.h" + +#ifdef __cplusplus +} +#endif + +#endif /* !calif_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/can_lib.h =================================================================== --- trunk/MagicSoft/Cosy/incl/can_lib.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/can_lib.h (revision 731) @@ -0,0 +1,187 @@ +/*----------------------------------------------------------------------------- +can_lib.h -- Interface to CAN library + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + + +Created 96/01/23 by Stefan Althoefer +Version 1.8 of 96/10/31 +-----------------------------------------------------------------------------*/ + + +#ifndef can_lib_DEFINED +#define can_lib_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef VXWORKS +#include "semLib.h" +#endif + +#include "defs.h" +#include "mican.h" +#include "dpm.h" +#include "vmod.h" + +/*------- Function Declarations ---------------------------------------------*/ + +/* Open the device and return a descriptor. Only one process may + hold the the device open at a time. */ +extern int can_open _PARAMS((char *)); +extern int can_alt_open _PARAMS((char *)); + +/* Close a device */ +extern void can_close _PARAMS((int fd)); + +/* Reset a device */ +extern void can_reset _PARAMS((int fd)); + +/* Declare a signal (for OS-9 systems only) */ +extern int can_sigdcl _PARAMS((int fd, int pid, int sig)); + +/* Undeclare a signal (for OS-9 systems only) */ +extern void can_sigdel _PARAMS((int fd)); + +#ifdef VXWORKS +/* Declare a semaphore (for VxWorks systems only) */ +extern SEM_ID can_semdcl _PARAMS((int fd)); + +/* Delete a semaphore (for VxWorks systems only) */ +extern void can_semdel _PARAMS((int fd)); +#endif + +/* Receive a message from a module */ +extern int can_recv _PARAMS((int fd, Message *pm)); + +/* Receive a fast message from a module */ +extern int can_recv_fast _PARAMS((int fd, FastMessage *pm)); + +/* Send a middle prior message to a module */ +extern int can_send _PARAMS((int fd, Message *pm)); + +/* Send a high prior message to a module */ +extern int can_send_hi _PARAMS((int fd, Message *pm)); + +/* Send a low_prior message to a module */ +extern int can_send_low _PARAMS((int fd, Message *pm)); + +/* Send a fast message to a module */ +extern int can_fast_send _PARAMS((int fd, FastMessage *pm)); + +/* Send a fast message to a module */ +extern int can_fast_send_prio _PARAMS((int fd, int prioQueue, FastMessage *pm)); + +/* One communication step (MS-DOS systems only) */ +extern void can_comm _PARAMS((int fd)); + +/* Switch to new stylish hostinterface */ +extern void ican2_select_hostif _PARAMS((int fd, int rbuffers, int wbuffers)); + +/* Switch to new stylish hostinterface with dedicated priorized-messsage- */ +/* buffer-size */ +extern void ican2_select_hostif_prio _PARAMS((int fd, int rbuffers, + int wbuffers, int wbuffers_hi, int wbuffers_low)); + +/* Init fast CANbus access */ +extern int ican2_init_fast_can _PARAMS((int fd, int rbuffers, int wbuffers)); + +/* Init fast CANbus access */ +extern int ican2_init_fast_can_prio _PARAMS((int fd, int rbuffers, int wbuffers, + int numOfPrioQueues)); + +/* Copy a block of data to the DPM */ +extern void ican2_todpmcpy _PARAMS((int fd, unsigned int d, + unsigned char *s, int n)); + +/* Copy a block of data from the DPM */ +extern void ican2_fromdpmcpy _PARAMS((int fd, unsigned char *d, + unsigned int s, int n)); + +/* Initialize table; holds Id-specific message-queue-ids, where */ +/* fast messages with the corresponding ID should be routed to are stored */ +extern int init_id_msg_q_table(int fd); + +/* Deinitialize above described table */ +extern int deinit_id_msg_q_table(int fd); + +/* Enter one message-queue-id into the above described table. */ +/* this entry causes a message-sending not to the default, common queue */ +/* but to a user defined queue */ +int add_msg_q_to_id_table( +#ifdef VXWORKS + int fd, + unsigned short id, + MSG_Q_ID target_queue +#endif +#ifdef LINUX + int fd, + unsigned short id +#endif +); + +/* removes one entry like above described */ +int rem_msg_q_from_id_table( + int fd, + unsigned short id +); + +/* Initialize table; holds device and ID where messages from this device */ +/* and with a certain CAN-ID should be routed to. */ +extern int can_init_layer_2_routing _PARAMS((int fd)); + +/* Deinitialize above described table */ +extern int can_deinit_layer_2_routing _PARAMS((int fd)); + +/* */ +extern int can_init_route_id _PARAMS(( + int fd, + int Id, + int max_routes +)); + +/* */ +extern int can_add_route_to_id _PARAMS(( + int fd, + int source_Id, + int dest_fd, + int dest_Id +)); + +/* */ +extern unsigned int can_drv_idvers _PARAMS(( + int fd +)); + +/* initiate a tpu request */ +extern void ican2_tpurequest _PARAMS((int fd)); + +extern void ican_objdic _PARAMS(( + int fd, + int objdic_index, + int objdic_subindex, + int access_type, + void *entry_structure +)); + +extern int ican_read_pp _PARAMS(( + int fd, + int dataSize, + int offset, + char *buffer +)); + +extern void ican_write_pp _PARAMS(( + int fd, + int dataSize, + int offset, + char *buffer +)); + +#ifdef __cplusplus +} +#endif + +#endif /* !can_lib_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/cms.h =================================================================== --- trunk/MagicSoft/Cosy/incl/cms.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/cms.h (revision 731) @@ -0,0 +1,566 @@ +/*----------------------------------------------------------------------------- +cms.h -- CAN Message Specification CMS + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.32 of 99/06/18 + +Definitions and type definitions for COB's and CMS Objects. +Prototypes of functions defined in cms.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef cms_DEFINED +#define cms_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" + +#define COB_LEN 8 /* max. data length of CAN message */ +#define CMS_NAME_LEN 13 /* cf. CiA/DS207 */ +#define COB_NAME_LEN 14 /* CMS_NAME_LEN + 1 */ + + +/* COB types */ +#define COB_RECEIVE 0 +#define COB_TRANSMIT 1 + + +/* Kinds of CMS objects */ +#define CMS_VARIABLE 0x0000 +#define CMS_VARSET 0x1000 +#define CMS_DOMAIN 0x2000 +#define CMS_EVENT 0x3000 +#define cmso_kind(type) ((type) & 0xf000) + +/* Classes of CMS objects */ +#define CMS_BASIC 0x0100 +#define CMS_MULTIPLEXED 0x0200 +#define CMS_CONTROLLED 0x0100 +#define CMS_UNCONTROLLED 0x0200 +#define CMS_STORED 0x0300 +#define cmso_class(type) ((type) & 0x0300) + +/* User types of CMS objects */ +#define CMS_CLIENT 0x0010 +#define CMS_SERVER 0x0020 +#define cmso_user(type) ((type) & 0x0030) + +/* Access types of Variables */ +#define CMS_READ_ONLY 0x0001 +#define CMS_WRITE_ONLY 0x0002 +#define CMS_READ_WRITE 0x0003 +#define cmso_access(type) ((type) & 0x0007) + + +#ifdef FIRMWARE + +/* CAN Communication Object */ +struct cob { + BYTE_t tc; /* COB type and class */ + BYTE_t prio; /* priority */ + WORD_t inht; /* inhibit time */ + WORD_t head; /* COB head (descriptor) */ + BYTE_t *nmcms; /* name of CMS object */ + BYTE_t nmsfx; /* suffix of COB name */ + struct calo *co; /* parent CAL object */ + struct cob *next; /* list of used COBs */ +}; + +#define NIL_COB (struct cob *)0 + +/* Set and get COB attributes */ +#define cob_length(cob) ((cob)->head & 0x000f) +#define cob_tc(t,c) (((c) & 0x07) | (((t) & 0x01) << 4)) +#define cob_class(cob) ((cob)->tc & 0x07) +#define cob_type(cob) (((cob)->tc >> 4) & 0x01) + + +/* Data set size type (for domains) */ +#if TYPEDEFS == 1 +typedef unsigned long DSIZE_t; /* 32 bit unsigned integer */ +#else +#define DSIZE_t unsigned long +#endif + +/* Components of messages in domain call-backs */ +#define dom_spec u.m2.r /* sub-specifier MS_DOM_* */ +#define dom_reason u.m2.b[0] /* reason for failure */ + +#define cms_spec u.m2.r /* cms sub-specifier MS_CMS_DATA */ +#define cms_id u.m2.d /* cms object id */ +#define cms_failure u.m2.b[0] /* cms failure code */ + +/* Location of data set size in message. */ +#define dsize_in_msg(m) (&(m)->u.m2.b[4]) + +/* Convert between data set size and an array of 4 bytes */ +#define dsize_from_bytes(b) ((DSIZE_t)(b)[0] + ((DSIZE_t)(b)[1] << 8) + \ + ((DSIZE_t)(b)[2] << 16) + ((DSIZE_t)(b)[3] << 24)) + +/* Domain specific state */ +struct domain { + BYTE_t *data; /* data buffer provided by application */ + DSIZE_t len; /* allocated length of buffer */ + DSIZE_t rlen; /* actual length of data received */ + DSIZE_t dsize; /* data set size if positive */ + BYTE_t ics; /* initial command specifier */ + BYTE_t cs; /* segment command spec. except for "n" */ + BYTE_t csb; /* backup of command specifier */ + BYTE_t more; /* more data blocks to be transferred? */ + BYTE_t pos; /* position in CAN message buffer */ + BYTE_t mux[3]; /* buffer for multiplexer */ + int muxlen; /* length of multiplexer */ + struct message *dm; /* delayed message */ + WORD_t config; /* some configurations */ + int pend_ack; /* flags for pending acknowlegdes */ + int del_ack; /* does delayed message need ack? */ + int delayed; /* set if delay occurs */ +}; + +#endif /* FIRMWARE */ + + +/* Flags in config/pend_ack */ +#define CMS_INHIBIT_CONFIG 1 /* multiplexor */ +/* flags will be interpreted as default inhibit time (for CANopen PDOs) */ + +#define CMS_DOMAIN_GENERAL_CONFIG 0 /* multiplexor */ +#define DOM_ACKNOWLEDGE (1<<0) +#define DOM_SDO_EVERY_STATE_ACTIV (1<<8) +#define DOM_RCPT_ACKNOWLEDGE (1<<1) + +/* Flags for configuring CMS domains at their creation */ +#define DOM_SDO_DBT_CAPABILITY (1<<0) + /* Flag specifies, if it is allowed to distribute the SDO-CMS + * object`s identifier by DBT services in preparing phases + * (CAL boot up for CANopen slaves). + */ + +#ifdef FIRMWARE + +/* Domains must be in the idle state to accept service requests. */ +#define dom_set_idle(dom) ((dom)->ics = 0xff) +#define dom_is_idle(dom) ((dom)->ics == 0xff) + +#define dom_is_delayed(dom) ((dom)->delayed != 0) + +/* True if the COB is a data COB with type COB_RECEIVE or is a remote COB + with type COB_TRANSMIT */ +#define cob_accept(cob) ((((cob)->head ^ (WORD_t)((cob)->tc)) & 0x0010) == 0) + + + +/* This linked list holds the created (and enabled, coded!) TPDOs */ +struct pdoSendList { + struct cmso *cmsIdOfPdo; /* cms object id of TPDO */ + struct pdoSendList *next; /* pointer to next object */ +}; +#define NIL_PDO_SEND_LIST (struct pdoSendList *)0 + +struct pdoMapList { +#ifdef CAL_CANOPEN_CLAMPED + LWORD_t cmsObjectMappingEntry; +#else + unsigned char *offsetInDpm; +#endif + BYTE_t mapLength; + struct pdoMapList *next; +}; +#define NIL_PDO_MAP_LIST (struct pdoMapList *)0 + +/* CANopen add on to CMS Object; is only used at PDOs */ +struct copAddOn { + BYTE_t transType; + BYTE_t actualTransCount; + BYTE_t state; + struct pdoMapList *mapList; +}; +#define NIL_COP_ADD_ON (struct copAddOn *)0 +/* values of state of PDO */ +#define BIT_PDO_ENABLED (1 << 0) +#define BIT_PDO_DISABLED (0 << 0) + + + +/* CMS Object */ +struct cmso { + BYTE_t *name; /* name of CMS Object */ + WORD_t type; /* var/dom/evt,bas/mux,user,access */ + BYTE_t *buf; /* buffer pointer */ + BYTE_t dbuf[COB_LEN]; /* data buffer */ + BYTE_t mux; /* save multiplexor here */ + struct domain *dom; /* domain specific */ + WORD_t flags; /* special flags for internal use */ + WORD_t tid; /* id for usage with timer timeout ? */ + WORD_t hid; /* host assigned object id */ + OBJECT adata; /* application data */ + void (*ahdl)(); /* application handler CMS messages */ + struct cob *cobs; /* list of used COBs */ + struct cob rxcob; /* receive COB */ + struct cob txcob; /* transmit COB */ + struct cmso *next; /* list of CMS Objects */ + OBJECT obj; /* associated CAL Object */ +#ifdef nodef + perhaps TODO: inhibit the possibility to send user-data in cms-objects + which will be driven by e.g. TPU irqs and get their data from module! + BYTE_t canopen_flags /* signals special canopen behavior */ + /* of cms-object (e.g. TIME, SYNC) */ +#endif + struct copAddOn *canOpenControls; +}; + +#define NIL_CMSO (struct cmso *)0 + +#endif /* FIRMWARE */ + +/* Various flags */ +#define INHIBITED 0x01 +#define TX_REQUEST 0x02 +#define TX_REQUEST_CON 0x04 +#define ENABLED 0x08 + +#define OUTSTANDING 0x10 +#define RW_REQUEST_MASK 0x20 +#define WRITE_REQUEST 0x20 + + +/* Timer/BCAN request Id modifiers */ +#define REQ_INHIBIT_TIME (0x1000 & ~CALID_MASK) +#define REQ_CON_TIMEOUT (0x2000 & ~CALID_MASK) + +#ifdef FIRMWARE + +/* Disable CMS Definition services */ +extern int DisableDefCms(void); + +/* Enable CMS Definition services */ +extern void EnableDefCms(void); + +/* Check if CMS Definition services are disabled */ +extern int IsDisabledDefCms(void); + +/* Initialize the CMS Object Directory */ +extern void InitCms(WORD_t); + +/* Create a CMS Object */ +struct cmso *NewCmsO(BYTE_t *); + +/* Create a special CMS Object without adding it to directory */ +struct cmso *NewCmsONoDBT(BYTE_t *); + +/* Set host assigned id for a CMS Object */ +void SetCmsOhid(struct cmso *co, WORD_t id); + +/* Delete a CMS Object */ +extern void DeleteCmsO(struct cmso *); + +/* Get a CMS Object by name */ +extern struct cmso *GetCmsO(BYTE_t *); + +/* Get next CMS Object. Used when looping through the defined CMS Objects. */ +extern struct cmso *GetNextCmsO(int); + +/* Get next COB used by a CMS Object. */ +extern struct cob *GetNextCobCms(int); + +/* Construct COB name */ +extern void cob_name(struct cob *, BYTE_t *); + +/* Invocation of (remote) CMS service for a CMS object. */ +extern int cms_invoke(struct cmso *, BYTE_t *, int); + +/* Handler for non-CAN messages to CMS objects. */ +extern void cms_no_can_hdl(struct cmso *, struct message *); + + +/*------ Application handler function --------------------------------------*/ + +/* Default application handler for CMS objects. */ +extern void DfltApplHdlCms(struct cmso *, struct message *); +#define NIL_AHDL DfltApplHdlCms + +#endif /* FIRMWARE */ + +/* Specific flags for JANZ */ +#define CMS_USE_HOST_ID (1<<0) + + +/*------ CMS Variables -----------------------------------------------------*/ + +#ifdef FIRMWARE + +/* Definition of a CMS Multiplexed Variable */ +struct cmso *MultiplexedVariable( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CMS messages */ +); + + +/* Definition of a CMS Basic Variable */ +extern struct cmso *BasicVariable( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CAN data frames */ +); + +/* Definition of a CMS Basic Variable for SYNC features */ +extern struct cmso *BasicVariableSYNC( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)(), /* appl. handler for CAN data frames */ + WORD_t, /* predefined transmit ID */ + WORD_t, /* predefined receive ID */ + BYTE_t /* DBT capibilities */ +); + +/* Update Read-Only Variable in Server */ +extern int UpdateVariable(struct cmso *, BYTE_t *); + +/* Client requests Write Variable Service */ +extern int WriteVariableReq(struct cmso *, BYTE_t *); + +/* Client requests Read Variable Service */ +extern int ReadVariableReq(struct cmso *); + +/* Client requests Write Variable Service for multiplexed variables. */ +int WriteMultiplexedVariableReq(struct cmso *co, int mux, BYTE_t *value); + +/* Client requests Read Variable Service. */ +int ReadMultiplexedVariableReq(struct cmso *co, int mux); + + +/* Server responds to a Write Variable Service */ +int WriteVariableRes(struct cmso *, int , BYTE_t *); + +/* Server responds to a Write Variable Service */ +int ReadVariableRes(struct cmso *co, int status, BYTE_t *value); + + + +/*------ CMS Events --------------------------------------------------------*/ + +/* Definition of a CMS Uncontrolled Event */ +extern struct cmso *UncontrolledEvent( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user type */ + int , /* length of data type (<=7) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CMS messages */ +); + +/* Definition of a CMS Controlled Event */ +extern struct cmso *ControlledEvent( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user type */ + int , /* length of data type (<=7) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CMS messages */ +); + +/* Definition of a CMS Stored Event */ +extern struct cmso *StoredEvent( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CMS messages */ +); + +/* Definition of a Stored Event for CANopen TIMESTAMP object */ +extern struct cmso *StoredEventTS( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)(), /* appl. handler for CAN data frames */ + WORD_t, /* predefined transmit ID */ + WORD_t, /* predefined receive ID */ + BYTE_t /* DBT capibilities */ +); + +/* Definition of a Stored Event for CANopen EMERGENCY object */ +extern struct cmso *StoredEventEMCY( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)(), /* appl. handler for CAN data frames */ + WORD_t, /* predefined transmit ID */ + WORD_t, /* predefined receive ID */ + BYTE_t /* DBT capibilities */ +); + +/* Definition of a Stored Event for CANopen PDO */ +extern struct cmso *StoredEventPDO( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* user and access type */ + int , /* length of data type (<=8) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)(), /* appl. handler for CAN data frames */ + WORD_t, /* predefined transmit ID */ + WORD_t, /* predefined receive ID */ + BYTE_t /* DBT capibilities */ +); + +/* Notify Event service. */ +extern int NotifyEvent(struct cmso *, BYTE_t *); + +/* Store Event service. */ +extern int StoreEvent(struct cmso *, BYTE_t *, int); + +/* Read Event service. */ +extern int ReadEvent(struct cmso *); + +/* Set Event Control State service. */ +extern int SetControlEventReq(struct cmso *, int); +extern int SetControlEventRes(struct cmso *, int, int, BYTE_t *); + +/*-------- CMS Domains ------------------------------------------------------*/ + +/* Implemented in cmsdom.c */ + +/* Definition of a CMS Domain */ +extern struct cmso *Domain( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* class and user type */ + int , /* multiplexer length (<=3) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)() /* appl. handler for CMS messages */ +); + +/* Definition of a CMS Domain for CANopen SDOs */ +extern struct cmso *DomainSDO( + BYTE_t *, /* name of CMS object to be created */ + WORD_t , /* class and user type */ + int , /* multiplexer length (<=3) */ + int , /* range: [0,7] */ + OBJECT , /* application data */ + void (*)(), /* appl. handler for CMS messages */ + WORD_t Tx_SDO_ID, /* Transmit SDO ID as seen by node */ + WORD_t Rx_SDO_ID, /* Receive SDO ID as seen by node */ + BYTE_t dbt_cap /* DBT capability flag of CANopen node */ +); + +/* Abort Domain Transfer */ +extern void DomAbortReq( + struct cmso *, /* Domain CMS object */ + BYTE_t * /* nil or 4 bytes */ +); + +/* Client requests the statrt of normal domain download. + Subsequently transfer of the data block, if provided by the client, + will start. Expedited transfer will be chosen iff 0 0 */ + int , /* enable expedited transfer */ + int /* true if more blocks will follow */ +); + +/* Client request the continuation of a download and provides the next + data block to be transfered after having received to confirmation + for the previous block if any. If the client provides no data (len==0) + then the service completes successfully. If more is true then the + client wishes to be asked for additional data blocks. */ +extern int DomDownloadContReq( + struct cmso *, /* the domain handle */ + BYTE_t *, /* (next) data block to transmit/receive */ + DSIZE_t , /* allocated length of data block */ + int /* true if more blocks will follow */ +); + +/* Server responds to download request providing a receive buffer for + data to be downloaded. The buffer must be able to hold 7 bytes + at least. */ +extern int DomDownloadRes( + struct cmso *, /* the domain handle */ + BYTE_t *, /* (next) data block to transmit/receive */ + DSIZE_t /* allocated length of data block */ +); + +/* Client requests initialization of a domain upload. + The client will be called back to to receive expedited data or to + provide buffers to receive data blocks of a normal transfer. + Note that the server decides about using normal or expedited transfer. */ +extern int DomUploadStartReq( + struct cmso *, /* the domain handle */ + BYTE_t * /* multiplexor */ +); + +/* The server received a domain upload indication. The server + responds by calling the following function to accept the upload + request. Expedited transfer will be chosen iff 0 0 */ + int , /* enable expedited transfer */ + int /* true if more blocks will follow */ +); + +/* Client requested the continuation of a upload. Server provides the next + data block to be transfered. If the server provides no data (len==0) + then the service completes successfully. If more is true then the + server wishes to be asked for additional data blocks. */ +extern int DomUploadContRes( + struct cmso *, /* the domain handle */ + BYTE_t *, /* (next) data block to transmit/receive */ + DSIZE_t , /* allocated length of data block */ + int /* true if more blocks will follow */ +); + +extern void DomHostAcknowledgeRes( + struct cmso *co +); + +extern void DomRcptAcknowledgeReq( + struct cmso *co +); + +#endif /* FIRMWARE */ + +/* bitpositions in cs */ +#define D_MORE (1 << 0) /* more date will follow */ +#define D_EXPED (1 << 1) /* inhibit expedited data transfer */ +#define D_SUCCESS (1 << 2) /* success indication */ + +#ifdef __cplusplus +} +#endif + +#endif /* !cms_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/dbtm.h =================================================================== --- trunk/MagicSoft/Cosy/incl/dbtm.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/dbtm.h (revision 731) @@ -0,0 +1,125 @@ +/*----------------------------------------------------------------------------- +dbtm.h -- DBT Master Interface + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 95/02/23 by Soenke Hansen +Version 1.7 of 96/05/21 + +Prototype declarations of functions defined in dbtm.c. + +-----------------------------------------------------------------------------*/ + +#ifndef dbtm_DEFINED +#define dbtm_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" +#include "cal.h" + + +/*--------- Data structures of COB database ---------------------------------*/ + +/* User Definition */ +struct usrdef { + WORD_t id; /* COB-ID */ + BYTE_t nid; /* node Id */ + BYTE_t len; /* COB length */ + BYTE_t type; /* COB type */ + BYTE_t cclass; /* COB class */ + WORD_t inht; /* actual inhibit time */ + BYTE_t cobnm[COB_NAME_LEN]; /* COB name */ + struct usrdef *next; /* next in same COB definition */ +}; + +/* Pre-Definition */ +struct predef { + WORD_t id; /* COB-ID */ + BYTE_t cobnm[COB_NAME_LEN]; /* COB name */ + struct predef *next; /* next in same COB definition */ +}; + +/* COB Definition */ +struct cobdef { + WORD_t id; /* COB-ID */ + WORD_t inht; /* inhibit time */ + struct usrdef *usr; /* list of user definitions */ + struct predef *pre; /* list of pre-definitions */ +}; + + +/* State of COB database */ +extern int CobDBEnabled; + +/*--------- COB Database Functions ------------------------------------------*/ + +/* Create COB Database Service (initialization of DB) */ +extern void CreateCobDB(void); + +/* Set state of COB database to ENABLED */ +extern void EnableDist(void); + +/* Set state of COB database to DISABLED */ +extern void DisableDist(void); + +/* Create COB Definition Service */ +extern int CreateCobDef( + WORD_t, /* lower bound of COB-ID range */ + WORD_t, /* upper bound of COB-ID range */ + WORD_t /* minimum inhibit time */ +); + +/* Delete COB Definition Service */ +extern void DeleteCobDef( + WORD_t, /* lower bound of COB-ID range */ + WORD_t /* upper bound of COB-ID range */ +); + +/* Create Pre-Definition Service */ +extern int CreatePreDef( + WORD_t, /* COB ID */ + BYTE_t * /* COB name */ +); + +/* Delete Pre-Definition Service */ +extern void DeletePreDef( + BYTE_t * /* COB name */ +); + + +/* Get next COB Definition in database. */ +extern struct cobdef *GetNextCobDef(int); + +/* Get next User Definition in database. */ +extern struct usrdef *GetNextUsrDef(int); + +/* Get next COB Definition in database. */ +extern struct predef *GetNextPreDef(int); + + +/*--------- Creation, Initialization, Destruction ---------------------------*/ + +/* Create and initialize the DBT Master */ +extern void InitDbtM( + WORD_t /* timeout interval */ +); + +void ConfigDbtM( + WORD_t timeout, /* timeout interval */ + WORD_t flags /* various config. flags */ +); + +/* Remove the DBT Master. Free the resources it holds. */ +extern void DeleteDbtM(void); + + +#ifdef __cplusplus +} +#endif + +#endif /* !dbtm_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/dbts.h =================================================================== --- trunk/MagicSoft/Cosy/incl/dbts.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/dbts.h (revision 731) @@ -0,0 +1,118 @@ +/*----------------------------------------------------------------------------- +dbts.h -- DBT Slave + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.8 of 98/07/31 + +Definitions of DBT Protocol command specifiers. +Status definitions for service confirmations. +Prototypes of functions defined in dbts.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef dbts_DEFINED +#define dbts_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" +#include "calconf.h" +#include "cms.h" + +/* Components of service confirmation message */ +#define dbts_stat u.m1.w[0] +#define dbts_cobid u.m1.w[1] +#define dbts_cksum u.m1.w[2] + +/* Command specifiers in DBT Protocol */ +#define DBT_CS_CREATE_1 2 /* Create User Definition part 1 */ +#define DBT_CS_CREATE_2 3 /* Create User Definition part 2 */ +#define DBT_CS_CREATE_3 4 /* Create User Definition part 3 */ +#define DBT_CS_DELETE 0 /* Delete User Definition */ +#define DBT_CS_VERIFY 5 /* Verify COB Class */ +#define DBT_CS_CHECKSUM 6 /* Get Checksum */ +#define DBT_CS_NIL 255 /* Nil */ + + +/* Status (return) values of DBT Slave services on success or failure */ +#define STAT_OKAY 0x00 /* service completed successfully */ +#define STAT_NOSERV 0x01 /* DBT services not allowed */ +#define STAT_PROT_ERR 0x02 /* protocol error */ +#define STAT_TIMED_OUT 0x03 /* timed out on confirmation */ +#define STAT_TIMER_ERR 0x04 /* timer could not be set */ +#define STAT_ASSIGN_ERR 0x05 /* failed to assign CAL protocol Id */ +#define STAT_TX_ERR 0x10 /* service failed */ +#define STAT_REMOTE_ERR 0x20 /* error code from DBT Master */ + +#ifdef FIRMWARE + +/* DBT Slave not implemented if the distribution capability + is not configured. */ +#if CAPS_DBT & CAP_DBT_DISTRIB + +/* Initialize the DBT Slave */ +extern void InitDbtS( + WORD_t , /* timeout interval */ + void (*)() /* user handler indication/confirmation */ +); + +/* Remove the DBT Slave */ +extern void DeleteDbtS(void); + +/* Request of Create User Definition Service */ +extern int CreateUserDefReq(struct cob *); +extern int CreateAllUserDefReq(void); + +/* Request of Delete User Definition Service */ +extern int DeleteUserDefReq(int); + +/* CANopen stuff */ +/* Request of SYNC cob-ID */ +extern WORD_t GetSYNCId(void); +extern void PutSYNCId(WORD_t); + +/* Request of SYNC pointer to CMS object */ +extern struct cmso *GetPToSYNCCMS(void); +extern void PutPToSYNCCMS(struct cmso *); + +/* Request of HiRes TIMESTAMP pointer to CMS object */ +extern WORD_t GetTSId(void); +extern void PutTSId(WORD_t); + +/* Request of HiRes TIMESTAMP pointer to CMS object */ +extern struct cmso *GetPToTSCMS(void); +extern void PutPToTSCMS(struct cmso *); + +/* Request of time of day TIMESTAMP pointer to CMS object */ +extern WORD_t GetTodTSId(void); +extern void PutTodTSId(WORD_t); + +/* Request of time of day TIMESTAMP pointer to CMS object */ +extern struct cmso *GetPToTodTSCMS(void); +extern void PutPToTodTSCMS(struct cmso *); + +#if CAPS_DBT & CAP_DBT_CONSIST + +/* Request of Verify COB Class Service */ +extern int VerifyCobClassReq(void); + +/* Request of Get Checksum Service */ +extern int GetChecksumReq(int); + +#endif /* CAPS_DBT & CAP_DBT_CONSIST */ +#endif /* CAPS_DBT & CAP_DBT_DISTRIB */ + +#endif /* FIRMWARE */ + +#ifdef __cplusplus +} +#endif + +#endif /* !dbts_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/debug.h =================================================================== --- trunk/MagicSoft/Cosy/incl/debug.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/debug.h (revision 731) @@ -0,0 +1,61 @@ +/************************************************************************/ +/* DEBUG-tool */ +/************************************************************************/ + +#ifdef __cplusplus +extern "C" { +#endif + +#if DEBUG +#define LOG_INIT (1 << 0) +#define LOG_OPEN (1 << 1) +#define LOG_CLOSE (1 << 2) +#define LOG_INTR (1 << 3) +#define LOG_READ (1 << 4) +#define LOG_WRITE (1 << 5) +#define LOG_IOCTL (1 << 6) +#define LOG_DEF (1 << 7) + +#define LOG_CAN (1 << 8) +#define LOG_MIN (1 << 9) +#define LOG_AST (1 << 10) +#define LOG_FUNC (1 << 11) +#define LOG_EXIT (1 << 12) +#define LOG_INT (1 << 13) +#define LOG_MMAP (1 << 14) +#define LOG_LOCK (1 << 15) +#define LOG_RESET (1 << 16) +#define LOG_SEM (1 << 17) +#define LOG_RMAIL (1 << 18) +#define LOG_WRFAST (1 << 19) +#define LOG_RDFAST (1 << 20) +#define LOG_WATCH (1 << 21) +#define LOG_ROUTE (1 << 22) +#define LOG_COP (1 << 23) +#define LOG_TPU (1 << 24) +#define LOG_PP (1 << 24) + +#define LOG_MAX (1 << 31) + +#if 0 +static int debug = LOG_RESET | LOG_INIT | LOG_OPEN | LOG_CLOSE | \ + LOG_IOCTL | LOG_INTR | LOG_WRITE | LOG_READ; +#endif +#if 0 +static int debug = LOG_PP | LOG_WATCH | LOG_ROUTE | LOG_RDFAST | LOG_INTR | LOG_TPU | LOG_COP; +#endif +#if 1 +static int debug = LOG_WRITE | LOG_INIT | LOG_IOCTL; +#endif + +int printf_ (); + +/* #define LOG(level, message) if(debug & level) logMsg message */ +#define LOG(level, message) if(debug & level) printk message +#else +#define LOG(level, message) +#endif + +#ifdef __cplusplus +} +#endif Index: trunk/MagicSoft/Cosy/incl/defs.h =================================================================== --- trunk/MagicSoft/Cosy/incl/defs.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/defs.h (revision 731) @@ -0,0 +1,103 @@ +/*----------------------------------------------------------------------------- +defs.h -- Various definitions + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.10 of 97/02/03 + +Basic type definitions: bytes and words. +Conversion functions for words (16 bit unsigned). + +-----------------------------------------------------------------------------*/ + +#ifndef defs_DEFINED +#define defs_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef OS_9 +#ifdef _UCC +#define _PARAMS(args) args +#else +#ifdef __STDC__ +#define _PARAMS(args) args +#else +#define _PARAMS(args) () +#endif +#endif +#endif + +/* Function prototypes by default */ +#ifndef _PARAMS +#define _PARAMS(args) args +#endif + +/* Use of typedef's or #define's. Some compilers (e.g., Ultra C for OS-9) + don't like typedef's in prototype declarations. */ +#ifndef TYPEDEFS +#define TYPEDEFS 1 /* default is with typedef's */ +#endif + +/* Generic object type */ +#if TYPEDEFS == 1 +typedef char * OBJECT; +#else +#define OBJECT char * /* known to be dangerous! */ +#endif +#define NIL_OBJECT (OBJECT)0 + +/* Return values (BYTE_t) */ +#define SUCCESS 0 +#define FAILURE 0xff + +/* Basic data types */ +#if TYPEDEFS == 1 +typedef unsigned char BYTE_t; /* 8 bit unsigned integer */ +typedef unsigned short WORD_t; /* 16 bit unsigned integer */ +typedef unsigned long LWORD_t; /* 32 bit unsigned integer */ +#else +#define BYTE_t unsigned char +#define WORD_t unsigned short +#define LWORD_t unsigned long +#endif + +/* Elaborate data types */ +#ifndef OS_9 +#if TYPEDEFS == 1 +typedef void (*Funcptr)(void); /* Having this makes life easier */ +#endif +#endif + +/* Convert between words and pairs of bytes */ +#define word_read(p, w) ((w) = ((WORD_t)(p)[0] << 8)|((WORD_t)(p)[1])) +#define word_write(p, w) (((p)[0] = (BYTE_t)((w)>>8)), \ + ((p)[1] = (BYTE_t)((w)&0x00ff))) + +/* Extract bytes from word */ +#define word_to_lsb(w) ((BYTE_t)((w)&0x00ff)) +#define word_to_msb(w) ((BYTE_t)((w)>>8)) + +/* Assemble bytes into word */ +#define word_from_bytes(lsb, msb) (((WORD_t)(msb) << 8)|((WORD_t)(lsb))) + +/* Convert between long word and an array of 4 bytes */ +#define lword_from_bytes(b) ((LWORD_t)(b)[0] + ((LWORD_t)(b)[1] << 8) + \ + ((LWORD_t)(b)[2] << 16) + ((LWORD_t)(b)[3] << 24)) +#define lword_to_bytes(b, lw) do { (b)[0] = (BYTE_t)(lw); \ + (b)[1] = (BYTE_t)(lw >> 8); (b)[2] = (BYTE_t)(lw >> 16); \ + (b)[3] = (BYTE_t)(lw >> 24); } while (0) + + +/* Compare 16 bit words which are assumed to have circular distance < 2^15 */ +#define word_cmp(w1, w2) ((w1) - (w2) <= 0x7fff ? ((w1) == (w2) ? 0 : 1) : (-1)) + + +#ifdef __cplusplus +} +#endif + +#endif /* !defs_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/dpm.h =================================================================== --- trunk/MagicSoft/Cosy/incl/dpm.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/dpm.h (revision 731) @@ -0,0 +1,614 @@ +/*----------------------------------------------------------------------------- +dpm.h -- Linux driver of DPM interface to VMOD + +Copyright (c) 1996 JANZ Computer AG +All Rights Reserved + +Created 96/01/23 by Stefan Althoefer + +Version 1.12 of 96/09/27 + +This file is for both, the "dpm" and the "dpmw" driver. +The only difference, besides the names of the driver functions, are the in +the INKERNEL structures. But these are not visible to the user. + +-----------------------------------------------------------------------------*/ + +#ifndef __INCdpmh +#define __INCdpmh + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "vmod.h" + +/* Max. Count of Devices for the dpm driver. */ +/*#define DPM_MAJOR_NUMBER 57 */ +#define MAX_BOARDS 16 /* max. # of boards supported */ +#define MAX_MODUL_BOARDS 4 /* max. # of modules supported */ + /* with one board */ +#define MAX_DPM_DEV (MAX_BOARDS * MAX_MODUL_BOARDS) + +#define FAST_QUEUE '\0' /* flag for fast queue */ +#define PLAIN_QUEUE '\1' /* flag for normal queue */ + +/* Data type of messages */ +#define MSGLEN 252 /* Maximum length of a message */ +#define MSGHDLEN 4 /* Length of message head */ + +#define ICAN2 1 +#define ICAN3 2 + +/* -*-Struct-*- + * + * Message - local message buffer for standard host interface + * + * This structure stores a message to be send to or received from + * a VMOD-ICAN module via the standard host interface. + * + * is a 8 bit command specifier. Refer to the VMOD-ICAN manual + * to find out which services are provided by the different + * specifiers. The data length to be transfered is stored in , thereby + * specifies how many bytes of the vector are valid. The data + * have to be interpreted by means of . + * + * At most MSGLEN bytes can be stored in a message. MSGLEN is 252 bytes + * for all current VMOD-ICAN modules. + */ +typedef struct { + BYTE_t cmd; /* Message specifier */ + BYTE_t gap1; + WORD_t len; /* Message length (<= MSGLEN) */ + BYTE_t data[MSGLEN]; /* Data array of Message */ +} Message; + + +/* -*-Struct-*- + * + * FastMessage - local message buffer for fast host interface + * + * This structure stores a CANbus message to be send to or received from + * a VMOD-ICAN modules fast interface. + * + * is a 8 bit service multiplexor. Currently only ='0' is used. + * + * Through the actual CANbus message is transfered if equals '0'. + * The first two bytes store the message descriptor, that contains the + * ID, RTR-flag and CANbus data length code (DLC), the remaining bytes store + * the CANbus data bytes. + * + * .CS + * data[0] = ID/8; + * data[1] = 32(ID%8) + 16RTR + DLC + * data[2] = CAN BYTE 1 + * data[:] = : + * data[9] = CAN BYTE 8 + * data[10] = unused + * data[:] = : + * data[13] = unused + * .CE + * + */ +typedef struct { + BYTE_t unused; + BYTE_t cmd; /* Service specifier */ + BYTE_t data[14]; /* Data array */ +} FastMessage; + + + +/*** DPM: Special Driver Functions (Driver management) *********************/ +#ifdef nodef + +/* Create the dpm driver. */ +extern STATUS dpmDrv(void); + +/* Remove the dpm driver from the system. */ +extern STATUS dpmDrvRemove(void); + +/* Add a dpm device. */ +extern STATUS dpmDevCreate( + int modno, + UINT baddr +); + +/* Delete a dpm device. */ +extern STATUS dpmDevDelete( + const char *name +); + +/* Main ioctl function. */ +extern dpmIoctl( + int modno, + int cmd, + int arg +); + +/* interrupt function. */ +extern void dpmInt (int modno); + + +/*** DPMW: Special Driver Functions (Driver management) *********************/ + +/* Create the dpmw driver. */ +extern STATUS dpmwDrv(void); + +/* Remove the dpmw driver from the system. */ +extern STATUS dpmwDrvRemove(void); + +/* Add a dpmw device. */ +extern STATUS dpmwDevCreate( + const char *name, + int modno, + UINT baddr, + int vector, + int level +); + +/* Delete a dpmw device. */ +extern STATUS dpmwDevDelete( + const char *name +); +#endif + +/*** IOCTL commands *****************************************************/ +#define WOS 0x8000 /* offset into user fuction codes */ + + /* getstat: */ +#define DPM_READ_MBOX (128 + WOS) /* function code READ */ +#define DPM_COPY_FROM (129 + WOS) /* copy data from dpm */ +#define DPM_READ_FAST_MBOX (130 + WOS) /* function code READ FAST */ + + /* putstat: */ +#define DPM_WRITE_MBOX (528 + WOS) /* function code WRITE mid prio */ +#define DPM_WRITE_MBOX_HI (539 + WOS) /* function code WRITE high prio*/ +#define DPM_WRITE_MBOX_LOW (540 + WOS) /* function code WRITE low prio */ +#define DPM_COPY_TO (529 + WOS) /* copy data to dpm */ +#define DPM_DEL_SIGNAL (530 + WOS) /* delete signal entry */ +#define DPM_SET_SIGNAL (531 + WOS) /* set signal entry */ +#define DPM_RESET (532 + WOS) /* reset the module */ +#define DPM_INIT_NEW_HOSTIF (533 + WOS) /* init new hostif */ +#define DPM_INIT_NEW_HOSTIF_PRIO (545 + WOS) /* init new hostif (priorized) */ +#define DPM_SET_SEM (534 + WOS) /* create semaphor for read */ +#define DPM_INIT_FAST_CAN (535 + WOS) /* init fast CAN access */ +#define DPM_INIT_FAST_CAN_PRIO (551 + WOS) /* init fast CAN access */ +#define DPM_WRITE_FAST_CAN (536 + WOS) /* send trougth fast interface */ +#define DPM_WRITE_FAST_CAN_PRIO (552 + WOS) /* send trougth prioritized fast interface */ + +#define DPM_DEINIT_FAST_CAN (537 + WOS) /* deinit fast CAN access */ +#define DPM_DEL_SEM (538 + WOS) /* delete semaphor for read */ + /* (539 + WOS) see above! */ + /* (540 + WOS) see above! */ +#define DPM_INIT_ID_MSG_Q_TABLE (541 + WOS) /* allocates memory for table, */ + /* where message-queue-Ids for */ + /* fast can access are stored */ +#define DPM_DEINIT_ID_MSG_Q_TABLE (542 + WOS) /* deallocates memory for table */ +#define DPM_ADD_ID_TO_MSG_Q_TABLE (543 + WOS) /* adds queue entry to ID-table */ +#define DPM_REM_ID_FROM_MSG_Q_TABLE (544 + WOS) /* removes entry from ID-table */ + /* (545 + WOS) see above! */ +#define DPM_INIT_L2_ROUTING (546 + WOS) /* inits the Layer2 routing cap */ +#define DPM_DEINIT_L2_ROUTING (547 + WOS) /* deinits Layer2 routing cap */ +#define DPM_INIT_ROUTE_ID (548 + WOS) /* lets _one_ ID being routable */ +#define DPM_ADD_ROUTE_TO_ID (549 + WOS) /* adds _one_ routing way to ID */ +#define DPM_MAP_FD_TO_MOD (550 + WOS) /* map the fd to board/module */ + +#define DPM_DEV_CREATE (600 + WOS) /* WINDOWS specific ioctl function code */ +#define DPM_DEV_DELETE (601 + WOS) /* deletes device from slot */ +#define DPM_READ_INTCOUNT (602 + WOS) +#define DPM_REGISTER_APC (603 + WOS) /* Register APC function */ +#define DPM_TPU_REQ (604 + WOS) /* initiates TPU request IR */ +#define DPM_OBJDIC_REQ (605 + WOS) /* access to object dict. */ + +#define DPM_DRV_IDVERS (606 + WOS) /* get driver version */ +#define DPM_WRITE_PP (607 + WOS) /* write CANopen process picture */ +#define DPM_READ_PP (608 + WOS) /* read CANopen process picture */ + + +struct signal_dpm { + int task_id; + int signal_code; + unsigned char *param_addr; +}; + +struct dpm_copy_desc { + unsigned int memory; + unsigned int dpm; + int len; +}; + +struct dpm_rw_can_desc { + int rval; + Message *pm; +}; + +struct dpm_new_hostif_desc { + int fromhost_len; + int tohost_len; +}; + +struct dpm_new_hostif_desc_prio { + int fromhost_hi_len; + int fromhost_low_len; + int fromhost_len; + int tohost_len; +}; + +struct dpm_fast_can_desc { + int fromhost_len; + int tohost_len; +/* MSG_Q_ID read_queue; */ +}; + +struct dpm_fast_can_desc_prio { + int numOfPrioQueues; + int fromhost_len; + int tohost_len; +/* MSG_Q_ID read_queue; */ +}; + +struct dpm_write_fast_can_desc { + int rval; + FastMessage *pm; +}; + +struct dpm_write_fast_can_desc_prio { + int rval; + int prioQueue; + FastMessage *pm; +}; + +struct dpm_fast_can_desc_win { + int fromhost_len; + int tohost_len; + int fkt_addr; +}; + +struct dpm_msg_q_id_desc { + unsigned short id; + /* MSG_Q_ID target_queue; */ +}; + +struct dpm_layer_2_routing_desc { + int rval; + int Id; + int max_routes; + int source_Id; + int dest_Id; + int dest_Board; + int dest_Modul; +}; + +struct io_args { + int modno; /* slot of interesing module */ + int arg; /* place of some arguments */ +}; + + +struct dpm_dev_create_desc { + int modno; +}; + +struct dpm_objdic_desc { + int objdic_index; + int objdic_subindex; + int access_type; + void *entry_structure; +}; + +struct dpm_readpp_desc { + int dataSize; + int offset; + int dataValid; + char *buffer; +}; + +struct dpm_writepp_desc { + int dataSize; + int offset; + char *buffer; +}; + +#define TS_TO_HOST 1 /* read modules timestamp counter */ + /* of last SYNC message */ +#define TS_TO_MODULE 0 /* synchronizing module by writing timestamp */ + + +#ifdef INKERNEL +/************************************************************************/ +/* DEFINES */ +/************************************************************************/ + +#define MAXNDEV 1 /* I/O-channel per module */ +#define BOARDTYP (1<<7) /* d7=1 VMOD-IG, d7=0 VMOD-IO */ +#define I_ENABLE 1 + +/* MICAN3 */ +#define DPM_PAGEWIDTH 256 /* ICAN3 */ + +#ifdef BIG_ENDIAN +struct dpmw { /* structure for BIG_ENDIAN */ + unsigned char unused; + unsigned char spec; /* message specifier */ + unsigned char len_l; /* data length low byte */ + unsigned char len_h; /* data length high byte */ + unsigned char data[MSGLEN]; /* raw data */ + unsigned char page_sel; /* page selector */ + unsigned char gap1; + unsigned char intgen; /* wr: generate inter. on ICAN3 */ + /* rd: clear MODULbus interrupt */ + unsigned char gap2; + unsigned char reset; /* generate reset on ICAN3 */ + unsigned char gap3; + unsigned char tpureq; /* signal to tpu on ICAN3 */ +}; +#endif + +#ifdef LITTLE_ENDIAN +struct dpmw { /* structure for LITTLE_ENDIAN */ + unsigned char spec; /* message specifier */ + unsigned char unused; + unsigned char len_h; /* data length high byte */ + unsigned char len_l; /* data length low byte */ + unsigned char data[MSGLEN]; /* raw data */ + unsigned char gap1; + unsigned char page_sel; /* page selector */ + unsigned char gap2; + unsigned char intgen; /* wr: generate inter. on ICAN3 */ + /* rd: clear MODULbus interrupt */ + unsigned char gap3; + unsigned char reset; /* generate reset on ICAN3 */ + unsigned char gap4; + unsigned char tpureq; /* signal to tpu on ICAN3 */ +}; +#endif + + +#define START_BUFF 9 /* first free page within DPM */ + +/* New stylish host interface */ + +#ifdef BIG_ENDIAN +struct dpmw_desc { + unsigned char control; /* control byte */ + unsigned char buffer; /* buffer pointer */ +}; +#endif + +#ifdef LITTLE_ENDIAN +struct dpmw_desc { + unsigned char buffer; /* buffer pointer */ + unsigned char control; /* control byte */ +}; +#endif + +#define DPM_DESC_VALID (1<<7) +#define DPM_DESC_WRAP (1<<6) +#define DPM_DESC_INTR (1<<5) +#define DPM_DESC_IVALID (1<<4) +#define DPM_DESC_LEN (7<<0) + + +/* Fast dpmqueue host interface */ + +#define FDPMQUEUE_LEN 14 /* data elements in each buffer */ + + +#ifdef BIG_ENDIAN +struct fdpmw_desc { + unsigned char control; + unsigned char spec; + unsigned char data[FDPMQUEUE_LEN]; +}; +#endif + +#ifdef LITTLE_ENDIAN +struct fdpmw_desc { + unsigned char spec; + unsigned char control; + unsigned char data[FDPMQUEUE_LEN]; +}; +#endif + +#define FDPM_DESC_VALID (1<<7) +#define FDPM_DESC_WRAP (1<<6) +#define FDPM_DESC_IVALID (1<<4) + +/* Definition of fast-queue-fromhost priorization */ +#define FDPMQUEUE_FROMHOST_NO_INIT 0 +#define FDPMQUEUE_FROMHOST_1_PRIO 1 +#define FDPMQUEUE_FROMHOST_N_PRIO 3 + +#ifdef BIG_ENDIAN +#define DPMW_MSYNC_LOCL_ADDR 0x1 +#define DPMW_MSYNC_PEER_ADDR 0x0 +#define DPMW_TARGET_RUN_ADDR 0x2 +#define TIME_STAMP_0_ADDR 0x10 +#define TIME_STAMP_1_ADDR 0x11 +#define TIME_STAMP_2_ADDR 0x12 +#define TIME_STAMP_3_ADDR 0x13 +#endif + +#ifdef LITTLE_ENDIAN +#define DPMW_MSYNC_LOCL_ADDR 0x0 +#define DPMW_MSYNC_PEER_ADDR 0x1 +#define DPMW_TARGET_RUN_ADDR 0x3 +#define TIME_STAMP_0_ADDR 0x12 +#define TIME_STAMP_1_ADDR 0x13 +#define TIME_STAMP_2_ADDR 0x10 +#define TIME_STAMP_3_ADDR 0x11 +#endif + +/* end of defined MICAN3 */ + +/* MICAN2 */ + +#ifdef BIG_ENDIAN +struct dpm { /* structure for MOTOROLA type */ + unsigned char page_sel; /* page selector */ + unsigned char unused; + unsigned char intgen; /* wr: generate inter. on ICAN2 */ + /* rd: clear MODULbus interrupt */ + unsigned char spec; /* message specifier */ + unsigned char reset; /* generate reset on ICAN2 */ + unsigned char len_l; /* data length low byte */ + unsigned char gap0; + unsigned char len_h; /* data length high byte */ + unsigned char gap_1; + unsigned char data[MSGLEN * 2]; /* raw data */ +}; +#endif + +#ifdef LITTLE_ENDIAN +struct dpm { /* structure for INTEL-LIKE type */ + unsigned char unused; + unsigned char page_sel; /* page selector */ + unsigned char spec; /* message specifier */ + unsigned char intgen; /* wr: generate inter. on ICAN2 */ + /* rd: clear MODULbus interrupt */ + unsigned char len_l; /* data length low byte */ + unsigned char reset; /* generate reset on ICAN2 */ + unsigned char len_h; /* data length high byte */ + unsigned char gap0; + unsigned char data[MSGLEN * 2]; /* raw data */ + unsigned char gap_1; +}; +#endif + +/* New stylish host interface */ + +#ifdef BIG_ENDIAN +struct dpm_desc { + unsigned char gap1; + unsigned char control; /* control byte */ + unsigned char gap2; + unsigned char buffer; /* buffer pointer */ +}; +#endif + +#ifdef LITTLE_ENDIAN +struct dpm_desc { + unsigned char control; /* control byte */ + unsigned char gap1; + unsigned char buffer; /* buffer pointer */ + unsigned char gap2; +}; +#endif + +#define DPM_DESC_VALID (1<<7) +#define DPM_DESC_WRAP (1<<6) +#define DPM_DESC_INTR (1<<5) +#define DPM_DESC_IVALID (1<<4) +#define DPM_DESC_LEN (7<<0) + + +/* Fast dpmqueue host interface */ + +#define FDPMQUEUE_LEN 14 + +#ifdef BIG_ENDIAN +struct fdpm_desc { + unsigned char gap1; + unsigned char control; + unsigned char gap2; + unsigned char spec; + unsigned char gap3; + unsigned char data[2*FDPMQUEUE_LEN-1]; +}; +#endif + +#ifdef LITTLE_ENDIAN +struct fdpm_desc { + unsigned char control; + unsigned char gap1; + unsigned char spec; + unsigned char gap2; + unsigned char data[2*FDPMQUEUE_LEN-1]; + unsigned char gap3; +}; +#endif + +#ifdef BIG_ENDIAN +#define DPM_MSYNC_LOCL_ADDR 0x3 +#define DPM_MSYNC_PEER_ADDR 0x1 +#define DPM_TARGET_RUN_ADDR 0x5 +#endif + +#ifdef LITTLE_ENDIAN +#define DPM_MSYNC_LOCL_ADDR 0x2 +#define DPM_MSYNC_PEER_ADDR 0x0 +#define DPM_TARGET_RUN_ADDR 0x4 +#endif + +/* swap macro for MOTOROLA <-> INTEL access on ICAN3 */ +#ifdef LITTLE_ENDIAN +#define SWAP_WORD(x) (((x & 0xff) << 8) | (0xff & (x >> 8))) +#endif +#ifdef BIG_ENDIAN +#define SWAP_WORD(x) (x) +#endif + +#endif /* #ifdef INKERNEL */ + +#define TOHOST_DPM_QUEUE_PAGE 5 /* tohost_dpmqueue page */ +#define FROMHOST_DPM_QUEUE_PAGE 6 /* fromhost_dpmqueue page prio mid */ +#define FROMHOST_DPM_QUEUE_HI_PAGE 7 /* fromhost_dpmqueue page prio high */ +#define FROMHOST_DPM_QUEUE_LOW_PAGE 8 /* fromhost_dpmqueue page prio low */ +#define START_BUFF 9 /* first free page within DPM */ + + +/*----------routing specific defines ------------------------*/ + +/* CAN Identifiers used by CAL (cf. CiA/DS204-1, Annex I) */ +#define ID_START_STOP 0 /* Node Start, Stop, Disconnect */ +#define ID_CMS_NIL 0 /* invalid CMS Id */ +#define ID_CMS_MIN 1 /* range of CMS */ +#define ID_CMS_MAX 1760 /* identifiers */ +#define ID_GUARD_NIL 0 /* invalid guard Id */ +#define ID_GUARD_MIN 1761 /* range of guarding */ +#define ID_GUARD_MAX 2015 /* identifiers */ +#define ID_LMT_S 2020 /* from LMT Slave */ +#define ID_LMT_M 2021 /* from LMT Master */ +#define ID_NMT_IDENTIFY 2022 /* Identify Node Protocol */ +#define ID_DBT_S 2023 /* from DBT Slave */ +#define ID_DBT_M 2024 /* from DBT Master */ +#define ID_NMT_S 2025 /* from NMT Slave */ +#define ID_NMT_M 2026 /* from NMT Master */ +#define ID_SELFTEST 2027 /* for module selftest */ +#define ID_MIN 0 /* range of identifiers */ +#define ID_MAX 2031 /* controlled by CiA */ + +#define MAX_ROUTES_PER_ID (ID_MAX * 2) + /* should be enough... */ + +#define NIL_ROUT (struct rout_target *) 0 + /* NIL pointer for "no routing" */ + +#define NIL_NIL_ROUT (struct rout_target **) 0 + /* NIL pointer for "no routing" */ + +#define NIL_DPM_DEV (DPM_DEV *) -1 + /* NIL pointer for "no routing" */ + +#define BLANC 0xffff /* empty / last entry indicator in */ + /* rout_target->target_id struct */ + /* member */ + +/* prioritized fast-fromhost-queue specific defines/structures */ + +struct fromHostFastDpmQPrioEntry { + unsigned short priority; + volatile struct fdpmw_desc *fhfdpmQueue; + int fhfdpmQueueP; + int fhfdpmQueueStartP; + struct fromHostFastDpmQPrioEntry *next; +}; +#define NIL_FHFDQ_PRIO_ENTRY (struct fromHostFastDpmQPrioEntry *)0 + +#ifdef __cplusplus +} +#endif + +#endif /* __INCdpmh */ + Index: trunk/MagicSoft/Cosy/incl/gendef.h =================================================================== --- trunk/MagicSoft/Cosy/incl/gendef.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/gendef.h (revision 731) @@ -0,0 +1,582 @@ +/* -*-C-*- + * gendef.h - CANopen; home of generic definitions + * + *----------------------------------------------------------------------- + * + * Copyright (c) 1998 JANZ Computer AG + * All Rights Reserved + * + * Permission is hereby granted to licensees of JANZ Computer AG + * products to use or abstract this computer program for the sole + * purpose of implementing a product based on JANZ Computer AG + * products. No other rights to reproduce, use, or disseminate + * this computer program, whether in part or in whole, are granted. + * + * JANZ Computer AG makes no representation or warranties with respect + * to the performance of this computer program, and specifically + * disclaims any responsibility for any damages, special or consequential, + * connected with the use of this program. + * + * JANZ Computer AG products are not authorized for use as critical + * components in life support devices or systems without the express + * written approval of JANZ Computer AG. + * + *----------------------------------------------------------------------- + * + * $Id: gendef.h,v 1.1 2001-04-09 13:32:55 tbretz Exp $ + * + *----------------------------------------------------------------------- + * + * $Log: not supported by cvs2svn $ + * Revision 1.7 2000/02/18 11:22:11 jens + * adding variable in global variable structure: incomingSdoBehaviour + * + * Revision 1.6 1999/10/29 11:07:51 gerd + * Add support for Linux. + * + * Revision 1.5 1999/09/16 14:50:02 gerd + * Add support for PSOS + * + * Revision 1.4 1999/09/06 14:20:54 wolfgang + * Add macros and variable for MS-DOS. + * + * Revision 1.3 1999/06/18 12:08:15 jens + * made VMOD-ICAN/CAN104 dependend headers conditional (CAL_CANOPEN_CLAMPED) + * made pdoTagTables available at CAL_CANOPEN_CLAMPED-section only + * + * Revision 1.2 1999/06/10 14:10:36 wolfgang + * Add NT40 part for CANopen stuff. + * + * Revision 1.1 1999/03/08 16:55:13 jens + * Initial revision + * + * + *----------------------------------------------------------------------- + */ + +#ifndef gendef_DEFINED +#define gendef_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef WIN95 +#include +#endif + +#ifdef WIN_NT40 +#include +#endif + +#include "icanconf.h" +#include "calconf.h" +#include "cms.h" + +#include "bcan.h" + +#ifndef CAL_CANOPEN_CLAMPED +#include "mican.h" +#include "dpm.h" +#include "can_lib.h" +#endif + +#include +#include + +#ifdef WIN95 + +#define LCL_SLEEP(sleepTimeInMs) \ + Sleep(sleepTimeInMs) + +#define CREATE_SEMAPHORE(pSecure, initCount, maxCount, pName) \ + CreateSemaphore(pSecure, initCount, maxCount, pName); + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + WaitForSingleObject(semId, howLong) + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) \ + ReleaseSemaphore(semId, count, addrPrevCount) +#endif + + +#ifdef WIN_NT40 + +#define LCL_SLEEP(sleepTimeInMs) \ + Sleep(sleepTimeInMs) + +#define CREATE_SEMAPHORE(pSecure, initCount, maxCount, pName) \ + CreateSemaphore(pSecure, initCount, maxCount, pName); + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + WaitForSingleObject(semId, howLong) + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) \ + ReleaseSemaphore(semId, count, addrPrevCount) + +#endif + +#ifdef VXWORKS +#include +#include + +#define INFINITE 0 + +#define LCL_SLEEP(sleepTimeInMs) \ + taskDelay(((sleepTimeInMs * 100) / (100000 / sysClkRateGet())) + 1) + +#define CREATE_SEMAPHORE(pSecure, initCount, maxCount, pName) \ + semBCreate(SEM_Q_FIFO, (SEM_B_STATE)initCount); + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + semTake(semId, WAIT_FOREVER) + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) \ + semGive(semId) +#endif + +#ifdef MSDOS + +#define LCL_SLEEP(sleepTimeInMs) \ + delay(sleepTimeInMs) + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + {do{delay(100);}while(((myVars->pMsgHandler)((void*)myVars))==1);} + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) + +#endif + +#ifdef PSOS +#include "sysdep.h" +#include +#include +#include +#include +#include +#include + +#include "defs.h" + + +extern NODE_CT *anchor; + +/* The following functions are used to translate vxWorks functions */ +/* to pSOS+ system calls */ +/* This functions will be removed within later versions. */ + +static int +semBCreate(int options, int state) +{ + unsigned long semid; + char semname[4]; + + semname[0] = 'S'; + semname[1] = 'M'; + semname[2] = '0'; + semname[3] = '0'; + + if(sm_create(semname, (unsigned long)state, + SM_GLOBAL | SM_FIFO, &semid) != 0) + return(0); + + return((int)semid); +} + +/* end of vxWorks to pSOS+ translation */ + +#define CLOCKS_PER_SEC (anchor->psosct->kc_ticks2sec) + +#define LCL_SLEEP(sleepTimeInMs) \ + tm_wkafter(((sleepTimeInMs * 100) / (100000 / CLOCKS_PER_SEC)) + 1) + +#define CREATE_SEMAPHORE(pSecure, initCount, maxCount, pName) \ + semBCreate(0, (int)initCount); + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + sm_p((unsigned long)semId, SM_WAIT, 0) + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) \ + sm_v(semId); + +#endif + +#ifdef LINUX +#include +#include +#include + +#define WAIT_FOREVER 0 + +extern int semBCreate(int options, int initCount); +extern int semTake(int semId, int timeout); +extern int semGive(int semId); + +#if 0 +static int +semBCreate(int options, int initCount) +{ + int semId; + + if((semId = semget(IPC_PRIVATE, 1, 0766|IPC_CREAT)) < 0) { + return(0); + } + + if(semctl(semId, 0, SETVAL, (union semun) initCount) < 0) { + return(0); + } + + return((int)semId); +} + +static int +semTake(int semId, int timeout) +{ + static struct sembuf semaphor; + + semaphor.sem_op = -1; + semaphor.sem_flg = SEM_UNDO; + + return( (int)semop(semId, &semaphor, 1) ); +} + +static int +semGive(int semId) +{ + static struct sembuf semaphor; + + semaphor.sem_op = 1; + semaphor.sem_flg = SEM_UNDO; + + return( (int)semop(semId, &semaphor, 1) ); +} +#endif + +#define LCL_SLEEP(sleepTimeInMs) (void)usleep(sleepTimeInMs * 1000) + + +#define CREATE_SEMAPHORE(pSecure, initCount, maxCount, pName) \ + semBCreate(0, (int)initCount); + +#define WAIT_FOR_SEMAPHORE(semId, howLong) \ + semTake(semId, WAIT_FOREVER) + +#define RELEASE_SEMAPHORE(semId, count, addrPrevCount) \ + semGive(semId) + +#endif /* LINUX */ + +/* + * generic variable types + */ +#define LWORD_t unsigned long +#define WORD_t unsigned short +#define BYTE_t unsigned char + +#define LWORDS_t long +#define WORDS_t short +#define BYTES_t char + +#define VOID_t void + +#define INT_t int + +/* + * CANopen specific structures/defines + */ + +/* + * Translation: CANopen data-type -> machine data-type + */ +#define Boolean char + +#define Integer8 char +#define Integer16 short +#define Integer32 long + +#define Signed8 char +#define Signed16 short +#define Signed32 long + +#define Unsigned8 unsigned char +#define Unsigned16 unsigned short +#define Unsigned32 unsigned long + +#define FloatingPoint float + +#define VisString char + + +/* + * machine dependant size of data-type + */ +#define Boolean_size sizeof(char) + +#define Integer8_size sizeof(char) +#define Integer16_size (2 * sizeof(char)) +#define Integer32_size (4 * sizeof(char)) +#define Integer64_size (8 * sizeof(char)) + +#define Signed8_size sizeof(char) +#define Signed16_size (2 * sizeof(char)) +#define Signed32_size (4 * sizeof(char)) +#define Signed64_size (8 * sizeof(char)) + +#define Unsigned8_size sizeof(char) +#define Unsigned16_size (2 * sizeof(char)) +#define Unsigned32_size (4 * sizeof(char)) +#define Unsigned64_size (8 * sizeof(char)) + + + +#define FloatingPoint_size sizeof(float) + +#define VisString_size (255 * sizeof(char)) + + +struct dataType64bit { + LWORD_t highBytes; + LWORD_t lowBytes; +}; + + +#define NIL (void *)0 + +/* define values for FALSE and TRUE */ + +#ifndef MSDOS + +#ifdef LINUX +#define TRUE 1 +#define FALSE 0 +#else +#ifndef TRUE +#define TRUE 0 +#endif + +#ifndef FALSE +#define FALSE (-1) +#endif +#endif + +#else +#define TRUE 1 +#define FALSE 0 +#endif + +#ifdef CAL_CANOPEN_CLAMPED + #define LCL_NIL_CMSO NIL_CMSO +#else + #define LCL_NIL_CMSO 0 +#endif + + +struct Node { + struct Node *Next; /* next node */ + WORD_t objDicIndex; /* data stored in node */ + VOID_t *pEntry; /* pointer to entry of object dictionary */ +}; + +struct hashTabs { + struct Node **pComProfHashTab; + struct Node **pManProfHashTab; + struct Node **pDevProfHashTab; + struct Node **pDataTypHashTab; + struct Node **pIec1131ProfHashTab; +}; + +struct pdoDataArray { + BYTE_t data[8]; + BYTE_t arrivedLength; +}; + +struct mSpErrField { + BYTE_t mSpErrData[5]; +}; + +#define NIL_SDO_DATA_AREA (struct sdoDataArea *)0 + +#define NUM_OF_TAG_BYTES 64 /* will be enough for 512 (* 2) PDOs */ +#define RX_PDO_TAG 0 +#define TX_PDO_TAG 1 + +#define SDO_ARRIVED 1 +#define PDO_ARRIVED 2 + + +#define NUM_BIT_RATE_TABLE_ENTRY 9 +#define CANOPEN_DEFAULT_BIT_RATE 4 + +struct baudTable { + WORD_t bitMacro; + WORD_t bitRate; +}; + +/* Code switch settings for LMT configuration */ +#define CS_SET_BIT_RATE 0xf0 +#define CS_SET_DEFAULT_BIT_RATE 0x00 + +/* + * Place of global variables + */ + + +struct globVars { + struct hashTabs haTab; /* place where pointer to */ + /* hash tables are stored */ + + BYTE_t nodeState; /* current CANopen slave node state */ + BYTE_t nodeClass; /* NMT node-class of slave node to create */ + + /* global entries from DCF: [DeviceCommisioning] */ + BYTE_t nodeId; /* CANopen node ID */ + BYTE_t nodeName[7]; /* CANopen LMT node name */ + WORD_t bitRateMacro; /* current CANopen CAN-Bus-bit-rate */ + + struct baudTable bitRateTable[NUM_BIT_RATE_TABLE_ENTRY]; /* CANopen bit-rate-table */ + + + /* field which holds manufacturer specific error for EMCY */ + struct mSpErrField myManSpErrorField; + + /* + * Holding number of TPDOs and RPDOs + */ + BYTE_t numRxPdo; + BYTE_t numTxPdo; + + /* + * behaviour on incoming SDOs in relationship to Slave nodeState + */ + BYTE_t incomingSdoBehaviour; + +#ifdef CAL_CANOPEN_CLAMPED + /* + * This table holds a tag if data which are + * mapped to a PDO (txDataTable) or if data + * of a PDO (rxDataTable) had changed. The + * Table is bit oriented and holds 512 RxPDOs + * and 512 TxPDOs + */ + BYTE_t rxPdoTagTable[NUM_OF_TAG_BYTES]; + BYTE_t txPdoTagTable[NUM_OF_TAG_BYTES]; + + /* + * Holding a table, where data[8] of each RPDO + * is hold to grant access without scrolling + * through Object Dictionary + */ + struct pdoDataArray *dataTablePdo; + + /* + * This variable gives a chance to decide, + * if the tag entry in the PDO-change-array + * was caused by a PDO arrival or by SDO- + * communication. + */ + BYTE_t lastDataFromPdoSdo; + + /* This linked list holds the created (and enabled, coded!) TPDOs */ + struct pdoSendList *pPdoSendList; + +#endif + /* + * array to hold temp VisString-OD-data + */ + char charBuf[256]; + +#ifndef CAL_CANOPEN_CLAMPED + /* stuff for communication to VMOD-ICAN3 */ + Message msgBufferTx; /* message buffer */ + int fd; /* file descriptor of module */ + WORD_t cmsDefinitionTimeout; /* timeout in milliseconds to */ + /* wait for module response at */ + /* cms definition services */ + char lastCmsDefinitionName[13]; /* ID from VMOD-ICAN3 at definition response */ + WORD_t lastCmsDefinitionId; /* ID from VMOD-ICAN3 at definition response */ + + + /* for CANopen manager functionality: */ + WORD_t variableSDOIdToIcan3; + WORD_t variableSDOIdFromIcan3; + WORD_t sdoResponseTimeout; /* timeout in milliseconds to */ + /* wait for peer nodes' SDO response */ + BYTE_t sdoRxBuffer[256]; /* place for SDO data exchange (Rx) */ + BYTE_t sdoTxBuffer[256]; /* place for SDO data exchange (Tx) */ + BYTE_t sdoValidData; /* number of received SDO data */ + BYTE_t sdoResponse; /* flag for answer of peer SDO */ + +#ifdef WIN95 + HANDLE hThreadCopSlv; /* thread handle */ +#endif +#ifdef VXWORKS + int hThreadCopSlv; /* task ID */ +#endif +#ifdef PSOS + unsigned long hThreadCopSlv; /* task ID */ +#endif +#ifdef LINUX + unsigned long hThreadCopSlv; /* task ID */ +#endif +#ifdef WIN_NT40 + HANDLE hThreadCopSlv; /* thread handle */ +#endif + +#ifdef WIN95 + HANDLE hSemCopSlv; + HANDLE hSemIcanCom; /* semaphore for thread-save comunication */ + /* between receive thread and lib */ +#endif + +#ifdef WIN_NT40 + HANDLE hSemCopSlv; + HANDLE hSemIcanCom; /* semaphore for thread-save comunication */ + /* between receive thread and lib */ + HANDLE hSemPlainQueue; /* semaphore to signal application that a message is */ + /* inside the to-host plain queue */ + HANDLE hSemFastQueue; /* semaphore to signal application that a message is */ + /* inside the to-host fast queue */ +#endif + +#ifdef VXWORKS + SEM_ID hSemCopSlv; + SEM_ID hSemIcanCom; /* semaphore for thread-save comunication */ + /* between receive thread and lib */ +#endif +#ifdef PSOS + SEM_ID hSemCopSlv; + SEM_ID hSemIcanCom; /* semaphore for thread-save comunication */ + /* between receive thread and lib */ +#endif +#ifdef LINUX + int hSemCopSlv; + int hSemIcanCom; /* semaphore for thread-save comunication */ + /* between receive thread and lib */ +#endif + +#ifdef MSDOS + int (*pMsgHandler) (void*); +#endif + int tIdCopSlv; + Message msgBufferRx; + + LWORD_t usedDpmCount; /* variable for objects interfacing to DPM, */ + /* counts the actual offset to start of PP-area */ + + int (*drvRead)(); /* driver function to call on internal DPM-read */ + void (*drvWrite)(); /* driver function to call on internal DPM-write */ +#endif + +}; + + +#if KDEBUG==1 +/* DEBUG tool KPRINTF */ +extern long freeMemDebug; +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* !gendef_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/hash.h =================================================================== --- trunk/MagicSoft/Cosy/incl/hash.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/hash.h (revision 731) @@ -0,0 +1,36 @@ +/*----------------------------------------------------------------------------- +hash.h -- Hashing + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.3 of 98/03/24 + +-----------------------------------------------------------------------------*/ + +#ifndef hash_DEFINED +#define hash_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" + +/* Hashing */ +#define HASH_LEN 211 /* prime number used in hashing */ +extern int hashfcn(BYTE_t *bytestr, int len); + +/* Check encoding range of character */ +#define IS_NUM(c) ((c) >= 0x30 && (c) <= 0x39) +#define IS_ALPHA_NUM(c) (((c) >= 0x30 && (c) <= 0x39) || \ + ((c) == '_') || \ + ((c) >= 0x41 && (c) <= 0x5a) || \ + ((c) >= 0x61 && (c) <= 0x7a)) + +#ifdef __cplusplus +} +#endif + +#endif /* !hash_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/icanconf.h =================================================================== --- trunk/MagicSoft/Cosy/incl/icanconf.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/icanconf.h (revision 731) @@ -0,0 +1,144 @@ +/*----------------------------------------------------------------------------- +icanconf.h -- ICANOS specific definitions + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.16 of 99/06/23 + +Declarations and definitions of functions and macros: + - disable/enable CAN and clock interrupts + - start/stop a periodical timer + - read/write registers in Basic CAN controller +The conditionally included files i8051.h and mc68332.h contain +examples for the Intel 8051 and Motorola 68332 micro-controller +families, respectively. + +Some definitions in bcan.h depend on the oscillator frequency used +for the Basic CAN controller. Currently only definitions for a 16 MHz +oscillator are given. These are activated by defining OSC_16MHZ here. + +Memory allocation functions: + - malloc() and free() +If these functions are not available from a system library the +functions implemented in malloc.c are used if OUR_MALLOC==1. +These functions allocate memory from a fixed size array. +The length of this array in bytes is given by MALLOC_BYTES. +The data type ALIGN_t is used to insure that malloc returns addresses +which are correctly aligned for every data type. + +-----------------------------------------------------------------------------*/ + +#ifndef icanconf_DEFINED +#define icanconf_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +/* Load the user configuration */ +#include "config.h" + +/* Intel 8051 family with Archimedes C-51 compiler */ +#ifdef i8051 +#include "i8051.h" +#endif + +/* Motorola 68332 with Microtec Research C compiler */ +#ifdef mc68332 +#include "mc68332.h" +#endif + +/* Implementation options */ +#ifndef ICAN_ECHO +#define ICAN_ECHO 1 /* with local transmit echo if == 1 */ +#endif +#ifndef ICAN_FILTER +#define ICAN_FILTER 1 /* with acceptance filtering if == 1 */ +#endif + +/* Set maximum CAN send queue length. */ +#ifndef TX_QUEUE_LEN +#define TX_QUEUE_LEN 20 +#endif + +/* Define this if a 16 MHz oscillator is used for BCAN */ +#define OSC_16MHZ + +/*------- Memory allocation ------------------------------------------------*/ + +/* If OUR_MALLOC is !=0 then malloc() and fre() as implemented in + malloc.c are used else the system library functions are used. + By default our functions are used. */ +#ifndef OUR_MALLOC +#define OUR_MALLOC 0 /* if true, use our malloc and free */ +#endif + +/* Memory management */ +#if OUR_MALLOC == 1 /* using our malloc and free? */ + +#ifndef MALLOC_BYTES +#define MALLOC_BYTES 8000 /* size in bytes of alloc array */ +#endif +typedef int ALIGN_t; /* alignment type */ + +/* Memory is allocated from an array of blocks of type HEADER */ +union header { /* free block header */ + struct { + union header *ptr; /* next free block */ + unsigned size; /* size of this free block */ + } s; + ALIGN_t x; /* force alignment of blocks */ +}; + +typedef union header HEADER; + +/* Maximum number of blocks */ +#define MALLOC_BLOCKS (MALLOC_BYTES/sizeof(HEADER)+1) + +extern void init_malloc(); /* initialization of alloc array */ +extern void *malloc(); /* well known function */ +extern void free(); /* well known function */ +extern int check_free_mem(); /* check for free memory */ + +#else /* use malloc and free of system library */ +#include +#define init_malloc() +#endif +#define FREE(p) if ((p)) free((void *)p) + + +/*------- Debugging tools (for development at JANZ only) -------------------*/ + +#ifndef DEBUG +#define DEBUG 0 /* default: no debugging */ +#endif + +/* Logging */ +#if DEBUG>0 +#include "debug.h" +#else +#define PRINTF(args) +#define LOG(level, args) +#define DESPAIR +#endif + +#ifndef BIGBOX +#ifdef GDBDEBUG +#include "userIf.h" +#else +#define KPRINTF(X) +#endif +#endif + +/* Dummies */ +#if DEBUG==1 +#include "simul.h" +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* !icanconf_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/icanif.h =================================================================== --- trunk/MagicSoft/Cosy/incl/icanif.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/icanif.h (revision 731) @@ -0,0 +1,84 @@ +/*----------------------------------------------------------------------------- +icanif.h -- Interface to ICANOS/2 + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.6 of 96/10/31 + +Timer and CAN controller indications, and received CAN messages are multiplexed +"upwards" into a queue which as to be read with recv_ican() by the user. +Requests to the timer management, the CAN controller and the acceptance +filter are issued via function calls. + +-----------------------------------------------------------------------------*/ + +#ifndef icanif_DEFINED +#define icanif_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "icanconf.h" +#include "defs.h" +#include "mican.h" +#include "msg.h" +#include "bcan.h" +#include "afil.h" +#include "timer.h" + + +/* Initialize the multiplexer */ +extern void init_ican _PARAMS((void)); + +/* Multiplex CAN messages from ICANOS in upwards queue */ +extern void mux_ican _PARAMS((struct message *)); + +/* Multiplex timer messages from ICANOS in upwards queue */ +extern void mux_ican_tim _PARAMS((struct message *)); + +/* User receives next message from ICANOS */ +extern struct message *recv_ican _PARAMS((void)); + +#ifdef __cplusplus +} +#endif + +#endif /* !icanif_DEFINED */ +#ifndef icanif_DEFINED +#define icanif_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "icanconf.h" +#include "defs.h" +#include "mican.h" +#include "msg.h" +#include "bcan.h" +#include "afil.h" +#include "timer.h" + +/* Set Priority Boundaries */ +extern void set_prio_boundaries(WORD_t,WORD_t); + +/* Initialize the multiplexer */ +extern void init_ican _PARAMS((void)); + +/* Multiplex messages from ICANOS in upwards queue for CAN-msgs */ +extern void mux_ican _PARAMS((struct message *)); + +/* Multiplex messages from ICANOS in upwards queue for timer-msgs */ +extern void mux_ican_tim _PARAMS((struct message *)); + +/* User receives next message from ICANOS */ +extern struct message *recv_ican _PARAMS((void)); + +#ifdef __cplusplus +} +#endif + +#endif /* !icanif_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/linux.h =================================================================== --- trunk/MagicSoft/Cosy/incl/linux.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/linux.h (revision 731) @@ -0,0 +1,94 @@ +/* -*-C-*- + * linux.h - linux to dpm type conversions + * + *----------------------------------------------------------------------- + * + * Copyright (c) 1997 JANZ Computer AG + * All Rights Reserved + * + * Permission is hereby granted to licensees of JANZ Computer AG + * products to use or abstract this computer program for the sole + * purpose of implementing a product based on JANZ Computer AG + * products. No other rights to reproduce, use, or disseminate + * this computer program, whether in part or in whole, are granted. + * + * JANZ Computer AG makes no representation or warranties with respect + * to the performance of this computer program, and specifically + * disclaims any responsibility for any damages, special or consequential, + * connected with the use of this program. + * + * JANZ Computer AG products are not authorized for use as critical + * components in life support devices or systems without the express + * written approval of JANZ Computer AG. + * + *----------------------------------------------------------------------- + * + * $Id: linux.h,v 1.1 2001-04-09 13:32:55 tbretz Exp $ + * + *----------------------------------------------------------------------- + */ + +/* + * $Log: not supported by cvs2svn $ + * Revision 1.1 1997/09/29 15:50:04 root + * Initial revision + * + * Revision 1.1 1997/04/01 14:54:59 root + * Initial revision + * + */ + + +#ifndef linux_DEFINED +#define linux_DEFINED +#if __cplusplus +extern "C" { +#endif + +/***** defines **************************************************************/ + +#define TRUE (1) +#define FALSE (0) +#define ERROR (-1) +#define intLock(x) disable_irq(x) +#define intUnlock(x) enable_irq(x) + +#define DEV_HDR int +#define SEM_ID int + +#define FAST register +#define IMPORT extern +#define LOCAL static + +/***** typedefs *************************************************************/ + +typedef char INT8; +typedef short INT16; +typedef int INT32; + +typedef unsigned char UINT8; +typedef unsigned short UINT16; +typedef unsigned int UINT32; + +typedef unsigned char UCHAR; +typedef unsigned short USHORT; +typedef unsigned int UINT; +typedef unsigned long ULONG; + +typedef int BOOL; +typedef int STATUS; +typedef int ARGINT; + +typedef void VOID; + +typedef int (*FUNCPTR) (); /* ptr to function returning int */ +typedef void (*VOIDFUNCPTR) (); /* ptr to function returning void */ +typedef double (*DBLFUNCPTR) (); /* ptr to function returning double*/ +typedef float (*FLTFUNCPTR) (); /* ptr to function returning float */ + +/***** function declarations ***********************************************/ + +#if __cplusplus +} +#endif +#endif /* linux_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/lmts.h =================================================================== --- trunk/MagicSoft/Cosy/incl/lmts.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/lmts.h (revision 731) @@ -0,0 +1,80 @@ +/*----------------------------------------------------------------------------- +lmts.h -- LMT Slave + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 95/02/02 by Soenke Hansen +Version 1.5 of 96/04/18 + +Various definitions: LMT Address type, LMT command specifiers, +macros for data indicated to the LMT User. +Prototypes of functions defined in lmts.c. + + +-----------------------------------------------------------------------------*/ + + +#ifndef lmts_DEFINED +#define lmts_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" + +/* There is one CAL Object associated with the LMT Slave */ +extern struct calo *LmtSlave; /* receives COBs from LMT Master */ + +/* LMT Address type */ +struct lmt_addr { + BYTE_t manuf[8]; /* manufacturer name */ + BYTE_t prod[8]; /* product name */ + BYTE_t serno[8]; /* serial number */ +}; +#if TYPEDEFS == 1 +typedef struct lmt_addr LmtAddr; +#else +#define LmtAddr struct lmt_addr +#endif + +/* Parameters to user indications */ +#define lmts_mode u.m1.w[0] /* LMT Mode */ +#define lmts_btr u.m1.w[0] /* Bit Timing Parameter */ + +/* Command specifiers in LMT Protocol */ +#define LMT_CS_SWITCH_SEL_MANUF 1 /* Switch Mode Select: Manuf. Name */ +#define LMT_CS_SWITCH_SEL_PROD 2 /* Switch Mode Select: Product Name */ +#define LMT_CS_SWITCH_SEL_SERNO 3 /* Switch Mode Select: Serial # */ +#define LMT_CS_SWITCH_GLOBAL 4 /* Switch Mode Global */ +#define LMT_CS_CONF_MODID 17 /* Configure Module ID */ +#define LMT_CS_CONF_MODNAME 18 /* Configure Module Name */ +#define LMT_CS_CONF_BITTIME 19 /* Configure Bit Timing */ +#define LMT_CS_ACTV_BITTIME 21 /* Activate Bit Timing */ +#define LMT_CS_STORE_CONFIG 23 /* Store Configuration */ +#define LMT_CS_INQUIRE_MANUF 36 /* Inquire Manufacturer Name */ +#define LMT_CS_INQUIRE_PROD 37 /* Inquire Product Name */ +#define LMT_CS_INQUIRE_SERNO 38 /* Inquire Serial Number */ + +/* Nil command specifier */ +#define LMT_CS_NIL 0 /* not used by protocols */ + +/* Allocate and initialize LMT Slave */ +extern void InitLmtS( + WORD_t , /* configured bit timing parameters */ + void (*)() /* user handler indication/confirmation */ +); + +/* Deallocate LMT Slave */ +extern void DeleteLmtS(void); + +/* Create LMT Address */ +extern void CreateLmtAddress(LmtAddr *); + +#ifdef __cplusplus +} +#endif + +#endif /* !lmts_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/mbx.h =================================================================== --- trunk/MagicSoft/Cosy/incl/mbx.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/mbx.h (revision 731) @@ -0,0 +1,69 @@ +/*----------------------------------------------------------------------------- +mbx.h -- Synchronization of mailbox access + +Copyright (c) 1995 JANZ Computer AG +All Rights Reserved + +Created 96/01/23 by Stefan Althoefer +Version 1.4 of 96/07/26 + +Two processes -- local and peer -- communicate via mailboxes. +There are two mailboxes for each direction. Thus there are four +mailboxes altogether referred to by indexes 0,1,2,3. + +To synchronize read-write access to the mailboxes two synchronization +bytes are used. These bytes are located in shared memory readable by +both processes. One byte is owned by the local process the other by +the (remote) peer process. Only the owner of a synchronization byte +may write it. + +There are two functions for the local process to manipulate the +synchronization bytes: msync_get() and msync_unget(). +With msync_get(1) (resp. msync_get(0)) the local process requests a +mailbox for writing (resp. reading). The index "index" of the next box +ready for writing (resp. for reading) is returned. The value -1 is +returned if there is no such box. After using the box the local process +calls msync_unget(writing, index) making the box available to the peer. + +The functions are declared static. This file is meant to included in +the file where reading and writing mailboxes is done. +It is necessary to designate the send (write) direction as either +up or down by #defining MSYNC_UP in the local process and MSYNC_DOWN +in the peer process (or vice versa). +The addresses of the synchronization bytes must be specified +with MSYNC_LOCL_ADDR or MSYNC_PEER_ADDR. + +-----------------------------------------------------------------------------*/ + +#ifndef mbx_DEFINED +#define mbx_DEFINED + +#define far + +/* Function prototypes by default */ +#ifdef __STDC__ +#define _PARAMS(args) args +#else +#define _PARAMS(args) () +#endif + +/* Mailbox access macros */ +#define mbx_get(i) ((unsigned char *)(MBX_BASE+(i+1) * MBX_LENGTH)) + +/* Values for parameter "writing" in msync_*() */ +#define MBX_WRITING 1 +#define MBX_READING 0 + +#define MSYNC_SHIFT(w) ((w) ? 4 : 0) + +/* Address of local synchronization byte */ +#ifdef MSYNC_LOCL_ADDR +#define MSYNC_LOCL (MSYNC_LOCL_ADDR) +#endif + +/* Address of peer synchronization byte */ +#ifdef MSYNC_PEER_ADDR +#define MSYNC_PEER (MSYNC_PEER_ADDR) +#endif + +#endif /* mbx_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/mcal.h =================================================================== --- trunk/MagicSoft/Cosy/incl/mcal.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/mcal.h (revision 731) @@ -0,0 +1,307 @@ +/*----------------------------------------------------------------------------- +mcal.h -- CAL Message Specifications + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.48 of 00/02/17 + +Definitions of message specifiers for message exchanged between +CAL and a CAL User (Application). + +-----------------------------------------------------------------------------*/ + +#ifndef mcal_DEFINED +#define mcal_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +/* Message specifiers (User -- DBT Slave) */ +#define M_DBTS_CREATE 0x80 /* create user definition */ +#define M_DBTS_CREATE_ALL 0x81 /* create all user definitions */ +#define M_DBTS_DELETE 0x82 /* delete user definition */ +#define M_DBTS_VERIFY 0x83 /* verify COB definition */ +#define M_DBTS_CHECKSUM 0x84 /* get checksum */ + +/* Message specifiers (User -- NMT Slave) */ +#define M_NMTS_STATE_ind 0x90 /* indicate NMT state change to user */ +#define M_NMTS_PREPARE_ind 0x91 /* ask user to initiate preparation */ +#define M_NMTS_IDENTIFY_ind 0x92 /* ind. for this node to identify */ +#define M_NMTS_EVENT_ind 0x93 /* Node Event indication */ +#define M_NMTS_RESET_NODE_ind 0x94 /* CANopen Reset Node indication */ +#define M_NMTS_RESET_COMMUNICATION_ind 0x95 + /* CANopen Reset Communication indication */ +#define M_NMTS_CONF_ind 0x96 /* config. services (with subspec!) */ +#define M_NMTS_CONF_DATA_ind 0x97 /* config. data services (w. subspec!) */ + +/* Message "sub-specifiers" with M_NMTS_CONF_[DATA_]ind */ +#define M_NMTS_CONF_DL_DATA_ind 0x0001 /* config. download data ind. */ +#define M_NMTS_CONF_DL_DATA_CONT_ind 0x0002 /* config. download data ind. */ +#define M_NMTS_CONF_DL_FAIL_ind 0x0003 /* config. download fail. ind.*/ +#define M_NMTS_CONF_DL_SUCC_ind 0x0004 /* config. download succ. ind.*/ +#define M_NMTS_CONF_ABORT_ind 0x0005 /* config. transfer abort ind.*/ +#define M_NMTS_CONF_VERIFY_ind 0x0006 /* config. protocol verify ind.*/ + +/* Failure codes (nmtm/ nmts configuration) */ +#define NMT_CONFIG_NO_ERR 0 /* no error */ +#define NMT_CONFIG_TOGGLE_ERR 1 /* toggle error */ +#define NMT_CONFIG_SIZE_ERR 2 /* mismatch of data size */ +#define NMT_CONFIG_PROTOCOL_ERR 3 /* nomen est omen */ +#define NMT_CONFIG_MEM_ERR 4 /* no more mem free */ +#define NMT_CONFIG_RESTART_ERR 5 /* current up-/down-load will */ + /* be restarted */ + +/* Message specifiers (User -- LMT Slave) */ +#define M_LMTS_MODE_ind 0x98 /* change of LMT mode */ +#define M_LMTS_BUSON_ind 0x99 /* activate bit timing completed */ +#define M_LMTS_BUSOFF_ind 0x9a /* activate bit timing started */ +#define M_LMTS_NMTADDR_ind 0x9b /* new NMT address (partial) */ +#define M_LMTS_BTR_ind 0x9c /* new Bit Timing */ +#define M_LMTS_STORE_ind 0x9d /* Store Configuration */ + +/* Message specifiers (User -- NMT Master) */ +#define M_NMTM_CONNECT_ind 0xa0 /* indicate end of Node Connect svc */ +#define M_NMTM_PREPARE_ind 0xa1 /* indicate end of Node Prepare svc */ +#define M_NMTM_IDENTIFY_ind 0xa2 /* Identify Node indication */ +#define M_NMTM_EVENT_ind 0xa3 /* Network Event indication */ +#define M_NMTM_CONF_ind 0xa4 /* config. services (with subspec!) */ + +/* Message "sub-specifiers" with M_NMTM_CONF_ind */ +#define M_NMTM_CONF_DL_CONT_ind 0x0001 /* config. download continue ind. */ +#define M_NMTM_CONF_DL_SUC_con 0x0002 /* config. download success conf. */ +#define M_NMTM_CONF_DL_FAIL_con 0x0003 /* config. download failure conf. */ +#define M_NMTM_CONF_UL_DATA_ind 0x0004 /* config. upload data ind. */ +#define M_NMTM_CONF_UL_DACO_ind 0x0005 /* config. upload data continue ind. */ +#define M_NMTM_CONF_UL_FAIL_con 0x0006 /* config. upload failure conf. */ +#define M_NMTM_CONF_ABORT_ind 0x0007 /* config. transfer abort indication */ +#define M_NMTM_CONF_VERIFY_con 0x0008 /* config. protocol verify conf.*/ + + +/* Message specifiers (User -- CAL) */ +#define M_NMTS 0xb0 /* user <--> NMT slave */ +#define M_NMTM 0xb1 /* user <--> NMT master */ +#define M_DBTS 0xb2 /* user <--> DBT slave */ +#define M_DBTM 0xb3 /* user <--> DBT master */ +#define M_LMTS 0xb4 /* user <--> LMT slave */ +#define M_LMTM 0xb5 /* user <--> LMT master */ +#define M_CMS_DEF 0xb6 /* user <--> CMS definition services */ +#define M_CMS_DATA 0xb7 /* user <--> CMS data transfer */ + +/* CANopen (hardware-timer (TPU) dependant) timer configuration */ +/* Message specifiers (User -- CANopen) */ +#define M_CANOPEN 0xb8 /* user <--> CANopen */ + +#define HI_RES_TIMER 0x0001 /* handle HiRes timestamping */ +#define TIME_OF_DAY_TIMER 0x0002 /* handle TimeOfDay timestamping */ +#define SYNC_TIMER 0x0004 /* handle SYNC timer */ + +/* Start of timestamp/sync messaging */ +#define MS_CANOPEN_START_HI_RES_TS_req 0x0001 /* start HiRes timestamping (CANopen master) */ +#define MS_CANOPEN_START_TOD_TS_req 0x0002 /* start TimeOfDay timestamping (CANopen master) */ +#define MS_CANOPEN_START_SYNC_req 0x0003 /* start SYNC timer (CANopen master) */ + +/* single shot of timestamp/sync messaging */ +#define MS_CANOPEN_TRIGGER_SINGLE_HI_RES_TS_req 0x0004 /* trigger HiRes (TIME-server) stamp once */ +#define MS_CANOPEN_TRIGGER_SINGLE_TOD_TS_req 0x0005 /* trigger TimeOfDay (TIME-server) stamp once */ + +/* mapping the high resolution timestamp into a PDO */ +#define MS_CANOPEN_MAP_HI_RES_TIMESTAMP_req 0x0006 /* map HiRes timestamp (TIME-server) into PDO */ + +#define MS_CANOPEN_DELETE_ALL_PDO_MAPPINGS_req 0x0007 /* PDO mapping configuration (CANopen slave) */ +#define MS_CANOPEN_ADD_PDO_MAPPING_req 0x0008 /* PDO mapping configuration (CANopen slave) */ +#define MS_CANOPEN_ADD_PDO_LENGTH_req 0x0009 /* PDO length configuration (CANopen slave) */ +#define MS_CANOPEN_ADD_PDO_TRANS_TYPE_req 0x000a /* PDO transm. type configuration (CANopen slave) */ +#define MS_CANOPEN_CONTROL_PDO_req 0x000b /* PDO dis-/enabling (CANopen slave) */ +#define MS_CANOPEN_ADJUST_COB_ID_req 0x000c /* PDO COB-Id configuration (CANopen slave) */ +#define MS_CANOPEN_ADD_PDO_INHIB_TIME_req 0x000d /* PDO inhibit-time configuration (CANopen slave) */ +#define MS_CANOPEN_TRIGGER_TPDO_req 0x000e /* triggering of PDO for sending (CANopen slave) */ +#define MS_CANOPEN_TRIGGER_RPDO_req 0x000f /* triggering of PDO for receiption (CANopen slave) */ + +/* Message sub-specifiers with M_NMTS */ +#define MS_NMTS_CREATE_NODE_req 0x0000 /* create slave node */ +#define MS_NMTS_DELETE_NODE_req 0x0001 /* delete slave node */ +#define MS_NMTS_IDENTIFY_NODE_req 0x0002 /* send identify node */ +#define MS_NMTS_CONNECT_NODE_req 0x0003 /* connect node */ +#define MS_NMTS_DISCONNECT_NODE_req 0x0004 /* disconnect node */ +#define MS_NMTS_PREPARE_REMOTE_NODE_res 0x0005 /* send prepare remote node response */ +#define MS_NMTS_PREPARE_REMOTE_NODE_ind 0x0006 /* indicate prepare remote node request */ +#define MS_NMTS_IDENTIFY_REMOTE_NODES_ind 0x0007 /* indicate request for nodes to identify */ +#define MS_NMTS_STATE_ind 0x0008 /* indicate NMT state change */ +#define MS_NMTS_EVENT_ind 0x0009 /* node event indication */ +/* Definitions for CANopen relevant functions */ +#define MS_NMTS_CREATE_COP_NODE_req 0x000a /* create CANopen slave node */ +#define MS_NMTS_RESET_NODE_ind 0x000b /* CANopen reset node indication */ +#define MS_NMTS_RESET_COMMUNICATION_ind 0x000c /* CANopen reset communication indication */ +#define MS_NMTS_CONFIG_COP_NODE_req 0x000d /* conf. dflt. guard par. of CANopen slave */ +#define MS_NMTS_CONFIG_DOWNLOAD_ind 0x000e /* configuration download indication */ +#define MS_NMTS_CONFIG_DOWNLOAD_CONT_ind 0x000f /* configuration download continue indication */ +#define MS_NMTS_CONFIG_DOWNLOAD_FAIL_ind 0x0011 /* configuration download failure indication */ +#define MS_NMTS_CONFIG_NODE_req 0x0012 /* general purpose configuration of NMT slave */ +#define MS_NMTS_CONFIG_ACK_res 0x0013 /* generate acknowledge for configuration download */ +#define MS_NMTS_CONFIG_ABORT_TRANSFER_ind 0x0014 /* abort configuration transfer indication */ +#define MS_NMTS_CONFIG_ABORT_TRANSFER_req 0x0015 /* abort configuration transfer indication */ +#define MS_NMTS_CONFIG_VERIFY_ind 0x0016 /* verify configuration transfer indication */ +#define MS_NMTS_CONFIG_VERIFY_res 0x0017 /* verify configuration transfer response */ + +/* Message sub-specifiers with M_DBTS */ +#define MS_DBTS_DELETE_USERDEF_req 0x0000 /* delete user definition */ +#define MS_DBTS_DELETE_USERDEF_con 0x0001 /* confirmation */ +#define MS_DBTS_CREATE_ALL_USERDEF_req 0x0002 /* create all user definitions */ +#define MS_DBTS_CREATE_ALL_USERDEF_con 0x0003 /* confirmation */ +#define MS_DBTS_VERIFY_COBCLASS_req 0x0004 /* verify cob class */ +#define MS_DBTS_VERIFY_COBCLASS_con 0x0005 /* confirmation */ +#define MS_DBTS_GET_CHECKSUM_req 0x0006 /* get checksum */ +#define MS_DBTS_GET_CHECKSUM_con 0x0007 /* confirmation */ + +/* Message sub-specifiers with M_LMTS */ +#define MS_LMTS_BUSON_req 0x0000 /* switch to bus on state */ +#define MS_LMTS_BUSOFF_req 0x0001 /* switch to bus off state */ +#define MS_LMTS_CANCONF_req 0x0002 /* configure CANbus parameter */ + +/* Subrequests for CANCONF */ +#define MS_LMTS_CANCONF_BERR 0x00 /* Configure bus-error detection */ +#define MS_LMTS_CANCONF_EWL 0x01 /* Configure error warning limit */ +#define MS_LMTS_CANCONF_LOM 0x02 /* Configure listen only mode */ +#define MS_LMTS_CANCONF_STM 0x03 /* Configure self test mode */ + +/* Message sub-specifiers with M_NMTM */ +#define MS_NMTM_ADD_REMOTE_NODE_req 0x0000 /* add remote node */ +#define MS_NMTM_ADD_REMOTE_NODE_con 0x0001 /* confirmation */ +#define MS_NMTM_REMOVE_REMOTE_NODE_req 0x0002 /* remove remote node */ +#define MS_NMTM_CONNECT_REMOTE_NODE_req 0x0003 /* connect remote node */ +#define MS_NMTM_CONNECT_REMOTE_NODE_con 0x0004 /* confirmation */ +#define MS_NMTM_PREPARE_REMOTE_NODE_req 0x0005 /* prepare remote node */ +#define MS_NMTM_PREPARE_REMOTE_NODE_con 0x0006 /* confirmation */ +#define MS_NMTM_START_REMOTE_NODE_req 0x0007 /* start remote node */ +#define MS_NMTM_STOP_REMOTE_NODE_req 0x0008 /* stop remote node */ +#define MS_NMTM_DISCONNECT_REMOTE_NODE_req 0x0009 /* disconnect remote node */ +#define MS_NMTM_IDENTIFY_REMOTE_NODES_req 0x000a /* identify remote nodes */ +#define MS_NMTM_IDENTIFY_ind 0x000b /* identify node indication */ +#define MS_NMTM_EVENT_ind 0x000c /* network event indication */ +#define MS_NMTM_GET_RNODES_req 0x000d /* get remote nodes */ +#define MS_NMTM_GET_RNODES_con 0x000e /* confirmation */ +#define MS_NMTM_CONFIG_req 0x000f /* configuration */ +/* Definitions for CANopen relevant functions */ +#define MS_NMTM_ADD_REMOTE_COP_NODE_req 0x0010 /* add CANopen remote node */ +#define MS_NMTM_ADD_REMOTE_COP_NODE_con 0x0011 /* confirmation */ +#define MS_NMTM_ENTER_PRE_OPERATIONAL_STATE_req 0x0012 /* enter pre-operational state request */ +#define MS_NMTM_RESET_NODE_req 0x0013 /* reset node request */ +#define MS_NMTM_RESET_COMMUNICATION_req 0x0014 /* reset communication request */ +#define MS_NMTM_START_GUARD_REMOTE_NODE_req 0x0015 /* start CANopen remote node guarding request */ +#define MS_NMTM_ADD_REMOTE_COP_NODE_GID_req 0x0016 /* add CANopen remote node with guard ID */ + +#define MS_NMTM_CONF_DOWNLOAD_START_req 0x0017 /* start config. download request */ +#define MS_NMTM_CONF_DOWNLOAD_CONT_res 0x0018 /* continue config. download response */ +#define MS_NMTM_CONF_UPLOAD_START_req 0x0019 /* start config. upload request */ +#define MS_NMTM_CONF_ACKNOWLEDGE_res 0x001a /* config. data acknowledge (from host) */ +#define MS_NMTM_CONF_DOWNLOAD_CONT_ind 0x001b /* config. download continue indication */ +#define MS_NMTM_CONF_DOWNLOAD_SUC_con 0x001c /* config. download success confirmation */ +#define MS_NMTM_CONF_DOWNLOAD_FAIL_con 0x001d /* config. download failure confirmation */ +#define MS_NMTM_CONF_ABORT_TRANSFER_ind 0x001e /* config. transfer abort indication */ +#define MS_NMTM_CONF_ABORT_TRANSFER_req 0x001f /* config. transfer abort indication */ +#define MS_NMTM_CONF_VERIFY_req 0x0020 /* verify configuration transfer request */ +#define MS_NMTM_CONF_VERIFY_con 0x0021 /* verify configuration transfer confirmation */ + + +/* Message sub-specifiers with M_DBTM */ +#define MS_DBTM_CREATE_COB_DEF_req 0x0000 /* create COB definitions */ +#define MS_DBTM_DELETE_COB_DEF_req 0x0001 /* delete COB definitions */ +#define MS_DBTM_CREATE_PRE_DEF_req 0x0002 /* create predefinitons */ +#define MS_DBTM_DELETE_PRE_DEF_req 0x0003 /* delete predefinitons */ +#define MS_DBTM_ENABLE_DIST_req 0x0004 /* enable COB database */ +#define MS_DBTM_DISABLE_DIST_req 0x0005 /* disable COB database */ +#define MS_DBTM_GET_COB_DB_req 0x0006 /* get COB database */ +#define MS_DBTM_GET_COB_DB_con 0x0007 /* confirmation */ +#define MS_DBTM_CONFIG_req 0x0008 /* configuration */ + +/* COB database list element specifiers */ +#define CDB_STATE 1 /* ./. */ +#define CDB_COB_DEF 2 /* ./. */ +#define CDB_USR_DEF 3 /* ./. */ +#define CDB_PRE_DEF 4 /* ./. */ + + +/* Message sub-specifiers with M_CMS_DEF */ +#define MS_CMS_DEFINITION_req 0x0000 /* CMS Definition */ +#define MS_CMS_DEFINITION_con 0x0001 /* confirmation */ +#define MS_CMS_OBJECT_CONF_req 0x0002 /* CMS Object configuration */ +#define MS_CMS_SERVICE_CONF_req 0x0004 /* CMS service configuration */ +#define MS_CMS_OBJECT_CHG_ID_req 0x0005 /* CMS Object change ID (SDO) */ + + +/* Message sub-specifiers (mask: 0xff) with M_CMS_DATA */ +#define MS_CMS_UPDATE_VAR 0x0001 /* update variable */ +#define MS_CMS_WRITE_VAR_req 0x0002 /* write variable */ +#define MS_CMS_READ_VAR_req 0x0003 /* read variable */ +#define MS_CMS_NOTIFY_EVT_req 0x0004 /* notify event */ +#define MS_CMS_STORE_EVT_req 0x0005 /* store event */ +#define MS_CMS_STORE_I_EVT_req 0x0006 /* store event and notify */ +#define MS_CMS_READ_EVT_req 0x0007 /* read data from stored event */ +#define MS_CMS_DATA_ind 0x0009 /* data indication*/ + +#define MS_CMS_CONTROL_EVT_req 0x0008 /* set event state request */ +#define MS_CMS_CONTROL_EVT_ind 0x000a /* set event state indication */ +#define MS_CMS_CONTROL_EVT_res 0x000b /* set event state response */ +#define MS_CMS_CONTROL_EVT_con 0x000c /* set event state confirm. */ + +#define MS_CMS_WRITE_VAR_ind 0x000d /* write variable indication */ +#define MS_CMS_WRITE_VAR_res 0x000e /* write variable response */ +#define MS_CMS_WRITE_VAR_con 0x000f /* write variable confirmation */ + +#define MS_CMS_READ_VAR_ind 0x0010 /* read variable indication */ +#define MS_CMS_READ_VAR_res 0x0011 /* read variable response */ +#define MS_CMS_READ_VAR_con 0x0012 /* read variable confirmation */ + +#define MS_CMS_FAIL_ind 0x0013 /* failure indication */ + +#define MS_CMS_WRITE_MUX_VAR_req 0x0014 /* write a mux variable */ +#define MS_CMS_READ_MUX_VAR_req 0x0015 /* read a mux variable */ + + + + +/* Domain sub specifiers (mask: 0xff00) with M_CMS_DATA */ +#define MS_CMS_DOWNLOAD_START_req 0x0100 /* start domain download */ +#define MS_CMS_DOWNLOAD_CONT_res 0x0200 /* continue domain download */ +#define MS_CMS_UPLOAD_START_req 0x0300 /* start domain upload */ +#define MS_CMS_UPLOAD_res 0x0400 /* begin upload */ +#define MS_CMS_UPLOAD_CONT_res 0x0500 /* continue upload */ +#define MS_CMS_DOM_ABORT_req 0x0600 /* abort domain transfer */ + +#define MS_CMS_DOM_DOWNLOAD_CONT_ind 0x0700 /* domain continue indication */ +#define MS_CMS_DOM_SUCCESS_con 0x0800 /* domain success confirmation */ +#define MS_CMS_DOM_SUCCESS_ind 0x0900 /* domain success indication */ +#define MS_CMS_DOM_FAILURE_con 0x0a00 /* domain failure confirmation */ +#define MS_CMS_DOM_FAILURE_ind 0x0b00 /* domain failure indication */ +#define MS_CMS_DOM_DATA_ind 0x0c00 /* domain data indication*/ +#define MS_CMS_DOM_EXPDATA_ind 0x0d00 /* ./. */ +#define MS_CMS_DOM_DATA_CONT_ind 0x0e00 /* domain data cont. indication */ +#define MS_CMS_DOM_UPLOAD_ind 0x0f00 /* domain upload indication */ +#define MS_CMS_DOM_UPLOAD_CONT_ind 0x1000 /* domain upload cont. indication */ +#define MS_CMS_DOM_ACKNOWLEDGE_res 0x2000 /* domain acknowledge (from host) */ +#define MS_CMS_DOM_RCPT_ACKNOWLEDGE_res 0x2100 /* domain receipt acknowledge (from host) */ +#define MS_CMS_DOM_RESOLV_DELAY_ind 0x2000 /* internally used */ + +/* Failure codes (MS_CMS_FAIL_ind and MS_DOM_FAILURE) */ +#define TRANSMIT_FAIL 1 /* transmitt failure */ +#define DOM_PROT_ERR 2 /* domain protocol error */ +#define NO_BUFFER 3 /* no free buffer (memory problem) */ +#define ABORTED_BY_PEER 4 /* service aborted by peer object */ +#define DATA_SIZE_ERR 5 /* wrong data size */ +#define TIMED_OUT_ON_CON 6 /* timed out waiting for confirmation */ +#define PROTOCOL_ERROR 7 /* protocol error */ + +/* some strategy codes concerning the host-guarding-stuff */ +/* at failed guarding conditions */ +#define DISABLE_COB_DATABASE 0x01 +#define DISABLE_NODE_GUARDING 0x02 +#define DISCONNECT_REMOTE_NODES 0x04 + +#ifdef __cplusplus +} +#endif + +#endif /* !mcal_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/mican.h =================================================================== --- trunk/MagicSoft/Cosy/incl/mican.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/mican.h (revision 731) @@ -0,0 +1,101 @@ +/*----------------------------------------------------------------------------- +mican.h -- ICANOS Message Specifications + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.17 of 99/12/07 + +Definitions of message specifiers for messages to/from ICANOS/2. + +-----------------------------------------------------------------------------*/ + +#ifndef mican_DEFINED +#define mican_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +/* Message specifiers */ +#define M_TIMER_START_req 0x20 /* start timer request */ +#define M_TIMER_STOP_req 0x21 /* stop timer request */ +#define M_TIMER_SET_req 0x22 /* set timer request */ +#define M_TIMER_SET_con 0x23 /* confirm setting of timer */ +#define M_TIMER_TO_ind 0x24 /* indicate timeout event */ +#define M_TIMER_CLEAR_req 0x25 /* clear timer request */ +#define M_BCAN_TX_req 0x30 /* transmit request */ +#define M_BCAN_TXC_req 0x31 /* transmit request with pos.conf. */ +#define M_BCAN_TXE_req 0x32 /* transmit request with echo */ +#define M_BCAN_TXCE_req 0x33 /* transmit request w.con(+), echo */ +#define M_BCAN_TXAT_req 0x34 /* abort transmission request */ +#define M_BCAN_TX_con 0x35 /* confirm (+/-) transmission */ +#define M_BCAN_RX_ind 0x36 /* receive indication */ +#define M_BCAN_EVENT_ind 0x37 /* BCAN event (error, overrun) */ +#define M_BCAN_SET_ACM_req 0x40 /* set acceptance code and mask */ +#define M_BCAN_SET_BTR_req 0x41 /* set bus timing parameters */ +#define M_BCAN_BUSOFF_req 0x42 /* switch to bus-off state */ +#define M_BCAN_BUSON_req 0x43 /* switch to bus-on state */ +#define M_BCAN_SETREG_req 0x44 /* set BCAN registers request */ +#define M_BCAN_GETREG_req 0x45 /* get BCAN registers request */ +#define M_BCAN_GETREG_con 0x46 /* get BCAN registers confirmation */ +#define M_BCAN_CONF_req 0x47 /* Special CANbus configurations */ +#define M_AFIL_OPEN_req 0x50 /* accept CAN-Id */ +#define M_AFIL_ROPEN_req 0x51 /* accept CAN-Id range */ +#define M_AFIL_CLOSE_req 0x52 /* reject CAN-Id */ +#define M_AFIL_RCLOSE_req 0x53 /* reject CAN-Id range */ +#define M_CYC_LIST_CREATE_req 0x60 /* request to create a list of cyclic CANbus messages */ +#define M_CYC_LIST_CREATE_con 0x61 /* confirmation of creation of cyclic-send-list */ +#define M_CYC_LIST_DELETE_req 0x62 /* request to delete a list of cyclic CANbus messages */ +#define M_CYC_LIST_DELETE_con 0x63 /* confirmation of deletion of cyclic-send-list */ +#define M_CYC_MSG_INSERT_req 0x64 /* request to insert a message in cyclic send list */ +#define M_CYC_MSG_INSERT_con 0x65 /* confirmation of insertion of a message into list */ +#define M_BCAN_BULK_ind 0x66 /* bulk buffer-message indication */ +#define M_BCAN_SNIFF_ind 0x68 /* sniff buffer-message indication */ + +#define M_BCAN_BUSLOAD_ind 0x67 /* busload-statistic-indication */ +#define MS_BCAN_BUSLOAD_ALL 0x00 /* request/indicate ALL busload-statistics */ + +#define M_SNIFFFIL_MASK_req 0x69 /* sniff buff. set-acceptance filter request */ + +/* Check type of transmit request (with/without echo and/or pos. confirm. + Note the consistency with the definitions of M_BCAN_TX*_req! */ +#define TX_REQ_CONF 0x01 /* positive confirmation desired if set */ +#define TX_REQ_ECHO 0x02 /* echo desired if set */ +#define tx_req_conf(spec) ((unsigned)(spec) & TX_REQ_CONF) +#define tx_req_echo(spec) ((unsigned)(spec) & TX_REQ_ECHO) + +/* Message subspecifiers for M_BCAN_TX_con messages */ +#define TX_OKAY 0x00 /* positive transmit confirmation */ +#define TX_NOBUF 0x01 /* controller transmit buffer full */ +#define TX_FAIL 0x02 /* negative transmit confirmation */ + +/* Message subspecifiers for M_BCAN_EVENT_ind messages */ +#if defined Customer_1 +#define C1_EVT_ERROR 0x01 /* error interrupt occured */ +#else +#define EVT_ERROR 0x01 /* error interrupt occured */ +#endif +#define EVT_OVERRUN 0x02 /* overrun interrupt occured */ +#define EVT_LOST_INTERRUPTS 0x04 /* interrupts lost */ +#define EVT_QUEUE_FULL 0x08 /* send queue full */ +#define EVT_BERR 0x10 /* CANbus bus-error */ + +/* Additional error types for M_BCAN_EVENT. */ +#define EVT_ERRT_NONE 0x00 /* no additional error infos */ +#define EVT_ERRT_82C200 0x01 /* 82C200 additional error infos */ +#define EVT_ERRT_SJA1000 0x02 /* SJA100 additional error infos */ + +/* Additional command subspecs for M_BCAN_CONF_req */ +#define MS_BCAN_CONF_BERR 0x00 /* Configure bus-error detection */ +#define MS_BCAN_CONF_EWL 0x01 /* Configure error warning limit */ +#define MS_BCAN_CONF_LOM 0x02 /* Configure listen only mode */ +#define MS_BCAN_CONF_STM 0x03 /* Configure self test mode */ + + +#ifdef __cplusplus +} +#endif + +#endif /* !mican_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/mitop.h =================================================================== --- trunk/MagicSoft/Cosy/incl/mitop.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/mitop.h (revision 731) @@ -0,0 +1,918 @@ +/*----------------------------------------------------------------------------- +mitop.h -- Top side (Host) of messaging interface to VMOD-ICAN + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 95/06/16 by Soenke Hansen +Version 1.40 of 00/03/29 + +Functions to fill messages which can be sent to VMOD-ICAN. +Functions to format the contents of messages for printing. + +The relevance of messages depends on the firmware on VMOD-ICAN. +The firmware discards messages which it does not understand. +Through preprocessor directives the set of messaging interface +functions are adapted to the firmware. + +This file contains prototype declarations for functions in mitop.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef mitop_DEFINED +#define mitop_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "dpm.h" + +/* Classes of messages. */ +#define MITOP_MGR 0x0001 /* module management */ +#define MITOP_ICANOS 0x0002 /* raw CAN access, SW CAN filtering, timers */ +#define MITOP_CAL 0x0004 /* CAL */ + +#define MITOP (MITOP_CAL + MITOP_MGR + MITOP_ICANOS) +/* Adapt the mesaging interface to the firmware capabilities. + The default is ICANOS and VMOD-ICAN management. */ +#ifndef MITOP +#define MITOP (MITOP_MGR + MITOP_ICANOS) +#endif + +/* Formatting functions are implemented if and only if + MITOP_FORMAT is defined. */ +#define MITOP_FORMAT + + +#if MITOP & MITOP_MGR + +/* Request identity and version from module */ +extern void IdVersReq(Message *); +extern void IdVersSniffReq(Message *); + +/* Request free memory size */ +extern void CheckFreeMem(Message *, int); + +/* Request host interface style */ +extern void InquiryHostInterface(Message *); + +/* Request CANbus bit rate, HW acceptance code/mask and termination state */ +extern void InquiryCANBitRateMasksTerm(Message *); + +/* Request CAN controllers / modules status */ +extern void InquiryStatus(Message *); +extern void InquiryStatusSniff(Message *); +extern void InquiryControllerStatusSniff(Message *m); + +/* Request setting of software acceptance filter */ +extern void InquiryAcceptanceFilter(Message *, WORD_t); + +#if MITOP & MITOP_CAL + +/* Install CAL master on module. By default the module implements + only CAL slave functionality. */ +extern void InstallCalMaster(Message *); + +/* Some host-guarding stuff */ +void InitHostGuarding(Message *, int, BYTE_t); +void HostIsAlive(Message *); + +#endif + + +void SwitchCanTermination(Message *, WORD_t); +void SwitchSYSClkTermination(Message *, WORD_t); + +#endif + +#if MITOP & MITOP_ICANOS + +/* format sja1000 error-code-capture to readable form. */ +int sprintf_sja1000_ec( + char *dest, /* destination for description */ + int ec, /* error code to format */ + int n ); /* max length of description */ + +/* Start periodical clock interrupt generation. */ +extern void IcStartTimer( + Message *, /* message buffer */ + WORD_t ); /* max. clock period in 100 usec units */ + +/* Stop periodical clock interrupt generation. */ +extern void IcStopTimer( + Message *); /* message buffer */ + +/* Unset a user-defined timer. */ +extern void IcClearTimer( + Message *, /* message buffer */ + WORD_t ); /* timer Id as confirmed on set timer req. */ + +/* Set a timer. The alarm time "tleft" is in units of 100 usecs. */ +extern void IcSetTimer( + Message *, /* message buffer */ + WORD_t , /* user request Id */ + WORD_t ); /* time left until alarm */ + +/* Issue request to send a CAN message. */ +extern void IcSendReqBCAN( + Message *, /* message buffer */ + int , /* pos. confirm. or echo required? */ + WORD_t , /* application request Id */ + WORD_t , /* CAN descriptor (id,rtr,dlc) */ + const BYTE_t *); /* data bytes to transmit */ + +/* Abort transmit request. */ +extern void IcSendAbortBCAN( + Message *); /* message buffer */ + +/* Switch CAN controller bus-on. */ +extern void IcBusOnBCAN( + Message *); /* message buffer */ + +/* Switch CAN controller bus-off. */ +extern void IcBusOffBCAN( + Message *); /* message buffer */ + +/* Set bit timing parameters in CAN controller. */ +extern void IcWriteBtrBCAN( + Message *, /* message buffer */ + WORD_t ); /* BTR0 and BTR1 */ + +/* Set error-warining limit in CAN controller. */ +void IcWriteEwlBCAN( + Message *m, /* message buffer */ + BYTE_t ewl ); /* Error warning limit to set */ + +/* Enable bus-error reporting. */ +void IcSwitchBerrBCAN( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Configure self test mode */ +void IcSwitchStmBCAN( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Configure listen-only mode */ +void IcSwitchLomBCAN( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Set hardware acceptance filter in CAN controller. */ +extern void IcWriteAcmBCAN( + Message *, /* message buffer */ + WORD_t ); /* acceptance code and mask */ + +/* Set extended hardware acceptance filter in CAN controller. */ +void IcWriteExtAcmBCAN( + Message *m, /* message buffer */ + int mode, /* 0: dual-, 1: single-filter-mode */ + LWORD_t ac, /* acceptance code */ + LWORD_t am ); /* acceptance mask */ + +/* Change software acceptance filter: accept all CAN messages + with given Id. */ +extern void IcOpenAfil( + Message *, /* message buffer */ + WORD_t ); /* this Id passes the filter */ + +/* Change software acceptance filter: reject all CAN messages + with given Id. */ +extern void IcCloseAfil( + Message *, /* message buffer */ + WORD_t ); /* messages with this Id are rejected */ + +/* Change software acceptance filter: accept all CAN messages + with IDs in specified range. */ +extern void IcRangeOpenAfil( + Message *, /* message buffer */ + WORD_t , /* lower bound of Id range */ + WORD_t ); /* upper bound of Id range */ + +/* Change software acceptance filter: reject all CAN messages + with IDs in specified range. */ +extern void IcRangeCloseAfil( + Message *, /* message buffer */ + WORD_t , /* lower bound of Id range */ + WORD_t ); /* upper bound of Id range */ + +/* Set software acceptance filter mask. */ +void IcSetAfil( + Message *m, /* message buffer */ + WORD_t id, /* this Ids filter is set ... */ + WORD_t mask /* ... to this value. */ +); + +/* Set software acceptance filter mask for a range of Ids. */ +void IcRangeSetAfil( + Message *m, /* message buffer */ + WORD_t idl, /* this Ids filter is set ... */ + WORD_t idh, /* this Ids filter is set ... */ + WORD_t mask /* ... to this value. */ +); + +void IcCreateCycSendList( + Message *m, /* message buffer */ + WORD_t cyctim /* cycle-time to send data */ +); + +void IcDeleteCycSendList( + Message *m, /* message buffer */ + BYTE_t listNo /* number of list to delete */ +); + +void IcAddMsgToCycSendList( + Message *m, /* message buffer */ + BYTE_t listId, /* list number where the message should */ + /* be added to */ + WORD_t id, /* CANbus id */ + BYTE_t len, /* CANbus message length */ + BYTE_t rtr, /* rtr bit [0,1] */ + BYTE_t *data /* pointer to data */ +); + +/* Set priority boundaries. */ +void IcSetPrioBnd( + Message *m, /* message buffer */ + WORD_t hi_mid_boundary, /* boundary between hi and mid prior. */ + WORD_t mid_low_boundary /* boundary between mid and low prior.*/ +); + + +/* Set host endianess. */ +void SetHostEndianess( + Message *m, /* message buffer */ + BYTE_t endianess /* endianess */ +); + +/* Init bulk buffer with timeout only */ +void InitBulkBufferTimeout( + Message *m, /* message buffer */ + WORD_t timeout /* time after bulk buffer message will be sent */ +); + +/* Init bulk buffer with timeout and sizes */ +void InitBulkBuffer( + Message *m, /* message buffer */ + WORD_t timeout, /* time after bulk buffer message will be sent */ + BYTE_t maxMsgInBulkMsg, /* max. number of bulk msgs. in one bulk message */ + BYTE_t maxBulkMsgPreAlloc /* max. number of preallocated bulk messages */ +); + +/* Init sniff buffer */ +void InitSniffBufferTimeout( + Message *m, /* message buffer */ + WORD_t timeout /* time after sniff buffer message will be sent */ +); +void InitSniffBuffer( + Message *m, /* message buffer */ + WORD_t timeout, /* time after bulk buffer message will be sent */ + BYTE_t maxByteInSniffMsg, /* max. number of msg.-bytes in one sniff message */ + BYTE_t maxSniffMsgPreAlloc /* max. number of preallocated sniff messages */ +); + +/* Config sniff buffer */ +void ConfigSniffBufferEcho( + Message *m, /* message buffer */ + WORD_t echoFromQueue /* specifies the queues, a sent message should be echoed from */ +); + +void ConfigSniffBufferAfilStd( + Message *m, /* message buffer */ + WORD_t idl, /* lower bound of Id range */ + WORD_t idh, /* upper bound of Id range */ + BYTE_t mask /* filter mask to use ([0..1] */ +); + +void ConfigSniffBufferAfilXtd( + Message *m, /* message buffer */ + WORD_t idl, /* lower bound of Id range (13 MSB!) */ + WORD_t idh, /* upper bound of Id range (13 MSB!) */ + BYTE_t mask /* filter mask to use ([0..1] */ +); + +void InitBusLoadStatistic( + Message *m, /* message buffer */ + WORD_t intTime, /* integration time (in times of 10 ms) */ + BYTE_t flags /* some flags */ +); + +void InitSniffBusLoadStatistic( + Message *m, /* message buffer */ + WORD_t intTime, /* integration time (in times of 10 ms) */ + BYTE_t flags /* some flags */ +); + +void RequestBusLoadStatistic( + Message *m, /* message buffer */ + BYTE_t choice /* choose the kind of statistics */ +); + +#endif /* MITOP & MITOP_ICANOS */ + + +#if MITOP & MITOP_CAL + +/* Create Node request */ +extern void NsCreateNodeReq( + Message *, /* message buffer */ + int, /* module Id */ + const char *, /* module name string (strlen==7) */ + int); /* CAL node class */ + +/* Create Node request */ +extern void NsCreateCOPNodeReq( + Message *, /* message buffer */ + int, /* module Id */ + const char *, /* module name string (strlen==7) */ + int); /* CAL node class */ + +/* Config NMT of CANopen slave node request */ +extern void NsConfigCOPNodeReq( + Message *m, /* message buffer */ + WORD_t guard_time, /* guard time in ms */ + int life_fac, /* life time factor */ + int guard_start); /* timepoint of guarding start */ + +/* Config CAL NMT slave node request */ +extern void NsConfigNodeReq( + Message *m, /* message buffer */ + WORD_t mux, /* multiplexor */ + WORD_t flags); /* flags */ + +/* Configuration download acknowledge response */ +extern void NsConfigAck( + Message *m); /* message buffer */ + +/* NMT slave configuration transfer abort request */ +extern void NsConfigAbort( + Message *m, /* message buffer */ + int failureReason, /* failure reason */ + int applSpecificReason); /* appl. specific failure reason */ + +/* NMT slave configuration transfer verify response */ +extern void NsConfigVerify( + Message *m, /* message buffer */ + int verificationResult, /* result of verification */ + int reason); /* failure reason */ + +/* Delete Node request */ +extern void NsDeleteNodeReq( + Message *); /* message buffer */ + +/* Identify Node request */ +extern void NsIdentifyNodeReq( + Message *); /* message buffer */ + +/* Connect Node request */ +extern void NsConnectNodeReq( + Message *, /* message buffer */ + int , /* download requested? */ + WORD_t , /* guard time in ms */ + int ); /* life time factor */ + +/* Disconnect Node request */ +extern void NsDisconnectNodeReq( + Message *); /* message buffer */ + +/* Prepare Remote Node Response */ +extern void NsPrepareRemoteNodeRes( + Message *, /* message buffer */ + int ); /* 0 or error code of CAL protocol */ + +/* Delete User Definition request */ +extern void DsDeleteUserDefReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Create all User Definitions request: + Initiate the Create User Definition service for the COB's + used by by the currently defined CMS objects. */ +extern void DsCreateAllUserDefReq( + Message *); /* message buffer */ + +/* Get Checksum request */ +extern void DsGetChecksumReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Delete User Definition request */ +extern void DsVerifyCobClassReq( + Message *); /* message buffer */ + +/* Set Bit Timing and Attach CAN controller to CAN bus */ +extern void LsBusOnReq( + Message *, /* message buffer */ + WORD_t ); /* Bit timing parameters */ + +/* Detach CAN controller from CAN bus */ +extern void LsBusOffReq( + Message *); /* message buffer */ + +/* Control bus error generation */ +void LsSwitchBerrReq( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Set Error warning limit threshold */ +void LsSetEwlReq( + Message *m, /* message buffer */ + BYTE_t ewl ); /* Error warning limit to set */ + +/* Control self-test mode */ +void LsSwitchStmReq( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Control listen-only mode */ +void LsSwitchLomReq( + Message *m, /* message buffer */ + BYTE_t state ); /* 0: disabled, 1: enabled */ + +/* Add Remote Node request */ +extern void NmAddRemoteNodeReq( + Message *, /* message buffer */ + int, /* module Id */ + const char *); /* module name string (strlen==7) */ + +/* Add Remote CANopen Node request */ +extern void NmAddRemoteCOPNodeReq( + Message *, /* message buffer */ + int, /* module Id */ + const char *, /* module name string (strlen==7) */ + WORD_t, /* default guard time */ + int ); /* default node class */ + +/* Add Remote CANopen Node request with user given guarding IDs */ +extern void NmAddRemoteCOPNodeGidReq( + Message *, /* message buffer */ + int, /* module Id */ + const char *, /* module name string (strlen==7) */ + WORD_t, /* default guard time */ + int, /* default node class */ + WORD_t); /* user given guarding ID */ + +/* Remove Remote Node request */ +extern void NmRemoveRemoteNodeReq( + Message *, /* message buffer */ + int , /* module Id */ + const char *); /* module name string (strlen==7) */ + +/* Connect Remote Node request */ +extern void NmConnectRemoteNodeReq( + Message *, /* message buffer */ + int , /* module Id */ + const char *); /* module name string (strlen==7) */ + +/* Prepare Remote Node request */ +extern void NmPrepareRemoteNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Start Remote Node request */ +extern void NmStartRemoteNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Stop Remote Node request */ +extern void NmStopRemoteNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Disconnect Remote Node request */ +extern void NmDisconnectRemoteNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Enter preoperational state request */ +extern void NmEnterPreOperationalStateReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Reset node request */ +extern void NmResetNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +void NmStartGuardRemoteCOPNodeReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Reset communication request */ +extern void NmResetCommunicationReq( + Message *, /* message buffer */ + int ); /* node Id */ + +/* Identify Remote Nodes request */ +extern void NmIdentifyRemoteNodesReq( + Message *, /* message buffer */ + int , /* min. node Id in range */ + int ); /* max. node Id in range */ + +/* Get NMT Remote Nodes request */ +extern void NmGetRemNodes( + Message *, /* message buffer */ + int ); /* node Id (0 to get all) */ + +/* Configure NMT master behaviour */ +extern void NmConfig( + Message *m, /* message buffer */ + WORD_t timeout, /* service timeout (in milliseconds) */ + WORD_t gt, /* guard time (in milliseconds) */ + int lf, /* life time factor */ + WORD_t flags /* configuration flags */ +); + + +/* Start Nmt configuration download request */ +extern void NmConfigDownloadStartReq( + Message *m, /* message buffer */ + int nid, /* node ID of slave node to dwonload to */ + int size, /* size of whole configuration data chunk */ + int dblk, /* size of configuration data in this message */ + int more, /* set to one if other datablocks will follow */ + const void *data /* data block */ +); + +/* Start subsequesnt Nmt configuration download continue response */ +extern void NmConfigDownloadContRes( + Message *m, /* message buffer */ + int nid, /* node ID of slave node to dwonload to */ + int dblk, /* size of configuration data in this message */ + int more, /* set to one if other datablocks will follow */ + const void *data /* data block */ +); + +/* NMT master configuration transfer abort request */ +extern void NmConfigAbort( + Message *m, /* message buffer */ + int nid, /* node id of peer node */ + int failureReason, /* failure reason */ + int applSpecificReason); /* appl. specific failure reason */ + +extern void NmConfigVerify( + Message *m, /* message buffer */ + int nid, /* remote node of interest */ + int checksum); /* checksum */ + +/* Create COB Definition request */ +extern void DmCreateCobDefReq( + Message *, /* message buffer */ + WORD_t , /* low COB-ID */ + WORD_t , /* high COB-ID */ + int ); /* min. inhibit time */ + +/* Delete COB Definition request */ +extern void DmDeleteCobDefReq( + Message *, /* message buffer */ + WORD_t , /* low COB-ID */ + WORD_t ); /* high COB-ID */ + +/* Create Predefinition request */ +extern void DmCreatePreDefReq( + Message *, /* message buffer */ + WORD_t, /* COB-ID */ + const char *); /* COB-Name string (strlen==14) */ + +/* Delete Predefinition request */ +extern void DmDeletePreDefReq( + Message *, /* message buffer */ + const char *); /* COB-Name string (strlen==14) */ + +/* Get COB Database request */ +extern void DmGetCobDbReq( + Message *); /* message buffer */ + +void DmConfig( + Message *m, /* message buffer */ + WORD_t timeout, /* service timeout (in milliseconds) */ + WORD_t flags /* configuration flags */ +); + +void CmsPatchHostId( + Message *m, /* message buffer */ + WORD_t hid /* ID to be assigned to object */ +); + +/* Define a Domain */ +extern void CmsDomain( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* muxlen ? ? */ + int /* priority */ +); + +/* Define a multipexed Domain */ +extern void CmsMultiplexedDomain( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* muxlen ? ? */ + int /* priority */ +); + +/* Define a multipexed Domain for CANopen SDO */ +extern void CmsMultiplexedDomainSDO( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* muxlen ? ? */ + int , /* priority */ + WORD_t, /* Tx_SDO_ID as seen by node */ + WORD_t, /* Rx_SDO ID as seen by node */ + BYTE_t /* dbt_cap - DBT capibility of CANopen node */ +); + +/* Change a multipexed Domain's ID for CANopen SDO */ +extern void CmsMultiplexedDomainChangeIdSDO( + Message *, /* message buffer */ + WORD_t , /* object id */ + WORD_t, /* Tx_SDO_ID as seen by node */ + WORD_t /* Rx_SDO ID as seen by node */ +); + +/* Define a Basic Variable */ +extern void CmsBasicVariable( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + WORD_t , /* CMS_READ_ONLY,... (see: cms.h) */ + int , /* length of data type */ + int ); /* priority */ + +/* Define a Basic Variable with predefined CobId */ +extern void CmsBasicVariablePredefCobId( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + WORD_t , /* CMS_READ_ONLY,... (see: cms.h) */ + int , /* length of data type */ + int , /* priority */ + WORD_t , + WORD_t , + BYTE_t ); + +/* Define a Multiplexed Variable */ +extern void CmsMultiplexedVariable( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + WORD_t , /* CMS_READ_ONLY,... (see: cms.h) */ + int , /* length of data type */ + int ); /* priority */ + +/* Define an Uncontrolled Event */ +extern void CmsUncontrolledEvent( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* length of data type */ + int ); /* priority */ + +/* Define a Controlled Event */ +extern void CmsControlledEvent( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* length of data type */ + int ); /* priority */ + +/* Define a Stored Event */ +extern void CmsStoredEvent( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* length of data type */ + int ); /* priority */ + +/* Define a Stored Event with predefined CobId */ +extern void CmsStoredEventPredefCobId( + Message *, /* message buffer */ + const char *, /* CMS name string (strlen==13) */ + WORD_t , /* CMS_CLIENT, CMS_SERVER (see: cms.h) */ + int , /* length of data type */ + int , /* priority */ + WORD_t , + WORD_t , + BYTE_t ); + +void ConfigDomainObject( + Message *m, /* message buffer */ + WORD_t cid, /* object id */ + WORD_t mux, /* multiplexor */ + WORD_t flags /* parameter flags */ +); + +void ConfigCmsObject( + Message *m, /* message buffer */ + WORD_t cid, /* object id */ + WORD_t mux, /* multiplexor */ + WORD_t param /* parameter */ +); + +void CmsConfig( + Message *m, /* message buffer */ + WORD_t flags /* parameter flags */ +); + +/* Update Variable in server of a Read-Only Variable */ +extern void CmsUpdateVariable( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* length of data type */ + const BYTE_t *); /* value matching data type */ + +/* Write Variable request by client of a Basic Variable */ +extern void CmsWriteVariable( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* length of data type */ + const BYTE_t *); /* value matching data type */ + +/* Read Variable request by client of a Basic Variable */ +extern void CmsReadVariable( + Message *, /* message buffer */ + WORD_t ); /* Id of CMS Variable */ + +/* Write Multiplexed Variable request by client of a Basic Variable */ +extern void CmsWriteMultiplexedVariable( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* length of data type */ + int , /* multiplexor */ + const BYTE_t *); /* value matching data type */ + +/* Read Mulitplexed Variable request by client of a Basic Variable */ +extern void CmsReadMultiplexedVariable( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int ); /* multiplexor */ + +void CmsWriteVariableRes( + Message *m, /* message buffer */ + WORD_t cid, /* Id of CMS Variable */ + int dlen, /* length of data type */ + int stat, /* operation status */ + const BYTE_t *value /* value matching data type */ +); + +void CmsReadVariableRes( + Message *m, /* message buffer */ + WORD_t cid, /* Id of CMS Variable */ + int dlen, /* length of data type */ + int stat, /* operation status */ + const BYTE_t *value /* value matching data type */ +); + + +/* Notify Event to clients */ +extern void CmsNotifyEvent( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* length of data type */ + const BYTE_t *); /* value matching data type */ + +/* Store and Notify Eventy to clients */ +extern void CmsStoreEvent( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* length of data type */ + const BYTE_t *, /* value matching data type */ + int ); /* !=0 for immediate notification */ + +/* Read Event */ +extern void CmsReadEvent( + Message *, /* message buffer */ + WORD_t ); /* Id of CMS Variable */ + +/* Set Event Control State Request */ +extern void CmsSetControlEventReq( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int ); /* !=0 to enable event in server */ + +/* Set Event Control State Response */ +extern void CmsSetControlEventRes( + Message *, /* message buffer */ + WORD_t , /* Id of CMS Variable */ + int , /* !=0 to indicate error */ + int , /* !=0 to enable event in server */ + const BYTE_t * /* reason in case of error */ +); + + +extern void CmsDomDownloadStart( + Message *, + WORD_t , /* Id of CMS Domain */ + int , /* option flags */ + int , /* domain multiplexor */ + int , /* whole data length */ + int , /* data length of current message */ + const void * /* data block */ +); + +extern void CmsDomDownloadCont( + Message *, + WORD_t , /* Id of CMS Domain */ + int , /* option flags */ + int , /* data length of current message */ + const void * /* data block */ +); + +extern void CmsDomUploadStart( + Message *m, + WORD_t cid, /* Id of CMS Domain */ + int mux /* Multiplexor type */ +); + +void CmsDomUpload( + Message *m, + WORD_t cid, /* Id of CMS Domain */ + int cs, /* option flags */ + int size, /* whole data length */ + int dblk, /* data length of current message */ + const void *data /* data block */ +); + +void CmsDomUploadCont( + Message *m, + WORD_t cid, /* Id of CMS Domain */ + int cs, /* option flags */ + int dblk, /* data length of current message */ + const void *data /* data block */ +); + +void CmsDomainAck( + Message *m, + WORD_t cid +); + +void CmsDomainRcptAck( + Message *m, + WORD_t cid +); + +void CmsDomAbort( + Message *m, + WORD_t cid, /* Id of CMS Domain */ + const void *data /* data block pointer or zero */ +); + +#endif /* MITOP & MITOP_CAL */ + +#ifdef MITOP_FORMAT + +/* Format the contents of messages for display. */ +#if MITOP & MITOP_MGR +extern void format_modulmgr(char *, int, const Message *); +#endif /* MITOP & MITOP_MGR */ +#if MITOP & MITOP_ICANOS +extern void format_icanos(char *, int, const Message *); +#endif /* MITOP & MITOP_ICANOS */ +#if MITOP & MITOP_CAL +extern void format_nmts(char *, int, const Message *); +extern void format_dbts(char *, int, const Message *); +extern void format_lmts(char *, int, const Message *); +extern void format_nmtm(char *, int, const Message *); +extern void format_dbtm(char *, int, const Message *); +extern void format_cmsdef(char *, int, const Message *); +extern void format_cmsdata(char *, int, const Message *); + +/* Formatted output */ +extern void printf_cob_db(FILE *, int, const BYTE_t *); +extern void printf_nmtm(FILE *, int, const BYTE_t *); +#endif /* MITOP & MITOP_CAL */ + +#endif /* MITOP_FORMAT */ + + +void Cust1Init(Message *, int); +void Cust1StartTimestampPeriod(Message *, WORD_t); + +void COPStartPeriodical(Message *, BYTE_t, WORD_t); +void COPStartSingleShot(Message *, BYTE_t); +void COPMapHiResTimestamp(Message *, WORD_t); + +/* + * CANopen process picture interface + */ +extern void COPDeleteAllPDOMappingEntries(Message *, WORD_t); +extern void COPAddPDOMappingEntry(Message *, WORD_t, WORD_t, BYTE_t, BYTE_t, LWORD_t); +extern void COPAddPDOLength(Message *, WORD_t, BYTE_t); +extern void COPAddPDOTransmType(Message *, WORD_t, BYTE_t); +extern void COPAddPDOInhibTime(Message *, WORD_t, WORD_t); +extern void COPControlPDO(Message *, WORD_t, BYTE_t); +extern void COPAdjustCobIdPDO(Message *, WORD_t, LWORD_t); +extern void COPSetSyncToHostSending(Message *, BYTE_t); +extern void COPTriggerTPDO(Message *, WORD_t); +extern void COPTriggerRPDO(Message *, WORD_t); + +#ifdef __cplusplus +} +#endif + +#endif /* mitop_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/msg.h =================================================================== --- trunk/MagicSoft/Cosy/incl/msg.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/msg.h (revision 731) @@ -0,0 +1,194 @@ +/*----------------------------------------------------------------------------- +msg.h -- Messages and message queues + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.7 of 99/12/07 + +Messages consist of a specifier for its contents, the (address of its) +contents, and the relevant length of the contents. Messages are +allocated from the heap with the maximum length of the contents specified. +The relevant length is useful when transmitting the message outside +the local address space. +Messages can be linked to form message queues or lists. + +-----------------------------------------------------------------------------*/ + +#ifndef msg_DEFINED +#define msg_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" + +/* Mode or format type of a message */ +#define MMODE_LOCAL 0x01 /* internal compiler specific format */ +#define MMODE_TRANSFER 0x02 /* external format for transfer */ + +/* Maximum length definitions */ +#define BCAN_LEN 8 /* max data length in CAN message */ +#define MB_LEN 16 /* max data length in bounded sized message */ + +/* Message contents types */ +struct m_m1 { /* multiple purpose message (local format) */ + WORD_t w[6]; +}; +struct m_m2 { /* for BCAN messages (local format) */ + WORD_t r; /* request id */ + WORD_t d; /* descriptor */ + BYTE_t b[BCAN_LEN]; /* data bytes */ +}; +struct m_m3 { /* generic transfer data buffer */ + BYTE_t len; /* length, number of relevant bytes */ + BYTE_t gap; /* just to align component b[] */ + BYTE_t b[MB_LEN]; /* bounded buffer */ + BYTE_t *pb; /* allocated buffer if len > MB_LEN */ +}; + +struct m_m4 { /* transfer data buffer for bulk purposes */ + BYTE_t len; /* length, number of relevant bytes */ + BYTE_t gap1; /* just to align component b[] */ + + BYTE_t available; + BYTE_t gap2; /* align */ + WORD_t actByteCount; /* actual usage of bulk buffer */ + LWORD_t actTime; /* last write time of this bulk buffer */ + BYTE_t *pActData; /* pointer to actual write-data location */ + + BYTE_t gap3[4]; /* gap */ + BYTE_t *pb; /* allocated buffer */ +}; + +/* Message object definition */ +struct message { + BYTE_t spec; /* message contents specifier */ + BYTE_t mode; /* mode (message format type) */ + union { /* message contents */ + WORD_t align; + /* mode == MMODE_LOCAL */ + struct m_m1 m1; + struct m_m2 m2; + /* mode == MMODE_TRANSFER */ + struct m_m3 m3; + /* mode == MMODE_TRANSFER for bulk/sniff buffer */ + struct m_m4 m4; + } u; + struct message *next; /* next on list/queue */ +}; + +#define NIL_MESSAGE (struct message *)0 + +/* Message components for mode==MMODE_TRANSFER */ +#define mlen u.m3.len /* usage: m->mlen (if: struct message *m) */ +#define fdata u.m3.b /* pointer to fixed length data buffer */ +#define vdata u.m3.pb /* pointer to variable length data buffer */ +/* Pointer to beginning of data buffer */ +#define m_data(m) (((m)->mlen > MB_LEN) ? (m)->vdata : (m)->fdata) + +/* definitions for bulk buffer transfer */ +/* (always MMODE_TRANSFER, always variable length data buffer) */ +#define mBulkAvailable u.m4.available /* usage: m->mBulkAvailable */ +#define mBulkActByteCount u.m4.actByteCount /* usage: m->mBulkActByteCount */ +#define mBulkActTim u.m4.actTime /* usage: m->mBulkActTime */ +#define mBulkDataAddr u.m4.pActData /* usage: m->mBulkDataAddr */ + +/* definitions for sniff buffer transfer */ +/* (always MMODE_TRANSFER, always variable length data buffer) */ +#define mSniffAvailable u.m4.available /* usage: m->mSniffAvailable */ +#define mSniffActByteCount u.m4.actByteCount /* usage: m->mSniffActByteCount */ +#define mSniffActTim u.m4.actTime /* usage: m->mSniffActTime */ +#define mSniffDataAddr u.m4.pActData /* usage: m->mSniffDataAddr */ + +/* Components of a timer message (struct m_m1) */ +#define timer_period u.m1.w[0] +#define timer_req u.m1.w[0] +#define timer_tid u.m1.w[1] +#define timer_tleft u.m1.w[2] + +/* Components of a filter message (struct m_m1) */ +#define afil_id u.m1.w[0] +#define afil_idlow u.m1.w[0] +#define afil_idhigh u.m1.w[1] + +/* Components of contents of struct m_m1 message */ +#define bcan_reset u.m1.w[0] /* !=0 if reset for M_BCAN_SET*req */ +#define bcan_acm u.m1.w[1] /* M_BCAN_SET_ACM_req */ +#define bcan_btr u.m1.w[1] /* M_BCAN_SET_BTR_req */ +#define bcan_evt u.m1.w[0] /* M_BCAN_EVENT_ind */ +#define bcan_evt_e0 u.m1.w[1] /* M_BCAN_EVENT_ind extended error */ +#define bcan_evt_e1 u.m1.w[2] /* M_BCAN_EVENT_ind extended error*/ +#define bcan_evt_e2 u.m1.w[3] /* M_BCAN_EVENT_ind extended error*/ +#define bcan_evt_e3 u.m1.w[4] /* M_BCAN_EVENT_ind extended error*/ +#define bcan_txreq u.m1.w[0] /* M_BCAN_TX_con */ +#define bcan_txcon u.m1.w[1] /* M_BCAN_TX_con */ + +/* Components of a BCAN message (struct m_m2) */ +#define bcan_req u.m2.r +#define bcan_desc u.m2.d +#define bcan_data u.m2.b + + +/* Message queues */ +struct mqueue { + struct message *head; /* first element on queue */ + struct message *tail; /* last element on queue */ + struct message *pos; /* current position in queue */ +}; + +#define NIL_MQUEUE (struct mqueue *)0 + +/* Get pointer to the first message in a queue */ +#define head_mqueue(q) ((q)->head) +#define first_mqueue(q) ((q)->head) + +/* Remove the head from a non-empty queue */ +#define rmhead_mqueue(q) do { \ + if ((q)->head != (q)->tail) (q)->head = (q)->head->next; \ + else (q)->head = (q)->tail = NIL_MESSAGE; \ + } while (0) + + +/* Allocate a message */ +extern struct message *new_message _PARAMS((int, int)); + +/* Deallocate a message */ +extern void delete_message _PARAMS((struct message *)); + +/* Allocate a message queue */ +extern struct mqueue *new_mqueue _PARAMS((void)); + +/* Deallocate a message queue. Any messages in the queue are also + deallocated. */ +extern void delete_mqueue _PARAMS((struct mqueue *)); + +/* Remove the first message from a queue. The address of the message + is returned. */ +extern struct message * extract_mqueue _PARAMS((struct mqueue *)); + +/* Append a message to a queue */ +extern void append_mqueue _PARAMS((struct mqueue *, struct message *)); + +/* Rewind queue for looping through its elements */ +extern void rewind_mqueue _PARAMS((struct mqueue *)); + +/* Get next message from queue */ +extern struct message *getnext_mqueue _PARAMS((struct mqueue *)); + +/* Delete the successor of a message from a queue. The deleted (not + freed!) message is returned. */ +extern struct message * +delsuc_mqueue _PARAMS((struct mqueue *, struct message *)); + +/* Insert a message into the queue after a specified message. */ +extern void +insert_mqueue _PARAMS((struct mqueue *, struct message *, struct message *)); + +#ifdef __cplusplus +} +#endif + +#endif /* !msg_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/nmtm.h =================================================================== --- trunk/MagicSoft/Cosy/incl/nmtm.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/nmtm.h (revision 731) @@ -0,0 +1,192 @@ +/*----------------------------------------------------------------------------- +nmtm.h -- NMT Master Interface + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 95/02/23 by Soenke Hansen +Version 1.16 of 99/10/26 + +Prototype declarations of functions defined in nmtm.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef nmtm_DEFINED +#define nmtm_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" +#include "cal.h" +#include "nmts.h" + +/*--------- Indication and Confirmation Primitives --------------------------*/ + +/* Origin of status/error confirmation */ +#define NMTM_LOCAL 0 /* on NMT Master */ +#define NMTM_REMOTE 1 /* on NMT Slave */ + +/* NMT error code for locally generated errors */ +#define LOC_ERR 1 + +/* Components of service confirmation message (spec == M_NMTM_*) */ +#define nmtm_nid u.m2.b[0] /* Node ID */ +#define nmtm_org u.m2.b[1] /* origin (local or remote) */ +#define nmtm_err u.m2.b[2] /* error code */ +#define nmtm_errs u.m2.b[3] /* error specifier */ +#define nmtm_xpct u.m2.b[4] /* toggle/state expected */ +#define nmtm_download u.m2.b[4] /* download expected by slave*/ +#define nmtm_real u.m2.b[5] /* toggle/state real */ + +#define NMTM_TIMEOUT_ERROR TIMEOUT_ERR /* value of nmtm_errs */ +#define NMTM_TOGGLE_ERROR TOGGLE_ERR /* value of nmtm_errs */ +#define NMTM_STATE_ERROR STATE_ERR /* value of nmtm_errs */ + + +/* Components of configuration message (spec == M_NMTM_*) */ +#define nmtm_conf_nid u.m2.b[0] /* Node ID */ +#define nmtm_conf_subspec_lo u.m2.b[1] /* subspec lo */ +#define nmtm_conf_subspec_hi u.m2.b[2] /* subspec hi */ +#define nmtm_conf_errspec u.m2.b[3] /* error specifier */ +#define nmtm_conf_fail_reason u.m1.w[3] /* failure reason */ +#define nmtm_conf_verify_result u.m1.w[3] /* verify result */ +#define nmtm_conf_verify_reason u.m1.w[4] /* verify failure reason */ +#define nmtm_conf_appl_spec_a u.m1.w[4] /* application specific a */ +#define nmtm_conf_appl_spec_b u.m1.w[5] /* application specific b */ +#define nmtm_conf_appl_spec_c u.m1.w[6] /* application specific c */ +#define nmtm_conf_appl_spec_d u.m1.w[7] /* application specific d */ +/*--------- Remote Node Objects ---------------------------------------------*/ + +/* Remote Node type definition */ +struct rnode { + NmtAddr addr; /* NMT Address */ + int state; /* remote node state */ + WORD_t ugt; /* guard time in 100 usecs */ + WORD_t userGuardId; /* user def. guard ID at CANopen remote nodes */ + BYTE_t nclass; /* node class */ + BYTE_t flags; /* flags related to error control */ + OBJECT obj; /* associated CAL object */ + BYTE_t type; /* CANopen (1) / CAL (0) node */ + BYTE_t guardErrType; /* flags related to guard error type */ + BYTE_t xpctTogState; /* rnode expected state/togglebit */ + BYTE_t realTogState; /* rnodes real state/togglebit */ + BYTE_t downloadRqd; /* rnode requires download if set 1 */ +}; + +#define NIL_RNODE (struct rnode *)0 + +/* Table of all Remote Nodes */ +extern struct rnode *RemoteNodes[]; + +/* Remote Node States */ +#define RN_NON_EXISTENT (-1) +#define RN_DISCONNECTED 0 +#define RN_CONNECTED PREPARING +#define RN_PREPARED PREPARED +#define RN_OPERATIONAL OPERATIONAL +#define RN_PRE_OPERATIONAL PRE_OPERATIONAL + +/*--------- Some guarding stuff -------------------------------------------*/ + +/* Values for error control flags */ +#define ARRIVED 0x01 /* guarding COB from remote node arrived */ +#define RAISED 0x02 /* timeout error raised at current grd period */ +#define INDICATED 0x04 /* timeout error occ. and was ind. to user */ +#define INHIBIT_GUARD 0x08 /* Node guarding was inhibited */ +#define STATE_CH_RAISED 0x10 /* signals a state change error */ +#define STATE_CH_INDICATED 0x20 /* state change error was indicated...*/ +#define TOGGLE_RAISED 0x40 /* signals a toggle error */ +/* TOGGLE (0x80) from bit-representation (see below) is used */ +/* for error control, too. */ + +/* Values for error report flags */ +#define TIMEOUT_ERR 0x01 /* error reported to user was timeout-error */ +#define TOGGLE_ERR 0x02 /* error reported to user was tgl.-bit-error */ +#define STATE_ERR 0x04 /* error reported to user was state-error */ + +/* guarding protocols bit representation */ +#define TOGGLE 0x80 /* toggle bit of guarding protocol */ +#define STATE_MASK 0x7f /* state relevant bits of guarding prot. */ + +/*--------- Prototypes ------------------------------------------------------*/ + +/* Create and initialize the NMT Master. */ +extern void InitNmtM(WORD_t, WORD_t, int, void (*)()); + +/* Configure NMT master. */ +extern void ConfigNmtM(WORD_t, WORD_t, int, WORD_t); + +/* Remove the NMT Master. Free the resources it holds. */ +extern void DeleteNmtM(void); + +/* Add Remote Node service */ +extern int CreateRemoteNode(NmtAddr *); +extern int AddRemoteNode(NmtAddr *); + +/* Add Remote CANopen Node service */ +extern int CreateRemoteCOPNode(NmtAddr *, WORD_t, BYTE_t); +extern int CreateRemoteCOPNodeDefGuardId(NmtAddr *, WORD_t, BYTE_t, WORD_t); +extern int AddRemoteCOPNode(NmtAddr *, WORD_t, BYTE_t); +extern int AddRemoteCOPNodeDefGuardId(NmtAddr *, WORD_t, BYTE_t, WORD_t); + +/* Request Guarding the CANopen Remote Nodes */ +extern int GuardingRemoteCOPNodeReq(int); + +/* Remove Remote Node service */ +extern void RemoveRemoteNode(NmtAddr *); + +/* Get a remote node state */ +extern int GetRemoteNodeState(NmtAddr *); + +/* Request Connect Remote Node */ +extern int ConnectRemoteNodeReq(NmtAddr *, int); + +/* Request Prepare Remote Node */ +extern int PrepareRemoteNodeReq(int); + +/* Request enter pre-operational state of Remote Node */ +extern int EnterPreOperationalStateReq(int); + +/* Request Reset_Node state of Remote Node */ +extern int ResetNodeReq(int); + +/* Request Reset_Communication state of Remote Node */ +extern int ResetCommunicationReq(int); + +/* Request Start Remote Node */ +extern int StartRemoteNodeReq(int); + +/* Request Stop Remote Node */ +extern int StopRemoteNodeReq(int); + +/* Request Disconnect Remote Node */ +extern int DisconnectRemoteNodeReq(int); + +/* Request Identify Remote Nodes */ +extern int IdentifyRemoteNodesReq(int, int); + +/* Request Initiate Config Download */ +extern int ConfDownloadStartReq(int, int, int, int, BYTE_t *); + +/* Response Continue Config Download */ +extern int ConfDownloadContReq(int, int, int, BYTE_t *); + +/* Request Abort Configuration */ +extern int NmAbortConfigTransferReq(int, int, int); + +/* Request Verify Configuration */ +extern int NmVerifyConfigTransferReq(int, int); + +#if DEBUG>0 +extern void guard_node(int); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* !nmtm_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/nmts.h =================================================================== --- trunk/MagicSoft/Cosy/incl/nmts.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/nmts.h (revision 731) @@ -0,0 +1,222 @@ +/*----------------------------------------------------------------------------- +nmts.h -- NMT Slave, Node + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.17 of 99/04/26 + +Various definitions: NMT Address type, NMT command specifiers, node states, +macros for data indicated to the NMT User. +Prototypes of functions defined in nmts.c. + +-----------------------------------------------------------------------------*/ + + +#ifndef nmts_DEFINED +#define nmts_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" + +/* Components of service confirmation message */ +#define nmts_state u.m1.w[0] /* Node State */ +#define nmts_error u.m1.w[0] /* Node Error */ +#define nmts_errcode u.m1.w[1] /* error code ident. from BCAN_EVENT */ +#define nmts_errcode_e0 u.m1.w[2] /* BCAN_EVENT additional infos */ +#define nmts_errcode_e1 u.m1.w[3] /* BCAN_EVENT additional infos */ +#define nmts_errcode_e2 u.m1.w[4] /* BCAN_EVENT additional infos */ +#define nmts_errcode_e3 u.m1.w[5] /* BCAN_EVENT additional infos */ +#define nmts_keep u.m2.b[2] /* Node Prepare Protocol */ + +/* Values of node error flag nmts_error */ +#define NE_LOCAL_OCCURRED 0x0003 /* local error occurred */ +#define NE_LOCAL_RESOLVED 0x0002 /* local error resolved */ +#define NE_REMOTE_OCCURRED 0x000c /* remote error occurred */ +#define NE_REMOTE_RESOLVED 0x0008 /* remote error resolved */ + +/* Components of configuration message (spec == M_NMTS_*) */ +#define nmts_conf_subspec_lo u.m1.w[0] /* subspec low */ +#define nmts_conf_subspec_hi u.m1.w[1] /* subspec high */ + +#define nmts_conf_errspec u.m1.w[2] /* error specifier */ + +#define nmts_conf_fail_reason u.m1.w[2] /* failure reason */ +#define nmts_conf_appl_spec_a u.m1.w[3] /* application specific a */ +#define nmts_conf_appl_spec_b u.m1.w[4] /* application specific b */ +#define nmts_conf_appl_spec_c u.m1.w[5] /* application specific c */ +#define nmts_conf_appl_spec_d u.m1.w[6] /* application specific d */ + +#define nmts_conf_verify_cs_a u.m1.w[2] /* verify checksum a */ +#define nmts_conf_verify_cs_b u.m1.w[3] /* verify checksum b */ +#define nmts_conf_verify_cs_c u.m1.w[4] /* verify checksum c */ +#define nmts_conf_verify_cs_d u.m1.w[5] /* verify checksum d */ + +/* Type definition of NMT address */ +struct nmt_addr { + BYTE_t modname[8]; /* module name */ + BYTE_t modid; /* module Id */ +}; +#if TYPEDEFS == 1 +typedef struct nmt_addr NmtAddr; +#else +#define NmtAddr struct nmt_addr +#endif + +/* Copy an NMT Address */ +extern void NmtAddrCopy( + NmtAddr *, /* target address */ + NmtAddr * /* source address */ +); + +/* The Node State */ +extern int NodeState; + +/* Node State values */ +#define DISCONNECTED 1 +#define CONNECTING 2 +#define PREPARING 3 +#define PREPARED 4 +#define OPERATIONAL 5 +#define PRE_OPERATIONAL 127 + +/* The Node Id */ +extern BYTE_t NodeId; + +/* There are three CAL Objects associated with the NMT Slave */ +extern struct calo *NodeO; /* receives COBs with Id=0 */ +extern struct calo *NmtSlave; /* receives COBs with Id=2026 */ +extern struct calo *NodeErrO; /* receives guarding COBs, Node Events */ + +/* Command specifiers in NMT Protocol with COB-ID=0 */ +#define NMT_CS_START 1 /* Start Node, COB-ID=0 */ +#define NMT_CS_STOP 2 /* Stop Node, COB-ID=0 */ +#define NMT_CS_DISCONNECT 3 /* Disconnect Node, COB-ID=0 */ + +/* Command specifiers in NMT Protocol with COB-ID=0 relevant for CANopen */ +#define NMT_CS_ENTER_PRE_OPERATIONAL 128 /* enter pre-operational state */ +#define NMT_CS_RESET_NODE 129 /* Reset Node */ +#define NMT_CS_RESET_COMMUNICATION 130 /* Reset Communication */ + +/* Command specifiers in NMT Protocol with COB-IDs=2025,2026 */ +#define NMT_CS_CONNECT_NAME 1 /* Node Connect, Module Name */ +#define NMT_CS_CONNECT_ID 4 /* Node Connect, Module Id */ +#define NMT_CS_CONNECT_ASSIGN 2 /* Node Connect, assign phase */ +#define NMT_CS_PREPARE 3 /* Node Prepare */ +#define NMT_CS_CONFIG 5 /* Configuration Service */ +#define NMT_CS_IDENTIFY 6 /* Node Identify */ + +/* Nil command specifier */ +#define NMT_CS_NIL 0 /* not used by protocols */ + + + /* timepoint of guard start: */ +#define START_AT_IDENTIFY 0x01 /* receiving of a identify msg */ +#define START_AT_GUARD_ID_RX 0x02 /* receiving on guard ID */ + +#define NMTS_CONF_DOWNLOAD_ACK 0x01 /* mux: configure nmt slave to use */ + /* acknowledge at configuration */ + /* download */ +#define NMTS_CONF_DL_ACK_OFF 0x00 /* flag: use acknowledge */ +#define NMTS_CONF_DL_ACK_ON 0x01 /* flag: don't use acknowledge (dflt.)*/ + +/* Subsequent command (sub-) specifiers in Nmt Configuration protocol */ +#define NMT_CONF_DIR_NO 0 +#define NMT_CONF_DIR_UPLOAD 1 +#define NMT_CONF_DIR_DOWNLOAD 2 +/* master commands */ +#define NMT_MCS_DL_SEGMENT_REQ 0 +#define NMT_MCS_INITIATE_DL_REQ 0x20 +#define NMT_MCS_INITIATE_UL_REQ 0x40 +#define NMT_MCS_UL_SEGMENT_REQ 0x60 +#define NMT_MCS_ABORT_CONF_REQ 0x80 +#define NMT_MCS_VERIFY_CONF_REQ 0xa0 +#define MCS_MASK 0xe0 + +/* slave commands */ +#define NMT_SCS_UL_SEGMENT_RES 0 +#define NMT_SCS_DL_SEGMENT_RES 0x20 +#define NMT_SCS_INITIATE_UL_RES 0x40 +#define NMT_SCS_INITIATE_DL_RES 0x60 +#define NMT_SCS_ABORT_CONF_REQ 0x80 +#define NMT_SCS_VERIFY_CONF_RES 0xa0 +#define SCS_MASK 0xe0 + +#define NMT_CONFIG_TOGGLE 0x10 + +/* leaving place for 2 byte subspec, 4 byte whole */ +/* size, 1 byte dblk-size and 1 byte cs */ +#define NMT_CONFIG_HEAD_SIZE 8 +#define NMT_CONFIG_DBLK_SIZE MSGLEN - NMT_CONFIG_HEAD_SIZE +#define NMT_CONFIG_MORE_SEG_INDICATOR 0x01 /* bit position in protocol */ +#define NMT_CONFIG_MORE_BYTES 0 +#define NMT_CONFIG_NOMORE_BYTES 1 + +#define NMT_CONFIG_MAX_SEG_DATA 5 +#define NMT_CONFIG_SIZE_INDICATOR 0x01 + +/* bitpositions in cs to user */ +#define NMT_MORE 1 /* more date will follow */ +#define NMT_SUCCESS 4 /* success indication */ + +/* indication of success/fail of last nmt transfer */ +#define NMT_CONFIG_TRANSFER_FAILED 0 +#define NMT_CONFIG_TRANSFER_SUCCESS 1 +#define XFER_FAIL NMT_CONFIG_TRANSFER_FAILED +#define XFER_SUCC NMT_CONFIG_TRANSFER_SUCCESS + +/* Allocate and initialize NMT Slave */ +extern void InitNmtS( + WORD_t , /* timeout interval */ + void (*)() /* user handler indication/confirmation */ +); + +/* Deallocate NMT Slave */ +extern void DeleteNmtS(void); + +/* Create Node Service */ +extern void CreateNode(NmtAddr *, unsigned); + +/* Create CANopen Node Service */ +extern void CreateCOPNode(NmtAddr *, unsigned); + +/* Config CANopen Node Service */ +extern void ConfigCOPNode(WORD_t, int, BYTE_t); + +/* Delete Node Service */ +extern void DeleteNode(void); + +/* Identify Node Service */ +extern void IdentifyNode(void); + +/* Disconnect Node Service */ +extern void DisconnectNode(void); + +/* Connect Node Service */ +extern int ConnectNode(int, WORD_t, BYTE_t); + +/* Respond Prepare Remote Node Service */ +extern int PrepareRemoteNodeRes(unsigned); + +/* Configure Configuration download acknowledge */ +extern void NsConfigConfDownloadAck(WORD_t); + +/* nmt configuration download acknowledge from user */ +extern void NsConfAckUser(void); + +/* Request Abort Configuration */ +extern int NsAbortConfigTransferReq(int,int); + +/* Response Verify Configuration */ +extern int NsVerifyConfigTransferRes(BYTE_t, BYTE_t); + +#ifdef __cplusplus +} +#endif + +#endif /* !nmts_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/timer.h =================================================================== --- trunk/MagicSoft/Cosy/incl/timer.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/timer.h (revision 731) @@ -0,0 +1,55 @@ +/*----------------------------------------------------------------------------- +timer.h -- Timer Management + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 94/10/11 by Soenke Hansen +Version 1.3 of 96/04/18 + +Prototypes of functions defined in timer.c. +The details of timer messages are in msg.h. + +-----------------------------------------------------------------------------*/ + +#ifndef timer_DEFINED +#define timer_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +#include "defs.h" +#include "msg.h" + +/* Time units are 100usecs. Conversion (with chopping) from other + time units. */ +#define time_units_ms(ms) (((ms) < 0xffff/10) ? 10 * (ms) : 0xffff) + +/* Timer identifiers are 16 bit unsigned integers */ +#define NIL_TIMID (WORD_t)0 /* invalid identifier */ + +/* Initialize the timer management */ +extern void init_timer _PARAMS((void)); + +/* Start periodical timer */ +extern void start_timer _PARAMS((WORD_t)); + +/* Stop timer */ +extern void stop_timer _PARAMS((void)); + +/* Deactivate a timer */ +extern void clear_timer _PARAMS((WORD_t)); + +/* Activate a timer. The alarm time is given in units of 100 usecs. + The alarm time is relative to the time of call. */ +extern int set_timer _PARAMS((WORD_t, WORD_t, WORD_t *)); + +/* Alarm interrupt handler passed to the clock. */ +extern void isr_timer _PARAMS((void)); + +#ifdef __cplusplus +} +#endif + +#endif /* !timer_DEFINED */ Index: trunk/MagicSoft/Cosy/incl/vmod.h =================================================================== --- trunk/MagicSoft/Cosy/incl/vmod.h (revision 731) +++ trunk/MagicSoft/Cosy/incl/vmod.h (revision 731) @@ -0,0 +1,153 @@ +/*----------------------------------------------------------------------------- +vmod.h -- VMOD specific definitions (message specifiers, values) + +Copyright (c) 1994 JANZ Computer AG +All Rights Reserved + +Created 96/08/01 by Stefan Althoefer +Version 1.19 of 00/03/29 + +-----------------------------------------------------------------------------*/ + +#ifndef vmod_DEFINED +#define vmod_DEFINED + +#ifdef __cplusplus +extern "C" { +#endif + +/* Specifiers of general messages */ +#define M_NOP 0x00 /* nil message, no operation */ +#define M_CONNECT 0x01 /* connect to host without interrupts */ +#define M_CONNECT_INTR 0x02 /* connect to host with interrupts */ +#define M_DISCONNECT 0x03 /* disconnect from host */ +#define M_IDVERS 0x04 /* get id and version */ +#define M_MSG_LOST 0x05 /* messages lost, host reads too slow */ +#define M_DEBUG 0x06 /* formatted debug output */ +#define M_SELECT 0x07 /* select functionality */ +#define M_NEWHOSTIF 0x08 /* switch to new stylish hostif */ +#define M_MEMORY 0x09 /* get info about memory */ +#define M_INQUIRY 0x0a /* get some info about module status */ + +#define M_LOCK_LOADER 0x0b /* lock loader on next reset */ +#define M_FW_DOWNLOAD_req 0x0c /* host starts a firmware download */ +#define M_FW_DOWNLOAD_CONT_ind 0x0d /* target requests for more data */ +#define M_FW_DOWNLOAD_CONT_res 0x0e /* host responds with next data */ +#define M_FW_DOWNLOAD_con 0x0f /* target confirms the service */ + +#define M_SET_AFIL 0x10 /* set acceptance filter mask */ +#define M_INIT_FDPMQUEUE 0x11 /* initialize fast dpmqueue */ +#define M_HW_CONF 0x12 /* configure hardware features */ +#define M_SET_PRIO_BND 0x13 /* set priority boundaries */ +#define M_HANDLE_HOST_GUARDING 0x14 /* spec dealing with host-guarding */ + +#define M_FMSG_LOST 0x15 /* lost messages on fast queue */ + +#define M_DEV_DEBUG 0x1f /* for debugging purposes */ + +/* host guarding stuff concerning macros */ +#define GUARD_ACTIVE 0x01 +#define GUARD_INACTIVE 0x00 +#define ALIVE 0xaa +#define DEAD 0x55 + +/* module/host dependant CANopen configuration */ +#define M_CONF_CANOPEN_MUX 0x16 /* user <-> CANopen relevant config. */ +#define M_CONF_CANOPEN_MUX_DPM_ENDIAN 0x0 /* endianess of host */ +/* possible values: */ +#define COP_DPM_BIG_ENDIAN 0x00 /* mapping for Big Endian hosts */ +#define COP_DPM_LITTLE_ENDIAN 0x01 /* mapping for Little Endian hosts */ +/* mux for seeing the SYNC or not at host */ +#define M_CONF_CANOPEN_MUX_SEND_SYNC_TO_HOST 0x1 /* visibility of SYNC on host */ + +#define M_ADD_FDPMQUEUE_PRIO 0x17 /* create one additional prioritized fast fromhost dpmqueue */ + +/* BULK_BUFFER-stuff shouldn't it belong to mican.h (ICANOS) ??? */ +#define M_CONFIG_BULK_BUFFER 0x18 /* configbulk buffer for CAN-Layer-2-messages */ +#define MS_CONFIG_BULK_BUFFER_TIMEOUT_ONLY 0x0000 /* configure bulk buffers timeout to send */ +#define MS_CONFIG_BULK_BUFFER_TIMEOUT_SIZE 0x0001 /* configure bulk buffers timeout and size */ + +#define M_CONFIG_SNIFF 0x1a /* config sniff buffer */ +#define MS_CONFIG_SNIFF_BUFFER_TIMEOUT_ONLY 0x0000 /* config sniff buff. timeout to send */ +#define MS_CONFIG_SNIFF_BUFFER_TIMEOUT_SIZE 0x0001 /* config sniff buff. timeout and size */ +#define MS_CONFIG_SNIFF_BUFFER_ECHO 0x0002 /* config sniff buff. echo from queues */ +#define MS_CONFIG_SNIFF_FILTER_STD 0x0003 /* set sniff acc. filt. (Std. CAN frames) */ +#define MS_CONFIG_SNIFF_FILTER_XTD 0x0004 /* set sniff acc. filt. (Xtd. CAN frames) */ +#define MS_SNIFF_INQUIRY 0x0005 /* inquiry module status (refer to M_INQUIRY) forces sending of INQUIRY message with SNIFF specifier */ +#define MS_SNIFF_IDVERS 0x0006 /* inquiry module version (refer to M_IDVERS) forces sending of IDVERS message with SNIFF specifier */ +#define MS_SNIFF_BUSLOAD_ALL 0x0007 +#define MS_SNIFF_CONFIG_BUSLOAD 0x0008 +#define MS_SNIFF_INQUIRY_CONTROLLER 0x0009 /* inquiry CAN controller status (refer to M_INQUIRY) forces sending of INQUIRY_CONTROLLER message with SNIFF specifier */ + + + +/* message specifier/subspecifier for measurement of CAN bus load */ +#define M_BUSLOAD 0x19 /* configure resp. send/receive bus-load-measurement parameter/values */ +#define MS_CONFIG_BUSLOAD 0x0000 /* configure/de-/activate bus-load parameters (host -> module) */ +#define MS_REQUEST_BUSLOAD_ALL 0x0001 /* configure/de-/activate bus-load parameters (host -> module) */ + + +/* Customer 1 */ +#define M_CUST1 0xc0 /* Customer 1 */ + +/* Subspecs for Customer 1 */ +#define MS_CUST1_INIT_req 0x0000 /* SysClk Init */ +#define MS_CUST1_START_TS_req 0x0001 /* OBSOLET! */ + +/* Subspecs/defines for module inquiry M_INQUIRY */ +#define MS_INQUIRY_STATUS 0x0000 /* CAN Chip / module status */ +#define MS_INQUIRY_TIMING_MASKS_TERM 0x0001 /* CANbus bit rate, accept */ + /* masks, termination state */ +#define MS_INQUIRY_HOST_IF 0x0002 /* new/old host interface */ + /* on module */ +#define MS_INQUIRY_AFIL 0x0003 /* looks for acceptance mask */ +#define MS_INQUIRY_EXTD_STATUS 0x0004 /* CAN Chip / module status */ + /* superior format. */ + +#define MASK_COUNT 50 /* count of ID masks which will be sent */ + /* on a MS_INQUIRY_AFIL response (CAVE AT */ + /* the buffer size to loose no messages!) */ +#define INVALID_ID 9 /* signals out of id-range in INQUIRY_AFIL */ + +#define INQUIRY_CTRL_82C200 0x01 /* 82C200 extended infos */ +#define INQUIRY_CTRL_SJA1000 0x02 /* SJA100 extended infos */ + +/* Definitions for ICAN2/3 dependent termination states */ +#define TERM_INFO_AVAILABLE 0x80 +#define TERM_INFO_NOT_AVAILABLE 0x00 +#define TERM_ON 0x01 +#define TERM_OFF 0x00 + +/* Maximum data length of messages */ +#define MSGLEN 252 + + +/* Definition of some special DPM locations. */ +#define TARGET_ALIVE 0xc +#define TARGET_STATUS 0xe + +/* + * Some CANopen definitions for process picture + */ +/* length of necessary bytes for synchronization between host and VMOD-ICAN3 */ +#define NUM_DPM_SYNC_BYTES 2 +#define SYNC_BYTE_ICAN_OWNED 0 +#define SYNC_BYTE_HOST_OWNED 1 + +#define MAX_DPM_PAGES 256 /* 0 .. 255 */ +#define MAX_DPM_BYTES 256 /* 0 .. 255 */ + +#define DPM_DATA_INVALID 0 +#define DPM_DATA_VALID 1 + +/* location of process picture */ +#define PP_START_IN_DPM 0x8000 /* PP starts at 32KByte in DPM */ +#define PP_MAX_BYTE_NUM 0x8000 /* PP has a length of 32KByte in DPM */ + + + +#ifdef __cplusplus +} +#endif + +#endif /* !vmod_DEFINED */ Index: trunk/MagicSoft/slalib/addet.c =================================================================== --- trunk/MagicSoft/slalib/addet.c (revision 731) +++ trunk/MagicSoft/slalib/addet.c (revision 731) @@ -0,0 +1,60 @@ +#include "slalib.h" +#include "slamac.h" +void slaAddet ( double rm, double dm, double eq, double *rc, double *dc ) +/* +** - - - - - - - - - +** s l a A d d e t +** - - - - - - - - - +** +** Add the e-terms (elliptic component of annual aberration) to a +** pre IAU 1976 mean place to conform to the old catalogue convention. +** +** Given: +** rm,dm double RA,Dec (radians) without e-terms +** eq double Besselian epoch of mean equator and equinox +** +** Returned: +** *rc,*dc double RA,dec (radians) with e-terms included +** +** Called: +** slaEtrms, slaDcs2c, slaDcc2s, slaDranrm, slaDrange +** +** Explanation: +** Most star positions from pre-1984 optical catalogues (or +** derived from astrometry using such stars) embody the +** e-terms. If it is necessary to convert a formal mean +** place (for example a pulsar timing position) to one +** consistent with such a star catalogue, then the RA,Dec +** should be adjusted using this routine. +** +** Reference: +** Explanatory Supplement to the Astronomical Almanac, +** ed P.K.Seidelmann (1992), page 169. +** +** Last revision: 25 July 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double a[3]; /* Elliptic components of annual aberration vector */ + double v[3]; /* Cartesian equivalant of RA,Dec */ + int i; + + +/* E-terms vector */ + slaEtrms ( eq, a ); + +/* Spherical to Cartesian */ + slaDcs2c ( rm, dm, v ); + +/* Include the e-terms */ + for ( i=0; i < 3; i++ ) { + v[i] += a[i]; + } + +/* Cartesian to spherical */ + slaDcc2s ( v, rc, dc ); + +/* Bring RA into conventional range */ + *rc = slaDranrm ( *rc ); +} Index: trunk/MagicSoft/slalib/afin.c =================================================================== --- trunk/MagicSoft/slalib/afin.c (revision 731) +++ trunk/MagicSoft/slalib/afin.c (revision 731) @@ -0,0 +1,91 @@ +#include "slalib.h" +#include "slamac.h" +void slaAfin ( char *string, int *iptr, float *a, int *j ) +/* +** - - - - - - - - +** s l a A f i n +** - - - - - - - - +** +** Sexagesimal character string to angle. +** +** (single precision) +** +** Given: +** string c*(*) string containing deg, arcmin, arcsec fields +** iptr int where to start decode (1st = 1) +** +** Returned: +** iptr int advanced past the decoded angle +** a float angle in radians +** j int status: 0 = OK +** +1 = default, A unchanged +** -1 = bad degrees ) +** -2 = bad arcminutes ) (note 3) +** -3 = bad arcseconds ) +** +** Example: +** +** argument before after +** +** string '-57 17 44.806 12 34 56.7' unchanged +** iptr 1 16 (points to 12...) +** +** a ? -1.00000f +** j ? 0 +** +** A further call to slaAfin, without adjustment of iptr, will +** decode the second angle, 12deg 34min 56.7sec. +** +** Notes: +** +** 1) The first three "fields" in string are degrees, arcminutes, +** arcseconds, separated by spaces or commas. The degrees field +** may be signed, but not the others. The decoding is carried +** out by the dfltin routine and is free-format. +** +** 2) Successive fields may be absent, defaulting to zero. For +** zero status, the only combinations allowed are degrees alone, +** degrees and arcminutes, and all three fields present. If all +** three fields are omitted, a status of +1 is returned and a is +** unchanged. In all other cases a is changed. +** +** 3) Range checking: +** The degrees field is not range checked. However, it is +** expected to be integral unless the other two fields are absent. +** The arcminutes field is expected to be 0-59, and integral if +** the arcseconds field is present. If the arcseconds field +** is absent, the arcminutes is expected to be 0-59.9999... +** The arcseconds field is expected to be 0-59.9999... +** +** 4) Decoding continues even when a check has failed. Under these +** circumstances the field takes the supplied value, defaulting +** to zero, and the result a is computed and returned. +** +** 5) Further fields after the three expected ones are not treated +** as an error. The pointer iptr is left in the correct state +** for further decoding with the present routine or with slaDfltin +** etc. See the example, above. +** +** 6) If string contains hours, minutes, seconds instead of degrees +** etc, or if the required units are turns (or days) instead of +** radians, the result a should be multiplied as follows: +** for to obtain multiply +** string a in a by +** d ' " radians 1 = 1.0f +** d ' " turns 1/2pi = 0.1591549430918953358f +** h m s radians 15 = 15.0f +** h m s days 15/2pi = 2.3873241463784300365f +** +** Called: slaDfltin +** +** Last revision: 16 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double ad; + +/* Call the double precision version */ + slaDafin ( string, iptr, &ad, j ); + if ( *j <= 0 ) *a = (float) ad; +} Index: trunk/MagicSoft/slalib/airmas.c =================================================================== --- trunk/MagicSoft/slalib/airmas.c (revision 731) +++ trunk/MagicSoft/slalib/airmas.c (revision 731) @@ -0,0 +1,57 @@ +#include "slalib.h" +#include "slamac.h" +double slaAirmas ( double zd ) +/* +** - - - - - - - - - - +** s l a A i r m a s +** - - - - - - - - - - +** +** Air mass at given zenith distance. +** +** (double precision) +** +** Given: +** zd d observed zenith distance (radians) +** +** The result is an estimate of the air mass, in units of that +** at the zenith. +** +** Notes: +** +** 1) The "observed" zenith distance referred to above means "as +** affected by refraction". +** +** 2) Uses Hardie's (1962) polynomial fit to Bemporad's data for +** the relative air mass, X, in units of thickness at the zenith +** as tabulated by Schoenberg (1929). This is adequate for all +** normal needs as it is accurate to better than 0.1% up to X = +** 6.8 and better than 1% up to X = 10. Bemporad's tabulated +** values are unlikely to be trustworthy to such accuracy +** because of variations in density, pressure and other +** conditions in the atmosphere from those assumed in his work. +** +** 3) The sign of the ZD is ignored. +** +** 4) At zenith distances greater than about ZD = 87 degrees the +** air mass is held constant to avoid arithmetic overflows. +** +** References: +** Hardie, R.H., 1962, in "Astronomical Techniques" +** ed. W.A. Hiltner, University of Chicago Press, p180. +** Schoenberg, E., 1929, Hdb. d. Ap., +** Berlin, Julius Springer, 2, 268. +** +** Adapted from original Fortran code by P.W.Hill, St Andrews. +** +** Last revision: 5 October 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double w, seczm1; + + w = fabs ( zd ); + seczm1 = 1.0 / ( cos ( gmin ( 1.52, w ) ) ) - 1.0; + return 1.0 + seczm1 * ( 0.9981833 + - seczm1 * ( 0.002875 + 0.0008083 * seczm1 ) ); +} Index: trunk/MagicSoft/slalib/altaz.c =================================================================== --- trunk/MagicSoft/slalib/altaz.c (revision 731) +++ trunk/MagicSoft/slalib/altaz.c (revision 731) @@ -0,0 +1,143 @@ +#include "slalib.h" +#include "slamac.h" +void slaAltaz ( double ha, double dec, double phi, + double *az, double *azd, double *azdd, + double *el, double *eld, double *eldd, + double *pa, double *pad, double *padd ) +/* +** - - - - - - - - - +** s l a A l t a z +** - - - - - - - - - +** +** Positions, velocities and accelerations for an altazimuth +** telescope mount. +** +** (double precision) +** +** Given: +** ha double hour angle +** dec double declination +** phi double latitude +** +** Returned: +** *az double azimuth +** *azd double " velocity +** *azdd double " acceleration +** *el double elevation +** *eld double " velocity +** *eldd double " acceleration +** *pa double parallactic angle +** *pad double " " velocity +** *padd double " " acceleration +** +** Notes: +** +** 1) Natural units are used throughout. HA, DEC, PHI, AZ, EL +** and ZD are in radians. The velocities and accelerations +** assume constant declination and constant rate of change of +** hour angle (as for tracking a star); the units of AZD, ELD +** and PAD are radians per radian of HA, while the units of AZDD, +** ELDD and PADD are radians per radian of HA squared. To +** convert into practical degree- and second-based units: +** +** angles * 360/2pi -> degrees +** velocities * (2pi/86400)*(360/2pi) -> degree/sec +** accelerations * ((2pi/86400)**2)*(360/2pi) -> degree/sec/sec +** +** Note that the seconds here are sidereal rather than SI. One +** sidereal second is about 0.99727 SI seconds. +** +** The velocity and acceleration factors assume the sidereal +** tracking case. Their respective numerical values are (exactly) +** 1/240 and (approximately) 1/3300236.9. +** +** 2) Azimuth is returned in the range 0-2pi; north is zero, +** and east is +pi/2. Elevation and parallactic angle are +** returned in the range +/-pi/2. Position angle is +ve +** for a star west of the meridian and is the angle NP-star-zenith. +** +** 3) The latitude is geodetic as opposed to geocentric. The +** hour angle and declination are topocentric. Refraction and +** deficiencies in the telescope mounting are ignored. The +** purpose of the routine is to give the general form of the +** quantities. The details of a real telescope could profoundly +** change the results, especially close to the zenith. +** +** 4) No range checking of arguments is carried out. +** +** 5) In applications which involve many such calculations, rather +** than calling the present routine it will be more efficient to +** use inline code, having previously computed fixed terms such +** as sine and cosine of latitude, and (for tracking a star) +** sine and cosine of declination. +** +** Defined in slamac.h: DPI, D2PI +** +** Last revision: 14 March 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define TINY 1e-30 /* Zone of avoidance around zenith/nadir */ + +{ + double sh, ch, sd, cd, sp, cp, chcd, sdcp, x, y, z, rsq, r, a, e, + c, s, q, qd, ad, ed, edr, add, edd, qdd; + +/* Useful functions */ + sh = sin ( ha ); + ch = cos ( ha ); + sd = sin ( dec ); + cd = cos ( dec ); + sp = sin ( phi ); + cp = cos ( phi ); + chcd = ch * cd; + sdcp = sd * cp; + x = - chcd * sp + sdcp; + y = - sh * cd; + z = chcd * cp + sd * sp; + rsq = x * x + y * y; + r = sqrt ( rsq ); + +/* Azimuth and elevation */ + if ( rsq == 0.0 ) { + a = 0.0; + } else { + a = atan2 ( y, x ); + } + if ( a < 0.0 ) a += D2PI; + e = atan2 ( z, r ); + +/* Parallactic angle */ + c = cd * sp - ch * sdcp; + s = sh * cp; + if ( c * c + s * s > 0.0 ) { + q = atan2 ( s, c ); + } else { + q = DPI - ha; + } + +/* Velocities and accelerations (clamped at zenith/nadir) */ + if ( rsq < TINY ) { + rsq = TINY; + r = sqrt ( rsq ); + } + qd = - x * cp / rsq; + ad = sp + z * qd; + ed = cp * y / r; + edr = ed / r; + add = edr * ( z * sp + ( 2.0 - rsq ) * qd ); + edd = - r * qd * ad; + qdd = edr * ( sp + 2.0 * z * qd ); + +/* Results */ + *az = a; + *azd = ad; + *azdd = add; + *el = e; + *eld = ed; + *eldd = edd; + *pa = q; + *pad = qd; + *padd = qdd; +} Index: trunk/MagicSoft/slalib/amp.c =================================================================== --- trunk/MagicSoft/slalib/amp.c (revision 731) +++ trunk/MagicSoft/slalib/amp.c (revision 731) @@ -0,0 +1,64 @@ +#include "slalib.h" +#include "slamac.h" +void slaAmp ( double ra, double da, double date, double eq, + double *rm, double *dm ) +/* +** - - - - - - - +** s l a A m p +** - - - - - - - +** +** Convert star RA,Dec from geocentric apparent to mean place. +** +** The mean coordinate system is the post IAU 1976 system, +** loosely called FK5. +** +** Given: +** ra double apparent RA (radians) +** da double apparent Dec (radians) +** date double TDB for apparent place (JD-2400000.5) +** eq double equinox: Julian epoch of mean place +** +** Returned: +** *rm double mean RA (radians) +** *dm double mean Dec (radians) +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Notes: +** +** 1) The distinction between the required TDB and the more +** accessible TT is always negligible. Moreover, for all +** but the most critical applications UTC is adequate. +** +** 2) The accuracy is limited by the routine slaEvp, called +** by slaMappa, which computes the Earth positions and +** velocities using the methods of Stumpff. The maximum +** error is about 0.3 milliarcsecond. +** +** 3) Iterative techniques are used for the aberration and +** light deflection corrections so that the routines +** slaAmp (or slaAmpqk) and slaMap (or slaMapqk) are +** accurate inverses; even at the edge of the Sun's disc +** the discrepancy is only about 1 nanoarcsecond. +** +** 4) Where multiple apparent places are to be converted to +** mean places, for a fixed date and equinox, it is more +** efficient to use the slaMappa routine to compute the +** required parameters once, followed by one call to +** slaAmpqk per star. +** +** Called: slaMappa, slaAmpqk +** +** Last revision: 12 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +** +*/ +{ + double amprms[21]; /* Mean-to-apparent parameters */ + + slaMappa ( eq, date, amprms ); + slaAmpqk ( ra, da, amprms, rm, dm ); +} Index: trunk/MagicSoft/slalib/ampqk.c =================================================================== --- trunk/MagicSoft/slalib/ampqk.c (revision 731) +++ trunk/MagicSoft/slalib/ampqk.c (revision 731) @@ -0,0 +1,123 @@ +#include "slalib.h" +#include "slamac.h" +void slaAmpqk ( double ra, double da, double amprms[21], + double *rm, double *dm ) +/* +** - - - - - - - - - +** s l a A m p q k +** - - - - - - - - - +** +** Convert star RA,Dec from geocentric apparent to mean place. +** +** The mean coordinate system is the post IAU 1976 system, +** loosely called FK5. +** +** Use of this routine is appropriate when efficiency is important +** and where many star positions are all to be transformed for +** one epoch and equinox. The star-independent parameters can be +** obtained by calling the slaMappa routine. +** +** Given: +** ra double apparent RA (radians) +** da double apparent Dec (radians) +** +** amprms double[21] star-independent mean-to-apparent parameters: +** +** (0) time interval for proper motion (Julian years) +** (1-3) barycentric position of the Earth (AU) +** (4-6) heliocentric direction of the Earth (unit vector) +** (7) (grav rad Sun)*2/(Sun-Earth distance) +** (8-10) abv: barycentric Earth velocity in units of c +** (11) sqrt(1-v*v) where v=modulus(abv) +** (12-20) precession/nutation (3,3) matrix +** +** Returned: +** *rm double mean RA (radians) +** *dm double mean Dec (radians) +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Notes: +** +** 1) The accuracy is limited by the routine slaEvp, called +** by slaMappa, which computes the Earth position and +** velocity using the methods of Stumpff. The maximum +** error is about 0.3 milliarcsecond. +** +** 2) Iterative techniques are used for the aberration and +** light deflection corrections so that the routines +** slaAmp (or slaAmpqk) and slaMap (or slaMapqk) are +** accurate inverses; even at the edge of the Sun's disc +** the discrepancy is only about 1 nanoarcsecond. +** +** Called: slaDcs2c, slaDimxv, slaDvdv, slaDvn, slaDcc2s, +** slaDranrm +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double gr2e; /* (grav rad Sun)*2/(Sun-Earth distance) */ + double ab1; /* sqrt(1-v*v) where v=modulus of Earth vel */ + double ehn[3]; /* Earth position wrt Sun (unit vector, FK5) */ + double abv[3]; /* Earth velocity wrt SSB (c, FK5) */ + double p[3], p1[3], p2[3], p3[3]; /* work vectors */ + double ab1p1, p1dv, p1dvp1, w, pde, pdep1; + int i, j; + +/* Unpack some of the parameters */ + gr2e = amprms[7]; + ab1 = amprms[11]; + for ( i = 0; i < 3; i++ ) { + ehn[i] = amprms[i + 4]; + abv[i] = amprms[i + 8]; + } + +/* Apparent RA,Dec to Cartesian */ + slaDcs2c ( ra, da, p3 ); + +/* Precession and nutation */ + slaDimxv ( (double(*)[3]) &rms[12], p3, p2 ); + +/* Aberration */ + ab1p1 = ab1 + 1.0; + for ( i = 0; i < 3; i++ ) { + p1[i] = p2[i]; + } + for ( j = 0; j < 2; j++ ) { + p1dv = slaDvdv ( p1, abv ); + p1dvp1 = 1.0 + p1dv; + w = 1.0 + p1dv / ab1p1; + for ( i = 0; i < 3; i++ ) { + p1[i] = ( p1dvp1 * p2[i] - w * abv[i] ) / ab1; + } + slaDvn ( p1, p3, &w ); + for ( i = 0; i < 3; i++ ) { + p1[i] = p3[i]; + } + } + +/* Light deflection */ + for ( i = 0; i < 3; i++ ) { + p[i] = p1[i]; + } + for ( j = 0; j < 5; j++ ) { + pde = slaDvdv ( p, ehn ); + pdep1 = 1.0 + pde; + w = pdep1 - gr2e * pde; + for ( i = 0; i < 3; i++ ) { + p[i] = ( pdep1 * p1[i] - gr2e * ehn[i] ) / w; + } + slaDvn ( p, p2, &w ); + for ( i = 0; i < 3; i++ ) { + p[i] = p2[i]; + } + } + +/* Mean RA,Dec */ + slaDcc2s ( p, rm, dm ); + *rm = slaDranrm ( *rm ); +} Index: trunk/MagicSoft/slalib/aop.c =================================================================== --- trunk/MagicSoft/slalib/aop.c (revision 731) +++ trunk/MagicSoft/slalib/aop.c (revision 731) @@ -0,0 +1,173 @@ +#include "slalib.h" +#include "slamac.h" +void slaAop ( double rap, double dap, double date, double dut, + double elongm, double phim, double hm, + double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, + double *aob, double *zob, + double *hob, double *dob, + double *rob ) +/* +** - - - - - - - +** s l a A o p +** - - - - - - - +** +** Apparent to observed place, for optical sources distant from +** the solar system. +** +** Given: +** rap double geocentric apparent right ascension +** dap double geocentric apparent declination +** date double UTC date/time (Modified Julian Date, JD-2400000.5) +** dut double delta UT: UT1-UTC (UTC seconds) +** elongm double mean longitude of the observer (radians, east +ve) +** phim double mean geodetic latitude of the observer (radians) +** hm double observer's height above sea level (metres) +** xp double polar motion x-coordinate (radians) +** yp double polar motion y-coordinate (radians) +** tdk double local ambient temperature (DegK; std=273.155) +** pmb double local atmospheric pressure (mB; std=1013.25) +** rh double local relative humidity (in the range 0.0-1.0) +** wl double effective wavelength (micron, e.g. 0.55) +** tlr double tropospheric lapse rate (DegK/metre, e.g. 0.0065) +** +** Returned: +** aob double observed azimuth (radians: N=0,E=90) +** zob double observed zenith distance (radians) +** hob double observed Hour Angle (radians) +** dob double observed Declination (radians) +** rob double observed Right Ascension (radians) +** +** Notes: +** +** 1) This routine returns zenith distance rather than elevation +** in order to reflect the fact that no allowance is made for +** depression of the horizon. +** +** 2) The accuracy of the result is limited by the corrections for +** refraction. Providing the meteorological parameters are +** known accurately and there are no gross local effects, the +** predicted apparent RA,Dec should be within about 0.1 arcsec +** for a zenith distance of less than 70 degrees. Even at a +** topocentric zenith distance of 90 degrees, the accuracy in +** elevation should be better than 1 arcmin; useful results +** are available for a further 3 degrees, beyond which the +** slaRefro routine returns a fixed value of the refraction. +** The complementary routines slaAop (or slaAopqk) and slaOap +** (or slaOapqk) are self-consistent to better than 1 micro- +** arcsecond all over the celestial sphere. +** +** 3) It is advisable to take great care with units, as even +** unlikely values of the input parameters are accepted and +** processed in accordance with the models used. +** +** 4) "Apparent" place means the geocentric apparent right ascension +** and declination, which is obtained from a catalogue mean place +** by allowing for space motion, parallax, precession, nutation, +** annual aberration, and the Sun's gravitational lens effect. For +** star positions in the FK5 system (i.e. J2000), these effects can +** be applied by means of the slaMap etc routines. Starting from +** other mean place systems, additional transformations will be +** needed; for example, FK4 (i.e. B1950) mean places would first +** have to be converted to FK5, which can be done with the +** slaFk425 etc routines. +** +** 5) "Observed" Az,El means the position that would be seen by a +** perfect theodolite located at the observer. This is obtained +** from the geocentric apparent RA,Dec by allowing for Earth +** orientation and diurnal aberration, rotating from equator +** to horizon coordinates, and then adjusting for refraction. +** The HA,Dec is obtained by rotating back into equatorial +** coordinates, using the geodetic latitude corrected for polar +** motion, and is the position that would be seen by a perfect +** equatorial located at the observer and with its polar axis +** aligned to the Earth's axis of rotation (n.b. not to the +** refracted pole). Finally, the RA is obtained by subtracting +** the HA from the local apparent ST. +** +** 6) To predict the required setting of a real telescope, the +** observed place produced by this routine would have to be +** adjusted for the tilt of the azimuth or polar axis of the +** mounting (with appropriate corrections for mount flexures), +** for non-perpendicularity between the mounting axes, for the +** position of the rotator axis and the pointing axis relative +** to it, for tube flexure, for gear and encoder errors, and +** finally for encoder zero points. Some telescopes would, of +** course, exhibit other properties which would need to be +** accounted for at the appropriate point in the sequence. +** +** 7) This routine takes time to execute, due mainly to the +** rigorous integration used to evaluate the refraction. +** For processing multiple stars for one location and time, +** call slaAoppa once followed by one call per star to slaAopqk. +** Where a range of times within a limited period of a few hours +** is involved, and the highest precision is not required, call +** slaAoppa once, followed by a call to slaAoppat each time the +** time changes, followed by one call per star to slaAopqk. +** +** 8) The date argument is UTC expressed as an MJD. This is, +** strictly speaking, wrong, because of leap seconds. However, +** as long as the delta UT and the UTC are consistent there +** are no difficulties, except during a leap second. In this +** case, the start of the 61st second of the final minute should +** begin a new MJD day and the old pre-leap delta UT should +** continue to be used. As the 61st second completes, the MJD +** should revert to the start of the day as, simultaneously, +** the delta UTC changes by one second to its post-leap new value. +** +** 9) The delta UT (UT1-UTC) is tabulated in IERS circulars and +** elsewhere. It increases by exactly one second at the end of +** each UTC leap second, introduced in order to keep delta UT +** within +/- 0.9 seconds. +** +** 10) IMPORTANT -- TAKE CARE WITH THE LONGITUDE SIGN CONVENTION. +** The longitude required by the present routine is east-positive, +** in accordance with geographical convention (and right-handed). +** In particular, note that the longitudes returned by the +** slaObs routine are west-positive, following astronomical +** usage, and must be reversed in sign before use in the present +** routine. +** +** 11) The polar coordinates xp,yp can be obtained from IERS +** circulars and equivalent publications. The maximum amplitude +** is about 0.3 arcseconds. If xp,yp values are unavailable, +** use xp=yp=0.0. See page B60 of the 1988 Astronomical Almanac +** for a definition of the two angles. +** +** 12) The height above sea level of the observing station, hm, +** can be obtained from the Astronomical Almanac (Section J +** in the 1988 edition), or via the routine slaObs. If p, +** the pressure in millibars, is available, an adequate +** estimate of hm can be obtained from the expression +** +** hm = -29.3 * tsl * log ( p / 1013.25 ); +** +** where tsl is the approximate sea-level air temperature +** in deg K (See Astrophysical Quantities, C.W.Allen, +** 3rd edition, section 52). Similarly, if the pressure p +** is not known, it can be estimated from the height of the +** observing station, hm as follows: +** +** p = 1013.25 * exp ( -hm / ( 29.3 * tsl ) ); +** +** Note, however, that the refraction is proportional to the +** pressure and that an accurate p value is important for +** precise work. +** +** 13) The azimuths etc produced by the present routine are with +** respect to the celestial pole. Corrections to the terrestrial +** pole can be computed using slaPolmo. +** +** Called: slaAoppa, slaAopqk +** +** Last revision: 6 September 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double aoprms[14]; + + slaAoppa ( date, dut, elongm, phim, hm, xp, + yp, tdk, pmb, rh, wl, tlr, aoprms ); + slaAopqk ( rap, dap, aoprms, aob, zob, hob, dob, rob ); +} Index: trunk/MagicSoft/slalib/aoppa.c =================================================================== --- trunk/MagicSoft/slalib/aoppa.c (revision 731) +++ trunk/MagicSoft/slalib/aoppa.c (revision 731) @@ -0,0 +1,157 @@ +#include "slalib.h" +#include "slamac.h" +void slaAoppa ( double date, double dut, double elongm, double phim, + double hm, double xp, double yp, double tdk, + double pmb, double rh, double wl, double tlr, + double aoprms[14] ) +/* +** - - - - - - - - - +** s l a A o p p a +** - - - - - - - - - +** +** Precompute apparent to observed place parameters required by +** slaAopqk and slaOapqk. +** +** Given: +** date d UTC date/time (Modified Julian Date, JD-2400000.5) +** dut d delta UT: UT1-UTC (UTC seconds) +** elongm d mean longitude of the observer (radians, east +ve) +** phim d mean geodetic latitude of the observer (radians) +** hm d observer's height above sea level (metres) +** xp d polar motion x-coordinate (radians) +** yp d polar motion y-coordinate (radians) +** tdk d local ambient temperature (DegK; std=273.155) +** pmb d local atmospheric pressure (mB; std=1013.25) +** rh d local relative humidity (in the range 0.0-1.0) +** wl d effective wavelength (micron, e.g. 0.55) +** tlr d tropospheric lapse rate (DegK/metre, e.g. 0.0065) +** +** Returned: +** aoprms d[14] star-independent apparent-to-observed parameters: +** +** (0) geodetic latitude (radians) +** (1,2) sine and cosine of geodetic latitude +** (3) magnitude of diurnal aberration vector +** (4) height (hm) +** (5) ambient temperature (tdk) +** (6) pressure (pmb) +** (7) relative humidity (rh) +** (8) wavelength (wl) +** (9) lapse rate (tlr) +** (10,11) refraction constants A and B (radians) +** (12) longitude + eqn of equinoxes + sidereal DUT (radians) +** (13) local apparent sidereal time (radians) +** +** Notes: +** +** 1) It is advisable to take great care with units, as even +** unlikely values of the input parameters are accepted and +** processed in accordance with the models used. +** +** 2) The date argument is UTC expressed as an MJD. This is, +** strictly speaking, improper, because of leap seconds. However, +** as long as the delta UT and the UTC are consistent there +** are no difficulties, except during a leap second. In this +** case, the start of the 61st second of the final minute should +** begin a new MJD day and the old pre-leap delta UT should +** continue to be used. As the 61st second completes, the MJD +** should revert to the start of the day as, simultaneously, +** the delta UTC changes by one second to its post-leap new value. +** +** 3) The delta UT (UT1-UTC) is tabulated in IERS circulars and +** elsewhere. It increases by exactly one second at the end of +** each UTC leap second, introduced in order to keep delta UT +** within +/- 0.9 seconds. +** +** 4) IMPORTANT -- TAKE CARE WITH THE LONGITUDE SIGN CONVENTION. +** The longitude required by the present routine is east-positive, +** in accordance with geographical convention (and right-handed). +** In particular, note that the longitudes returned by the +** slaObs routine are west-positive, following astronomical +** usage, and must be reversed in sign before use in the present +** routine. +** +** 5) The polar coordinates xp,yp can be obtained from IERS +** circulars and equivalent publications. The maximum amplitude +** is about 0.3 arcseconds. If xp,yp values are unavailable, +** use xp=yp=0.0. See page B60 of the 1988 Astronomical Almanac +** for a definition of the two angles. +** +** 6) The height above sea level of the observing station, hm, +** can be obtained from the Astronomical Almanac (Section J +** in the 1988 edition), or via the routine slaObs. If p, +** the pressure in millibars, is available, an adequate +** estimate of hm can be obtained from the expression +** +** hm = -29.3 * tsl * log ( p / 1013.25 ); +** +** where tsl is the approximate sea-level air temperature +** in deg K (See Astrophysical Quantities, C.W.Allen, +** 3rd edition, section 52). Similarly, if the pressure p +** is not known, it can be estimated from the height of the +** observing station, hm as follows: +** +** p = 1013.25 * exp ( -hm / ( 29.3 * tsl ) ); +** +** Note, however, that the refraction is proportional to the +** pressure and that an accurate p value is important for +** precise work. +** +** 7) Repeated, computationally-expensive, calls to slaAoppa for +** times that are very close together can be avoided by calling +** slaAoppa just once and then using slaAoppat for the subsequent +** times. Fresh calls to slaAoppa will be needed only when changes +** in the precession have grown to unacceptable levels or when +** anything affecting the refraction has changed. +** +** Defined in slamac.h: D2PI, DS2R +** +** Called: slaGeoc, slaRefco, slaEqeqx, slaAoppat +** +** Last revision: 6 September 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define C 173.14463331 /* Speed of light (AU per day) */ +#define SOLSID 1.00273790935 /* Ratio between solar and sidereal time */ + +{ + double cphim, xt, yt, zt, xc, yc, zc, elong, phi, uau, vau; + +/* Observer's location corrected for polar motion */ + cphim = cos( phim ); + xt = cos ( elongm ) * cphim; + yt = sin ( elongm ) * cphim; + zt = sin ( phim ); + xc = xt - xp * zt; + yc = yt + yp * zt; + zc = xp * xt - yp * yt + zt; + + elong = ( ( xc == 0.0 ) && ( yc == 0.0 ) ) ? 0.0 : atan2 ( yc, xc ); + + phi = atan2 ( zc, sqrt ( xc * xc + yc * yc ) ); + aoprms[0] = phi; + aoprms[1] = sin ( phi ); + aoprms[2] = cos ( phi ); + +/* Magnitude of the diurnal aberration vector */ + slaGeoc ( phi, hm, &uau, &vau ); + aoprms[3] = D2PI * uau * SOLSID / C; + +/* Copy the refraction parameters and compute the A & B constants */ + aoprms[4] = hm; + aoprms[5] = tdk; + aoprms[6] = pmb; + aoprms[7] = rh; + aoprms[8] = wl; + aoprms[9] = tlr; + slaRefco ( hm, tdk, pmb, rh, wl, phi, tlr, 1e-10, + &aoprms[10], &aoprms[11] ); + +/* Longitude + equation of the equinoxes + sidereal equivalent of DUT */ + aoprms[12] = elong + slaEqeqx ( date ) + dut * SOLSID * DS2R; + +/* Sidereal time */ + slaAoppat ( date, aoprms ); +} Index: trunk/MagicSoft/slalib/aoppat.c =================================================================== --- trunk/MagicSoft/slalib/aoppat.c (revision 731) +++ trunk/MagicSoft/slalib/aoppat.c (revision 731) @@ -0,0 +1,37 @@ +#include "slalib.h" +#include "slamac.h" +void slaAoppat ( double date, double aoprms[14] ) +/* +** - - - - - - - - - - +** s l a A o p p a t +** - - - - - - - - - - +** +** Recompute the sidereal time in the apparent to observed place +** star-independent parameter block. +** +** Given: +** date double UTC date/time (Modified Julian Date, JD-2400000.5) +** (see slaAoppa source for comments on leap seconds) +** aoprms double[14] star-independent apparent-to-observed parameters +** +** (0-11) not required +** (12) longitude + eqn of equinoxes + sidereal dut +** (13) not required +** +** Returned: +** aoprms double[14] star-independent apparent-to-observed parameters: +** +** (0-12) not changed +** (13) local apparent sidereal time (radians) +** +** For more information, see slaAoppa. +** +** Called: slaGmst +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + aoprms[13] = slaGmst ( date ) + aoprms[12]; +} Index: trunk/MagicSoft/slalib/aopqk.c =================================================================== --- trunk/MagicSoft/slalib/aopqk.c (revision 731) +++ trunk/MagicSoft/slalib/aopqk.c (revision 731) @@ -0,0 +1,236 @@ +#include "slalib.h" +#include "slamac.h" +void slaAopqk ( double rap, double dap, double aoprms[14], + double *aob, double *zob, double *hob, + double *dob, double *rob ) +/* +** - - - - - - - - - +** s l a A o p q k +** - - - - - - - - - +** +** Quick apparent to observed place (but see note 8, below, for +** remarks about speed). +** +** Given: +** rap double geocentric apparent right ascension +** dap double geocentric apparent declination +** aoprms double[14] star-independent apparent-to-observed parameters: +** +** (0) geodetic latitude (radians) +** (1,2) sine and cosine of geodetic latitude +** (3) magnitude of diurnal aberration vector +** (4) height (hm) +** (5) ambient temperature (t) +** (6) pressure (p) +** (7) relative humidity (rh) +** (8) wavelength (wl) +** (9) lapse rate (tlr) +** (10,11) refraction constants A and B (radians) +** (12) longitude + eqn of equinoxes + sidereal DUT (radians) +** (13) local apparent sidereal time (radians) +** +** Returned: +** *aob double observed azimuth (radians: N=0,E=90) +** *zob double observed zenith distance (radians) +** *hob double observed hour angle (radians) +** *dob double observed declination (radians) +** *rob double observed right ascension (radians) +** +** Notes: +** +** 1) This routine returns zenith distance rather than elevation +** in order to reflect the fact that no allowance is made for +** depression of the horizon. +** +** 2) The accuracy of the result is limited by the corrections for +** refraction. Providing the meteorological parameters are +** known accurately and there are no gross local effects, the +** observed RA,Dec predicted by this routine should be within +** about 0.1 arcsec for a zenith distance of less than 70 degrees. +** Even at a topocentric zenith distance of 90 degrees, the +** accuracy in elevation should be better than 1 arcmin; useful +** results are available for a further 3 degrees, beyond which +** the slaRefro routine returns a fixed value of the refraction. +** The complementary routines slaAop (or slaAopqk) and slaOap +** (or slaOapqk) are self-consistent to better than 1 micro- +** arcsecond all over the celestial sphere. +** +** 3) It is advisable to take great care with units, as even +** unlikely values of the input parameters are accepted and +** processed in accordance with the models used. +** +** 4) "Apparent" place means the geocentric apparent right ascension +** and declination, which is obtained from a catalogue mean place +** by allowing for space motion, parallax, precession, nutation, +** annual aberration, and the Sun's gravitational lens effect. For +** star positions in the FK5 system (i.e. J2000), these effects can +** be applied by means of the slaMap etc routines. Starting from +** other mean place systems, additional transformations will be +** needed; for example, FK4 (i.e. B1950) mean places would first +** have to be converted to FK5, which can be done with the +** slaFk425 etc routines. +** +** 5) "Observed" Az,El means the position that would be seen by a +** perfect theodolite located at the observer. This is obtained +** from the geocentric apparent RA,Dec by allowing for Earth +** orientation and diurnal aberration, rotating from equator +** to horizon coordinates, and then adjusting for refraction. +** The HA,Dec is obtained by rotating back into equatorial +** coordinates, using the geodetic latitude corrected for polar +** motion, and is the position that would be seen by a perfect +** equatorial located at the observer and with its polar axis +** aligned to the Earth's axis of rotation (n.b. not to the +** refracted pole). Finally, the RA is obtained by subtracting +** the HA from the local apparent ST. +** +** 6) To predict the required setting of a real telescope, the +** observed place produced by this routine would have to be +** adjusted for the tilt of the azimuth or polar axis of the +** mounting (with appropriate corrections for mount flexures), +** for non-perpendicularity between the mounting axes, for the +** position of the rotator axis and the pointing axis relative +** to it, for tube flexure, for gear and encoder errors, and +** finally for encoder zero points. Some telescopes would, of +** course, exhibit other properties which would need to be +** accounted for at the appropriate point in the sequence. +** +** 7) The star-independent apparent-to-observed-place parameters +** in aoprms may be computed by means of the slaAoppa routine. +** If nothing has changed significantly except the time, the +** slaAoppat routine may be used to perform the requisite +** partial recomputation of aoprms. +** +** 8) At zenith distances beyond about 76 degrees, the need for +** special care with the corrections for refraction causes a +** marked increase in execution time. Moreover, the effect +** gets worse with increasing zenith distance. Adroit +** programming in the calling application may allow the +** problem to be reduced. Prepare an alternative aoprms array, +** computed for zero air-pressure; this will disable the +** refraction corrections and cause rapid execution. Using +** this aoprms array, a preliminary call to the present routine +** will, depending on the application, produce a rough position +** which may be enough to establish whether the full, slow +** calculation (using the real aoprms array) is worthwhile. +** For example, there would be no need for the full calculation +** if the preliminary call had already established that the +** source was well below the elevation limits for a particular +** telescope. +** +** 9) The azimuths etc produced by the present routine are with +** respect to the celestial pole. Corrections to the terrestrial +** pole can be computed using slaPolmo. +** +** Called: slaDcs2c, slaRefz, slaRefro, slaDcc2s, slaDranrm +** +** Last revision: 22 February 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** Breakpoint for fast/slow refraction algorithm: +** ZD greater than arctan(4), (see slaRefco routine) +** or vector z less than cosine(arctan(z)) = 1/sqrt(17) +*/ + static double zbreak = 0.242535625; + + int i; + + double sphi, cphi, st, v[3], xhd, yhd, zhd, diurab, f, + xhdt, yhdt, zhdt, xaet, yaet, zaet, azobs, + zdt, refa, refb, zdobs, dzd, dref, ce, + xaeo, yaeo, zaeo, hmobs, dcobs, raobs; + +/* Sin, cos of latitude */ + sphi = aoprms[1]; + cphi = aoprms[2]; + +/* Local apparent sidereal time */ + st = aoprms[13]; + +/* Apparent RA,Dec to Cartesian -HA,Dec */ + slaDcs2c(rap - st, dap, v); + xhd = v[0]; + yhd = v[1]; + zhd = v[2]; + +/* Diurnal aberration */ + diurab = aoprms[3]; + f = 1.0 - diurab * yhd; + xhdt = f * xhd; + yhdt = f * ( yhd + diurab ); + zhdt = f * zhd; + +/* Cartesian -HA,Dec to Cartesian az,el (S=0,E=90) */ + xaet = sphi * xhdt - cphi * zhdt; + yaet = yhdt; + zaet = cphi * xhdt + sphi * zhdt; + +/* Azimuth (N=0,E=90) */ + azobs = ( (xaet == 0.0) && (yaet == 0.0) ) ? + 0.0 : atan2 ( yaet, -xaet ); + +/* Topocentric zenith distance */ + zdt = atan2 ( sqrt ( xaet * xaet + yaet * yaet ), zaet ); + +/* +** Refraction +** ---------- +*/ + +/* Fast algorithm using two constant model */ + refa = aoprms[10]; + refb = aoprms[11]; + slaRefz ( zdt, refa, refb, &zdobs ); + +/* Large zenith distance? */ + if ( cos ( zdobs ) < zbreak ) { + + /* Yes: use rigorous algorithm */ + + /* Initialize loop (maximum of 10 iterations) */ + i = 1; + do { + + /* Compute refraction using current estimate of observed ZD */ + slaRefro ( zdobs, aoprms[4], aoprms[5], aoprms[6], + aoprms[7], aoprms[8], aoprms[0], + aoprms[9], 1e-8, &dref ); + + /* Remaining discrepancy */ + dzd = zdobs + dref - zdt; + + /* Update the estimate */ + zdobs -= dzd; + + /* Increment the iteration counter */ + i++; + + } while ( fabs ( dzd ) > 1e-10 && i <= 10 ); + } + +/* To Cartesian az/ZD */ + ce = sin ( zdobs ); + xaeo = -cos ( azobs ) * ce; + yaeo = sin ( azobs ) * ce; + zaeo = cos ( zdobs ); + +/* Cartesian az/ZD to Cartesian -HA,Dec */ + v[0] = sphi * xaeo + cphi * zaeo; + v[1] = yaeo; + v[2] = -cphi * xaeo + sphi * zaeo; + +/* To spherical -HA,dec */ + slaDcc2s ( v, &hmobs, &dcobs ); + +/* Right ascension */ + raobs = slaDranrm ( st + hmobs ); + +/* Return the results */ + *aob = azobs; + *zob = zdobs; + *hob = -hmobs; + *dob = dcobs; + *rob = raobs; +} Index: trunk/MagicSoft/slalib/atmdsp.c =================================================================== --- trunk/MagicSoft/slalib/atmdsp.c (revision 731) +++ trunk/MagicSoft/slalib/atmdsp.c (revision 731) @@ -0,0 +1,123 @@ +#include "slalib.h" +#include "slamac.h" +void slaAtmdsp ( double tdk, double pmb, double rh, double wl1, + double a1, double b1, double wl2, double *a2, double *b2 ) +/* +** - - - - - - - - - - +** s l a A t m d s p +** - - - - - - - - - - +** +** Apply atmospheric-dispersion adjustments to refraction coefficients. +** +** Given: +** tdk double ambient temperature, degrees K +** pmb double ambient pressure, millibars +** rh double ambient relative humidity, 0-1 +** wl1 double reference wavelength, micrometre (0.4 recommended) +** a1 double refraction coefficient A for wavelength wl1 (radians) +** b1 double refraction coefficient B for wavelength wl1 (radians) +** wl2 double wavelength for which adjusted A,B required +** +** Returned: +** *a2 double refraction coefficient A for wavelength wl2 (radians) +** *b2 double refraction coefficient B for wavelength wl2 (radians) +** +** Notes: +** +** 1 To use this routine, first call slaRefco specifying wl1 as the +** wavelength. This yields refraction coefficients a1,b1, correct +** for that wavelength. Subsequently, calls to slaAtmdsp specifying +** different wavelengths will produce new, slightly adjusted +** refraction coefficients which apply to the specified wavelength. +** +** 2 Most of the atmospheric dispersion happens between 0.7 micrometre +** and the UV atmospheric cutoff, and the effect increases strongly +** towards the UV end. For this reason a blue reference wavelength +** is recommended, for example 0.4 micrometres. +** +** 3 The accuracy, for this set of conditions: +** +** height above sea level 2000 m +** latitude 29 deg +** pressure 793 mB +** temperature 17 degC +** humidity 50% +** lapse rate 0.0065 degC/m +** reference wavelength 0.4 micrometre +** star elevation 15 deg +** +** is about 2.5 mas RMS between 0.3 and 1.0 micrometres, and stays +** within 4 mas for the whole range longward of 0.3 micrometres +** (compared with a total dispersion from 0.3 to 20.0 micrometres +** of about 11 arcsec). These errors are typical for ordinary +** conditions and the given elevation; in extreme conditions values +** a few times this size may occur, while at higher elevations the +** errors become much smaller. +** +** 4 If either wavelength exceeds 100 micrometres, the radio case +** is assumed and the returned refraction coefficients are the +** same as the given ones. +** +** 5 The algorithm consists of calculation of the refractivity of the +** air at the observer for the two wavelengths, using the methods +** of the slaRefro routine, and then scaling of the two refraction +** coefficients according to classical refraction theory. This +** amounts to scaling the A coefficient in proportion to (n-1) and +** the B coefficient almost in the same ratio (see R.M.Green, +** "Spherical Astronomy", Cambridge University Press, 1985). +** +** Last revision: 25 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double tdkok, pmbok, rhok, psat, pwo, w1, wlok, wlsq, w2, dn1, dn2, f; + + +/* Check for radio wavelengths. */ + if ( wl1 > 100.0 || wl2 > 100.0 ) { + + /* Radio: no dispersion. */ + *a2 = a1; + *b2 = b1; + } else { + + /* Optical: keep arguments within safe bounds. */ + tdkok = gmax ( tdk, 100.0 ); + tdkok = gmin ( tdkok, 500.0 ); + pmbok = gmax ( pmb, 0.0 ); + pmbok = gmin ( pmbok, 10000.0 ); + rhok = gmax ( rh, 0.0 ); + rhok = gmin ( rhok, 1.0 ); + + /* Atmosphere parameters at the observer. */ + psat = pow ( 10.0, -8.7115 + 0.03477 * tdkok ); + pwo = rhok * psat; + w1 = 11.2684e-6 * pwo; + + /* Refractivity at the observer for first wavelength. */ + wlok = gmax ( wl1, 0.1 ); + wlsq = wlok * wlok; + w2 = 77.5317e-6 + ( 0.43909e-6 + 0.00367e-6 / wlsq ) / wlsq; + dn1 = ( w2 * pmbok - w1 ) / tdkok; + + /* Refractivity at the observer for second wavelength. */ + wlok = gmax ( wl2, 0.1 ); + wlsq = wlok * wlok; + w2 = 77.5317e-6 + ( 0.43909e-6 + 0.00367e-6 / wlsq ) / wlsq; + dn2 = ( w2 * pmbok - w1 ) / tdkok; + + /* Scale the refraction coefficients (see Green 4.31, p93). */ + if ( dn1 != 0.0 ) { + f = dn2 / dn1; + *a2 = a1 * f; + *b2 = b1 * f; + if ( dn1 != a1 ) + *b2 = *b2 * ( 1.0 + dn1 * ( dn1 - dn2 ) / + ( 2.0 * ( dn1 - a1 ) ) ); + } else { + *a2 = a1; + *b2 = b1; + } + } +} Index: trunk/MagicSoft/slalib/av2m.c =================================================================== --- trunk/MagicSoft/slalib/av2m.c (revision 731) +++ trunk/MagicSoft/slalib/av2m.c (revision 731) @@ -0,0 +1,63 @@ +#include "slalib.h" +#include "slamac.h" +void slaAv2m ( float axvec[3], float rmat[3][3] ) +/* +** - - - - - - - - +** s l a A v 2 m +** - - - - - - - - +** +** Form the rotation matrix corresponding to a given axial vector. +** +** (single precision) +** +** A rotation matrix describes a rotation about some arbitrary axis. +** The axis is called the Euler axis, and the angle through which the +** reference frame rotates is called the Euler angle. The axial +** vector supplied to this routine has the same direction as the +** Euler axis, and its magnitude is the Euler angle in radians. +** +** Given: +** axvec float[3] axial vector (radians) +** +** Returned: +** rmat float[3][3] rotation matrix +** +** If axvec is null, the unit matrix is returned. +** +** The reference frame rotates clockwise as seen looking along +** the axial vector from the origin. +** +** Last revision: 25 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, phi, s, c, w; + +/* Euler angle - magnitude of axial vector - and functions */ + x = (double) axvec[0]; + y = (double) axvec[1]; + z = (double) axvec[2]; + phi = sqrt ( x * x + y * y + z * z ); + s = sin ( phi ); + c = cos ( phi ); + w = 1.0 - c; + +/* Euler axis - direction of axial vector (perhaps null) */ + if ( phi != 0.0 ) { + x = x / phi; + y = y / phi; + z = z / phi; + } + +/* Compute the rotation matrix */ + rmat[0][0] = (float) ( x * x * w + c ); + rmat[0][1] = (float) ( x * y * w + z * s ); + rmat[0][2] = (float) ( x * z * w - y * s ); + rmat[1][0] = (float) ( x * y * w - z * s ); + rmat[1][1] = (float) ( y * y * w + c ); + rmat[1][2] = (float) ( y * z * w + x * s ); + rmat[2][0] = (float) ( x * z * w + y * s ); + rmat[2][1] = (float) ( y * z * w - x * s ); + rmat[2][2] = (float) ( z * z * w + c ); +} Index: trunk/MagicSoft/slalib/bear.c =================================================================== --- trunk/MagicSoft/slalib/bear.c (revision 731) +++ trunk/MagicSoft/slalib/bear.c (revision 731) @@ -0,0 +1,42 @@ +#include "slalib.h" +#include "slamac.h" +float slaBear ( float a1, float b1, float a2, float b2 ) +/* +** - - - - - - - - +** s l a B e a r +** - - - - - - - - +** +** Bearing (position angle) of one point on a sphere relative +** to another. +** +** (single precision) +** +** Given: +** a1,b1 float spherical coordinates of one point +** a2,b2 float spherical coordinates of the other point +** +** (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.) +** +** The result is the bearing (position angle), in radians, of point +** a2,b2 as seen from point a1,b1. It is in the range +/- pi. The +** sense is such that if a2,b2 is a small distance east of a1,b1, +** the bearing is about +pi/2. Zero is returned if the two points +** are coincident. +** +** If either b-coordinate is outside the range +/- pi/2, the +** result may correspond to "the long way round". +** +** The routine slaPav performs an equivalent function except +** that the points are specified in the form of Cartesian unit +** vectors. +** +** Called: slaDbear +** +** Last revision: 8 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return (float) slaDbear ( (double) a1, (double) b1, + (double) a2, (double) b2 ); +} Index: trunk/MagicSoft/slalib/caf2r.c =================================================================== --- trunk/MagicSoft/slalib/caf2r.c (revision 731) +++ trunk/MagicSoft/slalib/caf2r.c (revision 731) @@ -0,0 +1,42 @@ +#include "slalib.h" +#include "slamac.h" +void slaCaf2r ( int ideg, int iamin, float asec, float *rad, int *j ) +/* +** - - - - - - - - - +** s l a C a f 2 r +** - - - - - - - - - +** +** Convert degrees, arcminutes, arcseconds to radians. +** +** (single precision) +** +** Given: +** ideg int degrees +** iamin int arcminutes +** asec float arcseconds +** +** Returned: +** *rad float angle in radians +** *j int status: 0 = ok +** 1 = ideg outside range 0-359 +** 2 = iamin outside range 0-59 +** 3 = asec outside range 0-59.999... +** +** Notes: +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Called: slaDaf2r +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double w; + +/* Call double precision version */ + slaDaf2r ( ideg, iamin, (double) asec, &w, j ); + *rad = (float) w; +} Index: trunk/MagicSoft/slalib/caldj.c =================================================================== --- trunk/MagicSoft/slalib/caldj.c (revision 731) +++ trunk/MagicSoft/slalib/caldj.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaCaldj ( int iy, int im, int id, double *djm, int *j ) +/* +** - - - - - - - - - +** s l a C a l d j +** - - - - - - - - - +** +** Gregorian calendar to Modified Julian Date. +** +** (Includes century default feature: use slaCldj for years +** before 100AD.) +** +** Given: +** iy,im,id int year, month, day in Gregorian calendar +** +** Returned: +** *djm double Modified Julian Date (JD-2400000.5) for 0 hrs +** *j int status: +** 0 = ok +** 1 = bad year (MJD not computed) +** 2 = bad month (MJD not computed) +** 3 = bad day (MJD computed) +** +** Acceptable years are 00-49, interpreted as 2000-2049, +** 50-99, " " 1950-1999, +** 100 upwards, interpreted literally. +** +** Called: slaCldj +** +** Last revision: 21 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int ny; + +/* Default century if appropriate */ + if ( ( iy >= 0 ) && ( iy <= 49 ) ) + ny = iy + 2000; + else if ( ( iy >= 50 ) && ( iy <= 99 ) ) + ny = iy + 1900; + else + ny = iy; + +/* Modified Julian Date */ + slaCldj ( ny, im, id, djm, j ); +} Index: trunk/MagicSoft/slalib/calyd.c =================================================================== --- trunk/MagicSoft/slalib/calyd.c (revision 731) +++ trunk/MagicSoft/slalib/calyd.c (revision 731) @@ -0,0 +1,59 @@ +#include "slalib.h" +#include "slamac.h" +void slaCalyd ( int iy, int im, int id, int *ny, int *nd, int *j ) +/* +** - - - - - - - - - +** s l a C a l y d +** - - - - - - - - - +** +** Gregorian calendar date to year and day in year (in a Julian +** calendar aligned to the 20th/21st century Gregorian calendar). +** +** (Includes century default feature: use slaClyd for years +** before 100AD.) +** +** Given: +** iy,im,id int year, month, day in Gregorian calendar +** (year may optionally omit the century) +** Returned: +** *ny int year (re-aligned Julian calendar) +** *nd int day in year (1 = January 1st) +** *j int status: +** 0 = OK +** 1 = bad year (before -4711) +** 2 = bad month +** 3 = bad day (but conversion performed) +** +** Notes: +** +** 1 This routine exists to support the low-precision routines +** slaEarth, slaMoon and slaEcor. +** +** 2 Between 1900 March 1 and 2100 February 28 it returns answers +** which are consistent with the ordinary Gregorian calendar. +** Outside this range there will be a discrepancy which increases +** by one day for every non-leap century year. +** +** 3 Years in the range 50-99 are interpreted as 1950-1999, and +** years in the range 00-49 are interpreted as 2000-2049. +** +** Called: slaClyd +** +** Last revision: 22 September 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + +/* Default century if appropriate */ + if ( ( iy >= 0 ) && ( iy <= 49 ) ) + i = iy + 2000; + else if ( ( iy >= 50 ) && ( iy <= 99 ) ) + i = iy + 1900; + else + i = iy; + +/* Perform the conversion */ + slaClyd ( i, im, id, ny, nd, j ); +} Index: trunk/MagicSoft/slalib/cc2s.c =================================================================== --- trunk/MagicSoft/slalib/cc2s.c (revision 731) +++ trunk/MagicSoft/slalib/cc2s.c (revision 731) @@ -0,0 +1,42 @@ +#include "slalib.h" +#include "slamac.h" +void slaCc2s ( float v[3], float *a, float *b ) +/* +** - - - - - - - - +** s l a C c 2 s +** - - - - - - - - +** +** Direction cosines to spherical coordinates. +** +** (single precision) +** +** Given: +** v float[3] x,y,z vector +** +** Returned: +** *a,*b float spherical coordinates in radians +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** If v is null, zero a and b are returned. +** At either pole, zero a is returned. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, r; + + x = (double) v[0]; + y = (double) v[1]; + z = (double) v[2]; + r = sqrt ( x * x + y * y ); + + *a = ( r == 0.0 ) ? 0.0f : (float) atan2 ( y, x ); + *b = ( z == 0.0 ) ? 0.0f : (float) atan2 ( z, r ); +} Index: trunk/MagicSoft/slalib/cc62s.c =================================================================== --- trunk/MagicSoft/slalib/cc62s.c (revision 731) +++ trunk/MagicSoft/slalib/cc62s.c (revision 731) @@ -0,0 +1,71 @@ +#include "slalib.h" +#include "slamac.h" +void slaCc62s ( float v[6], + float *a, float *b, float *r, + float *ad, float *bd, float *rd ) +/* +** - - - - - - - - - +** s l a C c 6 2 s +** - - - - - - - - - +** +** Conversion of position & velocity in Cartesian coordinates +** to spherical coordinates. +** +** (single precision) +** +** Given: +** v float[6] Cartesian position & velocity vector +** +** Returned: +** *a float longitude (radians) +** *b float latitude (radians) +** *r float radial coordinate +** *ad float longitude derivative (radians per unit time) +** *bd float latitude derivative (radians per unit time) +** *rd float radial derivative +** +** Last revision: 28 April 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, xd, yd, zd, rxy2, rxy, r2, xyp, dr; + + +/* Components of position/velocity vector. */ + x = v[0]; + y = v[1]; + z = v[2]; + xd = v[3]; + yd = v[4]; + zd = v[5]; + +/* Component of R in XY plane squared. */ + rxy2 = x * x + y * y; + +/* Modulus squared, with protection against null vector. */ + if ( ( r2 = rxy2 + z * z ) == 0.0 ) { + x = xd; + y = yd; + z = zd; + rxy2 = x * x + y * y; + r2 = rxy2 + z * z; + } + +/* Position and velocity in spherical coordinates. */ + rxy = sqrt ( rxy2 ); + xyp = x * xd + y * yd; + if ( rxy2 != 0.0 ) { + *a = (float) atan2 ( y, x ); + *b = (float) atan2 ( z, rxy ); + *ad = (float) ( ( x * yd - y * xd ) / rxy2 ); + *bd = (float) ( ( zd * rxy2 - z * xyp ) / ( r2 * rxy ) ); + } else { + *a = 0.0f; + *b = (float) ( ( z != 0.0 ) ? atan2 ( z, rxy ) : 0.0 ); + *ad = 0.0f; + *bd = 0.0f; + } + *r = (float) ( dr = sqrt ( r2 ) ); + *rd = (float) ( ( dr != 0.0 ) ? ( xyp + z * zd ) / dr : 0.0 ); +} Index: trunk/MagicSoft/slalib/cd2tf.c =================================================================== --- trunk/MagicSoft/slalib/cd2tf.c (revision 731) +++ trunk/MagicSoft/slalib/cd2tf.c (revision 731) @@ -0,0 +1,30 @@ +#include "slalib.h" +#include "slamac.h" +void slaCd2tf ( int ndp, float days, char *sign, int ihmsf[4] ) +/* +** - - - - - - - - - +** s l a C d 2 t f +** - - - - - - - - - +** +** Convert an interval in days into hours, minutes, seconds. +** +** (single precision) +** +** Given: +** ndp int number of decimal places of seconds +** days float interval in days +** +** Returned: +** sign char* '+' or '-' +** ihmsf int[4] hours, minutes, seconds, fraction +** +** Called: slaDd2tf +** +** Last revision: 11 December 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Use double version */ + slaDd2tf ( ndp, (double) days, sign, ihmsf ); +} Index: trunk/MagicSoft/slalib/cldj.c =================================================================== --- trunk/MagicSoft/slalib/cldj.c (revision 731) +++ trunk/MagicSoft/slalib/cldj.c (revision 731) @@ -0,0 +1,62 @@ +#include "slalib.h" +#include "slamac.h" +void slaCldj ( int iy, int im, int id, double *djm, int *j ) +/* +** - - - - - - - - +** s l a C l d j +** - - - - - - - - +** +** Gregorian calendar to Modified Julian Date. +** +** Given: +** iy,im,id int year, month, day in Gregorian calendar +** +** Returned: +** *djm double Modified Julian Date (JD-2400000.5) for 0 hrs +** *j int status: +** 0 = OK +** 1 = bad year (MJD not computed) +** 2 = bad month (MJD not computed) +** 3 = bad day (MJD computed) +** +** The year must be -4699 (i.e. 4700BC) or later. +** +** The algorithm is derived from that of Hatcher 1984 (QJRAS 25, 53-55). +** +** Last revision: 29 August 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + long iyL, imL; + +/* Month lengths in days */ + static int mtab[12] = { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }; + + + +/* Validate year */ + if ( iy < -4699 ) { *j = 1; return; } + +/* Validate month */ + if ( ( im < 1 ) || ( im > 12 ) ) { *j = 2; return; } + +/* Allow for leap year */ + mtab[1] = ( ( ( iy % 4 ) == 0 ) && + ( ( ( iy % 100 ) != 0 ) || ( ( iy % 400 ) == 0 ) ) ) ? + 29 : 28; + +/* Validate day */ + *j = ( id < 1 || id > mtab[im-1] ) ? 3 : 0; + +/* Lengthen year and month numbers to avoid overflow */ + iyL = (long) iy; + imL = (long) im; + +/* Perform the conversion */ + *djm = (double) + ( ( 1461L * ( iyL - ( 12L - imL ) / 10L + 4712L ) ) / 4L + + ( 306L * ( ( imL + 9L ) % 12L ) + 5L ) / 10L + - ( 3L * ( ( iyL - ( 12L - imL ) / 10L + 4900L ) / 100L ) ) / 4L + + (long) id - 2399904L ); +} Index: trunk/MagicSoft/slalib/clyd.c =================================================================== --- trunk/MagicSoft/slalib/clyd.c (revision 731) +++ trunk/MagicSoft/slalib/clyd.c (revision 731) @@ -0,0 +1,84 @@ +#include "slalib.h" +#include "slamac.h" +void slaClyd ( int iy, int im, int id, int *ny, int *nd, int *jstat ) +/* +** - - - - - - - - +** s l a C l y d +** - - - - - - - - +** +** Gregorian calendar to year and day in year (in a Julian calendar +** aligned to the 20th/21st century Gregorian calendar). +** +** Given: +** iy,im,id int year, month, day in Gregorian calendar +** +** Returned: +** ny int year (re-aligned Julian calendar) +** nd int day in year (1 = January 1st) +** jstat int status: +** 0 = OK +** 1 = bad year (before -4711) +** 2 = bad month +** 3 = bad day (but conversion performed) +** +** Notes: +** +** 1 This routine exists to support the low-precision routines +** slaEarth, slaMoon and slaEcor. +** +** 2 Between 1900 March 1 and 2100 February 28 it returns answers +** which are consistent with the ordinary Gregorian calendar. +** Outside this range there will be a discrepancy which increases +** by one day for every non-leap century year. +** +** 3 The essence of the algorithm is first to express the Gregorian +** date as a Julian Day Number and then to convert this back to +** a Julian calendar date, with day-in-year instead of month and +** day. See 12.92-1 and 12.95-1 in the reference. +** +** Reference: Explanatory Supplement to the Astronomical Almanac, +** ed P.K.Seidelmann, University Science Books (1992), +** p604-606. +** +** Last revision: 26 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + long i, j, k, l, n, iyL, imL; + +/* Month lengths in days */ + static int mtab[12] = { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }; + + + +/* Validate year */ + if ( iy < -4711 ) { *jstat = 1; return; } + +/* Validate month */ + if ( ( im < 1 ) || ( im > 12 ) ) { *jstat = 2; return; } + +/* Allow for (Gregorian) leap year */ + mtab[1] = ( ( ( iy % 4 ) == 0 ) && + ( ( ( iy % 100 ) != 0 ) || ( ( iy % 400 ) == 0 ) ) ) ? + 29 : 28; + +/* Validate day */ + *jstat = ( id < 1 || id > mtab[im-1] ) ? 3 : 0; + +/* Perform the conversion */ + iyL = (long) iy; + imL = (long) im; + i = ( 14 - imL ) /12L; + k = iyL - i; + j = ( 1461L * ( k + 4800L ) ) / 4L + + ( 367L * ( imL - 2L + 12L * i ) ) / 12L + - ( 3L * ( ( k + 4900L ) / 100L ) ) / 4L + (long) id - 30660L; + k = ( j - 1L ) / 1461L; + l = j - 1461L * k; + n = ( l - 1L ) / 365L - l / 1461L; + j = ( ( 80L * ( l - 365L * n + 30L ) ) / 2447L ) / 11L; + i = n + j; + *nd = 59 + (int) ( l -365L * i + ( ( 4L - n ) / 4L ) * ( 1L - j ) ); + *ny = (int) ( 4L * k + i ) - 4716; +} Index: trunk/MagicSoft/slalib/combn.c =================================================================== --- trunk/MagicSoft/slalib/combn.c (revision 731) +++ trunk/MagicSoft/slalib/combn.c (revision 731) @@ -0,0 +1,137 @@ +#include "slalib.h" +#include "slamac.h" +void slaCombn ( int nsel, int ncand, int list[], int* j ) +/* +** - - - - - - - - - +** s l a C o m b n +** - - - - - - - - - +** +** Generate the next combination, a subset of a specified size chosen +** from a specified number of items. +** +** Given: +** nsel int number of items (subset size) +** ncand int number of candidates (set size) +** +** Given and Returned: +** list int[nsel] latest combination, list[0]=0 to initialize +** +** Returned: +** *j int status: -1 = illegal nsel or ncand +** 0 = OK +** +1 = no more combinations available +** +** Notes: +** +** 1) nsel and ncand must both be at least 1, and nsel must be less +** than or equal to ncand. +** +** 2) This routine returns, in the list array, a subset of nsel integers +** chosen from the range 1 to ncand inclusive, in ascending order. +** Before calling the routine for the first time, the caller must set +** the first element of the list array to zero (any value less than 1 +** will do) to cause initialization. +** +** 2) The first combination to be generated is: +** +** list[0]=1, list[1]=2, ..., list[nsel-1]=nsel +** +** This is also the combination returned for the "finished" (j=1) +** case. +** +** The final permutation to be generated is: +** +** list[0]=ncand, list[1]=ncand-1, ..., list[nsel-1]=ncand-nsel+1 +** +** 3) If the "finished" (j=1) status is ignored, the routine +** continues to deliver combinations, the pattern repeating +** every ncand!/(nsel!*(ncand-nsel)!) calls. +** +** 4) The algorithm is by R.F.Warren-Smith (private communication). +** +** Last revision: 25 August 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, more, nmax, m; + + +/* Validate, and set status. */ + if ( nsel < 1 || ncand < 1 || nsel > ncand ) { + *j = -1; + return; + } else { + *j = 0; + } + +/* Just starting? */ + if ( list[0] < 1 ) { + + /* Yes: return 1,2,3... */ + for ( i = 0; i < nsel; i++ ) { + list[i] = i+1; + } + + } else { + + /* No: find the first selection that we can increment. */ + + /* Start with the first list item. */ + i = 0; + + /* Loop. */ + more = 1; + while ( more ) { + + /* Is this the final list item? */ + if ( i == nsel-1 ) { + + /* Yes: comparison value is number of candidates plus one. */ + nmax = ncand+1; + + } else { + + /* No: comparison value is next list item. */ + nmax = list[i+1]; + } + + /* Can the current item be incremented? */ + if ( nmax - list[i] > 1 ) { + + /* Yes: increment it. */ + list[i]++; + + /* Reinitialize the preceding items. */ + for ( m = 0; m < i; m++ ) { + list[m] = m+1; + } + + /* Quit the loop. */ + more = 0; + + } else { + + /* Can't increment the current item: is it the final one? */ + if ( i == nsel-1 ) { + + /* Yes: set the status. */ + *j = 1; + + /* Restart the sequence. */ + for ( i = 0; i < nsel; i++ ) { + list[i] = i+1; + } + + /* Quit the loop. */ + more = 0; + + } else { + + /* No: next list item. */ + i++; + } + } + } + } +} Index: trunk/MagicSoft/slalib/cr2af.c =================================================================== --- trunk/MagicSoft/slalib/cr2af.c (revision 731) +++ trunk/MagicSoft/slalib/cr2af.c (revision 731) @@ -0,0 +1,33 @@ +#include "slalib.h" +#include "slamac.h" +void slaCr2af ( int ndp, float angle, char *sign, int idmsf[4] ) +/* +** - - - - - - - - - +** s l a C r 2 a f +** - - - - - - - - - +** +** Convert an angle in radians into degrees, arcminutes, arcseconds. +** +** (single precision) +** +** Given: +** ndp int number of decimal places of arcseconds +** angle float angle in radians +** +** Returned: +** sign *char '+' or '-' +** idmsf int[4] degrees, arcminutes, arcseconds, fraction +** +** Called: +** slaDd2tf +** +** Defined in slamac.h: D15B29 +** +** Last revision: 18 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Scale then use days to h,m,s routine */ + slaDd2tf ( ndp, (double) angle * D15B2P, sign, idmsf ); +} Index: trunk/MagicSoft/slalib/cr2tf.c =================================================================== --- trunk/MagicSoft/slalib/cr2tf.c (revision 731) +++ trunk/MagicSoft/slalib/cr2tf.c (revision 731) @@ -0,0 +1,33 @@ +#include "slalib.h" +#include "slamac.h" +void slaCr2tf ( int ndp, float angle, char *sign, int ihmsf[4] ) +/* +** - - - - - - - - - +** s l a C r 2 t f +** - - - - - - - - - +** +** Convert an angle in radians into hours, minutes, seconds. +** +** (single precision) +** +** Given: +** ndp int number of decimal places of seconds +** angle float angle in radians +** +** Returned: +** sign char* '+' or '-' +** ihmsf int(4) hours, minutes, seconds, fraction +** +** Called: +** slaDd2tf +** +** Defined in slamac.h: D2PI +** +** Last revision: 18 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Scale then use days to h,m,s routine */ + slaDd2tf ( ndp, (double) angle / D2PI, sign, ihmsf ); +} Index: trunk/MagicSoft/slalib/cs2c.c =================================================================== --- trunk/MagicSoft/slalib/cs2c.c (revision 731) +++ trunk/MagicSoft/slalib/cs2c.c (revision 731) @@ -0,0 +1,37 @@ +#include "slalib.h" +#include "slamac.h" +void slaCs2c ( float a, float b, float v[3] ) +/* +** - - - - - - - - +** s l a C s 2 c +** - - - - - - - - +** +** Spherical coordinates to direction cosines. +** +** (single precision) +** +** Given: +** a,b float spherical coordinates in radians +** (RA,Dec), (long,lat) etc +** +** Returned: +** v float[3] x,y,z unit vector +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + float cosb; + + cosb = (float) cos ( b ); + v[0] = (float) cos ( a ) * cosb; + v[1] = (float) sin ( a ) * cosb; + v[2] = (float) sin ( b ); +} Index: trunk/MagicSoft/slalib/cs2c6.c =================================================================== --- trunk/MagicSoft/slalib/cs2c6.c (revision 731) +++ trunk/MagicSoft/slalib/cs2c6.c (revision 731) @@ -0,0 +1,56 @@ +#include "slalib.h" +#include "slamac.h" +void slaCs2c6 ( float a, float b, float r, float ad, + float bd, float rd, float v[6] ) +/* +** - - - - - - - - - +** s l a C s 2 c 6 +** - - - - - - - - - +** +** Conversion of position & velocity in spherical coordinates +** to Cartesian coordinates. +** +** (single precision) +** +** Given: +** a float longitude (radians) +** b float latitude (radians) +** r float radial coordinate +** ad float longitude derivative (radians per unit time) +** bd float latitude derivative (radians per unit time) +** rd float radial derivative +** +** Returned: +** v float(6) Cartesian position & velocity vector +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double da, db; + float sa, ca, sb, cb, rcb, x, y, rbd, w; + +/* Useful functions */ + da = (double) a; + db = (double) b; + sa = (float) sin ( da ); + ca = (float) cos ( da ); + sb = (float) sin ( db ); + cb = (float) cos ( db ); + rcb = r * cb; + x = rcb * ca; + y = rcb * sa; + rbd = r * bd; + w = rbd * sb - cb * rd; + +/* Position */ + v[0] = x; + v[1] = y; + v[2] = r * sb; + +/* Velocity */ + v[3] = - y * ad - w * ca; + v[4] = x * ad - w * sa; + v[5] = rbd * cb + sb * rd; +} Index: trunk/MagicSoft/slalib/ctf2d.c =================================================================== --- trunk/MagicSoft/slalib/ctf2d.c (revision 731) +++ trunk/MagicSoft/slalib/ctf2d.c (revision 731) @@ -0,0 +1,58 @@ +#include "slalib.h" +#include "slamac.h" +void slaCtf2d ( int ihour, int imin, float sec, float *days, int *j ) +/* +** - - - - - - - - - +** s l a C t f 2 d +** - - - - - - - - - +** +** Convert hours, minutes, seconds to days. +** +** (single precision) +** +** Given: +** ihour int hours +** imin int minutes +** sec float seconds +** +** Returned: +** *days float interval in days +** *j int status: 0 = OK +** 1 = ihour outside range 0-23 +** 2 = imin outside range 0-59 +** 3 = sec outside range 0-59.999... +** +** Notes: +** +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Last revision: 9 April 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define D2S 86400.0f /* Seconds per day */ + +{ +/* Preset status */ + *j = 0; + +/* Validate sec, min, hour */ + if ( ( sec < 0.0f ) || ( sec >= 60.0f ) ) { + *j = 3; + return; + } + if ( ( imin < 0 ) || ( imin > 59 ) ) { + *j = 2; + return; + } + if ( ( ihour < 0 ) || ( ihour > 23 ) ) { + *j = 1; + return; + } + +/* Compute interval */ + *days = ( 60.0f * ( 60.0f * (float) ihour + (float) imin ) + sec) / D2S; +} Index: trunk/MagicSoft/slalib/ctf2r.c =================================================================== --- trunk/MagicSoft/slalib/ctf2r.c (revision 731) +++ trunk/MagicSoft/slalib/ctf2r.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaCtf2r ( int ihour, int imin, float sec, float *rad, int *j ) +/* +** - - - - - - - - - +** s l a C t f 2 r +** - - - - - - - - - +** +** Convert hours, minutes, seconds to radians. +** +** (single precision) +** +** Given: +** ihour int hours +** imin int minutes +** sec float seconds +** +** Returned: +** *rad float angle in radians +** *j int status: 0 = OK +** 1 = ihour outside range 0-23 +** 2 = imin outside range 0-59 +** 3 = sec outside range 0-59.999... +** +** Called: +** slaDtf2d +** +** Notes: +** +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Defined in slamac.h: D2PI +** +** Last revision: 30 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double turns; + +/* Convert to turns */ + slaDtf2d ( ihour, imin, (double) sec, &turns, j ); + +/* To radians */ + *rad = (float) ( turns * D2PI ); +} Index: trunk/MagicSoft/slalib/daf2r.c =================================================================== --- trunk/MagicSoft/slalib/daf2r.c (revision 731) +++ trunk/MagicSoft/slalib/daf2r.c (revision 731) @@ -0,0 +1,58 @@ +#include "slalib.h" +#include "slamac.h" +void slaDaf2r ( int ideg, int iamin, double asec, double *rad, int *j ) +/* +** - - - - - - - - - +** s l a D a f 2 r +** - - - - - - - - - +** +** Convert degrees, arcminutes, arcseconds to radians. +** +** (double precision) +** +** Given: +** ideg int degrees +** iamin int arcminutes +** asec double arcseconds +** +** Returned: +** *rad double angle in radians +** *j int status: 0 = OK +** 1 = ideg outside range 0-359 +** 2 = iamin outside range 0-59 +** 3 = asec outside range 0-59.999... +** +** Notes: +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Defined in slamac.h: DAS2R +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Preset status */ + *j = 0; + +/* Validate arcsec, arcmin, deg */ + if ( ( asec < 0.0 ) || ( asec >= 60.0 ) ) { + *j = 3; + return; + } + if ( ( iamin < 0 ) || ( iamin > 59 ) ) { + *j = 2; + return; + } + if ( ( ideg < 0 ) || ( ideg > 359 ) ) { + *j = 1; + return; + } + +/* Compute angle */ + *rad = DAS2R * ( 60.0 * ( 60.0 * (double) ideg + + (double) iamin ) + + asec ); +} Index: trunk/MagicSoft/slalib/dafin.c =================================================================== --- trunk/MagicSoft/slalib/dafin.c (revision 731) +++ trunk/MagicSoft/slalib/dafin.c (revision 731) @@ -0,0 +1,163 @@ +#include "slalib.h" +#include "slamac.h" +void slaDafin ( char *string, int *iptr, double *a, int *j ) +/* +** - - - - - - - - - +** s l a D a f i n +** - - - - - - - - - +** +** Sexagesimal character string to angle. +** +** (double precision) +** +** Given: +** string char* string containing deg, arcmin, arcsec fields +** iptr int where to start decode at (1st = 1) +** +** Returned: +** iptr int advanced past the decoded angle +** a double angle in radians +** j int status: 0 = OK +** +1 = default, A unchanged +** -1 = bad degrees ) +** -2 = bad arcminutes ) (note 3) +** -3 = bad arcseconds ) +** +** Example: +** +** argument before after +** +** string '-57 17 44.806 12 34 56.7' unchanged +** iptr 1 16 (points to 12...) +** +** a ? -1.00000 +** j ? 0 +** +** A further call to slaDafin, without adjustment of iptr, will +** decode the second angle, 12deg 34min 56.7sec. +** +** Notes: +** +** 1) The first three "fields" in string are degrees, arcminutes, +** arcseconds, separated by spaces or commas. The degrees field +** may be signed, but not the others. The decoding is carried +** out by the dfltin routine and is free-format. +** +** 2) Successive fields may be absent, defaulting to zero. For +** zero status, the only combinations allowed are degrees alone, +** degrees and arcminutes, and all three fields present. If all +** three fields are omitted, a status of +1 is returned and a is +** unchanged. In all other cases a is changed. +** +** 3) Range checking: +** The degrees field is not range checked. However, it is +** expected to be integral unless the other two fields are absent. +** The arcminutes field is expected to be 0-59, and integral if +** the arcseconds field is present. If the arcseconds field +** is absent, the arcminutes is expected to be 0-59.9999... +** The arcseconds field is expected to be 0-59.9999... +** +** 4) Decoding continues even when a check has failed. Under these +** circumstances the field takes the supplied value, defaulting +** to zero, and the result a is computed and returned. +** +** 5) Further fields after the three expected ones are not treated +** as an error. The pointer iptr is left in the correct state +** for further decoding with the present routine or with slaDfltin +** etc. See the example, above. +** +** 6) If string contains hours, minutes, seconds instead of degrees +** etc, or if the required units are turns (or days) instead of +** radians, the result a should be multiplied as follows: +** for to obtain multiply +** string a in a by +** d ' " radians 1 = 1.0 +** d ' " turns 1/2pi = 0.1591549430918953358 +** h m s radians 15 = 15.0 +** h m s days 15/2pi = 2.3873241463784300365 +** +** Called: slaDfltin +** +** Defined in slamac.h: DAS2R +** +** Last revision: 1 August 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Local variables */ + int jd, jf, jm, js; + double arcsec, arcmin, deg; + +/* Preset the status to OK */ + jf = 0; + +/* Defaults */ + deg = 0.0; + arcmin = 0.0; + arcsec = 0.0; + +/* Decode degrees, arcminutes, arcseconds */ + slaDfltin ( string, iptr, °, &jd ); + if ( jd > 1 ) { + jf = -1; + } else { + slaDfltin ( string, iptr, &arcmin, &jm ); + if ( jm < 0 || jm > 1 ) { + jf = -2; + } else { + slaDfltin ( string, iptr, &arcsec, &js ); + if ( js < 0 || js > 1 ) { + jf = -3; + + /* See if the combination of fields is credible */ + } else if ( jd > 0 ) { + + /* No degrees: arcmin, arcsec ought also to be absent */ + if ( jm == 0 ) { + + /* Suspect arcmin */ + jf = -2; + } else if ( js == 0 ) { + + /* Suspect arcsec */ + jf = -3; + } else { + + /* All three fields absent */ + jf = 1; + } + + /* Degrees present: if arcsec present so ought arcmin to be */ + } else if ( jm != 0 && js == 0 ) { + jf = -3; + + /* Tests for range and integrality */ + + /* Degrees */ + } else if ( jm == 0 && dint ( deg ) != deg ) { + jf = -1; + + /* Arcminutes */ + } else if ( ( js == 0 && dint ( arcmin ) != arcmin ) + || arcmin >= 60.0 ) { + jf = -2; + + /* Arcseconds */ + } else if ( arcsec >= 60.0 ) { + jf = -3; + } + } + } + +/* Unless all three fields absent, compute angle value */ + if ( jf <= 0 ) { + *a = ( ( fabs ( deg ) * 60.0 + arcmin ) * 60.0 + arcsec ) * DAS2R; + if (jd < 0) { + *a = -(*a); + } + } + +/* Return the status */ + *j = jf; +} Index: trunk/MagicSoft/slalib/dat.c =================================================================== --- trunk/MagicSoft/slalib/dat.c (revision 731) +++ trunk/MagicSoft/slalib/dat.c (revision 731) @@ -0,0 +1,173 @@ +#include "slalib.h" +#include "slamac.h" +double slaDat ( double utc ) +/* +** - - - - - - - +** s l a D a t +** - - - - - - - +** +** Increment to be applied to Coordinated Universal Time UTC to give +** International Atomic Time TAI. +** +** (double precision) +** +** Given: +** utc double UTC date as a modified JD (JD-2400000.5) +** +** Result: TAI-UTC in seconds +** +** Notes: +** +** 1 The UTC is specified to be a date rather than a time to indicate +** that care needs to be taken not to specify an instant which lies +** within a leap second. Though in most cases the utc argument can +** include the fractional part, correct behaviour on the day of a +** leap second can only be guaranteed up to the end of the second +** 23:59:59. +** +** 2 For epochs from 1961 January 1 onwards, the expressions from the +** file ftp://maia.usno.navy.mil/ser7/tai-utc.dat are used. +** +** 3 The 5ms timestep at 1961 January 1 is taken from 2.58.1 (p87) of +** the 1992 Explanatory Supplement. +** +** 4 UTC began at 1960 January 1.0 (JD 2436934.5) and it is improper +** to call the routine with an earlier epoch. However, if this +** is attempted, the TAI-UTC expression for the year 1960 is used. +** +** :-----------------------------------------: +** : : +** : IMPORTANT : +** : : +** : This routine must be updated on each : +** : occasion that a leap second is : +** : announced : +** : : +** : Latest leap second: 1999 January 1 : +** : : +** :-----------------------------------------: +** +** Last revision: 31 May 1999 +** +** Copyright 1999 P.T.Wallace. All rights reserved. +*/ +{ + +/* - - - - - - - - - - - - - - - - - - - - - */ +/* Add new code here on each occasion that a */ +/* leap second is announced, and also update */ +/* the preamble comments appropriately. */ +/* - - - - - - - - - - - - - - - - - - - - - */ + +/* 1999 January 1 */ + if ( utc >= 51179.0 ) return 32.0; + +/* 1997 July 1 */ + if ( utc >= 50630.0 ) return 31.0; + +/* 1996 January 1 */ + if ( utc >= 50083.0 ) return 30.0; + +/* 1994 July 1 */ + if ( utc >= 49534.0 ) return 29.0; + +/* 1993 July 1 */ + if ( utc >= 49169.0 ) return 28.0; + +/* 1992 July 1 */ + if ( utc >= 48804.0 ) return 27.0; + +/* 1991 January 1 */ + if ( utc >= 48257.0 ) return 26.0; + +/* 1990 January 1 */ + if ( utc >= 47892.0 ) return 25.0; + +/* 1988 January 1 */ + if ( utc >= 47161.0 ) return 24.0; + +/* 1985 July 1 */ + if ( utc >= 46247.0 ) return 23.0; + +/* 1983 July 1 */ + if ( utc >= 45516.0 ) return 22.0; + +/* 1982 July 1 */ + if ( utc >= 45151.0 ) return 21.0; + +/* 1981 July 1 */ + if ( utc >= 44786.0 ) return 20.0; + +/* 1980 January 1 */ + if ( utc >= 44239.0 ) return 19.0; + +/* 1979 January 1 */ + if ( utc >= 43874.0 ) return 18.0; + +/* 1978 January 1 */ + if ( utc >= 43509.0 ) return 17.0; + +/* 1977 January 1 */ + if ( utc >= 43144.0 ) return 16.0; + +/* 1976 January 1 */ + if ( utc >= 42778.0 ) return 15.0; + +/* 1975 January 1 */ + if ( utc >= 42413.0 ) return 14.0; + +/* 1974 January 1 */ + if ( utc >= 42048.0 ) return 13.0; + +/* 1973 January 1 */ + if ( utc >= 41683.0 ) return 12.0; + +/* 1972 July 1 */ + if ( utc >= 41499.0 ) return 11.0; + +/* 1972 January 1 */ + if ( utc >= 41317.0 ) return 10.0; + +/* 1968 February 1 */ + if ( utc >= 39887.0 ) return 4.2131700 + ( utc - 39126.0 ) * 0.002592; + +/* 1966 January 1 */ + if ( utc >= 39126.0 ) return 4.3131700 + ( utc - 39126.0 ) * 0.002592; + +/* 1965 September 1 */ + if ( utc >= 39004.0 ) return 3.8401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1965 July 1 */ + if ( utc >= 38942.0 ) return 3.7401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1965 March 1 */ + if ( utc >= 38820.0 ) return 3.6401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1965 January 1 */ + if ( utc >= 38761.0 ) return 3.5401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1964 September 1 */ + if ( utc >= 38639.0 ) return 3.4401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1964 April 1 */ + if ( utc >= 38486.0 ) return 3.3401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1964 January 1 */ + if ( utc >= 38395.0 ) return 3.2401300 + ( utc - 38761.0 ) * 0.001296; + +/* 1963 November 1 */ + if ( utc >= 38334.0 ) return 1.9458580 + ( utc - 37665.0 ) * 0.0011232; + +/* 1962 January 1 */ + if ( utc >= 37665.0 ) return 1.8458580 + ( utc - 37665.0 ) * 0.0011232; + +/* 1961 August 1 */ + if ( utc >= 37512.0 ) return 1.3728180 + ( utc - 37300.0 ) * 0.001296; + +/* 1961 January 1 */ + if ( utc >= 37300.0 ) return 1.4228180 + ( utc - 37300.0 ) * 0.001296; + +/* Before that. */ + return 1.4178180 + ( utc - 37300.0 ) * 0.001296; + +} Index: trunk/MagicSoft/slalib/dav2m.c =================================================================== --- trunk/MagicSoft/slalib/dav2m.c (revision 731) +++ trunk/MagicSoft/slalib/dav2m.c (revision 731) @@ -0,0 +1,63 @@ +#include "slalib.h" +#include "slamac.h" +void slaDav2m ( double axvec[3], double rmat[3][3] ) +/* +** - - - - - - - - - +** s l a D a v 2 m +** - - - - - - - - - +** +** Form the rotation matrix corresponding to a given axial vector. +** +** (double precision) +** +** A rotation matrix describes a rotation about some arbitrary axis. +** The axis is called the Euler axis, and the angle through which the +** reference frame rotates is called the Euler angle. The axial +** vector supplied to this routine has the same direction as the +** Euler axis, and its magnitude is the Euler angle in radians. +** +** Given: +** axvec double[3] axial vector (radians) +** +** Returned: +** rmat double[3][3] rotation matrix +** +** If axvec is null, the unit matrix is returned. +** +** The reference frame rotates clockwise as seen looking along +** the axial vector from the origin. +** +** Last revision: 25 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, phi, s, c, w; + +/* Euler angle - magnitude of axial vector - and functions */ + x = axvec[0]; + y = axvec[1]; + z = axvec[2]; + phi = sqrt ( x * x + y * y + z * z ); + s = sin ( phi ); + c = cos ( phi ); + w = 1.0 - c; + +/* Euler axis - direction of axial vector (perhaps null) */ + if ( phi != 0.0 ) { + x = x / phi; + y = y / phi; + z = z / phi; + } + +/* Compute the rotation matrix */ + rmat[0][0] = x * x * w + c; + rmat[0][1] = x * y * w + z * s; + rmat[0][2] = x * z * w - y * s; + rmat[1][0] = x * y * w - z * s; + rmat[1][1] = y * y * w + c; + rmat[1][2] = y * z * w + x * s; + rmat[2][0] = x * z * w + y * s; + rmat[2][1] = y * z * w - x * s; + rmat[2][2] = z * z * w + c; +} Index: trunk/MagicSoft/slalib/dbear.c =================================================================== --- trunk/MagicSoft/slalib/dbear.c (revision 731) +++ trunk/MagicSoft/slalib/dbear.c (revision 731) @@ -0,0 +1,44 @@ +#include "slalib.h" +#include "slamac.h" +double slaDbear ( double a1, double b1, double a2, double b2 ) +/* +** - - - - - - - - - +** s l a D b e a r +** - - - - - - - - - +** +** Bearing (position angle) of one point on a sphere relative +** to another. +** +** (double precision) +** +** Given: +** a1,b1 double spherical coordinates of one point +** a2,b2 double spherical coordinates of the other point +** +** (The spherical coordinates are RA,Dec, Long,Lat etc, in radians.) +** +** The result is the bearing (position angle), in radians, of point +** a2,b2 as seen from point a1,b1. It is in the range +/- pi. The +** sense is such that if a2,b2 is a small distance east of a1,b1, +** the bearing is about +pi/2. Zero is returned if the two points +** are coincident. +** +** If either b-coordinate is outside the range +/- pi/2, the +** result may correspond to "the long way round". +** +** The routine slaDpav performs an equivalent function except +** that the points are specified in the form of Cartesian unit +** vectors. +** +** Last revision: 8 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double da, x, y; + + da = a2 - a1; + y = sin ( da ) * cos ( b2 ); + x = sin ( b2 ) * cos ( b1 ) - cos ( b2 ) * sin ( b1 ) * cos ( da ); + return ( x != 0.0 || y != 0.0 ) ? atan2 ( y, x ) : 0.0; +} Index: trunk/MagicSoft/slalib/dbjin.c =================================================================== --- trunk/MagicSoft/slalib/dbjin.c (revision 731) +++ trunk/MagicSoft/slalib/dbjin.c (revision 731) @@ -0,0 +1,109 @@ +#include "slalib.h" +#include "slamac.h" +#include +void slaDbjin ( char *string, int *nstrt, + double *dreslt, int *jf1, int *jf2 ) +/* +** - - - - - - - - - +** s l a D b j i n +** - - - - - - - - - +** +** Convert free-format input into double precision floating point, +** using slaDfltin but with special syntax extensions. +** +** The purpose of the syntax extensions is to help cope with mixed +** FK4 and FK5 data. In addition to the syntax accepted by slaDfltin, +** the following two extensions are recognized by dbjin: +** +** 1) A valid non-null field preceded by the character 'B' +** (or 'b') is accepted. +** +** 2) A valid non-null field preceded by the character 'J' +** (or 'j') is accepted. +** +** The calling program is notified of the incidence of either of these +** extensions through an supplementary status argument. The rest of +** the arguments are as for slaDfltin. +** +** Given: +** *string char string containing field to be decoded +** *nstrt int where to start decode (1st = 1) +** +** +** Returned: +** *nstrt int incremented +** *dreslt double result +** *jf1 int dfltin status: -1 = -OK +** 0 = +OK +** +1 = null field +** +2 = error +** *jf2 int syntax flag: 0 = normal slaDfltin syntax +** +1 = 'B' or 'b' +** +2 = 'J' or 'j' +** +** Called: slaDfltin +** +** For details of the basic syntax, see slaDfltin. +** +** Last revision: 22 December 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int j2a, lenstr, na, j1a, nb, j1b; + char c; + +/* Preset syntax flag */ + j2a = 0; + +/* Length of string */ + lenstr = strlen ( string ); + +/* Position of current character */ + na = *nstrt; + +/* Attempt normal decode */ + slaDfltin ( string, &na, dreslt, &j1a ); + +/* Proceed only if pointer still within string */ + if ( ( na > 0 ) && ( na <= lenstr ) ) { + + /* See if slaDfltin reported a null field */ + if ( j1a == 1 ) { + + /* It did: examine character it stuck on */ + c = string[na-1]; + if ( c == 'B' || c == 'b' ) { + + /* 'B' or 'b' - provisionally note */ + j2a = 1; + + } else if ( c == 'J' || c == 'j' ) { + + /* 'J' or 'j' - provisionally note */ + j2a = 2; + } + + /* Following B or J, attempt to decode a number */ + if ( j2a == 1 || j2a == 2 ) { + nb = na + 1; + slaDfltin ( string, &nb, dreslt, &j1b ); + + /* If successful, copy pointer and status */ + if ( j1b <= 0 ) { + na = nb; + j1a = j1b; + + /* If not, forget about the B or J */ + } else { + j2a = 0; + } + } + } + } + +/* Return argument values and exit */ + *nstrt = na; + *jf1 = j1a; + *jf2 = j2a; +} Index: trunk/MagicSoft/slalib/dc62s.c =================================================================== --- trunk/MagicSoft/slalib/dc62s.c (revision 731) +++ trunk/MagicSoft/slalib/dc62s.c (revision 731) @@ -0,0 +1,69 @@ +#include "slalib.h" +#include "slamac.h" +void slaDc62s ( double v[6], double *a, double *b, double *r, + double *ad, double *bd, double *rd ) +/* +** - - - - - - - - - +** s l a D c 6 2 s +** - - - - - - - - - +** +** Conversion of position & velocity in Cartesian coordinates +** to spherical coordinates. +** +** (double precision) +** +** Given: +** v double[6] Cartesian position & velocity vector +** +** Returned: +** *a double longitude (radians) +** *b double latitude (radians) +** *r double radial coordinate +** *ad double longitude derivative (radians per unit time) +** *bd double latitude derivative (radians per unit time) +** *rd double radial derivative +** +** Last revision: 11 June 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, xd, yd, zd, rxy2, rxy, r2, xyp; + + +/* Components of position/velocity vector. */ + x = v[0]; + y = v[1]; + z = v[2]; + xd = v[3]; + yd = v[4]; + zd = v[5]; + +/* Component of R in XY plane squared. */ + rxy2 = x * x + y * y; + +/* Modulus squared, with protection against null vector. */ + if ( ( r2 = rxy2 + z * z ) == 0.0 ) { + x = xd; + y = yd; + z = zd; + rxy2 = x * x + y * y; + r2 = rxy2 + z * z; + } + +/* Position and velocity in spherical coordinates. */ + rxy = sqrt ( rxy2 ); + xyp = x * xd + y * yd; + if ( rxy2 != 0.0 ) { + *a = atan2 ( y, x ); + *b = atan2 ( z, rxy ); + *ad = ( x * yd - y * xd ) / rxy2; + *bd = ( zd * rxy2 - z * xyp ) / ( r2 * rxy ); + } else { + *a = 0.0; + *b = ( z != 0.0 ) ? atan2 ( z, rxy ) : 0.0; + *ad = 0.0; + *bd = 0.0; + } + *rd = ( ( *r = sqrt ( r2 ) ) != 0.0 ) ? ( xyp + z * zd ) / ( *r ) : 0.0; +} Index: trunk/MagicSoft/slalib/dcc2s.c =================================================================== --- trunk/MagicSoft/slalib/dcc2s.c (revision 731) +++ trunk/MagicSoft/slalib/dcc2s.c (revision 731) @@ -0,0 +1,42 @@ +#include "slalib.h" +#include "slamac.h" +void slaDcc2s ( double v[3], double *a, double *b ) +/* +** - - - - - - - - - +** s l a D c c 2 s +** - - - - - - - - - +** +** Direction cosines to spherical coordinates. +** +** (double precision) +** +** Given: +** v double[3] x,y,z vector +** +** Returned: +** *a,*b double spherical coordinates in radians +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** If v is null, zero a and b are returned. +** At either pole, zero a is returned. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, r; + + x = v[0]; + y = v[1]; + z = v[2]; + r = sqrt ( x * x + y * y ); + + *a = ( r != 0.0 ) ? atan2 ( y, x ) : 0.0; + *b = ( z != 0.0 ) ? atan2 ( z, r ) : 0.0; +} Index: trunk/MagicSoft/slalib/dcmpf.c =================================================================== --- trunk/MagicSoft/slalib/dcmpf.c (revision 731) +++ trunk/MagicSoft/slalib/dcmpf.c (revision 731) @@ -0,0 +1,127 @@ +#include "slalib.h" +#include "slamac.h" +void slaDcmpf ( double coeffs[6], + double *xz, double *yz, double *xs, + double *ys, double *perp, double *orient ) +/* +** - - - - - - - - - +** s l a D c m p f +** - - - - - - - - - +** +** Decompose an [x,y] linear fit into its constituent parameters: +** zero points, scales, nonperpendicularity and orientation. +** +** Given: +** coeffs double[6] transformation coefficients (see note) +** +** Returned: +** *xz double x zero point +** *yz double y zero point +** *xs double x scale +** *ys double y scale +** *perp double nonperpendicularity (radians) +** *orient double orientation (radians) +** +** The model relates two sets of [x,y] coordinates as follows. +** Naming the elements of coeffs: +** +** coeffs[0] = a +** coeffs[1] = b +** coeffs[2] = c +** coeffs[3] = d +** coeffs[4] = e +** coeffs[5] = f +** +** The model transforms coordinates [x1,y1] into coordinates +** [x2,y2] as follows: +** +** x2 = a + b*x1 + c*y1 +** y2 = d + e*x1 + f*y1 +** +** The transformation can be decomposed into four steps: +** +** 1) Zero points: +** +** x' = xz + x1 +** y' = yz + y1 +** +** 2) Scales: +** +** x'' = xs*x' +** y'' = ys*y' +** +** 3) Nonperpendicularity: +** +** x''' = cos(perp/2)*x'' + sin(perp/2)*y'' +** y''' = sin(perp/2)*x'' + cos(perp/2)*y'' +** +** 4) Orientation: +** +** x2 = cos(orient)*x''' + sin(orient)*y''' +** y2 =-sin(orient)*y''' + cos(orient)*y''' +** +** See also slaFitxy, slaPxy, slaInvf, slaXy2xy +** +** Last revision: 22 September 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double a, b, c, d, e, f, rb2e2, rc2f2, xsc, ysc, p, + ws, wc, or, hp, shp, chp, sor, cor, det, x0, y0; + +/* Copy the six coefficients */ + a = coeffs[0]; + b = coeffs[1]; + c = coeffs[2]; + d = coeffs[3]; + e = coeffs[4]; + f = coeffs[5]; + +/* Scales */ + rb2e2 = sqrt ( b * b + e * e ); + rc2f2 = sqrt ( c * c + f * f ); + if ( ( b * f - c * e ) >= 0.0 ) + xsc = rb2e2; + else { + b = -b; + c = -c; + xsc = -rb2e2; + } + ysc = rc2f2; + +/* Non-perpendicularity */ + p = ( ( c != 0.0 || f != 0.0 ) ? atan2 ( c, f ) : 0.0 ) + + ( ( e != 0.0 || b != 0.0 ) ? atan2 ( e, b ) : 0.0 ); + +/* Orientation */ + ws = ( c * rb2e2 ) - ( e * rc2f2 ); + wc = ( b * rc2f2 ) + ( f * rb2e2 ); + or = ( ws != 0.0 || wc != 0.0 ) ? atan2 ( ws, wc ) : 0.0; + +/* Zero corrections */ + hp = p / 2.0; + shp = sin ( hp ); + chp = cos ( hp ); + sor = sin ( or ); + cor = cos ( or ); + det = xsc * ysc * ( chp + shp ) * ( chp - shp ); + if ( fabs ( det ) > 0.0 ) { + x0 = ysc * ( a * ( ( chp * cor ) - ( shp * sor ) ) + - d * ( ( chp * sor ) + ( shp * cor ) ) ) / det; + y0 = xsc * ( a * ( ( chp * sor ) - ( shp * cor ) ) + + d * ( ( chp * cor ) + ( shp * sor ) ) ) / det; + } + else { + x0 = 0.0; + y0 = 0.0; + } + +/* Results */ + *xz = x0; + *yz = y0; + *xs = xsc; + *ys = ysc; + *perp = p; + *orient = or; +} Index: trunk/MagicSoft/slalib/dcs2c.c =================================================================== --- trunk/MagicSoft/slalib/dcs2c.c (revision 731) +++ trunk/MagicSoft/slalib/dcs2c.c (revision 731) @@ -0,0 +1,37 @@ +#include "slalib.h" +#include "slamac.h" +void slaDcs2c ( double a, double b, double v[3] ) +/* +** - - - - - - - - - +** s l a D c s 2 c +** - - - - - - - - - +** +** Spherical coordinates to direction cosines. +** +** (double precision) +** +** Given: +** a,b double spherical coordinates in radians +** (RA,Dec), (long,lat) etc +** +** Returned: +** v double[3] x,y,z unit vector +** +** The spherical coordinates are longitude (+ve anticlockwise +** looking from the +ve latitude pole) and latitude. The +** Cartesian coordinates are right handed, with the x axis +** at zero longitude and latitude, and the z axis at the +** +ve latitude pole. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double cosb; + + cosb = cos ( b ); + v[0] = cos ( a ) * cosb; + v[1] = sin ( a ) * cosb; + v[2] = sin ( b ); +} Index: trunk/MagicSoft/slalib/dd2tf.c =================================================================== --- trunk/MagicSoft/slalib/dd2tf.c (revision 731) +++ trunk/MagicSoft/slalib/dd2tf.c (revision 731) @@ -0,0 +1,60 @@ +#include "slalib.h" +#include "slamac.h" +void slaDd2tf ( int ndp, double days, char *sign, int ihmsf[4] ) +/* +** - - - - - - - - - +** s l a D d 2 t f +** - - - - - - - - - +** +** Convert an interval in days into hours, minutes, seconds. +** +** (double precision) +** +** Given: +** ndp int number of decimal places of seconds +** days double interval in days +** +** Returned: +** *sign char '+' or '-' +** ihmsf int[4] hours, minutes, seconds, fraction +** +** Last revision: 31 August 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define D2S 86400.0 /* Days to seconds */ + +{ + double rs, rm, rh, a, ah, am, as, af; + +/* Handle sign */ + *sign = (char) ( ( days < 0.0 ) ? '-' : '+' ); + +/* Field units in terms of least significant figure */ + rs = pow ( 10.0, (double) gmax ( ndp, 0 ) ); + rs = dint ( rs ); + rm = rs * 60.0; + rh = rm * 60.0; + +/* Round interval and express in smallest units required */ + a = rs * D2S * fabs ( days ); + a = dnint ( a ); + +/* Separate into fields */ + ah = a / rh; + ah = dint ( ah ); + a = a - ah * rh; + am = a / rm; + am = dint ( am ); + a = a - am * rm; + as = a / rs; + as = dint ( as ); + af = a - as * rs; + +/* Return results */ + ihmsf[0] = (int) ah; + ihmsf[1] = (int) am; + ihmsf[2] = (int) as; + ihmsf[3] = (int) af; +} Index: trunk/MagicSoft/slalib/de2h.c =================================================================== --- trunk/MagicSoft/slalib/de2h.c (revision 731) +++ trunk/MagicSoft/slalib/de2h.c (revision 731) @@ -0,0 +1,79 @@ +#include "slalib.h" +#include "slamac.h" +void slaDe2h ( double ha, double dec, double phi, double *az, double *el ) +/* +** - - - - - - - - +** s l a D e 2 h +** - - - - - - - - +** +** Equatorial to horizon coordinates: HA,Dec to Az,El +** +** (double precision) +** +** Given: +** ha double hour angle +** dec double declination +** phi double observatory latitude +** +** Returned: +** *az double azimuth +** *el double elevation +** +** Notes: +** +** 1) All the arguments are angles in radians. +** +** 2) Azimuth is returned in the range 0-2pi; north is zero, +** and east is +pi/2. Elevation is returned in the range +** +/-pi/2. +** +** 3) The latitude must be geodetic. In critical applications, +** corrections for polar motion should be applied. +** +** 4) In some applications it will be important to specify the +** correct type of hour angle and declination in order to +** produce the required type of azimuth and elevation. In +** particular, it may be important to distinguish between +** elevation as affected by refraction, which would +** require the "observed" HA,Dec, and the elevation +** in vacuo, which would require the "topocentric" HA,Dec. +** If the effects of diurnal aberration can be neglected, the +** "apparent" HA,Dec may be used instead of the topocentric +** HA,Dec. +** +** 5) No range checking of arguments is carried out. +** +** 6) In applications which involve many such calculations, rather +** than calling the present routine it will be more efficient to +** use inline code, having previously computed fixed terms such +** as sine and cosine of latitude, and (for tracking a star) +** sine and cosine of declination. +** +** Defined in slamac.h: D2PI +** +** Last revision: 10 July 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sh, ch, sd, cd, sp, cp, x, y, z, r, a; + +/* Useful trig functions */ + sh = sin ( ha ); + ch = cos ( ha ); + sd = sin ( dec ); + cd = cos ( dec ); + sp = sin ( phi ); + cp = cos ( phi ); + +/* Az,El as x,y,z */ + x = - ch * cd * sp + sd * cp; + y = - sh * cd; + z = ch * cd * cp + sd * sp; + +/* To spherical */ + r = sqrt ( x * x + y * y ); + a = ( r == 0.0 ) ? 0.0 : atan2 ( y, x ) ; + *az = ( a < 0.0 ) ? a + D2PI : a; + *el = atan2 ( z, r ); +} Index: trunk/MagicSoft/slalib/deuler.c =================================================================== --- trunk/MagicSoft/slalib/deuler.c (revision 731) +++ trunk/MagicSoft/slalib/deuler.c (revision 731) @@ -0,0 +1,147 @@ +#include "slalib.h" +#include "slamac.h" +#include +void slaDeuler ( char *order, double phi, double theta, + double psi, double rmat[3][3] ) +/* +** - - - - - - - - - - +** s l a D e u l e r +** - - - - - - - - - - +** +** Form a rotation matrix from the Euler angles - three successive +** rotations about specified Cartesian axes. +** +** (double precision) +** +** Given: +** *order char specifies about which axes the rotations occur +** phi double 1st rotation (radians) +** theta double 2nd rotation ( " ) +** psi double 3rd rotation ( " ) +** +** Returned: +** rmat double[3][3] rotation matrix +** +** A rotation is positive when the reference frame rotates +** anticlockwise as seen looking towards the origin from the +** positive region of the specified axis. +** +** The characters of order define which axes the three successive +** rotations are about. A typical value is 'zxz', indicating that +** rmat is to become the direction cosine matrix corresponding to +** rotations of the reference frame through phi radians about the +** old z-axis, followed by theta radians about the resulting x-axis, +** then psi radians about the resulting z-axis. +** +** The axis names can be any of the following, in any order or +** combination: x, y, z, uppercase or lowercase, 1, 2, 3. Normal +** axis labelling/numbering conventions apply; the xyz (=123) +** triad is right-handed. Thus, the 'zxz' example given above +** could be written 'zxz' or '313' (or even 'zxz' or '3xz'). Order +** is terminated by length or by the first unrecognized character. +** +** Fewer than three rotations are acceptable, in which case the later +** angle arguments are ignored. Zero rotations leaves rmat set to the +** identity matrix. +** +** Last revision: 9 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int j, i, l, n, k; + double result[3][3], rotn[3][3], angle, s, c , w, wm[3][3]; + char axis; + +/* Initialize result matrix */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + result[i][j] = ( i == j ) ? 1.0 : 0.0; + } + } + +/* Establish length of axis string */ + l = strlen ( order ); + +/* Look at each character of axis string until finished */ + for ( n = 0; n < 3; n++ ) { + if ( n <= l ) { + + /* Initialize rotation matrix for the current rotation */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + rotn[i][j] = ( i == j ) ? 1.0 : 0.0; + } + } + + /* Pick up the appropriate Euler angle and take sine & cosine */ + switch ( n ) { + case 0 : + angle = phi; + break; + case 1 : + angle = theta; + break; + default: + angle = psi; + break; + } + s = sin ( angle ); + c = cos ( angle ); + + /* Identify the axis */ + axis = order[n]; + if ( ( axis == 'X' ) || ( axis == 'x' ) || ( axis == '1' ) ) { + + /* Matrix for x-rotation */ + rotn[1][1] = c; + rotn[1][2] = s; + rotn[2][1] = -s; + rotn[2][2] = c; + } + else if ( ( axis == 'Y' ) || ( axis == 'y' ) || ( axis == '2' ) ) { + + /* Matrix for y-rotation */ + rotn[0][0] = c; + rotn[0][2] = -s; + rotn[2][0] = s; + rotn[2][2] = c; + } + else if ( ( axis == 'Z' ) || ( axis == 'z' ) || ( axis == '3' ) ) { + + /* Matrix for z-rotation */ + rotn[0][0] = c; + rotn[0][1] = s; + rotn[1][0] = -s; + rotn[1][1] = c; + } else { + + /* Unrecognized character - fake end of string */ + l = 0; + } + + /* Apply the current rotation (matrix rotn x matrix result) */ + for ( i = 0; i < 3; i++ ) { + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( k = 0; k < 3; k++ ) { + w += rotn[i][k] * result[k][j]; + } + wm[i][j] = w; + } + } + for ( j = 0; j < 3; j++ ) { + for ( i= 0; i < 3; i++ ) { + result[i][j] = wm[i][j]; + } + } + } + } + +/* Copy the result */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + rmat[i][j] = result[i][j]; + } + } +} Index: trunk/MagicSoft/slalib/dfltin.c =================================================================== --- trunk/MagicSoft/slalib/dfltin.c (revision 731) +++ trunk/MagicSoft/slalib/dfltin.c (revision 731) @@ -0,0 +1,629 @@ +#include "slalib.h" +#include "slamac.h" +#include + +static int idchf ( int, char*, int*, int*, double* ); + +void slaDfltin ( char *string, int *nstrt, double *dreslt, int *jflag ) +/* +** - - - - - - - - - - +** s l a D f l t i n +** - - - - - - - - - - +** +** Convert free-format input into double precision floating point. +** +** Given: +** *string char string containing field to be decoded +** *nstrt int where to start decode (1st = 1) +** +** Returned: +** *nstrt int advanced to next field +** *dreslt double result +** *jflag int -1 = -OK, 0 = +OK, 1 = null field, 2 = error +** +** Called: idchf +** +** Notes: +** +** 1 A tab character is interpreted as a space, and lower +** case d,e are interpreted as upper case. +** +** 2 The basic format is #^.^@#^ where # means + or -, +** ^ means a decimal subfield and @ means D or E. +** +** 3 Spaces: +** Leading spaces are ignored. +** Embedded spaces are allowed only after # and D or E, +** and after . where the first ^ is absent. +** Trailing spaces are ignored; the first signifies +** end of decoding and subsequent ones are skipped. +** +** 4 Field separators: +** Any character other than +,-,0-9,.,D,E or space may be +** used to end a field. Comma is recognized by slaDfltin +** as a special case; it is skipped, leaving the +** pointer on the next character. See 12, below. +** +** 5 Both signs are optional. The default is +. +** +** 6 The mantissa defaults to 1. +** +** 7 The exponent defaults to e0. +** +** 8 The decimal subfields may be of any length. +** +** 9 The decimal point is optional for whole numbers. +** +** 10 A null field is one that does not begin with +** +,-,0-9,.,D or E, or consists entirely of spaces. +** If the field is null, jflag is set to 1 and dreslt +** is left untouched. +** +** 11 nstrt = 1 for the first character in the string. +** +** 12 On return from slaDfltin, nstrt is set ready for the next +** decode - following trailing blanks and (if used) the +** comma separator. If a separator other than comma is +** being used, nstrt must be incremented before the next +** call to slaDfltin. +** +** 13 Errors (jflag=2) occur when: +** a) A +, -, D or E is left unsatisfied. +** b) The decimal point is present without at least +** one decimal subfield. +** c) An exponent more than 100 has been presented. +** +** 14 When an error has been detected, nstrt is left +** pointing to the character following the last +** one used before the error came to light. This +** may be after the point at which a more sophisticated +** program could have detected the error. For example, +** slaDfltin does not detect that '1e999' is unacceptable +** until the whole field has been read. +** +** 15 Certain highly unlikely combinations of mantissa & +** exponent can cause arithmetic faults during the +** decode, in some cases despite the fact that they +** together could be construed as a valid number. +** +** 16 Decoding is left to right, one pass. +** +** 17 End of field may occur in either of two ways: +** a) As dictated by the string length. +** b) Detected during the decode. +** (b overrides a.) +** +** 18 See also slaFlotin and slaIntin. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Definitions shared between slaDfltin and idchf */ +#define NUMBER 0 +#define SPACE 1 +#define EXPSYM 2 +#define PERIOD 3 +#define PLUS 4 +#define MINUS 5 +#define COMMA 6 +#define OTHER 7 +#define END 8 + +{ + int l_string, nptr, ndigit; + double digit; + +/* Current state of the decode and the values it can take */ + + int state; + +#define seek_sign 100 +#define neg_mant 200 +#define seek_1st_leading_digit 300 +#define accept_leading_digit 400 +#define seek_digit_when_none_before_pt 500 +#define seek_trailing_digit 600 +#define accept_trailing_digit 700 +#define accept_uns_exp_no_mant 800 +#define seek_sign_exp 900 +#define neg_exp 1000 +#define seek_1st_exp_digit 1100 +#define accept_exp_digit 1200 +#define end_of_field 1300 +#define build_result 1310 +#define seeking_end_of_field 1620 +#define next_field_OK 1720 +#define next_field_default 9100 +#define null_field 9110 +#define next_field_error 9200 +#define error 9210 +#define done 9900 + + + int msign, nexp, ndp, isignx, j; + double dmant; + + +/* Find string length */ + l_string = strlen ( string ); + +/* Current character index */ + nptr = *nstrt - 1; + +/* Set defaults: mantissa & sign, exponent & sign, decimal place count */ + dmant = 0.0; + msign = 1; + nexp = 0; + isignx = 1; + ndp = 0; + +/* Initialize state to "looking for sign" */ + state = seek_sign; + +/* Loop until decode is complete */ + while ( state != done ) { + switch ( state ) { + + case seek_sign : + + /* Look for sign */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_leading_digit; + break; + case SPACE : + state = seek_sign; + break; + case EXPSYM : + state = accept_uns_exp_no_mant; + break; + case PERIOD : + state = seek_digit_when_none_before_pt; + break; + case PLUS : + state = seek_1st_leading_digit; + break; + case MINUS : + state = neg_mant; + break; + case OTHER : + state = next_field_default; + break; + case COMMA : + case END : + state = null_field; + break; + default : + state = error; + } + break; + + case neg_mant : + + /* Negative mantissa */ + msign = -1; + + case seek_1st_leading_digit : + + /* Look for first leading decimal */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_leading_digit; + break; + case SPACE : + state = seek_1st_leading_digit; + break; + case EXPSYM : + state = accept_uns_exp_no_mant; + break; + case PERIOD : + state = seek_digit_when_none_before_pt; + break; + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = next_field_error; + break; + case END : + default : + state = error; + } + break; + + case accept_leading_digit : + + /* Accept leading decimals */ + dmant = dmant * 1e1 + digit; + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_leading_digit; + break; + case SPACE : + state = build_result; + break; + case EXPSYM : + state = seek_sign_exp; + break; + case PERIOD : + state = seek_trailing_digit; + break; + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = end_of_field; + break; + case END : + state = build_result; + break; + default : + state = error; + } + break; + + case seek_digit_when_none_before_pt : + + /* Look for decimal when none preceded the point */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_trailing_digit; + break; + case SPACE : + state = seek_digit_when_none_before_pt; + break; + case EXPSYM : + case PERIOD : + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = next_field_error; + break; + case END : + default : + state = error; + } + break; + + case seek_trailing_digit : + + /* Look for trailing decimals */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_trailing_digit; + break; + case EXPSYM : + state = seek_sign_exp; + break; + case PERIOD : + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = end_of_field; + break; + case SPACE : + case END : + state = build_result; + break; + default : + state = error; + } + break; + + case accept_trailing_digit : + + /* Accept trailing decimals */ + ndp++; + dmant = dmant * 1e1 + digit; + state = seek_trailing_digit; + break; + + case accept_uns_exp_no_mant : + + /* Exponent symbol first in field: default mantissa to 1 */ + dmant = 1.0; + + case seek_sign_exp : + + /* Look for sign of exponent */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_exp_digit; + break; + case SPACE : + state = seek_sign_exp; + break; + case PLUS : + state = seek_1st_exp_digit; + break; + case MINUS : + state = neg_exp; + break; + case EXPSYM : + case PERIOD : + case COMMA : + case OTHER : + state = next_field_error; + break; + case END : + default : + state = error; + } + break; + + case neg_exp : + + /* Exponent negative */ + isignx = -1; + + case seek_1st_exp_digit : + + /* Look for first digit of exponent */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_exp_digit; + break; + case SPACE : + state = seek_1st_exp_digit; + break; + case EXPSYM : + case PERIOD : + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = next_field_error; + break; + case END : + default : + state = error; + } + break; + + case accept_exp_digit : + + /* Use exponent digit */ + nexp = nexp * 10 + ndigit; + if ( nexp > 100 ) { + state = next_field_error; + } else { + + /* Look for subsequent digits of exponent */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case NUMBER : + state = accept_exp_digit; + break; + case SPACE : + state = build_result; + break; + case EXPSYM : + case PERIOD : + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = end_of_field; + break; + case END : + state = build_result; + break; + default : + state = error; + } + } + break; + + case end_of_field : + + /* Off the end of the field: move pointer back */ + nptr--; + + case build_result : + + /* Combine exponent and decimal place count */ + nexp = nexp * isignx - ndp; + + /* Sign of exponent? */ + if ( nexp >= 0 ) { + + /* Positive exponent: scale up */ + while ( nexp >= 10 ) { + dmant *= 1e10; + nexp -= 10; + } + while ( nexp >= 1 ) { + dmant *= 1e1; + nexp--; + } + } else { + + /* Negative exponent: scale down */ + while ( nexp <= -10 ) { + dmant /= 1e10; + nexp += 10; + } + while ( nexp <= -1 ) { + dmant /= 1e1; + nexp++; + } + } + + /* Get result & status */ + if ( msign == 1 ) { + *dreslt = dmant; + j = 0; + } else { + *dreslt = -dmant; + j = -1; + } + + case seeking_end_of_field : + + /* Skip to end of field */ + switch ( idchf ( l_string, string, &nptr, &ndigit, &digit ) ) { + case SPACE : + state = seeking_end_of_field; + break; + case NUMBER : + case EXPSYM : + case PERIOD : + case PLUS : + case MINUS : + case OTHER : + state = next_field_OK; + break; + case COMMA : + case END : + state = done; + break; + default : + state = error; + } + break; + + case next_field_OK : + + /* Next field terminates successful decode */ + nptr--; + state = done; + break; + + case next_field_default : + + /* Next field terminates null decode */ + nptr--; + + case null_field : + + /* Null decode */ + j = 1; + state = done; + break; + + case next_field_error : + + /* Next field detected prematurely */ + nptr--; + + case error : + + /* Decode has failed: set bad status */ + j = 2; + state = done; + break; + + default : + state = error; + } + } + +/* Finished: return updated pointer and the status */ + *nstrt = nptr + 1; + *jflag = j; +} + +static int idchf ( int l_string, char *string, + int *nptr, int *ndigit, double *digit ) +/* +** - - - - - +** i d c h f +** - - - - - +** +** Internal routine used by slaDfltin: +** +** identify next character in string. +** +** Given: +** l_string int length of string +** string char* string +** nptr int* character to be identified (1st = 0) +** +** Returned: +** nptr int* incremented unless end of field +** ndigit int* 0-9 if character was a numeral +** digit double* (double) ndigit +** +** Returned (function value): +** idchf int vector for identified character: +** +** value meaning +** +** NUMBER 0-9 +** SPACE space or tab +** EXPSYM D, d, E or e +** PERIOD . +** PLUS + +** MINUS - +** COMMA , +** OTHER else +** END outside field +** +** Last revision: 24 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int ivec, ictab; + char c; + +/* Character/vector tables */ + +#define NCREC (20) + static char kctab[NCREC] = { '0','1','2','3','4','5', + '6','7','8','9', + ' ','\t', + 'D','d','E','e', + '.', + '+', + '-', + ',' }; + + static int kvtab[NCREC] = { NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, + NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, + SPACE, SPACE, + EXPSYM, EXPSYM, EXPSYM, EXPSYM, + PERIOD, + PLUS, + MINUS, + COMMA }; + + +/* Initialize returned value */ + ivec = OTHER; + +/* Pointer outside field? */ + if ( *nptr < 0 || *nptr >= l_string ) { + + /* Yes: prepare returned value */ + ivec = END; + + } else { + + /* Not end of field: identify character */ + c = string [ *nptr ]; + for ( ictab = 0; ictab < NCREC; ictab++ ) { + if ( kctab [ ictab ] == c ) { + + /* Recognized */ + ivec = kvtab [ ictab ]; + + /* Allow for numerals */ + *ndigit = ictab; + *digit = (double) *ndigit; + + /* Quit the loop */ + break; + } + } + + /* Increment pointer */ + ( *nptr )++; + } + +/* Return the value identifying the character */ + return ivec; +} Index: trunk/MagicSoft/slalib/dh2e.c =================================================================== --- trunk/MagicSoft/slalib/dh2e.c (revision 731) +++ trunk/MagicSoft/slalib/dh2e.c (revision 731) @@ -0,0 +1,75 @@ +#include "slalib.h" +#include "slamac.h" +void slaDh2e ( double az, double el, double phi, double *ha, double *dec ) +/* +** - - - - - - - - +** s l a D h 2 e +** - - - - - - - - +** +** Horizon to equatorial coordinates: Az,El to HA,Dec +** +** (double precision) +** +** Given: +** az double azimuth +** el double elevation +** phi double observatory latitude +** +** Returned: +** *ha double hour angle +** *dec double declination +** +** Notes: +** +** 1) All the arguments are angles in radians. +** +** 2) The sign convention for azimuth is north zero, east +pi/2. +** +** 3) HA is returned in the range +/-pi. Declination is returned +** in the range +/-pi/2. +** +** 4) The is latitude is (in principle) geodetic. In critical +** applications, corrections for polar motion should be applied. +** +** 5) In some applications it will be important to specify the +** correct type of elevation in order to produce the required +** type of HA,Dec. In particular, it may be important to +** distinguish between the elevation as affected by refraction, +** which will yield the "observed" HA,Dec, and the elevation +** in vacuo, which will yield the "topocentric" HA,Dec. If the +** effects of diurnal aberration can be neglected, the +** topocentric HA,Dec may be used as an approximation to the +** "apparent" HA,Dec. +** +** 6) No range checking of arguments is done. +** +** 7) In applications which involve many such calculations, rather +** than calling the present routine it will be more efficient to +** use inline code, having previously computed fixed terms such +** as sine and cosine of latitude. +** +** Last revision: 21 February 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sa, ca, se, ce, sp, cp, x, y, z, r; + +/* Useful trig functions */ + sa = sin ( az ); + ca = cos ( az ); + se = sin ( el ); + ce = cos ( el ); + sp = sin ( phi ); + cp = cos ( phi ); + +/* HA,Dec as x,y,z */ + x = - ca * ce * sp + se * cp; + y = - sa * ce; + z = ca * ce * cp + se * sp; + +/* To spherical */ + r = sqrt ( x * x + y * y ); + *ha = ( r == 0.0 ) ? 0.0 : atan2 ( y, x ) ; + *dec = atan2 ( z, r ); +} Index: trunk/MagicSoft/slalib/dimxv.c =================================================================== --- trunk/MagicSoft/slalib/dimxv.c (revision 731) +++ trunk/MagicSoft/slalib/dimxv.c (revision 731) @@ -0,0 +1,49 @@ +#include "slalib.h" +#include "slamac.h" +void slaDimxv ( double dm[3][3], double va[3], double vb[3] ) +/* +** - - - - - - - - - +** s l a D i m x v +** - - - - - - - - - +** +** Performs the 3-d backward unitary transformation: +** +** vector vb = (inverse of matrix dm) * vector va +** +** (double precision) +** +** (n.b. The matrix must be unitary, as this routine assumes that +** the inverse and transpose are identical) +** +** +** Given: +** dm double[3][3] matrix +** va double[3] vector +** +** Returned: +** vb double[3] result vector +** +** Note: va and vb may be the same array. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j; + double w, vw[3]; + +/* Inverse of matrix dm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dm[i][j] * va[i]; + } + vw[j] = w; + } + +/* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} Index: trunk/MagicSoft/slalib/djcal.c =================================================================== --- trunk/MagicSoft/slalib/djcal.c (revision 731) +++ trunk/MagicSoft/slalib/djcal.c (revision 731) @@ -0,0 +1,69 @@ +#include "slalib.h" +#include "slamac.h" +void slaDjcal ( int ndp, double djm, int iymdf[4], int *j ) +/* +** - - - - - - - - - +** s l a D j c a l +** - - - - - - - - - +** +** Modified Julian Date to Gregorian calendar, expressed +** in a form convenient for formatting messages (namely +** rounded to a specified precision, and with the fields +** stored in a single array). +** +** Given: +** ndp int number of decimal places of days in fraction +** djm double Modified Julian Date (JD-2400000.5) +** +** Returned: +** iymdf int[4] year, month, day, fraction in Gregorian calendar +** *j int status: nonzero = out of range +** +** Any date after 4701BC March 1 is accepted. +** +** Large ndp values risk internal overflows. It is typically safe +** to use up to ndp=4. +** +** The algorithm is derived from that of Hatcher 1984 (QJRAS 25, 53-55). +** +** Defined in slamac.h: dmod +** +** Last revision: 17 August 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double fd, df, f, d; + long jd, n4, nd10; + +/* Validate */ + if ( ( djm <= -2395520.0 ) || ( djm >= 1.0e9 ) ) { + *j = - 1; + return; + } else { + + /* Denominator of fraction */ + fd = pow ( 10.0, (double) gmax ( ndp, 0 ) ); + fd = dnint ( fd ); + + /* Round date and express in units of fraction */ + df = djm * fd; + df = dnint ( df ); + + /* Separate day and fraction */ + f = dmod ( df, fd ); + if ( f < 0.0 ) f += fd; + d = ( df - f ) / fd; + + /* Express day in Gregorian calendar */ + jd = (long) dnint ( d ) + 2400001L; + n4 = 4L * ( jd + ( ( 2L * ( ( 4L * jd - 17918L ) / 146097L) + * 3L ) / 4L + 1L ) / 2L - 37L ); + nd10 = 10L * ( ( ( n4 - 237L ) % 1461L ) / 4L ) + 5L; + iymdf[0] = (int) ( ( n4 / 1461L ) - 4712L ); + iymdf[1] = (int) ( ( ( nd10 / 306L + 2L ) % 12L ) + 1L ); + iymdf[2] = (int) ( ( nd10 % 306L ) / 10L + 1L ); + iymdf[3] = (int) dnint ( f ); + *j = 0; + } +} Index: trunk/MagicSoft/slalib/djcl.c =================================================================== --- trunk/MagicSoft/slalib/djcl.c (revision 731) +++ trunk/MagicSoft/slalib/djcl.c (revision 731) @@ -0,0 +1,58 @@ +#include "slalib.h" +#include "slamac.h" +void slaDjcl ( double djm, int *iy, int *im, int *id, double *fd, int *j) +/* +** - - - - - - - - +** s l a D j c l +** - - - - - - - - +** +** Modified Julian Date to Gregorian year, month, day, +** and fraction of a day. +** +** Given: +** djm double Modified Julian Date (JD-2400000.5) +** +** Returned: +** *iy int year +** *im int month +** *id int day +** *fd double fraction of day +** *j int status: +** -1 = unacceptable date (before 4701BC March 1) +** +** The algorithm is derived from that of Hatcher 1984 (QJRAS 25, 53-55). +** +** Defined in slamac.h: dmod +** +** Last revision: 12 March 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double f, d; + long jd, n4, nd10; + +/* Check if date is acceptable */ + if ( ( djm <= -2395520.0 ) || ( djm >= 1e9 ) ) { + *j = -1; + return; + } else { + *j = 0; + + /* Separate day and fraction */ + f = dmod ( djm, 1.0 ); + if ( f < 0.0 ) f += 1.0; + d = djm - f; + d = dnint ( d ); + + /* Express day in Gregorian calendar */ + jd = (long) dnint ( d ) + 2400001; + n4 = 4L*(jd+((6L*((4L*jd-17918L)/146097L))/4L+1L)/2L-37L); + nd10 = 10L*(((n4-237L)%1461L)/4L)+5L; + *iy = (int) (n4/1461L-4712L); + *im = (int) (((nd10/306L+2L)%12L)+1L); + *id = (int) ((nd10%306L)/10L+1L); + *fd = f; + *j = 0; + } +} Index: trunk/MagicSoft/slalib/dm2av.c =================================================================== --- trunk/MagicSoft/slalib/dm2av.c (revision 731) +++ trunk/MagicSoft/slalib/dm2av.c (revision 731) @@ -0,0 +1,56 @@ +#include "slalib.h" +#include "slamac.h" +void slaDm2av ( double rmat[3][3], double axvec[3] ) +/* +** - - - - - - - - - +** s l a D m 2 a v +** - - - - - - - - - +** +** From a rotation matrix, determine the corresponding axial vector. +** +** (double precision) +** +** A rotation matrix describes a rotation about some arbitrary axis. +** The axis is called the Euler axis, and the angle through which the +** reference frame rotates is called the Euler angle. The axial +** vector returned by this routine has the same direction as the +** Euler axis, and its magnitude is the Euler angle in radians. (The +** magnitude and direction can be separated by means of the routine +** slaDvn.) +** +** Given: +** rmat double[3][3] rotation matrix +** +** Returned: +** axvec double[3] axial vector (radians) +** +** The reference frame rotates clockwise as seen looking along +** the axial vector from the origin. +** +** If rmat is null, so is the result. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, s2, c2, phi, f; + + x = rmat[1][2] - rmat[2][1]; + y = rmat[2][0] - rmat[0][2]; + z = rmat[0][1] - rmat[1][0]; + s2 = sqrt ( x * x + y * y + z * z ); + if ( s2 != 0.0 ) + { + c2 = ( rmat[0][0] + rmat[1][1] + rmat[2][2] - 1.0 ); + phi = atan2 ( s2 / 2.0, c2 / 2.0 ); + f = phi / s2; + axvec[0] = x * f; + axvec[1] = y * f; + axvec[2] = z * f; + } else { + axvec[0] = 0.0; + axvec[1] = 0.0; + axvec[2] = 0.0; + } +} Index: trunk/MagicSoft/slalib/dmat.c =================================================================== --- trunk/MagicSoft/slalib/dmat.c (revision 731) +++ trunk/MagicSoft/slalib/dmat.c (revision 731) @@ -0,0 +1,152 @@ +#include "slalib.h" +#include "slamac.h" +void slaDmat ( int n, double *a, double *y, double *d, int *jf, int *iw) +/* +** - - - - - - - - +** s l a D m a t +** - - - - - - - - +** +** Matrix inversion & solution of simultaneous equations. +** +** (double precision) +** +** For the set of n simultaneous equations in n unknowns: +** a.y = x +** +** where: +** a is a non-singular n x n matrix +** y is the vector of n unknowns +** x is the known vector +** +** slaDmat computes: +** the inverse of matrix a +** the determinant of matrix a +** the vector of n unknowns +** +** Arguments: +** +** symbol type dimension before after +** +** n int no. of unknowns unchanged +** *a double [n][n] matrix inverse +** *y double [n] vector solution +** *d double - determinant +** > *jf int - singularity flag +** *iw int [n] - workspace +** +** +** > jf is the singularity flag. If the matrix is non-singular, +** jf=0 is returned. If the matrix is singular, jf=-1 & d=0.0 are +** returned. In the latter case, the contents of array a on return +** are undefined. +** +** Algorithm: +** Gaussian elimination with partial pivoting. +** +** Speed: +** Very fast. +** +** Accuracy: +** Fairly accurate - errors 1 to 4 times those of routines optimized +** for accuracy. +** +** Example call (note handling of "adjustable dimension" 2D array): +** +** double a[MP][MP], v[MP], d; +** int j, iw[MP]; +** : +** slaDmat ( n, (double *) a, v, &d, &j, iw ); +** +** Last revision: 20 February 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define TINY 1e-20 + +{ + int k, imx, i, j, ki; + double amx, t, yk; + +/* Pointers to beginnings of rows in matrix a[n][n] */ + + double *ak, /* row k */ + *ai, /* row i */ + *aimx; /* row imx */ + + *jf = 0; + *d = 1.0; + for ( k = 0, ak = a; k < n; k++, ak += n ) { + amx = fabs ( ak[k] ); + imx = k; + aimx = ak; + if ( k != n ) { + for ( i = k + 1, ai = ak + n; i < n; i++, ai += n ) { + t = fabs ( ai[k] ); + if ( t > amx ) { + amx = t; + imx = i; + aimx = ai; + } + } + } + if ( amx < TINY ) { + *jf = -1; + } else { + if ( imx != k ) { + for ( j = 0; j < n; j++ ) { + t = ak[j]; + ak[j] = aimx[j]; + aimx[j] = t; + } + t = y[k]; + y[k] = y[imx]; + y[imx] = t; + *d = - *d; + } + iw[k] = imx; + *d *= ak[k]; + if ( fabs ( *d ) < TINY ) { + *jf = -1; + } else { + ak[k] = 1.0 / ak[k]; + for ( j = 0; j < n; j++ ) { + if ( j != k ) { + ak[j] *= ak[k]; + } + } + yk = y[k] * ak[k]; + y[k] = yk; + for ( i = 0, ai = a; i < n; i++, ai += n ) { + if ( i != k ) { + for ( j = 0; j < n; j++ ) { + if ( j != k ) { + ai[j] -= ai[k] * ak[j]; + } + } + y[i] -= ai[k] * yk; + } + } + for ( i = 0, ai = a; i < n; i++, ai += n ) { + if ( i != k ) { + ai[k] *= - ak[k]; + } + } + } + } + } + if ( *jf != 0 ) { + *d = 0.0; + } else { + for ( k = n; k-- > 0; ) { + ki = iw[k]; + if ( k != ki ) { + for ( i = 0, ai = a; i < n; i++, ai += n ) { + t = ai[k]; + ai[k] = ai[ki]; + ai[ki] = t; + } + } + } + } +} Index: trunk/MagicSoft/slalib/dmoon.c =================================================================== --- trunk/MagicSoft/slalib/dmoon.c (revision 731) +++ trunk/MagicSoft/slalib/dmoon.c (revision 731) @@ -0,0 +1,513 @@ +#include "slalib.h" +#include "slamac.h" +void slaDmoon ( double date, double pv[6] ) +/* +** - - - - - - - - - +** s l a D m o o n +** - - - - - - - - - +** +** Approximate geocentric position and velocity of the Moon +** (double precision). +** +** Given: +** date double TDB (loosely ET) as a Modified Julian Date +** (JD-2400000.5) +** +** Returned: +** pv double[6] Moon x,y,z,xdot,ydot,zdot, mean equator +** and equinox of date (AU, AU/s) +** +** Notes: +** +** 1 This routine is a full implementation of the algorithm +** published by Meeus (see reference). +** +** 2 Meeus quotes accuracies of 10 arcsec in longitude, 3 arcsec in +** latitude and 0.2 arcsec in HP (equivalent to about 20 km in +** distance). Comparison with JPL DE200 over the interval +** 1960-2025 gives RMS errors of 3.7 arcsec and 83 mas/hour in +** longitude, 2.3 arcsec and 48 mas/hour in latitude, 11 km +** and 81 mm/s in distance. The maximum errors over the same +** interval are 18 arcsec and 0.50 arcsec/hour in longitude, +** 11 arcsec and 0.24 arcsec/hour in latitude, 40 km and 0.29 m/s +** in distance. +** +** 3 The original algorithm is expressed in terms of the obsolete +** timescale Ephemeris Time. Either TDB or TT can be used, but +** not UT without incurring significant errors (30 arcsec at +** the present time) due to the Moon's 0.5 arcsec/sec movement. +** +** 4 The algorithm is based on pre IAU 1976 standards. However, +** the result has been moved onto the new (FK5) equinox, an +** adjustment which is in any case much smaller than the +** intrinsic accuracy of the procedure. +** +** 5 Velocity is obtained by a complete analytical differentiation +** of the Meeus model. +** +** Reference: +** Meeus, l'Astronomie, June 1984, p348. +** +** Defined in slamac.h: DD2R, DAS2R, DS2R, dmod +** +** Last revision: 22 January 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define CJ 3155760000.0 /* Seconds per Julian century */ + /* ( = 86400 * 36525 ) */ + +#define ERADAU 4.2635212653763e-5 /* Earth equatorial radius in AU */ + /* ( = 6378.137 / 149597870 ) */ + +#define B1950 1949.9997904423 /* Julian epoch of B1950 */ + +{ + double t, theta, sinom, cosom, domcom, wa, dwa, wb, dwb, wom, + dwom, sinwom, coswom, v, dv, coeff, emn, empn, dn, fn, en, + den, dtheta, ftheta, el, del, b, db, bf, dbf, p, dp, sp, r, + dr, x, y, z, xd, yd, zd, sel, cel, sb, cb, rcb, rbd, w, epj, + eqcor, eps, sineps, coseps, es, ec; + int n, i; + +/* +** Coefficients for fundamental arguments +** +** at J1900: T^0, T^1, T^2, T^3 +** at epoch: T^0, T^1 +** +** Units are degrees for position and Julian centuries for time. +*/ + +/* Moon's mean longitude */ + static double elp0 = 270.434164, + elp1 = 481267.8831, + elp2 = -0.001133, + elp3 = 0.0000019; + double elp, delp; + +/* Sun's mean anomaly */ + static double em0 = 358.475833, + em1 = 35999.0498, + em2 = -0.000150, + em3 = -0.0000033; + double em, dem; + +/* Moon's mean anomaly */ + static double emp0 = 296.104608, + emp1 = 477198.8491, + emp2 = 0.009192, + emp3 = 0.0000144; + double emp, demp; + +/* Moon's mean elongation */ + static double d0 = 350.737486, + d1 = 445267.1142, + d2 = -0.001436, + d3 = 0.0000019; + double d, dd; + +/* Mean distance of the Moon from its ascending node */ + static double f0 = 11.250889, + f1 = 483202.0251, + f2 = -0.003211, + f3 = -0.0000003; + double f, df; + +/* Longitude of the Moon's ascending node */ + static double om0 = 259.183275, + om1 = -1934.1420, + om2 = 0.002078, + om3 = 0.0000022; + double om, dom; + +/* Coefficients for (dimensionless) E factor */ + static double e1 = -0.002495, + e2 = -0.00000752; + double e, de, esq, desq; + +/* Coefficients for periodic variations etc */ + static double pac = 0.000233, pa0 = 51.2, + pa1 = 20.2; + static double pbc = -0.001778; + static double pcc = 0.000817; + static double pdc = 0.002011; + static double pec = 0.003964, pe0 = 346.560, + pe1 = 132.870, + pe2 = -0.0091731; + static double pfc = 0.001964; + static double pgc = 0.002541; + static double phc = 0.001964; + static double pic = -0.024691; + static double pjc = -0.004328, pj0 = 275.05, + pj1 = -2.30; + static double cw1 = 0.0004664; + static double cw2 = 0.0000754; + +/* +** Coefficients for Moon longitude, latitude, parallax series +*/ + struct term { + double coef; /* coefficient of L, B or P term (deg) */ + int nem; /* multiple of M in argument */ + int nemp; /* " " M' " " */ + int nd; /* " " D " " */ + int nf; /* " " F " " */ + int ne; /* power of e to multiply term by */ + }; + +/* +** Longitude coeff M M' D F n +*/ + static struct term tl[] = { { 6.288750, 0, 1, 0, 0, 0 }, + { 1.274018, 0, -1, 2, 0, 0 }, + { 0.658309, 0, 0, 2, 0, 0 }, + { 0.213616, 0, 2, 0, 0, 0 }, + { -0.185596, 1, 0, 0, 0, 1 }, + { -0.114336, 0, 0, 0, 2, 0 }, + { 0.058793, 0, -2, 2, 0, 0 }, + { 0.057212, -1, -1, 2, 0, 1 }, + { 0.053320, 0, 1, 2, 0, 0 }, + { 0.045874, -1, 0, 2, 0, 1 }, + { 0.041024, -1, 1, 0, 0, 1 }, + { -0.034718, 0, 0, 1, 0, 0 }, + { -0.030465, 1, 1, 0, 0, 1 }, + { 0.015326, 0, 0, 2, -2, 0 }, + { -0.012528, 0, 1, 0, 2, 0 }, + { -0.010980, 0, -1, 0, 2, 0 }, + { 0.010674, 0, -1, 4, 0, 0 }, + { 0.010034, 0, 3, 0, 0, 0 }, + { 0.008548, 0, -2, 4, 0, 0 }, + { -0.007910, 1, -1, 2, 0, 1 }, + { -0.006783, 1, 0, 2, 0, 1 }, + { 0.005162, 0, 1, -1, 0, 0 }, + { 0.005000, 1, 0, 1, 0, 1 }, + { 0.004049, -1, 1, 2, 0, 1 }, + { 0.003996, 0, 2, 2, 0, 0 }, + { 0.003862, 0, 0, 4, 0, 0 }, + { 0.003665, 0, -3, 2, 0, 0 }, + { 0.002695, -1, 2, 0, 0, 1 }, + { 0.002602, 0, 1, -2, -2, 0 }, + { 0.002396, -1, -2, 2, 0, 1 }, + { -0.002349, 0, 1, 1, 0, 0 }, + { 0.002249, -2, 0, 2, 0, 2 }, + { -0.002125, 1, 2, 0, 0, 1 }, + { -0.002079, 2, 0, 0, 0, 2 }, + { 0.002059, -2, -1, 2, 0, 2 }, + { -0.001773, 0, 1, 2, -2, 0 }, + { -0.001595, 0, 0, 2, 2, 0 }, + { 0.001220, -1, -1, 4, 0, 1 }, + { -0.001110, 0, 2, 0, 2, 0 }, + { 0.000892, 0, 1, -3, 0, 0 }, + { -0.000811, 1, 1, 2, 0, 1 }, + { 0.000761, -1, -2, 4, 0, 1 }, + { 0.000717, -2, 1, 0, 0, 2 }, + { 0.000704, -2, 1, -2, 0, 2 }, + { 0.000693, 1, -2, 2, 0, 1 }, + { 0.000598, -1, 0, 2, -2, 1 }, + { 0.000550, 0, 1, 4, 0, 0 }, + { 0.000538, 0, 4, 0, 0, 0 }, + { 0.000521, -1, 0, 4, 0, 1 }, + { 0.000486, 0, 2, -1, 0, 0 } }; + static int NL = ( sizeof tl / sizeof ( struct term ) ); + +/* +** Latitude coeff M M' D F n +*/ + static struct term tb[] = { { 5.128189, 0, 0, 0, 1, 0 }, + { 0.280606, 0, 1, 0, 1, 0 }, + { 0.277693, 0, 1, 0, -1, 0 }, + { 0.173238, 0, 0, 2, -1, 0 }, + { 0.055413, 0, -1, 2, 1, 0 }, + { 0.046272, 0, -1, 2, -1, 0 }, + { 0.032573, 0, 0, 2, 1, 0 }, + { 0.017198, 0, 2, 0, 1, 0 }, + { 0.009267, 0, 1, 2, -1, 0 }, + { 0.008823, 0, 2, 0, -1, 0 }, + { 0.008247, -1, 0, 2, -1, 1 }, + { 0.004323, 0, -2, 2, -1, 0 }, + { 0.004200, 0, 1, 2, 1, 0 }, + { 0.003372, -1, 0, -2, 1, 1 }, + { 0.002472, -1, -1, 2, 1, 1 }, + { 0.002222, -1, 0, 2, 1, 1 }, + { 0.002072, -1, -1, 2, -1, 1 }, + { 0.001877, -1, 1, 0, 1, 1 }, + { 0.001828, 0, -1, 4, -1, 0 }, + { -0.001803, 1, 0, 0, 1, 1 }, + { -0.001750, 0, 0, 0, 3, 0 }, + { 0.001570, -1, 1, 0, -1, 1 }, + { -0.001487, 0, 0, 1, 1, 0 }, + { -0.001481, 1, 1, 0, 1, 1 }, + { 0.001417, -1, -1, 0, 1, 1 }, + { 0.001350, -1, 0, 0, 1, 1 }, + { 0.001330, 0, 0, -1, 1, 0 }, + { 0.001106, 0, 3, 0, 1, 0 }, + { 0.001020, 0, 0, 4, -1, 0 }, + { 0.000833, 0, -1, 4, 1, 0 }, + { 0.000781, 0, 1, 0, -3, 0 }, + { 0.000670, 0, -2, 4, 1, 0 }, + { 0.000606, 0, 0, 2, -3, 0 }, + { 0.000597, 0, 2, 2, -1, 0 }, + { 0.000492, -1, 1, 2, -1, 1 }, + { 0.000450, 0, 2, -2, -1, 0 }, + { 0.000439, 0, 3, 0, -1, 0 }, + { 0.000423, 0, 2, 2, 1, 0 }, + { 0.000422, 0, -3, 2, -1, 0 }, + { -0.000367, 1, -1, 2, 1, 1 }, + { -0.000353, 1, 0, 2, 1, 1 }, + { 0.000331, 0, 0, 4, 1, 0 }, + { 0.000317, -1, 1, 2, 1, 1 }, + { 0.000306, -2, 0, 2, -1, 2 }, + { -0.000283, 0, 1, 0, 3, 0 } }; + static int NB = ( sizeof tb / sizeof ( struct term ) ); + +/* +** Parallax coeff M M' D F n +*/ + static struct term tp[] = { { 0.950724, 0, 0, 0, 0, 0 }, + { 0.051818, 0, 1, 0, 0, 0 }, + { 0.009531, 0, -1, 2, 0, 0 }, + { 0.007843, 0, 0, 2, 0, 0 }, + { 0.002824, 0, 2, 0, 0, 0 }, + { 0.000857, 0, 1, 2, 0, 0 }, + { 0.000533, -1, 0, 2, 0, 1 }, + { 0.000401, -1, -1, 2, 0, 1 }, + { 0.000320, -1, 1, 0, 0, 1 }, + { -0.000271, 0, 0, 1, 0, 0 }, + { -0.000264, 1, 1, 0, 0, 1 }, + { -0.000198, 0, -1, 0, 2, 0 }, + { 0.000173, 0, 3, 0, 0, 0 }, + { 0.000167, 0, -1, 4, 0, 0 }, + { -0.000111, 1, 0, 0, 0, 1 }, + { 0.000103, 0, -2, 4, 0, 0 }, + { -0.000084, 0, 2, -2, 0, 0 }, + { -0.000083, 1, 0, 2, 0, 1 }, + { 0.000079, 0, 2, 2, 0, 0 }, + { 0.000072, 0, 0, 4, 0, 0 }, + { 0.000064, -1, 1, 2, 0, 1 }, + { -0.000063, 1, -1, 2, 0, 1 }, + { 0.000041, 1, 0, 1, 0, 1 }, + { 0.000035, -1, 2, 0, 0, 1 }, + { -0.000033, 0, 3, -2, 0, 0 }, + { -0.000030, 0, 1, 1, 0, 0 }, + { -0.000029, 0, 0, -2, 2, 0 }, + { -0.000029, 1, 2, 0, 0, 1 }, + { 0.000026, -2, 0, 2, 0, 2 }, + { -0.000023, 0, 1, -2, 2, 0 }, + { 0.000019, -1, -1, 4, 0, 1 } }; + static int NP = ( sizeof tp / sizeof ( struct term ) ); + + + +/* --------------------- */ +/* Execution starts here */ +/* --------------------- */ + +/* Centuries since J1900 */ + t = ( date - 15019.5 ) / 36525.0; + +/* --------------------- */ +/* Fundamental arguments */ +/* --------------------- */ + +/* Arguments (radians) and derivatives (radians per Julian century) + for the current epoch */ + +/* Moon's mean longitude */ + elp = DD2R * dmod ( elp0 + ( elp1 + ( elp2 + elp3 * t ) * t ) * t, + 360.0 ); + delp = DD2R * ( elp1 + ( 2.0 * elp2 + 3.0 *elp3 * t ) * t ); + +/* Sun's mean anomaly */ + em = DD2R * dmod ( em0 + ( em1 + ( em2 + em3 * t ) * t ) * t, 360.0 ); + dem = DD2R * ( em1 + ( 2.0 * em2 + 3.0 * em3 * t ) * t ); + +/* Moon's mean anomaly */ + emp = DD2R * dmod ( emp0 + ( emp1 + ( emp2 + emp3 * t ) * t ) * t, + 360.0 ); + demp = DD2R * ( emp1 + ( 2.0 * emp2 + 3.0 * emp3 * t ) * t ); + +/* Moon's mean elongation */ + d = DD2R * dmod ( d0 + ( d1 + ( d2 + d3 * t ) * t ) * t, 360.0 ); + dd = DD2R * ( d1 + ( 2.0 * d2 + 3.0 * d3 * t ) * t ); + +/* Mean distance of the Moon from its ascending node */ + f = DD2R * dmod ( f0 + ( f1 + ( f2 + f3 * t ) * t ) * t, 360.0 ); + df = DD2R * ( f1 + ( 2.0 * f2 + 3.0 * f3 * t ) * t ); + +/* Longitude of the Moon's ascending node */ + om = DD2R * dmod ( om0 + ( om1 + ( om2 + om3 * t ) * t ) * t, 360.0 ); + dom = DD2R * ( om1 + ( 2.0 * om2 + 3.0 * om3 * t ) * t ); + sinom = sin ( om ); + cosom = cos ( om ); + domcom = dom * cosom; + +/* Add the periodic variations */ + theta = DD2R * ( pa0 + pa1 * t ); + wa = sin ( theta ); + dwa = DD2R * pa1 * cos ( theta ); + theta = DD2R * ( pe0 + ( pe1 + pe2 * t ) * t ); + wb = pec * sin ( theta ); + dwb = DD2R * pec*( pe1 + 2.0 * pe2 * t ) * cos ( theta ); + elp += DD2R * ( pac * wa + wb + pfc * sinom ); + delp += DD2R * ( pac * dwa + dwb + pfc * domcom ); + em += DD2R * pbc * wa; + dem += DD2R * pbc * dwa; + emp += DD2R * ( pcc * wa + wb + pgc * sinom ); + demp += DD2R * ( pcc * dwa + dwb + pgc * domcom ); + d += DD2R * ( pdc * wa + wb + phc * sinom ); + dd += DD2R * ( pdc * dwa + dwb + phc * domcom ); + wom = om + DD2R * ( pj0 + pj1 * t ); + dwom = dom + DD2R * pj1; + sinwom = sin ( wom ); + coswom = cos ( wom ); + f += DD2R * ( wb + pic * sinom + pjc * sinwom ); + df += DD2R * ( dwb + pic * domcom + pjc * dwom * coswom ); + +/* E-factor, and square */ + e = 1.0 + ( e1 + e2 * t ) * t; + de = e1 + 2.0 * e2 * t; + esq = e * e; + desq = 2.0 * e * de; + +/* ----------------- */ +/* Series expansions */ +/* ----------------- */ + +/* Longitude */ + v = 0.0; + dv = 0.0; + for ( n = NL -1; n >= 0; n-- ) { + coeff = tl[n].coef; + emn = (double) tl[n].nem; + empn = (double) tl[n].nemp; + dn = (double) tl[n].nd; + fn = (double) tl[n].nf; + i = tl[n].ne; + if ( i == 0 ) { + en = 1.0; + den = 0.0; + } else if ( i == 1 ) { + en = e; + den = de; + } else { + en = esq; + den = desq; + } + theta = emn * em + empn * emp + dn * d + fn * f; + dtheta = emn * dem + empn * demp + dn * dd + fn * df; + ftheta = sin ( theta ); + v += coeff * ftheta * en; + dv += coeff * ( cos ( theta ) * dtheta * en + ftheta * den ); + } + el = elp + DD2R * v; + del = ( delp + DD2R * dv ) / CJ; + +/* Latitude */ + v = 0.0; + dv = 0.0; + for ( n = NB - 1; n >= 0; n-- ) { + coeff = tb[n].coef; + emn = (double) tb[n].nem; + empn = (double) tb[n].nemp; + dn = (double) tb[n].nd; + fn = (double) tb[n].nf; + i = tb[n].ne; + if ( i == 0 ) { + en = 1.0; + den = 0.0; + } else if ( i == 1 ) { + en = e; + den = de; + } else { + en = esq; + den = desq; + } + theta = emn * em + empn * emp + dn * d + fn * f; + dtheta = emn * dem + empn * demp + dn * dd + fn * df; + ftheta = sin ( theta ); + v += coeff * ftheta * en; + dv += coeff * ( cos ( theta ) * dtheta * en + ftheta * den ); + } + bf = 1.0 - cw1 * cosom - cw2 * coswom; + dbf = cw1 * dom * sinom + cw2 * dwom * sinwom; + b = DD2R * v * bf; + db = DD2R * ( dv * bf + v * dbf ) / CJ; + +/* Parallax */ + v = 0.0; + dv = 0.0; + for ( n = NP - 1; n >= 0; n-- ) { + coeff = tp[n].coef; + emn = (double) tp[n].nem; + empn = (double) tp[n].nemp; + dn = (double) tp[n].nd; + fn = (double) tp[n].nf; + i = tp[n].ne; + if ( i == 0 ) { + en = 1.0; + den = 0.0; + } else if ( i == 1 ) { + en = e; + den = de; + } else { + en = esq; + den = desq; + } + theta = emn * em + empn * emp + dn * d + fn * f; + dtheta = emn * dem + empn * demp + dn * dd + fn * df; + ftheta = cos ( theta ); + v += coeff * ftheta * en; + dv += coeff* ( - sin ( theta ) * dtheta * en + ftheta * den ); + } + p = DD2R * v; + dp = DD2R * dv / CJ; + +/* ------------------------------ */ +/* Transformation into final form */ +/* ------------------------------ */ + +/* Parallax to distance (AU, AU/sec) */ + sp = sin ( p ); + r = ERADAU / sp; + dr = - r * dp * cos ( p ) / sp; + +/* Longitude, latitude to x, y, z (AU) */ + sel = sin ( el ); + cel = cos ( el ); + sb = sin ( b ); + cb = cos ( b ); + rcb = r * cb; + rbd = r * db; + w = rbd * sb - cb * dr; + x = rcb * cel; + y = rcb * sel; + z = r * sb; + xd = - y * del - w * cel; + yd = x * del - w * sel; + zd = rbd * cb + sb * dr; + +/* Julian centuries since J2000 */ + t = ( date - 51544.5 ) / 36525.0; + +/* Fricke equinox correction */ + epj = 2000.0 + t * 100.0; + eqcor = DS2R * ( 0.035 + 0.00085 * ( epj - B1950 ) ); + +/* Mean obliquity (IAU 1976) */ + eps = DAS2R * + ( 84381.448 + ( - 46.8150 + ( - 0.00059 + 0.001813 * t ) * t ) * t ); + +/* To the equatorial system, mean of date, FK5 system */ + sineps = sin ( eps ); + coseps = cos ( eps ); + es = eqcor * sineps; + ec = eqcor * coseps; + pv[0] = x - ec * y + es * z; + pv[1] = eqcor * x + y * coseps - z * sineps; + pv[2] = y * sineps + z * coseps; + pv[3] = xd - ec * yd + es * zd; + pv[4] = eqcor * xd + yd * coseps - zd * sineps; + pv[5] = yd * sineps + zd * coseps; +} Index: trunk/MagicSoft/slalib/dmxm.c =================================================================== --- trunk/MagicSoft/slalib/dmxm.c (revision 731) +++ trunk/MagicSoft/slalib/dmxm.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaDmxm ( double a[3][3], double b[3][3], double c[3][3] ) +/* +** - - - - - - - - +** s l a D m x m +** - - - - - - - - +** +** Product of two 3x3 matrices: +** matrix c = matrix a x matrix b +** +** (double precision) +** +** Given: +** a double[3][3] matrix +** b double[3][3] matrix +** +** Returned: +** c double[3][3] matrix result +** +** Note: the same array may be nominated more than once. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j, k; + double w, wm[3][3]; + +/* Multiply into scratch matrix */ + for ( i = 0; i < 3; i++ ) { + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( k = 0; k < 3; k++ ) { + w += a[i][k] * b[k][j]; + } + wm[i][j] = w; + } + } + +/* Return the result */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + c[i][j] = wm[i][j]; + } + } +} Index: trunk/MagicSoft/slalib/dmxv.c =================================================================== --- trunk/MagicSoft/slalib/dmxv.c (revision 731) +++ trunk/MagicSoft/slalib/dmxv.c (revision 731) @@ -0,0 +1,44 @@ +#include "slalib.h" +#include "slamac.h" +void slaDmxv ( double dm[3][3], double va[3], double vb[3] ) +/* +** - - - - - - - - +** s l a D m x v +** - - - - - - - - +** +** Performs the 3-d forward unitary transformation: +** vector vb = matrix dm * vector va +** +** (double precision) +** +** Given: +** dm double[3][3] matrix +** va double[3] vector +** +** Returned: +** vb double[3] result vector +** +** Note: va and vb may be the same array. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j; + double w, vw[3]; + +/* Matrix dm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dm[j][i] * va[i]; + } + vw[j] = w; + } + +/* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} Index: trunk/MagicSoft/slalib/dpav.c =================================================================== --- trunk/MagicSoft/slalib/dpav.c (revision 731) +++ trunk/MagicSoft/slalib/dpav.c (revision 731) @@ -0,0 +1,55 @@ +#include "slalib.h" +#include "slamac.h" +double slaDpav ( double v1 [ 3 ], double v2 [ 3 ] ) +/* +** - - - - - - - - +** s l a D p a v +** - - - - - - - - +** +** Position angle of one celestial direction with respect to another. +** +** (double precision) +** +** Given: +** v1 double[3] direction cosines of one point +** v2 double[3] direction cosines of the other point +** +** (The coordinate frames correspond to RA,Dec, Long,Lat etc.) +** +** The result is the bearing (position angle), in radians, of point +** v2 with respect to point v1. It is in the range +/- pi. The +** sense is such that if v2 is a small distance east of v1, the +** bearing is about +pi/2. Zero is returned if the two points +** are coincident. +** +** The vectors v1 and v2 need not be unit vectors. +** +** The routine slaDbear performs an equivalent function except +** that the points are specified in the form of spherical +** coordinates. +** +** Last revision: 12 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x0, y0, z0, w, x1, y1, z1, s, c; + + +/* Unit vector to point 1. */ + x0 = v1 [ 0 ]; + y0 = v1 [ 1 ]; + z0 = v1 [ 2 ]; + w = sqrt ( x0 * x0 + y0 * y0 + z0 * z0 ); + if ( w != 0.0 ) { x0 /= w; y0 /= w; z0 /= w; } + +/* Vector to point 2. */ + x1 = v2 [ 0 ]; + y1 = v2 [ 1 ]; + z1 = v2 [ 2 ]; + +/* Position angle. */ + s = y1 * x0 - x1 * y0; + c = z1 * ( x0 * x0 + y0 * y0 ) - z0 * ( x1 * x0 + y1 * y0 ); + return ( s != 0.0 || c != 0.0 ) ? atan2 ( s, c ) : 0.0; +} Index: trunk/MagicSoft/slalib/dr2af.c =================================================================== --- trunk/MagicSoft/slalib/dr2af.c (revision 731) +++ trunk/MagicSoft/slalib/dr2af.c (revision 731) @@ -0,0 +1,33 @@ +#include "slalib.h" +#include "slamac.h" +void slaDr2af ( int ndp, double angle, char *sign, int idmsf[4] ) +/* +** - - - - - - - - - +** s l a D r 2 a f +** - - - - - - - - - +** +** Convert an angle in radians to degrees, arcminutes, arcseconds. +** +** (double precision) +** +** Given: +** ndp int number of decimal places of arcseconds +** angle double angle in radians +** +** Returned: +** sign char* '+' or '-' +** idmsf int[4] degrees, arcminutes, arcseconds, fraction +** +** Called: +** slaDd2tf +** +** Defined in slamac.h: D15B2P +** +** Last revision: 19 November 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Scale then use days to h,m,s routine */ + slaDd2tf ( ndp, angle * D15B2P, sign, idmsf ); +} Index: trunk/MagicSoft/slalib/dr2tf.c =================================================================== --- trunk/MagicSoft/slalib/dr2tf.c (revision 731) +++ trunk/MagicSoft/slalib/dr2tf.c (revision 731) @@ -0,0 +1,33 @@ +#include "slalib.h" +#include "slamac.h" +void slaDr2tf ( int ndp, double angle, char *sign, int ihmsf[4] ) +/* +** - - - - - - - - - +** s l a D r 2 t f +** - - - - - - - - - +** +** Convert an angle in radians to hours, minutes, seconds. +** +** (double precision) +** +** Given: +** ndp int number of decimal places of seconds +** angle double angle in radians +** +** Returned: +** sign char* '+' or '-' +** ihmsf int[4] hours, minutes, seconds, fraction +** +** Called: +** slaDd2tf +** +** Defined in slamac.h: D2PI +** +** Last revision: 18 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Scale then use days to h,m,s routine */ + slaDd2tf ( ndp, angle / D2PI, sign, ihmsf ); +} Index: trunk/MagicSoft/slalib/drange.c =================================================================== --- trunk/MagicSoft/slalib/drange.c (revision 731) +++ trunk/MagicSoft/slalib/drange.c (revision 731) @@ -0,0 +1,29 @@ +#include "slalib.h" +#include "slamac.h" +double slaDrange ( double angle ) +/* +** - - - - - - - - - - +** s l a D r a n g e +** - - - - - - - - - - +** +** Normalize angle into range +/- pi. +** +** (double precision) +** +** Given: +** angle double the angle in radians +** +** The result is angle expressed in the +/- pi (double precision). +** +** Defined in slamac.h: DPI, D2PI, dmod +** +** Last revision: 19 March 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double w; + + w = dmod ( angle, D2PI ); + return ( fabs ( w ) < DPI ) ? w : w - dsign ( D2PI, angle ); +} Index: trunk/MagicSoft/slalib/dranrm.c =================================================================== --- trunk/MagicSoft/slalib/dranrm.c (revision 731) +++ trunk/MagicSoft/slalib/dranrm.c (revision 731) @@ -0,0 +1,29 @@ +#include "slalib.h" +#include "slamac.h" +double slaDranrm ( double angle ) +/* +** - - - - - - - - - - +** s l a D r a n r m +** - - - - - - - - - - +** +** Normalize angle into range 0-2 pi. +** +** (double precision) +** +** Given: +** angle double the angle in radians +** +** The result is angle expressed in the range 0-2 pi (double). +** +** Defined in slamac.h: D2PI, dmod +** +** Last revision: 19 March 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double w; + + w = dmod ( angle, D2PI ); + return ( w >= 0.0 ) ? w : w + D2PI; +} Index: trunk/MagicSoft/slalib/ds2c6.c =================================================================== --- trunk/MagicSoft/slalib/ds2c6.c (revision 731) +++ trunk/MagicSoft/slalib/ds2c6.c (revision 731) @@ -0,0 +1,53 @@ +#include "slalib.h" +#include "slamac.h" +void slaDs2c6 ( double a, double b, double r, double ad, + double bd, double rd, double v[6] ) +/* +** - - - - - - - - - +** s l a D s 2 c 6 +** - - - - - - - - - +** +** Conversion of position & velocity in spherical coordinates +** to Cartesian coordinates. +** +** (double precision) +** +** Given: +** a double longitude (radians) +** b double latitude (radians) +** r double radial coordinate +** ad double longitude derivative (radians per unit time) +** bd double latitude derivative (radians per unit time) +** rd double radial derivative +** +** Returned: +** v double[6] Cartesian position & velocity vector +** +** Last revision: 16 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sa, ca, sb, cb, rcb, x, y, rbd, w; + +/* Useful functions */ + sa = sin ( a ); + ca = cos ( a ); + sb = sin ( b ); + cb = cos ( b ); + rcb = r * cb; + x = rcb * ca; + y = rcb * sa; + rbd = r * bd; + w = rbd * sb - cb * rd; + +/* Position */ + v[0] = x; + v[1] = y; + v[2] = r * sb; + +/* Velocity */ + v[3] = -y * ad - w * ca; + v[4] = x * ad - w * sa; + v[5] = rbd * cb + sb * rd; +} Index: trunk/MagicSoft/slalib/ds2tp.c =================================================================== --- trunk/MagicSoft/slalib/ds2tp.c (revision 731) +++ trunk/MagicSoft/slalib/ds2tp.c (revision 731) @@ -0,0 +1,63 @@ +#include "slalib.h" +#include "slamac.h" +void slaDs2tp ( double ra, double dec, double raz, double decz, + double *xi, double *eta, int *j ) +/* +** - - - - - - - - - +** s l a D s 2 t p +** - - - - - - - - - +** +** Projection of spherical coordinates onto tangent plane +** ('gnomonic' projection - 'standard coordinates'). +** +** (double precision) +** +** Given: +** ra,dec double spherical coordinates of point to be projected +** raz,decz double spherical coordinates of tangent point +** +** Returned: +** *xi,*eta double rectangular coordinates on tangent plane +** *j int status: 0 = OK, star on tangent plane +** 1 = error, star too far from axis +** 2 = error, antistar on tangent plane +** 3 = error, antistar too far from axis +** +** Last revision: 18 July 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +#define TINY 1e-6 +{ + double sdecz, sdec, cdecz, cdec, radif, sradif, cradif, denom; + + +/* Trig functions */ + sdecz = sin ( decz ); + sdec = sin ( dec ); + cdecz = cos ( decz ); + cdec = cos ( dec ); + radif = ra - raz; + sradif = sin ( radif ); + cradif = cos ( radif ); + +/* Reciprocal of star vector length to tangent plane */ + denom = sdec * sdecz + cdec * cdecz * cradif; + +/* Handle vectors too far from axis */ + if ( denom > TINY ) { + *j = 0; + } else if ( denom >= 0.0 ) { + *j = 1; + denom = TINY; + } else if ( denom > -TINY ) { + *j = 2; + denom = -TINY; + } else { + *j = 3; + } + +/* Compute tangent plane coordinates (even in dubious cases) */ + *xi = cdec * sradif / denom; + *eta = ( sdec * cdecz - cdec * sdecz * cradif ) / denom; +} Index: trunk/MagicSoft/slalib/dsep.c =================================================================== --- trunk/MagicSoft/slalib/dsep.c (revision 731) +++ trunk/MagicSoft/slalib/dsep.c (revision 731) @@ -0,0 +1,47 @@ +#include "slalib.h" +#include "slamac.h" +double slaDsep ( double a1, double b1, double a2, double b2 ) +/* +** - - - - - - - - +** s l a D s e p +** - - - - - - - - +** +** Angle between two points on a sphere. +** +** (double precision) +** +** Given: +** a1,b1 double spherical coordinates of one point +** a2,b2 double spherical coordinates of the other point +** +** (The spherical coordinates are RA,dec, long,lat etc, in radians.) +** +** The result is the angle, in radians, between the two points. It +** is always positive. +** +** Called: slaDcs2c +** +** Last revision: 5 October 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + double d, v1[3], v2[3], s2, c2; + +/* Convert coordinates from spherical to Cartesian */ + slaDcs2c ( a1, b1, v1 ); + slaDcs2c ( a2, b2, v2 ); + +/* Modulus squared of half the difference vector */ + s2 = 0.0; + for ( i = 0; i < 3; i++ ) { + d = v1[i] - v2[i]; + s2 += d * d; + } + s2 /= 4.0; + +/* Angle between the vectors */ + c2 = 1.0 - s2; + return 2.0 * atan2 ( sqrt ( s2 ), sqrt ( gmax ( 0.0, c2 ))); +} Index: trunk/MagicSoft/slalib/dt.c =================================================================== --- trunk/MagicSoft/slalib/dt.c (revision 731) +++ trunk/MagicSoft/slalib/dt.c (revision 731) @@ -0,0 +1,81 @@ +#include "slalib.h" +#include "slamac.h" +double slaDt ( double epoch ) +/* +** - - - - - - +** s l a D t +** - - - - - - +** +** Estimate the offset between dynamical time and Universal Time +** for a given historical epoch. +** +** (double precision) +** +** Given: +** epoch double (Julian) epoch (e.g. 1850.0) +** +** The result is a rough estimate of ET-UT (after 1984, TT-UT1) at +** the given epoch, in seconds. +** +** Notes: +** +** 1 Depending on the epoch, one of three parabolic approximations +** is used: +** +** before 979 Stephenson & Morrison's 390 BC to AD 948 model +** 979 to 1708 Stephenson & Morrison's 948 to 1600 model +** after 1708 McCarthy & Babcock's post-1650 model +** +** The breakpoints are chosen to ensure continuity: they occur +** at places where the adjacent models give the same answer as +** each other. +** +** 2 The accuracy is modest, with errors of up to 20 sec during +** the interval since 1650, rising to perhaps 30 min by 1000 BC. +** Comparatively accurate values from AD 1600 are tabulated in +** the Astronomical Almanac (see section K8 of the 1995 AA). +** +** 3 The use of double-precision for both argument and result is +** purely for compatibility with other SLALIB time routines. +** +** 4 The models used are based on a lunar tidal acceleration value +** of -26.00 arcsec per century. +** +** Reference: Explanatory Supplement to the Astronomical Almanac, +** ed P.K.Seidelmann, University Science Books (1992), +** section 2.553, p83. This contains references to +** the Stephenson & Morrison and McCarthy & Babcock +** papers. +** +** Last revision: 14 February 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double t, w, s; + + +/* Centuries since 1800 */ + t = ( epoch - 1800.0 ) / 100.0; + +/* Select model */ + if ( epoch >= 1708.185161980887 ) { + + /* Post-1708: use McCarthy & Babcock */ + w = t - 0.19; + s = 5.156 + 13.3066 * w * w; + } else { + if ( epoch >= 979.0258204760233 ) { + + /* 979-1708: use Stephenson & Morrison's 948-1600 model */ + s = 25.5 * t * t; + } else { + + /* Pre-979: use Stephenson & Morrison's 390 BC to AD 948 model */ + s = 1360.0 + ( 320.0 + 44.3 * t ) * t; + } + } + +/* Result */ + return s; +} Index: trunk/MagicSoft/slalib/dtf2d.c =================================================================== --- trunk/MagicSoft/slalib/dtf2d.c (revision 731) +++ trunk/MagicSoft/slalib/dtf2d.c (revision 731) @@ -0,0 +1,59 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtf2d ( int ihour, int imin, double sec, double *days, int *j ) +/* +** - - - - - - - - - +** s l a D t f 2 d +** - - - - - - - - - +** +** Convert hours, minutes, seconds to days. +** +** (double precision) +** +** Given: +** ihour int hours +** imin int minutes +** sec double seconds +** +** Returned: +** *days double interval in days +** *j int status: 0 = OK +** 1 = ihour outside range 0-23 +** 2 = imin outside range 0-59 +** 3 = sec outside range 0-59.999... +** +** Notes: +** +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Last revision: 31 January 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Seconds per day */ +#define D2S 86400.0 + +{ +/* Preset status */ + *j = 0; + +/* Validate sec, min, hour */ + if ( ( sec < 0.0 ) || ( sec >= 60.0 ) ) { + *j = 3; + return; + } + if ( ( imin < 0 ) || ( imin > 59 ) ) { + *j = 2; + return; + } + if ( ( ihour < 0 ) || ( ihour > 23 ) ) { + *j = 1; + return; + } + +/* Compute interval */ + *days = ( 60.0 * ( 60.0 * (double) ihour + (double) imin ) + sec ) / D2S; +} Index: trunk/MagicSoft/slalib/dtf2r.c =================================================================== --- trunk/MagicSoft/slalib/dtf2r.c (revision 731) +++ trunk/MagicSoft/slalib/dtf2r.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtf2r ( int ihour, int imin, double sec, double *rad, int *j ) +/* +** - - - - - - - - - +** s l a D t f 2 r +** - - - - - - - - - +** +** Convert hours, minutes, seconds to radians. +** +** (double precision) +** +** Given: +** ihour int hours +** imin int minutes +** sec double seconds +** +** Returned: +** *rad double angle in radians +** *j int status: 0 = OK +** 1 = ihour outside range 0-23 +** 2 = imin outside range 0-59 +** 3 = sec outside range 0-59.999... +** +** Called: +** slaDtf2d +** +** Notes: +** +** 1) The result is computed even if any of the range checks fail. +** +** 2) The sign must be dealt with outside this routine. +** +** Defined in slamac.h: D2PI +** +** Last revision: 30 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double turns; + +/* Convert to turns */ + slaDtf2d ( ihour, imin, sec, &turns, j ); + +/* To radians */ + *rad = D2PI * turns; +} Index: trunk/MagicSoft/slalib/dtp2s.c =================================================================== --- trunk/MagicSoft/slalib/dtp2s.c (revision 731) +++ trunk/MagicSoft/slalib/dtp2s.c (revision 731) @@ -0,0 +1,35 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtp2s ( double xi, double eta, double raz, double decz, + double *ra, double *dec ) +/* +** - - - - - - - - - +** s l a D t p 2 s +** - - - - - - - - - +** +** Transform tangent plane coordinates into spherical. +** +** (double precision) +** +** Given: +** xi,eta double tangent plane rectangular coordinates +** raz,decz double spherical coordinates of tangent point +** +** Returned: +** *ra,*dec double spherical coordinates (0-2pi,+/-pi/2) +** +** Called: slaDranrm +** +** Last revision: 3 June 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sdecz, cdecz, denom; + + sdecz = sin ( decz ); + cdecz = cos ( decz ); + denom = cdecz - eta * sdecz; + *ra = slaDranrm ( atan2 ( xi, denom ) + raz ); + *dec = atan2 ( sdecz + eta * cdecz, sqrt ( xi * xi + denom * denom ) ); +} Index: trunk/MagicSoft/slalib/dtp2v.c =================================================================== --- trunk/MagicSoft/slalib/dtp2v.c (revision 731) +++ trunk/MagicSoft/slalib/dtp2v.c (revision 731) @@ -0,0 +1,53 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtp2v ( double xi, double eta, double v0[3], double v[3] ) +/* +** - - - - - - - - - +** s l a D t p 2 v +** - - - - - - - - - +** +** Given the tangent-plane coordinates of a star and the direction +** cosines of the tangent point, determine the direction cosines +** of the star. +** +** (double precision) +** +** Given: +** xi,eta double tangent plane coordinates of star +** v0 double[3] direction cosines of tangent point +** +** Returned: +** v double[3] direction cosines of star +** +** Notes: +** +** 1 If vector v0 is not of unit length, the returned vector v will +** be wrong. +** +** 2 If vector v0 points at a pole, the returned vector v will be +** based on the arbitrary assumption that the RA of the tangent +** point is zero. +** +** 3 This routine is the Cartesian equivalent of the routine slaDtp2s. +** +** Last revision: 12 February 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, f, r; + + + x = v0[0]; + y = v0[1]; + z = v0[2]; + f = sqrt ( 1.0 + xi * xi + eta * eta ); + r = sqrt ( x * x + y * y ); + if ( r == 0.0 ) { + r = 1e-20; + x = r; + } + v[0] = ( x - ( xi * y + eta * x * z ) / r ) / f; + v[1] = ( y + ( xi * x - eta * y * z ) / r ) / f; + v[2] = ( z + eta * r ) / f; +} Index: trunk/MagicSoft/slalib/dtps2c.c =================================================================== --- trunk/MagicSoft/slalib/dtps2c.c (revision 731) +++ trunk/MagicSoft/slalib/dtps2c.c (revision 731) @@ -0,0 +1,84 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtps2c ( double xi, double eta, double ra, double dec, + double *raz1, double *decz1, + double *raz2, double *decz2, int *n ) +/* +** - - - - - - - - - - +** s l a D t p s 2 c +** - - - - - - - - - - +** +** From the tangent plane coordinates of a star of known RA,Dec, +** determine the RA,Dec of the tangent point. +** +** (double precision) +** +** Given: +** xi,eta double tangent plane rectangular coordinates +** ra,dec double spherical coordinates +** +** Returned: +** *raz1,*decz1 double spherical coordinates of TP, solution 1 +** *raz2,*decz2 double spherical coordinates of TP, solution 2 +** *n int number of solutions: +** 0 = no solutions returned (note 2) +** 1 = only the first solution is useful (note 3) +** 2 = both solutions are useful (note 3) +** +** +** Notes: +** +** 1 The raz1 and raz2 values are returned in the range 0-2pi. +** +** 2 Cases where there is no solution can only arise near the poles. +** For example, it is clearly impossible for a star at the pole +** itself to have a non-zero xi value, and hence it is +** meaningless to ask where the tangent point would have to be +** to bring about this combination of xi and dec. +** +** 3 Also near the poles, cases can arise where there are two useful +** solutions. The argument n indicates whether the second of the +** two solutions returned is useful; n=1 indicates only one useful +** solution, the usual case; under these circumstances, the second +** solution corresponds to the "over-the-pole" case, and this is +** reflected in the values of raz2 and decz2 which are returned. +** +** 4 The decz1 and decz2 values are returned in the range +/-pi, but +** in the usual, non-pole-crossing, case, the range is +/-pi/2. +** +** 5 This routine is the spherical equivalent of the routine slaDtpv2c. +** +** Called: slaDranrm +** +** Last revision: 5 June 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x2, y2, sd, cd, sdf, r2, r, s, c; + + x2 = xi * xi; + y2 = eta * eta; + sd = sin ( dec ); + cd = cos ( dec ); + sdf = sd * sqrt ( 1.0 + x2 + y2 ); + r2 = cd * cd * ( 1.0 + y2 ) - sd * sd * x2; + if ( r2 >= 0.0 ) { + r = sqrt ( r2 ); + s = sdf - eta * r; + c = sdf * eta + r; + if ( xi == 0.0 && r == 0.0 ) { + r = 1.0; + } + *raz1 = slaDranrm ( ra - atan2 ( xi, r ) ); + *decz1 = atan2 ( s, c ); + r = -r; + s = sdf - eta * r; + c = sdf * eta + r; + *raz2 = slaDranrm ( ra - atan2 ( xi, r ) ); + *decz2 = atan2 ( s, c ); + *n = ( fabs ( sdf ) < 1.0 ) ? 1 : 2; + } else { + *n = 0; + } +} Index: trunk/MagicSoft/slalib/dtpv2c.c =================================================================== --- trunk/MagicSoft/slalib/dtpv2c.c (revision 731) +++ trunk/MagicSoft/slalib/dtpv2c.c (revision 731) @@ -0,0 +1,76 @@ +#include "slalib.h" +#include "slamac.h" +void slaDtpv2c ( double xi, double eta, double v[3], double v01[3], + double v02[3], int *n ) +/* +** - - - - - - - - - - +** s l a D t p v 2 c +** - - - - - - - - - - +** +** Given the tangent-plane coordinates of a star and its direction +** cosines, determine the direction cosines of the tangent-point. +** +** (double precision) +** +** Given: +** xi,eta double tangent plane coordinates of star +** v double[3] direction cosines of star +** +** Returned: +** v01 double[3] direction cosines of TP, solution 1 +** v02 double[3] direction cosines of TP, solution 2 +** *n int number of solutions: +** 0 = no solutions returned (note 2) +** 1 = only the first solution is useful (note 3) +** 2 = both solutions are useful (note 3) +** +** Notes: +** +** 1 The vector v must be of unit length or the result will be wrong. +** +** 2 Cases where there is no solution can only arise near the poles. +** For example, it is clearly impossible for a star at the pole +** itself to have a non-zero xi value, and hence it is meaningless +** to ask where the tangent point would have to be. +** +** 3 Also near the poles, cases can arise where there are two useful +** solutions. The argument n indicates whether the second of the +** two solutions returned is useful; n=1 indicates only one useful +** solution, the usual case. Under these circumstances, the second +** solution can be regarded as valid if the vector v02 is interpreted +** as the "over-the-pole" case. +** +** 4 This routine is the Cartesian equivalent of the routine slaDtps2c. +** +** Last revision: 5 June 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z, rxy2, xi2, eta2p1, sdf, r2, r, c; + + + x = v[0]; + y = v[1]; + z = v[2]; + rxy2 = x * x + y * y; + xi2 = xi * xi; + eta2p1 = eta*eta + 1.0; + sdf = z * sqrt ( xi2 + eta2p1 ); + r2 = rxy2 * eta2p1 - z * z * xi2; + if ( r2 > 0.0 ) { + r = sqrt( r2 ); + c = ( sdf * eta + r ) / ( eta2p1 * sqrt ( rxy2 * ( r2 + xi2 ) ) ); + v01[0] = c * ( x * r + y * xi ); + v01[1] = c * ( y * r - x * xi ); + v01[2] = ( sdf - eta * r ) / eta2p1; + r = - r; + c = ( sdf * eta + r ) / ( eta2p1 * sqrt ( rxy2 * ( r2 + xi2 ) ) ); + v02[0] = c * ( x * r + y * xi ); + v02[1] = c * ( y * r - x * xi ); + v02[2] = ( sdf - eta * r ) / eta2p1; + *n = ( fabs ( sdf ) < 1.0 ) ? 1 : 2; + } else { + *n = 0; + } +} Index: trunk/MagicSoft/slalib/dtt.c =================================================================== --- trunk/MagicSoft/slalib/dtt.c (revision 731) +++ trunk/MagicSoft/slalib/dtt.c (revision 731) @@ -0,0 +1,40 @@ +#include "slalib.h" +#include "slamac.h" +double slaDtt ( double utc ) +/* +** - - - - - - - +** s l a D t t +** - - - - - - - +** +** Increment to be applied to Coordinated Universal Time UTC to give +** Terrestrial Time TT (formerly Ephemeris Time ET). +** +** (double precision) +** +** Given: +** utc double UTC date as a modified JD (JD-2400000.5) +** +** Result: TT-UTC in seconds +** +** Notes: +** +** 1 The UTC is specified to be a date rather than a time to indicate +** that care needs to be taken not to specify an instant which lies +** within a leap second. Though in most cases UTC can include the +** fractional part, correct behaviour on the day of a leap second +** can only be guaranteed up to the end of the second 23:59:59. +** +** 2 Pre 1972 January 1 a fixed value of 10 + ET-TAI is returned. +** +** 3 See also the routine slaDt, which roughly estimates ET-UT for +** historical epochs. +** +** Called: slaDat +** +** Last revision: 6 December 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return 32.184 + slaDat ( utc ); +} Index: trunk/MagicSoft/slalib/dv2tp.c =================================================================== --- trunk/MagicSoft/slalib/dv2tp.c (revision 731) +++ trunk/MagicSoft/slalib/dv2tp.c (revision 731) @@ -0,0 +1,72 @@ +#include "slalib.h" +#include "slamac.h" +void slaDv2tp ( double v[3], double v0[3], double *xi, double *eta, int *j ) +/* +** - - - - - - - - - +** s l a D v 2 t p +** - - - - - - - - - +** +** Given the direction cosines of a star and of the tangent point, +** determine the star's tangent-plane coordinates. +** +** (double precision) +** +** Given: +** v double[3] direction cosines of star +** v0 double[3] direction cosines of tangent point +** +** Returned: +** *xi,*eta double tangent plane coordinates of star +** j int status: 0 = OK +** 1 = error, star too far from axis +** 2 = error, antistar on tangent plane +** 3 = error, antistar too far from axis +** +** Notes: +** +** 1 If vector v0 is not of unit length, or if vector v is of zero +** length, the results will be wrong. +** +** 2 If v0 points at a pole, the returned xi,eta will be based on the +** arbitrary assumption that the RA of the tangent point is zero. +** +** 3 This routine is the Cartesian equivalent of the routine slaDs2tp. +** +** Last revision: 27 November 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +#define TINY 1e-6 +{ + double x, y, z, x0, y0, z0, r2, r, w, d; + + + x = v[0]; + y = v[1]; + z = v[2]; + x0 = v0[0]; + y0 = v0[1]; + z0 = v0[2]; + r2 = x0 * x0 + y0 * y0; + r = sqrt ( r2 ); + if ( r == 0.0 ) { + r = 1e-20; + x0 = r; + } + w = x * x0 + y * y0; + d = w + z * z0; + if ( d > TINY ) { + *j = 0; + } else if ( d >= 0.0 ) { + *j = 1; + d = TINY; + } else if ( d > -TINY ) { + *j = 2; + d = -TINY; + } else { + *j = 3; + } + d *= r; + *xi = ( y * x0 - x * y0 ) / d; + *eta = ( z * r2 - z0 * w ) / d; +} Index: trunk/MagicSoft/slalib/dvdv.c =================================================================== --- trunk/MagicSoft/slalib/dvdv.c (revision 731) +++ trunk/MagicSoft/slalib/dvdv.c (revision 731) @@ -0,0 +1,28 @@ +#include "slalib.h" +#include "slamac.h" +double slaDvdv ( double va[3], double vb[3] ) +/* +** - - - - - - - - +** s l a D v d v +** - - - - - - - - +** +** Scalar product of two 3-vectors. +** +** (double precision) +** +** +** Given: +** va double(3) first vector +** vb double(3) second vector +** +** +** The result is the scalar product va.vb (double precision) +** +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return va[0] * vb[0] + va[1] * vb[1] + va[2] * vb[2]; +} Index: trunk/MagicSoft/slalib/dvn.c =================================================================== --- trunk/MagicSoft/slalib/dvn.c (revision 731) +++ trunk/MagicSoft/slalib/dvn.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaDvn ( double v[3], double uv[3], double *vm ) +/* +** - - - - - - - +** s l a D v n +** - - - - - - - +** +** Normalizes a 3-vector also giving the modulus. +** +** (double precision) +** +** Given: +** v double[3] vector +** +** Returned: +** uv double[3] unit vector in direction of v +** *vm double modulus of v +** +** Note: v and uv may be the same array. +** +** +** If the modulus of v is zero, uv is set to zero as well. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + double w1, w2; + +/* Modulus */ + w1 = 0.0; + for ( i = 0; i < 3; i++ ) { + w2 = v[i]; + w1 += w2 * w2; + } + w1 = sqrt ( w1 ); + *vm = w1; + +/* Normalize the vector */ + w1 = ( w1 > 0.0 ) ? w1 : 1.0; + + for ( i = 0; i < 3; i++ ) { + uv[i] = v[i] / w1; + } +} Index: trunk/MagicSoft/slalib/dvxv.c =================================================================== --- trunk/MagicSoft/slalib/dvxv.c (revision 731) +++ trunk/MagicSoft/slalib/dvxv.c (revision 731) @@ -0,0 +1,39 @@ +#include "slalib.h" +#include "slamac.h" +void slaDvxv ( double va[3], double vb[3], double vc[3] ) +/* +** - - - - - - - - +** s l a D v x v +** - - - - - - - - +** +** Vector product of two 3-vectors. +** +** (double precision) +** +** Given: +** va double[3] first vector +** vb double[3] second vector +** +** Returned: +** vc double[3] vector result +** +** Note: the same vector may be specified more than once. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double vw[3]; + int i; + +/* Form the vector product va cross vb */ + vw[0] = va[1] * vb[2] - va[2] * vb[1]; + vw[1] = va[2] * vb[0] - va[0] * vb[2]; + vw[2] = va[0] * vb[1] - va[1] * vb[0]; + +/* Return the result */ + for ( i = 0; i < 3; i++ ) { + vc[i] = vw[i]; + } +} Index: trunk/MagicSoft/slalib/e2h.c =================================================================== --- trunk/MagicSoft/slalib/e2h.c (revision 731) +++ trunk/MagicSoft/slalib/e2h.c (revision 731) @@ -0,0 +1,79 @@ +#include "slalib.h" +#include "slamac.h" +void slaE2h ( float ha, float dec, float phi, float *az, float *el ) +/* +** - - - - - - - +** s l a E 2 h +** - - - - - - - +** +** Equatorial to horizon coordinates: HA,Dec to Az,El +** +** (single precision) +** +** Given: +** ha float hour angle +** dec float declination +** phi float observatory latitude +** +** Returned: +** *az float azimuth +** *el float elevation +** +** Notes: +** +** 1) All the arguments are angles in radians. +** +** 2) Azimuth is returned in the range 0-2pi; north is zero, +** and east is +pi/2. Elevation is returned in the range +** +/-pi/2. +** +** 3) The latitude must be geodetic. In critical applications, +** corrections for polar motion should be applied. +** +** 4) In some applications it will be important to specify the +** correct type of hour angle and declination in order to +** produce the required type of azimuth and elevation. In +** particular, it may be important to distinguish between +** elevation as affected by refraction, which would +** require the "observed" HA,Dec, and the elevation +** in vacuo, which would require the "topocentric" HA,Dec. +** If the effects of diurnal aberration can be neglected, the +** "apparent" HA,Dec may be used instead of the topocentric +** HA,Dec. +** +** 5) No range checking of arguments is carried out. +** +** 6) In applications which involve many such calculations, rather +** than calling the present routine it will be more efficient to +** use inline code, having previously computed fixed terms such +** as sine and cosine of latitude, and (for tracking a star) +** sine and cosine of declination. +** +** Defined in slamac.h: D2PI +** +** Last revision: 10 July 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + float sh, ch, sd, cd, sp, cp, x, y, z, r, a; + +/* Useful trig functions */ + sh = (float) sin ( ha ); + ch = (float) cos ( ha ); + sd = (float) sin ( dec ); + cd = (float) cos ( dec ); + sp = (float) sin ( phi ); + cp = (float) cos ( phi ); + +/* Az,El as x,y,z */ + x = - ch * cd * sp + sd * cp; + y = - sh * cd; + z = ch * cd * cp + sd * sp; + +/* To spherical */ + r = (float) sqrt ( x * x + y * y ); + a = ( r == 0.0f ) ? 0.0f : (float) atan2 ( y, x ) ; + *az = ( a < 0.0f ) ? (float) ( (double) a + D2PI ) : a; + *el = (float) atan2 ( z, r ); +} Index: trunk/MagicSoft/slalib/earth.c =================================================================== --- trunk/MagicSoft/slalib/earth.c (revision 731) +++ trunk/MagicSoft/slalib/earth.c (revision 731) @@ -0,0 +1,111 @@ +#include "slalib.h" +#include "slamac.h" +void slaEarth ( int iy, int id, float fd, float pv[6] ) +/* +** - - - - - - - - - +** s l a E a r t h +** - - - - - - - - - +** +** Approximate heliocentric position and velocity of the Earth. +** +** (single precision) +** +** Given: +** iy int year +** id int day in year (1 = Jan 1st) +** fd float fraction of day +** +** Returned: +** pv float[6] Earth position & velocity vector +** +** Notes: +** +** 1 The date and time is TDB (loosely ET) in a Julian calendar +** which has been aligned to the ordinary Gregorian +** calendar for the interval 1900 March 1 to 2100 February 28. +** The year and day can be obtained by calling slaCalyd or +** slaClyd. +** +** 2 The Earth heliocentric 6-vector is mean equator and equinox +** of date. Position part, PV(1-3), is in AU; velocity part, +** PV(4-6), is in AU/sec. +** +** 3 Max/RMS errors 1950-2050: +** 13/5 E-5 AU = 19200/7600 km in position +** 47/26 E-10 AU/s = 0.0070/0.0039 km/s in speed +** +** 4 More precise results are obtainable with the routine slaEvp. +** +** Defined in slamac.h: D2PI, dmod +** +** Last revision: 25 April 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define SPEED 1.9913e-7f /* Mean orbital speed of Earth, AU/s */ +#define REMB 3.12e-5f /* Mean Earth:EMB distance, AU */ +#define SEMB 8.31e-11f /* Mean Earth:EMB speed, AU/s */ + +{ + float yi, yf, t, elm, gam, em, elt, eps0, + e, esq, v, r, elmm, coselt, sineps, coseps, w1, w2, selmm, celmm; + int iy4; + +/* Whole years & fraction of year, and years since J1900.0 */ + yi = (float) ( iy - 1900 ); + iy4 = iy >= 0 ? iy % 4 : 3 - ( - iy - 1 ) % 4; + yf = ( (float) ( 4 * ( id - 1 / ( iy4 + 1 ) ) + - iy4 - 2 ) + 4.0f * fd ) / 1461.0f; + t = yi + yf; + +/* Geometric mean longitude of Sun */ +/* (cf 4.881627938+6.283319509911*t mod 2pi) */ + elm = (float) dmod ( 4.881628 + + D2PI * ( (double) yf ) + 0.00013420 * ( (double) t ), + D2PI ); + +/* Mean longitude of perihelion */ + gam = 4.908230f + 3.0005e-4f * t; + +/* Mean anomaly */ + em = elm - gam; + +/* Mean obliquity */ + eps0 = 0.40931975f - 2.27e-6f * t; + +/* Eccentricity */ + e = 0.016751f - 4.2e-7f * t; + esq = (float) ( e * e ); + +/* True anomaly */ + v = em + 2.0f * e * (float) sin ( (double) em ) + + 1.25f * esq * (float) sin ( 2.0 * (double) em ); + +/* True ecliptic longitude */ + elt = v + gam; + +/* True distance */ + r = ( 1.0f - esq ) / ( 1.0f + e * (float) cos ( (double) v ) ); + +/* Moon's mean longitude */ + elmm = (float) dmod ( ( 4.72 + 83.9971 * ( (double) t ) ), D2PI ); + +/* Useful functions */ + coselt = (float) cos ( (double) elt ); + sineps = (float) sin ( (double) eps0 ); + coseps = (float) cos ( (double) eps0 ); + w1 = -r * (float) sin ( (double) elt ); + w2 = -SPEED * ( coselt + e * (float) cos ( (double) gam ) ); + selmm = (float) sin ( (double) elmm ); + celmm = (float) cos ( (double) elmm ); + +/* Earth position and velocity */ + pv[0] = - r * coselt - REMB * celmm; + pv[1] = ( w1 - REMB * selmm ) * coseps; + pv[2] = w1 * sineps; + pv[3] = SPEED * ( (float) sin ( (double) elt ) + + e * (float) sin ( (double) gam ) ) + SEMB * selmm; + pv[4] = ( w2 - SEMB * celmm ) * coseps; + pv[5] = w2 * sineps; +} Index: trunk/MagicSoft/slalib/ecleq.c =================================================================== --- trunk/MagicSoft/slalib/ecleq.c (revision 731) +++ trunk/MagicSoft/slalib/ecleq.c (revision 731) @@ -0,0 +1,51 @@ +#include "slalib.h" +#include "slamac.h" +void slaEcleq ( double dl, double db, double date, + double *dr, double *dd) +/* +** - - - - - - - - - +** s l a E c l e q +** - - - - - - - - - +** +** Transformation from ecliptic coordinates to J2000.0 +** equatorial coordinates. +** +** (double precision) +** +** Given: +** dl,db double ecliptic longitude and latitude +** (mean of date, IAU 1980 theory, radians) +** date double TDB (loosely ET) as Modified Julian Date +** (JD-2400000.5) +** Returned: +** *dr,*dd double J2000.0 mean RA,Dec (radians) +** +** Called: +** slaDcs2c, slaEcmat, slaDimxv, slaPrec, slaEpj, slaDcc2s, +** slaDranrm, slaDrange +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double rmat[3][3], v1[3], v2[3]; + +/* Spherical to Cartesian */ + slaDcs2c ( dl, db, v1 ); + +/* Ecliptic to equatorial */ + slaEcmat ( date, rmat ); + slaDimxv ( rmat, v1, v2 ); + +/* Mean of date to J2000 */ + slaPrec ( 2000.0, slaEpj ( date ), rmat ); + slaDimxv ( rmat, v2, v1 ); + +/* Cartesian to spherical */ + slaDcc2s ( v1, dr, dd ); + +/* Express in conventional ranges */ + *dr = slaDranrm ( *dr ); + *dd = slaDrange ( *dd ); +} Index: trunk/MagicSoft/slalib/ecmat.c =================================================================== --- trunk/MagicSoft/slalib/ecmat.c (revision 731) +++ trunk/MagicSoft/slalib/ecmat.c (revision 731) @@ -0,0 +1,46 @@ +#include "slalib.h" +#include "slamac.h" +void slaEcmat ( double date, double rmat[3][3] ) +/* +** - - - - - - - - - +** s l a E c m a t +** - - - - - - - - - +** +** Form the equatorial to ecliptic rotation matrix (IAU 1980 theory). +** +** (double precision) +** +** Given: +** date double TDB (loosely ET) as Modified Julian Date +** (JD-2400000.5) +** Returned: +** rmat double[3][3] matrix +** +** References: +** Murray, C.A., Vectorial Astrometry, section 4.3. +** +** Note: +** The matrix is in the sense v[ecl] = rmat * v[equ]; the +** equator, equinox and ecliptic are mean of date. +** +** Called: slaDeuler +** +** Defined in slamac.h: DAS2R +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double t, eps0; + +/* Interval between basic epoch J2000.0 and current epoch (JC) */ + t = ( date - 51544.5 ) / 36525.0; + +/* Mean obliquity */ + eps0 = DAS2R * + ( 84381.448 + ( -46.8150 + ( -0.00059 + 0.001813 * t ) * t ) * t ); + +/* Matrix */ + slaDeuler ( "X", eps0, 0.0, 0.0, rmat ); +} Index: trunk/MagicSoft/slalib/ecor.c =================================================================== --- trunk/MagicSoft/slalib/ecor.c (revision 731) +++ trunk/MagicSoft/slalib/ecor.c (revision 731) @@ -0,0 +1,72 @@ +#include "slalib.h" +#include "slamac.h" +void slaEcor ( float rm, float dm, int iy, int id, float fd, + float *rv, float *tl ) +/* +** - - - - - - - - +** s l a E c o r +** - - - - - - - - +** +** Component of Earth orbit velocity and heliocentric +** light time in a given direction. +** +** (single precision) +** +** Given: +** rm,dm float mean RA,Dec of date (radians) +** iy int year +** id int day in year (1 = Jan 1st) +** fd float fraction of day +** +** Returned: +** *rv float component of Earth orbital velocity (km/sec) +** *tl float component of heliocentric light time (sec) +** +** Notes: +** +** 1 The date and time is TDB (loosely ET) in a Julian calendar +** which has been aligned to the ordinary Gregorian +** calendar for the interval 1900 March 1 to 2100 February 28. +** The year and day can be obtained by calling slaCalyd or +** slaClyd. +** +** 2 Sign convention: +** +** The velocity component is +ve when the Earth is receding from +** the given point on the sky. The light time component is +ve +** when the Earth lies between the Sun and the given point on +** the sky. +** +** 3 Accuracy: +** +** The velocity component is usually within 0.004 km/s of the +** correct value and is never in error by more than 0.007 km/s. +** The error in light time correction is about 0.03s at worst, +** but is usually better than 0.01s. For applications requiring +** higher accuracy, see the slaEvp routine. +** +** Called: slaEarth, slaCs2c, slaVdv +** +** Last revision: 24 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AUKM 1.4959787066e8f /* AU to km (1985 Almanac) */ +#define AUSEC 499.0047837f /* AU to light sec */ + +{ + float pv[6], v[3]; + +/* Sun:Earth position & velocity vector */ + slaEarth ( iy, id, fd, pv ); + +/* Star position vector */ + slaCs2c ( rm, dm, v ); + +/* Velocity component */ + *rv = - AUKM * slaVdv ( &pv[3], v ); + +/* Light time component */ + *tl = AUSEC * slaVdv ( pv, v ); +} Index: trunk/MagicSoft/slalib/eg50.c =================================================================== --- trunk/MagicSoft/slalib/eg50.c (revision 731) +++ trunk/MagicSoft/slalib/eg50.c (revision 731) @@ -0,0 +1,89 @@ +#include "slalib.h" +#include "slamac.h" +void slaEg50 ( double dr, double dd, double *dl, double *db ) +/* +** - - - - - - - - +** s l a E g 5 0 +** - - - - - - - - +** +** Transformation from B1950.0 'FK4' equatorial coordinates to +** IAU 1958 Galactic coordinates. +** +** (double precision) +** +** Given: +** dr,dd double B1950.0 'FK4' RA,dec +** +** Returned: +** *dl,*db double Galactic longitude and latitude l2,b2 +** +** (all arguments are radians) +** +** Called: +** slaDcs2c, slaDmxv, slaDcc2s, slaSubet, slaDranrm, slaDrange +** +** Note: +** The equatorial coordinates are B1950.0 'FK4'. Use the +** routine slaEqgal if conversion from J2000.0 coordinates +** is required. +** +** Reference: +** Blaauw et al, Mon.Not.R.astron.Soc.,121,123 (1960) +** +** Last revision: 16 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double v1[3], v2[3], r, d; + +/* +** l2,b2 system of Galactic coordinates +** +** p = 192.25 RA of Galactic north pole (mean B1950.0) +** q = 62.6 inclination of Galactic to mean B1950.0 equator +** r = 33 longitude of ascending node +** +** p,q,r are degrees +** +** Equatorial to Galactic rotation matrix +** +** The Euler angles are p, q, 90-r, about the z then y then +** z axes. +** +** +cp.cq.sr-sp.cr +sp.cq.sr+cp.cr -sq.sr +** +** -cp.cq.cr-sp.sr -sp.cq.cr+cp.sr +sq.cr +** +** +cp.sq +sp.sq +cq +*/ + + static double rmat[3][3]; + + rmat[0][0] = -0.066988739415; + rmat[0][1] = -0.872755765852; + rmat[0][2] = -0.483538914632; + rmat[1][0] = 0.492728466075; + rmat[1][1] = -0.450346958020; + rmat[1][2] = 0.744584633283; + rmat[2][0] = -0.867600811151; + rmat[2][1] = -0.188374601723; + rmat[2][2] = 0.460199784784; + + +/* Remove e-terms */ + slaSubet ( dr, dd, 1950.0, &r, &d ); + +/* Spherical to Cartesian */ + slaDcs2c ( r, d, v1 ); + +/* Rotate to Galactic */ + slaDmxv ( rmat, v1, v2 ); + +/* Cartesian to spherical */ + slaDcc2s ( v2, dl, db ); + +/* Express angles in conventional ranges */ + *dl = slaDranrm ( *dl ); + *db = slaDrange ( *db ); +} Index: trunk/MagicSoft/slalib/el2ue.c =================================================================== --- trunk/MagicSoft/slalib/el2ue.c (revision 731) +++ trunk/MagicSoft/slalib/el2ue.c (revision 731) @@ -0,0 +1,298 @@ +#include "slalib.h" +#include "slamac.h" +void slaEl2ue ( double date, int jform, double epoch, double orbinc, + double anode, double perih, double aorq, double e, + double aorl, double dm, double u[], int *jstat ) +/* +** - - - - - - - - - +** s l a E l 2 u e +** - - - - - - - - - +** +** Transform conventional osculating orbital elements into "universal" form. +** +** Given: +** date double epoch (TT MJD) of osculation (Note 3) +** jform int choice of element set (1-3, Note 6) +** epoch double epoch (TT MJD) of the elements +** orbinc double inclination (radians) +** anode double longitude of the ascending node (radians) +** perih double longitude or argument of perihelion (radians) +** aorq double mean distance or perihelion distance (AU) +** e double eccentricity +** aorl double mean anomaly or longitude (radians, jform=1,2 only) +** dm double daily motion (radians, jform=1 only) +** +** Returned: +** u double[13] universal orbital elements (Note 1) +** +** [0] combined mass (M+m) +** [1] total energy of the orbit (alpha) +** [2] reference (osculating) epoch (t0) +** [3-5] position at reference epoch (r0) +** [6-8] velocity at reference epoch (v0) +** [9] heliocentric distance at reference epoch +** [10] r0.v0 +** [11] date (t) +** [12] universal eccentric anomaly (psi) of date, approx +** +** jstat int* status: 0 = OK +** -1 = illegal jform +** -2 = illegal e +** -3 = illegal aorq +** -4 = illegal dm +** -5 = numerical error +** +** Called: slaUe2pv, slaPv2ue +** +** Notes +** +** 1 The "universal" elements are those which define the orbit for the +** purposes of the method of universal variables (see reference). +** They consist of the combined mass of the two bodies, an epoch, +** and the position and velocity vectors (arbitrary reference frame) +** at that epoch. The parameter set used here includes also various +** quantities that can, in fact, be derived from the other +** information. This approach is taken to avoiding unnecessary +** computation and loss of accuracy. The supplementary quantities +** are (i) alpha, which is proportional to the total energy of the +** orbit, (ii) the heliocentric distance at epoch, (iii) the +** outwards component of the velocity at the given epoch, (iv) an +** estimate of psi, the "universal eccentric anomaly" at a given +** date and (v) that date. +** +** 2 The companion routine is slaUe2pv. This takes the set of numbers +** that the present routine outputs and uses them to derive the +** object's position and velocity. A single prediction requires one +** call to the present routine followed by one call to slaUe2pv; +** for convenience, the two calls are packaged as the routine +** slaPlanel. Multiple predictions may be made by again calling the +** present routine once, but then calling slaUe2pv multiple times, +** which is faster than multiple calls to slaPlanel. +** +** 3 date is the epoch of osculation. It is in the TT timescale +** (formerly Ephemeris Time, ET) and is a Modified Julian Date +** (JD-2400000.5). +** +** 4 The supplied orbital elements are with respect to the J2000 +** ecliptic and equinox. The position and velocity parameters +** returned in the array u are with respect to the mean equator and +** equinox of epoch J2000, and are for the perihelion prior to the +** specified epoch. +** +** 5 The universal elements returned in the array u are in canonical +** units (solar masses, AU and canonical days). +** +** 6 Three different element-format options are available: +** +** Option jform=1, suitable for the major planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = longitude of perihelion, curly pi (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e (range 0 to <1) +** aorl = mean longitude L (radians) +** dm = daily motion (radians) +** +** Option jform=2, suitable for minor planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e (range 0 to <1) +** aorl = mean anomaly M (radians) +** +** Option jform=3, suitable for comets: +** +** epoch = epoch of perihelion (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = perihelion distance, q (AU) +** e = eccentricity, e (range 0 to 10) +** +** 7 Unused elements (dm for jform=2, aorl and dm for jform=3) are +** not accessed. +** +** 8 The algorithm was originally adapted from the EPHSLA program of +** D.H.P.Jones (private communication, 1996). The method is based on +** Stumpff's Universal Variables. +** +** Reference: Everhart, E. & Pitkin, E.T., Am.J.Phys. 51, 712, 1983. +** +** Last revision: 18 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Gaussian gravitational constant (exact) */ +#define GCON 0.01720209895 + +/* Sin and cos of J2000 mean obliquity (IAU 1976) */ +#define SE 0.3977771559319137 +#define CE 0.9174820620691818 + +{ + int j; + double pht, argph, q, w, cm, alpha, phs, sw, cw, si, ci, so, co, + x, y, z, px, py, pz, vx, vy, vz, dt, fc, fp, psi, ul[13], pv[6]; + + + +/* Validate arguments. */ + if ( jform < 1 || jform > 3 ) { + *jstat = -1; + return; + } + if ( e < 0.0 || e > 10.0 || ( e >= 1.0 && jform != 3 ) ) { + *jstat = -2; + return; + } + if ( aorq <= 0.0 ) { + *jstat = -3; + return; + } + if ( jform == 1 && dm <= 0.0 ) { + *jstat = -4; + return; + } + +/* +** Transform elements into standard form: +** +** pht = epoch of perihelion passage +** argph = argument of perihelion (little omega) +** q = perihelion distance (q) +** cm = combined mass, M+m (mu) +*/ + + if ( jform == 1 ) { + pht = epoch - ( aorl - perih ) / dm; + argph = perih - anode; + q = aorq * ( 1.0 - e ); + w = dm / GCON; + cm = w * w * aorq * aorq * aorq; + } else if ( jform == 2 ) { + pht = epoch - aorl * sqrt ( aorq * aorq * aorq ) / GCON; + argph = perih; + q = aorq * ( 1.0 - e ); + cm = 1.0; + } else if ( jform == 3 ) { + pht = epoch; + argph = perih; + q = aorq; + cm = 1.0; + } + +/* +** The universal variable alpha. This is proportional to the total +** energy of the orbit: -ve for an ellipse, zero for a parabola, +** +ve for a hyperbola. +*/ + + alpha = cm * ( e - 1.0 ) / q; + +/* Speed at perihelion. */ + + phs = sqrt ( alpha + 2.0 * cm / q ); + +/* +** In a Cartesian coordinate system which has the x-axis pointing +** to perihelion and the z-axis normal to the orbit (such that the +** object orbits counter-clockwise as seen from +ve z), the +** perihelion position and velocity vectors are: +** +** position [Q,0,0] +** velocity [0,phs,0] +** +** To express the results in J2000 equatorial coordinates we make a +** series of four rotations of the Cartesian axes: +** +** axis Euler angle +** +** 1 z argument of perihelion (little omega) +** 2 x inclination (i) +** 3 z longitude of the ascending node (big omega) +** 4 x J2000 obliquity (epsilon) +** +** In each case the rotation is clockwise as seen from the +ve end +** of the axis concerned. +*/ + +/* Functions of the Euler angles. */ + sw = sin ( argph ); + cw = cos ( argph ); + si = sin ( orbinc ); + ci = cos ( orbinc ); + so = sin ( anode ); + co = cos ( anode ); + +/* Position at perihelion (AU). */ + x = q * cw; + y = q * sw; + z = y * si; + y = y * ci; + px = x * co - y * so; + y = x * so + y * co; + py = y * CE - z * SE; + pz = y * SE + z * CE; + +/* Velocity at perihelion (AU per canonical day). */ + x = - phs * sw; + y = phs * cw; + z = y * si; + y = y * ci; + vx = x * co - y * so; + y = x * so + y * co; + vy = y * CE - z * SE; + vz = y * SE + z * CE; + +/* Time from perihelion to date (in Canonical Days: a canonical */ +/* day is 58.1324409... days, defined as 1/GCON). */ + + dt = ( date - pht ) * GCON; + +/* First Approximation to the Universal Eccentric Anomaly, psi, */ +/* based on the circle (fc) and parabola (fp) values. */ + fc = dt / q; + w = pow ( 3.0 * dt + sqrt ( 9.0 * dt * dt + 8.0 * q * q * q ), + 1.0 / 3.0 ); + fp = w - 2.0 * q / w; + psi = ( 1.0 - e ) * fc + e * fp; + +/* Assemble local copy of element set. */ + ul[0] = cm; + ul[1] = alpha; + ul[2] = pht; + ul[3] = px; + ul[4] = py; + ul[5] = pz; + ul[6] = vx; + ul[7] = vy; + ul[8] = vz; + ul[9] = q; + ul[10] = 0.0; + ul[11] = date; + ul[12] = psi; + +/* Predict position+velocity at epoch of osculation. */ + slaUe2pv ( date, ul, pv, &j ); + if ( j ) { + *jstat = -5; + return; + } + +/* Convert back to universal elements. */ + slaPv2ue ( pv, date, cm - 1.0, u, &j ); + if ( j ) { + *jstat = -5; + return; + } + +/* OK exit. */ + *jstat = 0; + +} Index: trunk/MagicSoft/slalib/epb.c =================================================================== --- trunk/MagicSoft/slalib/epb.c (revision 731) +++ trunk/MagicSoft/slalib/epb.c (revision 731) @@ -0,0 +1,27 @@ +#include "slalib.h" +#include "slamac.h" +double slaEpb ( double date ) +/* +** - - - - - - - +** s l a E p b +** - - - - - - - +** +** Conversion of Modified Julian Date to Besselian epoch. +** +** (double precision) +** +** Given: +** date double Modified Julian Date (JD - 2400000.5) +** +** The result is the Besselian epoch. +** +** Reference: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return 1900.0 + ( date - 15019.81352 ) / 365.242198781; +} Index: trunk/MagicSoft/slalib/epb2d.c =================================================================== --- trunk/MagicSoft/slalib/epb2d.c (revision 731) +++ trunk/MagicSoft/slalib/epb2d.c (revision 731) @@ -0,0 +1,27 @@ +#include "slalib.h" +#include "slamac.h" +double slaEpb2d ( double epb ) +/* +** - - - - - - - - - +** s l a E p b 2 d +** - - - - - - - - - +** +** Conversion of Besselian epoch to Modified Julian Date. +** +** (double precision) +** +** Given: +** epb double Besselian epoch +** +** The result is the Modified Julian Date (JD - 2400000.5). +** +** Reference: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return 15019.81352 + ( epb - 1900.0 ) * 365.242198781; +} Index: trunk/MagicSoft/slalib/epco.c =================================================================== --- trunk/MagicSoft/slalib/epco.c (revision 731) +++ trunk/MagicSoft/slalib/epco.c (revision 731) @@ -0,0 +1,52 @@ +#include "slalib.h" +#include "slamac.h" +#include +double slaEpco ( char k0, char k, double e ) +/* +** - - - - - - - - +** s l a E p c o +** - - - - - - - - +** +** Convert an epoch into the appropriate form - 'B' or 'J'. +** +** Given: +** k0 char form of result: 'B'=Besselian, 'J'=Julian +** k char form of given epoch: 'B' or 'J' +** e double epoch +** +** Called: slaEpb, slaEpj2d, slaEpj, slaEpb2d +** +** Notes: +** +** 1) The result is always either equal to or very close to +** the given epoch e. The routine is required only in +** applications where punctilious treatment of heterogeneous +** mixtures of star positions is necessary. +** +** 2) k0 and k are not validated, and only their first characters +** are used, interpreted as follows: +** +** o If k0 and k are the same the result is e. +** o If k0 is 'B' or 'b' and k isn't, the conversion is J to B. +** o In all other cases, the conversion is B to J. +** +** Last revision: 18 November 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double result; + int c; + + c = toupper ( (int) k0 ); + if ( c == toupper ( (int) k ) ) { + result = e; + } else { + if ( c == (int) 'B' ) { + result = slaEpb ( slaEpj2d ( e ) ); + } else { + result = slaEpj ( slaEpb2d ( e ) ); + } + } + return ( result ); +} Index: trunk/MagicSoft/slalib/epj.c =================================================================== --- trunk/MagicSoft/slalib/epj.c (revision 731) +++ trunk/MagicSoft/slalib/epj.c (revision 731) @@ -0,0 +1,27 @@ +#include "slalib.h" +#include "slamac.h" +double slaEpj ( double date ) +/* +** - - - - - - - +** s l a E p j +** - - - - - - - +** +** Conversion of Modified Julian Date to Julian epoch. +** +** (double precision) +** +** Given: +** date double Modified Julian Date (JD - 2400000.5) +** +** The result is the Julian epoch. +** +** Reference: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return 2000.0 + ( date - 51544.5 ) / 365.25; +} Index: trunk/MagicSoft/slalib/epj2d.c =================================================================== --- trunk/MagicSoft/slalib/epj2d.c (revision 731) +++ trunk/MagicSoft/slalib/epj2d.c (revision 731) @@ -0,0 +1,27 @@ +#include "slalib.h" +#include "slamac.h" +double slaEpj2d ( double epj ) +/* +** - - - - - - - - - +** s l a E p j 2 d +** - - - - - - - - - +** +** Conversion of Julian epoch to Modified Julian Date. +** +** (double precision) +** +** Given: +** epj double Julian epoch +** +** The result is the Modified Julian Date (JD - 2400000.5). +** +** Reference: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return 51544.5 + ( epj - 2000.0 ) * 365.25; +} Index: trunk/MagicSoft/slalib/eqecl.c =================================================================== --- trunk/MagicSoft/slalib/eqecl.c (revision 731) +++ trunk/MagicSoft/slalib/eqecl.c (revision 731) @@ -0,0 +1,53 @@ +#include "slalib.h" +#include "slamac.h" +void slaEqecl ( double dr, double dd, double date, + double *dl, double *db ) +/* +** - - - - - - - - - +** s l a E q e c l +** - - - - - - - - - +** +** Transformation from J2000.0 equatorial coordinates to +** ecliptic coordinates. +** +** (double precision) +** +** Given: +** dr,dd double J2000.0 mean RA,Dec (radians) +** date double TDB (loosely ET) as Modified Julian Date +** (JD-2400000.5) +** Returned: +** *dl,*db double ecliptic longitude and latitude +** (mean of date, IAU 1980 theory, radians) +** +** +** Called: +** slaDcs2c, slaPrec, slaEpj, slaDmxv, slaEcmat, slaDcc2s, +** slaDranrm, slaDrange +** +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double rmat[3][3], v1[3], v2[3]; + +/* Spherical to Cartesian */ + slaDcs2c ( dr, dd, v1 ); + +/* Mean J2000 to mean of date */ + slaPrec ( 2000.0, slaEpj ( date ), rmat ); + slaDmxv ( rmat, v1, v2 ); + +/* Equatorial to ecliptic */ + slaEcmat ( date, rmat ); + slaDmxv ( rmat, v2, v1 ); + +/* Cartesian to spherical */ + slaDcc2s ( v1, dl, db ); + +/* Express in conventional ranges */ + *dl = slaDranrm ( *dl ); + *db = slaDrange ( *db ); +} Index: trunk/MagicSoft/slalib/eqeqx.c =================================================================== --- trunk/MagicSoft/slalib/eqeqx.c (revision 731) +++ trunk/MagicSoft/slalib/eqeqx.c (revision 731) @@ -0,0 +1,49 @@ +#include "slalib.h" +#include "slamac.h" +double slaEqeqx ( double date ) +/* +** - - - - - - - - - +** s l a E q e q x +** - - - - - - - - - +** +** Equation of the equinoxes (IAU 1994, double precision). +** +** Given: +** date double TDB (loosely ET) as Modified Julian Date +** (JD-2400000.5) +** +** The result is the equation of the equinoxes (double precision) +** in radians: +** +** Greenwich apparent ST = Greenwich mean ST + equation of the equinoxes +** +** References: IAU Resolution C7, Recommendation 3 (1994) +** Capitaine, N. & Gontier, A.-M., Astron. Astrophys., +** 275, 645-650 (1993) +** +** Called: slaNutc +** +** Last revision: 21 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +#define T2AS 1296000.0 /* Turns to arc seconds */ +#define AS2R 0.4848136811095359949E-5 /* Arc seconds to radians */ +{ + double t, om, dpsi, deps, eps0; + +/* Interval between basic epoch J2000.0 and current epoch (JC) */ + t = ( date - 51544.5 ) / 36525.0; + +/* Longitude of the mean ascending node of the lunar orbit on the + ecliptic, measured from the mean equinox of date */ + om = AS2R * ( 450160.280 + ( -5.0 * T2AS - 482890.539 + + ( 7.455 + 0.008 * t ) * t ) * t ); + +/* Nutation */ + slaNutc ( date, &dpsi, &deps, &eps0 ); + +/* Equation of the equinoxes */ + return dpsi * cos ( eps0 ) + AS2R * ( 0.00264 * sin ( om ) + + 0.000063 * sin ( om + om ) ); +} Index: trunk/MagicSoft/slalib/eqgal.c =================================================================== --- trunk/MagicSoft/slalib/eqgal.c (revision 731) +++ trunk/MagicSoft/slalib/eqgal.c (revision 731) @@ -0,0 +1,78 @@ +#include "slalib.h" +#include "slamac.h" +void slaEqgal ( double dr, double dd, double *dl, double *db ) +/* +** - - - - - - - - - +** s l a E q g a l +** - - - - - - - - - +** +** Transformation from J2000.0 equatorial coordinates to +** IAU 1958 Galactic coordinates. +** +** (double precision) +** +** Given: +** dr,dd double J2000.0 RA,Dec +** +** Returned: +** *dl,*db double Galactic longitude and latitude l2,b2 +** +** (all arguments are radians) +** +** Called: +** slaDcs2c, slaDmxv, slaDcc2s, slaDranrm, slaDrange +** +** Note: +** The equatorial coordinates are J2000.0. Use the routine +** slaEg50 if conversion from B1950.0 'FK4' coordinates is +** required. +** +** Reference: +** Blaauw et al, Mon.Not.R.astron.Soc.,121,123 (1960) +** +** Last revision: 21 September 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double v1[3], v2[3]; + +/* +** l2,b2 system of Galactic coordinates +** +** p = 192.25 RA of Galactic north pole (mean B1950.0) +** q = 62.6 inclination of Galactic to mean B1950.0 equator +** r = 33 longitude of ascending node +** +** p,q,r are degrees +** +** Equatorial to Galactic rotation matrix (J2000.0), obtained by +** applying the standard FK4 to FK5 transformation, for zero proper +** motion in FK5, to the columns of the B1950 equatorial to +** Galactic rotation matrix: +*/ + static double rmat[3][3]; + + rmat[0][0] = -0.054875539726; + rmat[0][1] = -0.873437108010; + rmat[0][2] = -0.483834985808; + rmat[1][0] = 0.494109453312; + rmat[1][1] = -0.444829589425; + rmat[1][2] = 0.746982251810; + rmat[2][0] = -0.867666135858; + rmat[2][1] = -0.198076386122; + rmat[2][2] = 0.455983795705; + +/* Spherical to Cartesian */ + slaDcs2c ( dr, dd, v1 ); + +/* Equatorial to Galactic */ + slaDmxv ( rmat, v1, v2 ); + +/* Cartesian to spherical */ + slaDcc2s ( v2, dl, db ); + +/* Express in conventional ranges */ + *dl = slaDranrm ( *dl ); + *db = slaDrange ( *db ); +} Index: trunk/MagicSoft/slalib/etrms.c =================================================================== --- trunk/MagicSoft/slalib/etrms.c (revision 731) +++ trunk/MagicSoft/slalib/etrms.c (revision 731) @@ -0,0 +1,64 @@ +#include "slalib.h" +#include "slamac.h" +void slaEtrms ( double ep, double ev[3] ) +/* +** - - - - - - - - - +** s l a E t r m s +** - - - - - - - - - +** +** Compute the e-terms (elliptic component of annual aberration) +** vector. +** +** (double precision) +** +** Given: +** ep double Besselian epoch +** +** Returned: +** ev double[3] e-terms as (dx,dy,dz) +** +** References: +** +** 1 Smith, C.A. et al, 1989. "The transformation of astrometric +** catalog systems to the equinox J2000.0". Astron.J. 97, 265. +** +** 2 Yallop, B.D. et al, 1989. "Transformation of mean star places +** from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". +** Astron.J. 97, 274. +** +** Note the use of the J2000 aberration constant (20.49552 arcsec). +** This is a reflection of the fact that the e-terms embodied in +** existing star catalogues were computed from a variety of +** aberration constants. Rather than adopting one of the old +** constants the latest value is used here. +** +** Defined in slamac.h: DAS2R +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double t, e, e0, p, ek, cp; + +/* Julian centuries since B1950 */ + t = ( ep - 1950.0 ) * 1.00002135903e-2; + +/* Eccentricity */ + e = 0.01673011 - ( 0.00004193 + 0.000000126 * t ) * t; + +/* Mean obliquity */ + e0 = ( 84404.836 - + ( 46.8495 + ( 0.00319 + 0.00181 * t ) * t ) * t ) * DAS2R; + +/* Mean longitude of perihelion */ + p = ( 1015489.951 + + ( 6190.67 + ( 1.65 + 0.012 * t ) * t ) * t ) * DAS2R; + +/* E-terms */ + ek = e * 20.49552 * DAS2R; + cp = cos ( p ); + ev[0] = ek * sin ( p ); + ev[1] = -ek * cp * cos ( e0 ); + ev[2] = -ek * cp * sin ( e0 ); +} Index: trunk/MagicSoft/slalib/euler.c =================================================================== --- trunk/MagicSoft/slalib/euler.c (revision 731) +++ trunk/MagicSoft/slalib/euler.c (revision 731) @@ -0,0 +1,65 @@ +#include "slalib.h" +#include "slamac.h" +void slaEuler ( char *order, float phi, float theta, float psi, + float rmat[3][3] ) +/* +** - - - - - - - - - +** s l a E u l e r +** - - - - - - - - - +** +** Form a rotation matrix from the Euler angles - three successive +** rotations about specified Cartesian axes. +** +** (single precision) +** +** Given: +** *order char specifies about which axes the rotations occur +** phi float 1st rotation (radians) +** theta float 2nd rotation ( " ) +** psi float 3rd rotation ( " ) +** +** Returned: +** rmat float[3][3] rotation matrix +** +** A rotation is positive when the reference frame rotates +** anticlockwise as seen looking towards the origin from the +** positive region of the specified axis. +** +** The characters of order define which axes the three successive +** rotations are about. A typical value is 'ZXZ', indicating that +** rmat is to become the direction cosine matrix corresponding to +** rotations of the reference frame through phi radians about the +** old z-axis, followed by theta radians about the resulting x-axis, +** then psi radians about the resulting z-axis. +** +** The axis names can be any of the following, in any order or +** combination: x, y, z, uppercase or lowercase, 1, 2, 3. Normal +** axis labelling/numbering conventions apply; the xyz (=123) +** triad is right-handed. Thus, the 'ZXZ' example given above +** could be written 'ZXZ' or '313' (or even 'zxz' or '3xz'). Order +** is terminated by length or by the first unrecognized character. +** +** Fewer than three rotations are acceptable, in which case the later +** angle arguments are ignored. Zero rotations leaves rmat set to the +** identity matrix. +** +** Called: slaDeuler +** +** Last revision: 9 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int j, i; + double w[3][3]; + +/* Compute matrix in double precision */ + slaDeuler ( order, (double) phi, (double) theta, (double) psi, w ); + +/* Copy the result */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + rmat[i][j] = (float) w[i][j]; + } + } +} Index: trunk/MagicSoft/slalib/evp.c =================================================================== --- trunk/MagicSoft/slalib/evp.c (revision 731) +++ trunk/MagicSoft/slalib/evp.c (revision 731) @@ -0,0 +1,614 @@ +#include "slalib.h" +#include "slamac.h" +void slaEvp ( double date, double deqx, double dvb[3], double dpb[3], + double dvh[3], double dph[3] ) +/* +** - - - - - - - +** s l a E v p +** - - - - - - - +** +** Barycentric and heliocentric velocity and position of the Earth. +** +** Given: +** +** date double TDB (loosely ET) as a Modified Julian Date +** (JD-2400000.5) +** +** deqx double Julian epoch (e.g. 2000.0) of mean equator and +** equinox of the vectors returned. If deqx <= 0.0, +** all vectors are referred to the mean equator and +** equinox (FK5) of epoch date. +** +** Returned (all 3D Cartesian vectors): +** +** dvb,dpb double[3] barycentric velocity, position +** +** dvh,dph double[3] heliocentric velocity, position +** +** (Units are AU/s for velocity and AU for position) +** +** Called: slaEpj, slaPrec +** +** Accuracy: +** +** The maximum deviations from the JPL DE96 ephemeris are as +** follows: +** +** barycentric velocity 42 cm/s +** barycentric position 6900 km +** +** heliocentric velocity 42 cm/s +** heliocentric position 1600 km +** +** This routine is adapted from the BARVEL and BARCOR Fortran +** subroutines of P.Stumpff, which are described in +** Astron. Astrophys. Suppl. Ser. 41, 1-8 (1980). The present +** routine uses double precision throughout; most of the other +** changes are essentially cosmetic and do not affect the +** results. However, some adjustments have been made so as to +** give results that refer to the new (IAU 1976 "FK5") equinox +** and precession, although the differences these changes make +** relative to the results from Stumpff's original "FK4" version +** are smaller than the inherent accuracy of the algorithm. One +** minor shortcoming in the original routines that has not been +** corrected is that better numerical accuracy could be achieved +** if the various polynomial evaluations were nested. Note also +** that one of Stumpff's precession constants differs by 0.001 arcsec +** from the value given in the Explanatory Supplement to the A.E. +** +** Defined in slamac.h: D2PI, DS2R, dmod +** +** Last revision: 21 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int ideq, i, j, k; + + double a, pertl, + pertld, pertr, pertrd, cosa, sina, e, twoe, esq, g, twog, + phi, f, sf, cf, phid, psid, pertp, pertpd, tl, sinlm, coslm, + sigma, b, plon, pomg, pecc, flatm, flat; + + double dt, dlocal, dml, + deps, dparam, dpsi, d1pdro, drd, drld, dtl, dsinls, + dcosls, dxhd, dyhd, dzhd, dxbd, dybd, dzbd, dcosep, + dsinep, dyahd, dzahd, dyabd, dzabd, dr, + dxh, dyh, dzh, dxb, dyb, dzb, dyah, dzah, dyab, + dzab, depj, deqcor; + + double sn[4], forbel[7], sorbel[17], sinlp[4], coslp[4]; + + double dprema[3][3], w, vw[3]; + +/* Sidereal rate dcsld in longitude, rate ccsgd in mean anomaly */ + static double dcsld = 1.990987e-7; + static double ccsgd = 1.990969e-7; + +/* Some constants used in the calculation of the lunar contribution */ + static double cckm = 3.122140e-5; + static double ccmld = 2.661699e-6; + static double ccfdi = 2.399485e-7; + +/* Besselian epoch 1950.0 expressed as a Julian epoch */ + static double b1950 = 1949.9997904423; + +/* +** ccpamv(k)=a*m*dl/dt (planets), dc1mme=1-mass(Earth+Moon) +*/ + static double ccpamv[4] = { + 8.326827e-11, + 1.843484e-11, + 1.988712e-12, + 1.881276e-12 + }; + static double dc1mme = 0.99999696; + +/* +** ccpam(k)=a*m(planets) +** ccim=inclination(Moon) +*/ + static double ccpam[4] = { + 4.960906e-3, + 2.727436e-3, + 8.392311e-4, + 1.556861e-3 + }; + static double ccim = 8.978749e-2; + +/* +** Constants dcfel(i,k) of fast changing elements +*/ + static double dcfel[3][8] = { + { 1.7400353, /* dcfel[0][0] */ + 6.2565836, /* dcfel[0][1] */ + 4.7199666, /* dcfel[0][2] */ + 1.9636505e-1, /* dcfel[0][3] */ + 4.1547339, /* dcfel[0][4] */ + 4.6524223, /* dcfel[0][5] */ + 4.2620486, /* dcfel[0][6] */ + 1.4740694 }, /* dcfel[0][7] */ + { 6.2833195099091e+2, /* dcfel[1][0] */ + 6.2830194572674e+2, /* dcfel[1][1] */ + 8.3997091449254e+3, /* dcfel[1][2] */ + 8.4334662911720e+3, /* dcfel[1][3] */ + 5.2993466764997e+1, /* dcfel[1][4] */ + 2.1354275911213e+1, /* dcfel[1][5] */ + 7.5025342197656, /* dcfel[1][6] */ + 3.8377331909193 }, /* dcfel[1][7] */ + { 5.2796e-6, /* dcfel[2][0] */ + -2.6180e-6, /* dcfel[2][1] */ + -1.9780e-5, /* dcfel[2][2] */ + -5.6044e-5, /* dcfel[2][3] */ + 5.8845e-6, /* dcfel[2][4] */ + 5.6797e-6, /* dcfel[2][5] */ + 5.5317e-6, /* dcfel[2][6] */ + 5.6093e-6 } /* dcfel[2][7] */ + }; + +/* +** Constants dceps and ccsel(i,k) of slowly changing elements +*/ + static double dceps[3] = { + 4.093198e-1, + -2.271110e-4, + -2.860401e-8 + }; + static double ccsel[3][17] = { + { 1.675104e-2, /* ccsel[0][0] */ + 2.220221e-1, /* ccsel[0][1] */ + 1.589963, /* ccsel[0][2] */ + 2.994089, /* ccsel[0][3] */ + 8.155457e-1, /* ccsel[0][4] */ + 1.735614, /* ccsel[0][5] */ + 1.968564, /* ccsel[0][6] */ + 1.282417, /* ccsel[0][7] */ + 2.280820, /* ccsel[0][8] */ + 4.833473e-2, /* ccsel[0][9] */ + 5.589232e-2, /* ccsel[0][10] */ + 4.634443e-2, /* ccsel[0][11] */ + 8.997041e-3, /* ccsel[0][12] */ + 2.284178e-2, /* ccsel[0][13] */ + 4.350267e-2, /* ccsel[0][14] */ + 1.348204e-2, /* ccsel[0][15] */ + 3.106570e-2 }, /* ccsel[0][16] */ + { -4.179579e-5, /* ccsel[1][0] */ + 2.809917e-2, /* ccsel[1][1] */ + 3.418075e-2, /* ccsel[1][2] */ + 2.590824e-2, /* ccsel[1][3] */ + 2.486352e-2, /* ccsel[1][4] */ + 1.763719e-2, /* ccsel[1][5] */ + 1.524020e-2, /* ccsel[1][6] */ + 8.703393e-3, /* ccsel[1][7] */ + 1.918010e-2, /* ccsel[1][8] */ + 1.641773e-4, /* ccsel[1][9] */ + -3.455092e-4, /* ccsel[1][10] */ + -2.658234e-5, /* ccsel[1][11] */ + 6.329728e-6, /* ccsel[1][12] */ + -9.941590e-5, /* ccsel[1][13] */ + -6.839749e-5, /* ccsel[1][14] */ + 1.091504e-5, /* ccsel[1][15] */ + -1.665665e-4 }, /* ccsel[1][16] */ + { -1.260516e-7, /* ccsel[2][0] */ + 1.852532e-5, /* ccsel[2][1] */ + 1.430200e-5, /* ccsel[2][2] */ + 4.155840e-6, /* ccsel[2][3] */ + 6.836840e-6, /* ccsel[2][4] */ + 6.370440e-6, /* ccsel[2][5] */ + -2.517152e-6, /* ccsel[2][6] */ + 2.289292e-5, /* ccsel[2][7] */ + 4.484520e-6, /* ccsel[2][8] */ + -4.654200e-7, /* ccsel[2][9] */ + -7.388560e-7, /* ccsel[2][10] */ + 7.757000e-8, /* ccsel[2][11] */ + -1.939256e-9, /* ccsel[2][12] */ + 6.787400e-8, /* ccsel[2][13] */ + -2.714956e-7, /* ccsel[2][14] */ + 6.903760e-7, /* ccsel[2][15] */ + -1.590188e-7 } /* ccsel[2][16] */ + }; + +/* +** Constants of the arguments of the short-period perturbations +** by the planets: dcargs(i,k) +*/ + static double dcargs[2][15] = { + { 5.0974222, /* dcargs[0][0] */ + 3.9584962, /* dcargs[0][1] */ + 1.6338070, /* dcargs[0][2] */ + 2.5487111, /* dcargs[0][3] */ + 4.9255514, /* dcargs[0][4] */ + 1.3363463, /* dcargs[0][5] */ + 1.6072053, /* dcargs[0][6] */ + 1.3629480, /* dcargs[0][7] */ + 5.5657014, /* dcargs[0][8] */ + 5.0708205, /* dcargs[0][9] */ + 3.9318944, /* dcargs[0][10] */ + 4.8989497, /* dcargs[0][11] */ + 1.3097446, /* dcargs[0][12] */ + 3.5147141, /* dcargs[0][13] */ + 3.5413158 }, /* dcargs[0][14] */ + { -7.8604195454652e+2, /* dcargs[1][0] */ + -5.7533848094674e+2, /* dcargs[1][1] */ + -1.1506769618935e+3, /* dcargs[1][2] */ + -3.9302097727326e+2, /* dcargs[1][3] */ + -5.8849265665348e+2, /* dcargs[1][4] */ + -5.5076098609303e+2, /* dcargs[1][5] */ + -5.2237501616674e+2, /* dcargs[1][6] */ + -1.1790629318198e+3, /* dcargs[1][7] */ + -1.0977134971135e+3, /* dcargs[1][8] */ + -1.5774000881978e+2, /* dcargs[1][9] */ + 5.2963464780000e+1, /* dcargs[1][10] */ + 3.9809289073258e+1, /* dcargs[1][11] */ + 7.7540959633708e+1, /* dcargs[1][12] */ + 7.9618578146517e+1, /* dcargs[1][13] */ + -5.4868336758022e+2 } /* dcargs[1][14] */ + }; + +/* +** Amplitudes ccamps(n,k) of the short-period perturbations +*/ + static double ccamps[5][15] = { + { -2.279594e-5, /* ccamps[0][0] */ + -3.494537e-5, /* ccamps[0][1] */ + 6.593466e-7, /* ccamps[0][2] */ + 1.140767e-5, /* ccamps[0][3] */ + 9.516893e-6, /* ccamps[0][4] */ + 7.310990e-6, /* ccamps[0][5] */ + -2.603449e-6, /* ccamps[0][6] */ + -3.228859e-6, /* ccamps[0][7] */ + 3.442177e-7, /* ccamps[0][8] */ + 8.702406e-6, /* ccamps[0][9] */ + -1.488378e-6, /* ccamps[0][10] */ + -8.043059e-6, /* ccamps[0][11] */ + 3.699128e-6, /* ccamps[0][12] */ + 2.550120e-6, /* ccamps[0][13] */ + -6.351059e-7 }, /* ccamps[0][14] */ + { 1.407414e-5, /* ccamps[1][0] */ + 2.860401e-7, /* ccamps[1][1] */ + 1.322572e-5, /* ccamps[1][2] */ + -2.049792e-5, /* ccamps[1][3] */ + -2.748894e-6, /* ccamps[1][4] */ + -1.924710e-6, /* ccamps[1][5] */ + 7.359472e-6, /* ccamps[1][6] */ + 1.308997e-7, /* ccamps[1][7] */ + 2.671323e-6, /* ccamps[1][8] */ + -8.421214e-6, /* ccamps[1][9] */ + -1.251789e-5, /* ccamps[1][10] */ + -2.991300e-6, /* ccamps[1][11] */ + -3.316126e-6, /* ccamps[1][12] */ + -1.241123e-6, /* ccamps[1][13] */ + 2.341650e-6 }, /* ccamps[1][14] */ + { 8.273188e-6, /* ccamps[2][0] */ + 1.289448e-7, /* ccamps[2][1] */ + 9.258695e-6, /* ccamps[2][2] */ + -4.747930e-6, /* ccamps[2][3] */ + -1.319381e-6, /* ccamps[2][4] */ + -8.772849e-7, /* ccamps[2][5] */ + 3.168357e-6, /* ccamps[2][6] */ + 1.013137e-7, /* ccamps[2][7] */ + 1.832858e-6, /* ccamps[2][8] */ + -1.372341e-6, /* ccamps[2][9] */ + 5.226868e-7, /* ccamps[2][10] */ + 1.473654e-7, /* ccamps[2][11] */ + 2.901257e-7, /* ccamps[2][12] */ + 9.901116e-8, /* ccamps[2][13] */ + 1.061492e-6 }, /* ccamps[2][14] */ + { 1.340565e-5, /* ccamps[3][0] */ + 1.627237e-5, /* ccamps[3][1] */ + -4.674248e-7, /* ccamps[3][2] */ + -2.638763e-6, /* ccamps[3][3] */ + -4.549908e-6, /* ccamps[3][4] */ + -3.334143e-6, /* ccamps[3][5] */ + 1.119056e-6, /* ccamps[3][6] */ + 2.403899e-6, /* ccamps[3][7] */ + -2.394688e-7, /* ccamps[3][8] */ + -1.455234e-6, /* ccamps[3][9] */ + -2.049301e-7, /* ccamps[3][10] */ + -3.154542e-7, /* ccamps[3][11] */ + 3.407826e-7, /* ccamps[3][12] */ + 2.210482e-7, /* ccamps[3][13] */ + 2.878231e-7 }, /* ccamps[3][14] */ + { -2.490817e-7, /* ccamps[4][0] */ + -1.823138e-7, /* ccamps[4][1] */ + -3.646275e-7, /* ccamps[4][2] */ + -1.245408e-7, /* ccamps[4][3] */ + -1.864821e-7, /* ccamps[4][4] */ + -1.745256e-7, /* ccamps[4][5] */ + -1.655307e-7, /* ccamps[4][6] */ + -3.736225e-7, /* ccamps[4][7] */ + -3.478444e-7, /* ccamps[4][8] */ + -4.998479e-8, /* ccamps[4][9] */ + 0.0, /* ccamps[4][10] */ + 0.0, /* ccamps[4][11] */ + 0.0, /* ccamps[4][12] */ + 0.0, /* ccamps[4][13] */ + 0.0 } /* ccamps[4][14] */ + }; + +/* +** Constants of the secular perturbations in longitude +** ccsec3 and ccsec(n,k) +*/ + static double ccsec3 = -7.757020e-8; + static double ccsec[3][4] = { + { 1.289600e-6, /* ccsec[0][0] */ + 3.102810e-5, /* ccsec[0][1] */ + 9.124190e-6, /* ccsec[0][2] */ + 9.793240e-7 }, /* ccsec[0][3] */ + { 5.550147e-1, /* ccsec[1][0] */ + 4.035027, /* ccsec[1][1] */ + 9.990265e-1, /* ccsec[1][2] */ + 5.508259 }, /* ccsec[1][3] */ + { 2.076942, /* ccsec[2][0] */ + 3.525565e-1, /* ccsec[2][1] */ + 2.622706, /* ccsec[2][2] */ + 1.559103e+1 } /* ccsec[2][3] */ + }; + +/* +** Constants dcargm(i,k) of the arguments of the perturbations +** of the motion of the Moon +*/ + static double dcargm[2][3] = { + { 5.167983, /* dcargm[0][0] */ + 5.491315, /* dcargm[0][1] */ + 5.959853 }, /* dcargm[0][2] */ + { 8.3286911095275e+3, /* dcargm[1][0] */ + -7.2140632838100e+3, /* dcargm[1][1] */ + 1.5542754389685e+4 } /* dcargm[1][2] */ + }; + +/* +** Amplitudes ccampm(n,k) of the perturbations of the Moon +*/ + static double ccampm[4][3] = { + { 1.097594e-1, /* ccampm[0][0] */ + -2.223581e-2, /* ccampm[0][1] */ + 1.148966e-2 }, /* ccampm[0][2] */ + { 2.896773e-7, /* ccampm[1][0] */ + 5.083103e-8, /* ccampm[1][1] */ + 5.658888e-8 }, /* ccampm[1][2] */ + { 5.450474e-2, /* ccampm[2][0] */ + 1.002548e-2, /* ccampm[2][1] */ + 8.249439e-3 }, /* ccampm[2][2] */ + { 1.438491e-7, /* ccampm[3][0] */ + -2.291823e-8, /* ccampm[3][1] */ + 4.063015e-8 } /* ccampm[3][2] */ + }; + +/* +** +** Execution +** --------- +** +** Control parameter ideq, and time arguments +*/ + ideq = ( deqx <= 0.0 ) ? 0 : 1; + dt = ( date - 15019.5 ) / 36525.0; + +/* Values of all elements for the instant date */ + for ( k = 0; k < 8; k++ ) { + dlocal = dmod ( dcfel[0][k] + + dt * ( dcfel[1][k] + + dt * dcfel[2][k] ), D2PI ); + if ( k == 0 ) { + dml = dlocal; + } else { + forbel[k-1] = dlocal; + } + } + deps = dmod ( dceps[0] + + dt * ( dceps[1] + + dt * dceps[2] ) , D2PI ); + for ( k = 0; k < 17; k++ ) { + sorbel[k] = dmod ( ccsel[0][k] + + dt * ( ccsel[1][k] + + dt * ccsel[2][k] ), D2PI ); + } + +/* Secular perturbations in longitude */ + for ( k = 0; k < 4; k++ ) { + a = dmod ( ccsec[1][k] + dt * ccsec[2][k] , D2PI ); + sn[k] = sin ( a ); + } + +/* Periodic perturbations of the EMB (Earth-Moon barycentre) */ + pertl = ccsec[0][0] * sn[0] + + ccsec[0][1] * sn[1] + + ( ccsec[0][2] + dt * ccsec3 ) * sn[2] + + ccsec[0][3] * sn[3]; + pertld = 0.0; + pertr = 0.0; + pertrd = 0.0; + for ( k = 0; k < 15; k++ ) { + a = dmod ( dcargs[0][k] + dt * dcargs[1][k] , D2PI ); + cosa = cos ( a ); + sina = sin ( a ); + pertl += ccamps[0][k] * cosa + ccamps[1][k] * sina; + pertr += ccamps[2][k] * cosa + ccamps[3][k] * sina; + if ( k < 10 ) { + pertld += ( ccamps[1][k] * cosa + - ccamps[0][k] * sina ) * ccamps[4][k]; + pertrd += ( ccamps[3][k] * cosa + - ccamps[2][k] * sina ) * ccamps[4][k]; + } + } + +/* Elliptic part of the motion of the EMB */ + e = sorbel[0]; + twoe = e + e; + esq = e * e; + dparam = 1.0 - esq; + g = forbel[0]; + twog = g + g; + phi = twoe * ( ( 1.0 - esq / 8.0 ) * sin ( g ) + + 5.0 * e * sin ( twog ) / 8.0 + + 13.0 * esq * sin ( g + twog ) / 24.0 ); + f = forbel[0] + phi; + sf = sin ( f ); + cf = cos ( f ); + dpsi = dparam / ( 1.0 + e * cf ); + phid = twoe * ccsgd * ( ( 1.0 + esq * 1.5 ) * cf + + e * ( 1.25 - sf * sf / 2.0 ) ); + psid = ccsgd * e * sf / sqrt ( dparam ); + +/* Perturbed heliocentric motion of the EMB */ + d1pdro = 1.0 + pertr; + drd = d1pdro * ( psid + dpsi * pertrd ); + drld = d1pdro * dpsi * ( dcsld + phid + pertld ); + dtl = dmod ( dml + phi + pertl , D2PI ); + dsinls = sin ( dtl ); + dcosls = cos ( dtl ); + dxhd = drd * dcosls - drld * dsinls; + dyhd = drd * dsinls + drld * dcosls; + +/* Influence of eccentricity, evection and variation on the +** geocentric motion of the Moon */ + pertl = 0.0; + pertld = 0.0; + pertp = 0.0; + pertpd = 0.0; + for ( k = 0; k < 3; k++ ) { + a = dmod ( dcargm[0][k] + dt * dcargm[1][k] , D2PI ); + sina = sin ( a ); + cosa = cos ( a ); + pertl += ccampm[0][k] * sina; + pertld += ccampm[1][k] * cosa; + pertp += ccampm[2][k] * cosa; + pertpd += - ccampm[3][k] * sina; + } + +/* Heliocentric motion of the Earth */ + tl = forbel[1] + pertl; + sinlm = sin ( tl ); + coslm = cos ( tl ); + sigma = cckm / ( 1.0 + pertp ); + a = sigma * ( ccmld + pertld ); + b = sigma * pertpd; + dxhd += a * sinlm + b * coslm; + dyhd += - a * coslm + b * sinlm; + dzhd = - sigma * ccfdi * cos ( forbel[2] ); + +/* Barycentric motion of the Earth */ + dxbd = dxhd * dc1mme; + dybd = dyhd * dc1mme; + dzbd = dzhd * dc1mme; + for ( k = 0; k < 4; k++ ) { + plon = forbel[k+3]; + pomg = sorbel[k+1]; + pecc = sorbel[k+9]; + tl = dmod( plon + 2.0 * pecc * sin ( plon - pomg ) , D2PI ); + sinlp[k] = sin ( tl ); + coslp[k] = cos ( tl ); + dxbd += ccpamv[k] * ( sinlp[k] + pecc * sin ( pomg ) ); + dybd += - ccpamv[k] * ( coslp[k] + pecc * cos ( pomg ) ); + dzbd += - ccpamv[k] * sorbel[k+13] * cos ( plon - sorbel[k+5] ); + } + +/* Transition to mean equator of date */ + dcosep = cos ( deps ); + dsinep = sin ( deps ); + dyahd = dcosep * dyhd - dsinep * dzhd; + dzahd = dsinep * dyhd + dcosep * dzhd; + dyabd = dcosep * dybd - dsinep * dzbd; + dzabd = dsinep * dybd + dcosep * dzbd; + +/* Heliocentric coordinates of the Earth */ + dr = dpsi * d1pdro; + flatm = ccim * sin ( forbel[2] ); + a = sigma * cos ( flatm ); + dxh = dr * dcosls - a * coslm; + dyh = dr * dsinls - a * sinlm; + dzh = - sigma * sin ( flatm ); + +/* Barycentric coordinates of the Earth */ + dxb = dxh * dc1mme; + dyb = dyh * dc1mme; + dzb = dzh * dc1mme; + for ( k = 0; k < 4; k++ ) { + flat = sorbel[k+13] * sin ( forbel[k+3] - sorbel[k+5] ); + a = ccpam[k] * (1.0 - sorbel[k+9] * cos ( forbel[k+3] - sorbel[k+1])); + b = a * cos(flat); + dxb -= b * coslp[k]; + dyb -= b * sinlp[k]; + dzb -= a * sin ( flat ); + } + +/* Transition to mean equator of date */ + dyah = dcosep * dyh - dsinep * dzh; + dzah = dsinep * dyh + dcosep * dzh; + dyab = dcosep * dyb - dsinep * dzb; + dzab = dsinep * dyb + dcosep * dzb; + +/* Copy result components into vectors, correcting for FK4 equinox */ + depj = slaEpj ( date ); + deqcor = DS2R * ( 0.035 + ( 0.00085 * ( depj - b1950 ) ) ); + dvh[0] = dxhd - deqcor * dyahd; + dvh[1] = dyahd + deqcor * dxhd; + dvh[2] = dzahd; + dvb[0] = dxbd - deqcor * dyabd; + dvb[1] = dyabd + deqcor * dxbd; + dvb[2] = dzabd; + dph[0] = dxh - deqcor * dyah; + dph[1] = dyah + deqcor * dxh; + dph[2] = dzah; + dpb[0] = dxb - deqcor * dyab; + dpb[1] = dyab + deqcor * dxb; + dpb[2] = dzab; + +/* Was precession to another equinox requested? */ + if ( ideq != 0 ) { + + /* Yes: compute precession matrix from MJD date to Julian Epoch deqx */ + slaPrec ( depj, deqx, dprema ); + + /* Rotate dvh */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dprema[j][i] * dvh[i]; + } + vw[j] = w; + } + for ( j = 0; j < 3; j++ ) { + dvh[j] = vw[j]; + } + + /* Rotate dvb */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dprema[j][i] * dvb[i]; + } + vw[j] = w; + } + for ( j = 0; j < 3; j++ ) { + dvb[j] = vw[j]; + } + + /* Rotate dph */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dprema[j][i] * dph[i]; + } + vw[j] = w; + } + for ( j = 0; j < 3; j++ ) { + dph[j] = vw[j]; + } + + /* Rotate dpb */ + for ( j = 0; j < 3; j++ ) { + w = 0.0; + for ( i = 0; i < 3; i++ ) { + w += dprema[j][i] * dpb[i]; + } + vw[j] = w; + } + for ( j = 0; j < 3; j++ ) { + dpb[j] = vw[j]; + } + } +} Index: trunk/MagicSoft/slalib/fitxy.c =================================================================== --- trunk/MagicSoft/slalib/fitxy.c (revision 731) +++ trunk/MagicSoft/slalib/fitxy.c (revision 731) @@ -0,0 +1,289 @@ +#include "slalib.h" +#include "slamac.h" +void slaFitxy ( int itype, int np, + double xye[][2], double xym[][2], double coeffs[6], + int *j ) +/* +** - - - - - - - - - +** s l a F i t x y +** - - - - - - - - - +** +** Fit a linear model to relate two sets of [x,y] coordinates. +** +** Given: +** itype int type of model: 4 or 6 (note 1) +** np int number of samples (note 2) +** xye double[np][2] expected [x,y] for each sample +** xym double[np][2] measured [x,y] for each sample +** +** Returned: +** coeffs double[6] coefficients of model (note 3) +** *j int status: 0 = OK +** -1 = illegal itype +** -2 = insufficient data +** -3 = singular solution +** +** Notes: +** +** 1) itype, which must be either 4 or 6, selects the type of model +** fitted. Both allowed itype values produce a model coeffs which +** consists of six coefficients, namely the zero points and, for +** each of xe and ye, the coefficient of xm and ym. For itype=6, +** all six coefficients are independent, modelling squash and shear +** as well as origin, scale, and orientation. However, itype=4 +** selects the "solid body rotation" option; the model coeffs +** still consists of the same six coefficients, but now two of +** them are used twice (appropriately signed). Origin, scale +** and orientation are still modelled, but not squash or shear - +** the units of x and y have to be the same. +** +** 2) For nc=4, np must be at least 2. For nc=6, np must be at +** least 3. +** +** 3) The model is returned in the array coeffs. Naming the +** elements of coeffs as follows: +** +** coeffs[0] = a +** coeffs[1] = b +** coeffs[2] = c +** coeffs[3] = d +** coeffs[4] = e +** coeffs[5] = f +** +** The model is: +** +** xe = a + b*xm + c*ym +** ye = d + e*xm + f*ym +** +** For the "solid body rotation" option (itype=4), the +** magnitudes of b and f, and of c and e, are equal. The +** signs of these coefficients depend on whether there is a +** sign reversal between xe,ye and xm,ym. Fits are performed +** with and without a sign reversal and the best one chosen. +** +** 4) Error status values j=-1 and -2 leave coeffs unchanged; +** If j=-3 coeffs may have been changed. +** +** See also slaPxy, slaInvf, slaXy2xy, slaDcmpf +** +** Called: slaDmat, slaDmxv +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, jstat; + int iw[4]; + int nsol; + double p, sxe, sxexm, sxeym, sye, syeym, syexm, sxm, + sym, sxmxm, sxmym, symym, xe, ye, + xm, ym, v[4], dm3[3][3], dm4[4][4], det, + sgn, sxxyy, sxyyx, sx2y2, a, b, c, d, + sdr2, xr, yr, aold, bold, cold, dold, sold; + +/* Preset the status */ + *j = 0; + +/* Float the number of samples */ + p = (double) np; + +/* Check itype */ + if ( itype == 6 ) { + +/* +** Six-coefficient linear model +** ---------------------------- +*/ + + /* Check enough samples */ + if ( np >= 3 ) { + + /* Form summations */ + sxe = 0.0; + sxexm = 0.0; + sxeym = 0.0; + sye = 0.0; + syeym = 0.0; + syexm = 0.0; + sxm = 0.0; + sym = 0.0; + sxmxm = 0.0; + sxmym = 0.0; + symym = 0.0; + + for ( i = 0; i < np; i++ ) { + xe = xye[i][0]; + ye = xye[i][1]; + xm = xym[i][0]; + ym = xym[i][1]; + sxe = sxe + xe; + sxexm = sxexm + xe * xm; + sxeym = sxeym + xe * ym; + sye = sye + ye; + syeym = syeym + ye * ym; + syexm = syexm + ye * xm; + sxm = sxm + xm; + sym = sym + ym; + sxmxm = sxmxm + xm * xm; + sxmym = sxmym + xm * ym; + symym = symym + ym * ym; + } + + /* Solve for a,b,c in xe = a + b*xm + c*ym */ + v[0] = sxe; + v[1] = sxexm; + v[2] = sxeym; + dm3[0][0] = p; + dm3[0][1] = sxm; + dm3[0][2] = sym; + dm3[1][0] = sxm; + dm3[1][1] = sxmxm; + dm3[1][2] = sxmym; + dm3[2][0] = sym; + dm3[2][1] = sxmym; + dm3[2][2] = symym; + slaDmat ( 3, dm3[0], v, &det, &jstat, iw); + if (jstat == 0) { + for ( i = 0; i < 3; i++ ) { + coeffs[i] = v[i]; + } + + /* Solve for d,e,f in ye = d + e*xm + f*ym */ + v[0] = sye; + v[1] = syexm; + v[2] = syeym; + slaDmxv ( dm3, v, &coeffs[3] ); + } else { + + /* No 6-coefficient solution possible */ + *j = -3; + } + } else { + + /* Insufficient data for 6-coefficient fit */ + *j = -2; + } + } else if ( itype == 4 ) { + + /* + ** Four-coefficient solid body rotation model + ** ------------------------------------------ + */ + + /* Check enough samples */ + if ( np >= 2 ) { + + /* Try two solutions, first without then with flip in x */ + for ( nsol = 1; nsol <= 2; nsol++ ) { + sgn = ( nsol == 1 ) ? 1.0 : -1.0; + + /* Form summations*/ + sxe = 0.0; + sxxyy = 0.0; + sxyyx = 0.0; + sye = 0.0; + sxm = 0.0; + sym = 0.0; + sx2y2 = 0.0; + for ( i = 0; i < np; i++ ) { + xe = xye[i][0] * sgn; + ye = xye[i][1]; + xm = xym[i][0]; + ym = xym[i][1]; + sxe = sxe + xe; + sxxyy = sxxyy + xe * xm + ye * ym; + sxyyx = sxyyx + xe * ym - ye * xm; + sye = sye + ye; + sxm = sxm + xm; + sym = sym + ym; + sx2y2 = sx2y2 + xm * xm + ym * ym; + } + + /* + ** Solve for a,b,c,d in: +/- xe = a + b*xm - c*ym + ** + ye = d + c*xm + b*ym + */ + v[0] = sxe; + v[1] = sxxyy; + v[2] = sxyyx; + v[3] = sye; + dm4[0][0] = p; + dm4[0][1] = sxm; + dm4[0][2] = -sym; + dm4[0][3] = 0.0; + dm4[1][0] = sxm; + dm4[1][1] = sx2y2; + dm4[1][2] = 0.0; + dm4[1][3] = sym; + dm4[2][0] = sym; + dm4[2][1] = 0.0; + dm4[2][2] = -sx2y2; + dm4[2][3] = -sxm; + dm4[3][0] = 0.0; + dm4[3][1] = sym; + dm4[3][2] = sxm; + dm4[3][3] = p; + slaDmat ( 4, dm4[0], v, &det, &jstat, iw ); + if ( jstat == 0 ) { + a = v[0]; + b = v[1]; + c = v[2]; + d = v[3]; + + /* Determine sum of radial errors squared */ + sdr2 = 0.0; + for ( i = 0; i < np; i++ ) { + xm = xym[i][0]; + ym = xym[i][1]; + xr = a + b * xm - c * ym - xye[i][0] * sgn; + yr = d + c * xm + b * ym- xye[i][1]; + sdr2 = sdr2 + xr * xr + yr * yr; + } + } else { + + /* Singular: set flag */ + sdr2 = -1.0; + } + + /* If first pass and non-singular, save variables */ + if ( nsol == 1 && jstat == 0 ) { + aold = a; + bold = b; + cold = c; + dold = d; + sold = sdr2; + } + } + + /* Pick the best of the two solutions */ + if ( sold >= 0.0 && sold <= sdr2 ) { + coeffs[0] = aold; + coeffs[1] = bold; + coeffs[2] = -cold; + coeffs[3] = dold; + coeffs[4] = cold; + coeffs[5] = bold; + } else if ( jstat == 0 ) { + coeffs[0] = -a; + coeffs[1] = -b; + coeffs[2] = c; + coeffs[3] = d; + coeffs[4] = c; + coeffs[5] = b; + } else { + + /* No 4-coefficient fit possible */ + *j = -3; + } + } else { + + /* Insufficient data for 4-coefficient fit */ + *j = -2; + } + } else { + + /* Illegal itype - not 4 or 6 */ + *j = -1; + } +} Index: trunk/MagicSoft/slalib/fk425.c =================================================================== --- trunk/MagicSoft/slalib/fk425.c (revision 731) +++ trunk/MagicSoft/slalib/fk425.c (revision 731) @@ -0,0 +1,246 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk425 ( double r1950, double d1950, double dr1950, + double dd1950, double p1950, double v1950, + double *r2000, double *d2000, double *dr2000, + double *dd2000, double *p2000, double *v2000 ) +/* +** - - - - - - - - - +** s l a F k 4 2 5 +** - - - - - - - - - +** +** Convert B1950.0 FK4 star data to J2000.0 FK5. +** +** (double precision) +** +** This routine converts stars from the old, Bessel-Newcomb, FK4 +** system to the new, IAU 1976, FK5, Fricke system. The precepts +** of Smith et al (Ref 1) are followed, using the implementation +** by Yallop et al (Ref 2) of a matrix method due to Standish. +** Kinoshita's development of Andoyer's post-Newcomb precession is +** used. The numerical constants from Seidelmann et al (Ref 3) are +** used canonically. +** +** Given: (all B1950.0,FK4) +** +** r1950,d1950 double B1950.0 RA,dec (rad) +** dr1950,dd1950 double B1950.0 proper motions (rad/trop.yr) +** p1950 double parallax (arcsec) +** v1950 double radial velocity (km/s, +ve = moving away) +** +** Returned: (all J2000.0,FK5) +** +** *r2000,*d2000 double J2000.0 RA,dec (rad) +** *dr2000,*dd2000 double J2000.0 proper motions (rad/jul.yr) +** *p2000 double parallax (arcsec) +** *v2000 double radial velocity (km/s, +ve = moving away) +** +** Notes: +** +** 1) The proper motions in RA are dRA/dt rather than +** cos(Dec)*dRA/dt, and are per year rather than per century. +** +** 2) Conversion from Besselian epoch 1950.0 to Julian epoch +** 2000.0 only is provided for. Conversions involving other +** epochs will require use of the appropriate precession, +** proper motion, and E-terms routines before and/or +** after FK425 is called. +** +** 3) In the FK4 catalogue the proper motions of stars within +** 10 degrees of the poles do not embody the differential +** E-term effect and should, strictly speaking, be handled +** in a different manner from stars outside these regions. +** However, given the general lack of homogeneity of the star +** data available for routine astrometry, the difficulties of +** handling positions that may have been determined from +** astrometric fields spanning the polar and non-polar regions, +** the likelihood that the differential E-terms effect was not +** taken into account when allowing for proper motion in past +** astrometry, and the undesirability of a discontinuity in +** the algorithm, the decision has been made in this routine to +** include the effect of differential E-terms on the proper +** motions for all stars, whether polar or not. At epoch 2000, +** and measuring on the sky rather than in terms of dRA, the +** errors resulting from this simplification are less than +** 1 milliarcsecond in position and 1 milliarcsecond per +** century in proper motion. +** +** References: +** +** 1 Smith, C.A. et al, 1989. "The transformation of astrometric +** catalog systems to the equinox J2000.0". Astron.J. 97, 265. +** +** 2 Yallop, B.D. et al, 1989. "Transformation of mean star places +** from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". +** Astron.J. 97, 274. +** +** 3 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to +** the Astronomical Almanac", ISBN 0-935702-68-7. +** +** Defined in slamac.h: D2PI +** +** Last revision: 26 September 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double r, d, ur, ud, px, rv, sr, cr, sd, cd, w, wd, + x, y, z, xd, yd, zd, + rxysq, rxyzsq, rxy, rxyz, spxy, spxyz; + int i, j; + +/* Star position and velocity vectors */ + double r0[3], rd0[3]; + +/* Combined position and velocity vectors */ + double v1[6], v2[6]; + +/* Radians per year to arcsec per century */ + static double pmf = 100.0 * 60.0 * 60.0 * 360.0 / D2PI; + +/* Small number to avoid arithmetic problems */ + double tiny = 1.0e-30; + +/* +** Canonical constants (see references) +*/ + +/* +** Km per sec to AU per tropical century +** = 86400 * 36524.2198782 / 1.49597870e8 +*/ + double vf = 21.095; + +/* Constant vector and matrix (by rows) */ + static double a[3] = { -1.62557e-6, -0.31919e-6, -0.13843e-6 }; + static double ad[3] = { 1.245e-3, -1.580e-3, -0.659e-3 }; + static double em[6][6] = + { + { 0.9999256782, /* em[0][0] */ + -0.0111820611, /* em[0][1] */ + -0.0048579477, /* em[0][2] */ + 0.00000242395018, /* em[0][3] */ + -0.00000002710663, /* em[0][4] */ + -0.00000001177656 }, /* em[0][5] */ + + { 0.0111820610, /* em[1][0] */ + 0.9999374784, /* em[1][1] */ + -0.0000271765, /* em[1][2] */ + 0.00000002710663, /* em[1][3] */ + 0.00000242397878, /* em[1][4] */ + -0.00000000006587 }, /* em[1][5] */ + + { 0.0048579479, /* em[2][0] */ + -0.0000271474, /* em[2][1] */ + 0.9999881997, /* em[2][2] */ + 0.00000001177656, /* em[2][3] */ + -0.00000000006582, /* em[2][4] */ + 0.00000242410173 }, /* em[2][5] */ + + { -0.000551, /* em[3][0] */ + -0.238565, /* em[3][1] */ + 0.435739, /* em[3][2] */ + 0.99994704, /* em[3][3] */ + -0.01118251, /* em[3][4] */ + -0.00485767 }, /* em[3][5] */ + + { 0.238514, /* em[4][0] */ + -0.002667, /* em[4][1] */ + -0.008541, /* em[4][2] */ + 0.01118251, /* em[4][3] */ + 0.99995883, /* em[4][4] */ + -0.00002718 }, /* em[4][5] */ + + { -0.435623, /* em[5][0] */ + 0.012254, /* em[5][1] */ + 0.002117, /* em[5][2] */ + 0.00485767, /* em[5][3] */ + -0.00002714, /* em[5][4] */ + 1.00000956 } /* em[5][5] */ + }; + +/* Pick up B1950 data (units radians and arcsec/tc) */ + r = r1950; + d = d1950; + ur = dr1950 * pmf; + ud = dd1950 * pmf; + px = p1950; + rv = v1950; + +/* Spherical to Cartesian */ + sr = sin ( r ); + cr = cos ( r ); + sd = sin ( d ); + cd = cos ( d ); + + r0[0] = cr * cd; + r0[1] = sr * cd; + r0[2] = sd; + + w = vf * rv * px; + + rd0[0] = ( -sr * cd * ur ) - ( cr * sd * ud ) + ( w * r0[0] ); + rd0[1] = ( cr * cd * ur ) - ( sr * sd * ud ) + ( w * r0[1] ); + rd0[2] = ( cd * ud ) + ( w * r0[2] ); + +/* Allow for e-terms and express as position+velocity 6-vector */ + w = ( r0[0] * a[0] ) + ( r0[1] * a[1] ) + ( r0[2] * a[2] ); + wd = ( r0[0] * ad[0] ) + ( r0[1] * ad[1] ) + ( r0[2] * ad[2] ); + + for ( i = 0; i < 3; i++ ) { + v1[i] = r0[i] - a[i] + w * r0[i]; + v1[i+3] = rd0[i] - ad[i] + wd * r0[i]; + } + +/* Convert position+velocity vector to Fricke system */ + for ( i = 0; i < 6; i++ ) { + w = 0.0; + for ( j = 0; j < 6; j++ ) { + w += em[i][j] * v1[j]; + } + v2[i] = w; + } + +/* Revert to spherical coordinates */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + xd = v2[3]; + yd = v2[4]; + zd = v2[5]; + + rxysq = ( x * x ) + ( y * y ); + rxyzsq = ( rxysq ) + ( z * z ); + rxy = sqrt ( rxysq ); + rxyz = sqrt ( rxyzsq ); + + spxy = ( x * xd ) + ( y * yd ); + spxyz = spxy + ( z * zd ); + + if ( (x == 0.0) && (y == 0.0) ) + r = 0.0; + else { + r = atan2 ( y, x ); + if ( r < 0.0 ) + r += D2PI; + } + d = atan2 ( z, rxy ); + + if ( rxy > tiny ) { + ur = ( ( x * yd ) - ( y * xd ) ) / rxysq; + ud = ( ( zd * rxysq ) - ( z * spxy ) ) / ( rxyzsq * rxy ); + } + + if ( px > tiny ) { + rv = spxyz / ( px * rxyz * vf ); + px = px / rxyz; + } + +/* Return results */ + *r2000 = r; + *d2000 = d; + *dr2000 = ur / pmf; + *dd2000 = ud / pmf; + *v2000 = rv; + *p2000 = px; +} Index: trunk/MagicSoft/slalib/fk45z.c =================================================================== --- trunk/MagicSoft/slalib/fk45z.c (revision 731) +++ trunk/MagicSoft/slalib/fk45z.c (revision 731) @@ -0,0 +1,143 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk45z ( double r1950, double d1950, double bepoch, + double *r2000, double *d2000 ) +/* +** - - - - - - - - - +** s l a F k 4 5 z +** - - - - - - - - - +** +** Convert B1950.0 FK4 star data to J2000.0 FK5 assuming zero +** proper motion in the FK5 frame (double precision) +** +** This routine converts stars from the old, Bessel-Newcomb, FK4 +** system to the new, IAU 1976, FK5, Fricke system, in such a +** way that the FK5 proper motion is zero. Because such a star +** has, in general, a non-zero proper motion in the FK4 system, +** the routine requires the epoch at which the position in the +** FK4 system was determined. +** +** The method is from Appendix 2 of Ref 1, but using the constants +** of Ref 4. +** +** Given: +** r1950,d1950 double B1950.0 FK4 RA,Dec at epoch (rad) +** bepoch double Besselian epoch (e.g. 1979.3) +** +** Returned: +** *r2000,*d2000 double J2000.0 FK5 RA,Dec (rad) +** +** Notes: +** +** 1) The epoch BEPOCH is strictly speaking Besselian, but +** if a Julian epoch is supplied the result will be +** affected only to a negligible extent. +** +** 2) Conversion from Besselian epoch 1950.0 to Julian epoch +** 2000.0 only is provided for. Conversions involving other +** epochs will require use of the appropriate precession, +** proper motion, and E-terms routines before and/or +** after FK45Z is called. +** +** 3) In the FK4 catalogue the proper motions of stars within +** 10 degrees of the poles do not embody the differential +** E-term effect and should, strictly speaking, be handled +** in a different manner from stars outside these regions. +** However, given the general lack of homogeneity of the star +** data available for routine astrometry, the difficulties of +** handling positions that may have been determined from +** astrometric fields spanning the polar and non-polar regions, +** the likelihood that the differential E-terms effect was not +** taken into account when allowing for proper motion in past +** astrometry, and the undesirability of a discontinuity in +** the algorithm, the decision has been made in this routine to +** include the effect of differential E-terms on the proper +** motions for all stars, whether polar or not. At epoch 2000, +** and measuring on the sky rather than in terms of dRA, the +** errors resulting from this simplification are less than +** 1 milliarcsecond in position and 1 milliarcsecond per +** century in proper motion. +** +** References: +** +** 1 Aoki,S., et al, 1983. Astron. Astrophys., 128, 263. +** +** 2 Smith, C.A. et al, 1989. "The transformation of astrometric +** catalog systems to the equinox J2000.0". Astron.J. 97, 265. +** +** 3 Yallop, B.D. et al, 1989. "Transformation of mean star places +** from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". +** Astron.J. 97, 274. +** +** 4 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to +** the Astronomical Almanac", ISBN 0-935702-68-7. +** +** Called: slaDcs2c, slaEpj, slaEpb2d, slaDcc2s, slaDranrm +** +** Defined in slamac.h: D2PI +** +** Last revision: 21 September 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double w; + int i, j; + +/* Position and position+velocity vectors */ + double r0[3], a1[3], v1[3], v2[6]; + +/* Radians per year to arcsec per century */ + static double pmf = 100.0 * 60.0 * 60.0 * 360.0 / D2PI; + +/* +** Canonical constants (see references) +*/ + +/* vectors a and adot, and matrix m (only half of which is needed here) */ + static double a[3] = { -1.62557e-6, -0.31919e-6, -0.13843e-6 }; + static double ad[3] = { 1.245e-3, -1.580e-3, -0.659e-3 }; + static double em[6][3] = + { + { 0.9999256782, -0.0111820611, -0.0048579477 }, + { 0.0111820610, 0.9999374784, -0.0000271765 }, + { 0.0048579479, -0.0000271474, 0.9999881997 }, + { -0.000551, -0.238565, 0.435739 }, + { 0.238514, -0.002667, -0.008541 }, + { -0.435623, 0.012254, 0.002117 } + }; + +/* Spherical to Cartesian */ + slaDcs2c ( r1950, d1950, r0 ); + +/* Adjust vector a to give zero proper motion in FK5 */ + w = ( bepoch - 1950.0 ) / pmf; + for ( i = 0; i < 3; i++ ) { + a1[i] = a[i] + w * ad[i]; + } + +/* Remove e-terms */ + w = r0[0] * a1[0] + r0[1] * a1[1] + r0[2] * a1[2]; + for ( i = 0; i < 3; i++ ) { + v1[i] = r0[i] - a1[i] + w * r0[i]; + } + +/* Convert position vector to Fricke system */ + for ( i = 0; i < 6; i++ ) { + w = 0.0; + for ( j = 0; j < 3; j++ ) { + w += em[i][j] * v1[j]; + } + v2[i] = w; + } + +/* Allow for fictitious proper motion in FK4 */ + w = ( slaEpj ( slaEpb2d ( bepoch ) ) - 2000.0 ) / pmf; + for ( i = 0; i < 3; i++ ) { + v2[i] += w * v2[i+3]; + } + +/* Revert to spherical coordinates */ + slaDcc2s ( v2, &w, d2000 ); + *r2000 = slaDranrm ( w ); +} Index: trunk/MagicSoft/slalib/fk524.c =================================================================== --- trunk/MagicSoft/slalib/fk524.c (revision 731) +++ trunk/MagicSoft/slalib/fk524.c (revision 731) @@ -0,0 +1,256 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk524 ( double r2000, double d2000, double dr2000, + double dd2000, double p2000, double v2000, + double *r1950, double *d1950, double *dr1950, + double *dd1950, double *p1950, double *v1950 ) +/* +** - - - - - - - - - +** s l a F k 5 2 4 +** - - - - - - - - - +** +** Convert J2000.0 FK5 star data to B1950.0 FK4. +** +** (double precision) +** +** This routine converts stars from the new, IAU 1976, FK5, Fricke +** system, to the old, Bessel-Newcomb, FK4 system. The precepts +** of Smith et al (Ref 1) are followed, using the implementation +** by Yallop et al (Ref 2) of a matrix method due to Standish. +** Kinoshita's development of Andoyer's post-Newcomb precession is +** used. The numerical constants from Seidelmann et al (Ref 3) are +** used canonically. +** +** Given: (all J2000.0,FK5) +** r2000,d2000 double J2000.0 RA,Dec (rad) +** dr2000,dd2000 double J2000.0 proper motions (rad/Jul.yr) +** p2000 double parallax (arcsec) +** v2000 double radial velocity (km/s, +ve = moving away) +** +** Returned: (all B1950.0,FK4) +** *r1950,*d1950 double B1950.0 RA,Dec (rad) +** *dr1950,*dd1950 double B1950.0 proper motions (rad/trop.yr) +** *p1950 double parallax (arcsec) +** *v1950 double radial velocity (km/s, +ve = moving away) +** +** Notes: +** +** 1) The proper motions in RA are dRA/dt rather than +** cos(Dec)*dRA/dt, and are per year rather than per century. +** +** 2) Note that conversion from Julian epoch 2000.0 to Besselian +** epoch 1950.0 only is provided for. Conversions involving +** other epochs will require use of the appropriate precession, +** proper motion, and E-terms routines before and/or after +** FK524 is called. +** +** 3) In the FK4 catalogue the proper motions of stars within +** 10 degrees of the poles do not embody the differential +** E-term effect and should, strictly speaking, be handled +** in a different manner from stars outside these regions. +** However, given the general lack of homogeneity of the star +** data available for routine astrometry, the difficulties of +** handling positions that may have been determined from +** astrometric fields spanning the polar and non-polar regions, +** the likelihood that the differential E-terms effect was not +** taken into account when allowing for proper motion in past +** astrometry, and the undesirability of a discontinuity in +** the algorithm, the decision has been made in this routine to +** include the effect of differential E-terms on the proper +** motions for all stars, whether polar or not. At epoch 2000, +** and measuring on the sky rather than in terms of dRA, the +** errors resulting from this simplification are less than +** 1 milliarcsecond in position and 1 milliarcsecond per +** century in proper motion. +** +** References: +** +** 1 Smith, C.A. et al, 1989. "The transformation of astrometric +** catalog systems to the equinox J2000.0". Astron.J. 97, 265. +** +** 2 Yallop, B.D. et al, 1989. "Transformation of mean star places +** from FK4 B1950.0 to FK5 J2000.0 using matrices in 6-space". +** Astron.J. 97, 274. +** +** 3 Seidelmann, P.K. (ed), 1992. "Explanatory Supplement to +** the Astronomical Almanac", ISBN 0-935702-68-7. +** +** Defined in slamac.h: D2PI +** +** Last revision: 20 December 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + +/* Miscellaneous */ + double r, d, ur, ud, px, rv; + double sr, cr, sd, cd, x, y, z, w; + double v1[6], v2[6]; + double xd, yd, zd; + double rxyz, wd, rxysq, rxy; + int i,j; + +/* Radians per year to arcsec per century */ + static double pmf = 100.0 * 60.0 * 60.0 * 360.0 / D2PI; + +/* Small number to avoid arithmetic problems */ + static double tiny = 1.0e-30; + +/* +** Canonical constants (see references) +*/ + +/* +** km per sec to AU per tropical century +** = 86400 * 36524.2198782 / 1.49597870e8 +*/ + static double vf = 21.095; + +/* Constant vector and matrix (by rows) */ + static double a[6] = { -1.62557e-6, -0.31919e-6, -0.13843e-6, + 1.245e-3, -1.580e-3, -0.659e-3 }; + + static double emi[6][6] = + { + { 0.9999256795, /* emi[0][0] */ + 0.0111814828, /* emi[0][1] */ + 0.0048590039, /* emi[0][2] */ + -0.00000242389840, /* emi[0][3] */ + -0.00000002710544, /* emi[0][4] */ + -0.00000001177742 }, /* emi[0][5] */ + + { -0.0111814828, /* emi[1][0] */ + 0.9999374849, /* emi[1][1] */ + -0.0000271771, /* emi[1][2] */ + 0.00000002710544, /* emi[1][3] */ + -0.00000242392702, /* emi[1][4] */ + 0.00000000006585 }, /* emi[1][5] */ + + { -0.0048590040, /* emi[2][0] */ + -0.0000271557, /* emi[2][1] */ + 0.9999881946, /* emi[2][2] */ + 0.00000001177742, /* emi[2][3] */ + 0.00000000006585, /* emi[2][4] */ + -0.00000242404995 }, /* emi[2][5] */ + + { -0.000551, /* emi[3][0] */ + 0.238509, /* emi[3][1] */ + -0.435614, /* emi[3][2] */ + 0.99990432, /* emi[3][3] */ + 0.01118145, /* emi[3][4] */ + 0.00485852 }, /* emi[3][5] */ + + { -0.238560, /* emi[4][0] */ + -0.002667, /* emi[4][1] */ + 0.012254, /* emi[4][2] */ + -0.01118145, /* emi[4][3] */ + 0.99991613, /* emi[4][4] */ + -0.00002717 }, /* emi[4][5] */ + + { 0.435730, /* emi[5][0] */ + -0.008541, /* emi[5][1] */ + 0.002117, /* emi[5][2] */ + -0.00485852, /* emi[5][3] */ + -0.00002716, /* emi[5][4] */ + 0.99996684 } /* emi[5][5] */ + }; + +/* Pick up J2000 data (units radians and arcsec/JC) */ + r = r2000; + d = d2000; + ur = dr2000 * pmf; + ud = dd2000 * pmf; + px = p2000; + rv = v2000; + +/* Spherical to Cartesian */ + sr = sin ( r ); + cr = cos ( r ); + sd = sin ( d ); + cd = cos ( d ); + + x = cr * cd; + y = sr * cd; + z = sd; + + w = vf * rv * px; + + v1[0] = x; + v1[1] = y; + v1[2] = z; + + v1[3] = - ur * y - cr * sd * ud + w * x; + v1[4] = ur * x - sr * sd * ud + w * y; + v1[5] = cd * ud + w * z; + +/* Convert position+velocity vector to BN system */ + for ( i = 0; i < 6; i++ ) { + w = 0.0; + for ( j = 0; j < 6; j++ ) { + w += emi[i][j] * v1[j]; + } + v2[i] = w; + } + +/* Position vector components and magnitude */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + rxyz = sqrt ( x * x + y * y + z * z ); + +/* Include e-terms */ + w = x * a[0] + y * a[1] + z * a[2]; + x += a[0] * rxyz - w * x; + y += a[1] * rxyz - w * y; + z += a[2] * rxyz - w * z; + +/* Recompute magnitude */ + rxyz = sqrt ( x * x + y * y + z * z ); + +/* Apply E-terms to both position and velocity */ + x = v2[0]; + y = v2[1]; + z = v2[2]; + w = x * a[0] + y * a[1] + z * a[2]; + wd = x * a[3] + y * a[4] + z * a[5]; + x += a[0] * rxyz - w * x; + y += a[1] * rxyz - w * y; + z += a[2] * rxyz - w * z; + xd = v2[3] + a[3] * rxyz - wd * x; + yd = v2[4] + a[4] * rxyz - wd * y; + zd = v2[5] + a[5] * rxyz - wd * z; + +/* Convert to spherical */ + rxysq = x * x + y * y; + rxy = sqrt ( rxysq ); + + if ( ( x == 0.0 ) && ( y == 0.0 ) ) { + r = 0.0; + } else { + r = atan2 ( y, x ); + if ( r < 0.0 ) r += D2PI; + } + d = atan2 ( z, rxy ); + + if (rxy > tiny) { + ur = ( x * yd - y * xd ) / rxysq; + ud = ( zd * rxysq - z * ( x * xd + y * yd ) ) / + ( ( rxysq + z * z ) * rxy ); + } + +/* Radial velocity and parallax */ + if ( px > tiny ) + { + rv = ( x * xd + y * yd + z * zd ) / ( px * vf * rxyz ); + px = px / rxyz; + } + +/* Return results */ + *r1950 = r; + *d1950 = d; + *dr1950 = ur / pmf; + *dd1950 = ud / pmf; + *v1950 = rv; + *p1950 = px; +} Index: trunk/MagicSoft/slalib/fk52h.c =================================================================== --- trunk/MagicSoft/slalib/fk52h.c (revision 731) +++ trunk/MagicSoft/slalib/fk52h.c (revision 731) @@ -0,0 +1,88 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk52h ( double r5, double d5, double dr5, double dd5, + double *rh, double *dh, double *drh, double *ddh ) +/* +** - - - - - - - - - +** s l a F k 5 2 h +** - - - - - - - - - +** +** Transform FK5 (J2000) star data into the Hipparcos frame. +** +** (double precision) +** +** This routine transforms FK5 star positions and proper motions +** into the frame of the Hipparcos catalogue. +** +** Given (all FK5, equinox J2000, epoch J2000): +** r5 double RA (radians) +** d5 double Dec (radians) +** dr5 double proper motion in RA (dRA/dt, rad/Jyear) +** dd5 double proper motion in Dec (dDec/dt, rad/Jyear) +** +** Returned (all Hipparcos, epoch J2000): +** rh double RA (radians) +** dh double Dec (radians) +** drh double proper motion in RA (dRA/dt, rad/Jyear) +** ddh double proper motion in Dec (dDec/dt, rad/Jyear) +** +** Called: slaDs2c6, slaDav2m, slaDmxv, slaDvxv, slaDc62s, +** slaDranrm +** +** Notes: +** +** 1) The proper motions in RA are dRA/dt rather than +** cos(Dec)*dRA/dt, and are per year rather than per century. +** +** 2) The FK5 to Hipparcos transformation consists of a pure +** rotation and spin; zonal errors in the FK5 catalogue are +** not taken into account. +** +** 3) The published orientation and spin components are interpreted +** as "axial vectors". An axial vector points at the pole of the +** rotation and its length is the amount of rotation in radians. +** +** 4) See also slaH2fk5, slaFk5hz, slaHfk5z. +** +** Reference: +** +** M.Feissel & F.Mignard, Astron. Astrophys. 331, L33-L36 (1998). +** +** Last revision: 22 June 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AS2R 0.484813681109535994e-5 /* arcseconds to radians */ + +{ +/* FK5 to Hipparcos orientation and spin (radians, radians/year) */ + static double ortn[3] = { -19.9e-3 * AS2R, + -9.1e-3 * AS2R, + 22.9e-3 * AS2R }, + s5[3] = { -0.30e-3 * AS2R, + 0.60e-3 * AS2R, + 0.70e-3 * AS2R }; + + double pv5[6], r5h[3][3], vv[3], pvh[6], w, r, v; + int i; + + +/* FK5 barycentric position/velocity 6-vector (normalized). */ + slaDs2c6 ( r5, d5, 1.0, dr5, dd5, 0.0, pv5 ); + +/* FK5 to Hipparcos orientation matrix. */ + slaDav2m ( ortn, r5h ); + +/* Rotate & spin the 6-vector into the Hipparcos frame. */ + slaDmxv ( r5h, pv5, pvh ); + slaDvxv ( pv5, s5, vv ); + for ( i = 0; i < 3; i++ ) { + vv [ i ] = pv5 [ i + 3 ] + vv [ i ]; + } + slaDmxv ( r5h, vv, pvh + 3 ); + +/* Hipparcos 6-vector to spherical. */ + slaDc62s ( pvh, &w, dh, &r, drh, ddh, &v ); + *rh = slaDranrm ( w ); +} Index: trunk/MagicSoft/slalib/fk54z.c =================================================================== --- trunk/MagicSoft/slalib/fk54z.c (revision 731) +++ trunk/MagicSoft/slalib/fk54z.c (revision 731) @@ -0,0 +1,68 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk54z ( double r2000, double d2000, double bepoch, + double *r1950, double *d1950, + double *dr1950, double *dd1950 ) +/* +** - - - - - - - - - +** s l a F k 5 4 z +** - - - - - - - - - +** +** Convert a J2000.0 FK5 star position to B1950.0 FK4 assuming +** zero proper motion and parallax. +** +** (double precision) +** +** This routine converts star positions from the new, IAU 1976, +** FK5, Fricke system to the old, Bessel-Newcomb, FK4 system. +** +** Given: +** r2000,d2000 double J2000.0 FK5 RA,Dec (rad) +** bepoch double Besselian epoch (e.g. 1950) +** +** Returned: +** *r1950,*d1950 double B1950.0 FK4 RA,Dec (rad) at epoch BEPOCH +** *dr1950,*dd1950 double B1950.0 FK4 proper motions (rad/trop.yr) +** +** Notes: +** +** 1) The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt. +** +** 2) Conversion from Julian epoch 2000.0 to Besselian epoch 1950.0 +** only is provided for. Conversions involving other epochs will +** require use of the appropriate precession routines before and +** after this routine is called. +** +** 3) Unlike in the slaFK524 routine, the FK5 proper motions, the +** parallax and the radial velocity are presumed zero. +** +** 4) It is the intention that FK5 should be a close approximation +** to an inertial frame, so that distant objects have zero proper +** motion; such objects have (in general) non-zero proper motion +** in FK4, and this routine returns those fictitious proper +** motions. +** +** 5) The position returned by this routine is in the B1950 +** reference frame but at Besselian epoch bepoch. For +** comparison with catalogues the bepoch argument will +** frequently be 1950.0. +** +** Called: slaFk524, slaPm +** +** Last revision: 30 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + static double zero = 0.0; + + double r, d, px, rv; + +/* FK5 equinox J2000 (any epoch) to FK4 equinox B1950 epoch B1950 */ + slaFk524 ( r2000, d2000, zero, zero, zero, zero, + &r, &d, dr1950, dd1950, &px, &rv ); + +/* Fictitious proper motion to epoch bepoch */ + slaPm ( r, d, *dr1950, *dd1950, zero, zero, 1950.0, bepoch, + r1950, d1950 ); +} Index: trunk/MagicSoft/slalib/fk5hz.c =================================================================== --- trunk/MagicSoft/slalib/fk5hz.c (revision 731) +++ trunk/MagicSoft/slalib/fk5hz.c (revision 731) @@ -0,0 +1,93 @@ +#include "slalib.h" +#include "slamac.h" +void slaFk5hz ( double r5, double d5, double epoch, double *rh, double *dh ) +/* +** - - - - - - - - - +** s l a F k 5 h z +** - - - - - - - - - +** +** Transform an FK5 (J2000) star position into the frame of the +** Hipparcos catalogue, assuming zero Hipparcos proper motion. +** +** (double precision) +** +** This routine converts a star position from the FK5 system to +** the Hipparcos system, in such a way that the Hipparcos proper +** motion is zero. Because such a star has, in general, a non-zero +** proper motion in the FK5 system, the routine requires the epoch +** at which the position in the FK5 system was determined. +** +** Given: +** r5 double FK5 RA (radians), equinox J2000, epoch EPOCH +** d5 double FK5 Dec (radians), equinox J2000, epoch EPOCH +** epoch double Julian epoch (TDB) +** +** Returned (all Hipparcos): +** rh double RA (radians) +** dh double Dec (radians) +** +** Called: slaDcs2c, slaDav2m, slaDimxv, slaDmxv, slaDcc2s, slaDranrm +** +** Notes: +** +** 1) The FK5 to Hipparcos transformation consists of a pure +** rotation and spin; zonal errors in the FK5 catalogue are +** not taken into account. +** +** 2) The published orientation and spin components are interpreted +** as "axial vectors". An axial vector points at the pole of the +** rotation and its length is the amount of rotation in radians. +** +** 3) See also slaFk52h, slaH2fk5, slaHfk5z. +** +** Reference: +** +** M.Feissel & F.Mignard, Astron. Astrophys. 331, L33-L36 (1998). +** +** Last revision: 22 June 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AS2R 0.484813681109535994e-5 /* arcseconds to radians */ + +{ +/* FK5 to Hipparcos orientation and spin (radians, radians/year) */ + static double ortn[3] = { -19.9e-3 * AS2R, + -9.1e-3 * AS2R, + 22.9e-3 * AS2R }, + s5[3] = { -0.30e-3 * AS2R, + 0.60e-3 * AS2R, + 0.70e-3 * AS2R }; + + double p5e[3], r5h[3][3], t, vst[3], rst[3][3], p5[3], ph[3], w; + int i; + + +/* FK5 barycentric position vector. */ + slaDcs2c ( r5, d5, p5e ); + +/* FK5 to Hipparcos orientation matrix. */ + slaDav2m ( ortn, r5h ); + +/* Time interval from epoch to J2000. */ + t = 2000.0 - epoch; + +/* Axial vector: accumulated Hipparcos wrt FK5 spin over that interval. */ + for ( i = 0; i < 3; i++ ) { + vst [ i ] = s5 [ i ] * t; + } + +/* Express the accumulated spin as a rotation matrix. */ + slaDav2m ( vst, rst ); + +/* Derotate the vector's FK5 axes back to epoch. */ + slaDimxv ( rst, p5e, p5 ); + +/* Rotate the vector into the Hipparcos frame. */ + slaDmxv ( r5h, p5, ph ); + +/* Hipparcos vector to spherical. */ + slaDcc2s ( ph, &w, dh ); + *rh = slaDranrm ( w ); +} Index: trunk/MagicSoft/slalib/flotin.c =================================================================== --- trunk/MagicSoft/slalib/flotin.c (revision 731) +++ trunk/MagicSoft/slalib/flotin.c (revision 731) @@ -0,0 +1,104 @@ +#include "slalib.h" +#include "slamac.h" +void slaFlotin ( char *string, int *nstrt, float *reslt, int *jflag ) +/* +** - - - - - - - - - - +** s l a F l o t i n +** - - - - - - - - - - +** +** Convert free-format input into single precision floating point. +** +** Given: +** *string char string containing field to be decoded +** *nstrt int where to start decode (1st = 1) +** +** Returned: +** *nstrt int advanced to next field +** *reslt float result +** *jflag int -1 = -OK, 0 = +OK, 1 = null field, 2 = error +** +** Called: slaDfltin +** +** Notes: +** +** 1 A tab character is interpreted as a space, and lower +** case d,e are interpreted as upper case. +** +** 2 The basic format is #^.^@#^ where # means + or -, +** ^ means a decimal subfield and @ means d or e. +** +** 3 Spaces: +** Leading spaces are ignored. +** Embedded spaces are allowed only after # and d or e, +** and after . where the first ^ is absent. +** Trailing spaces are ignored; the first signifies +** end of decoding and subsequent ones are skipped. +** +** 4 Field separators: +** Any character other than +,-,0-9,.,d,e or space may be +** used to end a field. Comma is recognized by slaFlotin +** as a special case; it is skipped, leaving the +** pointer on the next character. See 12, below. +** +** 5 Both signs are optional. The default is +. +** +** 6 The mantissa defaults to 1. +** +** 7 The exponent defaults to e0. +** +** 8 The decimal subfields may be of any length. +** +** 9 The decimal point is optional for whole numbers. +** +** 10 A null field is one that does not begin with +** +,-,0-9,.,d or e, or consists entirely of spaces. +** If the field is null, jflag is set to 1 and reslt +** is left untouched. +** +** 11 nstrt = 1 for the first character in the string. +** +** 12 On return from slaFlotin, nstrt is set ready for the next +** decode - following trailing blanks and (if used) the +** comma separator. If a separator other than comma is +** being used, nstrt must be incremented before the next +** call to slaFlotin. +** +** 13 Errors (jflag=2) occur when: +** a) A +, -, d or e is left unsatisfied. +** b) The decimal point is present without at least +** one decimal subfield. +** c) An exponent more than 100 has been presented. +** +** 14 When an error has been detected, nstrt is left +** pointing to the character following the last +** one used before the error came to light. This +** may be after the point at which a more sophisticated +** program could have detected the error. For example, +** slaFlotin does not detect that '1e999' is unacceptable +** until the whole field has been read. +** +** 15 Certain highly unlikely combinations of mantissa & +** exponent can cause arithmetic faults during the +** decode, in some cases despite the fact that they +** together could be construed as a valid number. +** +** 16 Decoding is left to right, one pass. +** +** 17 End of field may occur in either of two ways: +** a) As dictated by the string length. +** b) Detected during the decode. +** (b overrides a.) +** +** 18 See also slaDfltin and slaIntin. +** +** Last revision: 23 November 1995 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double dreslt; + +/* Call the double precision version */ + slaDfltin ( string, nstrt, &dreslt, jflag ); + if ( *jflag <= 0 ) *reslt = (float) dreslt; +} Index: trunk/MagicSoft/slalib/galeq.c =================================================================== --- trunk/MagicSoft/slalib/galeq.c (revision 731) +++ trunk/MagicSoft/slalib/galeq.c (revision 731) @@ -0,0 +1,73 @@ +#include "slalib.h" +#include "slamac.h" +void slaGaleq ( double dl, double db, double *dr, double *dd ) +/* +** - - - - - - - - - +** s l a G a l e q +** - - - - - - - - - +** +** Transformation from IAU 1958 Galactic coordinates to +** J2000.0 equatorial coordinates. +** +** (double precision) +** +** Given: +** dl,db double galactic longitude and latitude l2,b2 +** +** Returned: +** *dr,*dd double J2000.0 RA,dec +** +** (all arguments are radians) +** +** Called: +** slaDcs2c, slaDimxv, slaDcc2s, slaDranrm, slaDrange +** +** Note: +** The equatorial coordinates are J2000.0. Use the routine +** slaGe50 if conversion to B1950.0 'FK4' coordinates is +** required. +** +** Reference: +** Blaauw et al, Mon.Not.R.astron.Soc.,121,123 (1960) +** +** Last revision: 21 September 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double v1[3], v2[3]; + +/* +** l2,b2 system of Galactic coordinates +** +** p = 192.25 RA of Galactic north pole (mean B1950.0) +** q = 62.6 inclination of Galactic to mean B1950.0 equator +** r = 33 longitude of ascending node +** +** p,q,r are degrees +** +** Equatorial to Galactic rotation matrix (J2000.0), obtained by +** applying the standard FK4 to FK5 transformation, for zero proper +** motion in FK5, to the columns of the B1950 equatorial to +** Galactic rotation matrix: +*/ + static double rmat[3][3] = + { + { -0.054875539726, -0.873437108010, -0.483834985808 }, + { 0.494109453312, -0.444829589425, 0.746982251810 }, + { -0.867666135858, -0.198076386122, 0.455983795705 } + }; + +/* Spherical to Cartesian */ + slaDcs2c ( dl, db, v1 ); + +/* Galactic to equatorial */ + slaDimxv ( rmat, v1, v2 ); + +/* Cartesian to spherical */ + slaDcc2s ( v2, dr, dd ); + +/* Express in conventional ranges */ + *dr = slaDranrm ( *dr ); + *dd = slaDrange ( *dd ); +} Index: trunk/MagicSoft/slalib/galsup.c =================================================================== --- trunk/MagicSoft/slalib/galsup.c (revision 731) +++ trunk/MagicSoft/slalib/galsup.c (revision 731) @@ -0,0 +1,73 @@ +#include "slalib.h" +#include "slamac.h" +void slaGalsup ( double dl, double db, double *dsl, double *dsb ) +/* +** - - - - - - - - - - +** s l a G a l s u p +** - - - - - - - - - - +** +** Transformation from IAU 1958 Galactic coordinates to +** De Vaucouleurs supergalactic coordinates. +** +** (double precision) +** +** Given: +** dl,db double Galactic longitude and latitude l2,b2 +** +** Returned: +** *dsl,*dsb double Supergalactic longitude and latitude +** +** (all arguments are radians) +** +** Called: +** slaDcs2c, slaDmxv, slaDcc2s, slaDranrm, slaDrange +** +** References: +** +** De Vaucouleurs, De Vaucouleurs, & Corwin, Second reference +** catalogue of bright galaxies, U. Texas, page 8. +** +** Systems & Applied Sciences Corp., Documentation for the +** machine-readable version of the above catalogue, +** contract NAS 5-26490. +** +** (These two references give different values for the Galactic +** longitude of the Supergalactic origin. Both are wrong; the +** correct value is l2 = 137.37.) +** +** Last revision: 25 January 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double v1[3], v2[3]; + +/* +** System of Supergalactic coordinates: +** +** SGl SGb l2 b2 (deg) +** - +90 47.37 +6.32 +** 0 0 - 0 +** +** Galactic to Supergalactic rotation matrix: +*/ + static double rmat[3][3] = + { + { -0.735742574804, 0.677261296414, 0.0 }, + { -0.074553778365, -0.080991471307, 0.993922590400 }, + { 0.673145302109, 0.731271165817, 0.110081262225 } + }; + +/* Spherical to Cartesian */ + slaDcs2c ( dl, db, v1 ); + +/* Galactic to Supergalactic */ + slaDmxv ( rmat, v1, v2 ); + +/* Cartesian to spherical */ + slaDcc2s ( v2, dsl, dsb ); + +/* Express in conventional ranges */ + *dsl = slaDranrm ( *dsl ); + *dsb = slaDrange ( *dsb ); +} Index: trunk/MagicSoft/slalib/ge50.c =================================================================== --- trunk/MagicSoft/slalib/ge50.c (revision 731) +++ trunk/MagicSoft/slalib/ge50.c (revision 731) @@ -0,0 +1,82 @@ +#include "slalib.h" +#include "slamac.h" +void slaGe50 ( double dl, double db, double *dr, double *dd ) +/* +** - - - - - - - - +** s l a G e 5 0 +** - - - - - - - - +** +** Transformation from IAU 1958 Galactic coordinates to +** B1950.0 'FK4' equatorial coordinates. +** +** (double precision) +** +** Given: +** dl,db double Galactic longitude and latitude l2,b2 +** +** Returned: +** *dr,*dd double B1950.0 'FK4' RA,Dec +** +** (all arguments are radians) +** +** Called: +** slaDcs2c, slaDimxv, slaDcc2s, slaAddet, slaDranrm, slaDrange +** +** Note: +** The equatorial coordinates are B1950.0 'FK4'. Use the +** routine slaGaleq if conversion to J2000.0 coordinates +** is required. +** +** Reference: +** Blaauw et al, Mon.Not.R.astron.Soc.,121,123 (1960) +** +** Last revision: 8 December 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double v1[3], v2[3], r, d, re, de; +/* +** l2,b2 system of Galactic coordinates +** +** p = 192.25 RA of Galactic north pole (mean B1950.0) +** q = 62.6 inclination of Galactic to mean B1950.0 equator +** r = 33 longitude of ascending node +** +** p,q,r are degrees +** +** Equatorial to Galactic rotation matrix +** +** The Euler angles are p, q, 90-r, about the z then y then +** z axes. +** +** +cp.cq.sr-sp.cr +sp.cq.sr+cp.cr -sq.sr +** +** -cp.cq.cr-sp.sr -sp.cq.cr+cp.sr +sq.cr +** +** +cp.sq +sp.sq +cq +*/ + static double rmat[3][3] = + { + { -0.066988739415, -0.872755765852, -0.483538914632 }, + { 0.492728466075, -0.450346958020, 0.744584633283 }, + { -0.867600811151, -0.188374601723, 0.460199784784 } + }; + + +/* Spherical to Cartesian */ + slaDcs2c ( dl, db, v1 ); + +/* Rotate to mean B1950.0 */ + slaDimxv ( rmat, v1, v2 ); + +/* Cartesian to spherical */ + slaDcc2s ( v2, &r, &d ); + +/* Introduce e-terms */ + slaAddet ( r, d, 1950.0, &re, &de ); + +/* Express in conventional ranges */ + *dr = slaDranrm ( re ); + *dd = slaDrange ( de ); +} Index: trunk/MagicSoft/slalib/geoc.c =================================================================== --- trunk/MagicSoft/slalib/geoc.c (revision 731) +++ trunk/MagicSoft/slalib/geoc.c (revision 731) @@ -0,0 +1,54 @@ +#include "slalib.h" +#include "slamac.h" +void slaGeoc ( double p, double h, double *r, double *z ) +/* +** - - - - - - - - +** s l a G e o c +** - - - - - - - - +** +** Convert geodetic position to geocentric. +** +** (double precision) +** +** Given: +** p double latitude (geodetic, radians) +** h double height above reference spheroid (geodetic, metres) +** +** Returned: +** *r double distance from Earth axis (AU) +** *z double distance from plane of Earth equator (AU) +** +** Notes: +** +** 1) Geocentric latitude can be obtained by evaluating atan2(z,r). +** +** 2) IAU 1976 constants are used. +** +** Reference: +** Green,R.M., Spherical Astronomy, CUP 1985, p98. +** +** Last revision: 25 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sp, cp, c, s; + +/* Earth equatorial radius (metres) */ + static double a0 = 6378140.0; + +/* Reference spheroid flattening factor and useful function thereof */ + static double f = 1.0 / 298.257; + double b = ( 1.0 - f ) * ( 1.0 - f ); + +/* Astronomical unit in metres */ + static double au = 1.49597870e11; + +/* Geodetic to geocentric conversion */ + sp = sin ( p ); + cp = cos ( p ); + c = 1.0 / sqrt ( cp * cp + b * sp * sp ); + s = b * c; + *r = ( a0 * c + h ) * cp / au; + *z = ( a0 * s + h ) * sp / au; +} Index: trunk/MagicSoft/slalib/gmst.c =================================================================== --- trunk/MagicSoft/slalib/gmst.c (revision 731) +++ trunk/MagicSoft/slalib/gmst.c (revision 731) @@ -0,0 +1,53 @@ +#include "slalib.h" +#include "slamac.h" +double slaGmst ( double ut1 ) +/* +** - - - - - - - - +** s l a G m s t +** - - - - - - - - +** +** Conversion from Universal Time to Sidereal Time. +** +** (double precision) +** +** Given: +** ut1 double Universal Time (strictly UT1) expressed as +** Modified Julian Date (JD-2400000.5) +** +** The result is the Greenwich Mean Sidereal Time (double +** precision, radians). +** +** The IAU 1982 expression (see page S15 of the 1984 Astronomical +** Almanac) is used, but rearranged to reduce rounding errors. +** This expression is always described as giving the GMST at +** 0 hours UT. In fact, it gives the difference between the +** GMST and the UT, which happens to equal the GMST (modulo +** 24 hours) at 0 hours UT each day. In this routine, the +** entire UT is used directly as the argument for the +** standard formula, and the fractional part of the UT is +** added separately; note that the factor 1.0027379... does +** not appear. +** +** See also the routine slaGmsta, which delivers better numerical +** precision by accepting the UT date and time as separate arguments. +** +** Called: slaDranrm +** +** Defined in slamac.h: D2PI, DS2R, dmod +** +** Last revision: 19 March 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double tu; + +/* Julian centuries from fundamental epoch J2000 to this UT */ + tu = ( ut1 - 51544.5 ) / 36525.0; + +/* GMST at this UT */ + return slaDranrm ( dmod ( ut1, 1.0 ) * D2PI + + ( 24110.54841 + + ( 8640184.812866 + + ( 0.093104 - 6.2e-6 * tu ) * tu ) * tu ) * DS2R ); +} Index: trunk/MagicSoft/slalib/gmsta.c =================================================================== --- trunk/MagicSoft/slalib/gmsta.c (revision 731) +++ trunk/MagicSoft/slalib/gmsta.c (revision 731) @@ -0,0 +1,74 @@ +#include "slalib.h" +#include "slamac.h" +double slaGmsta ( double date, double ut ) +/* +** - - - - - - - - - +** s l a G m s t a +** - - - - - - - - - +** +** Conversion from Universal Time to Greenwich mean sidereal time, +** with rounding errors minimized. +** +** (double precision) +** +** Given: +* date double UT1 date (MJD: integer part of JD-2400000.5)) +** ut double UT1 time (fraction of a day) +** +** The result is the Greenwich Mean Sidereal Time (double precision, +** radians, in the range 0 to 2pi). +** +** There is no restriction on how the UT is apportioned between the +** date and ut1 arguments. Either of the two arguments could, for +** example, be zero and the entire date+time supplied in the other. +** However, the routine is designed to deliver maximum accuracy when +** the date argument is a whole number and the ut argument lies in +** the range 0 to 1, or vice versa. +** +** The algorithm is based on the IAU 1982 expression (see page S15 of +** the 1984 Astronomical Almanac). This is always described as giving +** the GMST at 0 hours UT1. In fact, it gives the difference between +** the GMST and the UT, the steady 4-minutes-per-day drawing-ahead of +** ST with respect to UT. When whole days are ignored, the expression +** happens to equal the GMST at 0 hours UT1 each day. +** +** In this routine, the entire UT1 (the sum of the two arguments date +** and ut) is used directly as the argument for the standard formula. +** The UT1 is then added, but omitting whole days to conserve accuracy. +** +** See also the routine slaGmst, which accepts the UT1 as a single +** argument. Compared with slaGmst, the extra numerical precision +** delivered by the present routine is unlikely to be important in +** an absolute sense, but may be useful when critically comparing +** algorithms and in applications where two sidereal times close +** together are differenced. +** +** Called: slaDranrm +** +** Defined in slamac.h: DS2R, dmod +** +** Last revision: 13 April 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double d1, d2, t; + +/* Julian centuries since J2000. */ + if ( date < ut ) { + d1 = date; + d2 = ut; + } else { + d1 = ut; + d2 = date; + } + t = ( d1 + ( d2 - 51544.5 ) ) / 36525.0; + +/* GMST at this UT1. */ + return slaDranrm ( DS2R * ( 24110.54841 + + ( 8640184.812866 + + ( 0.093104 + - 6.2e-6 * t ) * t ) * t + + 86400.0 * ( dmod ( d1, 1.0 ) + + dmod ( d2, 1.0 ) ) ) ); +} Index: trunk/MagicSoft/slalib/h2e.c =================================================================== --- trunk/MagicSoft/slalib/h2e.c (revision 731) +++ trunk/MagicSoft/slalib/h2e.c (revision 731) @@ -0,0 +1,75 @@ +#include "slalib.h" +#include "slamac.h" +void slaH2e ( float az, float el, float phi, float *ha, float *dec ) +/* +** - - - - - - - +** s l a H 2 e +** - - - - - - - +** +** Horizon to equatorial coordinates: Az,El to HA,Dec +** +** (single precision) +** +** Given: +** az float azimuth +** el float elevation +** phi float observatory latitude +** +** Returned: +** *ha float hour angle +** *dec float declination +** +** Notes: +** +** 1) All the arguments are angles in radians. +** +** 2) The sign convention for azimuth is north zero, east +pi/2. +** +** 3) HA is returned in the range +/-pi. Declination is returned +** in the range +/-pi/2. +** +** 4) The latitude is (in principle) geodetic. In critical +** applications, corrections for polar motion should be applied. +** +** 5) In some applications it will be important to specify the +** correct type of elevation in order to produce the required +** type of HA,Dec. In particular, it may be important to +** distinguish between the elevation as affected by refraction, +** which will yield the "observed" HA,Dec, and the elevation +** in vacuo, which will yield the "topocentric" HA,Dec. If the +** effects of diurnal aberration can be neglected, the +** topocentric HA,Dec may be used as an approximation to the +** "apparent" HA,Dec. +** +** 6) No range checking of arguments is done. +** +** 7) In applications which involve many such calculations, rather +** than calling the present routine it will be more efficient to +** use inline code, having previously computed fixed terms such +** as sine and cosine of latitude. +** +** Last revision: 21 February 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + float sa, ca, se, ce, sp, cp, x, y, z, r; + +/* Useful trig functions */ + sa = (float) sin ( az ); + ca = (float) cos ( az ); + se = (float) sin ( el ); + ce = (float) cos ( el ); + sp = (float) sin ( phi ); + cp = (float) cos ( phi ); + +/* HA,Dec as x,y,z */ + x = - ca * ce * sp + se * cp; + y = - sa * ce; + z = ca * ce * cp + se * sp; + +/* To spherical */ + r = (float) sqrt ( x * x + y * y ); + *ha = ( r == 0.0f ) ? 0.0f : (float) atan2 ( y, x ) ; + *dec = (float) atan2 ( z, r ); +} Index: trunk/MagicSoft/slalib/h2fk5.c =================================================================== --- trunk/MagicSoft/slalib/h2fk5.c (revision 731) +++ trunk/MagicSoft/slalib/h2fk5.c (revision 731) @@ -0,0 +1,91 @@ +#include "slalib.h" +#include "slamac.h" +void slaH2fk5 ( double rh, double dh, double drh, double ddh, + double *r5, double *d5, double *dr5, double *dd5 ) +/* +** - - - - - - - - - +** s l a H 2 f k 5 +** - - - - - - - - - +** +** Transform Hipparcos star data into the FK5 (J2000) system. +** +** (double precision) +** +** This routine transforms Hipparcos star positions and proper +** motions into FK5 J2000. +** +** Given (all Hipparcos, epoch J2000): +** rh double RA (radians) +** dh double Dec (radians) +** drh double proper motion in RA (dRA/dt, rad/Jyear) +** ddh double proper motion in Dec (dDec/dt, rad/Jyear) +** +** Returned (all FK5, equinox J2000, Epoch J2000): +** r5 double RA (radians) +** d5 double Dec (radians) +** dr5 double proper motion in RA (dRA/dt, rad/Jyear) +** dd5 double proper motion in Dec (dDec/dt, rad/Jyear) +** +** Called: slaDs2c6, slaDav2m, slaDmxv, slaDimxv, slaDvxv, +** slaDc62s, slaDranrm +** +** Notes: +** +** 1) The proper motions in RA are dRA/dt rather than +** cos(Dec)*dRA/dt, and are per year rather than per century. +** +** 2) The FK5 to Hipparcos transformation consists of a pure +** rotation and spin; zonal errors in the FK5 catalogue are +** not taken into account. +** +** 3) The published orientation and spin components are interpreted +** as "axial vectors". An axial vector points at the pole of the +** rotation and its length is the amount of rotation in radians. +** +** 4) See also slaFk52h, slaFk5hz, slaHfk5z. +** +** Reference: +** +** M.Feissel & F.Mignard, Astron. Astrophys. 331, L33-L36 (1998). +** +** Last revision: 22 June 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AS2R 0.484813681109535994e-5 /* arcseconds to radians */ + +{ +/* FK5 to Hipparcos orientation and spin (radians, radians/year) */ + static double ortn[3] = { -19.9e-3 * AS2R, + -9.1e-3 * AS2R, + 22.9e-3 * AS2R }, + s5[3] = { -0.30e-3 * AS2R, + 0.60e-3 * AS2R, + 0.70e-3 * AS2R }; + + double pvh[6], r5h[3][3], sh[3], vv[3], pv5[6], w, r, v; + int i; + + +/* Hipparcos barycentric position/velocity 6-vector (normalized). */ + slaDs2c6 ( rh, dh, 1.0, drh, ddh, 0.0, pvh ); + +/* FK5 to Hipparcos orientation matrix. */ + slaDav2m ( ortn, r5h ); + +/* Rotate the spin vector into the Hipparcos frame. */ + slaDmxv ( r5h, s5, sh ); + +/* De-orient & de-spin the 6-vector into FK5 J2000. */ + slaDimxv ( r5h, pvh, pv5 ); + slaDvxv ( pvh, sh, vv ); + for ( i = 0; i < 3; i++ ) { + vv [ i ] = pvh [ i + 3 ] - vv [ i ]; + } + slaDimxv ( r5h, vv, pv5 + 3 ); + +/* FK5 6-vector to spherical. */ + slaDc62s ( pv5, &w, d5, &r, dr5, dd5, &v ); + *r5 = slaDranrm ( w ); +} Index: trunk/MagicSoft/slalib/hfk5z.c =================================================================== --- trunk/MagicSoft/slalib/hfk5z.c (revision 731) +++ trunk/MagicSoft/slalib/hfk5z.c (revision 731) @@ -0,0 +1,106 @@ +#include "slalib.h" +#include "slamac.h" +void slaHfk5z ( double rh, double dh, double epoch, + double *r5, double *d5, double *dr5, double *dd5 ) +/* +** - - - - - - - - - +** s l a H f k 5 z +** - - - - - - - - - +** +** Transform a Hipparcos star position into FK5 J2000, assuming +** zero Hipparcos proper motion. +** +** (double precision) +** +** Given: +** rh double Hipparcos RA (radians) +** dh double Hipparcos Dec (radians) +** epoch double Julian epoch (TDB) +** +** Returned (all FK5, equinox J2000, epoch EPOCH): +** r5 double RA (radians) +** d5 double Dec (radians) +** +** Called: slaDcs2c, slaDav2m, slaDmxv, slaDav2m, slaDmxm, +** slaDimxv, slaDvxv, slaDc62s, slaDranrm +** +** Notes: +** +** 1) The proper motion in RA is dRA/dt rather than cos(Dec)*dRA/dt. +** +** 2) The FK5 to Hipparcos transformation consists of a pure +** rotation and spin; zonal errors in the FK5 catalogue are +** not taken into account. +** +** 3) The published orientation and spin components are interpreted +** as "axial vectors". An axial vector points at the pole of the +** rotation and its length is the amount of rotation in radians. +** +** 4) It was the intention that Hipparcos should be a close +** approximation to an inertial frame, so that distant objects +** have zero proper motion; such objects have (in general) +** non-zero proper motion in FK5, and this routine returns those +** fictitious proper motions. +** +** 5) The position returned by this routine is in the FK5 J2000 +** reference frame but at the specified epoch. +** +** 6) See also slaFk52h, slaH2fk5, slaFk5zhz. +** +** Reference: +** +** M.Feissel & F.Mignard, Astron. Astrophys. 331, L33-L36 (1998). +** +** Last revision: 30 December 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AS2R 0.484813681109535994e-5 /* arcseconds to radians */ + +{ +/* FK5 to Hipparcos orientation and spin (radians, radians/year) */ + static double ortn[3] = { -19.9e-3 * AS2R, + -9.1e-3 * AS2R, + 22.9e-3 * AS2R }, + s5[3] = { -0.30e-3 * AS2R, + 0.60e-3 * AS2R, + 0.70e-3 * AS2R }; + + double ph[3], r5h[3][3], sh[3], t, vst[3], rst[3][3], r5ht[3][3], + pv5e[6], vv[3], w, r, v; + int i; + + +/* Hipparcos barycentric position vector (normalized). */ + slaDcs2c ( rh, dh, ph ); + +/* FK5 to Hipparcos orientation matrix. */ + slaDav2m ( ortn, r5h ); + +/* Rotate the spin vector into the Hipparcos frame. */ + slaDmxv ( r5h, s5, sh ); + +/* Time interval from J2000 to epoch. */ + t = epoch - 2000.0; + +/* Axial vector: accumulated Hipparcos wrt FK5 spin over that interval. */ + for ( i = 0; i < 3; i++ ) { + vst [ i ] = s5 [ i ] * t; + } + +/* Express the accumulated spin as a rotation matrix. */ + slaDav2m ( vst, rst ); + +/* Rotation matrix: accumulated spin, then FK5 to Hipparcos. */ + slaDmxm ( r5h, rst, r5ht ); + +/* De-orient & de-spin the vector into FK5 J2000 at epoch. */ + slaDimxv ( r5ht, ph, pv5e ); + slaDvxv ( sh, ph, vv ); + slaDimxv ( r5ht, vv, pv5e + 3 ); + +/* FK5 position/velocity 6-vector to spherical. */ + slaDc62s( pv5e, &w, d5, &r, dr5, dd5, &v ); + *r5 = slaDranrm ( w ); +} Index: trunk/MagicSoft/slalib/imxv.c =================================================================== --- trunk/MagicSoft/slalib/imxv.c (revision 731) +++ trunk/MagicSoft/slalib/imxv.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +void slaImxv ( float rm[3][3], float va[3], float vb[3] ) +/* +** - - - - - - - - +** s l a I m x v +** - - - - - - - - +** +** Performs the 3-d backward unitary transformation: +** +** vector vb = (inverse of matrix rm) * vector va +** +** (single precision) +** +** n.b. The matrix must be unitary, as this routine assumes that +** the inverse and transpose are identical. +** +** Given: +** rm float[3][3] matrix +** va float[3] vector +** +** Returned: +** vb float[3] result vector +** +** The same vector can be specified for both va and vb. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j; + float w, vw[3]; + +/* Inverse of matrix rm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0f; + for ( i = 0; i < 3; i++ ) { + w += rm[i][j] * va[i]; + } + vw[j] = w; + } + +/* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} Index: trunk/MagicSoft/slalib/intin.c =================================================================== --- trunk/MagicSoft/slalib/intin.c (revision 731) +++ trunk/MagicSoft/slalib/intin.c (revision 731) @@ -0,0 +1,399 @@ +#include "slalib.h" +#include "slamac.h" +#include +#include + +static int idchi ( int, char*, int*, double* ); + +void slaIntin ( char *string, int *nstrt, long *ireslt, int *jflag ) +/* +** - - - - - - - - - +** s l a I n t i n +** - - - - - - - - - +** +** Convert free-format input into a long integer. +** +** Given: +** string char* string containing number to be decoded +** nstrt int* where to start decode (1st = 1) +** ireslt long* current value of result +** +** Returned: +** nstrt int* advanced to next number +** ireslt long* result +** jflag int* status: -1 = -OK, 0 = +OK, 1 = null, 2 = error +** +** Called: idchi +** +** Notes: +** +** 1 The reason slaIntin has separate OK status values for + +** and - is to enable minus zero to be detected. This is +** of crucial importance when decoding mixed-radix numbers. +** For example, an angle expressed as deg, arcmin, arcsec +** may have a leading minus sign but a zero degrees field. +** +** 2 A TAB is interpreted as a space. +** +** 3 The basic format is the sequence of fields #^, where +** # is a sign character + or -, and ^ means a string of +** decimal digits. +** +** 4 Spaces: +** +** . Leading spaces are ignored. +** +** . Spaces between the sign and the number are allowed. +** +** . Trailing spaces are ignored; the first signifies +** end of decoding and subsequent ones are skipped. +** +** 5 Delimiters: +** +** . Any character other than +,-,0-9 or space may be +** used to signal the end of the number and terminate +** decoding. +** +** . Comma is recognized by slaIntin as a special case; it +** is skipped, leaving the pointer on the next character. +** See 9, below. +** +** 6 The sign is optional. The default is +. +** +** 7 A "null result" occurs when the string of characters being +** decoded does not begin with +,- or 0-9, or consists +** entirely of spaces. When this condition is detected, jflag +** is set to 1 and ireslt is left untouched. +** +** 8 nstrt = 1 for the first character in the string. +** +** 9 On return from slaIntin, nstrt is set ready for the next +** decode - following trailing blanks and any comma. If a +** delimiter other than comma is being used, nstrt must be +** incremented before the next call to slaIntin, otherwise +** all subsequent calls will return a null result. +** +** 10 Errors (jflag=2) occur when: +** +** . there is a + or - but no number; or +** +** . the number is larger than LONG_MAX. +** +** 11 When an error has been detected, nstrt is left +** pointing to the character following the last +** one used before the error came to light. +** +** 12 See also slaFlotin and slaDfltin. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Definitions shared between slaIntin and idchi */ +#define NUMBER 0 +#define SPACE 1 +#define PLUS 2 +#define MINUS 3 +#define COMMA 4 +#define OTHER 5 +#define END 6 + +{ + int l_string, nptr; + double digit; + +/* Current state of the decode and the values it can take */ + + int state; + +#define seek_sign 100 +#define neg 200 +#define seek_1st_digit 300 +#define accept_digit 400 +#define seek_digit 410 +#define end_of_field 1600 +#define build_result 1610 +#define seeking_end_of_field 1630 +#define next_field_OK 1720 +#define next_field_default 9100 +#define null_field 9110 +#define next_field_error 9200 +#define error 9210 +#define done 9900 + + + int j; + double dres; + + +/* Find string length */ + l_string = strlen ( string ); + +/* Current character index (1st = 0) */ + nptr = *nstrt - 1; + +/* Set defaults: result & sign */ + dres = 0.0; + j = 0; + +/* Initialize state to "looking for sign" */ + state = seek_sign; + +/* Loop until decode is complete */ + while ( state != done ) { + switch ( state ) { + + case seek_sign : + + /* Look for sign */ + switch ( idchi ( l_string, string, &nptr, &digit ) ) { + case NUMBER : + state = accept_digit; + break; + case SPACE : + state = seek_sign; + break; + case PLUS : + state = seek_1st_digit; + break; + case MINUS : + state = neg; + break; + case OTHER : + state = next_field_default; + break; + case COMMA : + case END : + state = null_field; + break; + default : + state = error; + } + break; + + case neg : + + /* Negative result */ + j = -1; + + case seek_1st_digit : + + /* Look for first leading decimal */ + switch ( idchi ( l_string, string, &nptr, &digit ) ) { + case NUMBER : + state = accept_digit; + break; + case SPACE : + state = seek_1st_digit; + break; + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = next_field_error; + break; + case END : + default : + state = error; + } + break; + + case accept_digit : + + /* Accept decimals */ + dres = dres * 1e1 + digit; + state = ( fabs ( dres ) <= LONG_MAX) ? + seek_digit : next_field_error; + break; + + case seek_digit : + + /* Look for next decimal */ + switch ( idchi ( l_string, string, &nptr, &digit ) ) { + case NUMBER : + state = accept_digit; + break; + case SPACE : + state = build_result; + break; + case PLUS : + case MINUS : + case COMMA : + case OTHER : + state = end_of_field; + break; + case END : + state = build_result; + break; + default : + state = error; + } + break; + + case end_of_field : + + /* Off the end of the field: move pointer back */ + nptr--; + + case build_result : + + /* Make the result */ + if ( j ) dres = - dres; + *ireslt = (long) ( dnint ( dres ) ); + + case seeking_end_of_field : + + /* Skip to end of field */ + switch ( idchi ( l_string, string, &nptr, &digit ) ) { + case SPACE : + state = seeking_end_of_field; + break; + case NUMBER : + case PLUS : + case MINUS : + case OTHER : + state = next_field_OK; + break; + case COMMA : + case END : + state = done; + break; + default : + state = error; + } + break; + + case next_field_OK : + + /* Next field terminates successful decode */ + nptr--; + state = done; + break; + + case next_field_default : + + /* Next field terminates null decode */ + nptr--; + + case null_field : + + /* Null decode */ + j = 1; + state = done; + break; + + case next_field_error : + + /* Next field detected prematurely */ + nptr--; + + case error : + + /* Decode has failed: set bad status */ + j = 2; + state = done; + break; + + default : + state = error; + } + } + +/* Finished: return updated pointer and the status */ + *nstrt = nptr + 1; + *jflag = j; +} + +static int idchi ( int l_string, char *string, int *nptr, double *digit ) +/* +** - - - - - +** i d c h i +** - - - - - +** +** Internal routine used by slaIntin: +** +** identify next character in string. +** +** Given: +** l_string int length of string +** string char* string +** nptr int* character to be identified (1st = 0) +** +** Returned: +** nptr int* incremented unless end of field +** digit double* 0.0 - 9.0 if character was a numeral +** +** Returned (function value): +** int vector for identified character: +** +** value meaning +** +** NUMBER 0-9 +** SPACE space or tab +** PLUS + +** MINUS - +** COMMA , +** OTHER else +** END outside field +** +** Last revision: 24 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int ivec, ictab; + char c; + +/* Character/vector tables */ + +#define NCREC (15) + static char kctab[NCREC] = { '0','1','2','3','4','5', + '6','7','8','9', + ' ','\t', + '+', + '-', + ',' }; + + static int kvtab[NCREC] = { NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, + NUMBER, NUMBER, NUMBER, NUMBER, NUMBER, + SPACE, SPACE, + PLUS, + MINUS, + COMMA }; + + +/* Initialize returned value */ + ivec = OTHER; + +/* Pointer outside field? */ + if ( *nptr < 0 || *nptr >= l_string ) { + + /* Yes: prepare returned value */ + ivec = END; + + } else { + + /* Not end of field: identify character */ + c = string [ *nptr ]; + for ( ictab = 0; ictab < NCREC; ictab++ ) { + if ( kctab [ ictab ] == c ) { + + /* Recognized */ + ivec = kvtab [ ictab ]; + + /* Allow for numerals */ + *digit = (double) ictab; + + /* Quit the loop */ + break; + } + } + + /* Increment pointer */ + ( *nptr )++; + } + +/* Return the value identifying the character */ + return ivec; +} Index: trunk/MagicSoft/slalib/invf.c =================================================================== --- trunk/MagicSoft/slalib/invf.c (revision 731) +++ trunk/MagicSoft/slalib/invf.c (revision 731) @@ -0,0 +1,79 @@ +#include "slalib.h" +#include "slamac.h" +void slaInvf ( double fwds[6], double bkwds[6], int *j ) +/* +** - - - - - - - - +** s l a I n v f +** - - - - - - - - +** +** Invert a linear model of the type produced by the slaFitxy routine. +** +** Given: +** fwds double[6] model coefficients +** +** Returned: +** bkwds double[6] inverse model +** *j int status: 0 = OK, -1 = no inverse +** +** The models relate two sets of [x,y] coordinates as follows. +** Naming the elements of fwds: +** +** fwds[0] = a +** fwds[1] = b +** fwds[2] = c +** fwds[3] = d +** fwds[4] = e +** fwds[5] = f +** +** Where two sets of coordinates [x1,y1] and [x2,y1] are related +** thus: +** +** x2 = a + b*x1 + c*y1 +** y2 = d + e*x1 + f*y1 +** +** The present routine generates a new set of coefficients: +** +** bkwds[0] = p +** bkwds[1] = q +** bkwds[2] = r +** bkwds[3] = s +** bkwds[4] = t +** bkwds[5] = u +** +** Such that: +** +** x1 = p + q*x2 + r*y2 +** y1 = s + t*x2 + u*y2 +** +** Two successive calls to slaInvf will thus deliver a set +** of coefficients equal to the starting values. +** +** See also slaFitxy, slaPxy, slaXy2xy, slaDcmpf +** +** Last revision: 30 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double a, b, c, d, e, f, det; + + a = fwds[0]; + b = fwds[1]; + c = fwds[2]; + d = fwds[3]; + e = fwds[4]; + f = fwds[5]; + det = b * f - c * e; + + if ( det != 0.0 ) { + bkwds[0] = ( c * d - a * f ) / det; + bkwds[1] = f / det; + bkwds[2] = - c / det; + bkwds[3] = ( a * e - b * d ) / det; + bkwds[4] = - e / det; + bkwds[5] = b / det; + *j = 0; + } else { + *j = -1; + } +} Index: trunk/MagicSoft/slalib/kbj.c =================================================================== --- trunk/MagicSoft/slalib/kbj.c (revision 731) +++ trunk/MagicSoft/slalib/kbj.c (revision 731) @@ -0,0 +1,51 @@ +#include "slalib.h" +#include "slamac.h" +void slaKbj ( int jb, double e, char *k, int *j ) +/* +** - - - - - - - +** s l a K b j +** - - - - - - - +** +** Select epoch prefix 'B' or 'J'. +** +** Given: +** jb int slaDbjin prefix status: 0=none, 1='B', 2='J' +** e double epoch - Besselian or Julian +** +** Returned: +** *k char 'B' or 'J' +** *j int status: 0=OK +** +** If jb=0, B is assumed for e < 1984.0, otherwise J. +** +** Last revision: 23 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + +/* Preset status */ + *j = 0; + +/* If prefix given expressly, use it */ + if ( jb == 1 ) { + *k = 'B'; + } else if ( jb == 2 ) { + *k = 'J'; + +/* If no prefix, examine the epoch */ + } else if ( jb == 0 ) { + + /* If epoch is pre-1984.0, assume Besselian; otherwise Julian */ + if ( e < 1984.0 ) { + *k = 'B'; + } else { + *k = 'J'; + } + +/* If illegal prefix, return error status */ + } else { + *k = ' '; + *j = 1; + } +} Index: trunk/MagicSoft/slalib/m2av.c =================================================================== --- trunk/MagicSoft/slalib/m2av.c (revision 731) +++ trunk/MagicSoft/slalib/m2av.c (revision 731) @@ -0,0 +1,55 @@ +#include "slalib.h" +#include "slamac.h" +void slaM2av ( float rmat[3][3], float axvec[3] ) +/* +** - - - - - - - - +** s l a M 2 a v +** - - - - - - - - +** +** From a rotation matrix, determine the corresponding axial vector. +** +** (single precision) +** +** A rotation matrix describes a rotation about some arbitrary axis. +** The axis is called the Euler axis, and the angle through which the +** reference frame rotates is called the Euler angle. The axial +** vector returned by this routine has the same direction as the +** Euler axis, and its magnitude is the Euler angle in radians. (The +** magnitude and direction can be separated by means of the routine +** slaVn.) +** +** Given: +** rmat float[3][3] rotation matrix +** +** Returned: +** axvec float[3] axial vector (radians) +** +** The reference frame rotates clockwise as seen looking along +** the axial vector from the origin. +** +** If rmat is null, so is the result. +** +** Last revision: 9 April 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + float x, y, z, s2, c2, phi, f; + + x = rmat[1][2] - rmat[2][1]; + y = rmat[2][0] - rmat[0][2]; + z = rmat[0][1] - rmat[1][0]; + s2 = (float) sqrt ( (double) ( x * x + y * y + z * z ) ); + if ( s2 != 0.0f ) { + c2 = rmat[0][0] + rmat[1][1] + rmat[2][2] - 1.0f; + phi = (float) atan2 ( (double) s2 / 2.0, (double) c2 / 2.0 ); + f = phi / s2; + axvec[0] = x * f; + axvec[1] = y * f; + axvec[2] = z * f; + } else { + axvec[0] = 0.0f; + axvec[1] = 0.0f; + axvec[2] = 0.0f; + } +} Index: trunk/MagicSoft/slalib/makefile =================================================================== --- trunk/MagicSoft/slalib/makefile (revision 731) +++ trunk/MagicSoft/slalib/makefile (revision 731) @@ -0,0 +1,486 @@ +#----------------------------------------------------------------------- +# Description: make file for the ANSI-C version of SLALIB. This +# makefile creates a Unix .a library. Designed for Linux/gcc but +# can be adapted for other platforms or run in an appropriate way - +# for example on Sun/Solaris type "make CCOMPC=cc CFLAGC=-c". +# +# Last revision: 13 September 1999 +# +# Copyright 1999 P.T.Wallace. All rights reserved. +# +# Acknowledgements: +# Martin Shepherd, Caltech +# Jeremy Bailey, AAO +# Peter Bunclark, RGO +# +# Usage: +# +# To make the library and install the library and include files, type: +# +# make +# +# To delete all object files and the local copy of the library, type: +# +# make clean +# +#----------------------------------------------------------------------- + +#----YOU MAY HAVE TO MODIFY THE NEXT FEW DEFINITIONS----- + +# Specify the installation home directory. + +INSTALL_DIR = $(HOME) + +# Specify the installation directory for the library. + +SLA_LIB_DIR = $(INSTALL_DIR)/lib/ + +# Specify the installation directory for the include files. + +SLA_INC_DIR = $(INSTALL_DIR)/include/ + +# This suite of functions is only compilable by ANSI C compilers - +# give the name of your preferred C compiler and compilation flags +# here. + +CCOMPC = gcc +CFLAGC = -c -pedantic -Wall + +#----YOU SHOULDN'T HAVE TO MODIFY ANYTHING BELOW THIS LINE--------- + +# The list of installation directories. + +INSTALL_DIRS = $(SLA_LIB_DIR) $(SLA_INC_DIR) + +# Name the slalib library in its source location. + +SLA_LIB_NAME = libsla.a + +# Name the slalib library in its target location. + +SLA_LIB = $(SLA_LIB_DIR)$(SLA_LIB_NAME) + +# Name the slalib includes in their target location. + +SLA_INC = $(SLA_INC_DIR)slalib.h $(SLA_INC_DIR)slamac.h + +# The list of slalib library object files. + +SLA_OBS = slaAddet.o slaAfin.o slaAirmas.o slaAltaz.o slaAmp.o \ +slaAmpqk.o slaAop.o slaAoppa.o slaAoppat.o slaAopqk.o slaAtmdsp.o \ +slaAv2m.o slaBear.o slaCaf2r.o slaCaldj.o slaCalyd.o slaCc2s.o \ +slaCc62s.o slaCd2tf.o slaCldj.o slaClyd.o slaCombn.o slaCr2af.o slaCr2tf.o \ +slaCs2c.o slaCs2c6.o slaCtf2d.o slaCtf2r.o slaDaf2r.o slaDafin.o \ +slaDat.o slaDav2m.o slaDbear.o slaDbjin.o slaDc62s.o slaDcc2s.o \ +slaDcmpf.o slaDcs2c.o slaDd2tf.o slaDe2h.o slaDeuler.o slaDfltin.o \ +slaDh2e.o slaDimxv.o slaDjcal.o slaDjcl.o slaDm2av.o slaDmat.o \ +slaDmoon.o slaDmxm.o slaDmxv.o slaDpav.o slaDr2af.o slaDr2tf.o \ +slaDrange.o slaDranrm.o slaDs2c6.o slaDs2tp.o slaDsep.o slaDt.o \ +slaDtf2d.o slaDtf2r.o slaDtp2s.o slaDtp2v.o slaDtps2c.o slaDtpv2c.o \ +slaDtt.o slaDv2tp.o slaDvdv.o slaDvn.o slaDvxv.o slaE2h.o slaEarth.o \ +slaEcleq.o slaEcmat.o slaEcor.o slaEg50.o slaEl2ue.o slaEpb.o \ +slaEpb2d.o slaEpco.o slaEpj.o slaEpj2d.o slaEqecl.o slaEqeqx.o \ +slaEqgal.o slaEtrms.o slaEuler.o slaEvp.o slaFitxy.o slaFk425.o \ +slaFk45z.o slaFk524.o slaFk52h.o slaFk54z.o slaFk5hz.o slaFlotin.o \ +slaGaleq.o slaGalsup.o slaGe50.o slaGeoc.o slaGmst.o slaGmsta.o \ +slaH2e.o slaH2fk5.o slaHfk5z.o slaImxv.o slaIntin.o slaInvf.o \ +slaKbj.o slaM2av.o slaMap.o slaMappa.o slaMapqk.o slaMapqkz.o \ +slaMoon.o slaMxm.o slaMxv.o slaNut.o slaNutc.o slaOap.o slaOapqk.o \ +slaObs.o slaPa.o slaPav.o slaPcd.o slaPda2h.o slaPdq2h.o slaPermut.o \ +slaPertel.o slaPertue.o slaPlanel.o slaPlanet.o slaPlante.o slaPm.o \ +slaPolmo.o slaPrebn.o slaPrec.o slaPrecl.o slaPreces.o slaPrenut.o \ +slaPvobs.o slaPv2el.o slaPv2ue.o slaPxy.o slaRange.o slaRanorm.o \ +slaRcc.o slaRdplan.o slaRefco.o slaRefcoq.o slaRefro.o slaRefv.o \ +slaRefz.o slaRverot.o slaRvgalc.o slaRvlg.o slaRvlsrd.o slaRvlsrk.o \ +slaS2tp.o slaSep.o slaSmat.o slaSubet.o slaSupgal.o \ +slaSvd.o slaSvdcov.o slaSvdsol.o slaTp2s.o slaTp2v.o slaTps2c.o \ +slaTpv2c.o slaUe2el.o slaUe2pv.o slaUnpcd.o slaV2tp.o slaVdv.o \ +slaVn.o slaVxv.o slaXy2xy.o slaZd.o + +#----------------------------------------------------------------------- + +default: $(INSTALL_DIRS) $(SLA_INC) $(SLA_LIB) + +# Make the installation directories if necessary. + +$(INSTALL_DIRS): + mkdir -p $@ + +# Make and install the library. + +$(SLA_LIB): $(SLA_OBS) + ar ru $(SLA_LIB_NAME) $? + cp $(SLA_LIB_NAME) $@ + +# Keep the installed include files up to date. + +$(SLA_INC): slalib.h slamac.h + cp slalib.h $(SLA_INC_DIR). + cp slamac.h $(SLA_INC_DIR). + +clean: + rm -f $(SLA_OBS) $(SLA_LIB_NAME) + +#----------------------------------------------------------------------- +# The list of object file dependencies + +slaAddet.o : addet.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ addet.c +slaAfin.o : afin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ afin.c +slaAirmas.o : airmas.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ airmas.c +slaAltaz.o : altaz.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ altaz.c +slaAmp.o : amp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ amp.c +slaAmpqk.o : ampqk.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ampqk.c +slaAop.o : aop.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ aop.c +slaAoppa.o : aoppa.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ aoppa.c +slaAoppat.o : aoppat.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ aoppat.c +slaAopqk.o : aopqk.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ aopqk.c +slaAtmdsp.o : atmdsp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ atmdsp.c +slaAv2m.o : av2m.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ av2m.c +slaBear.o : bear.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ bear.c +slaCaf2r.o : caf2r.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ caf2r.c +slaCaldj.o : caldj.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ caldj.c +slaCalyd.o : calyd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ calyd.c +slaCc2s.o : cc2s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cc2s.c +slaCc62s.o : cc62s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cc62s.c +slaCd2tf.o : cd2tf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cd2tf.c +slaCldj.o : cldj.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cldj.c +slaClyd.o : clyd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ clyd.c +slaCombn.o : combn.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ combn.c +slaCr2af.o : cr2af.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cr2af.c +slaCr2tf.o : cr2tf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cr2tf.c +slaCs2c.o : cs2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cs2c.c +slaCs2c6.o : cs2c6.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ cs2c6.c +slaCtf2d.o : ctf2d.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ctf2d.c +slaCtf2r.o : ctf2r.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ctf2r.c +slaDaf2r.o : daf2r.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ daf2r.c +slaDafin.o : dafin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dafin.c +slaDat.o : dat.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dat.c +slaDav2m.o : dav2m.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dav2m.c +slaDbear.o : dbear.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dbear.c +slaDbjin.o : dbjin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dbjin.c +slaDc62s.o : dc62s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dc62s.c +slaDcc2s.o : dcc2s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dcc2s.c +slaDcmpf.o : dcmpf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dcmpf.c +slaDcs2c.o : dcs2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dcs2c.c +slaDd2tf.o : dd2tf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dd2tf.c +slaDe2h.o : de2h.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ de2h.c +slaDeuler.o : deuler.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ deuler.c +slaDfltin.o : dfltin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dfltin.c +slaDh2e.o : dh2e.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dh2e.c +slaDimxv.o : dimxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dimxv.c +slaDjcal.o : djcal.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ djcal.c +slaDjcl.o : djcl.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ djcl.c +slaDm2av.o : dm2av.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dm2av.c +slaDmat.o : dmat.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dmat.c +slaDmoon.o : dmoon.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dmoon.c +slaDmxm.o : dmxm.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dmxm.c +slaDmxv.o : dmxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dmxv.c +slaDpav.o : dpav.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dpav.c +slaDr2af.o : dr2af.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dr2af.c +slaDr2tf.o : dr2tf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dr2tf.c +slaDrange.o : drange.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ drange.c +slaDranrm.o : dranrm.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dranrm.c +slaDs2c6.o : ds2c6.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ds2c6.c +slaDs2tp.o : ds2tp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ds2tp.c +slaDsep.o : dsep.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dsep.c +slaDt.o : dt.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dt.c +slaDtf2d.o : dtf2d.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtf2d.c +slaDtf2r.o : dtf2r.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtf2r.c +slaDtp2s.o : dtp2s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtp2s.c +slaDtp2v.o : dtp2v.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtp2v.c +slaDtps2c.o : dtps2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtps2c.c +slaDtpv2c.o : dtpv2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtpv2c.c +slaDtt.o : dtt.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dtt.c +slaDv2tp.o : dv2tp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dv2tp.c +slaDvdv.o : dvdv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dvdv.c +slaDvn.o : dvn.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dvn.c +slaDvxv.o : dvxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ dvxv.c +slaE2h.o : e2h.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ e2h.c +slaEarth.o : earth.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ earth.c +slaEcleq.o : ecleq.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ecleq.c +slaEcmat.o : ecmat.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ecmat.c +slaEcor.o : ecor.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ecor.c +slaEg50.o : eg50.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ eg50.c +slaEl2ue.o : el2ue.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ el2ue.c +slaEpb.o : epb.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ epb.c +slaEpb2d.o : epb2d.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ epb2d.c +slaEpco.o : epco.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ epco.c +slaEpj.o : epj.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ epj.c +slaEpj2d.o : epj2d.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ epj2d.c +slaEqecl.o : eqecl.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ eqecl.c +slaEqeqx.o : eqeqx.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ eqeqx.c +slaEqgal.o : eqgal.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ eqgal.c +slaEtrms.o : etrms.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ etrms.c +slaEuler.o : euler.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ euler.c +slaEvp.o : evp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ evp.c +slaFitxy.o : fitxy.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fitxy.c +slaFk425.o : fk425.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk425.c +slaFk45z.o : fk45z.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk45z.c +slaFk524.o : fk524.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk524.c +slaFk52h.o : fk52h.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk52h.c +slaFk54z.o : fk54z.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk54z.c +slaFk5hz.o : fk5hz.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ fk5hz.c +slaFlotin.o : flotin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ flotin.c +slaGaleq.o : galeq.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ galeq.c +slaGalsup.o : galsup.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ galsup.c +slaGe50.o : ge50.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ge50.c +slaGeoc.o : geoc.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ geoc.c +slaGmst.o : gmst.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ gmst.c +slaGmsta.o : gmsta.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ gmsta.c +slaH2e.o : h2e.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ h2e.c +slaH2fk5.o : h2fk5.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ h2fk5.c +slaHfk5z.o : hfk5z.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ hfk5z.c +slaImxv.o : imxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ imxv.c +slaIntin.o : intin.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ intin.c +slaInvf.o : invf.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ invf.c +slaKbj.o : kbj.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ kbj.c +slaM2av.o : m2av.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ m2av.c +slaMap.o : map.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ map.c +slaMappa.o : mappa.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ mappa.c +slaMapqk.o : mapqk.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ mapqk.c +slaMapqkz.o : mapqkz.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ mapqkz.c +slaMoon.o : moon.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ moon.c +slaMxm.o : mxm.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ mxm.c +slaMxv.o : mxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ mxv.c +slaNut.o : nut.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ nut.c +slaNutc.o : nutc.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ nutc.c +slaOap.o : oap.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ oap.c +slaOapqk.o : oapqk.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ oapqk.c +slaObs.o : obs.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ obs.c +slaPa.o : pa.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pa.c +slaPav.o : pav.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pav.c +slaPcd.o : pcd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pcd.c +slaPm.o : pm.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pm.c +slaPda2h.o : pda2h.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pda2h.c +slaPdq2h.o : pdq2h.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pdq2h.c +slaPermut.o : permut.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ permut.c +slaPertel.o : pertel.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pertel.c +slaPertue.o : pertue.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pertue.c +slaPlanel.o : planel.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ planel.c +slaPlanet.o : planet.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ planet.c +slaPlante.o : plante.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ plante.c +slaPolmo.o : polmo.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ polmo.c +slaPrebn.o : prebn.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ prebn.c +slaPrec.o : prec.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ prec.c +slaPrecl.o : precl.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ precl.c +slaPreces.o : preces.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ preces.c +slaPrenut.o : prenut.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ prenut.c +slaPvobs.o : pvobs.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pvobs.c +slaPv2el.o : pv2el.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pv2el.c +slaPv2ue.o : pv2ue.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pv2ue.c +slaPxy.o : pxy.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ pxy.c +slaRange.o : range.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ range.c +slaRanorm.o : ranorm.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ranorm.c +slaRcc.o : rcc.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rcc.c +slaRdplan.o : rdplan.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rdplan.c +slaRefco.o : refco.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ refco.c +slaRefcoq.o : refcoq.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ refcoq.c +slaRefro.o : refro.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ refro.c +slaRefv.o : refv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ refv.c +slaRefz.o : refz.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ refz.c +slaRverot.o : rverot.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rverot.c +slaRvgalc.o : rvgalc.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rvgalc.c +slaRvlg.o : rvlg.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rvlg.c +slaRvlsrd.o : rvlsrd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rvlsrd.c +slaRvlsrk.o : rvlsrk.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ rvlsrk.c +slaS2tp.o : s2tp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ s2tp.c +slaSep.o : sep.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ sep.c +slaSmat.o : smat.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ smat.c +slaSubet.o : subet.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ subet.c +slaSupgal.o : supgal.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ supgal.c +slaSvd.o : svd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ svd.c +slaSvdcov.o : svdcov.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ svdcov.c +slaSvdsol.o : svdsol.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ svdsol.c +slaTp2s.o : tp2s.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ tp2s.c +slaTp2v.o : tp2v.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ tp2v.c +slaTps2c.o : tps2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ tps2c.c +slaTpv2c.o : tpv2c.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ tpv2c.c +slaUe2el.o : ue2el.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ue2el.c +slaUe2pv.o : ue2pv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ ue2pv.c +slaUnpcd.o : unpcd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ unpcd.c +slaV2tp.o : v2tp.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ v2tp.c +slaVdv.o : vdv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ vdv.c +slaVn.o : vn.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ vn.c +slaVxv.o : vxv.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ vxv.c +slaXy2xy.o : xy2xy.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ xy2xy.c +slaZd.o : zd.c slalib.h slamac.h + $(CCOMPC) $(CFLAGC) -o $@ zd.c Index: trunk/MagicSoft/slalib/map.c =================================================================== --- trunk/MagicSoft/slalib/map.c (revision 731) +++ trunk/MagicSoft/slalib/map.c (revision 731) @@ -0,0 +1,71 @@ +#include "slalib.h" +#include "slamac.h" +void slaMap ( double rm, double dm, double pr, double pd, + double px, double rv, double eq, double date, + double *ra, double *da ) +/* +** - - - - - - - +** s l a M a p +** - - - - - - - +** +** Transform star RA,Dec from mean place to geocentric apparent. +** +** The reference frames and timescales used are post IAU 1976. +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Given: +** rm,dm double mean RA,Dec (rad) +** pr,pd double proper motions: RA,Dec changes per Julian year +** px double parallax (arcsec) +** rv double radial velocity (km/sec, +ve if receding) +** eq double epoch and equinox of star data (Julian) +** date double TDB for apparent place (JD-2400000.5) +** +** Returned: +** *ra,*da double apparent RA,Dec (rad) +** +** Called: +** slaMappa star-independent parameters +** slaMapqk quick mean to apparent +** +** Notes: +** +** 1) eq is the Julian epoch specifying both the reference +** frame and the epoch of the position - usually 2000. +** For positions where the epoch and equinox are +** different, use the routine slaPm to apply proper +** motion corrections before using this routine. +** +** 2) The distinction between the required TDB and TDT is +** always negligible. Moreover, for all but the most +** critical applications UTC is adequate. +** +** 3) The proper motions in RA are dRA/dt rather than +** cos(dec)*dra/dt. +** +** 4) This routine may be wasteful for some applications +** because it recomputes the Earth position/velocity and +** the precession/nutation matrix each time, and because +** it allows for parallax and proper motion. Where +** multiple transformations are to be carried out for one +** epoch, a faster method is to call the slaMappa routine +** once and then either the slaMapqk routine (which includes +** parallax and proper motion) or slaMapqkz (which assumes +** zero parallax and proper motion). +** +** Last revision: 12 June 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double amprms[21]; + +/* Star-independent parameters */ + slaMappa ( eq, date, amprms ); + +/* Mean to apparent */ + slaMapqk ( rm, dm, pr, pd, px, rv, amprms, ra, da ); +} Index: trunk/MagicSoft/slalib/mappa.c =================================================================== --- trunk/MagicSoft/slalib/mappa.c (revision 731) +++ trunk/MagicSoft/slalib/mappa.c (revision 731) @@ -0,0 +1,92 @@ +#include "slalib.h" +#include "slamac.h" +void slaMappa ( double eq, double date, double amprms[21] ) +/* +** - - - - - - - - - +** s l a M a p p a +** - - - - - - - - - +** +** Compute star-independent parameters in preparation for +** conversions between mean place and geocentric apparent place. +** +** The parameters produced by this routine are required in the +** parallax, light deflection, aberration, and precession/nutation +** parts of the mean/apparent transformations. +** +** The reference frames and timescales used are post IAU 1976. +** +** Given: +** eq double epoch of mean equinox to be used (Julian) +** date double TDB (JD-2400000.5) +** +** Returned: +** amprms double[21] star-independent mean-to-apparent parameters: +** +** (0) time interval for proper motion (Julian years) +** (1-3) barycentric position of the Earth (AU) +** (4-6) heliocentric direction of the Earth (unit vector) +** (7) (grav rad Sun)*2/(Sun-Earth distance) +** (8-10) abv: barycentric Earth velocity in units of c +** (11) sqrt(1-v**2) where v=modulus(abv) +** (12-20) precession/nutation (3,3) matrix +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Notes: +** +** 1) For date, the distinction between the required TDB and TT +** is always negligible. Moreover, for all but the most +** critical applications UTC is adequate. +** +** 2) The accuracy of the routines using the parameters amprms is +** limited by the routine slaEvp, used here to compute the +** Earth position and velocity by the methods of Stumpff. +** The maximum error in the resulting aberration corrections is +** about 0.3 milliarcsecond. +** +** 3) The vectors amprms(1-3) and amprms(4-6) are referred to +** the mean equinox and equator of epoch eq. +** +** 4) The parameters amprms produced by this routine are used by +** slaMapqk and slaMapqkz. +** +** Called: +** slaEpj, slaEvp, slaDvn, slaPrenut +** +** Last revision: 26 September 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define CR 499.004782 /* Light time for 1 AU (sec) */ +#define GR2 1.974126e-8 /* Gravitational radius of the Sun x 2: + (2*mu/c**2, au) */ +{ + int i; + + double ebd[3], ehd[3], eh[3], e, vn[3], vm; + +/* Time interval for proper motion correction */ + amprms[0] = slaEpj ( date ) - eq; + +/* Get Earth barycentric and heliocentric position and velocity */ + slaEvp ( date, eq, ebd, &rms[1], ehd, eh ); + +/* Heliocentric direction of Earth (normalized) and modulus */ + slaDvn ( eh, &rms[4], &e ); + +/* Light deflection parameter */ + amprms[7] = GR2 / e; + +/* Aberration parameters */ + for ( i = 0; i < 3; i++ ) { + amprms[i+8] = ebd[i] * CR; + } + slaDvn ( &rms[8], vn, &vm ); + amprms[11] = sqrt ( 1.0 - vm * vm ); + +/* Precession/nutation matrix */ + slaPrenut ( eq, date, (double(*)[3]) &rms[12] ); +} Index: trunk/MagicSoft/slalib/mapqk.c =================================================================== --- trunk/MagicSoft/slalib/mapqk.c (revision 731) +++ trunk/MagicSoft/slalib/mapqk.c (revision 731) @@ -0,0 +1,134 @@ +#include "slalib.h" +#include "slamac.h" +void slaMapqk ( double rm, double dm, double pr, double pd, + double px, double rv, double amprms[21], + double *ra, double *da ) +/* +** - - - - - - - - - +** s l a M a p q k +** - - - - - - - - - +** +** Quick mean to apparent place: transform a star RA,Dec from +** mean place to geocentric apparent place, given the +** star-independent parameters. +** +** Use of this routine is appropriate when efficiency is important +** and where many star positions, all referred to the same equator +** and equinox, are to be transformed for one epoch. The +** star-independent parameters can be obtained by calling the +** slaMappa routine. +** +** If the parallax and proper motions are zero the slaMapqkz +** routine can be used instead. +** +** The reference frames and timescales used are post IAU 1976. +** +** Given: +** rm,dm double mean RA,Dec (rad) +** pr,pd double proper motions: RA,Dec changes per Julian year +** px double parallax (arcsec) +** rv double radial velocity (km/sec, +ve if receding) +** +** amprms double[21] star-independent mean-to-apparent parameters: +** +** (0) time interval for proper motion (Julian years) +** (1-3) barycentric position of the Earth (AU) +** (4-6) heliocentric direction of the Earth (unit vector) +** (7) (grav rad Sun)*2/(Sun-Earth distance) +** (8-10) barycentric Earth velocity in units of c +** (11) sqrt(1-v**2) where v=modulus(abv) +** (12-20) precession/nutation (3,3) matrix +** +** Returned: +** *ra,*da double apparent RA,Dec (rad) +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Notes: +** +** 1) The vectors amprms(1-3) and amprms(4-6) are referred to +** the mean equinox and equator of epoch eq. +** +** 2) Strictly speaking, the routine is not valid for solar-system +** sources, though the error will usually be extremely small. +** However, to prevent gross errors in the case where the +** position of the Sun is specified, the gravitational +** deflection term is restrained within about 920 arcsec of the +** centre of the Sun's disc. The term has a maximum value of +** about 1.85 arcsec at this radius, and decreases to zero as +** the centre of the disc is approached. +** +** Called: +** slaDcs2c spherical to Cartesian +** slaDvdv dot product +** slaDmxv matrix x vector +** slaDcc2s Cartesian to spherical +** slaDranrm normalize angle 0-2pi +** +** Defined in slamac.h: DAS2R +** +** Last revision: 15 January 2000 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define VF 0.21094502 /* Km/s to AU/year */ + +{ + int i; + double pmt, gr2e, ab1, eb[3], ehn[3], abv[3], + q[3], pxr, w, em[3], p[3], pn[3], pde, pdep1, + p1[3], p1dv, p2[3], p3[3]; + +/* Unpack scalar and vector parameters */ + pmt = amprms[0]; + gr2e = amprms[7]; + ab1 = amprms[11]; + for ( i = 0; i < 3; i++ ) + { + eb[i] = amprms[i+1]; + ehn[i] = amprms[i+4]; + abv[i] = amprms[i+8]; + } + +/* Spherical to x,y,z */ + slaDcs2c ( rm, dm, q ); + +/* Space motion (radians per year) */ + pxr = px * DAS2R; + w = VF * rv * pxr; + em[0] = (-pr * q[1]) - ( pd * cos ( rm ) * sin ( dm ) ) + ( w * q[0] ); + em[1] = ( pr * q[0]) - ( pd * sin ( rm ) * sin ( dm ) ) + ( w * q[1] ); + em[2] = ( pd * cos ( dm ) ) + ( w * q[2] ); + +/* Geocentric direction of star (normalized) */ + for ( i = 0; i < 3; i++ ) { + p[i] = q[i] + ( pmt * em[i] ) - ( pxr * eb[i] ); + } + slaDvn ( p, pn, &w ); + +/* Light deflection (restrained within the Sun's disc) */ + pde = slaDvdv ( pn, ehn ); + pdep1 = 1.0 + pde; + w = gr2e / gmax ( pdep1, 1.0e-5 ); + for ( i = 0; i < 3; i++ ) { + p1[i] = pn[i] + ( w * ( ehn[i] - pde * pn[i] ) ); + } + +/* Aberration (normalization omitted) */ + p1dv = slaDvdv ( p1, abv ); + w = 1.0 + p1dv / ( ab1 + 1.0 ); + for ( i = 0; i < 3; i++ ) { + p2[i] = ab1 * p1[i] + w * abv[i]; + } + +/* Precession and nutation */ + slaDmxv ( (double(*)[3]) &rms[12], p2, p3 ); + +/* Geocentric apparent RA,dec */ + slaDcc2s ( p3, ra, da ); + + *ra = slaDranrm ( *ra ); +} Index: trunk/MagicSoft/slalib/mapqkz.c =================================================================== --- trunk/MagicSoft/slalib/mapqkz.c (revision 731) +++ trunk/MagicSoft/slalib/mapqkz.c (revision 731) @@ -0,0 +1,110 @@ +#include "slalib.h" +#include "slamac.h" +void slaMapqkz ( double rm, double dm, double amprms[21], + double *ra, double *da ) +/* +** - - - - - - - - - - +** s l a M a p q k z +** - - - - - - - - - - +** +** Quick mean to apparent place: transform a star RA,dec from +** mean place to geocentric apparent place, given the +** star-independent parameters, and assuming zero parallax +** and proper motion. +** +** Use of this routine is appropriate when efficiency is important +** and where many star positions, all with parallax and proper +** motion either zero or already allowed for, and all referred to +** the same equator and equinox, are to be transformed for one +** epoch. The star-independent parameters can be obtained by +** calling the slaMappa routine. +** +** The corresponding routine for the case of non-zero parallax +** and proper motion is slaMapqk. +** +** The reference frames and timescales used are post IAU 1976. +** +** Given: +** rm,dm double mean RA,dec (rad) +** amprms double[21] star-independent mean-to-apparent parameters: +** +** (0-3) not used +** (4-6) heliocentric direction of the Earth (unit vector) +** (7) (grav rad Sun)*2/(Sun-Earth distance) +** (8-10) abv: barycentric Earth velocity in units of c +** (11) sqrt(1-v**2) where v=modulus(abv) +** (12-20) precession/nutation (3,3) matrix +** +** Returned: +** *ra,*da double apparent RA,dec (rad) +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, +** 1-6, 1984) +** +** Notes: +** +** 1) The vectors amprms(1-3) and amprms(4-6) are referred to the +** mean equinox and equator of epoch eq. +** +** 2) Strictly speaking, the routine is not valid for solar-system +** sources, though the error will usually be extremely small. +** However, to prevent gross errors in the case where the +** position of the Sun is specified, the gravitational +** deflection term is restrained within about 920 arcsec of the +** centre of the Sun's disc. The term has a maximum value of +** about 1.85 arcsec at this radius, and decreases to zero as +** the centre of the disc is approached. +** +** Called: +** slaDcs2c spherical to Cartesian +** slaDvdv dot product +** slaDmxv matrix x vector +** slaDcc2s Cartesian to spherical +** slaDranrm normalize angle 0-2pi +** +** Last revision: 17 August 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + double gr2e, ab1, ehn[3], abv[3], p[3], pde, pdep1, + w, p1[3], p1dv, p1dvp1, p2[3], p3[3]; + + +/* Unpack scalar and vector parameters */ + gr2e = amprms[7]; + ab1 = amprms[11]; + for ( i = 0; i < 3; i++ ) { + ehn[i] = amprms[i+4]; + abv[i] = amprms[i+8]; + } + +/* Spherical to x,y,z */ + slaDcs2c ( rm, dm, p ); + +/* Light deflection */ + pde = slaDvdv ( p, ehn ); + pdep1 = pde + 1.0; + w = gr2e / gmax ( pdep1, 1e-5 ); + for ( i = 0; i < 3; i++ ) { + p1[i] = p[i] + w * ( ehn[i] - pde * p[i] ); + } + +/* Aberration */ + p1dv = slaDvdv ( p1, abv ); + p1dvp1 = p1dv + 1.0; + w = 1.0 + p1dv / ( ab1 + 1.0 ); + for ( i = 0; i < 3; i++ ) { + p2[i] = ( ( ab1 * p1[i] ) + ( w * abv[i] ) ) / p1dvp1; + } + +/* Precession and nutation */ + slaDmxv ( (double(*)[3]) &rms[12], p2, p3 ); + +/* Geocentric apparent RA,dec */ + slaDcc2s ( p3, ra, da ); + *ra = slaDranrm ( *ra ); +} Index: trunk/MagicSoft/slalib/moon.c =================================================================== --- trunk/MagicSoft/slalib/moon.c (revision 731) +++ trunk/MagicSoft/slalib/moon.c (revision 731) @@ -0,0 +1,314 @@ +#include "slalib.h" +#include "slamac.h" +void slaMoon ( int iy, int id, float fd, float pv[6] ) +/* +** - - - - - - - - +** s l a M o o n +** - - - - - - - - +** +** Approximate geocentric position and velocity of the Moon +** (single precision). +** +** Given: +** iy int year +** id int day in year (1 = Jan 1st) +** fd float fraction of day +** +** Returned: +** pv float[6] Moon position & velocity vector +** +** Notes: +** +** 1 The date and time is TDB (loosely ET) in a Julian calendar +** which has been aligned to the ordinary Gregorian +** calendar for the interval 1900 March 1 to 2100 February 28. +** The year and day can be obtained by calling slaCalyd or +** slaClyd. +** +** 2 The Moon 6-vector is Moon centre relative to Earth centre, +** mean equator and equinox of date. Position part, pv[0-2], +** is in AU; velocity part, pv[3-5], is in AU/sec. +** +** 3 The position is accurate to better than 0.5 arcminute +** in direction and 1000 km in distance. The velocity +** is accurate to better than 0.5"/hour in direction and +** 4 m/s in distance. (RMS figures with respect to JPL DE200 +** for the interval 1960-2025 are 14 arcsec and 0.2 arcsec/hour in +** longitude, 9 arcsec and 0.2 arcsec/hour in latitude, 350 km and +** 2 m/s in distance.) Note that the distance accuracy is +** comparatively poor because this routine is principally intended +** for computing topocentric direction. +** +** 4 This routine is only a partial implementation of the original +** Meeus algorithm (reference below), which offers 4 times the +** accuracy in direction and 30 times the accuracy in distance +** when fully implemented (as it is in slaDmoon). +** +** Reference: +** Meeus, l'Astronomie, June 1984, p348. +** +** Defined in slamac.h: dmod +** +** Last revision: 9 April 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define D2R 0.01745329252f /* Degrees to radians */ + +#define RATCON 9.652743551e-12f /* Rate conversion factor: */ + /* D2R * D2R / (86400 * 365.25) */ + +#define ERADAU 4.2635212653763e-5f /* Earth equatorial radius in AU */ + /* ( = 6378.137 / 149597870 ) */ + +{ + int iy4, n; + float yi, yf, t, elp, em, emp, d, f, v, dv, emn, empn, dn, fn, coeff, + theta, el, del, b, db, p, dp, sp, r, dr, x, y, z, xd, yd, zd, + sel, cel, sb, cb, rcb, rbd, w, eps, sineps, coseps; + +/* +** Coefficients for fundamental arguments +** +** Fixed term (deg), term in t (deg & whole revs + fraction per year) +** +** Moon's mean longitude +*/ + static float elp0 = 270.434164f; + static float elp1 = 4812.678831f; + static float elp1i = 4680.0f; + static float elp1f = 132.678831f; + +/* Sun's mean anomaly */ + static float em0 = 358.475833f; + static float em1 = 359.990498f; + static float em1f = 359.990498f; + +/* Moon's mean anomaly */ + static float emp0 = 296.104608f; + static float emp1 = 4771.988491f; + static float emp1i = 4680.0f; + static float emp1f = 91.988491f; + +/* Moon's mean elongation */ + static float d0 = 350.737486f; + static float d1 = 4452.671142f; + static float d1i = 4320.0f; + static float d1f = 132.671142f; + +/* Mean distance of the Moon from its ascending node */ + static float f0 = 11.250889f; + static float f1 = 4832.020251f; + static float f1i = 4680.0f; + static float f1f = 152.020251f; + +/* +** Coefficients for Moon longitude, latitude, parallax series +*/ + struct term { + float coef; /* coefficient of L, B or P term (deg) */ + int nem; /* multiple of M in argument */ + int nemp; /* " " M' " " */ + int nd; /* " " D " " */ + int nf; /* " " F " " */ + }; + +/* +** Longitude coeff M M' D F +*/ + static struct term tl[] = { { 6.288750f, 0, 1, 0, 0 }, + { 1.274018f, 0, -1, 2, 0 }, + { 0.658309f, 0, 0, 2, 0 }, + { 0.213616f, 0, 2, 0, 0 }, + { -0.185596f, 1, 0, 0, 0 }, + { -0.114336f, 0, 0, 0, 2 }, + { 0.058793f, 0, -2, 2, 0 }, + { 0.057212f, -1, -1, 2, 0 }, + { 0.053320f, 0, 1, 2, 0 }, + { 0.045874f, -1, 0, 2, 0 }, + { 0.041024f, -1, 1, 0, 0 }, + { -0.034718f, 0, 0, 1, 0 }, + { -0.030465f, 1, 1, 0, 0 }, + { 0.015326f, 0, 0, 2, -2 }, + { -0.012528f, 0, 1, 0, 2 }, + { -0.010980f, 0, -1, 0, 2 }, + { 0.010674f, 0, -1, 4, 0 }, + { 0.010034f, 0, 3, 0, 0 }, + { 0.008548f, 0, -2, 4, 0 }, + { -0.007910f, 1, -1, 2, 0 }, + { -0.006783f, 1, 0, 2, 0 }, + { 0.005162f, 0, 1, -1, 0 }, + { 0.005000f, 1, 0, 1, 0 }, + { 0.004049f, -1, 1, 2, 0 }, + { 0.003996f, 0, 2, 2, 0 }, + { 0.003862f, 0, 0, 4, 0 }, + { 0.003665f, 0, -3, 2, 0 }, + { 0.002695f, -1, 2, 0, 0 }, + { 0.002602f, 0, 1, -2, -2 }, + { 0.002396f, -1, -2, 2, 0 }, + { -0.002349f, 0, 1, 1, 0 }, + { 0.002249f, -2, 0, 2, 0 }, + { -0.002125f, 1, 2, 0, 0 }, + { -0.002079f, 2, 0, 0, 0 }, + { 0.002059f, -2, -1, 2, 0 }, + { -0.001773f, 0, 1, 2, -2 }, + { -0.001595f, 0, 0, 2, 2 }, + { 0.001220f, -1, -1, 4, 0 }, + { -0.001110f, 0, 2, 0, 2 } }; + static int NL = ( sizeof tl / sizeof ( struct term ) ); + +/* +** Latitude coeff M M' D F +*/ + static struct term tb[] = { { 5.128189f, 0, 0, 0, 1 }, + { 0.280606f, 0, 1, 0, 1 }, + { 0.277693f, 0, 1, 0, -1 }, + { 0.173238f, 0, 0, 2, -1 }, + { 0.055413f, 0, -1, 2, 1 }, + { 0.046272f, 0, -1, 2, -1 }, + { 0.032573f, 0, 0, 2, 1 }, + { 0.017198f, 0, 2, 0, 1 }, + { 0.009267f, 0, 1, 2, -1 }, + { 0.008823f, 0, 2, 0, -1 }, + { 0.008247f, -1, 0, 2, -1 }, + { 0.004323f, 0, -2, 2, -1 }, + { 0.004200f, 0, 1, 2, 1 }, + { 0.003372f, -1, 0, -2, 1 }, + { 0.002472f, -1, -1, 2, 1 }, + { 0.002222f, -1, 0, 2, 1 }, + { 0.002072f, -1, -1, 2, -1 }, + { 0.001877f, -1, 1, 0, 1 }, + { 0.001828f, 0, -1, 4, -1 }, + { -0.001803f, 1, 0, 0, 1 }, + { -0.001750f, 0, 0, 0, 3 }, + { 0.001570f, -1, 1, 0, -1 }, + { -0.001487f, 0, 0, 1, 1 }, + { -0.001481f, 1, 1, 0, 1 }, + { 0.001417f, -1, -1, 0, 1 }, + { 0.001350f, -1, 0, 0, 1 }, + { 0.001330f, 0, 0, -1, 1 }, + { 0.001106f, 0, 3, 0, 1 }, + { 0.001020f, 0, 0, 4, -1 } }; + static int NB = ( sizeof tb / sizeof ( struct term ) ); + +/* +** Parallax coeff M M' D F +*/ + static struct term tp[] = { { 0.950724f, 0, 0, 0, 0 }, + { 0.051818f, 0, 1, 0, 0 }, + { 0.009531f, 0, -1, 2, 0 }, + { 0.007843f, 0, 0, 2, 0 }, + { 0.002824f, 0, 2, 0, 0 } }; + static int NP = ( sizeof tp / sizeof ( struct term ) ); + + + +/* Whole years & fraction of year, and years since J1900.0 */ + yi = (float) ( iy - 1900 ); + iy4 = iy >= 4 ? iy % 4 : 3 - ( -iy - 1 ) % 4 ; + yf = ( (float) ( 4 * ( id - 1 / ( iy4 + 1 ) ) + - iy4 - 2 ) + ( 4.0f * fd ) ) / 1461.0f; + t = yi + yf; + +/* Moon's mean longitude */ + elp = D2R * (float) dmod ( (double) ( elp0 + elp1i * yf + elp1f * t ), + 360.0 ); + +/* Sun's mean anomaly */ + em = D2R * (float) dmod ( (double) ( em0 + em1f * t ), 360.0 ); + +/* Moon's mean anomaly */ + emp = D2R * (float) dmod ( (double) ( emp0 + emp1i * yf + emp1f * t ), + 360.0 ); + +/* Moon's mean elongation */ + d = D2R * (float) dmod ( (double) ( d0 + d1i * yf + d1f * t ), 360.0 ); + +/* Mean distance of the Moon from its ascending node */ + f = D2R * (float) dmod ( (double) ( f0 + f1i * yf + f1f * t ), 360.0 ); + +/* Longitude */ + v = 0.0f; + dv = 0.0f; + for ( n = NL -1; n >= 0; n-- ) { + coeff = tl[n].coef; + emn = (float) tl[n].nem; + empn = (float) tl[n].nemp; + dn = (float) tl[n].nd; + fn = (float) tl[n].nf; + theta = emn * em + empn * emp + dn * d + fn * f; + v += coeff * ( (float) sin ( (double) theta ) ); + dv += coeff * ( (float) cos ( (double) theta ) ) * + ( emn * em1 + empn * emp1 + dn * d1 + fn * f1 ); + } + el = elp + D2R * v; + del = RATCON * ( elp1 / D2R + dv ); + +/* Latitude */ + v = 0.0f; + dv = 0.0f; + for ( n = NB - 1; n >= 0; n-- ) { + coeff = tb[n].coef; + emn = (float) tb[n].nem; + empn = (float) tb[n].nemp; + dn = (float) tb[n].nd; + fn = (float) tb[n].nf; + theta = emn * em + empn * emp + dn * d + fn * f; + v += coeff * ( (float) sin ( (double) theta ) ); + dv += coeff * ( (float) cos ( (double) theta ) ) * + ( emn * em1 + empn * emp1 + dn * d1 + fn * f1 ); + } + b = D2R * v; + db = RATCON * dv; + +/* Parallax */ + v = 0.0f; + dv = 0.0f; + for ( n = NP - 1; n >= 0; n-- ) { + coeff = tp[n].coef; + emn = (float) tp[n].nem; + empn = (float) tp[n].nemp; + dn = (float) tp[n].nd; + fn = (float) tp[n].nf; + theta = emn * em + empn * emp + dn * d + fn * f; + v += coeff * ( (float) cos ( (double) theta ) ); + dv += coeff * ( - (float) sin ( (double) theta ) ) * + ( emn * em1 + empn * emp1 + dn * d1 + fn * f1 ); + } + p = D2R * v; + dp = RATCON * dv; + +/* Parallax to distance (AU, AU/sec) */ + sp = (float) sin ( (double) p ); + r = ERADAU / sp; + dr = - r * dp * (float) ( cos ( (double) p ) ) / sp; + +/* Longitude, latitude to x, y, z (AU) */ + sel = (float) sin ( (double) el ); + cel = (float) cos ( (double) el ); + sb = (float) sin ( (double) b ); + cb = (float) cos ( (double) b ); + rcb = r * cb; + rbd = r * db; + w = rbd * sb - cb * dr; + x = rcb * cel; + y = rcb * sel; + z = r * sb; + xd = - y * del - w * cel; + yd = x * del - w * sel; + zd = rbd * cb + sb * dr; + +/* Mean obliquity */ + eps = D2R * ( 23.45229f - 0.00013f * t ); + sineps = (float) sin ( (double) eps ); + coseps = (float) cos ( (double) eps ); + +/* To the equatorial system, mean of date */ + pv[0] = x; + pv[1] = y * coseps - z * sineps; + pv[2] = y * sineps + z * coseps; + pv[3] = xd; + pv[4] = yd * coseps - zd * sineps; + pv[5] = yd * sineps + zd * coseps; +} Index: trunk/MagicSoft/slalib/mxm.c =================================================================== --- trunk/MagicSoft/slalib/mxm.c (revision 731) +++ trunk/MagicSoft/slalib/mxm.c (revision 731) @@ -0,0 +1,49 @@ +#include "slalib.h" +#include "slamac.h" +void slaMxm ( float a[3][3], float b[3][3], float c[3][3] ) +/* +** - - - - - - - +** s l a M x m +** - - - - - - - +** +** Product of two 3x3 matrices: +** +** matrix c = matrix a x matrix b +** +** (single precision) +** +** Given: +** a float[3][3] matrix +** b float[3][3] matrix +** +** Returned: +** c float[3][3] matrix result +** +** Note: the same array may be nominated more than once. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j, k; + float w, wm[3][3]; + +/* Multiply into scratch matrix */ + for ( i = 0; i < 3; i++ ) { + for ( j = 0; j < 3; j++ ) { + w = 0.0f; + for ( k = 0; k < 3; k++ ) { + w += a[i][k] * b[k][j]; + } + wm[i][j] = w; + } + } + +/* Return the result */ + for ( j = 0; j < 3; j++ ) { + for ( i = 0; i < 3; i++ ) { + c[i][j] = wm[i][j]; + } + } +} Index: trunk/MagicSoft/slalib/mxv.c =================================================================== --- trunk/MagicSoft/slalib/mxv.c (revision 731) +++ trunk/MagicSoft/slalib/mxv.c (revision 731) @@ -0,0 +1,45 @@ +#include "slalib.h" +#include "slamac.h" +void slaMxv ( float rm[3][3], float va[3], float vb[3] ) +/* +** - - - - - - - +** s l a M x v +** - - - - - - - +** +** Perform the 3-d forward unitary transformation: +** +** vector vb = matrix rm * vector va +** +** (single precision) +** +** Given: +** rm float[3][3] matrix +** va float[3] vector +** +** Returned: +** vb float[3] result vector +** +** Note: va and vb may be the same array. +** +** Last revision: 6 November 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, j; + float w, vw[3]; + +/* Matrix rm * vector va -> vector vw */ + for ( j = 0; j < 3; j++ ) { + w = 0.0f; + for ( i = 0; i < 3; i++ ) { + w += rm[j][i] * va[i]; + } + vw[j] = w; + } + +/* Vector vw -> vector vb */ + for ( j = 0; j < 3; j++ ) { + vb[j] = vw[j]; + } +} Index: trunk/MagicSoft/slalib/nut.c =================================================================== --- trunk/MagicSoft/slalib/nut.c (revision 731) +++ trunk/MagicSoft/slalib/nut.c (revision 731) @@ -0,0 +1,41 @@ +#include "slalib.h" +#include "slamac.h" +void slaNut ( double date, double rmatn[3][3] ) +/* +** - - - - - - - +** s l a N u t +** - - - - - - - +** +** Form the matrix of nutation for a given date (IAU 1980 theory). +** +** (double precision) +** +** References: +** Final report of the IAU working group on nutation, +** chairman P.K.Seidelmann, 1980. +** Kaplan, G.H., 1981, USNO circular no. 163, pA3-6. +** +** Given: +** date double TDB (loosely ET) as Modified Julian Date +** (=JD-2400000.5) +** +** Returned: +** rmatn double[3][3] nutation matrix +** +** The matrix is in the sense v(true) = rmatn * v(mean) . +** +** Called: slaNutc, slaDeuler +** +** Last revision: 11 April 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double dpsi, deps, eps0; + +/* Nutation components and mean obliquity */ + slaNutc ( date, &dpsi, &deps, &eps0 ); + +/* Rotation matrix */ + slaDeuler ( "xzx", eps0, -dpsi, - ( eps0 + deps ), rmatn ); +} Index: trunk/MagicSoft/slalib/nutc.c =================================================================== --- trunk/MagicSoft/slalib/nutc.c (revision 731) +++ trunk/MagicSoft/slalib/nutc.c (revision 731) @@ -0,0 +1,427 @@ +#include "slalib.h" +#include "slamac.h" +void slaNutc ( double date, double *dpsi, double *deps, double *eps0 ) +/* +** - - - - - - - - +** s l a N u t c +** - - - - - - - - +** +** Nutation: longitude & obliquity components and +** mean obliquity (IAU 1980 theory). +** +** (double precision) +** +** References: +** Final report of the IAU working group on nutation, +** chairman P.K.Seidelmann, 1980. +** Kaplan,G.H., 1981, USNO circular No. 163, pa3-6. +** +** Given: +** date double TDB (loosely ET) as Modified Julian Date +** (JD-2400000.5) +** +** Returned: +** *dpsi,*deps double nutation in longitude,obliquity +** *eps0 double mean obliquity +** +** Called: slaDrange +** +** Defined in slamac.h: DAS2R, dmod +** +** Last revision: 19 March 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define T2AS 1296000.0 /* Turns to arc seconds */ +#define U2R 0.4848136811095359949e-9 /* Units of 0.0001 arcsec to radians */ + +{ + double t, el, el2, el3, elp, elp2, + f, f2, f4, + d, d2, d4, + om, om2, + dp, de, a; + +/* Interval between basic epoch J2000.0 and current epoch (JC) */ + t = ( date - 51544.5 ) / 36525.0; + +/* Fundamental arguments in the FK5 reference system */ + +/* Mean longitude of the Moon minus mean longitude of the Moon's perigee */ + el = slaDrange ( DAS2R * dmod ( 485866.733 + ( 1325.0 * T2AS + 715922.633 + + ( 31.310 + 0.064 * t ) * t ) * t , T2AS ) ); + +/* Mean longitude of the Sun minus mean longitude of the Sun's perigee */ + elp = slaDrange ( DAS2R * dmod ( 1287099.804 + ( 99.0 * T2AS + 1292581.224 + + ( -0.577 - 0.012 * t ) * t ) * t, T2AS ) ); + +/* Mean longitude of the Moon minus mean longitude of the Moon's node */ + f = slaDrange ( DAS2R * dmod ( 335778.877 + ( 1342.0 * T2AS + 295263.137 + + ( -13.257 + 0.011 * t ) * t ) * t, T2AS ) ); + +/* Mean elongation of the Moon from the Sun */ + d = slaDrange ( DAS2R * dmod ( 1072261.307 + ( 1236.0 * T2AS + 1105601.328 + + ( -6.891 + 0.019 * t ) * t ) * t, T2AS ) ); + +/* Longitude of the mean ascending node of the lunar orbit on the + ecliptic, measured from the mean equinox of date */ + om = slaDrange ( DAS2R * dmod ( 450160.280 + ( -5.0 * T2AS - 482890.539 + + ( 7.455 + 0.008 * t ) * t ) * t, T2AS ) ); + +/* Multiples of arguments */ + el2 = el + el; + el3 = el2 + el; + elp2 = elp + elp; + f2 = f + f; + f4 = f2 + f2; + d2 = d + d; + d4 = d2 + d2; + om2 = om + om; + +/* Series for the nutation */ + dp = 0.0; + de = 0.0; + + dp += sin ( elp + d ); /* 106 */ + + dp -= sin ( f2 + d4 + om2 ); /* 105 */ + + dp += sin ( el2 + d2 ); /* 104 */ + + dp -= sin ( el - f2 + d2 ); /* 103 */ + + dp -= sin ( el + elp - d2 + om ); /* 102 */ + + dp -= sin ( - elp + f2 + om ); /* 101 */ + + dp -= sin ( el - f2 - d2 ); /* 100 */ + + dp -= sin ( elp + d2 ); /* 99 */ + + dp -= sin ( f2 - d + om2 ); /* 98 */ + + dp -= sin ( - f2 + om ); /* 97 */ + + dp += sin ( - el - elp + d2 + om ); /* 96 */ + + dp += sin ( elp + f2 + om ); /* 95 */ + + dp -= sin ( el + f2 - d2 ); /* 94 */ + + dp += sin ( el3 + f2 - d2 + om2 ); /* 93 */ + + dp += sin ( f4 - d2 + om2 ); /* 92 */ + + dp -= sin ( el + d2 + om ); /* 91 */ + + dp -= sin ( el2 + f2 + d2 + om2 ); /* 90 */ + + a = el2 + f2 - d2 + om; /* 89 */ + dp += sin ( a ); + de -= cos ( a ); + + dp += sin ( el - elp - d2 ); /* 88 */ + + dp += sin ( - el + f4 + om2 ); /* 87 */ + + a = - el2 + f2 + d4 + om2; /* 86 */ + dp -= sin ( a ); + de += cos ( a ); + + a = el + f2 + d2 + om; /* 85 */ + dp -= sin ( a ); + de += cos ( a ); + + a = el + elp + f2 - d2 + om2; /* 84 */ + dp += sin ( a ); + de -= cos ( a ); + + dp -= sin ( el2 - d4 ); /* 83 */ + + a = - el + f2 + d4 + om2; /* 82 */ + dp -= 2.0 * sin ( a ); + de += cos ( a ); + + a = - el2 + f2 + d2 + om2; /* 81 */ + dp += sin ( a ); + de = de - cos ( a ); + + dp -= sin ( el - d4 ); /* 80 */ + + a = - el + om2; /* 79 */ + dp += sin ( a ); + de = de - cos ( a ); + + a = f2 + d + om2; /* 78 */ + dp += 2.0 * sin ( a ); + de = de - cos ( a ); + + dp += 2.0 * sin ( el3 ); /* 77 */ + + a = el + om2; /* 76 */ + dp -= 2.0 * sin ( a ); + de += cos ( a ); + + a = el2 + om; /* 75 */ + dp += 2.0 * sin ( a ); + de -= cos ( a ); + + a = - el + f2 - d2 + om; /* 74 */ + dp -= 2.0 * sin ( a ); + de += cos ( a ); + + a = el + elp + f2 + om2; /* 73 */ + dp += 2.0 * sin ( a ); + de = de - cos ( a ); + + a = - elp + f2 + d2 + om2; /* 72 */ + dp -= 3.0 * sin ( a ); + de += cos ( a ); + + a = el3 + f2 + om2; /* 71 */ + dp -= 3.0 * sin ( a ); + de += cos ( a ); + + a = - el2 + om; /* 70 */ + dp -= 2.0 * sin ( a ); + de += cos ( a ); + + a = - el - elp + f2 + d2 + om2; /* 69 */ + dp -= 3.0 * sin ( a ); + de += cos ( a ); + + a = el - elp + f2 + om2; /* 68 */ + dp -= 3.0 * sin ( a ); + de += cos ( a ); + + dp += 3.0 * sin ( el + f2 ); /* 67 */ + + dp -= 3.0 * sin ( el + elp ); /* 66 */ + + dp -= 4.0 * sin ( d ); /* 65 */ + + dp += 4.0 * sin ( el - f2 ); /* 64 */ + + dp -= 4.0 * sin ( elp - d2 ); /* 63 */ + + a = el2 + f2 + om; /* 62 */ + dp -= 5.0 * sin ( a ); + de += 3.0 * cos ( a ); + + dp += 5.0 * sin ( el - elp ); /* 61 */ + + a = - d2 + om; /* 60 */ + dp -= 5.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = el + f2 - d2 + om; /* 59 */ + dp += 6.0 * sin ( a ); + de -= 3.0 * cos ( a ); + + a = f2 + d2 + om; /* 58 */ + dp -= 7.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = d2 + om; /* 57 */ + dp -= 6.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = el2 + f2 - d2 + om2; /* 56 */ + dp += 6.0 * sin ( a ); + de -= 3.0 * cos ( a ); + + dp += 6.0 * sin ( el + d2); /* 55 */ + + a = el + f2 + d2 + om2; /* 54 */ + dp -= 8.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = - elp + f2 + om2; /* 53 */ + dp -= 7.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = elp + f2 + om2; /* 52 */ + dp += 7.0 * sin ( a ); + de -= 3.0 * cos ( a ); + + dp -= 7.0 * sin ( el + elp - d2 ); /* 51 */ + + a = - el + f2 + d2 + om; /* 50 */ + dp -= 10.0 * sin ( a ); + de += 5.0 * cos ( a ); + + a = el - d2 + om; /* 49 */ + dp -= 13.0 * sin ( a ); + de += 7.0 * cos ( a ); + + a = - el + d2 + om; /* 48 */ + dp += 16.0 * sin ( a ); + de -= 8.0 * cos ( a ); + + a = - el + f2 + om; /* 47 */ + dp += 21.0 * sin ( a ); + de -= 10.0 * cos ( a ); + + dp += 26.0 * sin ( f2 ); /* 46 */ + de -= cos( f2 ); + + a = el2 + f2 + om2; /* 45 */ + dp -= 31.0 * sin ( a ); + de += 13.0 * cos ( a ); + + a = el + f2 - d2 + om2; /* 44 */ + dp += 29.0 * sin ( a ); + de -= 12.0 * cos ( a ); + + dp += 29.0 * sin ( el2 ); /* 43 */ + de -= cos( el2 ); + + a = f2 + d2 + om2; /* 42 */ + dp -= 38.0 * sin ( a ); + de += 16.0 * cos ( a ); + + a = el + f2 + om; /* 41 */ + dp -= 51.0 * sin ( a ); + de += 27.0 * cos ( a ); + + a = - el + f2 + d2 + om2; /* 40 */ + dp -= 59.0 * sin ( a ); + de += 26.0 * cos ( a ); + + a = - el + om; /* 39 */ + dp += ( - 58.0 - 0.1 * t ) * sin ( a ); + de += 32.0 * cos ( a ); + + a = el + om; /* 38 */ + dp += ( 63.0 + 0.1 * t ) * sin ( a ); + de -= 33.0 * cos ( a ); + + dp += 63.0 * sin ( d2 ); /* 37 */ + de -= 2.0 * cos( d2 ); + + a = - el + f2 + om2; /* 36 */ + dp += 123.0 * sin ( a ); + de -= 53.0 * cos ( a ); + + a = el - d2; /* 35 */ + dp -= 158.0 * sin ( a ); + de -= cos ( a ); + + a = el + f2 + om2; /* 34 */ + dp -= 301.0 * sin ( a ); + de += ( 129.0 - 0.1 * t ) * cos ( a ); + + a = f2 + om; /* 33 */ + dp += ( - 386.0 - 0.4 * t ) * sin ( a ); + de += 200.0 * cos ( a ); + + dp += ( 712.0 + 0.1 * t ) * sin ( el ); /* 32 */ + de -= 7.0 * cos( el ); + + a = f2 + om2; /* 31 */ + dp += ( -2274.0 - 0.2 * t ) * sin ( a ); + de += ( 977.0 - 0.5 * t ) * cos ( a ); + + dp -= sin ( elp + f2 - d2 ); /* 30 */ + + dp += sin ( - el + d + om ); /* 29 */ + + dp += sin ( elp + om2 ); /* 28 */ + + dp -= sin ( elp - f2 + d2 ); /* 27 */ + + dp += sin ( - f2 + d2 + om ); /* 26 */ + + dp += sin ( el2 + elp - d2 ); /* 25 */ + + dp -= 4.0 * sin ( el - d ); /* 24 */ + + a = elp + f2 - d2 + om; /* 23 */ + dp += 4.0 * sin ( a ); + de -= 2.0 * cos ( a ); + + a = el2 - d2 + om; /* 22 */ + dp += 4.0 * sin ( a ); + de -= 2.0 * cos ( a ); + + a = - elp + f2 - d2 + om; /* 21 */ + dp -= 5.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = - el2 + d2 + om; /* 20 */ + dp -= 6.0 * sin ( a ); + de += 3.0 * cos ( a ); + + a = - elp + om; /* 19 */ + dp -= 12.0 * sin ( a ); + de += 6.0 * cos ( a ); + + a = elp2 + f2 - d2 + om2; /* 18 */ + dp += ( - 16.0 + 0.1 * t) * sin ( a ); + de += 7.0 * cos ( a ); + + a = elp + om; /* 17 */ + dp -= 15.0 * sin ( a ); + de += 9.0 * cos ( a ); + + dp += ( 17.0 - 0.1 * t ) * sin ( elp2 ); /* 16 */ + + dp -= 22.0 * sin ( f2 - d2 ); /* 15 */ + + a = el2 - d2; /* 14 */ + dp += 48.0 * sin ( a ); + de += cos ( a ); + + a = f2 - d2 + om; /* 13 */ + dp += ( 129.0 + 0.1 * t ) * sin ( a ); + de -= 70.0 * cos ( a ); + + a = - elp + f2 - d2 + om2; /* 12 */ + dp += ( 217.0 - 0.5 * t ) * sin ( a ); + de += ( -95.0 + 0.3 * t ) * cos ( a ); + + a = elp + f2 - d2 + om2; /* 11 */ + dp += ( - 517.0 + 1.2 * t ) * sin ( a ); + de += ( 224.0 - 0.6 * t ) * cos ( a ); + + dp += ( 1426.0 - 3.4 * t ) * sin ( elp ); /* 10 */ + de += ( 54.0 - 0.1 * t) * cos ( elp ); + + a = f2 - d2 + om2; /* 9 */ + dp += ( - 13187.0 - 1.6 * t ) * sin ( a ); + de += ( 5736.0 - 3.1 * t ) * cos ( a ); + + dp += sin ( el2 - f2 + om ); /* 8 */ + + a = - elp2 + f2 - d2 + om; /* 7 */ + dp -= 2.0 * sin ( a ); + de += cos ( a ); + + dp -= 3.0 * sin ( el - elp - d ); /* 6 */ + + a = - el2 + f2 + om2; /* 5 */ + dp -= 3.0 * sin ( a ); + de += cos ( a ); + + dp += 11.0 * sin ( el2 - f2 ); /* 4 */ + + a = - el2 + f2 + om; /* 3 */ + dp += 46.0 * sin ( a ); + de -= 24.0 * cos ( a ); + + dp += ( 2062.0 + 0.2 * t ) * sin ( om2 ); /* 2 */ + de += ( - 895.0 + 0.5 * t ) * cos ( om2 ); + + dp += ( - 171996.0 - 174.2 * t) * sin ( om ); /* 1 */ + de += ( 92025.0 + 8.9 * t ) * cos ( om ); + +/* Convert results to radians */ + *dpsi = dp * U2R; + *deps = de * U2R; + +/* Mean obliquity */ + *eps0 = DAS2R * ( 84381.448 + + ( - 46.8150 + + ( - 0.00059 + 0.001813 * t ) * t ) * t ); +} Index: trunk/MagicSoft/slalib/oap.c =================================================================== --- trunk/MagicSoft/slalib/oap.c (revision 731) +++ trunk/MagicSoft/slalib/oap.c (revision 731) @@ -0,0 +1,168 @@ +#include "slalib.h" +#include "slamac.h" +void slaOap ( char *type, double ob1, double ob2, double date, + double dut, double elongm, double phim, double hm, + double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, + double *rap, double *dap ) +/* +** - - - - - - - +** s l a O a p +** - - - - - - - +** +** Observed to apparent place +** +** Given: +** type c*(*) type of coordinates - 'R', 'H' or 'A' (see below) +** ob1 d observed Az, HA or RA (radians; Az is N=0,E=90) +** ob2 d observed ZD or Dec (radians) +** date d UTC date/time (modified Julian Date, JD-2400000.5) +** dut d delta UT: UT1-UTC (UTC seconds) +** elongm d mean longitude of the observer (radians, east +ve) +** phim d mean geodetic latitude of the observer (radians) +** hm d observer's height above sea level (metres) +** xp d polar motion x-coordinate (radians) +** yp d polar motion y-coordinate (radians) +** tdk d local ambient temperature (DegK; std=273.155) +** pmb d local atmospheric pressure (mB; std=1013.25) +** rh d local relative humidity (in the range 0.0-1.0) +** wl d effective wavelength (micron, e.g. 0.55) +** tlr d tropospheric lapse rate (DegK/metre, e.g. 0.0065) +** +** Returned: +** rap d geocentric apparent right ascension +** dap d geocentric apparent declination +** +** Notes: +** +** 1) Only the first character of the type argument is significant. +** 'R' or 'r' indicates that obs1 and obs2 are the observed Right +** Ascension and Declination; 'H' or 'h' indicates that they are +** Hour Angle (West +ve) and Declination; anything else ('A' or +** 'a' is recommended) indicates that obs1 and obs2 are Azimuth +** (North zero, East is 90 deg) and zenith distance. (Zenith +** distance is used rather than elevation in order to reflect the +** fact that no allowance is made for depression of the horizon.) +** +** 2) The accuracy of the result is limited by the corrections for +** refraction. Providing the meteorological parameters are +** known accurately and there are no gross local effects, the +** predicted apparent RA,Dec should be within about 0.1 arcsec +** for a zenith distance of less than 70 degrees. Even at a +** topocentric zenith distance of 90 degrees, the accuracy in +** elevation should be better than 1 arcmin; useful results +** are available for a further 3 degrees, beyond which the +** slaRefro routine returns a fixed value of the refraction. +** The complementary routines slaAop (or slaAopqk) and slaOap +** (or slaOapqk) are self-consistent to better than 1 micro- +** arcsecond all over the celestial sphere. +** +** 3) It is advisable to take great care with units, as even +** unlikely values of the input parameters are accepted and +** processed in accordance with the models used. +** +** 4) "Observed" Az,El means the position that would be seen by a +** perfect theodolite located at the observer. This is +** related to the observed HA,Dec via the standard rotation, using +** the geodetic latitude (corrected for polar motion), while the +** observed HA and RA are related simply through the local +** apparent ST. "Observed" RA,Dec or HA,Dec thus means the +** position that would be seen by a perfect equatorial located +** at the observer and with its polar axis aligned to the +** Earth's axis of rotation (n.b. not to the refracted pole). +** By removing from the observed place the effects of +** atmospheric refraction and diurnal aberration, the +** geocentric apparent RA,Dec is obtained. +** +** 5) Frequently, mean rather than apparent RA,Dec will be required, +** in which case further transformations will be necessary. The +** slaAMP etc routines will convert the apparent RA,Dec produced +** by the present routine into an "FK5" (J2000) mean place, by +** allowing for the Sun's gravitational lens effect, annual +** aberration, nutation and precession. Should "FK4" (1950) +** coordinates be needed, the routines slaFk425 etc will also +** need to be applied. +** +** 6) To convert to apparent RA,Dec the coordinates read from a +** real telescope, corrections would have to be applied for +** encoder zero points, gear and encoder errors, tube flexure, +** the position of the rotator axis and the pointing axis +** relative to it, non-perpendicularity between the mounting +** axes, and finally for the tilt of the azimuth or polar axis +** of the mounting (with appropriate corrections for mount +** flexures). Some telescopes would, of course, exhibit other +** properties which would need to be accounted for at the +** appropriate point in the sequence. +** +** 7) The star-independent apparent-to-observed-place parameters +** in aoprms may be computed by means of the slaAoppa routine. +** If nothing has changed significantly except the time, the +** slaAoppat routine may be used to perform the requisite +** partial recomputation of aoprms. +** +** 8) The date argument is UTC expressed as an MJD. This is, +** strictly speaking, wrong, because of leap seconds. However, +** as long as the delta UT and the UTC are consistent there +** are no difficulties, except during a leap second. In this +** case, the start of the 61st second of the final minute should +** begin a new MJD day and the old pre-leap delta UT should +** continue to be used. As the 61st second completes, the MJD +** should revert to the start of the day as, simultaneously, +** the delta UTC changes by one second to its post-leap new value. +** +** 9) The delta UT (UT1-UTC) is tabulated in IERS circulars and +** elsewhere. It increases by exactly one second at the end of +** each UTC leap second, introduced in order to keep delta UT +** within +/- 0.9 seconds. +** +** 10) IMPORTANT -- TAKE CARE WITH THE LONGITUDE SIGN CONVENTION. +** The longitude required by the present routine is east-positive, +** in accordance with geographical convention (and right-handed). +** In particular, note that the longitudes returned by the +** slaObs routine are west-positive, following astronomical +** usage, and must be reversed in sign before use in the present +** routine. +** +** 11) The polar coordinates xp,yp can be obtained from IERS +** circulars and equivalent publications. The maximum amplitude +** is about 0.3 arcseconds. If xp,yp values are unavailable, +** use xp=yp=0.0. See page B60 of the 1988 Astronomical Almanac +** for a definition of the two angles. +** +** 12) The height above sea level of the observing station, hm, +** can be obtained from the Astronomical Almanac (Section J +** in the 1988 edition), or via the routine slaObs. If p, +** the pressure in millibars, is available, an adequate +** estimate of hm can be obtained from the expression +** +** hm = -29.3 * tsl * log ( p / 1013.25 ); +** +** where tsl is the approximate sea-level air temperature +** in deg K (See Astrophysical Quantities, C.W.Allen, +** 3rd edition, section 52). Similarly, if the pressure p +** is not known, it can be estimated from the height of the +** observing station, hm as follows: +** +** p = 1013.25 * exp ( -hm / ( 29.3 * tsl ) ); +** +** Note, however, that the refraction is proportional to the +** pressure and that an accurate p value is important for +** precise work. +** +** 13) The azimuths etc used by the present routine are with respect +** to the celestial pole. Corrections from the terrestrial pole +** can be computed using slaPolmo. +** +** Called: slaAoppa, slaOapqk +** +** Last revision: 6 September 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double aoprms[14]; + + slaAoppa ( date, dut, elongm, phim, hm, xp, yp, tdk, + pmb, rh, wl, tlr, aoprms ); + slaOapqk ( type, ob1, ob2, aoprms, rap, dap ); +} Index: trunk/MagicSoft/slalib/oapqk.c =================================================================== --- trunk/MagicSoft/slalib/oapqk.c (revision 731) +++ trunk/MagicSoft/slalib/oapqk.c (revision 731) @@ -0,0 +1,223 @@ +#include "slalib.h" +#include "slamac.h" +void slaOapqk ( char *type, double ob1, double ob2, + double aoprms[14], double *rap, double *dap ) +/* +** - - - - - - - - - +** s l a O a p q k +** - - - - - - - - - +** +** Quick observed to apparent place. +** +** Given: +** type char type of coordinates - 'r', 'h' or 'a' (see below) +** ob1 double observed az, HA or RA (radians; az is n=0,e=90) +** ob2 double observed ZD or Dec (radians) +** aoprms double[14] star-independent apparent-to-observed parameters: +** +** (0) geodetic latitude (radians) +** (1,2) sine and cosine of geodetic latitude +** (3) magnitude of diurnal aberration vector +** (4) height (hm) +** (5) ambient temperature (t) +** (6) pressure (p) +** (7) relative humidity (rh) +** (8) wavelength (wl) +** (9) lapse rate (tlr) +** (10,11) refraction constants a and b (radians) +** (12) longitude + eqn of equinoxes + sidereal DUT (radians) +** (13) local apparent sidereal time (radians) +** +** Returned: +** *rap double geocentric apparent right ascension +** *dap double geocentric apparent declination +** +** Notes: +** +** 1) Only the first character of the type argument is significant. +** 'R' or 'r' indicates that obs1 and obs2 are the observed right +** ascension and declination; 'H' or 'h' indicates that they are +** hour angle (west +ve) and declination; anything else ('A' or +** 'a' is recommended) indicates that obs1 and obs2 are azimuth +** (north zero, east is 90 deg) and zenith distance. (Zenith +** distance is used rather than elevation in order to reflect the +** fact that no allowance is made for depression of the horizon.) +** +** 2) The accuracy of the result is limited by the corrections for +** refraction. Providing the meteorological parameters are +** known accurately and there are no gross local effects, the +** predicted apparent RA,Dec should be within about 0.1 arcsec. +** Even at a topocentric zenith distance of 90 degrees, the +** accuracy in elevation should be better than 1 arcmin; useful +** results are available for a further 3 degrees, beyond which +** the slaRefro routine returns a fixed value of the refraction. +** the complementary routines slaAop (or slaAopqk) and slaOap +** (or slaOapqk) are self-consistent to better than 1 micro- +** arcsecond all over the celestial sphere. +** +** 3) It is advisable to take great care with units, as even +** unlikely values of the input parameters are accepted and +** processed in accordance with the models used. +** +** 5) "Observed" az,el means the position that would be seen by a +** perfect theodolite located at the observer. This is +** related to the observed HA,Dec via the standard rotation, using +** the geodetic latitude (corrected for polar motion), while the +** observed HA and RA are related simply through the local +** apparent ST. "Observed" RA,Dec or HA,Dec thus means the +** position that would be seen by a perfect equatorial located +** at the observer and with its polar axis aligned to the +** Earth's axis of rotation (n.b. not to the refracted pole). +** by removing from the observed place the effects of +** atmospheric refraction and diurnal aberration, the +** geocentric apparent RA,Dec is obtained. +** +** 5) Frequently, mean rather than apparent RA,Dec will be required, +** in which case further transformations will be necessary. The +** slaAmp etc routines will convert the apparent RA,Dec produced +** by the present routine into an "FK5" (J2000) mean place, by +** allowing for the Sun's gravitational lens effect, annual +** aberration, nutation and precession. Should "FK4" (1950) +** coordinates be needed, the routines slaFk524 etc will also +** need to be applied. +** +** 6) To convert to apparent RA,Dec the coordinates read from a +** real telescope, corrections would have to be applied for +** encoder zero points, gear and encoder errors, tube flexure, +** the position of the rotator axis and the pointing axis +** relative to it, non-perpendicularity between the mounting +** axes, and finally for the tilt of the azimuth or polar axis +** of the mounting (with appropriate corrections for mount +** flexures). Some telescopes would, of course, exhibit other +** properties which would need to be accounted for at the +** appropriate point in the sequence. +** +** 7) The star-independent apparent-to-observed-place parameters +** in aoprms may be computed by means of the slaAoppa routine. +** If nothing has changed significantly except the time, the +** slaAoppat routine may be used to perform the requisite +** partial recomputation of aoprms. +** +** 8) The azimuths etc used by the present routine are with respect +** to the celestial pole. Corrections from the terrestrial pole +** can be computed using slaPolmo. +** +** Called: slaDcs2c, slaDcc2s, slaRefro, slaDranrm +** +** Last revision: 3 February 2000 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + +/* +** Breakpoint for fast/slow refraction algorithm: +** ZD greater than arctan(4), (see slaRefco routine) +** or vector z less than cosine(arctan(z)) = 1/sqrt(17) +*/ + static double zbreak = 0.242535625; + + char c; + double c1, c2, sphi, cphi, st, ce, xaeo, yaeo, zaeo, v[3], + xmhdo, ymhdo, zmhdo, az, sz, zdo, tz, dref, zdt, + xaet, yaet, zaet, xmhda, ymhda, zmhda, diurab, f, hma; + + +/* Coordinate type */ + c = *type; + +/* Coordinates */ + c1 = ob1; + c2 = ob2; + +/* Sin, cos of latitude */ + sphi = aoprms[1]; + cphi = aoprms[2]; + +/* Local apparent sidereal time */ + st = aoprms[13]; + +/* Standardize coordinate type */ + if ( c == 'r' || c == 'R' ) { + c = 'R'; + } else if ( c == 'h' || c == 'H' ) { + c = 'H'; + } else { + c = 'A'; + } + +/* If az,ZD convert to Cartesian (S=0,E=90) */ + if ( c == 'A' ) { + ce = sin ( c2 ); + xaeo = - cos ( c1 ) * ce; + yaeo = sin ( c1 ) * ce; + zaeo = cos ( c2 ); + } else { + + /* If RA,Dec convert to HA,Dec */ + if ( c == 'R' ) { + c1 = st - c1; + } + + /* To Cartesian -HA,Dec */ + slaDcs2c ( -c1, c2, v ); + xmhdo = v[0]; + ymhdo = v[1]; + zmhdo = v[2]; + + /* To Cartesian az,el (S=0,E=90) */ + xaeo = sphi * xmhdo - cphi * zmhdo; + yaeo = ymhdo; + zaeo = cphi * xmhdo + sphi * zmhdo; + } + +/* Azimuth (S=0,E=90) */ + az = xaeo != 0.0 && yaeo != 0.0 ? atan2 ( yaeo, xaeo ) : 0.0; + +/* Sine of observed ZD, and observed ZD */ + sz = sqrt ( xaeo * xaeo + yaeo * yaeo ); + zdo = atan2 ( sz, zaeo ); + +/* +** Refraction +** ---------- +*/ + +/* Large zenith distance? */ + if ( zaeo >= zbreak ) { + + /* Fast algorithm using two constant model */ + tz = sz / zaeo; + dref = ( aoprms[10] + aoprms[11] * tz * tz ) * tz; + } else { + + /* Rigorous algorithm for large ZD */ + slaRefro ( zdo, aoprms[4], aoprms[5], aoprms[6], aoprms[7], + aoprms[8], aoprms[0], aoprms[9], 1e-8, &dref ); + } + zdt = zdo + dref; + +/* To Cartesian az,ZD */ + ce = sin ( zdt ); + xaet = cos ( az ) * ce; + yaet = sin ( az ) * ce; + zaet = cos ( zdt ); + +/* Cartesian az,ZD to Cartesian -HA,Dec */ + xmhda = sphi * xaet + cphi * zaet; + ymhda = yaet; + zmhda = - cphi * xaet + sphi * zaet; + +/* Diurnal aberration */ + diurab = -aoprms[3]; + f = 1.0 - diurab * ymhda; + v[0] = f * xmhda; + v[1] = f * ( ymhda + diurab ); + v[2] = f * zmhda; + +/* To spherical -HA,Dec */ + slaDcc2s ( v, &hma, dap ); + +/* Right ascension */ + *rap = slaDranrm ( st + hma ); +} Index: trunk/MagicSoft/slalib/obs.c =================================================================== --- trunk/MagicSoft/slalib/obs.c (revision 731) +++ trunk/MagicSoft/slalib/obs.c (revision 731) @@ -0,0 +1,867 @@ +#include "slalib.h" +#include "slamac.h" +#include +void slaObs ( int n, char *c, char *name, double *w, double *p, double *h ) +/* +** - - - - - - - +** s l a O b s +** - - - - - - - +** +** Parameters of selected groundbased observing stations. +** +** Given: +** n int number specifying observing station +** +** Either given or returned +** *c char identifier specifying observing station +** +** Returned: +** *name char name of specified observing station +** *w double longitude (radians, West +ve) +** *p double geodetic latitude (radians, North +ve) +** *h double height above sea level (metres) +** +** Notes: +** +** Station identifiers may be up to 10 characters long +** (plus string terminator), and station names may be up to +** 40 characters long (plus string terminator). Leading or +** trailing spaces are not supported. +** +** c and n are alternative ways of specifying the observing +** station. The c option, which is the most generally useful, +** may be selected by specifying an n value of zero or less. +** If n is 1 or more, the parameters of the nth station +** in the currently supported list are interrogated (n=1 +** meaning the first station in the list), and the station +** identifier c is returned as well as name, w, p and h. +** +** If the station parameters are not available, either because +** the station identifier c is not recognized, or because an +** n value greater than the number of stations supported is +** given, a name of "?" is returned and c, w, p and h are left +** in their current states. +** +** Programs can obtain a list of all currently supported +** stations by calling the routine repeatedly, with n=1,2,3... +** When name="?" is seen, the list of stations has been +** exhausted. +** +** Station numbers, identifiers, names and other details are +** subject to change and should not be hardwired into +** application programs. +** +** All station identifiers c are uppercase only; lowercase +** characters must be converted to uppercase by the calling +** program. The station names returned may contain both upper- +** and lowercase. All characters up to the first space are +** checked; thus an abbreviated ID will return the parameters +** for the first station in the list which matches the +** abbreviation supplied, and no station in the list will ever +** contain embedded spaces. c must not have leading spaces. +** +** IMPORTANT -- BEWARE OF THE LONGITUDE SIGN CONVENTION. The +** longitude returned by slaObs is west-positive in accordance +** with astronomical usage. However, this sign convention is +** left-handed and is the opposite of the one used by geographers; +** elsewhere in slalib the preferable east-positive convention is +** used. In particular, note that for use in slaAop, slaAoppa +** and slaOap the sign of the longitude must be reversed. +** +** Users are urged to inform the author of any improvements +** they would like to see made. For example: +** +** typographical corrections +** more accurate parameters +** better station identifiers or names +** additional stations +** +** Defined in slamac.h: DAS2R +** +** Last revision: 13 December 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define WEST(id,iam,as) ( DAS2R * \ + ( (double) (60L * ( (long) (60 * (id)) +(iam) ) ) + (as) ) ) +#define NORTH(id,iam,as) ( WEST(id,iam,as) ) +#define EAST(id,iam,as) ( -WEST(id,iam,as) ) +#define SOUTH(id,iam,as) ( -WEST(id,iam,as) ) + +{ +/* ------------------- Table of station parameters ------------------- */ + + static struct station { + char *id; /* identifier */ + char *na; /* name */ + double wlong; /* longitude (west) */ + double phi; /* latitude */ + double hm; /* height ASL (metres) */ + } statab[] = { + +/* AAT (Observer's Guide) */ + { + "AAT", + "Anglo-Australian 3.9m Telescope", + EAST(149, 3,57.91), + SOUTH(31,16,37.34), + 1164.0 + }, + +/* WHT (Gemini, April 1987) */ + { + "LPO4.2", + "William Herschel 4.2m Telescope", + WEST(17,52,53.9), + NORTH(28,45,38.1), + 2332.0 + }, + +/* INT (Gemini, April 1987) */ + { + "LPO2.5", + "Isaac Newton 2.5m Telescope", + WEST(17,52,39.5), + NORTH(28,45,43.2), + 2336.0 + }, + +/* JKT (Gemini, April 1987) */ + { + "LPO1", + "Jacobus Kapteyn 1m Telescope", + WEST(17,52,41.2), + NORTH(28,45,39.9), + 2364.0 + }, + +/* Lick 120" (1984 Almanac) */ + { + "LICK120", + "Lick 120 inch", + WEST(121,38, 9.9), + NORTH(37,20,35.2), + 1290.0 + }, + +/* MMT 6.5m conversion (MMT Observatory website) */ + { + "MMT", + "MMT 6.5m, Mt Hopkins", + WEST(110,53, 4.4), + NORTH(31,41,19.6), + 2608.0 + }, + +/* Victoria B.C. 1.85m (1984 Almanac) */ + { + "VICBC", + "Victoria B.C. 1.85 metre", + WEST(123,25, 1.18), + NORTH(48,31,11.9), + 238.0 + }, + +/* Las Campanas (1983 Almanac) */ + { + "DUPONT", + "Du Pont 2.5m Telescope, Las Campanas", + WEST(70,42,9.), + SOUTH(29, 0,11.), + 2280.0 + }, + +/* Mt Hopkins 1.5m (1983 Almanac) */ + { + "MTHOP1.5", + "Mt Hopkins 1.5 metre", + WEST(110,52,39.00), + NORTH(31,40,51.4), + 2344.0 + }, + +/* Mt Stromlo 74" (1983 Almanac) */ + { + "STROMLO74", + "Mount Stromlo 74 inch", + EAST(149, 0,27.59), + SOUTH(35,19,14.3), + 767.0 + }, + +/* ANU 2.3m, SSO (Gary Hovey) */ + { + "ANU2.3", + "Siding Spring 2.3 metre", + EAST(149, 3,40.3), + SOUTH(31,16,24.1), + 1149.0 + }, + +/* Greenbank 140' (1983 Almanac) */ + { + "GBVA140", + "Greenbank 140 foot", + WEST(79,50, 9.61), + NORTH(38,26,15.4), + 881.0 + }, + +/* Cerro Tololo 4m (1982 Almanac) */ + { + "TOLOLO4M", + "Cerro Tololo 4 metre", + WEST(70,48,53.6), + SOUTH(30, 9,57.8), + 2235.0 + }, + +/* Cerro Tololo 1.5m (1982 Almanac) */ + { + "TOLOLO1.5M", + "Cerro Tololo 1.5 metre", + WEST(70,48,54.5), + SOUTH(30, 9,56.3), + 2225.0 + }, + +/* Tidbinbilla 64m (1982 Almanac) */ + { + "TIDBINBLA", + "Tidbinbilla 64 metre", + EAST(148,58,48.20), + SOUTH(35,24,14.3), + 670.0 + }, + +/* Bloemfontein 1.52m (1981 Almanac) */ + { + "BLOEMF", + "Bloemfontein 1.52 metre", + EAST(26,24,18.), + SOUTH(29, 2,18.), + 1387.0 + }, + +/* Bosque Alegre 1.54m (1981 Almanac) */ + { + "BOSQALEGRE", + "Bosque Alegre 1.54 metre", + WEST(64,32,48.0), + SOUTH(31,35,53.), + 1250.0 + }, + +/* USNO 61" astrographic reflector, Flagstaff (1981 Almanac) */ + { + "FLAGSTF61", + "USNO 61 inch astrograph, Flagstaff", + WEST(111,44,23.6), + NORTH(35,11, 2.5), + 2316.0 + }, + +/* Lowell 72" (1981 Almanac) */ + { + "LOWELL72", + "Perkins 72 inch, Lowell", + WEST(111,32, 9.3), + NORTH(35, 5,48.6), + 2198.0 + }, + +/* Harvard 1.55m (1981 Almanac) */ + { + "HARVARD", + "Harvard College Observatory 1.55m", + WEST(71,33,29.32), + NORTH(42,30,19.0), + 185.0 + }, + +/* Okayama 1.88m (1981 Almanac) */ + { + "OKAYAMA", + "Okayama 1.88 metre", + EAST(133,35,47.29), + NORTH(34,34,26.1), + 372.0 + }, + +/* Kitt Peak Mayall 4m (1981 Almanac) */ + { + "KPNO158", + "Kitt Peak 158 inch", + WEST(111,35,57.61), + NORTH(31,57,50.3), + 2120.0 + }, + +/* Kitt Peak 90 inch (1981 Almanac) */ + { + "KPNO90", + "Kitt Peak 90 inch", + WEST(111,35,58.24), + NORTH(31,57,46.9), + 2071.0 + }, + +/* Kitt Peak 84 inch (1981 Almanac) */ + { + "KPNO84", + "Kitt Peak 84 inch", + WEST(111,35,51.56), + NORTH(31,57,29.2), + 2096.0 + }, + +/* Kitt Peak 36 foot (1981 Almanac) */ + { + "KPNO36FT", + "Kitt Peak 36 foot", + WEST(111,36,51.12), + NORTH(31,57,12.1), + 1939.0 + }, + +/* Kottamia 74" (1981 Almanac) */ + { + "KOTTAMIA", + "Kottamia 74 inch", + EAST(31,49,30.), + NORTH(29,55,54.), + 476.0 + }, + +/* La Silla 3.6m (1981 Almanac) */ + { + "ESO3.6", + "ESO 3.6 metre", + WEST(70,43,36.), + SOUTH(29,15,36.), + 2428.0 + }, + +/* Mauna Kea 88 inch + (IfA website, Richard Wainscoat) */ + { + "MAUNAK88", + "Mauna Kea 88 inch", + WEST(155,28,09.96), + NORTH(19,49,22.77), + 4213.6 + }, + +/* UKIRT + (Ifa website, Richard Wainscoat) */ + { + "UKIRT", + "UK Infra Red Telescope", + WEST(155,28,13.18), + NORTH(19,49,20.75), + 4198.5 + }, + +/* Quebec 1.6m (1981 Almanac) */ + { + "QUEBEC1.6", + "Quebec 1.6 metre", + WEST(71, 9, 9.7), + NORTH(45,27,20.6), + 1114.0 + }, + +/* Mt Ekar 1.82m (1981 Almanac) */ + { + "MTEKAR", + "Mt Ekar 1.82 metre", + EAST(11,34,15.), + NORTH(45,50,48.), + 1365.0 + }, + +/* Mt Lemmon 60" (1981 Almanac) */ + { + "MTLEMMON60", + "Mt Lemmon 60 inch", + WEST(110,42,16.9), + NORTH(32,26,33.9), + 2790.0 + }, + +/* Mt Locke 2.7m (1981 Almanac) */ + { + "MCDONLD2.7", + "McDonald 2.7 metre", + WEST(104, 1,17.60), + NORTH(30,40,17.7), + 2075.0 + }, + +/* Mt Locke 2.1m (1981 Almanac) */ + { + "MCDONLD2.1", + "McDonald 2.1 metre", + WEST(104, 1,20.10), + NORTH(30,40,17.7), + 2075.0 + }, + +/* Palomar 200" (1981 Almanac) */ + { + "PALOMAR200", + "Palomar 200 inch", + WEST(116,51,50.), + NORTH(33,21,22.), + 1706.0 + }, + +/* Palomar 60" (1981 Almanac) */ + { + "PALOMAR60", + "Palomar 60 inch", + WEST(116,51,31.), + NORTH(33,20,56.), + 1706.0 + }, + +/* David Dunlap 74" (1981 Almanac) */ + { + "DUNLAP74", + "David Dunlap 74 inch", + WEST(79,25,20.), + NORTH(43,51,46.), + 244.0 + }, + +/* Haute Provence 1.93m (1981 Almanac) */ + { + "HPROV1.93", + "Haute Provence 1.93 metre", + EAST(5,42,46.75), + NORTH(43,55,53.3), + 665.0 + }, + +/* Haute Provence 1.52m (1981 Almanac) */ + { + "HPROV1.52", + "Haute Provence 1.52 metre", + EAST(5,42,43.82), + NORTH(43,56, 0.2), + 667.0 + }, + +/* San Pedro Martir 83" (1981 Almanac) */ + { + "SANPM83", + "San Pedro Martir 83 inch", + WEST(115,27,47.), + NORTH(31, 2,38.), + 2830.0 + }, + +/* Sutherland 74" (1981 Almanac) */ + { + "SAAO74", + "Sutherland 74 inch", + EAST(20,48,44.3), + SOUTH(32,22,43.4), + 1771.0 + }, + +/* Tautenburg 2m (1981 Almanac) */ + { + "TAUTNBG", + "Tautenburg 2 metre", + EAST(11,42,45.), + NORTH(50,58,51.), + 331.0 + }, + +/* Catalina 61" (1981 Almanac) */ + { + "CATALINA61", + "Catalina 61 inch", + WEST(110,43,55.1), + NORTH(32,25, 0.7), + 2510.0 + }, + +/* Steward 90" (1981 Almanac) */ + { + "STEWARD90", + "Steward 90 inch", + WEST(111,35,58.24), + NORTH(31,57,46.9), + 2071.0 + }, + +/* Russian 6m (1981 Almanac) */ + { + "USSR6", + "USSR 6 metre", + EAST(41,26,30.0), + NORTH(43,39,12.), + 2100.0 + }, + +/* Arecibo 1000' (1981 Almanac) */ + { + "ARECIBO", + "Arecibo 1000 foot", + WEST(66,45,11.1), + NORTH(18,20,36.6), + 496.0 + }, + +/* Cambridge 5km (1981 Almanac) */ + { + "CAMB5KM", + "Cambridge 5km", + EAST(0, 2,37.23), + NORTH(52,10,12.2), + 17.0 + }, + +/* Cambridge 1 mile (1981 Almanac) */ + { + "CAMB1MILE", + "Cambridge 1 mile", + EAST(0, 2,21.64), + NORTH(52, 9,47.3), + 17.0 + }, + +/* Bonn 100m (1981 Almanac) */ + { + "EFFELSBERG", + "Effelsberg 100 metre", + EAST(6,53, 1.5), + NORTH(50,31,28.6), + 366.0 + }, + +/* Greenbank 300' (1981 Almanac - defunct) */ + { + "GBVA300", + "Greenbank 300 foot", + WEST(79,50,56.36), + NORTH(38,25,46.3), + 894.0 + }, + +/* Jodrell Bank Mk 1 (1981 Almanac) */ + { + "JODRELL1", + "Jodrell Bank 250 foot", + WEST(2,18,25.), + NORTH(53,14,10.5), + 78.0 + }, + +/* Australia Telescope Parkes Observatory + (private comm. Peter te Lintel Hekkert) */ + { + "PARKES", + "Parkes 64 metre", + EAST(148,15,44.3591), + SOUTH(32,59,59.8657), + 391.79 + }, + +/* VLA (1981 Almanac) */ + { + "VLA", + "Very Large Array", + WEST(107,37, 3.82), + NORTH(34, 4,43.5), + 2124.0 + }, + +/* Sugar Grove 150' (1981 Almanac) */ + { + "SUGARGROVE", + "Sugar Grove 150 foot", + WEST(79,16,23.), + NORTH(38,31,14.), + 705.0 + }, + +/* Russian 600' (1981 Almanac) */ + { + "USSR600", + "USSR 600 foot", + EAST(41,35,25.5), + NORTH(43,49,32.), + 973.0 + }, + +/* Nobeyama 45 metre mm dish (based on 1981 Almanac entry) */ + { + "NOBEYAMA", + "Nobeyama 45 metre", + EAST(138,29,12.), + NORTH(35,56,19.), + 1350.0 + }, + +/* James Clerk Maxwell 15 metre mm telescope, Mauna Kea + (IfA website, Richard Wainscoat, height from I.Coulson) */ + { + "JCMT", + "JCMT 15 metre", + WEST(155,28,37.20), + NORTH(19,49,22.11), + 4111.0 + }, + +/* ESO 3.5 metre NTT, La Silla (K.Wirenstrand) */ + { + "ESONTT", + "ESO 3.5 metre NTT", + WEST(70,43, 7.), + SOUTH(29,15,30.), + 2377.0 + }, + +/* St Andrews University Observatory (1982 Almanac) */ + { + "ST.ANDREWS", + "St Andrews", + WEST(2,48,52.5), + NORTH(56,20,12.), + 30.0 + }, + +/* Apache Point 3.5 metre (R.Owen) */ + { + "APO3.5", + "Apache Point 3.5m", + WEST(105,49,11.56), + NORTH(32,46,48.96), + 2809.0 + }, + +/* W.M.Keck Observatory, Telescope 1 (site survey) + (private comm. William Lupton) */ + { + "KECK1", + "Keck 10m Telescope #1", + WEST(155,28,28.99), + NORTH(19,49,33.41), + 4160.0 + }, + +/* Tautenberg Schmidt (1983 Almanac) */ + { + "TAUTSCHM", + "Tautenberg 1.34 metre Schmidt", + EAST(11,42,45.0), + NORTH(50,58,51.0), + 331.0 + }, + +/* Palomar Schmidt (1981 Almanac) */ + { + "PALOMAR48", + "Palomar 48-inch Schmidt", + WEST(116,51,32.0), + NORTH(33,21,26.0), + 1706.0 + }, + +/* UK Schmidt, Siding Spring (1983 Almanac) */ + { + "UKST", + "UK 1.2 metre Schmidt, Siding Spring", + EAST(149,04,12.8), + SOUTH(31,16,27.8), + 1145.0 + }, + +/* Kiso Schmidt, Japan (1981 Almanac) */ + { + "KISO", + "Kiso 1.05 metre Schmidt, Japan", + EAST(137,37,42.2), + NORTH(35,47,38.7), + 1130.0 + }, + +/* ESO Schmidt, La Silla (1981 Almanac) */ + { + "ESOSCHM", + "ESO 1 metre Schmidt, La Silla", + WEST(70,43,46.5), + SOUTH(29,15,25.8), + 2347.0 + }, + +/* Australia Telescope Compact Array (WGS84 coordinates of Station 35, + private comm. Mark Calabretta) */ + { + "ATCA", + "Australia Telescope Compact Array", + EAST(149,33, 0.500), + SOUTH(30,18,46.385), + 236.9 + }, + +/* Australia Telescope Mopra Observatory + (private comm. Peter te Lintel Hekkert) */ + { + "MOPRA", + "ATNF Mopra Observatory", + EAST(149, 5,58.732), + SOUTH(31,16, 4.451), + 850.0 + }, + +/* Subaru telescope, Mauna Kea + (IfA website, Richard Wainscoat) */ + { + "SUBARU", + "Subaru 8m telescope", + WEST(155,28,33.67), + NORTH(19,49,31.81), + 4163.0 + }, + +/* Canada-France-Hawaii Telescope, Mauna Kea + (IfA website, Richard Wainscoat) */ + { + "CFHT", + "Canada-France-Hawaii 3.6m Telescope", + WEST(155,28,07.95), + NORTH(19,49,30.91), + 4204.1 + }, + +/* W.M.Keck Observatory, Telescope 2 + (William Lupton, private comm) */ + { + "KECK2", + "Keck 10m Telescope #2", + WEST(155,28,27.24), + NORTH(19,49,35.62), + 4159.6 + }, + +/* Gemini North, Mauna Kea + (IfA website, Richard Wainscoat) */ + { + "GEMININ", + "Gemini North 8-m telescope", + WEST(155,28,08.57), + NORTH(19,49,25.69), + 4213.4 + }, + +/* Five College Radio Astronomy Observatory + (Tim Jenness, private comm) */ + { + "FCRAO", + "Five College Radio Astronomy Obs", + WEST(72,20,42.0), + NORTH(42,23,30.0), + 314.0 + }, + +/* NASA Infra Red Telescope Facility + (IfA website, Richard Wainscoat) */ + { + "IRTF", + "NASA IR Telescope Facility, Mauna Kea", + WEST(155,28,19.20), + NORTH(19,49,34.39), + 4168.1 + }, + +/* Caltech Submillimeter Observatory + (IfA website, Richard Wainscoat; height estimated) */ + { + "CSO", + "Caltech Sub-mm Observatory, Mauna Kea", + WEST(155,28,31.79), + NORTH(19,49,20.78), + 4080.0 + }, + +/* ESO VLT, UT1 + (ESO website, VLT Whitebook Chapter 2) */ + { + "VLT1", + "ESO VLT, Paranal, Chile: UT1", + WEST(70,24,11.642), + SOUTH(24,37,33.117), + 2635.43 + }, + +/* ESO VLT, UT2 + (ESO website, VLT Whitebook Chapter 2) */ + { + "VLT2", + "ESO VLT, Paranal, Chile: UT2", + WEST(70,24,10.855), + SOUTH(24,37,31.465), + 2635.43 + }, + +/* ESO VLT, UT3 + (ESO website, VLT Whitebook Chapter 2) */ + { + "VLT3", + "ESO VLT, Paranal, Chile: UT3", + WEST(70,24,09.896), + SOUTH(24,37,30.300), + 2635.43 + }, + +/* ESO VLT, UT4 + (ESO website, VLT Whitebook Chapter 2) */ + { + "VLT4", + "ESO VLT, Paranal, Chile: UT4", + WEST(70,24,08.000), + SOUTH(24,37,31.000), + 2635.43 + } + }; + + static int NMAX = ( sizeof statab / sizeof ( struct station ) ); + +/* ------------------------------------------------------------------- */ + + int m; + + +/* Station specified by number or identifier? */ + if ( n > 0 ) { + + /* Station specified by number */ + m = n - 1; + if ( m < NMAX ) { + strcpy ( c, statab[m].id ); + } + } else { + + /* Station specified by identifier: determine corresponding number */ + for ( m = 0; m < NMAX; m++ ) { + if ( ! strncmp ( c, statab[m].id, 10 ) ) { + break; + } + } + } + +/* Return parameters of mth station */ + if ( m < NMAX ) { + strncpy ( name, statab[m].na, 40 ); + *w = statab[m].wlong; + *p = statab[m].phi; + *h = statab[m].hm; + } else { + strcpy ( name, "?" ); + } +} Index: trunk/MagicSoft/slalib/pa.c =================================================================== --- trunk/MagicSoft/slalib/pa.c (revision 731) +++ trunk/MagicSoft/slalib/pa.c (revision 731) @@ -0,0 +1,42 @@ +#include "slalib.h" +#include "slamac.h" +double slaPa ( double ha, double dec, double phi ) +/*+ +** - - - - - - +** s l a P a +** - - - - - - +** +** HA, Dec to Parallactic Angle. +** +** (double precision) +** +** Given: +** ha d hour angle in radians (geocentric apparent) +** dec d declination in radians (geocentric apparent) +** phi d observatory latitude in radians (geodetic) +** +** The result is in the range -pi to +pi +** +** Notes: +** +** 1) The parallactic angle at a point in the sky is the position +** angle of the vertical, i.e. the angle between the direction to +** the pole and to the zenith. In precise applications care must +** be taken only to use geocentric apparent HA,Dec and to consider +** separately the effects of atmospheric refraction and telescope +** mount errors. +** +** 2) At the pole a zero result is returned. +** +** Last revision: 16 August 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double cp, cqsz, sqsz; + + cp = cos ( phi ); + sqsz = cp * sin ( ha ); + cqsz = sin ( phi ) * cos ( dec) - cp * sin ( dec) * cos ( ha ); + return ( ( sqsz != 0.0 || cqsz != 0.0 ) ? atan2 ( sqsz, cqsz ) : 0.0 ); +} Index: trunk/MagicSoft/slalib/pav.c =================================================================== --- trunk/MagicSoft/slalib/pav.c (revision 731) +++ trunk/MagicSoft/slalib/pav.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +double slaPav ( float v1 [ 3 ], float v2 [ 3 ] ) +/* +** - - - - - - - +** s l a P a v +** - - - - - - - +** +** Position angle of one celestial direction with respect to another. +** +** (single precision) +** +** Given: +** v1 float[3] direction cosines of one point +** v2 float[3] direction cosines of the other point +** +** (The coordinate frames correspond to RA,Dec, Long,Lat etc.) +** +** The result is the bearing (position angle), in radians, of point +** v2 with respect to point v1. It is in the range +/- pi. The +** sense is such that if v2 is a small distance east of v1, the +** bearing is about +pi/2. Zero is returned if the two points +** are coincident. +** +** The vectors v1 and v2 need not be unit vectors. +** +** The routine slaBear performs an equivalent function except +** that the points are specified in the form of spherical +** coordinates. +** +** Called: slaDpav +** +** Last revision: 9 December 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + double d1 [ 3 ], d2 [ 3 ]; + + +/* Call the double precision version. */ + for ( i = 0; i < 3; i++ ) { + d1 [ i ] = (double) v1 [ i ]; + d2 [ i ] = (double) v2 [ i ]; + } + return (float) slaDpav ( d1, d2 ); +} Index: trunk/MagicSoft/slalib/pcd.c =================================================================== --- trunk/MagicSoft/slalib/pcd.c (revision 731) +++ trunk/MagicSoft/slalib/pcd.c (revision 731) @@ -0,0 +1,54 @@ +#include "slalib.h" +#include "slamac.h" +void slaPcd ( double disco, double *x, double *y ) +/* +** - - - - - - - +** s l a P c d +** - - - - - - - +** +** Apply pincushion/barrel distortion to a tangent-plane [x,y]. +** +** Given: +** disco double pincushion/barrel distortion coefficient +** x,y double tangent-plane coordinates +** +** Returned: +** *x,*y double distorted coordinates +** +** Notes: +** +** 1) The distortion is of the form rp = r*(1 + c*r**2), where r is +** the radial distance from the tangent point, c is the disco +** argument, and rp is the radial distance in the presence of +** the distortion. +** +** 2) For pincushion distortion, c is +ve; +** For barrel distortion, c is -ve. +** +** 3) For x,y in units of one projection radius (in the case of +** a photographic plate, the focal length), the following +** disco values apply: +** +** geometry disco +** +** astrograph 0.0 +** schmidt -0.3333 +** AAT pf doublet +147.069 +** AAT pf triplet +178.585 +** AAT f/8 +21.20 +** JKT f/8 +13.32 +** +** 4) There is a companion routine, slaUnpcd, which performs +** an approximately inverse operation. +** +** Last revision: 15 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double f; + + f = 1.0 + disco * ( *x * *x + *y * *y ); + *x *= f; + *y *= f; +} Index: trunk/MagicSoft/slalib/pda2h.c =================================================================== --- trunk/MagicSoft/slalib/pda2h.c (revision 731) +++ trunk/MagicSoft/slalib/pda2h.c (revision 731) @@ -0,0 +1,90 @@ +#include "slalib.h" +#include "slamac.h" +void slaPda2h ( double p, double d, double a, + double *h1, int *j1, double *h2, int *j2 ) +/* +** - - - - - - - - - +** s l a P d a 2 h +** - - - - - - - - - +** +** Hour Angle corresponding to a given azimuth +** +** (double precision) +** +** Given: +** p double latitude +** d double declination +** a double azimuth +** +** Returned: +** *h1 double hour angle: first solution if any +** *j1 int flag: 0 = solution 1 is valid +** *h2 double hour angle: first solution if any +** *j2 int flag: 0 = solution 2 is valid +** +** Defined in slamac.h: DPI, DPIBY2 +** +** Last revision: 24 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define TINY 1e-12 /* Zone of avoidance around critical angles */ + +{ + double pn, an, dn, sa, ca, sasp, qt, qb, hpt, t; + +/* Preset status flags to OK */ + *j1 = 0; + *j2 = 0; + +/* Adjust latitude, azimuth, declination to avoid critical values */ + pn = slaDrange ( p ); + if ( fabs ( fabs ( pn ) - DPIBY2 ) < TINY ) { + pn -= dsign ( TINY, pn); + } else if ( fabs ( pn ) < TINY ) { + pn = TINY; + } + an = slaDrange ( a ); + if ( fabs ( fabs ( an ) - DPI ) < TINY ) { + an -= dsign ( TINY, an ); + } else if ( fabs ( an ) < TINY ) { + an = TINY; + } + dn = slaDrange ( d ); + if ( fabs ( fabs ( dn ) - fabs ( p ) ) < TINY ) { + dn -= dsign ( TINY, dn ); + } else if ( fabs ( fabs ( dn ) - DPIBY2 ) < TINY ) { + dn -= dsign ( TINY, dn ); + } else if ( fabs ( dn ) < TINY ) { + dn = TINY; + } + +/* Useful functions */ + sa = sin ( an ); + ca = cos ( an ); + sasp = sa * sin ( pn ); + +/* Quotient giving sin(h+t) */ + qt = sin ( dn ) * sa * cos ( pn ); + qb = cos ( dn ) * sqrt ( ca * ca + sasp * sasp ); + +/* Any solutions? */ + if ( fabs ( qt ) <= qb ) { + + /* Yes: find h+t and t */ + hpt = asin ( qt / qb ); + t = atan2 ( sasp, - ca ); + + /* The two solutions */ + *h1 = slaDrange ( hpt - t ); + *h2 = slaDrange ( - hpt - ( t + DPI ) ); + + /* Reject unless h and A different signs */ + if ( *h1 * an > 0.0 ) *j1 = - 1; + if ( *h2 * an > 0.0 ) *j2 = - 1; + } else { + *j1 = - 1; + *j2 = - 1; + } +} Index: trunk/MagicSoft/slalib/pdq2h.c =================================================================== --- trunk/MagicSoft/slalib/pdq2h.c (revision 731) +++ trunk/MagicSoft/slalib/pdq2h.c (revision 731) @@ -0,0 +1,92 @@ +#include "slalib.h" +#include "slamac.h" +void slaPdq2h ( double p, double d, double q, + double *h1, int *j1, double *h2, int *j2 ) +/* +** - - - - - - - - - +** s l a P d q 2 h +** - - - - - - - - - +** +** Hour Angle corresponding to a given parallactic angle +** +** (double precision) +** +** Given: +** p double latitude +** d double declination +** q double parallactic angle +** +** Returned: +** *h1 double hour angle: first solution if any +** *j1 int flag: 0 = solution 1 is valid +** *h2 double hour angle: first solution if any +** *j2 int flag: 0 = solution 2 is valid +** +** Called: slaDrange +** +** Defined in slamac.h: DPI, DPIBY2 +** +** Last revision: 24 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define TINY 1e-12 /* Zone of avoidance around critical angles */ + +{ + double pn, qn, dn, sq, cq, sqsd, qt, qb, hpt, t; + +/* Preset status flags to OK */ + *j1 = 0; + *j2 = 0; + +/* Adjust latitude, azimuth, parallactic angle to avoid critical values */ + pn = slaDrange ( p ); + if ( fabs ( fabs ( pn ) - DPIBY2 ) < TINY ) { + pn -= dsign ( TINY, pn); + } else if ( fabs ( pn ) < TINY ) { + pn = TINY; + } + qn = slaDrange ( q ); + if ( fabs ( fabs ( qn ) - DPI ) < TINY ) { + qn -= dsign ( TINY, qn ); + } else if ( fabs ( qn ) < TINY ) { + qn = TINY; + } + dn = slaDrange ( d ); + if ( fabs ( fabs ( dn ) - fabs ( p ) ) < TINY ) { + dn -= dsign ( TINY, dn ); + } else if ( fabs ( fabs ( dn ) - DPIBY2 ) < TINY ) { + dn -= dsign ( TINY, dn ); + } else if ( fabs ( dn ) < TINY ) { + dn = TINY; + } + +/* Useful functions */ + sq = sin ( qn ); + cq = cos ( qn ); + sqsd = sq * sin ( dn ); + +/* Quotient giving sin(h+t) */ + qt = sin ( pn ) * sq * cos ( dn ); + qb = cos ( pn ) * sqrt ( cq * cq + sqsd * sqsd ); + +/* Any solutions? */ + if ( fabs ( qt ) <= qb ) { + + /* Yes: find h+t and t */ + hpt = asin ( qt / qb ); + t = atan2 ( sqsd, cq ); + + /* The two solutions */ + *h1 = slaDrange ( hpt - t ); + *h2 = slaDrange ( - hpt - ( t + DPI ) ); + + /* Reject if h and Q different signs */ + if ( *h1 * qn < 0.0 ) *j1 = - 1; + if ( *h2 * qn < 0.0 ) *j2 = - 1; + } else { + *j1 = - 1; + *j2 = - 1; + } +} Index: trunk/MagicSoft/slalib/permut.c =================================================================== --- trunk/MagicSoft/slalib/permut.c (revision 731) +++ trunk/MagicSoft/slalib/permut.c (revision 731) @@ -0,0 +1,139 @@ +#include "slalib.h" +#include "slamac.h" +void slaPermut ( int n, int istate[], int iorder[], int* j ) +/* +** - - - - - - - - - - +** s l a P e r m u t +** - - - - - - - - - - +** +** Generate the next permutation of a specified number of items. +** +** Given: +** n int number of items: there will be n! permutations +** +** Given and Returned: +** istate int[n] state, istate[0]=-1 to initialize +** +** Returned: +** istate int[n] state, updated ready for next time +** iorder int[n) next permutation of numbers 1,2,...,n +** *j int status: -1 = illegal n (zero or less is illegal) +** 0 = OK +** +1 = no more permutations available +** +** Notes: +** +** 1) This routine returns, in the iorder array, the integers 1 to n +** inclusive, in an order that depends on the current contents of +** the istate array. Before calling the routine for the first +** time, the caller must set the first element of the istate array +** to -1 (any negative number will do) to cause the istate array +** to be fully initialized. +** +** 2) The first permutation to be generated is: +** +** iorder[0]=n, iorder[1]=n-1, ..., iorder[n-1]=1 +** +** This is also the permutation returned for the "finished" +** (j=1) case. +** +** The final permutation to be generated is: +** +** iorder[0]=1, iorder[1]=2, ..., iorder[n-1]=n +** +** 3) If the "finished" (j=1) status is ignored, the routine continues +** to deliver permutations, the pattern repeating every n! calls. +** +** Last revision: 14 July 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i, ip1, islot, iskip; + + +/* ------------- */ +/* Preliminaries */ +/* ------------- */ + +/* Validate, and set status. */ + if ( n < 1 ) { + *j = -1; + return; + } else { + *j = 0; + } + +/* If just starting, initialize state array */ + if ( istate[0] < 0 ) { + istate[0] = -1; + for ( i = 1; i < n; i++ ) { + istate[i] = 0; + } + } + +/* -------------------------- */ +/* Increment the state number */ +/* -------------------------- */ + +/* The state number, maintained in the istate array, is a mixed-radix */ +/* number with n! states. The least significant digit, with a radix of */ +/* 1, is in istate[0]. The next digit, in istate[1], has a radix of 2, */ +/* and so on. */ + +/* Increment the least-significant digit of the state number. */ + istate[0]++; + +/* Digit by digit starting with the least significant. */ + for ( i = 0; i < n; i++ ) { + ip1 = i + 1; + + /* Carry? */ + if ( istate[i] >= ip1 ) { + + /* Yes: reset the current digit. */ + istate[i] = 0; + + /* Overflow? */ + if ( ip1 >= n ) { + + /* Yes: there are no more permutations. */ + *j = 1; + + } else { + + /* No: carry. */ + istate[ip1]++; + } + } + } + +/* ------------------------------------------------------------------- */ +/* Translate the state number into the corresponding permutation order */ +/* ------------------------------------------------------------------- */ + +/* Initialize the order array. All but one element will be overwritten. */ + for ( i = 0; i < n; i++ ) { + iorder[i] = 1; + } + +/* Look at each state number digit, starting with the most significant. */ + for ( i = n-1; i > 0; i-- ) { + + /* Initialize the position where the new number will go. */ + islot = -1; + + /* The state number digit says which unfilled slot is to be used. */ + for ( iskip = 0; iskip <= istate[i]; iskip++ ) { + + /* Increment the slot number until an unused slot is found. */ + islot++; + while ( iorder[islot] > 1 ) { + islot++; + } + } + + /* Store the number in the permutation order array. */ + iorder[islot] = i + 1; + } +} Index: trunk/MagicSoft/slalib/pertel.c =================================================================== --- trunk/MagicSoft/slalib/pertel.c (revision 731) +++ trunk/MagicSoft/slalib/pertel.c (revision 731) @@ -0,0 +1,153 @@ +#include "slalib.h" +#include "slamac.h" +void slaPertel (int jform, double date0, double date1, + double epoch0, double orbi0, double anode0, + double perih0, double aorq0, double e0, double am0, + double *epoch1, double *orbi1, double *anode1, + double *perih1, double *aorq1, double *e1, double *am1, + int *jstat ) +/* +** - - - - - - - - - - +** s l a P e r t e l +** - - - - - - - - - - +** +** Update the osculating orbital elements of an asteroid or comet by +** applying planetary perturbations. +** +** Given (format and dates): +** jform int choice of element set (2 or 3; Note 1) +** date0 double date of osculation (TT MJD) for the given elements +** date1 double date of osculation (TT MJD) for the updated elements +** +** Given (the unperturbed elements): +** epoch0 double epoch (TT MJD) of the given element set (Note 2) +** orbi0 double inclination (radians) +** anode0 double longitude of the ascending node (radians) +** perih0 double argument of perihelion (radians) +** aorq0 double mean distance or perihelion distance (AU) +** e0 double eccentricity +** am0 double mean anomaly (radians, jform=2 only) +** +** Returned (the updated elements): +** epoch1 double* epoch (TT MJD) of the updated element set (Note 2) +** orbi1 double* inclination (radians) +** anode1 double* longitude of the ascending node (radians) +** perih1 double* argument of perihelion (radians) +** aorq1 double* mean distance or perihelion distance (AU) +** e1 double* eccentricity +** am1 double* mean anomaly (radians, jform=2 only) +** +** Returned (status flag): +** jstat int* status: +102 = warning, distant epoch +** +101 = warning, large timespan ( > 100 years) +** +1 to +8 = coincident with major planet (Note 6) +** 0 = OK +** -1 = illegal jform +** -2 = illegal e0 +** -3 = illegal aorq0 +** -4 = internal error +** -5 = numerical error +** +** Notes: +** +** 1 Two different element-format options are available: +** +** Option jform=2, suitable for minor planets: +** +** epoch = epoch of elements (TT MJD) +** orbi = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e +** am = mean anomaly M (radians) +** +** Option jform=3, suitable for comets: +** +** epoch = epoch of perihelion (TT MJD) +** orbi = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = perihelion distance, q (AU) +** e = eccentricity, e +** +** 2 date0, date1, epoch0 and epoch1 are all instants of time in +** the TT timescale (formerly Ephemeris Time, ET), expressed +** as Modified Julian Dates (JD-2400000.5). +** +** date0 is the instant at which the given (i.e. unperturbed) +** osculating elements are correct. +** +** date1 is the specified instant at which the updated osculating +** elements are correct. +** +** epoch0 and epoch1 will be the same as date0 and date1 +** (respectively) for the jform=2 case, normally used for minor +** planets. For the jform=3 case, the two epochs will refer to +** perihelion passage and so will not, in general, be the same as +** date0 and/or date1 though they may be similar to one another. +** +** 3 The elements are with respect to the J2000 ecliptic and equinox. +** +** 4 Unused elements (am0 and am1 for jform=3) are not accessed. +** +** 5 See the slaPertue routine for details of the algorithm used. +** +** 6 This routine is not intended to be used for major planets, which +** is why jform=1 is not available and why there is no opportunity +** to specify either the longitude of perihelion or the daily +** motion. However, if jform=2 elements are somehow obtained for a +** major planet and supplied to the routine, sensible results will, +** in fact, be produced. This happens because the slaPertue routine +** that is called to perform the calculations checks the separation +** between the body and each of the planets and interprets a +** suspiciously small value (1E-3 AU) as an attempt to apply it to +** the planet concerned. If this condition is detected, the +** contribution from that planet is ignored, and the status is set to +** the planet number (Mercury=1,...,Neptune=8) as a warning. +** +** Reference: +** +** Sterne, Theodore E., "An Introduction to Celestial Mechanics", +** Interscience Publishers Inc., 1960. Section 6.7, p199. +** +** Called: slaEl2ue, slaPertue, slaUe2el +** +** Last revision: 14 March 1999 +** +** Copyright 1999 P.T.Wallace. All rights reserved. +*/ +{ + double u[13], dm; + int j, jf; + + +/* Check that the elements are either minor-planet or comet format. */ + if ( jform < 2 || jform > 3 ) { + *jstat = -1; + return; + } + +/* Transform the elements from conventional to universal form. */ + slaEl2ue ( date0, jform, epoch0, orbi0, anode0, perih0, + aorq0, e0, am0, 0.0, u, &j ); + if ( j ) { + *jstat = j; + return; + } + +/* Update the universal elements. */ + slaPertue ( date1, u, &j ); + if ( j > 0 ) { + *jstat = j; + } else if ( j < 0 ) { + *jstat = -5; + return; + } + +/* Transform from universal to conventional elements. */ + slaUe2el ( u, 2, + &jf, epoch1, orbi1, anode1, perih1, aorq1, e1, am1, &dm, &j ); + if ( jf != jform || j ) *jstat = -5; + +} Index: trunk/MagicSoft/slalib/pertue.c =================================================================== --- trunk/MagicSoft/slalib/pertue.c (revision 731) +++ trunk/MagicSoft/slalib/pertue.c (revision 731) @@ -0,0 +1,539 @@ +#include "slalib.h" +#include "slamac.h" +void slaPertue ( double date, double u[], int *jstat ) +/* +** - - - - - - - - - - +** s l a P e r t u e +** - - - - - - - - - - +** +** Update the universal elements of an asteroid or comet by applying +** planetary perturbations. +** +** Given: +** date double final epoch (TT MJD) for the updated elements +** +** Given and returned: +** +** u double[13] universal orbital elements (Note 1) +** +** [0] combined mass (M+m) +** [1] total energy of the orbit (alpha) +** [2] reference (osculating) epoch (t0) +** [3-5] position at reference epoch (r0) +** [6-8] velocity at reference epoch (v0) +** [9] heliocentric distance at reference epoch +** [10] r0.v0 +** [11] date (t) +** [12] universal eccentric anomaly (psi) of date, approx +** +** Returned: +** jstat int* status: +** +102 = warning, distant epoch +** +101 = warning, large timespan ( > 100 years) +** +1 to +8 = coincident with major planet (Note 5) +** 0 = OK +** -1 = numerical error +** +** Called: slaPlanet, slaUe2pv, slaPv2ue +** +** Notes: +** +** 1 The "universal" elements are those which define the orbit for the +** purposes of the method of universal variables (see reference 2). +** They consist of the combined mass of the two bodies, an epoch, +** and the position and velocity vectors (arbitrary reference frame) +** at that epoch. The parameter set used here includes also various +** quantities that can, in fact, be derived from the other +** information. This approach is taken to avoiding unnecessary +** computation and loss of accuracy. The supplementary quantities +** are (i) alpha, which is proportional to the total energy of the +** orbit, (ii) the heliocentric distance at epoch, (iii) the +** outwards component of the velocity at the given epoch, (iv) an +** estimate of psi, the "universal eccentric anomaly" at a given +** date and (v) that date. +** +** 2 The universal elements are with respect to the J2000 equator and +** equinox. +** +** 3 The epochs date, u[2] and u[11] are all Modified Julian Dates +** (JD-2400000.5). +** +** 4 The algorithm is a simplified form of Encke's method. It takes as +** a basis the unperturbed motion of the body, and numerically +** integrates the perturbing accelerations from the major planets. +** The expression used is essentially Sterne's 6.7-2 (reference 1). +** Everhart and Pitkin (reference 2) suggest rectifying the orbit at +** each integration step by propagating the new perturbed position +** and velocity as the new universal variables. In the present +** routine the orbit is rectified less frequently than this, in order +** to gain a slight speed advantage. However, the rectification is +** done directly in terms of position and velocity, as suggested by +** Everhart and Pitkin, bypassing the use of conventional orbital +** elements. +** +** The f(q) part of the full Encke method is not used. The purpose +** of this part is to avoid subtracting two nearly equal quantities +** when calculating the "indirect member", which takes account of the +** small change in the Sun's attraction due to the slightly displaced +** position of the perturbed body. A simpler, direct calculation in +** double precision proves to be faster and not significantly less +** accurate. +** +** Apart from employing a variable timestep, and occasionally +** "rectifying the orbit" to keep the indirect member small, the +** integration is done in a fairly straightforward way. The +** acceleration estimated for the middle of the timestep is assumed +** to apply throughout that timestep; it is also used in the +** extrapolation of the perturbations to the middle of the next +** timestep, to predict the new disturbed position. There is no +** iteration within a timestep. +** +** Measures are taken to reach a compromise between execution time +** and accuracy. The starting-point is the goal of achieving +** arcsecond accuracy for ordinary minor planets over a ten-year +** timespan. This goal dictates how large the timesteps can be, +** which in turn dictates how frequently the unperturbed motion has +** to be recalculated from the osculating elements. +** +** Within predetermined limits, the timestep for the numerical +** integration is varied in length in inverse proportion to the +** magnitude of the net acceleration on the body from the major +** planets. +** +** The numerical integration requires estimates of the major-planet +** motions. Approximate positions for the major planets (Pluto +** alone is omitted) are obtained from the routine slaPlanet. Two +** levels of interpolation are used, to enhance speed without +** significantly degrading accuracy. At a low frequency, the routine +** slaPlanet is called to generate updated position+velocity "state +** vectors". The only task remaining to be carried out at the full +** frequency (i.e. at each integration step) is to use the state +** vectors to extrapolate the planetary positions. In place of a +** strictly linear extrapolation, some allowance is made for the +** curvature of the orbit by scaling back the radius vector as the +** linear extrapolation goes off at a tangent. +** +** Various other approximations are made. For example, perturbations +** by Pluto and the minor planets are neglected, relativistic effects +** are not taken into account and the Earth-Moon system is treated as +** a single body. +** +** In the interests of simplicity, the background calculations for +** the major planets are carried out en masse. The mean elements and +** state vectors for all the planets are refreshed at the same time, +** without regard for orbit curvature, mass or proximity. +** +** 5 This routine is not intended to be used for major planets. +** However, if major-planet elements are supplied, sensible results +** will, in fact, be produced. This happens because the routine +** checks the separation between the body and each of the planets and +** interprets a suspiciously small value (0.001 AU) as an attempt to +** apply the routine to the planet concerned. If this condition is +** detected, the contribution from that planet is ignored, and the +** status is set to the planet number (Mercury=1,...,Neptune=8) as a +** warning. +** +** References: +** +** 1 Sterne, Theodore E., "An Introduction to Celestial Mechanics", +** Interscience Publishers Inc., 1960. Section 6.7, p199. +** +** 2 Everhart, E. & Pitkin, E.T., Am.J.Phys. 51, 712, 1983. +** +** Last revision: 18 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Coefficient relating timestep to perturbing force */ +#define TSC 1e-4 + +/* Minimum and maximum timestep (days) */ +#define TSMIN 0.01 +#define TSMAX 10.0 + +/* Age limit for major-planet state vector (days) */ +#define AGEPMO 5.0 + +/* Age limit for major-planet mean elements (days) */ +#define AGEPEL 50.0 + +/* Margin for error when deciding whether to renew the planetary data */ +#define TINY 1e-6 + +/* Age limit for the body's osculating elements (before rectification) */ +#define AGEBEL 100.0 + +/* Gaussian gravitational constant (exact) and square */ +#define GCON 0.01720209895 +#define GCON2 (GCON*GCON) + +{ + +/* The final epoch */ + double tfinal; + +/* The body's current universal elements */ + double ul[13]; + +/* Current reference epoch */ + double t0; + +/* Timespan from latest orbit rectification to final epoch (days) */ + double tspan; + +/* Time left to go before integration is complete */ + double tleft; + +/* Time direction flag: +1=forwards, -1=backwards */ + double fb; + +/* First-time flag */ + int first; + +/* The current perturbations */ + double rtn, /* Epoch (days relative to current reference epoch) */ + perp[3], /* Position (AU) */ + perv[3], /* Velocity (AU/d) */ + pera[3]; /* Acceleration (AU/d/d) */ + +/* Length of current timestep (days), and half that */ + double ts, hts; + +/* Epoch of middle of timestep */ + double t; + +/* Epoch of planetary mean elements */ + double tpel; + +/* Planet number (1=Mercury, 2=Venus, 3=EMB...8=Neptune) */ + int np; + +/* Planetary universal orbital elements */ + double up[8][13]; + +/* Epoch of planetary state vectors */ + double tpmo; + +/* State vectors for the major planets (AU,AU/s) */ + double pvin[8][6]; + +/* Correction terms for extrapolated major planet vectors */ + double r2x3[8], /* Sun-to-planet distances squared multiplied by 3 */ + gc[8], /* Sunward acceleration terms, G/2R^3 */ + fc, /* Tangential-to-circular correction factor */ + fg; /* Radial correction factor due to Sunwards acceleration */ + +/* The body's unperturbed and perturbed state vectors (AU,AU/s) */ + double pv0[6], pv[6]; + +/* The body's perturbed and unperturbed heliocentric distances (AU) cubed */ + double r03, r3; + +/* The perturbating accelerations, indirect and direct */ + double fi[3], fd[3]; + +/* Sun-to-planet vector, and distance cubed */ + double rho[3], rho3; + +/* Body-to-planet vector, and distance cubed */ + double delta[3], delta3; + +/* Miscellaneous */ + int i, j, npm1; + double r2, w, dt, dt2, ft; + +/* Planetary inverse masses, Mercury through Neptune */ + static double amas[] = { + 6023600.0, + 408523.5, + 328900.5, + 3098710.0, + 1047.355, + 3498.5, + 22869.0, + 19314.0 + }; + + + +/* Preset the status to OK. */ + *jstat = 0; + +/* Copy the final epoch. */ + tfinal = date; + +/* Copy the elements (which will be periodically updated). */ + for ( i = 0; i < 13; i++ ) { + ul[i] = u[i]; + } + +/* Initialize the working reference epoch. */ + t0 = ul[2]; + +/* Total timespan (days) and hence time left. */ + tspan = tfinal - t0; + tleft = tspan; + +/* Warn if excessive. */ + if ( fabs ( tspan ) > 36525.0 ) *jstat = 101; + +/* Time direction: +1 for forwards, -1 for backwards. */ + fb = dsign ( 1.0, tspan ); + +/* Initialize relative epoch for start of current timestep. */ + rtn = 0.0; + +/* Reset the perturbations (position, velocity, acceleration). */ + for ( i = 0; i < 3; i++ ) { + perp[i] = 0.0; + perv[i] = 0.0; + pera[i] = 0.0; + } + +/* Set "first iteration" flag. */ + first = TRUE; + +/* Step through the time left. */ + while ( fb * tleft > 0.0 ) { + + /* Magnitude of current acceleration due to planetary attractions. */ + if ( first ) { + ts = TSMIN; + } else { + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = fd[i]; + r2 += w * w; + } + w = sqrt ( r2 ); + + /* Use the acceleration to decide how big a timestep can be tolerated. */ + if ( w != 0.0 ) { + ts = TSC / w; + if ( ts > TSMAX ) { + ts = TSMAX; + } else if ( ts < TSMIN ) { + ts = TSMIN; + } + } else { + ts = TSMAX; + } + } + ts *= fb; + + /* Override if final epoch is imminent. */ + tleft = tspan - rtn; + if ( fabs ( ts ) > fabs ( tleft ) ) ts = tleft; + + /* Epoch of middle of timestep. */ + hts = ts / 2.0; + t = t0 + rtn + hts; + + /* Is it time to recompute the major-planet elements? */ + if ( first || ( fabs ( t - tpel ) - AGEPEL ) >= TINY ) { + + /* Yes: go forward in time by just under the maximum allowed. */ + tpel = t + fb * AGEPEL; + + /* Compute the state vector for the new epoch. */ + for ( np = 1; np <= 8; np++ ) { + npm1 = np - 1; + + slaPlanet ( tpel, np, pv, &j ); + + /* Warning if remote epoch, abort if error. */ + if ( j == 1 ) { + *jstat = 102; + } else if ( j ) { + *jstat = -1; + return; + } + + /* Transform the vector into universal elements. */ + slaPv2ue ( pv, tpel, 0.0, up[npm1], &j ); + if ( j ) { + *jstat = -1; + return; + } + } + } + + /* Is it time to recompute the major-planet motions? */ + if ( first || ( fabs ( t - tpmo ) - AGEPMO ) >= TINY ) { + + /* Yes: look ahead. */ + tpmo = t + fb * AGEPMO; + + /* Compute the motions of each planet (AU,AU/d). */ + for ( np = 1; np <= 8; np++ ) { + npm1 = np - 1; + + /* The planet's position and velocity (AU,AU/s). */ + slaUe2pv ( tpmo, up[npm1], pvin[npm1], &j ); + if ( j ) { + *jstat = -1; + return; + } + + /* Scale velocity to AU/d. */ + for ( j = 3; j < 6; j++ ) { + pvin[npm1][j] *= 86400.0; + } + + /* Precompute also the extrapolation correction terms. */ + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = pvin[npm1][i]; + r2 += w * w; + } + r2x3[npm1] = r2 * 3.0; + gc[npm1] = GCON2 / ( 2.0 * r2 * sqrt ( r2 ) ); + } + } + + /* Reset the first-time flag. */ + first = FALSE; + + /* Unperturbed motion of the body at middle of timestep (AU,AU/s). */ + slaUe2pv ( t, ul, pv0, &j ); + if ( j ) { + *jstat = -1; + return; + } + + /* Perturbed position of the body (AU) and heliocentric distance cubed. */ + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = pv0[i] + perp[i] + ( perv[i] + pera[i] * hts / 2.0 ) * hts; + pv[i] = w; + r2 += w * w; + } + r3 = r2 * sqrt ( r2 ); + + /* The body's unperturbed heliocentric distance cubed. */ + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = pv0[i]; + r2 += w * w; + } + r03 = r2 * sqrt ( r2 ); + + /* Compute indirect and initialize direct parts of the perturbation. */ + for ( i = 0; i < 3; i++ ) { + fi[i] = pv0[i] / r03 - pv[i] / r3; + fd[i] = 0.0; + } + + /* Ready to compute the direct planetary effects. */ + + /* Interval from state-vector epoch to middle of current timestep. */ + dt = t - tpmo; + dt2 = dt * dt; + + /* Planet by planet. */ + for ( np = 1; np <= 8; np++ ) { + npm1 = np - 1; + + /* First compute the extrapolation in longitude (squared). */ + r2 = 0.0; + for ( j = 3; j < 6; j++ ) { + w = pvin[npm1][j] * dt; + r2 += w * w; + } + + /* Hence the tangential-to-circular correction factor. */ + fc = 1.0 + r2 / r2x3[npm1]; + + /* The radial correction factor due to the inwards acceleration. */ + fg = 1.0 - gc[npm1] * dt2; + + /* Planet's position, and heliocentric distance cubed. */ + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = fg * ( pvin[npm1][i] + fc * pvin[npm1][i+3] * dt ); + rho[i] = w; + r2 += w * w; + } + rho3 = r2 * sqrt ( r2 ); + + /* Body-to-planet vector, and distance cubed. */ + r2 = 0.0; + for ( i = 0; i < 3; i++ ) { + w = rho[i] - pv[i]; + delta[i] = w; + r2 += w * w; + } + delta3 = r2 * sqrt ( r2 ); + + /* If too close, ignore this planet and set a warning. */ + if ( r2 < 1e-6 ) { + *jstat = np; + } else { + + /* Accumulate "direct" part of perturbation acceleration. */ + w = amas[npm1]; + for ( i = 0; i < 3; i++ ) { + fd[i] += ( delta[i] / delta3 - rho[i] / rho3 ) / w; + } + } + } + + /* Update the perturbations to the end of the timestep. */ + rtn = rtn + ts; + for ( i = 0; i < 3; i++ ) { + w = ( fi[i] + fd[i] ) * GCON2; + ft = w * ts; + perp[i] += ( perv[i] + ft / 2.0 ) * ts; + perv[i] += ft; + pera[i] = w; + } + + /* Time still to go. */ + tleft = tspan - rtn; + + /* Is it either time to rectify the orbit or the last time through? */ + if ( fabs ( rtn ) >= AGEBEL || ( fb * tleft ) <= 0.0 ) { + + /* Yes: update to the end of the current timestep. */ + t0 += rtn; + rtn = 0.0; + + /* The body's unperturbed motion (AU,AU/s). */ + slaUe2pv ( t0, ul, pv0, &j ); + if ( j ) { + *jstat = -1; + return; + } + + /* Add and re-initialize the perturbations. */ + for ( i = 0; i < 3; i++ ) { + j = i + 3; + pv[i] = pv0[i] + perp[i]; + pv[j] = pv0[j] + perv[i] / 86400.0; + perp[i] = 0.0; + perv[i] = 0.0; + pera[i] = fd[i] * GCON2; + } + + /* Use the position and velocity to set up new universal elements. */ + slaPv2ue ( pv, t0, 0.0, ul, &j ); + if ( j ) { + *jstat = -1; + return; + } + + /* Adjust the timespan and time left. */ + tspan = tfinal - t0; + tleft = tspan; + } + + /* Next timestep. */ + } + +/* Return the updated universal-element set. */ + for ( i = 0; i < 13; i++ ) { + u[i] = ul[i]; + } + +} Index: trunk/MagicSoft/slalib/planel.c =================================================================== --- trunk/MagicSoft/slalib/planel.c (revision 731) +++ trunk/MagicSoft/slalib/planel.c (revision 731) @@ -0,0 +1,113 @@ +#include "slalib.h" +#include "slamac.h" +void slaPlanel ( double date, int jform, double epoch, double orbinc, + double anode, double perih, double aorq, double e, + double aorl, double dm, double pv[6], int* jstat ) +/* +** - - - - - - - - - - +** s l a P l a n e l +** - - - - - - - - - - +** +** Heliocentric position and velocity of a planet, asteroid or comet, +** starting from orbital elements. +** +** Given: +** date double date, Modified Julian Date (JD - 2400000.5) +** jform int choice of element set (1-3; Note 3) +** epoch double epoch of elements (TT MJD) +** orbinc double inclination (radians) +** anode double longitude of the ascending node (radians) +** perih double longitude or argument of perihelion (radians) +** aorq double mean distance or perihelion distance (AU) +** e double eccentricity +** aorl double mean anomaly or longitude (radians, jform=1,2 only) +** dm double daily motion (radians, jform=1 only) +** +** Returned: +** pv double[6] heliocentric x,y,z,xdot,ydot,zdot of date, +** J2000 equatorial triad (AU,AU/s) +** jstat int* status: 0 = OK +** -1 = illegal jform +** -2 = illegal e +** -3 = illegal aorq +** -4 = illegal dm +** -5 = numerical error +** +** Called: slaEl2ue, slaUe2pv +** +** Notes +** +** 1 DATE is the instant for which the prediction is required. It is +** in the TT timescale (formerly Ephemeris Time, ET) and is a +** Modified Julian Date (JD-2400000.5). +** +** 2 The elements are with respect to the J2000 ecliptic and equinox. +** +** 3 Three different element-format options are available: +** +** Option jform=1, suitable for the major planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = longitude of perihelion, curly pi (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e (range 0 to <1) +** aorl = mean longitude L (radians) +** dm = daily motion (radians) +** +** Option jform=2, suitable for minor planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e (range 0 to <1) +** aorl = mean anomaly M (radians) +** +** Option jform=3, suitable for comets: +** +** epoch = epoch of perihelion (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = perihelion distance, q (AU) +** e = eccentricity, e (range 0 to 10) +** +** 4 Unused elements (DM for jform=2, aorl and dm for jform=3) are +** not accessed. +** +** 5 The reference frame for the result is with respect to the mean +** equator and equinox of epoch J2000. +** +** 6 The algorithm was originally adapted from the EPHSLA program +** of D.H.P.Jones (private communication, 1996). The method is +** based on Stumpff's Universal Variables. +** +** Reference: Everhart, E. & Pitkin, E.T., Am.J.Phys. 51, 712, 1983. +** +** Last revision: 18 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double u[13]; + int j; + + + +/* Validate elements and convert to "universal variables" parameters. */ + slaEl2ue ( date, jform, + epoch, orbinc, anode, perih, aorq, e, aorl, dm, u, &j ); + +/* Determine the position and velocity. */ + if ( !j ) { + slaUe2pv ( date, u, pv, &j ); + if ( j ) j = -5; + } + +/* Wrap up. */ + *jstat = j; + +} Index: trunk/MagicSoft/slalib/planet.c =================================================================== --- trunk/MagicSoft/slalib/planet.c (revision 731) +++ trunk/MagicSoft/slalib/planet.c (revision 731) @@ -0,0 +1,673 @@ +#include "slalib.h" +#include "slamac.h" +void slaPlanet ( double date, int np, double pv[6], int *jstat ) +/* +** - - - - - - - - - - +** s l a P l a n e t +** - - - - - - - - - - +** +** Approximate heliocentric position and velocity of a specified +** major planet. +** +** Given: +** date double TDB (loosely ET) as a Modified Julian Date +** (JD-2400000.5) +** np int planet (1=Mercury, 2=Venus, 3=EMB, ... +** ... 9=Pluto) +** +** Returned: +** pv double[6] heliocentric x,y,z,xdot,ydot,zdot, J2000 +** equatorial triad (AU,AU/s) +** +** *jstat int status: +1 = warning: date outside 1000-3000 +** *jstat int status: 0 = OK +** -1 = illegal NP (outside 1-9) +** -2 = solution didn't converge +** +** Called: slaPlanel +** +** Notes +** +** 1 The epoch, date, is in the TDB timescale and is a Modified +** Julian Date (JD-2400000.5). +** +** 2 The reference frame is equatorial and is with respect to the +** mean equinox and ecliptic of epoch J2000. +** +** 3 If an np value outside the range 1-9 is supplied, an error +** status (jstat = -1) is returned and the pv vector set to zeroes. +** +** 4 The algorithm for obtaining the mean elements of the planets +** from Mercury to Neptune is due to J.L. Simon, P. Bretagnon, +** J. Chapront, M. Chapront-Touze, G. Francou and J. Laskar +** (Bureau des Longitudes, Paris). The (completely different) +** algorithm for calculating the ecliptic coordinates of Pluto +** is by Meeus. +** +** 5 Comparisons of the present routine with the JPL DE200 ephemeris +** give the following RMS errors over the interval 1960-2025: +** +** position (km) speed (metre/sec) +** +** Mercury 334 0.437 +** Venus 1060 0.855 +** EMB 2010 0.815 +** Mars 7690 1.98 +** Jupiter 71700 7.70 +** Saturn 199000 19.4 +** Uranus 564000 16.4 +** Neptune 158000 14.4 +** +** From comparisons with DE102, Simon et al quote the following +** longitude accuracies over the interval 1800-2200: +** +** Mercury 4" +** Venus 5" +** EMB 6" +** Mars 17" +** Jupiter 71" +** Saturn 81" +** Uranus 86" +** Neptune 11" +** +** In the case of Pluto, Meeus quotes an accuracy of 0.6 arcsec +** in longitude and 0.2 arcsec in latitude for the period +** 1885-2099. +** +** For all except Pluto, over the period 1000-3000 the accuracy +** is better than 1.5 times that over 1800-2200. Outside the +** period 1000-3000 the accuracy declines. For Pluto the +** accuracy declines rapidly outside the period 1885-2099. +** Outside these ranges (1885-2099 for Pluto, 1000-3000 for +** the rest) a "date out of range" warning status (JSTAT=+1) +** is returned. +** +** 6 The algorithms for (i) Mercury through Neptune and (ii) Pluto +** are completely independent. In the Mercury through Neptune +** case, the present SLALIB C implementation follows the original +** Simon et al Fortran code closely, and delivers essentially +** the same results. The changes are these: +** +** * The date is supplied as a Modified Julian Date rather +** than a Julian Date (MJD = JD - 2400000.5). +** +** * The result is returned only in equatorial Cartesian form; +** the ecliptic longitude, latitude and radius vector are not +** returned. +** +** * The velocity is in AU per second, not AU per day. +** +** * Different error/warning status values are used. +** +** * Kepler's equation is not solved inline. +** +** * Polynomials in T are nested to minimize rounding errors. +** +** * Explicit double-precision constants are used to avoid +** mixed-mode expressions. +** +** 7 For np=3 the result is for the Earth-Moon Barycentre. To +** obtain the heliocentric position and velocity of the Earth, +** either use the SLALIB routine slaEvp or use slaDmoon and +** subtract 0.012150581 times the geocentric Moon vector from +** the EMB vector produced by the present routine. (The Moon +** vector should be precessed to J2000 first, but this can +** be omitted for modern epochs without introducing significant +** inaccuracy.) +** +** References: Simon et al., Astron. Astrophys. 282, 663 (1994). +** Meeus, Astronomical Algorithms, Willmann-Bell (1991). +** +** Defined in slamac.h: D2PI, DAS2R, DD2R, dmod +** +** Last revision: 27 May 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Gaussian gravitational constant (exact) */ +#define GCON 0.01720209895 + +/* Canonical days to seconds */ +#define CD2S ( GCON / 86400.0 ) + +/* Seconds per Julian century */ +#define SPC ( 36525.0 * 86400.0 ) + +/* Sin and cos of J2000 mean obliquity (IAU 1976) */ +#define SE 0.3977771559319137 +#define CE 0.9174820620691818 + +{ + int ip, i, j; + double t, da, de, dpe, di, dom, dmu, arga, argl, dm, + dj, ds, dp, wlbr[3], wlbrd[3], + wj, ws, wp, al, ald, sal, cal, + ac, bc, dl, dld, db, dbd, dr, drd, + sl, cl, sb, cb, slcb, clcb, x, y, z, xd, yd, zd; + +/* +** ----------------------- +** Mercury through Neptune +** ----------------------- +*/ + +/* Planetary inverse masses */ + static double amas[] = { + 6023600.0, + 408523.5, + 328900.5, + 3098710.0, + 1047.355, + 3498.5, + 22869.0, + 19314.0 + }; + +/* +** Tables giving the mean Keplerian elements, limited to T^2 terms: +** +** a semi-major axis (AU) +** dlm mean longitude (degree and arcsecond) +** e eccentricity +** pi longitude of the perihelion (degree and arcsecond) +** dinc inclination (degree and arcsecond) +** omega longitude of the ascending node (degree and arcsecond) +*/ + static double a[8][3] = { + { 0.3870983098, 0.0, 0.0 }, + { 0.7233298200, 0.0, 0.0 }, + { 1.0000010178, 0.0, 0.0 }, + { 1.5236793419, 3e-10, 0.0 }, + { 5.2026032092, 19132e-10, -39e-10 }, + { 9.5549091915, -0.0000213896, 444e-10 }, + { 19.2184460618, -3716e-10, 979e-10 }, + { 30.1103868694, -16635e-10, 686e-10 } + }; + static double dlm[8][3] = { + { 252.25090552, 5381016286.88982, -1.92789 }, + { 181.97980085, 2106641364.33548, 0.59381 }, + { 100.46645683, 1295977422.83429, -2.04411 }, + { 355.43299958, 689050774.93988, 0.94264 }, + { 34.35151874, 109256603.77991, -30.60378 }, + { 50.07744430, 43996098.55732, 75.61614 }, + { 314.05500511, 15424811.93933, -1.75083 }, + { 304.34866548, 7865503.20744, 0.21103 } + }; + static double e[8][3] = { + { 0.2056317526, 0.0002040653, -28349e-10 }, + { 0.0067719164, -0.0004776521, 98127e-10 }, + { 0.0167086342, -0.0004203654, -0.0000126734 }, + { 0.0934006477, 0.0009048438, -80641e-10 }, + { 0.0484979255, 0.0016322542, -0.0000471366 }, + { 0.0555481426, -0.0034664062, -0.0000643639 }, + { 0.0463812221, -0.0002729293, 0.0000078913 }, + { 0.0094557470, 0.0000603263, 0.0 } + }; + static double pi[8][3] = { + { 77.45611904, 5719.11590, -4.83016 }, + { 131.56370300, 175.48640, -498.48184 }, + { 102.93734808, 11612.35290, 53.27577 }, + { 336.06023395, 15980.45908, -62.32800 }, + { 14.33120687, 7758.75163, 259.95938 }, + { 93.05723748, 20395.49439, 190.25952 }, + { 173.00529106, 3215.56238, -34.09288 }, + { 48.12027554, 1050.71912, 27.39717 } + }; + static double dinc[8][3] = { + { 7.00498625, -214.25629, 0.28977 }, + { 3.39466189, -30.84437, -11.67836 }, + { 0.0, 469.97289, -3.35053 }, + { 1.84972648, -293.31722, -8.11830 }, + { 1.30326698, -71.55890, 11.95297 }, + { 2.48887878, 91.85195, -17.66225 }, + { 0.77319689, -60.72723, 1.25759 }, + { 1.76995259, 8.12333, 0.08135 } + }; + static double omega[8][3] = { + { 48.33089304, -4515.21727, -31.79892 }, + { 76.67992019, -10008.48154, -51.32614 }, + { 174.87317577, -8679.27034, 15.34191 }, + { 49.55809321, -10620.90088, -230.57416 }, + { 100.46440702, 6362.03561, 326.52178 }, + { 113.66550252, -9240.19942, -66.23743 }, + { 74.00595701, 2669.15033, 145.93964 }, + { 131.78405702, -221.94322, -0.78728 } + }; + +/* +** Tables for trigonometric terms to be added to the mean elements +** of the semi-major axes. +*/ + static double dkp[8][9] = { + { 69613.0, 75645.0, 88306.0, 59899.0, 15746.0, 71087.0, + 142173.0, 3086.0, 0.0 }, + { 21863.0, 32794.0, 26934.0, 10931.0, 26250.0, 43725.0, + 53867.0, 28939.0, 0.0 }, + { 16002.0, 21863.0, 32004.0, 10931.0, 14529.0, 16368.0, + 15318.0, 32794.0, 0.0 }, + { 6345.0, 7818.0, 15636.0, 7077.0, 8184.0, 14163.0, + 1107.0, 4872.0, 0.0 }, + { 1760.0, 1454.0, 1167.0, 880.0, 287.0, 2640.0, + 19.0, 2047.0, 1454.0 }, + { 574.0, 0.0, 880.0, 287.0, 19.0, 1760.0, + 1167.0, 306.0, 574.0 }, + { 204.0, 0.0, 177.0, 1265.0, 4.0, 385.0, + 200.0, 208.0, 204.0 }, + { 0.0, 102.0, 106.0, 4.0, 98.0, 1367.0, + 487.0, 204.0, 0.0 } + }; + static double ca[8][9] = { + { 4.0, -13.0, 11.0, -9.0, -9.0, -3.0, + -1.0, 4.0, 0.0 }, + { -156.0, 59.0, -42.0, 6.0, 19.0, -20.0, + -10.0, -12.0, 0.0 }, + { 64.0, -152.0, 62.0, -8.0, 32.0, -41.0, + 19.0, -11.0, 0.0 }, + { 124.0, 621.0, -145.0, 208.0, 54.0, -57.0, + 30.0, 15.0, 0.0 }, + { -23437.0, -2634.0, 6601.0, 6259.0, -1507.0, -1821.0, + 2620.0, -2115.0,-1489.0 }, + { 62911.0,-119919.0, 79336.0, 17814.0,-24241.0, 12068.0, + 8306.0, -4893.0, 8902.0 }, + { 389061.0,-262125.0,-44088.0, 8387.0,-22976.0, -2093.0, + -615.0, -9720.0, 6633.0 }, + { -412235.0,-157046.0,-31430.0, 37817.0, -9740.0, -13.0, + -7449.0, 9644.0, 0.0 } + }; + static double sa[8][9] = { + { -29.0, -1.0, 9.0, 6.0, -6.0, 5.0, + 4.0, 0.0, 0.0 }, + { -48.0, -125.0, -26.0, -37.0, 18.0, -13.0, + -20.0, -2.0, 0.0 }, + { -150.0, -46.0, 68.0, 54.0, 14.0, 24.0, + -28.0, 22.0, 0.0 }, + { -621.0, 532.0, -694.0, -20.0, 192.0, -94.0, + 71.0, -73.0, 0.0 }, + { -14614.0,-19828.0, -5869.0, 1881.0, -4372.0, -2255.0, + 782.0, 930.0, 913.0 }, + { 139737.0, 0.0, 24667.0, 51123.0, -5102.0, 7429.0, + -4095.0, -1976.0,-9566.0 }, + { -138081.0, 0.0, 37205.0,-49039.0,-41901.0,-33872.0, + -27037.0,-12474.0,18797.0 }, + { 0.0, 28492.0,133236.0, 69654.0, 52322.0,-49577.0, + -26430.0, -3593.0, 0.0 } + }; + +/* +** Tables giving the trigonometric terms to be added to the mean +** elements of the mean longitudes. +*/ + static double dkq[8][10] = { + { 3086.0, 15746.0, 69613.0, 59899.0, 75645.0, + 88306.0, 12661.0, 2658.0, 0.0, 0.0 }, + { 21863.0, 32794.0, 10931.0, 73.0, 4387.0, + 26934.0, 1473.0, 2157.0, 0.0, 0.0 }, + { 10.0, 16002.0, 21863.0, 10931.0, 1473.0, + 32004.0, 4387.0, 73.0, 0.0, 0.0 }, + { 10.0, 6345.0, 7818.0, 1107.0, 15636.0, + 7077.0, 8184.0, 532.0, 10.0, 0.0 }, + { 19.0, 1760.0, 1454.0, 287.0, 1167.0, + 880.0, 574.0, 2640.0, 19.0,1454.0 }, + { 19.0, 574.0, 287.0, 306.0, 1760.0, + 12.0, 31.0, 38.0, 19.0, 574.0 }, + { 4.0, 204.0, 177.0, 8.0, 31.0, + 200.0, 1265.0, 102.0, 4.0, 204.0 }, + { 4.0, 102.0, 106.0, 8.0, 98.0, + 1367.0, 487.0, 204.0, 4.0, 102.0 } + }; + static double clo[8][10] = { + { 21.0, -95.0, -157.0, 41.0, -5.0, + 42.0, 23.0, 30.0, 0.0, 0.0 }, + { -160.0, -313.0, -235.0, 60.0, -74.0, + -76.0, -27.0, 34.0, 0.0, 0.0 }, + { -325.0, -322.0, -79.0, 232.0, -52.0, + 97.0, 55.0, -41.0, 0.0, 0.0 }, + { 2268.0, -979.0, 802.0, 602.0, -668.0, + -33.0, 345.0, 201.0, -55.0, 0.0 }, + { 7610.0, -4997.0, -7689.0, -5841.0, -2617.0, + 1115.0, -748.0, -607.0, 6074.0, 354.0 }, + { -18549.0, 30125.0, 20012.0, -730.0, 824.0, + 23.0, 1289.0, -352.0,-14767.0,-2062.0 }, + { -135245.0, -14594.0, 4197.0, -4030.0, -5630.0, + -2898.0, 2540.0, -306.0, 2939.0, 1986.0 }, + { 89948.0, 2103.0, 8963.0, 2695.0, 3682.0, + 1648.0, 866.0, -154.0, -1963.0, -283.0 } + }; + static double slo[8][10] = { + { -342.0, 136.0, -23.0, 62.0, 66.0, + -52.0, -33.0, 17.0, 0.0, 0.0 }, + { 524.0, -149.0, -35.0, 117.0, 151.0, + 122.0, -71.0, -62.0, 0.0, 0.0 }, + { -105.0, -137.0, 258.0, 35.0, -116.0, + -88.0, -112.0, -80.0, 0.0, 0.0 }, + { 854.0, -205.0, -936.0, -240.0, 140.0, + -341.0, -97.0, -232.0, 536.0, 0.0 }, + { -56980.0, 8016.0, 1012.0, 1448.0, -3024.0, + -3710.0, 318.0, 503.0, 3767.0, 577.0 }, + { 138606.0, -13478.0, -4964.0, 1441.0, -1319.0, + -1482.0, 427.0, 1236.0, -9167.0, -1918.0 }, + { 71234.0, -41116.0, 5334.0, -4935.0, -1848.0, + 66.0, 434.0, -1748.0, 3780.0, -701.0 }, + { -47645.0, 11647.0, 2166.0, 3194.0, 679.0, + 0.0, -244.0, -419.0, -2531.0, 48.0 } + }; + +/* +** ----- +** Pluto +** ----- +*/ + +/* +** Coefficients for fundamental arguments: mean longitudes (degrees) +** and mean rate of change of longitude (degrees per Julian century) +** for Jupiter, Saturn and Pluto +*/ + static double dj0 = 34.35, djd = 3034.9057, + ds0 = 50.08, dsd = 1222.1138, + dp0 = 238.96, dpd = 144.9600; + +/* Coefficients for latitude, longitude, radius vector */ + static double dl0 = 238.956785, dld0 = 144.96, + db0 = -3.908202, + dr0 = 40.7247248; + +/* +** Coefficients for periodic terms (Meeus's Table 36.A) +*/ + struct ab { + double a; /* sine component */ + double b; /* cosine component */ + }; + struct tm { + int ij; /* Jupiter contribution to argument */ + int is; /* Saturn contribution to argument */ + int ip; /* Pluto contribution to argument */ + struct ab dlbr[3]; /* longitude (degrees), + latitude (degrees), + radius vector (AU) */ + }; + static struct tm term[] = { + + /* 1 */ { 0, 0, 1, { { -19798886e-6, 19848454e-6 }, + { -5453098e-6, -14974876e-6 }, + { 66867334e-7, 68955876e-7 } } }, + /* 2 */ { 0, 0, 2, { { 897499e-6, -4955707e-6 }, + { 3527363e-6, 1672673e-6 }, + { -11826086e-7, -333765e-7 } } }, + /* 3 */ { 0, 0, 3, { { 610820e-6, 1210521e-6 }, + { -1050939e-6, 327763e-6 }, + { 1593657e-7, -1439953e-7 } } }, + /* 4 */ { 0, 0, 4, { { -341639e-6, -189719e-6 }, + { 178691e-6, -291925e-6 }, + { -18948e-7, 482443e-7 } } }, + /* 5 */ { 0, 0, 5, { { 129027e-6, -34863e-6 }, + { 18763e-6, 100448e-6 }, + { -66634e-7, -85576e-7 } } }, + /* 6 */ { 0, 0, 6, { { -38215e-6, 31061e-6 }, + { -30594e-6, -25838e-6 }, + { 30841e-7, -5765e-7 } } }, + /* 7 */ { 0, 1, -1, { { 20349e-6, -9886e-6 }, + { 4965e-6, 11263e-6 }, + { -6140e-7, 22254e-7 } } }, + /* 8 */ { 0, 1, 0, { { -4045e-6, -4904e-6 }, + { 310e-6, -132e-6 }, + { 4434e-7, 4443e-7 } } }, + /* 9 */ { 0, 1, 1, { { -5885e-6, -3238e-6 }, + { 2036e-6, -947e-6 }, + { -1518e-7, 641e-7 } } }, + /* 10 */ { 0, 1, 2, { { -3812e-6, 3011e-6 }, + { -2e-6, -674e-6 }, + { -5e-7, 792e-7 } } }, + /* 11 */ { 0, 1, 3, { { -601e-6, 3468e-6 }, + { -329e-6, -563e-6 }, + { 518e-7, 518e-7 } } }, + /* 12 */ { 0, 2, -2, { { 1237e-6, 463e-6 }, + { -64e-6, 39e-6 }, + { -13e-7, -221e-7 } } }, + /* 13 */ { 0, 2, -1, { { 1086e-6, -911e-6 }, + { -94e-6, 210e-6 }, + { 837e-7, -494e-7 } } }, + /* 14 */ { 0, 2, 0, { { 595e-6, -1229e-6 }, + { -8e-6, -160e-6 }, + { -281e-7, 616e-7 } } }, + /* 15 */ { 1, -1, 0, { { 2484e-6, -485e-6 }, + { -177e-6, 259e-6 }, + { 260e-7, -395e-7 } } }, + /* 16 */ { 1, -1, 1, { { 839e-6, -1414e-6 }, + { 17e-6, 234e-6 }, + { -191e-7, -396e-7 } } }, + /* 17 */ { 1, 0, -3, { { -964e-6, 1059e-6 }, + { 582e-6, -285e-6 }, + { -3218e-7, 370e-7 } } }, + /* 18 */ { 1, 0, -2, { { -2303e-6, -1038e-6 }, + { -298e-6, 692e-6 }, + { 8019e-7, -7869e-7 } } }, + /* 19 */ { 1, 0, -1, { { 7049e-6, 747e-6 }, + { 157e-6, 201e-6 }, + { 105e-7, 45637e-7 } } }, + /* 20 */ { 1, 0, 0, { { 1179e-6, -358e-6 }, + { 304e-6, 825e-6 }, + { 8623e-7, 8444e-7 } } }, + /* 21 */ { 1, 0, 1, { { 393e-6, -63e-6 }, + { -124e-6, -29e-6 }, + { -896e-7, -801e-7 } } }, + /* 22 */ { 1, 0, 2, { { 111e-6, -268e-6 }, + { 15e-6, 8e-6 }, + { 208e-7, -122e-7 } } }, + /* 23 */ { 1, 0, 3, { { -52e-6, -154e-6 }, + { 7e-6, 15e-6 }, + { -133e-7, 65e-7 } } }, + /* 24 */ { 1, 0, 4, { { -78e-6, -30e-6 }, + { 2e-6, 2e-6 }, + { -16e-7, 1e-7 } } }, + /* 25 */ { 1, 1, -3, { { -34e-6, -26e-6 }, + { 4e-6, 2e-6 }, + { -22e-7, 7e-7 } } }, + /* 26 */ { 1, 1, -2, { { -43e-6, 1e-6 }, + { 3e-6, 0e-6 }, + { -8e-7, 16e-7 } } }, + /* 27 */ { 1, 1, -1, { { -15e-6, 21e-6 }, + { 1e-6, -1e-6 }, + { 2e-7, 9e-7 } } }, + /* 28 */ { 1, 1, 0, { { -1e-6, 15e-6 }, + { 0e-6, -2e-6 }, + { 12e-7, 5e-7 } } }, + /* 29 */ { 1, 1, 1, { { 4e-6, 7e-6 }, + { 1e-6, 0e-6 }, + { 1e-7, -3e-7 } } }, + /* 30 */ { 1, 1, 3, { { 1e-6, 5e-6 }, + { 1e-6, -1e-6 }, + { 1e-7, 0e-7 } } }, + /* 31 */ { 2, 0, -6, { { 8e-6, 3e-6 }, + { -2e-6, -3e-6 }, + { 9e-7, 5e-7 } } }, + /* 32 */ { 2, 0, -5, { { -3e-6, 6e-6 }, + { 1e-6, 2e-6 }, + { 2e-7, -1e-7 } } }, + /* 33 */ { 2, 0, -4, { { 6e-6, -13e-6 }, + { -8e-6, 2e-6 }, + { 14e-7, 10e-7 } } }, + /* 34 */ { 2, 0, -3, { { 10e-6, 22e-6 }, + { 10e-6, -7e-6 }, + { -65e-7, 12e-7 } } }, + /* 35 */ { 2, 0, -2, { { -57e-6, -32e-6 }, + { 0e-6, 21e-6 }, + { 126e-7, -233e-7 } } }, + /* 36 */ { 2, 0, -1, { { 157e-6, -46e-6 }, + { 8e-6, 5e-6 }, + { 270e-7, 1068e-7 } } }, + /* 37 */ { 2, 0, 0, { { 12e-6, -18e-6 }, + { 13e-6, 16e-6 }, + { 254e-7, 155e-7 } } }, + /* 38 */ { 2, 0, 1, { { -4e-6, 8e-6 }, + { -2e-6, -3e-6 }, + { -26e-7, -2e-7 } } }, + /* 39 */ { 2, 0, 2, { { -5e-6, 0e-6 }, + { 0e-6, 0e-6 }, + { 7e-7, 0e-7 } } }, + /* 40 */ { 2, 0, 3, { { 3e-6, 4e-6 }, + { 0e-6, 1e-6 }, + { -11e-7, 4e-7 } } }, + /* 41 */ { 3, 0, -2, { { -1e-6, -1e-6 }, + { 0e-6, 1e-6 }, + { 4e-7, -14e-7 } } }, + /* 42 */ { 3, 0, -1, { { 6e-6, -3e-6 }, + { 0e-6, 0e-6 }, + { 18e-7, 35e-7 } } }, + /* 43 */ { 3, 0, 0, { { -1e-6, -2e-6 }, + { 0e-6, 1e-6 }, + { 13e-7, 3e-7 } } } }; + + + +/* Validate the planet number. */ + if ( np < 1 || np > 9 ) { + *jstat = -1; + for ( i = 0; i <= 5; i++ ) pv[i] = 0.0; + return; + } else { + ip = np - 1; + } + +/* Separate algorithms for Pluto and the rest. */ + if ( np != 9 ) { + + /* ----------------------- */ + /* Mercury through Neptune */ + /* ----------------------- */ + + /* Time: Julian millennia since J2000. */ + t = ( date - 51544.5 ) / 365250.0; + + /* OK status unless remote epoch. */ + *jstat = ( fabs ( t ) <= 1.0 ) ? 0 : 1; + + /* Compute the mean elements. */ + da = a[ip][0] + ( a[ip][1] + a[ip][2] * t ) * t; + dl = ( 3600.0 * dlm[ip][0] + ( dlm[ip][1] + dlm[ip][2] * t ) * t ) + * DAS2R; + de = e[ip][0] + ( e[ip][1] + e[ip][2] * t ) * t; + dpe = dmod ( ( 3600.0 * pi[ip][0] + ( pi[ip][1] + pi[ip][2] * t ) * t ) + * DAS2R,D2PI ); + di = ( 3600.0 * dinc[ip][0] + ( dinc[ip][1] + dinc[ip][2] * t ) * t ) + * DAS2R; + dom = dmod( ( 3600.0 * omega[ip][0] + ( omega[ip][1] + + omega[ip][2] * t ) * t ) * DAS2R, D2PI ); + + /* Apply the trigonometric terms. */ + dmu = 0.35953620 * t; + for ( j = 0; j <= 7; j++ ) { + arga = dkp[ip][j] * dmu; + argl = dkq[ip][j] * dmu; + da += ( ca[ip][j] * cos ( arga ) + + sa[ip][j] * sin ( arga ) ) * 1e-7; + dl += ( clo[ip][j] * cos ( argl ) + + slo[ip][j] * sin ( argl ) ) * 1e-7; + } + arga = dkp[ip][8] * dmu; + da += t * ( ca[ip][8] * cos ( arga ) + + sa[ip][8] * sin ( arga ) ) * 1e-7; + for ( j = 8; j <= 9; j++ ) { + argl = dkq[ip][j] * dmu; + dl += t * ( clo[ip][j] * cos ( argl ) + + slo[ip][j] * sin ( argl ) ) * 1e-7; + } + dl = dmod ( dl, D2PI ); + + /* Daily motion. */ + dm = GCON * sqrt ( ( 1.0 + 1.0 / amas[ip] ) / ( da * da * da ) ); + + /* Make the prediction. */ + slaPlanel ( date, 1, date, di, dom, dpe, da, de, dl, dm, pv, &j ); + if ( j < 0 ) *jstat = -2; + + + } else { + + /* ----- */ + /* Pluto */ + /* ----- */ + + /* Time: Julian centuries since J2000. */ + t = ( date - 51544.5 ) / 36525.0; + + /* OK status unless remote epoch. */ + *jstat = t >= -1.15 && t <= 1.0 ? 0 : -1; + + /* Fundamental arguments (radians). */ + dj = ( dj0 + djd * t ) * DD2R; + ds = ( ds0 + dsd * t ) * DD2R; + dp = ( dp0 + dpd * t ) * DD2R; + + /* Initialize coefficients and derivatives. */ + for ( i = 0; i < 3; i++ ) { + wlbr[i] = 0.0; + wlbrd[i] = 0.0; + } + + /* Term by term through Meeus Table 36.A. */ + for ( j = 0; j < ( sizeof term / sizeof term[0] ); j++ ) { + + /* Argument and derivative (radians, radians per century). */ + wj = (double) ( term[j].ij ); + ws = (double) ( term[j].is ); + wp = (double) ( term[j].ip ); + al = wj * dj + ws * ds + wp * dp; + ald = ( wj * djd + ws * dsd + wp * dpd ) * DD2R; + + /* Functions of argument. */ + sal = sin ( al ); + cal = cos ( al ); + + /* Periodic terms in longitude, latitude, radius vector. */ + for ( i = 0; i < 3; i++ ) { + + /* A and B coefficients (deg, AU). */ + ac = term[j].dlbr[i].a; + bc = term[j].dlbr[i].b; + + /* Periodic terms (deg, AU, deg/Jc, AU/Jc). */ + wlbr[i] = wlbr[i] + ac * sal + bc * cal; + wlbrd[i] = wlbrd[i] + ( ac * cal - bc * sal ) * ald; + } + } + + /* Heliocentric longitude and derivative (radians, radians/sec). */ + dl = ( dl0 + dld0 * t + wlbr[0] ) * DD2R; + dld = ( dld0 + wlbrd[0] ) * DD2R / SPC; + + /* Heliocentric latitude and derivative (radians, radians/sec). */ + db = ( db0 + wlbr[1] ) * DD2R; + dbd = wlbrd[1] * DD2R / SPC; + + /* Heliocentric radius vector and derivative (AU, AU/sec). */ + dr = dr0 + wlbr[2]; + drd = wlbrd[2] / SPC; + + /* Functions of latitude, longitude, radius vector. */ + sl = sin ( dl ); + cl = cos ( dl ); + sb = sin ( db ); + cb = cos ( db ); + slcb = sl * cb; + clcb = cl * cb; + + /* Heliocentric vector and derivative, J2000 ecliptic and equinox. */ + x = dr * clcb; + y = dr * slcb; + z = dr * sb; + xd = drd * clcb - dr * ( cl * sb * dbd + slcb * dld ); + yd = drd * slcb + dr * ( - sl * sb * dbd + clcb * dld ); + zd = drd * sb + dr * cb * dbd; + + /* Transform to J2000 equator and equinox. */ + pv[0] = x; + pv[1] = y * CE - z * SE; + pv[2] = y * SE + z * CE; + pv[3] = xd; + pv[4] = yd * CE - zd * SE; + pv[5] = yd * SE + zd * CE; + } +} Index: trunk/MagicSoft/slalib/plante.c =================================================================== --- trunk/MagicSoft/slalib/plante.c (revision 731) +++ trunk/MagicSoft/slalib/plante.c (revision 731) @@ -0,0 +1,150 @@ +#include "slalib.h" +#include "slamac.h" +void slaPlante ( double date, double elong, double phi, int jform, + double epoch, double orbinc, double anode, double perih, + double aorq, double e, double aorl, double dm, + double* ra, double* dec, double* r, int* jstat ) +/* +** - - - - - - - - - - +** s l a P l a n t e +** - - - - - - - - - - +** +** Topocentric apparent RA,Dec of a Solar-System object whose +** heliocentric orbital elements are known. +** +** Given: +** date double MJD of observation (JD - 2400000.5) +** elong double observer's east longitude (radians) +** phi double observer's geodetic latitude (radians) +** jform int choice of element set (1-3; Note 2) +** epoch double epoch of elements (TT MJD) +** orbinc double inclination (radians) +** anode double longitude of the ascending node (radians) +** perih double longitude or argument of perihelion (radians) +** aorq double mean distance or perihelion distance (AU) +** e double eccentricity +** aorl double mean anomaly or longitude (radians, jform=1,2 only) +** dm double daily motion (radians, jform=1 only ) +** +** Returned: +** ra,dec double RA, Dec (topocentric apparent, radians) +** r double distance from observer (AU) +** jstat int status: 0 = OK +** -1 = illegal jform +** -2 = illegal e +** -3 = illegal aorq +** -4 = illegal dm +** -5 = numerical error +** +** Notes: +** +** 1 date is the instant for which the prediction is required. +** It is in the TT timescale (formerly Ephemeris Time, ET) +** and is a Modified Julian Date (JD-2400000.5). +** +** 2 The longitude and latitude allow correction for geocentric +** parallax. This is usually a small effect, but can become +** important for Earth-crossing asteroids. Geocentric positions +** can be generated by appropriate use of the routines slaEvp and +** slaPlanel. +** +** 3 The elements are with respect to the J2000 ecliptic and equinox. +** +** 4 Three different element-format options are available: +** +** Option jform=1, suitable for the major planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = longitude of perihelion, curly pi (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e +** aorl = mean longitude L (radians) +** dm = daily motion (radians) +** +** Option jform=2, suitable for minor planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e +** aorl = mean anomaly M (radians) +** +** Option jform=3, suitable for comets: +** +** epoch = epoch of perihelion (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = perihelion distance, q (AU) +** e = eccentricity, e +** +** 5 Unused elements (dm for jform=2, aorl and dm for jform=3) are +** not accessed. +** +** Called: slaGmst, slaDt, slaEpj, slaPvobs, slaPrenut, +** slaPlanel, slaDmxv, slaDcc2s, slaDranrm +** +** Last revision: 17 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Light time for unit distance (sec) */ +#define TAU 499.004782 + +{ + int i; + double dvb[3], dpb[3], vsg[6], vsp[6], v[6], + rmat[3][3], vgp[6], stl, vgo[6], + dx, dy, dz, tl; + + +/* Sun to geocentre (J2000). */ + slaEvp( date, 2000.0, dvb, dpb, &vsg[3], &vsg[0] ); + +/* Sun to planet (J2000). */ + slaPlanel ( date, jform, epoch, orbinc, anode, perih, aorq, + e, aorl, dm, vsp, jstat ); + +/* Geocentre to planet (J2000). */ + for ( i = 0; i < 6; i++ ) { + v[i] = vsp[i] - vsg[i]; + } + +/* Precession and nutation to date. */ + slaPrenut ( 2000.0, date, rmat ); + slaDmxv ( rmat, v, vgp ); + slaDmxv ( rmat, &v[3], &vgp[3] ); + +/* Geocentre to observer (date). */ + stl = slaGmst ( date - slaDt ( slaEpj ( date ) ) / 86400.0 ) + elong; + slaPvobs ( phi, 0.0, stl, vgo ); + +/* Observer to planet (date). */ + for ( i = 0; i < 6; i++ ) { + v[i] = vgp[i] - vgo[i]; + } + +/* Geometric distance (AU). */ + dx = v[0]; + dy = v[1]; + dz = v[2]; + *r = sqrt ( dx * dx + dy * dy + dz * dz ); + +/* Light time (sec). */ + tl = *r * TAU; + +/* Correct position for planetary aberration. */ + for ( i = 0; i < 3; i++ ) { + v[i] = v[i] - tl * v[i+3]; + } + +/* To RA,Dec. */ + slaDcc2s ( v, ra, dec ); + *ra = slaDranrm ( *ra ); + return; +} Index: trunk/MagicSoft/slalib/pm.c =================================================================== --- trunk/MagicSoft/slalib/pm.c (revision 731) +++ trunk/MagicSoft/slalib/pm.c (revision 731) @@ -0,0 +1,73 @@ +#include "slalib.h" +#include "slamac.h" +void slaPm ( double r0, double d0, double pr, double pd, + double px, double rv, double ep0, double ep1, + double *r1, double *d1 ) +/* +** - - - - - - +** s l a P m +** - - - - - - +** +** Apply corrections for proper motion to a star RA,Dec. +** +** (double precision) +** +** References: +** 1984 Astronomical Almanac, pp B39-B41. +** (also Lederle & Schwan, Astron. Astrophys. 134, 1-6, 1984) +** +** Given: +** r0,d0 double RA,Dec at epoch ep0 (rad) +** pr,pd double proper motions: RA,Dec changes per year of epoch +** px double parallax (arcsec) +** rv double radial velocity (km/sec, +ve if receding) +** ep0 double start epoch in years (e.g Julian epoch) +** ep1 double end epoch in years (same system as ep0) +** +** Returned: +** *r1,*d1 double RA,Dec at epoch ep1 (rad) +** +** Notes: +** +** 1 The proper motions in RA are dRA/dt rather than cos(Dec)*dRA/dt, +** and are in the same coordinate system as R0,D0. +** +** 2 If the available proper motions are pre-FK5 they will be per +** tropical year rather than per Julian year, and so the epochs +** must both be Besselian rather than Julian. In such cases, a +** scaling factor of 365.2422D0/365.25D0 should be applied to the +** radial velocity before use. +** +** Called: slaDcs2c, slaDcc2s, slaDranrm +** +** Defined in slamac.h: DAS2R +** +** Last revision: 19 January 2000 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Km/s to AU/year multiplied by arc seconds to radians */ + static double vfr = ( 365.25 * 86400.0 / 149597870.0 ) * DAS2R; + + int i; + double w, em[3], t, p[3]; + +/* Spherical to Cartesian */ + slaDcs2c ( r0, d0, p ); + +/* Space motion (radians per year) */ + w = vfr * rv * px; + em[0] = - pr * p[1] - pd * cos ( r0 ) * sin ( d0 ) + w * p[0]; + em[1] = pr * p[0] - pd * sin ( r0 ) * sin ( d0 ) + w * p[1]; + em[2] = pd * cos ( d0 ) + w * p[2]; + +/* Apply the motion */ + t = ep1 - ep0; + for ( i = 0; i < 3; i++ ) + p[i] = p[i] + (t * em[i]); + +/* Cartesian to spherical */ + slaDcc2s ( p, r1, d1 ); + *r1 = slaDranrm ( *r1 ); +} Index: trunk/MagicSoft/slalib/polmo.c =================================================================== --- trunk/MagicSoft/slalib/polmo.c (revision 731) +++ trunk/MagicSoft/slalib/polmo.c (revision 731) @@ -0,0 +1,133 @@ +#include "slalib.h" +#include "slamac.h" +void slaPolmo ( double elongm, double phim, double xp, double yp, + double *elong, double *phi, double *daz ) +/* +** - - - - - - - - - +** s l a P o l m o +** - - - - - - - - - +** +** Polar motion: correct site longitude and latitude for polar +** motion and calculate azimuth difference between celestial and +** terrestrial poles. +** +** Given: +** elongm double mean longitude of the observer (radians, east +ve) +** phim double mean geodetic latitude of the observer (radians) +** xp double polar motion x-coordinate (radians) +** yp double polar motion y-coordinate (radians) +** +** Returned: +** elong double* true longitude of the observer (radians, east +ve) +** phi double* true geodetic latitude of the observer (radians) +** daz double* azimuth correction (terrestrial-celestial, radians) +** +** Notes: +** +** 1) "Mean" longitude and latitude are the (fixed) values for the +** site's location with respect to the IERS terrestrial reference +** frame; the latitude is geodetic. TAKE CARE WITH THE LONGITUDE +** SIGN CONVENTION. The longitudes used by the present routine +** are east-positive, in accordance with geographical convention +** (and right-handed). In particular, note that the longitudes +** Returned by the slaObs routine are west-positive, following +** astronomical usage, and must be reversed in sign before use in +** the present routine. +** +** 2) xp and yp are the (changing) coordinates of the Celestial +** Ephemeris Pole with respect to the IERS Reference Pole. +** xp is positive along the meridian at longitude 0 degrees, +** and yp is positive along the meridian at longitude +** 270 degrees (i.e. 90 degrees west). Values for xp,yp can +** be obtained from IERS circulars and equivalent publications; +** the maximum amplitude observed so far is about 0.3 arcseconds. +** +** 3) "True" longitude and latitude are the (moving) values for +** the site's location with respect to the celestial ephemeris +** pole and the meridian which corresponds to the Greenwich +** apparent sidereal time. The true longitude and latitude +** link the terrestrial coordinates with the standard celestial +** models (for precession, nutation, sidereal time etc). +** +** 4) The azimuths produced by slaAop and slaAopqk are with +** respect to due north as defined by the Celestial Ephemeris +** Pole, and can therefore be called "celestial azimuths". +** However, a telescope fixed to the Earth measures azimuth +** essentially with respect to due north as defined by the +** IERS Reference Pole, and can therefore be called "terrestrial +** azimuth". Uncorrected, this would manifest itself as a +** changing "azimuth zero-point error". The value daz is the +** correction to be added to a celestial azimuth to produce +** a terrestrial azimuth. +** +** 5) The present routine is rigorous. For most practical +** purposes, the following simplified formulae provide an +** adequate approximation: +** +** elong = elongm+xp*cos(elongm)-yp*sin(elongm); +** phi = phim+(xp*sin(elongm)+yp*cos(elongm))*tan(phim); +** daz = -sqrt(xp*xp+yp*yp)*cos(elongm-atan2(xp,yp))/cos(phim); +** +** An alternative formulation for daz is: +** +** x = cos(elongm)*cos(phim); +** y = sin(elongm)*cos(phim); +** daz = atan2(-x*yp-y*xp,x*x+y*y); +** +** Reference: Seidelmann, P.K. (ed), 1992. "Explanatory Supplement +** to the Astronomical Almanac", ISBN 0-935702-68-7, +** sections 3.27, 4.25, 4.52. +** +** Last revision: 22 February 1996 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double sel, cel, sph, cph, xm, ym, zm, xnm, ynm, znm, + sxp, cxp, syp, cyp, zw, xt, yt, zt, xnt, ynt; + + + +/* Site mean longitude and mean geodetic latitude as a Cartesian vector. */ + sel = sin ( elongm ); + cel = cos ( elongm ); + sph = sin ( phim ); + cph = cos ( phim ); + + xm = cel * cph; + ym = sel * cph; + zm = sph; + +/* Rotate site vector by polar motion, Y-component then X-component. */ + sxp = sin ( xp ); + cxp = cos ( xp ); + syp = sin ( yp ); + cyp = cos ( yp ); + + zw = ( - ym * syp + zm * cyp ); + + xt = xm * cxp - zw * sxp; + yt = ym * cyp + zm * syp; + zt = xm * sxp + zw * cxp; + +/* Rotate also the geocentric direction of the terrestrial pole (0,0,1). */ + xnm = - sxp * cyp; + ynm = syp; + znm = cxp * cyp; + + cph = sqrt ( xt * xt + yt * yt ); + if ( cph == 0.0 ) xt = 1.0; + sel = yt / cph; + cel = xt / cph; + +/* Return true longitude and true geodetic latitude of site. */ + *elong = atan2 ( yt, xt ); + *phi = atan2 ( zt, cph ); + +/* Return current azimuth of terrestrial pole seen from site position. */ + xnt = ( xnm * cel + ynm * sel ) * zt - znm * cph; + ynt = - xnm * sel + ynm * cel; + *daz = atan2 ( - ynt, - xnt ); + + return; +} Index: trunk/MagicSoft/slalib/prebn.c =================================================================== --- trunk/MagicSoft/slalib/prebn.c (revision 731) +++ trunk/MagicSoft/slalib/prebn.c (revision 731) @@ -0,0 +1,54 @@ +#include "slalib.h" +#include "slamac.h" +void slaPrebn ( double bep0, double bep1, double rmatp[3][3] ) +/* +** - - - - - - - - - +** s l a P r e b n +** - - - - - - - - - +** +** Generate the matrix of precession between two epochs, +** using the old, pre-IAU1976, Bessel-Newcomb model, using +** Kinoshita's formulation (double precision) +** +** Given: +** BEP0 double beginning Besselian epoch +** BEP1 double ending Besselian epoch +** +** Returned: +** RMATP double[3][3] precession matrix +** +** The matrix is in the sense v(bep1) = rmatp * v(bep0) +** +** Reference: +** Kinoshita, H. (1975) 'Formulas for precession', SAO Special +** Report No. 364, Smithsonian Institution Astrophysical +** Observatory, Cambridge, Massachusetts. +** +** Called: slaDeuler +** +** Defined in slamac.h: DAS2R +** +** Last revision: 30 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double bigt, t, tas2r, w, zeta, z, theta; + +/* Interval between basic epoch B1850.0 and beginning epoch in TC */ + bigt = ( bep0 - 1850.0 ) / 100.0; + +/* Interval over which precession required, in tropical centuries */ + t = ( bep1 - bep0 ) / 100.0; + +/* Euler angles */ + tas2r = t * DAS2R; + w = 2303.5548 + ( 1.39720 + 0.000059 * bigt ) * bigt; + zeta = (w + ( 0.30242 - 0.000269 * bigt + 0.017996 * t ) * t ) * tas2r; + z = (w + ( 1.09478 + 0.000387 * bigt + 0.018324 * t ) * t ) * tas2r; + theta = ( 2005.1125 + ( - 0.85294 - 0.000365* bigt ) * bigt + + ( - 0.42647 - 0.000365 * bigt - 0.041802 * t ) * t ) * tas2r; + +/* Rotation matrix */ + slaDeuler ( "ZYZ", -zeta, theta, -z, rmatp ); +} Index: trunk/MagicSoft/slalib/prec.c =================================================================== --- trunk/MagicSoft/slalib/prec.c (revision 731) +++ trunk/MagicSoft/slalib/prec.c (revision 731) @@ -0,0 +1,72 @@ +#include "slalib.h" +#include "slamac.h" +void slaPrec ( double ep0, double ep1, double rmatp[3][3] ) +/* +** - - - - - - - - +** s l a P r e c +** - - - - - - - - +** +** Form the matrix of precession between two epochs (IAU 1976, FK5). +** +** (double precision) +** +** Given: +** ep0 double beginning epoch +** ep1 double ending epoch +** +** Returned: +** rmatp double[3][3] precession matrix +** +** Notes: +** +** 1) The epochs are TDB (loosely ET) Julian epochs. +** +** 2) The matrix is in the sense v(ep1) = rmatp * v(ep0) . +** +** 3) Though the matrix method itself is rigorous, the precession +** angles are expressed through canonical polynomials which are +** valid only for a limited time span. There are also known +** errors in the IAU precession rate. The absolute accuracy +** of the present formulation is better than 0.1 arcsec from +** 1960AD to 2040AD, better than 1 arcsec from 1640AD to 2360AD, +** and remains below 3 arcsec for the whole of the period +** 500BC to 3000AD. The errors exceed 10 arcsec outside the +** range 1200BC to 3900AD, exceed 100 arcsec outside 4200BC to +** 5600AD and exceed 1000 arcsec outside 6800BC to 8200AD. +** The SLALIB routine slaPrecl implements a more elaborate +** model which is suitable for problems spanning several +** thousand years. +** +** References: +** Lieske,J.H., 1979. Astron. Astrophys.,73,282. +** equations (6) & (7), p283. +** Kaplan,G.H., 1981. USNO circular no. 163, pa2. +** +** Called: slaDeuler +** +** Defined in slamac.h: DAS2R +** +** Last revision: 10 July 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double t0, t, tas2r, w, zeta, z, theta; + +/* Interval between basic epoch J2000.0 and beginning epoch (JC) */ + t0 = ( ep0 - 2000.0 ) / 100.0; + +/* Interval over which precession required (JC) */ + t = ( ep1 - ep0 ) / 100.0; + +/* Euler angles */ + tas2r = t * DAS2R; + w = 2306.2181 + ( ( 1.39656 - ( 0.000139 * t0 ) ) * t0 ); + zeta = (w + ( ( 0.30188 - 0.000344 * t0 ) + 0.017998 * t ) * t ) * tas2r; + z = (w + ( ( 1.09468 + 0.000066 * t0 ) + 0.018203 * t ) * t ) * tas2r; + theta = ( ( 2004.3109 + ( - 0.85330 - 0.000217 * t0 ) * t0 ) + + ( ( -0.42665 - 0.000217 * t0 ) - 0.041833 * t ) * t ) * tas2r; + +/* Rotation matrix */ + slaDeuler ( "ZYZ", -zeta, theta, -z, rmatp ); +} Index: trunk/MagicSoft/slalib/preces.c =================================================================== --- trunk/MagicSoft/slalib/preces.c (revision 731) +++ trunk/MagicSoft/slalib/preces.c (revision 731) @@ -0,0 +1,71 @@ +#include "slalib.h" +#include "slamac.h" +#include +void slaPreces ( char sys[3], double ep0, double ep1, + double *ra, double *dc ) +/* +** - - - - - - - - - - +** s l a P r e c e s +** - - - - - - - - - - +** +** Precession - either FK4 (Bessel-Newcomb, pre-IAU1976) or +** FK5 (Fricke, post-IAU1976) as required. +** +** Given: +** sys char[] precession to be applied: "FK4" or "FK5" +** ep0,ep1 double starting and ending epoch +** ra,dc double RA,Dec, mean equator & equinox of epoch ep0 +** +** Returned: +** *ra,*dc double RA,Dec, mean equator & equinox of epoch ep1 +** +** Called: slaDranrm, slaPrebn, slaPrec, slaDcs2c, +** slaDmxv, slaDcc2s +** +** Notes: +** +** 1) The epochs are Besselian if sys='FK4' and Julian if 'FK5'. +** For example, to precess coordinates in the old system from +** equinox 1900.0 to 1950.0 the call would be: +** slaPreces ( "FK4", 1900.0, 1950.0, &ra, &dc ) +** +** 2) This routine will not correctly convert between the old and +** the new systems - for example conversion from B1950 to J2000. +** For these purposes see slaFk425, slaFk524, slaFk45z and +** slaFk54z. +** +** 3) If an invalid sys is supplied, values of -99.0,-99.0 will +** be returned for both ra and dc. +** +** Last revision: 22 December 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double pm[3][3], v1[3], v2[3]; + +/* Validate sys */ + if ( ( toupper ( sys[0] ) != 'F' ) + || ( toupper ( sys[1] ) != 'K' ) + || ( sys[2] != '4' && sys[2] != '5' ) ) { + *ra = -99.0; /* Error */ + *dc = -99.0; + } else { + + /* Generate appropriate precession matrix */ + if ( sys[2] == '4' ) + slaPrebn ( ep0, ep1, pm ); + else + slaPrec ( ep0, ep1, pm ); + + /* Convert RA,Dec to x,y,z */ + slaDcs2c ( *ra, *dc, v1 ); + + /* Precess */ + slaDmxv ( pm, v1, v2 ); + + /* Back to RA,Dec */ + slaDcc2s ( v2, ra, dc ); + *ra = slaDranrm ( *ra ); + } +} Index: trunk/MagicSoft/slalib/precl.c =================================================================== --- trunk/MagicSoft/slalib/precl.c (revision 731) +++ trunk/MagicSoft/slalib/precl.c (revision 731) @@ -0,0 +1,120 @@ +#include "slalib.h" +#include "slamac.h" +void slaPrecl ( double ep0, double ep1, double rmatp[3][3] ) +/* +** - - - - - - - - - +** s l a P r e c l +** - - - - - - - - - +** +** Form the matrix of precession between two epochs, using the +** model of Simon et al (1994), which is suitable for long +** periods of time. +** +** (double precision) +** +** Given: +** ep0 double beginning epoch +** ep1 double ending epoch +** +** Returned: +** rmatp double[3][3] precession matrix +** +** Notes: +** +** 1) The epochs are TDB (loosely ET) Julian epochs. +** +** 2) The matrix is in the sense v(ep1) = rmatp * v(ep0) . +** +** 3) The absolute accuracy of the model is limited by the +** uncertainty in the general precession, about 0.3 arcsec per +** 1000 years. The remainder of the formulation provides a +** precision of 1 mas over the interval from 1000AD to 3000AD, +** 0.1 arcsec from 1000BC to 5000AD and 1 arcsec from +** 4000BC to 8000AD. +** +** Reference: +** Simon, J.L., et al., 1994. Astron.Astrophys., 282, 663-683. +** +** Called: slaDeuler +** +** Defined in slamac.h: DAS2R +** +** Last revision: 23 August 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double t0, t, tas2r, w, zeta, z, theta; + +/* Interval between basic epoch J2000.0 and beginning epoch (1000JY) */ + t0 = ( ep0 - 2000.0 ) / 1000.0; + +/* Interval over which precession required (1000JY) */ + t = ( ep1 - ep0 ) / 1000.0; + +/* Euler angles */ + tas2r = t * DAS2R; + w = 23060.9097 + + ( 139.7459 + + ( - 0.0038 + + ( - 0.5918 + + ( - 0.0037 + + 0.0007 * t0 ) * t0 ) * t0 ) * t0 ) * t0; + + zeta = ( w + + ( 30.2226 + + ( - 0.2523 + + ( - 0.3840 + + ( - 0.0014 + + 0.0007 * t0 ) * t0 ) * t0 ) * t0 + + ( 18.0183 + + ( - 0.1326 + + ( 0.0006 + + 0.0005 * t0 ) * t0 ) * t0 + + ( - 0.0583 + + ( - 0.0001 + + 0.0007 * t0 ) * t0 + + ( - 0.0285 + + ( - 0.0002 ) * t ) * t ) * t ) * t ) * t ) * tas2r; + + z = ( w + + ( 109.5270 + + ( 0.2446 + + ( - 1.3913 + + ( - 0.0134 + + 0.0026 * t0 ) * t0 ) * t0 ) * t0 + + ( 18.2667 + + ( - 1.1400 + + ( - 0.0173 + + 0.0044 * t0 ) * t0 ) * t0 + + ( - 0.2821 + + ( - 0.0093 + + 0.0032 * t0 ) * t0 + + ( -0.0301 + + 0.0006 * t0 + - 0.0001 * t ) * t ) * t ) * t ) * t ) * tas2r; + + theta = ( 20042.0207 + + ( - 85.3131 + + ( - 0.2111 + + ( 0.3642 + + ( 0.0008 + + ( - 0.0005 ) * t0 ) * t0 ) * t0 ) * t0 ) * t0 + + ( - 42.6566 + + ( - 0.2111 + + ( 0.5463 + + ( 0.0017 + + ( - 0.0012 ) * t0 ) * t0 ) * t0 ) * t0 + + ( - 41.8238 + + ( 0.0359 + + ( 0.0027 + + ( - 0.0001 ) * t0 ) * t0 ) * t0 + + ( - 0.0731 + + ( 0.0019 + + 0.0009 * t0 ) * t0 + + ( - 0.0127 + + 0.0011 * t0 + 0.0004 * t ) * t ) * t ) * t ) * t ) * tas2r; + +/* Rotation matrix */ + slaDeuler ( "ZYZ", -zeta, theta, -z, rmatp ); +} Index: trunk/MagicSoft/slalib/prenut.c =================================================================== --- trunk/MagicSoft/slalib/prenut.c (revision 731) +++ trunk/MagicSoft/slalib/prenut.c (revision 731) @@ -0,0 +1,45 @@ +#include "slalib.h" +#include "slamac.h" +void slaPrenut ( double epoch, double date, double rmatpn[3][3] ) +/* +** - - - - - - - - - - +** s l a P r e n u t +** - - - - - - - - - - +** +** Form the matrix of precession and nutation (IAU 1976 / FK5) +** +** (double precision) +** +** Given: +** epoch double Julian epoch for mean coordinates +** date double Modified Julian Date (JD-2400000.5) +** for true coordinates +** +** +** Returned: +** rmatpn double[3][3] combined precession/nutation matrix +** +** Called: slaPrec, slaEpj, slaNut, slaDmxm +** +** Notes: +** +** 1) The epoch and date are TDB (loosely ET). +** +** 2) The matrix is in the sense v(true) = rmatpn * v(mean) . +** +** Last revision: 15 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double rmatp[3][3], rmatn[3][3]; + +/* Precession */ + slaPrec ( epoch, slaEpj ( date ), rmatp ); + +/* Nutation */ + slaNut ( date, rmatn ); + +/* Combine the matrices: pn = n x p */ + slaDmxm ( rmatn, rmatp, rmatpn ); +} Index: trunk/MagicSoft/slalib/pv2el.c =================================================================== --- trunk/MagicSoft/slalib/pv2el.c (revision 731) +++ trunk/MagicSoft/slalib/pv2el.c (revision 731) @@ -0,0 +1,343 @@ +#include "slalib.h" +#include "slamac.h" +void slaPv2el ( double pv[], double date, double pmass, int jformr, + int *jform, double *epoch, double *orbinc, + double *anode, double *perih, double *aorq, double *e, + double *aorl, double *dm, int *jstat ) +/* +** - - - - - - - - - +** s l a P v 2 e l +** - - - - - - - - - +** +** Heliocentric osculating elements obtained from instantaneous position +** and velocity. +** +** Given: +** pv double[6] heliocentric x,y,z,xdot,ydot,zdot of date, +** J2000 equatorial triad (AU,AU/s; Note 1) +** date double date (TT Modified Julian Date = JD-2400000.5) +** pmass double mass of the planet (Sun=1; Note 2) +** jformr int requested element set (1-3; Note 3) +** +** Returned: +** jform double* element set actually returned (1-3; Note 4) +** epoch double* epoch of elements (TT MJD) +** orbinc double* inclination (radians) +** anode double* longitude of the ascending node (radians) +** perih double* longitude or argument of perihelion (radians) +** aorq double* mean distance or perihelion distance (AU) +** e double* eccentricity +** aorl double* mean anomaly or longitude (radians, jform=1,2 only) +** dm double* daily motion (radians, jform=1 only) +** jstat int* status: 0 = OK +** -1 = illegal pmass +** -2 = illegal jformr +** -3 = position/velocity out of range +** +** Notes +** +** 1 The pv 6-vector is with respect to the mean equator and equinox of +** epoch J2000. The orbital elements produced are with respect to +** the J2000 ecliptic and mean equinox. +** +** 2 The mass, pmass, is important only for the larger planets. For +** most purposes (e.g. asteroids) use 0.0. Values less than zero +** are illegal. +** +** 3 Three different element-format options are supported: +** +** Option jformr=1, suitable for the major planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = longitude of perihelion, curly pi (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e +** aorl = mean longitude L (radians) +** dm = daily motion (radians) +** +** Option jformr=2, suitable for minor planets: +** +** epoch = epoch of elements (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = mean distance, a (AU) +** e = eccentricity, e +** aorl = mean anomaly M (radians) +** +** Option jformr=3, suitable for comets: +** +** epoch = epoch of perihelion (TT MJD) +** orbinc = inclination i (radians) +** anode = longitude of the ascending node, big omega (radians) +** perih = argument of perihelion, little omega (radians) +** aorq = perihelion distance, q (AU) +** e = eccentricity, e +** +** 4 It may not be possible to generate elements in the form +** requested through jformr. The caller is notified of the form +** of elements actually returned by means of the jform argument: +** +** jformr jform meaning +** +** 1 1 OK - elements are in the requested format +** 1 2 never happens +** 1 3 orbit not elliptical +** +** 2 1 never happens +** 2 2 OK - elements are in the requested format +** 2 3 orbit not elliptical +** +** 3 1 never happens +** 3 2 never happens +** 3 3 OK - elements are in the requested format +** +** 5 The arguments returned for each value of jform (cf Note 5: jform +** may not be the same as jformr) are as follows: +** +** jform 1 2 3 +** epoch t0 t0 T +** orbinc i i i +** anode Omega Omega Omega +** perih curly pi omega omega +** aorq a a q +** e e e e +** aorl L M - +** dm n - - +** +** where: +** +** t0 is the epoch of the elements (MJD, TT) +** T " epoch of perihelion (MJD, TT) +** i " inclination (radians) +** Omega " longitude of the ascending node (radians) +** curly pi " longitude of perihelion (radians) +** omega " argument of perihelion (radians) +** a " mean distance (AU) +** q " perihelion distance (AU) +** e " eccentricity +** L " longitude (radians, 0-2pi) +** M " mean anomaly (radians, 0-2pi) +** n " daily motion (radians) +** - means no value is set +** +** 6 At very small inclinations, the longitude of the ascending node +** anode becomes indeterminate and under some circumstances may be +** set arbitrarily to zero. Similarly, if the orbit is close to +** circular, the true anomaly becomes indeterminate and under some +** circumstances may be set arbitrarily to zero. In such cases, +** the other elements are automatically adjusted to compensate, +** and so the elements remain a valid description of the orbit. +** +** Reference: Sterne, Theodore E., "An Introduction to Celestial +** Mechanics", Interscience Publishers, 1960 +** +** Called: slaDranrm +** +** Last revision: 21 February 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Seconds to days */ +#define DAY 86400.0 + +/* Gaussian gravitational constant (exact) */ +#define GCON 0.01720209895 + +/* Sin and cos of J2000 mean obliquity (IAU 1976) */ +#define SE 0.3977771559319137 +#define CE 0.9174820620691818 + +/* Minimum allowed distance (AU) and speed (AU/day) */ +#define RMIN 1e-3 +#define VMIN 1e-8 + +/* How close to unity the eccentricity has to be to call it a parabola */ +#define PARAB 1e-8 + +{ + double x, y, z, xd, yd, zd, r, v2, v, rdv, gmu, hx, hy, hz, + hx2py2, h2, h, oi, bigom, ar, e2, ecc, s, c, at, u, om, + gar3, em1, ep1, hat, shat, chat, ae, am, dn, pl, + el, q, tp, that, thhf, f; + int jf; + + +/* Validate arguments pmass and jformr. */ + if ( pmass < 0.0 ) { + *jstat = -1; + return; + } + if ( jformr < 1 || jformr > 3 ) { + *jstat = -2; + return; + } + +/* Provisionally assume the elements will be in the chosen form. */ + jf = jformr; + +/* Rotate the position from equatorial to ecliptic coordinates. */ + x = pv [ 0 ]; + y = pv [ 1 ] * CE + pv [ 2 ] * SE; + z = - pv [ 1 ] * SE + pv [ 2 ] * CE; + +/* Rotate the velocity similarly, scaling to AU/day. */ + xd = DAY * pv [ 3 ]; + yd = DAY * ( pv [ 4 ] * CE + pv [ 5 ] * SE ); + zd = DAY * ( - pv [ 4 ] * SE + pv [ 5 ] * CE ); + +/* Distance and speed. */ + r = sqrt ( x * x + y * y + z * z ); + v2 = xd * xd + yd * yd + zd * zd; + v = sqrt ( v2 ); + +/* Reject unreasonably small values. */ + if ( r < RMIN || v < VMIN ) { + *jstat = -3; + return; + } + +/* R dot V. */ + rdv = x * xd + y * yd + z * zd; + +/* Mu. */ + gmu = ( 1.0 + pmass ) * GCON * GCON; + +/* Vector angular momentum per unit reduced mass. */ + hx = y * zd - z * yd; + hy = z * xd - x * zd; + hz = x * yd - y * xd; + +/* Areal constant. */ + hx2py2 = hx * hx + hy * hy; + h2 = hx2py2 + hz * hz; + h = sqrt ( h2 ); + +/* Inclination. */ + oi = atan2 ( sqrt ( hx2py2 ), hz ); + +/* Longitude of ascending node. */ + if ( hx != 0.0 || hy != 0.0 ) { + bigom = atan2 ( hx, -hy ); + } else { + bigom = 0.0; + } + +/* Reciprocal of mean distance etc. */ + ar = 2.0 / r - v2 / gmu; + +/* Eccentricity. */ + e2 = 1.0 - ar * h2 / gmu; + ecc = ( e2 >= 0.0 ) ? sqrt ( e2 ) : 0.0; + +/* True anomaly. */ + s = h * rdv; + c = h2 - r * gmu; + if ( s != 0.0 && c != 0.0 ) { + at = atan2 ( s, c ); + } else { + at = 0.0; + } + +/* Argument of the latitude. */ + s = sin ( bigom ); + c = cos ( bigom ); + u = atan2 ( ( - x * s + y * c ) * cos ( oi ) + z * sin ( oi ), + x * c + y * s ); + +/* Argument of perihelion. */ + om = u - at; + +/* Capture near-parabolic cases. */ + if ( fabs ( ecc - 1.0 ) < PARAB ) ecc = 1.0; + +/* Comply with jformr = 1 or 2 only if orbit is elliptical. */ + if ( ecc >= 1.0 ) jf = 3; + +/* Functions. */ + gar3 = gmu * ar * ar * ar; + em1 = ecc - 1.0; + ep1 = ecc + 1.0; + hat = at / 2.0; + shat = sin ( hat ); + chat = cos ( hat ); + +/* Ellipse? */ + if ( ecc < 1.0 ) { + + /* Eccentric anomaly. */ + ae = 2.0 * atan2 ( sqrt ( -em1 ) * shat, sqrt ( ep1 ) * chat ); + + /* Mean anomaly. */ + am = ae - ecc * sin ( ae ); + + /* Daily motion. */ + dn = sqrt ( gar3 ); + } + +/* "Major planet" element set? */ + if ( jf == 1 ) { + + /* Longitude of perihelion. */ + pl = bigom + om; + + /* Longitude at epoch. */ + el = pl + am; + } + +/* "Comet" element set? */ + if ( jf == 3 ) { + + /* Perihelion distance. */ + q = h2 / ( gmu * ep1 ); + + /* Ellipse, parabola, hyperbola? */ + if ( ecc < 1.0 ) { + + /* Ellipse: epoch of perihelion. */ + tp = date - am / dn; + } else { + + /* Parabola or hyperbola: evaluate tan ( ( true anomaly ) / 2 ) */ + that = shat / chat; + if ( ecc == 1.0 ) { + + /* Parabola: epoch of perihelion. */ + tp = date - that * ( 1.0 + that * that / 3.0 ) * h * h2 / + ( 2.0 * gmu * gmu ); + } else { + + /* Hyperbola: epoch of perihelion. */ + thhf = sqrt ( em1 / ep1 ) * that; + f = log ( 1.0 + thhf ) - log ( 1.0 - thhf ); + tp = date - ( ecc * sinh ( f ) - f ) / sqrt ( - gar3 ); + } + } + } + +/* Return the appropriate set of elements. */ + *jform = jf; + *orbinc = oi; + *anode = slaDranrm ( bigom ); + *e = ecc; + if ( jf == 1 ) { + *perih = slaDranrm ( pl ); + *aorl = slaDranrm ( el ); + *dm = dn; + } else { + *perih = slaDranrm ( om ); + if ( jf == 2 ) *aorl = slaDranrm ( am ); + } + if ( jf != 3 ) { + *epoch = date; + *aorq = 1.0 / ar; + } else { + *epoch = tp; + *aorq = q; + } + *jstat = 0; + +} Index: trunk/MagicSoft/slalib/pv2ue.c =================================================================== --- trunk/MagicSoft/slalib/pv2ue.c (revision 731) +++ trunk/MagicSoft/slalib/pv2ue.c (revision 731) @@ -0,0 +1,141 @@ +#include "slalib.h" +#include "slamac.h" +void slaPv2ue ( double pv[], double date, double pmass, + double u[], int *jstat ) +/* +** - - - - - - - - - +** s l a P v 2 u e +** - - - - - - - - - +** +** Construct a universal element set based on an instantaneous position +** and velocity. +** +** Given: +** pv double[6] heliocentric x,y,z,xdot,ydot,zdot of date, +** (au,au/s; Note 1) +** date double date (TT Modified Julian Date = JD-2400000.5) +** pmass double mass of the planet (Sun=1; Note 2) +** +** Returned: +** +** u double[13] universal orbital elements (Note 3) +** +** [0] combined mass (M+m) +** [1] total energy of the orbit (alpha) +** [2] reference (osculating) epoch (t0) +** [3-5] position at reference epoch (r0) +** [6-8] velocity at reference epoch (v0) +** [9] heliocentric distance at reference epoch +** [10] r0.v0 +** [11] date (t) +** [12] universal eccentric anomaly (psi) of date +** +** jstat int* status: 0 = OK +** -1 = illegal pmass +** -2 = too close to Sun +** -3 = too slow +** +** Notes +** +** 1 The pv 6-vector can be with respect to any chosen inertial frame, +** and the resulting universal-element set will be with respect to +** the same frame. A common choice will be mean equator and ecliptic +** of epoch J2000. +** +** 2 The mass, pmass, is important only for the larger planets. For +** most purposes (e.g. asteroids) use 0.0. Values less than zero +** are illegal. +** +** 3 The "universal" elements are those which define the orbit for the +** purposes of the method of universal variables (see reference). +** They consist of the combined mass of the two bodies, an epoch, +** and the position and velocity vectors (arbitrary reference frame) +** at that epoch. The parameter set used here includes also various +** quantities that can, in fact, be derived from the other +** information. This approach is taken to avoiding unnecessary +** computation and loss of accuracy. The supplementary quantities +** are (i) alpha, which is proportional to the total energy of the +** orbit, (ii) the heliocentric distance at epoch, (iii) the +** outwards component of the velocity at the given epoch, (iv) an +** estimate of psi, the "universal eccentric anomaly" at a given +** date and (v) that date. +** +** Reference: Everhart, E. & Pitkin, E.T., Am.J.Phys. 51, 712, 1983. +** +** Last revision: 17 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +/* Gaussian gravitational constant (exact) */ +#define GCON 0.01720209895 + +/* Canonical days to seconds */ +#define CD2S ( GCON / 86400.0 ); + +/* Minimum allowed distance (AU) and speed (AU per canonical day) */ +#define RMIN 1e-3 +#define VMIN 1e-3 + +{ + double t0, cm, x, y, z, xd, yd, zd, r, v2, v, alpha, rdv; + + +/* Reference epoch. */ + t0 = date; + +/* Combined mass (mu=M+m). */ + if ( pmass < 0.0 ) { + *jstat = -1; + return; + } + cm = 1.0 + pmass; + +/* Unpack the state vector, expressing velocity in AU per canonical day. */ + x = pv[0]; + y = pv[1]; + z = pv[2]; + xd = pv[3] / CD2S; + yd = pv[4] / CD2S; + zd = pv[5] / CD2S; + +/* Heliocentric distance, and speed. */ + r = sqrt ( x * x + y * y + z * z ); + v2 = xd * xd + yd * yd + zd * zd; + v = sqrt ( v2 ); + +/* Reject unreasonably small values. */ + if ( r < RMIN ) { + *jstat = -2; + return; + } + if ( v < VMIN ) { + *jstat = -3; + return; + } + +/* Total energy of the orbit. */ + alpha = v2 - 2.0 * cm / r; + +/* Outward component of velocity. */ + rdv = x * xd + y * yd + z * zd; + +/* Construct the universal-element set. */ + u[0] = cm; + u[1] = alpha; + u[2] = t0; + u[3] = x; + u[4] = y; + u[5] = z; + u[6] = xd; + u[7] = yd; + u[8] = zd; + u[9 ] = r; + u[10] = rdv; + u[11] = t0; + u[12] = 0.0; + +/* Exit. */ + *jstat = 0; + +} Index: trunk/MagicSoft/slalib/pvobs.c =================================================================== --- trunk/MagicSoft/slalib/pvobs.c (revision 731) +++ trunk/MagicSoft/slalib/pvobs.c (revision 731) @@ -0,0 +1,56 @@ +#include "slalib.h" +#include "slamac.h" +void slaPvobs ( double p, double h, double stl, double pv[6] ) +/* +** - - - - - - - - - +** s l a P v o b s +** - - - - - - - - - +** +** Position and velocity of an observing station. +** +** (double precision) +** +** Given: +** p double latitude (geodetic, radians) +** h double height above reference spheroid (geodetic, metres) +** stl double local apparent sidereal time (radians) +** +** Returned: +** pv double[6] position/velocity 6-vector (au, au/s, true +** equator and equinox of date) +** +** IAU 1976 constants are used. +** +** Called: slaGeoc +** +** Last revision: 14 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define SR 7.292115855306589e-5 /* Mean sidereal rate (at J2000) + in radians per (UT1) second */ + +{ + double r, z, s, c, v; + +/* Geodetic to geocentric conversion */ + slaGeoc ( p, h, &r, &z ); + +/* Functions of ST */ + s = sin ( stl ); + c = cos ( stl ); + +/* Speed */ + v = SR * r; + +/* Position */ + pv[0] = r * c; + pv[1] = r * s; + pv[2] = z; + +/* Velocity */ + pv[3] = - v * s; + pv[4] = v * c; + pv[5] = 0.0; +} Index: trunk/MagicSoft/slalib/pxy.c =================================================================== --- trunk/MagicSoft/slalib/pxy.c (revision 731) +++ trunk/MagicSoft/slalib/pxy.c (revision 731) @@ -0,0 +1,87 @@ +#include "slalib.h" +#include "slamac.h" +void slaPxy ( int np, double xye[][2], double xym[][2], + double coeffs[6], double xyp[][2], + double *xrms, double *yrms, double *rrms ) +/* +** - - - - - - - +** s l a P x y +** - - - - - - - +** +** Given arrays of "expected" and "measured" [x,y] coordinates, and a +** linear model relating them (as produced by slaFitxy), compute +** the array of "predicted" coordinates and the rms residuals. +** +** Given: +** np int number of samples +** xye double[np] expected [x,y] for each sample +** xym double[np] measured [x,y] for each sample +** coeffs double[6] coefficients of model (see below) +** +** Returned: +** xyp double[np] predicted [x,y] for each sample +** *xrms double RMS in x +** *yrms double RMS in y +** *rrms double total RMS (vector sum of xrms and yrms) +** +** The model is supplied in the array coeffs. Naming the +** elements of coeff as follows: +** +** coeffs[0] = a +** coeffs[1] = b +** coeffs[2] = c +** coeffs[3] = d +** coeffs[4] = e +** coeffs[5] = f +** +** The model is applied thus: +** +** xp = a + b*xm + c*ym +** yp = d + e*xm + f*ym +** +** The residuals are (xp-xe) and (yp-ye). +** +** If np is less than or equal to zero, no coordinates are +** transformed, and the rms residuals are all zero. +** +** See also slaFitxy, slaInvf, slaXy2xy, slaDcmpf +** +** Called: slaXy2xy +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + double sdx2, sdy2, xp, yp, dx, dy, dx2, dy2, p; + +/* Initialize summations */ + sdx2 = 0.0; + sdy2 = 0.0; + +/* Loop by sample */ + for ( i = 0; i < np; i++ ) { + + /* Transform "measured" [x,y] to "predicted" [x,y] */ + slaXy2xy ( xym[i][0], xym[i][1], coeffs, &xp, &yp ); + xyp[i][0] = xp; + xyp[i][1] = yp; + + /* Compute residuals in x and y, and update summations */ + dx = xye[i][0] - xp; + dy = xye[i][1] - yp; + dx2 = dx * dx; + dy2 = dy * dy; + sdx2 = sdx2 + dx2; + sdy2 = sdy2 + dy2; + + /* Next sample */ + } + +/* Compute RMS values */ + p = (double) gmax ( 1.0, np ); + *xrms = sqrt ( sdx2 / p ); + *yrms = sqrt ( sdy2 / p ); + *rrms = sqrt ( *xrms * *xrms + *yrms * *yrms ); +} Index: trunk/MagicSoft/slalib/range.c =================================================================== --- trunk/MagicSoft/slalib/range.c (revision 731) +++ trunk/MagicSoft/slalib/range.c (revision 731) @@ -0,0 +1,24 @@ +#include "slalib.h" +#include "slamac.h" +float slaRange ( float angle ) +/* +** - - - - - - - - - +** s l a R a n g e +** - - - - - - - - - +** +** Normalize angle into range +/- pi. +** +** (single precision) +** +** Given: +** angle float the angle in radians +** +** The result is angle expressed in the +/- pi (single precision). +** +** Last revision: 31 October 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return (float) slaDrange ( (double) angle ); +} Index: trunk/MagicSoft/slalib/ranorm.c =================================================================== --- trunk/MagicSoft/slalib/ranorm.c (revision 731) +++ trunk/MagicSoft/slalib/ranorm.c (revision 731) @@ -0,0 +1,25 @@ +#include "slalib.h" +#include "slamac.h" +float slaRanorm ( float angle ) +/* +** - - - - - - - - - - +** s l a R a n o r m +** - - - - - - - - - - +** +** Normalize angle into range 0-2 pi. +** +** (single precision) +** +** Given: +** angle double the angle in radians +** +** The result is angle expressed in the range 0-2 pi (single +** precision). +** +** Last revision: 15 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + return (float) slaDranrm ( (double) angle ); +} Index: trunk/MagicSoft/slalib/rcc.c =================================================================== --- trunk/MagicSoft/slalib/rcc.c (revision 731) +++ trunk/MagicSoft/slalib/rcc.c (revision 731) @@ -0,0 +1,979 @@ +#include "slalib.h" +#include "slamac.h" +double slaRcc ( double tdb, double ut1, double wl, double u, double v ) +/* +** - - - - - - - +** s l a R c c +** - - - - - - - +** +** Relativistic clock correction: the difference between proper time at +** a point on the surface of the Earth and coordinate time in the Solar +** System barycentric space-time frame of reference. +** +** The proper time is Terrestrial Time TT; the coordinate +** time is an implementation of the Barycentric Dynamical Time TDB. +** +** Given: +** TDB double coordinate time (MJD: JD-2400000.5) +** UT1 double universal time (fraction of one day) +** WL double clock longitude (radians west) +** U double clock distance from Earth spin axis (km) +** V double clock distance north of Earth equatorial plane (km) +** +** Returned: +** The clock correction, TDB-TT, in seconds. TDB may be considered +** to be the coordinate time in the Solar System barycentre frame of +** reference, and TT is the proper time given by clocks at mean sea +** level on the Earth. +** +** The result has a main (annual) sinusoidal term of amplitude +** approximately 0.00166 seconds, plus planetary terms up to about +** 20 microseconds, and lunar and diurnal terms up to 2 microseconds. +** +** The variation arises from the transverse Doppler effect and the +** gravitational red-shift as the observer varies in speed and moves +** through different gravitational potentials. +** +** The argument TDB is, strictly, the barycentric coordinate time; +** however, the terrestrial proper time (TT) can in practice be used. +** +** The geocentric model is that of Fairhead & Bretagnon (1990), in its +** full form. It was supplied by Fairhead (private communication) as a +** FORTRAN subroutine. The original Fairhead routine used explicit +** formulae, in such large numbers that problems were experienced with +** certain compilers (Microsoft Fortran on PC aborted with stack +** overflow, Convex compiled successfully but extremely slowly). The +** present implementation is a complete recoding in C, with the original +** Fairhead coefficients held in a table. To optimize arithmetic +** precision, the terms are accumulated in reverse order, smallest +** first. The numerical results from this C version agree with +** those from the original Fairhead Fortran code to better than +** 10^-15 seconds, depending on the machine hardware. +** +** The topocentric part of the model is from Moyer (1981) and +** Murray (1983). +** +** During the interval 1950-2050, the absolute accuracy is better +** than +/- 3 nanoseconds relative to direct numerical integrations +** using the JPL DE200/LE200 solar system ephemeris. +** +** The IAU definition of TDB is that it must differ from TT only by +** periodic terms. Though practical, this is an imprecise definition +** which ignores the existence of very long-period and secular effects +** in the dynamics of the solar system. As a consequence, different +** implementations of TDB will, in general, differ in zero-point and +** will drift linearly relative to one other. +** +** References: +** Bretagnon P, 1982 Astron. Astrophys., 114, 278-288. +** Fairhead L & Bretagnon P, 1990, Astron. Astrophys., 229, 240-247. +** +** Meeus J, 1984, l'Astronomie, 348-354. +** Moyer T D, 1981, Cel. Mech., 23, 33. +** Murray C A, 1983, Vectorial Astrometry, Adam Hilger. +** +** Defined in slamac.h: D2PI, dmod +** +** Last revision: 31 December 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** Fairhead and Bretagnon canonical coefficients +** +** 787 sets of three coefficients. +** +** Each set is amplitude (microseconds) +** frequency (radians per Julian millennium since J2000), +** phase (radians). +** +** Sets 1-474 are the T^0 terms, +** " 475-679 " " T^1 " +** " 680-764 " " T^2 " +** " 765-784 " " T^3 " +** " 785-787 " " T^4 " . +*/ + static double fairhd[2361] = { + 1656.674564e-6, 6283.075849991, 6.240054195, + 22.417471e-6, 5753.384884897, 4.296977442, + 13.839792e-6, 12566.151699983, 6.196904410, + 4.770086e-6, 529.690965095, 0.444401603, + 4.676740e-6, 6069.776754553, 4.021195093, + 2.256707e-6, 213.299095438, 5.543113262, + 1.694205e-6, -3.523118349, 5.025132748, + 1.554905e-6, 77713.771467920, 5.198467090, + 1.276839e-6, 7860.419392439, 5.988822341, + 1.193379e-6, 5223.693919802, 3.649823730, + 1.115322e-6, 3930.209696220, 1.422745069, + 0.794185e-6, 11506.769769794, 2.322313077, + 0.447061e-6, 26.298319800, 3.615796498, + 0.435206e-6, -398.149003408, 4.349338347, + 0.600309e-6, 1577.343542448, 2.678271909, + 0.496817e-6, 6208.294251424, 5.696701824, + 0.486306e-6, 5884.926846583, 0.520007179, + 0.432392e-6, 74.781598567, 2.435898309, + 0.468597e-6, 6244.942814354, 5.866398759, + 0.375510e-6, 5507.553238667, 4.103476804, + 0.243085e-6, -775.522611324, 3.651837925, + 0.173435e-6, 18849.227549974, 6.153743485, + 0.230685e-6, 5856.477659115, 4.773852582, + 0.203747e-6, 12036.460734888, 4.333987818, + 0.143935e-6, -796.298006816, 5.957517795, + 0.159080e-6, 10977.078804699, 1.890075226, + 0.119979e-6, 38.133035638, 4.551585768, + 0.118971e-6, 5486.777843175, 1.914547226, + 0.116120e-6, 1059.381930189, 0.873504123, + 0.137927e-6, 11790.629088659, 1.135934669, + 0.098358e-6, 2544.314419883, 0.092793886, + 0.101868e-6, -5573.142801634, 5.984503847, + 0.080164e-6, 206.185548437, 2.095377709, + 0.079645e-6, 4694.002954708, 2.949233637, + 0.062617e-6, 20.775395492, 2.654394814, + 0.075019e-6, 2942.463423292, 4.980931759, + 0.064397e-6, 5746.271337896, 1.280308748, + 0.063814e-6, 5760.498431898, 4.167901731, + 0.048042e-6, 2146.165416475, 1.495846011, + 0.048373e-6, 155.420399434, 2.251573730, + 0.058844e-6, 426.598190876, 4.839650148, + 0.046551e-6, -0.980321068, 0.921573539, + 0.054139e-6, 17260.154654690, 3.411091093, + 0.042411e-6, 6275.962302991, 2.869567043, + 0.040184e-6, -7.113547001, 3.565975565, + 0.036564e-6, 5088.628839767, 3.324679049, + 0.040759e-6, 12352.852604545, 3.981496998, + 0.036507e-6, 801.820931124, 6.248866009, + 0.036955e-6, 3154.687084896, 5.071801441, + 0.042732e-6, 632.783739313, 5.720622217, + 0.042560e-6, 161000.685737473, 1.270837679, + 0.040480e-6, 15720.838784878, 2.546610123, + 0.028244e-6, -6286.598968340, 5.069663519, + 0.033477e-6, 6062.663207553, 4.144987272, + 0.034867e-6, 522.577418094, 5.210064075, + 0.032438e-6, 6076.890301554, 0.749317412, + 0.030215e-6, 7084.896781115, 3.389610345, + 0.029247e-6, -71430.695617928, 4.183178762, + 0.033529e-6, 9437.762934887, 2.404714239, + 0.032423e-6, 8827.390269875, 5.541473556, + 0.027567e-6, 6279.552731642, 5.040846034, + 0.029862e-6, 12139.553509107, 1.770181024, + 0.022509e-6, 10447.387839604, 1.460726241, + 0.020937e-6, 8429.241266467, 0.652303414, + 0.020322e-6, 419.484643875, 3.735430632, + 0.024816e-6, -1194.447010225, 1.087136918, + 0.025196e-6, 1748.016413067, 2.901883301, + 0.021691e-6, 14143.495242431, 5.952658009, + 0.017673e-6, 6812.766815086, 3.186129845, + 0.022567e-6, 6133.512652857, 3.307984806, + 0.016155e-6, 10213.285546211, 1.331103168, + 0.014751e-6, 1349.867409659, 4.308933301, + 0.015949e-6, -220.412642439, 4.005298270, + 0.015974e-6, -2352.866153772, 6.145309371, + 0.014223e-6, 17789.845619785, 2.104551349, + 0.017806e-6, 73.297125859, 3.475975097, + 0.013671e-6, -536.804512095, 5.971672571, + 0.011942e-6, 8031.092263058, 2.053414715, + 0.014318e-6, 16730.463689596, 3.016058075, + 0.012462e-6, 103.092774219, 1.737438797, + 0.010962e-6, 3.590428652, 2.196567739, + 0.015078e-6, 19651.048481098, 3.969480770, + 0.010396e-6, 951.718406251, 5.717799605, + 0.011707e-6, -4705.732307544, 2.654125618, + 0.010453e-6, 5863.591206116, 1.913704550, + 0.012420e-6, 4690.479836359, 4.734090399, + 0.011847e-6, 5643.178563677, 5.489005403, + 0.008610e-6, 3340.612426700, 3.661698944, + 0.011622e-6, 5120.601145584, 4.863931876, + 0.010825e-6, 553.569402842, 0.842715011, + 0.008666e-6, -135.065080035, 3.293406547, + 0.009963e-6, 149.563197135, 4.870690598, + 0.009858e-6, 6309.374169791, 1.061816410, + 0.007959e-6, 316.391869657, 2.465042647, + 0.010099e-6, 283.859318865, 1.942176992, + 0.007147e-6, -242.728603974, 3.661486981, + 0.007505e-6, 5230.807466803, 4.920937029, + 0.008323e-6, 11769.853693166, 1.229392026, + 0.007490e-6, -6256.777530192, 3.658444681, + 0.009370e-6, 149854.400134205, 0.673880395, + 0.007117e-6, 38.027672636, 5.294249518, + 0.007857e-6, 12168.002696575, 0.525733528, + 0.007019e-6, 6206.809778716, 0.837688810, + 0.006056e-6, 955.599741609, 4.194535082, + 0.008107e-6, 13367.972631107, 3.793235253, + 0.006731e-6, 5650.292110678, 5.639906583, + 0.007332e-6, 36.648562930, 0.114858677, + 0.006366e-6, 4164.311989613, 2.262081818, + 0.006858e-6, 5216.580372801, 0.642063318, + 0.006919e-6, 6681.224853400, 6.018501522, + 0.006826e-6, 7632.943259650, 3.458654112, + 0.005308e-6, -1592.596013633, 2.500382359, + 0.005096e-6, 11371.704689758, 2.547107806, + 0.004841e-6, 5333.900241022, 0.437078094, + 0.005582e-6, 5966.683980335, 2.246174308, + 0.006304e-6, 11926.254413669, 2.512929171, + 0.006603e-6, 23581.258177318, 5.393136889, + 0.005123e-6, -1.484472708, 2.999641028, + 0.004648e-6, 1589.072895284, 1.275847090, + 0.005119e-6, 6438.496249426, 1.486539246, + 0.004521e-6, 4292.330832950, 6.140635794, + 0.005680e-6, 23013.539539587, 4.557814849, + 0.005488e-6, -3.455808046, 0.090675389, + 0.004193e-6, 7234.794256242, 4.869091389, + 0.003742e-6, 7238.675591600, 4.691976180, + 0.004148e-6, -110.206321219, 3.016173439, + 0.004553e-6, 11499.656222793, 5.554998314, + 0.004892e-6, 5436.993015240, 1.475415597, + 0.004044e-6, 4732.030627343, 1.398784824, + 0.004164e-6, 12491.370101415, 5.650931916, + 0.004349e-6, 11513.883316794, 2.181745369, + 0.003919e-6, 12528.018664345, 5.823319737, + 0.003129e-6, 6836.645252834, 0.003844094, + 0.004080e-6, -7058.598461315, 3.690360123, + 0.003270e-6, 76.266071276, 1.517189902, + 0.002954e-6, 6283.143160294, 4.447203799, + 0.002872e-6, 28.449187468, 1.158692983, + 0.002881e-6, 735.876513532, 0.349250250, + 0.003279e-6, 5849.364112115, 4.893384368, + 0.003625e-6, 6209.778724132, 1.473760578, + 0.003074e-6, 949.175608970, 5.185878737, + 0.002775e-6, 9917.696874510, 1.030026325, + 0.002646e-6, 10973.555686350, 3.918259169, + 0.002575e-6, 25132.303399966, 6.109659023, + 0.003500e-6, 263.083923373, 1.892100742, + 0.002740e-6, 18319.536584880, 4.320519510, + 0.002464e-6, 202.253395174, 4.698203059, + 0.002409e-6, 2.542797281, 5.325009315, + 0.003354e-6, -90955.551694697, 1.942656623, + 0.002296e-6, 6496.374945429, 5.061810696, + 0.003002e-6, 6172.869528772, 2.797822767, + 0.003202e-6, 27511.467873537, 0.531673101, + 0.002954e-6, -6283.008539689, 4.533471191, + 0.002353e-6, 639.897286314, 3.734548088, + 0.002401e-6, 16200.772724501, 2.605547070, + 0.003053e-6, 233141.314403759, 3.029030662, + 0.003024e-6, 83286.914269554, 2.355556099, + 0.002863e-6, 17298.182327326, 5.240963796, + 0.002103e-6, -7079.373856808, 5.756641637, + 0.002303e-6, 83996.847317911, 2.013686814, + 0.002303e-6, 18073.704938650, 1.089100410, + 0.002381e-6, 63.735898303, 0.759188178, + 0.002493e-6, 6386.168624210, 0.645026535, + 0.002366e-6, 3.932153263, 6.215885448, + 0.002169e-6, 11015.106477335, 4.845297676, + 0.002397e-6, 6243.458341645, 3.809290043, + 0.002183e-6, 1162.474704408, 6.179611691, + 0.002353e-6, 6246.427287062, 4.781719760, + 0.002199e-6, -245.831646229, 5.956152284, + 0.001729e-6, 3894.181829542, 1.264976635, + 0.001896e-6, -3128.388765096, 4.914231596, + 0.002085e-6, 35.164090221, 1.405158503, + 0.002024e-6, 14712.317116458, 2.752035928, + 0.001737e-6, 6290.189396992, 5.280820144, + 0.002229e-6, 491.557929457, 1.571007057, + 0.001602e-6, 14314.168113050, 4.203664806, + 0.002186e-6, 454.909366527, 1.402101526, + 0.001897e-6, 22483.848574493, 4.167932508, + 0.001825e-6, -3738.761430108, 0.545828785, + 0.001894e-6, 1052.268383188, 5.817167450, + 0.001421e-6, 20.355319399, 2.419886601, + 0.001408e-6, 10984.192351700, 2.732084787, + 0.001847e-6, 10873.986030480, 2.903477885, + 0.001391e-6, -8635.942003763, 0.593891500, + 0.001388e-6, -7.046236698, 1.166145902, + 0.001810e-6, -88860.057071188, 0.487355242, + 0.001288e-6, -1990.745017041, 3.913022880, + 0.001297e-6, 23543.230504682, 3.063805171, + 0.001335e-6, -266.607041722, 3.995764039, + 0.001376e-6, 10969.965257698, 5.152914309, + 0.001745e-6, 244287.600007027, 3.626395673, + 0.001649e-6, 31441.677569757, 1.952049260, + 0.001416e-6, 9225.539273283, 4.996408389, + 0.001238e-6, 4804.209275927, 5.503379738, + 0.001472e-6, 4590.910180489, 4.164913291, + 0.001169e-6, 6040.347246017, 5.841719038, + 0.001039e-6, 5540.085789459, 2.769753519, + 0.001004e-6, -170.672870619, 0.755008103, + 0.001284e-6, 10575.406682942, 5.306538209, + 0.001278e-6, 71.812653151, 4.713486491, + 0.001321e-6, 18209.330263660, 2.624866359, + 0.001297e-6, 21228.392023546, 0.382603541, + 0.000954e-6, 6282.095528923, 0.882213514, + 0.001145e-6, 6058.731054289, 1.169483931, + 0.000979e-6, 5547.199336460, 5.448375984, + 0.000987e-6, -6262.300454499, 2.656486959, + 0.001070e-6, -154717.609887482, 1.827624012, + 0.000991e-6, 4701.116501708, 4.387001801, + 0.001155e-6, -14.227094002, 3.042700750, + 0.001176e-6, 277.034993741, 3.335519004, + 0.000890e-6, 13916.019109642, 5.601498297, + 0.000884e-6, -1551.045222648, 1.088831705, + 0.000876e-6, 5017.508371365, 3.969902609, + 0.000806e-6, 15110.466119866, 5.142876744, + 0.000773e-6, -4136.910433516, 0.022067765, + 0.001077e-6, 175.166059800, 1.844913056, + 0.000954e-6, -6284.056171060, 0.968480906, + 0.000737e-6, 5326.786694021, 4.923831588, + 0.000845e-6, -433.711737877, 4.749245231, + 0.000819e-6, 8662.240323563, 5.991247817, + 0.000852e-6, 199.072001436, 2.189604979, + 0.000723e-6, 17256.631536341, 6.068719637, + 0.000940e-6, 6037.244203762, 6.197428148, + 0.000885e-6, 11712.955318231, 3.280414875, + 0.000706e-6, 12559.038152982, 2.824848947, + 0.000732e-6, 2379.164473572, 2.501813417, + 0.000764e-6, -6127.655450557, 2.236346329, + 0.000908e-6, 131.541961686, 2.521257490, + 0.000907e-6, 35371.887265976, 3.370195967, + 0.000673e-6, 1066.495477190, 3.876512374, + 0.000814e-6, 17654.780539750, 4.627122566, + 0.000630e-6, 36.027866677, 0.156368499, + 0.000798e-6, 515.463871093, 5.151962502, + 0.000798e-6, 148.078724426, 5.909225055, + 0.000806e-6, 309.278322656, 6.054064447, + 0.000607e-6, -39.617508346, 2.839021623, + 0.000601e-6, 412.371096874, 3.984225404, + 0.000646e-6, 11403.676995575, 3.852959484, + 0.000704e-6, 13521.751441591, 2.300991267, + 0.000603e-6, -65147.619767937, 4.140083146, + 0.000609e-6, 10177.257679534, 0.437122327, + 0.000631e-6, 5767.611978898, 4.026532329, + 0.000576e-6, 11087.285125918, 4.760293101, + 0.000674e-6, 14945.316173554, 6.270510511, + 0.000726e-6, 5429.879468239, 6.039606892, + 0.000710e-6, 28766.924424484, 5.672617711, + 0.000647e-6, 11856.218651625, 3.397132627, + 0.000678e-6, -5481.254918868, 6.249666675, + 0.000618e-6, 22003.914634870, 2.466427018, + 0.000738e-6, 6134.997125565, 2.242668890, + 0.000660e-6, 625.670192312, 5.864091907, + 0.000694e-6, 3496.032826134, 2.668309141, + 0.000531e-6, 6489.261398429, 1.681888780, + 0.000611e-6, -143571.324284214, 2.424978312, + 0.000575e-6, 12043.574281889, 4.216492400, + 0.000553e-6, 12416.588502848, 4.772158039, + 0.000689e-6, 4686.889407707, 6.224271088, + 0.000495e-6, 7342.457780181, 3.817285811, + 0.000567e-6, 3634.621024518, 1.649264690, + 0.000515e-6, 18635.928454536, 3.945345892, + 0.000486e-6, -323.505416657, 4.061673868, + 0.000662e-6, 25158.601719765, 1.794058369, + 0.000509e-6, 846.082834751, 3.053874588, + 0.000472e-6, -12569.674818332, 5.112133338, + 0.000461e-6, 6179.983075773, 0.513669325, + 0.000641e-6, 83467.156352816, 3.210727723, + 0.000520e-6, 10344.295065386, 2.445597761, + 0.000493e-6, 18422.629359098, 1.676939306, + 0.000478e-6, 1265.567478626, 5.487314569, + 0.000472e-6, -18.159247265, 1.999707589, + 0.000559e-6, 11190.377900137, 5.783236356, + 0.000494e-6, 9623.688276691, 3.022645053, + 0.000463e-6, 5739.157790895, 1.411223013, + 0.000432e-6, 16858.482532933, 1.179256434, + 0.000574e-6, 72140.628666286, 1.758191830, + 0.000484e-6, 17267.268201691, 3.290589143, + 0.000550e-6, 4907.302050146, 0.864024298, + 0.000399e-6, 14.977853527, 2.094441910, + 0.000491e-6, 224.344795702, 0.878372791, + 0.000432e-6, 20426.571092422, 6.003829241, + 0.000481e-6, 5749.452731634, 4.309591964, + 0.000480e-6, 5757.317038160, 1.142348571, + 0.000485e-6, 6702.560493867, 0.210580917, + 0.000426e-6, 6055.549660552, 4.274476529, + 0.000480e-6, 5959.570433334, 5.031351030, + 0.000466e-6, 12562.628581634, 4.959581597, + 0.000520e-6, 39302.096962196, 4.788002889, + 0.000458e-6, 12132.439962106, 1.880103788, + 0.000470e-6, 12029.347187887, 1.405611197, + 0.000416e-6, -7477.522860216, 1.082356330, + 0.000449e-6, 11609.862544012, 4.179989585, + 0.000465e-6, 17253.041107690, 0.353496295, + 0.000362e-6, -4535.059436924, 1.583849576, + 0.000383e-6, 21954.157609398, 3.747376371, + 0.000389e-6, 17.252277143, 1.395753179, + 0.000331e-6, 18052.929543158, 0.566790582, + 0.000430e-6, 13517.870106233, 0.685827538, + 0.000368e-6, -5756.908003246, 0.731374317, + 0.000330e-6, 10557.594160824, 3.710043680, + 0.000332e-6, 20199.094959633, 1.652901407, + 0.000384e-6, 11933.367960670, 5.827781531, + 0.000387e-6, 10454.501386605, 2.541182564, + 0.000325e-6, 15671.081759407, 2.178850542, + 0.000318e-6, 138.517496871, 2.253253037, + 0.000305e-6, 9388.005909415, 0.578340206, + 0.000352e-6, 5749.861766548, 3.000297967, + 0.000311e-6, 6915.859589305, 1.693574249, + 0.000297e-6, 24072.921469776, 1.997249392, + 0.000363e-6, -640.877607382, 5.071820966, + 0.000323e-6, 12592.450019783, 1.072262823, + 0.000341e-6, 12146.667056108, 4.700657997, + 0.000290e-6, 9779.108676125, 1.812320441, + 0.000342e-6, 6132.028180148, 4.322238614, + 0.000329e-6, 6268.848755990, 3.033827743, + 0.000374e-6, 17996.031168222, 3.388716544, + 0.000285e-6, -533.214083444, 4.687313233, + 0.000338e-6, 6065.844601290, 0.877776108, + 0.000276e-6, 24.298513841, 0.770299429, + 0.000336e-6, -2388.894020449, 5.353796034, + 0.000290e-6, 3097.883822726, 4.075291557, + 0.000318e-6, 709.933048357, 5.941207518, + 0.000271e-6, 13095.842665077, 3.208912203, + 0.000331e-6, 6073.708907816, 4.007881169, + 0.000292e-6, 742.990060533, 2.714333592, + 0.000362e-6, 29088.811415985, 3.215977013, + 0.000280e-6, 12359.966151546, 0.710872502, + 0.000267e-6, 10440.274292604, 4.730108488, + 0.000262e-6, 838.969287750, 1.327720272, + 0.000250e-6, 16496.361396202, 0.898769761, + 0.000325e-6, 20597.243963041, 0.180044365, + 0.000268e-6, 6148.010769956, 5.152666276, + 0.000284e-6, 5636.065016677, 5.655385808, + 0.000301e-6, 6080.822454817, 2.135396205, + 0.000294e-6, -377.373607916, 3.708784168, + 0.000236e-6, 2118.763860378, 1.733578756, + 0.000234e-6, 5867.523359379, 5.575209112, + 0.000268e-6, -226858.238553767, 0.069432392, + 0.000265e-6, 167283.761587465, 4.369302826, + 0.000280e-6, 28237.233459389, 5.304829118, + 0.000292e-6, 12345.739057544, 4.096094132, + 0.000223e-6, 19800.945956225, 3.069327406, + 0.000301e-6, 43232.306658416, 6.205311188, + 0.000264e-6, 18875.525869774, 1.417263408, + 0.000304e-6, -1823.175188677, 3.409035232, + 0.000301e-6, 109.945688789, 0.510922054, + 0.000260e-6, 813.550283960, 2.389438934, + 0.000299e-6, 316428.228673312, 5.384595078, + 0.000211e-6, 5756.566278634, 3.789392838, + 0.000209e-6, 5750.203491159, 1.661943545, + 0.000240e-6, 12489.885628707, 5.684549045, + 0.000216e-6, 6303.851245484, 3.862942261, + 0.000203e-6, 1581.959348283, 5.549853589, + 0.000200e-6, 5642.198242609, 1.016115785, + 0.000197e-6, -70.849445304, 4.690702525, + 0.000227e-6, 6287.008003254, 2.911891613, + 0.000197e-6, 533.623118358, 1.048982898, + 0.000205e-6, -6279.485421340, 1.829362730, + 0.000209e-6, -10988.808157535, 2.636140084, + 0.000208e-6, -227.526189440, 4.127883842, + 0.000191e-6, 415.552490612, 4.401165650, + 0.000190e-6, 29296.615389579, 4.175658539, + 0.000264e-6, 66567.485864652, 4.601102551, + 0.000256e-6, -3646.350377354, 0.506364778, + 0.000188e-6, 13119.721102825, 2.032195842, + 0.000185e-6, -209.366942175, 4.694756586, + 0.000198e-6, 25934.124331089, 3.832703118, + 0.000195e-6, 4061.219215394, 3.308463427, + 0.000234e-6, 5113.487598583, 1.716090661, + 0.000188e-6, 1478.866574064, 5.686865780, + 0.000222e-6, 11823.161639450, 1.942386641, + 0.000181e-6, 10770.893256262, 1.999482059, + 0.000171e-6, 6546.159773364, 1.182807992, + 0.000206e-6, 70.328180442, 5.934076062, + 0.000169e-6, 20995.392966449, 2.169080622, + 0.000191e-6, 10660.686935042, 5.405515999, + 0.000228e-6, 33019.021112205, 4.656985514, + 0.000184e-6, -4933.208440333, 3.327476868, + 0.000220e-6, -135.625325010, 1.765430262, + 0.000166e-6, 23141.558382925, 3.454132746, + 0.000191e-6, 6144.558353121, 5.020393445, + 0.000180e-6, 6084.003848555, 0.602182191, + 0.000163e-6, 17782.732072784, 4.960593133, + 0.000225e-6, 16460.333529525, 2.596451817, + 0.000222e-6, 5905.702242076, 3.731990323, + 0.000204e-6, 227.476132789, 5.636192701, + 0.000159e-6, 16737.577236597, 3.600691544, + 0.000200e-6, 6805.653268085, 0.868220961, + 0.000187e-6, 11919.140866668, 2.629456641, + 0.000161e-6, 127.471796607, 2.862574720, + 0.000205e-6, 6286.666278643, 1.742882331, + 0.000189e-6, 153.778810485, 4.812372643, + 0.000168e-6, 16723.350142595, 0.027860588, + 0.000149e-6, 11720.068865232, 0.659721876, + 0.000189e-6, 5237.921013804, 5.245313000, + 0.000143e-6, 6709.674040867, 4.317625647, + 0.000146e-6, 4487.817406270, 4.815297007, + 0.000144e-6, -664.756045130, 5.381366880, + 0.000175e-6, 5127.714692584, 4.728443327, + 0.000162e-6, 6254.626662524, 1.435132069, + 0.000187e-6, 47162.516354635, 1.354371923, + 0.000146e-6, 11080.171578918, 3.369695406, + 0.000180e-6, -348.924420448, 2.490902145, + 0.000148e-6, 151.047669843, 3.799109588, + 0.000157e-6, 6197.248551160, 1.284375887, + 0.000167e-6, 146.594251718, 0.759969109, + 0.000133e-6, -5331.357443741, 5.409701889, + 0.000154e-6, 95.979227218, 3.366890614, + 0.000148e-6, -6418.140930027, 3.384104996, + 0.000128e-6, -6525.804453965, 3.803419985, + 0.000130e-6, 11293.470674356, 0.939039445, + 0.000152e-6, -5729.506447149, 0.734117523, + 0.000138e-6, 210.117701700, 2.564216078, + 0.000123e-6, 6066.595360816, 4.517099537, + 0.000140e-6, 18451.078546566, 0.642049130, + 0.000126e-6, 11300.584221356, 3.485280663, + 0.000119e-6, 10027.903195729, 3.217431161, + 0.000151e-6, 4274.518310832, 4.404359108, + 0.000117e-6, 6072.958148291, 0.366324650, + 0.000165e-6, -7668.637425143, 4.298212528, + 0.000117e-6, -6245.048177356, 5.379518958, + 0.000130e-6, -5888.449964932, 4.527681115, + 0.000121e-6, -543.918059096, 6.109429504, + 0.000162e-6, 9683.594581116, 5.720092446, + 0.000141e-6, 6219.339951688, 0.679068671, + 0.000118e-6, 22743.409379516, 4.881123092, + 0.000129e-6, 1692.165669502, 0.351407289, + 0.000126e-6, 5657.405657679, 5.146592349, + 0.000114e-6, 728.762966531, 0.520791814, + 0.000120e-6, 52.596639600, 0.948516300, + 0.000115e-6, 65.220371012, 3.504914846, + 0.000126e-6, 5881.403728234, 5.577502482, + 0.000158e-6, 163096.180360983, 2.957128968, + 0.000134e-6, 12341.806904281, 2.598576764, + 0.000151e-6, 16627.370915377, 3.985702050, + 0.000109e-6, 1368.660252845, 0.014730471, + 0.000131e-6, 6211.263196841, 0.085077024, + 0.000146e-6, 5792.741760812, 0.708426604, + 0.000146e-6, -77.750543984, 3.121576600, + 0.000107e-6, 5341.013788022, 0.288231904, + 0.000138e-6, 6281.591377283, 2.797450317, + 0.000113e-6, -6277.552925684, 2.788904128, + 0.000115e-6, -525.758811831, 5.895222200, + 0.000138e-6, 6016.468808270, 6.096188999, + 0.000139e-6, 23539.707386333, 2.028195445, + 0.000146e-6, -4176.041342449, 4.660008502, + 0.000107e-6, 16062.184526117, 4.066520001, + 0.000142e-6, 83783.548222473, 2.936315115, + 0.000128e-6, 9380.959672717, 3.223844306, + 0.000135e-6, 6205.325306007, 1.638054048, + 0.000101e-6, 2699.734819318, 5.481603249, + 0.000104e-6, -568.821874027, 2.205734493, + 0.000103e-6, 6321.103522627, 2.440421099, + 0.000119e-6, 6321.208885629, 2.547496264, + 0.000138e-6, 1975.492545856, 2.314608466, + 0.000121e-6, 137.033024162, 4.539108237, + 0.000123e-6, 19402.796952817, 4.538074405, + 0.000119e-6, 22805.735565994, 2.869040566, + 0.000133e-6, 64471.991241142, 6.056405489, + 0.000129e-6, -85.827298831, 2.540635083, + 0.000131e-6, 13613.804277336, 4.005732868, + 0.000104e-6, 9814.604100291, 1.959967212, + 0.000112e-6, 16097.679950283, 3.589026260, + 0.000123e-6, 2107.034507542, 1.728627253, + 0.000121e-6, 36949.230808424, 6.072332087, + 0.000108e-6, -12539.853380183, 3.716133846, + 0.000113e-6, -7875.671863624, 2.725771122, + 0.000109e-6, 4171.425536614, 4.033338079, + 0.000101e-6, 6247.911759770, 3.441347021, + 0.000113e-6, 7330.728427345, 0.656372122, + 0.000113e-6, 51092.726050855, 2.791483066, + 0.000106e-6, 5621.842923210, 1.815323326, + 0.000101e-6, 111.430161497, 5.711033677, + 0.000103e-6, 909.818733055, 2.812745443, + 0.000101e-6, 1790.642637886, 1.965746028, + 102.156724e-6, 6283.075849991, 4.249032005, + 1.706807e-6, 12566.151699983, 4.205904248, + 0.269668e-6, 213.299095438, 3.400290479, + 0.265919e-6, 529.690965095, 5.836047367, + 0.210568e-6, -3.523118349, 6.262738348, + 0.077996e-6, 5223.693919802, 4.670344204, + 0.054764e-6, 1577.343542448, 4.534800170, + 0.059146e-6, 26.298319800, 1.083044735, + 0.034420e-6, -398.149003408, 5.980077351, + 0.032088e-6, 18849.227549974, 4.162913471, + 0.033595e-6, 5507.553238667, 5.980162321, + 0.029198e-6, 5856.477659115, 0.623811863, + 0.027764e-6, 155.420399434, 3.745318113, + 0.025190e-6, 5746.271337896, 2.980330535, + 0.022997e-6, -796.298006816, 1.174411803, + 0.024976e-6, 5760.498431898, 2.467913690, + 0.021774e-6, 206.185548437, 3.854787540, + 0.017925e-6, -775.522611324, 1.092065955, + 0.013794e-6, 426.598190876, 2.699831988, + 0.013276e-6, 6062.663207553, 5.845801920, + 0.011774e-6, 12036.460734888, 2.292832062, + 0.012869e-6, 6076.890301554, 5.333425680, + 0.012152e-6, 1059.381930189, 6.222874454, + 0.011081e-6, -7.113547001, 5.154724984, + 0.010143e-6, 4694.002954708, 4.044013795, + 0.009357e-6, 5486.777843175, 3.416081409, + 0.010084e-6, 522.577418094, 0.749320262, + 0.008587e-6, 10977.078804699, 2.777152598, + 0.008628e-6, 6275.962302991, 4.562060226, + 0.008158e-6, -220.412642439, 5.806891533, + 0.007746e-6, 2544.314419883, 1.603197066, + 0.007670e-6, 2146.165416475, 3.000200440, + 0.007098e-6, 74.781598567, 0.443725817, + 0.006180e-6, -536.804512095, 1.302642751, + 0.005818e-6, 5088.628839767, 4.827723531, + 0.004945e-6, -6286.598968340, 0.268305170, + 0.004774e-6, 1349.867409659, 5.808636673, + 0.004687e-6, -242.728603974, 5.154890570, + 0.006089e-6, 1748.016413067, 4.403765209, + 0.005975e-6, -1194.447010225, 2.583472591, + 0.004229e-6, 951.718406251, 0.931172179, + 0.005264e-6, 553.569402842, 2.336107252, + 0.003049e-6, 5643.178563677, 1.362634430, + 0.002974e-6, 6812.766815086, 1.583012668, + 0.003403e-6, -2352.866153772, 2.552189886, + 0.003030e-6, 419.484643875, 5.286473844, + 0.003210e-6, -7.046236698, 1.863796539, + 0.003058e-6, 9437.762934887, 4.226420633, + 0.002589e-6, 12352.852604545, 1.991935820, + 0.002927e-6, 5216.580372801, 2.319951253, + 0.002425e-6, 5230.807466803, 3.084752833, + 0.002656e-6, 3154.687084896, 2.487447866, + 0.002445e-6, 10447.387839604, 2.347139160, + 0.002990e-6, 4690.479836359, 6.235872050, + 0.002890e-6, 5863.591206116, 0.095197563, + 0.002498e-6, 6438.496249426, 2.994779800, + 0.001889e-6, 8031.092263058, 3.569003717, + 0.002567e-6, 801.820931124, 3.425611498, + 0.001803e-6, -71430.695617928, 2.192295512, + 0.001782e-6, 3.932153263, 5.180433689, + 0.001694e-6, -4705.732307544, 4.641779174, + 0.001704e-6, -1592.596013633, 3.997097652, + 0.001735e-6, 5849.364112115, 0.417558428, + 0.001643e-6, 8429.241266467, 2.180619584, + 0.001680e-6, 38.133035638, 4.164529426, + 0.002045e-6, 7084.896781115, 0.526323854, + 0.001458e-6, 4292.330832950, 1.356098141, + 0.001437e-6, 20.355319399, 3.895439360, + 0.001738e-6, 6279.552731642, 0.087484036, + 0.001367e-6, 14143.495242431, 3.987576591, + 0.001344e-6, 7234.794256242, 0.090454338, + 0.001438e-6, 11499.656222793, 0.974387904, + 0.001257e-6, 6836.645252834, 1.509069366, + 0.001358e-6, 11513.883316794, 0.495572260, + 0.001628e-6, 7632.943259650, 4.968445721, + 0.001169e-6, 103.092774219, 2.838496795, + 0.001162e-6, 4164.311989613, 3.408387778, + 0.001092e-6, 6069.776754553, 3.617942651, + 0.001008e-6, 17789.845619785, 0.286350174, + 0.001008e-6, 639.897286314, 1.610762073, + 0.000918e-6, 10213.285546211, 5.532798067, + 0.001011e-6, -6256.777530192, 0.661826484, + 0.000753e-6, 16730.463689596, 3.905030235, + 0.000737e-6, 11926.254413669, 4.641956361, + 0.000694e-6, 3340.612426700, 2.111120332, + 0.000701e-6, 3894.181829542, 2.760823491, + 0.000689e-6, -135.065080035, 4.768800780, + 0.000700e-6, 13367.972631107, 5.760439898, + 0.000664e-6, 6040.347246017, 1.051215840, + 0.000654e-6, 5650.292110678, 4.911332503, + 0.000788e-6, 6681.224853400, 4.699648011, + 0.000628e-6, 5333.900241022, 5.024608847, + 0.000755e-6, -110.206321219, 4.370971253, + 0.000628e-6, 6290.189396992, 3.660478857, + 0.000635e-6, 25132.303399966, 4.121051532, + 0.000534e-6, 5966.683980335, 1.173284524, + 0.000543e-6, -433.711737877, 0.345585464, + 0.000517e-6, -1990.745017041, 5.414571768, + 0.000504e-6, 5767.611978898, 2.328281115, + 0.000485e-6, 5753.384884897, 1.685874771, + 0.000463e-6, 7860.419392439, 5.297703006, + 0.000604e-6, 515.463871093, 0.591998446, + 0.000443e-6, 12168.002696575, 4.830881244, + 0.000570e-6, 199.072001436, 3.899190272, + 0.000465e-6, 10969.965257698, 0.476681802, + 0.000424e-6, -7079.373856808, 1.112242763, + 0.000427e-6, 735.876513532, 1.994214480, + 0.000478e-6, -6127.655450557, 3.778025483, + 0.000414e-6, 10973.555686350, 5.441088327, + 0.000512e-6, 1589.072895284, 0.107123853, + 0.000378e-6, 10984.192351700, 0.915087231, + 0.000402e-6, 11371.704689758, 4.107281715, + 0.000453e-6, 9917.696874510, 1.917490952, + 0.000395e-6, 149.563197135, 2.763124165, + 0.000371e-6, 5739.157790895, 3.112111866, + 0.000350e-6, 11790.629088659, 0.440639857, + 0.000356e-6, 6133.512652857, 5.444568842, + 0.000344e-6, 412.371096874, 5.676832684, + 0.000383e-6, 955.599741609, 5.559734846, + 0.000333e-6, 6496.374945429, 0.261537984, + 0.000340e-6, 6055.549660552, 5.975534987, + 0.000334e-6, 1066.495477190, 2.335063907, + 0.000399e-6, 11506.769769794, 5.321230910, + 0.000314e-6, 18319.536584880, 2.313312404, + 0.000424e-6, 1052.268383188, 1.211961766, + 0.000307e-6, 63.735898303, 3.169551388, + 0.000329e-6, 29.821438149, 6.106912080, + 0.000357e-6, 6309.374169791, 4.223760346, + 0.000312e-6, -3738.761430108, 2.180556645, + 0.000301e-6, 309.278322656, 1.499984572, + 0.000268e-6, 12043.574281889, 2.447520648, + 0.000257e-6, 12491.370101415, 3.662331761, + 0.000290e-6, 625.670192312, 1.272834584, + 0.000256e-6, 5429.879468239, 1.913426912, + 0.000339e-6, 3496.032826134, 4.165930011, + 0.000283e-6, 3930.209696220, 4.325565754, + 0.000241e-6, 12528.018664345, 3.832324536, + 0.000304e-6, 4686.889407707, 1.612348468, + 0.000259e-6, 16200.772724501, 3.470173146, + 0.000238e-6, 12139.553509107, 1.147977842, + 0.000236e-6, 6172.869528772, 3.776271728, + 0.000296e-6, -7058.598461315, 0.460368852, + 0.000306e-6, 10575.406682942, 0.554749016, + 0.000251e-6, 17298.182327326, 0.834332510, + 0.000290e-6, 4732.030627343, 4.759564091, + 0.000261e-6, 5884.926846583, 0.298259862, + 0.000249e-6, 5547.199336460, 3.749366406, + 0.000213e-6, 11712.955318231, 5.415666119, + 0.000223e-6, 4701.116501708, 2.703203558, + 0.000268e-6, -640.877607382, 0.283670793, + 0.000209e-6, 5636.065016677, 1.238477199, + 0.000193e-6, 10177.257679534, 1.943251340, + 0.000182e-6, 6283.143160294, 2.456157599, + 0.000184e-6, -227.526189440, 5.888038582, + 0.000182e-6, -6283.008539689, 0.241332086, + 0.000228e-6, -6284.056171060, 2.657323816, + 0.000166e-6, 7238.675591600, 5.930629110, + 0.000167e-6, 3097.883822726, 5.570955333, + 0.000159e-6, -323.505416657, 5.786670700, + 0.000154e-6, -4136.910433516, 1.517805532, + 0.000176e-6, 12029.347187887, 3.139266834, + 0.000167e-6, 12132.439962106, 3.556352289, + 0.000153e-6, 202.253395174, 1.463313961, + 0.000157e-6, 17267.268201691, 1.586837396, + 0.000142e-6, 83996.847317911, 0.022670115, + 0.000152e-6, 17260.154654690, 0.708528947, + 0.000144e-6, 6084.003848555, 5.187075177, + 0.000135e-6, 5756.566278634, 1.993229262, + 0.000134e-6, 5750.203491159, 3.457197134, + 0.000144e-6, 5326.786694021, 6.066193291, + 0.000160e-6, 11015.106477335, 1.710431974, + 0.000133e-6, 3634.621024518, 2.836451652, + 0.000134e-6, 18073.704938650, 5.453106665, + 0.000134e-6, 1162.474704408, 5.326898811, + 0.000128e-6, 5642.198242609, 2.511652591, + 0.000160e-6, 632.783739313, 5.628785365, + 0.000132e-6, 13916.019109642, 0.819294053, + 0.000122e-6, 14314.168113050, 5.677408071, + 0.000125e-6, 12359.966151546, 5.251984735, + 0.000121e-6, 5749.452731634, 2.210924603, + 0.000136e-6, -245.831646229, 1.646502367, + 0.000120e-6, 5757.317038160, 3.240883049, + 0.000134e-6, 12146.667056108, 3.059480037, + 0.000137e-6, 6206.809778716, 1.867105418, + 0.000141e-6, 17253.041107690, 2.069217456, + 0.000129e-6, -7477.522860216, 2.781469314, + 0.000116e-6, 5540.085789459, 4.281176991, + 0.000116e-6, 9779.108676125, 3.320925381, + 0.000129e-6, 5237.921013804, 3.497704076, + 0.000113e-6, 5959.570433334, 0.983210840, + 0.000122e-6, 6282.095528923, 2.674938860, + 0.000140e-6, -11.045700264, 4.957936982, + 0.000108e-6, 23543.230504682, 1.390113589, + 0.000106e-6, -12569.674818332, 0.429631317, + 0.000110e-6, -266.607041722, 5.501340197, + 0.000115e-6, 12559.038152982, 4.691456618, + 0.000134e-6, -2388.894020449, 0.577313584, + 0.000109e-6, 10440.274292604, 6.218148717, + 0.000102e-6, -543.918059096, 1.477842615, + 0.000108e-6, 21228.392023546, 2.237753948, + 0.000101e-6, -4535.059436924, 3.100492232, + 0.000103e-6, 76.266071276, 5.594294322, + 0.000104e-6, 949.175608970, 5.674287810, + 0.000101e-6, 13517.870106233, 2.196632348, + 0.000100e-6, 11933.367960670, 4.056084160, + 4.322990e-6, 6283.075849991, 2.642893748, + 0.406495e-6, 0.000000000, 4.712388980, + 0.122605e-6, 12566.151699983, 2.438140634, + 0.019476e-6, 213.299095438, 1.642186981, + 0.016916e-6, 529.690965095, 4.510959344, + 0.013374e-6, -3.523118349, 1.502210314, + 0.008042e-6, 26.298319800, 0.478549024, + 0.007824e-6, 155.420399434, 5.254710405, + 0.004894e-6, 5746.271337896, 4.683210850, + 0.004875e-6, 5760.498431898, 0.759507698, + 0.004416e-6, 5223.693919802, 6.028853166, + 0.004088e-6, -7.113547001, 0.060926389, + 0.004433e-6, 77713.771467920, 3.627734103, + 0.003277e-6, 18849.227549974, 2.327912542, + 0.002703e-6, 6062.663207553, 1.271941729, + 0.003435e-6, -775.522611324, 0.747446224, + 0.002618e-6, 6076.890301554, 3.633715689, + 0.003146e-6, 206.185548437, 5.647874613, + 0.002544e-6, 1577.343542448, 6.232904270, + 0.002218e-6, -220.412642439, 1.309509946, + 0.002197e-6, 5856.477659115, 2.407212349, + 0.002897e-6, 5753.384884897, 5.863842246, + 0.001766e-6, 426.598190876, 0.754113147, + 0.001738e-6, -796.298006816, 2.714942671, + 0.001695e-6, 522.577418094, 2.629369842, + 0.001584e-6, 5507.553238667, 1.341138229, + 0.001503e-6, -242.728603974, 0.377699736, + 0.001552e-6, -536.804512095, 2.904684667, + 0.001370e-6, -398.149003408, 1.265599125, + 0.001889e-6, -5573.142801634, 4.413514859, + 0.001722e-6, 6069.776754553, 2.445966339, + 0.001124e-6, 1059.381930189, 5.041799657, + 0.001258e-6, 553.569402842, 3.849557278, + 0.000831e-6, 951.718406251, 2.471094709, + 0.000767e-6, 4694.002954708, 5.363125422, + 0.000756e-6, 1349.867409659, 1.046195744, + 0.000775e-6, -11.045700264, 0.245548001, + 0.000597e-6, 2146.165416475, 4.543268798, + 0.000568e-6, 5216.580372801, 4.178853144, + 0.000711e-6, 1748.016413067, 5.934271972, + 0.000499e-6, 12036.460734888, 0.624434410, + 0.000671e-6, -1194.447010225, 4.136047594, + 0.000488e-6, 5849.364112115, 2.209679987, + 0.000621e-6, 6438.496249426, 4.518860804, + 0.000495e-6, -6286.598968340, 1.868201275, + 0.000456e-6, 5230.807466803, 1.271231591, + 0.000451e-6, 5088.628839767, 0.084060889, + 0.000435e-6, 5643.178563677, 3.324456609, + 0.000387e-6, 10977.078804699, 4.052488477, + 0.000547e-6, 161000.685737473, 2.841633844, + 0.000522e-6, 3154.687084896, 2.171979966, + 0.000375e-6, 5486.777843175, 4.983027306, + 0.000421e-6, 5863.591206116, 4.546432249, + 0.000439e-6, 7084.896781115, 0.522967921, + 0.000309e-6, 2544.314419883, 3.172606705, + 0.000347e-6, 4690.479836359, 1.479586566, + 0.000317e-6, 801.820931124, 3.553088096, + 0.000262e-6, 419.484643875, 0.606635550, + 0.000248e-6, 6836.645252834, 3.014082064, + 0.000245e-6, -1592.596013633, 5.519526220, + 0.000225e-6, 4292.330832950, 2.877956536, + 0.000214e-6, 7234.794256242, 1.605227587, + 0.000205e-6, 5767.611978898, 0.625804796, + 0.000180e-6, 10447.387839604, 3.499954526, + 0.000229e-6, 199.072001436, 5.632304604, + 0.000214e-6, 639.897286314, 5.960227667, + 0.000175e-6, -433.711737877, 2.162417992, + 0.000209e-6, 515.463871093, 2.322150893, + 0.000173e-6, 6040.347246017, 2.556183691, + 0.000184e-6, 6309.374169791, 4.732296790, + 0.000227e-6, 149854.400134205, 5.385812217, + 0.000154e-6, 8031.092263058, 5.120720920, + 0.000151e-6, 5739.157790895, 4.815000443, + 0.000197e-6, 7632.943259650, 0.222827271, + 0.000197e-6, 74.781598567, 3.910456770, + 0.000138e-6, 6055.549660552, 1.397484253, + 0.000149e-6, -6127.655450557, 5.333727496, + 0.000137e-6, 3894.181829542, 4.281749907, + 0.000135e-6, 9437.762934887, 5.979971885, + 0.000139e-6, -2352.866153772, 4.715630782, + 0.000142e-6, 6812.766815086, 0.513330157, + 0.000120e-6, -4705.732307544, 0.194160689, + 0.000131e-6, -71430.695617928, 0.000379226, + 0.000124e-6, 6279.552731642, 2.122264908, + 0.000108e-6, -6256.777530192, 0.883445696, + 0.143388e-6, 6283.075849991, 1.131453581, + 0.006671e-6, 12566.151699983, 0.775148887, + 0.001480e-6, 155.420399434, 0.480016880, + 0.000934e-6, 213.299095438, 6.144453084, + 0.000795e-6, 529.690965095, 2.941595619, + 0.000673e-6, 5746.271337896, 0.120415406, + 0.000672e-6, 5760.498431898, 5.317009738, + 0.000389e-6, -220.412642439, 3.090323467, + 0.000373e-6, 6062.663207553, 3.003551964, + 0.000360e-6, 6076.890301554, 1.918913041, + 0.000316e-6, -21.340641002, 5.545798121, + 0.000315e-6, -242.728603974, 1.884932563, + 0.000278e-6, 206.185548437, 1.266254859, + 0.000238e-6, -536.804512095, 4.532664830, + 0.000185e-6, 522.577418094, 4.578313856, + 0.000245e-6, 18849.227549974, 0.587467082, + 0.000180e-6, 426.598190876, 5.151178553, + 0.000200e-6, 553.569402842, 5.355983739, + 0.000141e-6, 5223.693919802, 1.336556009, + 0.000104e-6, 5856.477659115, 4.239842759, + 0.003826e-6, 6283.075849991, 5.705257275, + 0.000303e-6, 12566.151699983, 5.407132842, + 0.000209e-6, 155.420399434, 1.989815753 + }; + + double tsol; + int i, i3; + double t, w0, w1, w2, w3, w4, wf, wj, wt, rdmoon, rge, rle, rtj, rts; + + +/* Time since J2000.0 in Julian millennia */ + t = ( tdb - 51544.5 ) / 365250.0; + +/* -------------------- Topocentric terms ------------------------------- */ + +/* Convert UT1 to local solar time in radians */ + tsol = dmod ( ut1, 1.0 ) * D2PI - wl; + +/* Planetary arguments: taken or derived from Bretagnon 1982 +** RLp = mean longitude, mean equinox of date +** RGp = mean anomaly +** RTp = mean longitude difference, EMB minus planet */ + +/* EMB */ + rle = dmod ( t * 6283.3196666635 + 1.75347031435, D2PI ); + rge = dmod ( t * 6283.019551285 + 6.24005997418, D2PI ); + +/* Jupiter */ + rtj = dmod ( t * 5753.3848591241 + 1.15392381696, D2PI ); + +/* Saturn */ + rts = dmod ( t * 6069.7767103654 + .87945355785, D2PI ); + +/* Lunar mean elongation: derived from Meeus 1984 */ + rdmoon = dmod ( t * 77713.77144 + 5.198468, D2PI ); + +/* Topocentric terms (Moyer 1981 and Murray 1983) */ + wt = u * 2.9e-14 * sin ( tsol + rts ) + + u * 1e-13 * sin ( tsol - 2.0 * rge ) + + u * 1.33e-13 * sin ( tsol - rdmoon ) + + u * 1.33e-13 * sin ( tsol + rtj ) + - u * 2.29e-13 * sin ( tsol + 2.0 * rle + rge ) + - v * 2.2e-12 * sin ( rle + rge ) + + u * 5.312e-12 * sin ( tsol - rge ) + - u * 1.3677e-11 * sin ( tsol + 2.0 * rle ) + - v * 1.3184e-10 * cos ( rle ) + + u * 3.17679e-10 * sin ( tsol ); + +/* --------------- Fairhead model --------------------------------------- */ + +/* T^0 */ + w0 = 0.0; + for ( i = 474; i >= 1; --i ) { + i3 = i * 3; + w0 += fairhd[i3-3] * sin ( fairhd[i3-2] * t + fairhd[i3-1] ); + } + +/* T^1 */ + w1 = 0.0; + for ( i = 679; i >= 475; --i ) { + i3 = i * 3; + w1 += fairhd[i3-3] * sin ( fairhd[i3-2] * t + fairhd[i3-1] ); + } + +/* T^2 */ + w2 = 0.0; + for ( i = 764; i >= 680; --i ) { + i3 = i * 3; + w2 += fairhd[i3-3] * sin ( fairhd[i3-2] * t + fairhd[i3-1] ); + } + +/* T^3 */ + w3 = 0.0; + for ( i = 784; i >= 765; --i ) { + i3 = i * 3; + w3 += fairhd[i3-3] * sin ( fairhd[i3-2] * t + fairhd[i3-1] ); + } + +/* T^4 */ + w4 = 0.0; + for ( i = 787; i >= 785; --i ) { + i3 = i * 3; + w4 += fairhd[i3-3] * sin ( fairhd[i3-2] * t + fairhd[i3-1] ); + } + +/* Multiply by powers of T and combine */ + wf = t * ( t * ( t * ( t * w4 + w3 ) + w2 ) + w1 ) + w0; + +/* Adjustments to use JPL planetary masses instead of IAU */ + wj = sin ( t * 6069.776754 + 4.021194 ) * 6.5e-10 + + sin ( t * 213.299095 + 5.543132 ) * 3.3e-10 + + sin ( t * 6208.294251 + 5.696701 ) * -1.96e-9 + + sin ( t * 74.781599 + 2.4359 ) * -1.73e-9 + + 3.638e-8 * t * t; + +/* Final result: TDB-TT in seconds */ + return wt + wf + wj; +} Index: trunk/MagicSoft/slalib/rdplan.c =================================================================== --- trunk/MagicSoft/slalib/rdplan.c (revision 731) +++ trunk/MagicSoft/slalib/rdplan.c (revision 731) @@ -0,0 +1,171 @@ +#include "slalib.h" +#include "slamac.h" +void slaRdplan ( double date, int np, double elong, double phi, + double *ra, double *dec, double *diam ) +/* +** - - - - - - - - - - +** s l a R d p l a n +** - - - - - - - - - - +** +** Approximate topocentric apparent RA,Dec of a planet, and its +** angular diameter. +** +** Given: +** date double MJD of observation (JD - 2400000.5) +** np int planet: 1 = Mercury +** 2 = Venus +** 3 = Moon +** 4 = Mars +** 5 = Jupiter +** 6 = Saturn +** 7 = Uranus +** 8 = Neptune +** 9 = Pluto +** else = Sun +** elong,phi double observer's east longitude and geodetic +** latitude (radians) +** +** Returned: +** ra,dec double RA, Dec (topocentric apparent, radians) +** diam double angular diameter (equatorial, radians) +** +** Notes: +** +** 1 The date is in a dynamical timescale (TDB, formerly ET) and is +** in the form of a Modified Julian Date (JD-2400000.5). For all +** practical purposes, TT can be used instead of TDB, and for many +** applications UT will do (except for the Moon). +** +** 2 The longitude and latitude allow correction for geocentric +** parallax. This is a major effect for the Moon, but in the +** context of the limited accuracy of the present routine its +** effect on planetary positions is small (negligible for the +** outer planets). Geocentric positions can be generated by +** appropriate use of the routines slaDmoon and slaPlanet. +** +** 3 The direction accuracy (arcsec, 1000-3000AD) is of order: +** +** Sun 5 +** Mercury 2 +** Venus 10 +** Moon 30 +** Mars 50 +** Jupiter 90 +** Saturn 90 +** Uranus 90 +** Neptune 10 +** Pluto 1 (1885-2099AD only) +** +** The angular diameter accuracy is about 0.4% for the Moon, +** and 0.01% or better for the Sun and planets. +** +** Called: slaGmst, slaDt, slaEpj, slaDmoon, slaPvobs, slaPrenut, +** slaPlanet, slaDmxv, slaDcc2s, slaDranrm +** +** Last revision: 27 May 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define AUKM 1.49597870e8 /* AU in km */ +#define TAU 499.004782 /* Light time for unit distance (sec) */ + +{ + int ip, j, i; + double stl, vgm[6], v[6], rmat[3][3], vse[6], vsg[6], vsp[6], + vgo[6], dx, dy, dz, r, tl; + +/* Equatorial radii (km) */ + static double eqrau[] = { + 696000.0, /* Sun */ + 2439.7, /* Mercury */ + 6051.9, /* Venus */ + 1738.0, /* Moon */ + 3397.0, /* Mars */ + 71492.0, /* Jupiter */ + 60268.0, /* Saturn */ + 25559.0, /* Uranus */ + 24764.0, /* Neptune */ + 1151.0 /* Pluto */ + }; + + + +/* Classify NP. */ + ip = ( np >= 1 && np <= 9 ) ? np : 0; + +/* Approximate local ST. */ + stl = slaGmst ( date - slaDt ( slaEpj ( date ) ) / 86400.0 ) + elong; + +/* Geocentre to Moon (mean of date). */ + slaDmoon ( date, v ); + +/* Nutation, to true of date. */ + slaNut ( date, rmat ); + slaDmxv ( rmat, &v[0], &vgm[0] ); + slaDmxv ( rmat, &v[3], &vgm[3] ); + +/* Moon? */ + if ( ip == 3 ) { + + /* Yes: geocentre to Moon (true of date). */ + for ( i = 0; i <= 5; i++ ) v[i] = vgm[i]; + + } else { + + /* No: precession/nutation matrix, J2000 to date. */ + slaPrenut ( 2000.0, date, rmat ); + + /* Sun to Earth-Moon Barycentre (J2000). */ + slaPlanet ( date, 3, v, &j ); + + /* Precession and nutation to date. */ + slaDmxv ( rmat, &v[0], &vse[0] ); + slaDmxv ( rmat, &v[3], &vse[3] ); + + /* Sun to geocentre. */ + for ( i = 0; i <= 5; i++ ) vsg[i] = vse[i] - 0.012150581 * vgm[i]; + + /* Sun? */ + if ( ip == 0 ) { + + /* Yes: geocentre to Sun. */ + for ( i = 0; i <= 5; i++ ) v[i] = - vsg[i]; + + } else { + + /* No: Sun to Planet. */ + slaPlanet ( date, ip, v, &j ); + + /* Precession and nutation to date. */ + slaDmxv ( rmat, &v[0], &vsp[0] ); + slaDmxv ( rmat, &v[3], &vsp[3] ); + + /* Geocentre to planet. */ + for ( i = 0; i <= 5; i++ ) v[i] = vsp[i] - vsg[i]; + } + } + +/* Refer to origin at the observer. */ + slaPvobs ( phi, 0.0, stl, vgo ); + for ( i = 0; i <= 5; i++ ) v[i] -= vgo[i]; + +/* Geometric distance (AU). */ + dx = v[0]; + dy = v[1]; + dz = v[2]; + r = sqrt ( dx * dx + dy * dy + dz * dz ); + +/* Light time (sec). */ + tl = TAU * r; + +/* Correct position for planetary aberration. */ + for ( i = 0; i <= 2; i++ ) v[i] -= tl * v[i+3]; + +/* To RA,Dec. */ + slaDcc2s ( v, ra, dec ); + *ra = slaDranrm ( *ra ); + +/* Angular diameter (radians). */ + *diam = 2.0 * asin ( eqrau[ip] / ( r * AUKM ) ); +} Index: trunk/MagicSoft/slalib/refco.c =================================================================== --- trunk/MagicSoft/slalib/refco.c (revision 731) +++ trunk/MagicSoft/slalib/refco.c (revision 731) @@ -0,0 +1,66 @@ +#include "slalib.h" +#include "slamac.h" +void slaRefco ( double hm, double tdk, double pmb, double rh, + double wl, double phi, double tlr, double eps, + double *refa, double *refb ) +/* +** - - - - - - - - - +** s l a R e f c o +** - - - - - - - - - +** +** Determine constants A and B in atmospheric refraction model +** dz = A tan z + B tan^3 z. +** +** z is the "observed" zenith distance (i.e. affected by +** refraction) and dz is what to add to z to give the "topocentric" +** (i.e. in vacuo) zenith distance. +** +** Given: +** hm double height of the observer above sea level (metre) +** tdk double ambient temperature at the observer (deg k) +** pmb double pressure at the observer (millibar) +** rh double relative humidity at the observer (range 0-1) +** wl double effective wavelength of the source (micrometre) +** phi double latitude of the observer (radian, astronomical) +** tlr double temperature lapse rate in the troposphere (degk/metre) +** eps double precision required to terminate iteration (radian) +** +** Returned: +** *refa double tan z coefficient (radian) +** *refb double tan^3 z coefficient (radian) +** +** Called: slaRefro +** +** Notes: +** +** 1 Typical values for the tlr and eps arguments might be 0.0065 and +** 1e-10 respectively. +** +** 2 The radio refraction is chosen by specifying wl > 100 micrometres. +** +** 3 The routine is a slower but more accurate alternative to the +** slaRefcoq routine. The constants it produces give perfect +** agreement with slaRefro at zenith distances arctan(1) (45 deg) +** and arctan(4) (about 76 deg). It achieves 0.5 arcsec accuracy +** for ZD < 80 deg, 0.01 arcsec accuracy for ZD < 60 deg, and +** 0.001 arcsec accuracy for ZD < 45 deg. +** +** Last revision: 4 June 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double r1,r2; + +/* Sample zenith distances: arctan(1) and arctan(4) */ + static double atn1 = 0.7853981633974483; + static double atn4 = 1.325817663668033; + +/* Determine refraction for the two sample zenith distances. */ + slaRefro ( atn1, hm, tdk, pmb, rh, wl, phi, tlr, eps, &r1 ); + slaRefro ( atn4, hm, tdk, pmb, rh, wl, phi, tlr, eps, &r2 ); + +/* Solve for refraction constants. */ + *refa = ( 64.0 * r1 - r2 ) / 60.0; + *refb = ( r2 - 4.0 * r1 ) / 60.0; +} Index: trunk/MagicSoft/slalib/refcoq.c =================================================================== --- trunk/MagicSoft/slalib/refcoq.c (revision 731) +++ trunk/MagicSoft/slalib/refcoq.c (revision 731) @@ -0,0 +1,210 @@ +#include "slalib.h" +#include "slamac.h" +void slaRefcoq ( double tdk, double pmb, double rh, double wl, + double *refa, double *refb ) +/* +** - - - - - - - - - - +** s l a R e f c o q +** - - - - - - - - - - +** +** Determine the constants A and B in the atmospheric refraction +** model dZ = A tan Z + B tan^3 Z. This is a fast alternative +** to the slaRefco routine - see notes. +** +** Z is the "observed" zenith distance (i.e. affected by refraction) +** and dZ is what to add to Z to give the "topocentric" (i.e. in vacuo) +** zenith distance. +** +** Given: +** tdk double ambient temperature at the observer (deg K) +** pmb double pressure at the observer (millibar) +** rh double relative humidity at the observer (range 0-1) +** wl double effective wavelength of the source (micrometre) +** +** Returned: +** refa double* tan Z coefficient (radian) +** refb double* tan^3 Z coefficient (radian) +** +** The radio refraction is chosen by specifying WL > 100 micrometres. +** +** Notes: +** +** 1 The model is an approximation, for moderate zenith distances, +** to the predictions of the slaRefro routine. The approximation +** is maintained across a range of conditions, and applies to +** both optical/IR and radio. +** +** 2 The algorithm is a fast alternative to the slaRefco routine. +** The latter calls the slaRefro routine itself: this involves +** integrations through a model atmosphere, and is costly in +** processor time. However, the model which is produced is precisely +** correct for two zenith distance (45 degrees and about 76 degrees) +** and at other zenith distances is limited in accuracy only by the +** A tan Z + B tan^3 Z formulation itself. The present routine +** is not as accurate, though it satisfies most practical +** requirements. +** +** 3 The model omits the effects of (i) height above sea level (apart +** from the reduced pressure itself), (ii) latitude (i.e. the +** flattening of the Earth) and (iii) variations in tropospheric +** lapse rate. +** +** The model was tested using the following range of conditions: +** +** lapse rates 0.0055, 0.0065, 0.0075 deg/metre +** latitudes 0, 25, 50, 75 degrees +** heights 0, 2500, 5000 metres ASL +** pressures mean for height -10% to +5% in steps of 5% +** temperatures -10 deg to +20 deg with respect to 280 deg at SL +** relative humidity 0, 0.5, 1 +** wavelengths 0.4, 0.6, ... 2 micron, + radio +** zenith distances 15, 45, 75 degrees +** +** The accuracy with respect to direct use of the slaRefro routine +** was as follows: +** +** worst RMS +** +** optical/IR 62 mas 8 mas +** radio 319 mas 49 mas +** +** For this particular set of conditions: +** +** lapse rate 0.0065 degK/metre +** latitude 50 degrees +** sea level +** pressure 1005 mB +** temperature 280.15 degK +** humidity 80% +** wavelength 5740 Angstroms +** +** the results were as follows: +** +** ZD slaRefro slaRefcoq Saastamoinen +** +** 10 10.27 10.27 10.27 +** 20 21.19 21.20 21.19 +** 30 33.61 33.61 33.60 +** 40 48.82 48.83 48.81 +** 45 58.16 58.18 58.16 +** 50 69.28 69.30 69.27 +** 55 82.97 82.99 82.95 +** 60 100.51 100.54 100.50 +** 65 124.23 124.26 124.20 +** 70 158.63 158.68 158.61 +** 72 177.32 177.37 177.31 +** 74 200.35 200.38 200.32 +** 76 229.45 229.43 229.42 +** 78 267.44 267.29 267.41 +** 80 319.13 318.55 319.10 +** +** deg arcsec arcsec arcsec +** +** The values for Saastamoinen's formula (which includes terms +** up to tan^5) are taken from Hohenkerk and Sinclair (1985). +** +** The results from the much slower but more accurate slaRefco +** routine have not been included in the tabulation as they are +** identical to those in the slaRefro column to the 0.01 arcsec +** resolution used. +** +** 4 Outlandish input parameters are silently limited to mathematically +** safe values. Zero pressure is permissible, and causes zeroes to +** be returned. +** +** 5 The algorithm draws on several sources, as follows: +** +** a) The formula for the saturation vapour pressure of water as +** a function of temperature and temperature is taken from +** expressions A4.5-A4.7 of Gill (1982). +** +** b) The formula for the water vapour pressure, Given the +** saturation pressure and the relative humidity, is from +** Crane (1976), expression 2.5.5. +** +** c) The refractivity of air is a function of temperature, +** total pressure, water-vapour pressure and, in the case +** of optical/IR but not radio, wavelength. The formulae +** for the two cases are developed from the Essen and Froome +** expressions adopted in Resolution 1 of the 12th International +** Geodesy Association General Assembly (1963). +** +** The above three items are as used in the slaRefro routine. +** +** d) The formula for beta, the ratio of the scale height of the +** atmosphere to the geocentric distance of the observer, is +** an adaption of expression 9 from Stone (1996). The +** adaptations, arrived at empirically, consist of (i) a +** small adjustment to the coefficient and (ii) a humidity +** term for the radio case only. +** +** e) The formulae for the refraction constants as a function of +** n-1 and beta are from Green (1987), expression 4.31. +** +** References: +** +** Crane, R.K., Meeks, M.L. (ed), "Refraction Effects in the Neutral +** Atmosphere", Methods of Experimental Physics: Astrophysics 12B, +** Academic Press, 1976. +** +** Gill, Adrian E., "Atmosphere-Ocean Dynamics", Academic Press, 1982. +** +** Hohenkerk, C.Y., & Sinclair, A.T., NAO Technical Note No. 63, 1985. +** +** International Geodesy Association General Assembly, Bulletin +** Geodesique 70 p390, 1963. +** +** Stone, Ronald C., P.A.S.P. 108 1051-1058, 1996. +** +** Green, R.M., "Spherical Astronomy", Cambridge University Press, 1987. +** +** Last revision: 17 March 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int optic; + double t, p, r,w, tdc, ps, pw, wlsq, gamma, beta; + + +/* Decide whether optical/IR or radio case: switch at 100 microns. */ + optic = ( wl <= 100.0 ); + +/* Restrict parameters to safe values. */ + t = gmax ( tdk, 100.0 ); + t = gmin ( t, 500.0 ); + p = gmax ( pmb, 0.0 ); + p = gmin ( p, 10000.0 ); + r = gmax ( rh, 0.0 ); + r = gmin ( r, 1.0 ); + w = gmax ( wl, 0.1 ); + w = gmin ( w, 1e6 ); + +/* Water vapour pressure at the observer. */ + if ( p > 0.0 ) { + tdc = t - 273.15; + ps = pow ( 10.0, ( 0.7859 + 0.03477 * tdc ) / + ( 1.0 + 0.00412 * tdc ) ) * + ( 1.0 + p * ( 4.5e-6 + 6e-10 * tdc * tdc ) ); + pw = r * ps / ( 1.0 - ( 1.0 - r ) * ps / p ); + } else { + pw = 0.0; + } + +/* Refractive index minus 1 at the observer. */ + if ( optic ) { + wlsq = wl * wl; + gamma = ( ( 77.532e-6 + ( 4.391e-7 + 3.57e-9 / wlsq ) / wlsq ) * p + - 11.2684e-6 * pw ) / t; + } else { + gamma = ( 77.624e-6 * p - ( 12.92e-6 - 0.371897 / t ) * pw ) / t; + } + +/* Formula for beta from Stone, with empirical adjustments. */ + beta = 4.4474e-6 * t; + if ( !optic ) beta -= 0.0074 * pw * beta; + +/* Refraction constants from Green. */ + *refa = gamma * ( 1.0 - beta ); + *refb = - gamma * ( beta - gamma / 2.0 ); +} Index: trunk/MagicSoft/slalib/refro.c =================================================================== --- trunk/MagicSoft/slalib/refro.c (revision 731) +++ trunk/MagicSoft/slalib/refro.c (revision 731) @@ -0,0 +1,456 @@ +#include "slalib.h" +#include "slamac.h" + +static void atmt ( double, double, double, double, double, double, + double, double, double, double, double, double, + double*, double*, double* ); +static void atms ( double, double, double, double, double, + double*, double* ); + +void slaRefro ( double zobs, double hm, double tdk, double pmb, + double rh, double wl, double phi, double tlr, + double eps, double *ref ) +/* +** - - - - - - - - - +** s l a R e f r o +** - - - - - - - - - +** +** Atmospheric refraction for radio and optical/IR wavelengths. +** +** Given: +** zobs double observed zenith distance of the source (radian) +** hm double height of the observer above sea level (metre) +** tdk double ambient temperature at the observer (deg K) +** pmb double pressure at the observer (millibar) +** rh double relative humidity at the observer (range 0-1) +** wl double effective wavelength of the source (micrometre) +** phi double latitude of the observer (radian, astronomical) +** tlr double tropospheric lapse rate (degK/metre) +** eps double precision required to terminate iteration (radian) +** +** Returned: +** ref double refraction: in vacuo ZD minus observed ZD (radian) +** +** Notes: +** +** 1 A suggested value for the tlr argument is 0.0065. The +** refraction is significantly affected by tlr, and if studies +** of the local atmosphere have been carried out a better tlr +** value may be available. +** +** 2 A suggested value for the eps argument is 1e-8. The result is +** usually at least two orders of magnitude more computationally +** precise than the supplied eps value. +** +** 3 The routine computes the refraction for zenith distances up +** to and a little beyond 90 deg using the method of Hohenkerk +** and Sinclair (NAO Technical Notes 59 and 63, subsequently adopted +** in the Explanatory Supplement, 1992 edition - see section 3.281). +** +** 4 The C code is an adaptation of the Fortran optical/IR refraction +** subroutine AREF of C.Hohenkerk (HMNAO, September 1984), with +** extensions to support the radio case. The following modifications +** to the original HMNAO optical/IR refraction algorithm have been made: +** +** . The angle arguments have been changed to radians. +** +** . Any value of zobs is allowed (see note 6, below). +** +** . Other argument values have been limited to safe values. +** +** . Murray's values for the gas constants have been used +** (Vectorial Astrometry, Adam Hilger, 1983). +** +** . The numerical integration phase has been rearranged for +** extra clarity. +** +** . A better model for Ps(T) has been adopted (taken from +** Gill, Atmosphere-Ocean Dynamics, Academic Press, 1982). +** +** . More accurate expressions for Pwo have been adopted +** (again from Gill 1982). +** +** . Provision for radio wavelengths has been added using +** expressions devised by A.T.Sinclair, RGO (private +** communication 1989), based on the Essen & Froome +** refractivity formula adopted in Resolution 1 of the +** 13th International Geodesy Association General Assembly +** (Bulletin Geodesique 70 p390, 1963). +** +** . Various small changes have been made to gain speed. +** +** None of the changes significantly affects the optical/IR results +** with respect to the algorithm given in the 1992 Explanatory +** Supplement. For example, at 70 deg zenith distance the present +** routine agrees with the ES algorithm to better than 0.05 arcsec +** for any reasonable combination of parameters. However, the +** improved water-vapour expressions do make a significant difference +** in the radio band, at 70 deg zenith distance reaching almost +** 4 arcsec for a hot, humid, low-altitude site during a period of +** low pressure. +** +** 5 The radio refraction is chosen by specifying wl > 100 micrometres. +** Because the algorithm takes no account of the ionosphere, the +** accuracy deteriorates at low frequencies, below about 30 MHz. +** +** 6 Before use, the value of zobs is expressed in the range +/- pi. +** If this ranged zobs is -ve, the result ref is computed from its +** absolute value before being made -ve to match. In addition, if +** it has an absolute value greater than 93 deg, a fixed ref value +** equal to the result for zobs = 93 deg is returned, appropriately +** signed. +** +** 7 As in the original Hohenkerk and Sinclair algorithm, fixed +** values of the water vapour polytrope exponent, the height of the +** tropopause, and the height at which refraction is negligible are +** used. +** +** 8 The radio refraction has been tested against work done by +** Iain Coulson, JACH, (private communication 1995) for the +** James Clerk Maxwell Telescope, Mauna Kea. For typical conditions, +** agreement at the 0.1 arcsec level is achieved for moderate ZD, +** worsening to perhaps 0.5-1.0 arcsec at ZD 80 deg. At hot and +** humid sea-level sites the accuracy will not be as good. +** +** 9 It should be noted that the relative humidity rh is formally +** defined in terms of "mixing ratio" rather than pressures or +** densities as is often stated. It is the mass of water per unit +** mass of dry air divided by that for saturated air at the same +** temperature and pressure (see Gill 1982). +** +** Called: slaDrange, atmt, atms +** +** Defined in slamac.h: TRUE, FALSE +** +** Last revision: 3 June 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* Fixed parameters */ + + static double d93 = 1.623156204; /* 93 degrees in radians */ + static double gcr = 8314.32; /* Universal gas constant */ + static double dmd = 28.9644; /* Molecular weight of dry air */ + static double dmw = 18.0152; /* Molecular weight of water + vapour */ + static double s = 6378120.0; /* Mean Earth radius (metre) */ + static double delta = 18.36; /* Exponent of temperature + dependence of water vapour + pressure */ + static double ht = 11000.0; /* Height of tropopause (metre) */ + static double hs = 80000.0; /* Upper limit for refractive + effects (metre) */ + +/* Variables used when calling the internal routine atmt */ + double robs; /* height of observer from centre of Earth (metre) */ + double tdkok; /* temperature at the observer (deg K) */ + double alpha; /* alpha | */ + double gamm2; /* gamma minus 2 | see ES */ + double delm2; /* delta minus 2 | */ + double c1,c2,c3,c4,c5,c6; /* various */ + +/* Variables used when calling the internal routine atms */ + double rt; /* height of tropopause from centre of Earth (metre) */ + double tt; /* temperature at the tropopause (deg k) */ + double dnt; /* refractive index at the tropopause */ + double gamal; /* constant of the atmospheric model = g*md/r */ + + int is, k, n, i, j, optic; + double zobs1, zobs2, hmok, pmbok, rhok, wlok, tol, wlsq, gb, + a, gamma, tdc, psat, pwo, w, tempo, dn0, rdndr0, sk0, + f0, rdndrt, zt, ft, dnts, rdndrp, zts, fts, rs, + dns, rdndrs, zs, fs, refold, z0, zrange, fb, ff, fo, + fe, h, r, sz, rg, dr, tg, dn, rdndr, t, f, refp, reft; + +/* The refraction integrand */ +#define refi(R,DN,RDNDR) ((RDNDR)/(DN+RDNDR)); + + + +/* Transform zobs into the normal range. */ + zobs1 = slaDrange ( zobs ); + zobs2 = fabs ( zobs1 ); + zobs2 = gmin ( zobs2, d93 ); + +/* Keep other arguments within safe bounds. */ + hmok = gmax ( hm, -1000.0 ); + hmok = gmin ( hmok, 10000.0 ); + tdkok = gmax ( tdk, 100.0 ); + tdkok = gmin ( tdkok, 500.0 ); + pmbok = gmax ( pmb, 0.0 ); + pmbok = gmin ( pmbok, 10000.0 ); + rhok = gmax ( rh, 0.0 ); + rhok = gmin ( rhok, 1.0 ); + wlok = gmax ( wl, 0.1 ); + alpha = fabs ( tlr ); + alpha = gmax ( alpha, 0.001 ); + alpha = gmin ( alpha, 0.01 ); + +/* Tolerance for iteration. */ + w = fabs ( eps ); + w = gmax ( w, 1e-12 ); + tol = gmin ( w, 0.1 ) / 2.0; + +/* Decide whether optical/IR or radio case - switch at 100 microns. */ + optic = ( wlok <= 100.0 ); + +/* Set up model atmosphere parameters defined at the observer. */ + wlsq = wlok * wlok; + gb = 9.784 * ( 1.0 - 0.0026 * cos ( 2.0 * phi ) - 2.8e-7 * hmok ); + a = ( optic ) ? + ( ( 287.604 + 1.6288 / wlsq + 0.0136 / ( wlsq * wlsq ) ) + * 273.15 / 1013.25 ) * 1e-6 + : + 77.624e-6; + gamal = gb * dmd / gcr; + gamma = gamal / alpha; + gamm2 = gamma - 2.0; + delm2 = delta - 2.0; + tdc = tdkok - 273.15; + psat = pow ( 10.0, ( 0.7859 + 0.03477 * tdc ) / + ( 1.0 + 0.00412 * tdc ) ) * + ( 1.0 + pmbok * ( 4.5e-6 + 6e-10 * tdc * tdc ) ); + pwo = ( pmbok > 0.0 ) ? + rhok * psat / ( 1.0 - ( 1.0 - rhok ) * psat / pmbok ) : + 0.0; + w = pwo * ( 1.0 - dmw / dmd ) * gamma / ( delta - gamma ); + c1 = a * ( pmbok + w ) / tdkok; + c2 = ( a * w + ( optic ? 11.2684e-6 : 12.92e-6 ) * pwo ) / tdkok; + c3 = ( gamma - 1.0 ) * alpha * c1 / tdkok; + c4 = ( delta - 1.0 ) * alpha * c2 / tdkok; + c5 = optic ? 0.0 : 371897e-6 * pwo / tdkok; + c6 = c5 * delm2 * alpha / ( tdkok * tdkok ); + +/* Conditions at the observer. */ + robs = s + hmok; + atmt ( robs, tdkok, alpha, gamm2, delm2, c1, c2, c3, c4, c5, c6, robs, + &tempo, &dn0, &rdndr0 ); + sk0 = dn0 * robs * sin ( zobs2 ); + f0 = refi ( robs, dn0, rdndr0 ); + +/* Conditions at the tropopause in the troposphere. */ + rt = s + ht; + atmt ( robs, tdkok, alpha, gamm2, delm2, c1, c2, c3, c4, c5, c6, rt, + &tt, &dnt, &rdndrt ); + zt = asin ( sk0 / ( rt * dnt ) ); + ft = refi ( rt, dnt, rdndrt ); + +/* Conditions at the tropopause in the stratosphere. */ + atms ( rt, tt, dnt, gamal, rt, &dnts, &rdndrp ); + zts = asin ( sk0 / ( rt * dnts ) ); + fts = refi ( rt, dnts, rdndrp ); + +/* Conditions at the stratosphere limit. */ + rs = s + hs; + atms ( rt, tt, dnt, gamal, rs, &dns, &rdndrs ); + zs = asin ( sk0 / ( rs * dns ) ); + fs = refi ( rs, dns, rdndrs ); + +/* +** Integrate the refraction integral in two parts; first in the +** troposphere (k=1), then in the stratosphere (k=2). +*/ + +/* Initialize previous refraction to ensure at least two iterations. */ + refold = 1e6; + +/* +** Start off with 8 strips for the troposphere integration, and then +** use the final troposphere value for the stratosphere integration, +** which tends to need more strips. +*/ + is = 8; + +/* Troposphere then stratosphere. */ + for ( k = 1; k <= 2; k++ ) { + + /* Start z, z range, and start and end values. */ + if ( k == 1 ) { + z0 = zobs2; + zrange = zt - z0; + fb = f0; + ff = ft; + } else { + z0 = zts; + zrange = zs - z0; + fb = fts; + ff = fs; + } + + /* Sums of odd and even values. */ + fo = 0.0; + fe = 0.0; + + /* First time through the loop we have to do every point. */ + n = 1; + + /* Start of iteration loop (terminates at specified precision). */ + for ( ; ; ) { + + /* Strip width */ + h = zrange / (double) is; + + /* Initialize distance from Earth centre for quadrature pass. */ + r = ( k == 1 ) ? robs : rt; + + /* One pass (no need to compute evens after first time). */ + for ( i = 1; i < is; i += n ) { + + /* Sine of observed zenith distance. */ + sz = sin ( z0 + h * (double) i ); + + /* Find r (to nearest metre, maximum four iterations). */ + if ( sz > 1e-20 ) { + w = sk0 / sz; + rg = r; + j = 0; + do { + if ( k == 1 ) { + atmt ( robs, tdkok, alpha, gamm2, delm2, + c1, c2, c3, c4, c5, c6, rg, + &tg, &dn, &rdndr ); + } else { + atms ( rt, tt, dnt, gamal, rg, &dn, &rdndr ); + } + dr = ( rg * dn - w ) / ( dn + rdndr ); + rg -= dr; + } while ( fabs ( dr ) > 1.0 && j++ <= 4 ); + r = rg; + } + + /* Find refractive index and integrand at r. */ + if ( k == 1 ) { + atmt ( robs, tdkok, alpha, gamm2, delm2, + c1, c2, c3, c4, c5, c6, r, + &t, &dn, &rdndr ); + } else { + atms ( rt, tt, dnt, gamal, r, &dn, &rdndr ); + } + f = refi ( r, dn, rdndr ); + + /* Accumulate odd and (first time only) even values. */ + if ( n == 1 && i % 2 == 0 ) { + fe += f; + } else { + fo += f; + } + } + + /* Evaluate the integrand using Simpson's Rule. */ + refp = h * ( fb + 4.0 * fo + 2.0 * fe + ff ) / 3.0; + + /* Has the required precision been reached? */ + if ( fabs ( refp - refold ) > tol ) { + + /* No: prepare for next iteration. */ + refold = refp; /* Save current value for convergence test */ + is += is; /* Double the number of strips */ + fe += fo; /* Sum of all = sum of evens next time */ + fo = 0.0; /* Reset odds accumulator */ + n = 2; /* Skip even values next time */ + + } else { + + /* Yes: save troposphere component and terminate loop. */ + if ( k == 1 ) reft = refp; + break; + } + } + } + +/* Result. */ + *ref = reft + refp; + if ( zobs1 < 0.0 ) *ref = - ( *ref ); +} + +/*--------------------------------------------------------------------------*/ + +static void atmt ( double robs, double tdkok, double alpha, double gamm2, + double delm2, double c1, double c2, double c3, + double c4, double c5, double c6, double r, + double *t, double *dn, double *rdndr ) +/* +** - - - - - +** a t m t +** - - - - - +** +** Internal routine used by slaRefro: +** +** refractive index and derivative with respect to height for the +** troposphere. +** +** Given: +** robs double height of observer from centre of the Earth (metre) +** tdkok double temperature at the observer (deg K) +** alpha double alpha ) +** gamm2 double gamma minus 2 ) see ES +** delm2 double delta minus 2 ) +** c1 double useful term ) +** c2 double useful term ) +** c3 double useful term ) see source of +** c4 double useful term ) slaRefro main routine +** c5 double useful term ) +** c6 double useful term ) +** r double current distance from the centre of the Earth (metre) +** +** Returned: +** *t double temperature at r (deg K) +** *dn double refractive index at r +** *rdndr double r * rate the refractive index is changing at r +** +** This routine is derived from the ATMOSTRO routine (C.Hohenkerk, +** HMNAO), with enhancements specified by A.T.Sinclair (RGO) to +** handle the radio case. +** +** Note that in the optical case c5 and c6 are zero. +*/ +{ + double w, tt0, tt0gm2, tt0dm2; + + w = tdkok - alpha * ( r - robs ); + w = gmin ( w, 320.0 ); + w = gmax ( w, 100.0 ); + tt0 = w / tdkok; + tt0gm2 = pow ( tt0, gamm2 ); + tt0dm2 = pow ( tt0, delm2 ); + *t = w; + *dn = 1.0 + ( c1 * tt0gm2 - ( c2 - c5 / w ) * tt0dm2 ) * tt0; + *rdndr = r * ( - c3 * tt0gm2 + ( c4 - c6 / tt0 ) * tt0dm2 ); +} + +/*--------------------------------------------------------------------------*/ + +static void atms ( double rt, double tt, double dnt, double gamal, double r, + double *dn, double *rdndr ) +/* +** - - - - - +** a t m s +** - - - - - +** +** Internal routine used by slaRefro: +** +** refractive index and derivative with respect to height for the +** stratosphere. +** +** Given: +** rt double height of tropopause from centre of the Earth (metre) +** tt double temperature at the tropopause (deg k) +** dnt double refractive index at the tropopause +** gamal double constant of the atmospheric model = g*md/r +** r double current distance from the centre of the Earth (metre) +** +** Returned: +** *dn double refractive index at r +** *rdndr double r * rate the refractive index is changing at r +** +** This routine is derived from the ATMOSSTR routine (C.Hohenkerk, HMNAO). +*/ +{ + double b, w; + + b = gamal / tt; + w = ( dnt - 1.0 ) * exp ( - b * ( r - rt ) ); + *dn = 1.0 + w; + *rdndr = - r * b * w; +} Index: trunk/MagicSoft/slalib/refv.c =================================================================== --- trunk/MagicSoft/slalib/refv.c (revision 731) +++ trunk/MagicSoft/slalib/refv.c (revision 731) @@ -0,0 +1,101 @@ +#include "slalib.h" +#include "slamac.h" +void slaRefv ( double vu[3], double refa, double refb, double vr[3] ) +/* +** - - - - - - - - +** s l a R e f v +** - - - - - - - - +** +** Adjust an unrefracted Cartesian vector to include the effect of +** atmospheric refraction, using the simple A tan z + B tan^3 z +** model. +** +** Given: +** vu double unrefracted position of the source (az/el 3-vector) +** refa double A: tan z coefficient (radian) +** refb double B: tan^3 z coefficient (radian) +** +** Returned: +** *vr double refracted position of the source (az/el 3-vector) +** +** Notes: +** +** 1 This routine applies the adjustment for refraction in the +** opposite sense to the usual one - it takes an unrefracted +** (in vacuo) position and produces an observed (refracted) +** position, whereas the A tan Z + B tan^3 Z model strictly +** applies to the case where an observed position is to have the +** refraction removed. The unrefracted to refracted case is +** harder, and requires an inverted form of the text-book +** refraction models; the algorithm used here is equivalent to +** one iteration of the Newton-Raphson method applied to the above +** formula. +** +** 2 Though optimized for speed rather than precision, the present +** routine achieves consistency with the refracted-to-unrefracted +** A tan Z + B tan^3 Z model at better than 1 microarcsecond within +** 30 degrees of the zenith and remains within 1 milliarcsecond to +** beyond ZD 70 degrees. The inherent accuracy of the model is, of +** course, far worse than this - see the documentation for slaRefco +** for more information. +** +** 3 At low elevations (below about 3 degrees) the refraction +** correction is held back to prevent arithmetic problems and +** wildly wrong results. Over a wide range of observer heights +** and corresponding temperatures and pressures, the following +** levels of accuracy (arcsec) are achieved, relative to numerical +** integration through a model atmosphere: +** +** ZD error +** +** 80 0.4 +** 81 0.8 +** 82 1.6 +** 83 3 +** 84 7 +** 85 17 +** 86 45 +** 87 150 +** 88 340 +** 89 620 +** 90 1100 +** 91 1900 } relevant only to +** 92 3200 } high-elevation sites +** +** 4 See also the routine slaRefz, which performs the adjustment to +** the zenith distance rather than in Cartesian Az/El coordinates. +** The present routine is faster than slaRefz and, except very low down, +** is equally accurate for all practical purposes. However, beyond +** about ZD 84 degrees slaRefz should be used, and for the utmost +** accuracy iterative use of slaRefro should be considered. +** +** Last revision: 4 June 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double x, y, z1, z, zsq, rsq, r, wb, wt, d, cd, f; + +/* Initial estimate = unrefracted vector */ + x = vu[0]; + y = vu[1]; + z1 = vu[2]; + +/* Keep correction approximately constant below about 3 deg elevation */ + z = gmax ( z1, 0.05 ); + +/* One Newton-Raphson iteration */ + zsq = z * z; + rsq = x * x + y * y; + r = sqrt ( rsq ); + wb = refb * rsq / zsq; + wt = ( refa + wb ) / ( 1.0 + ( refa + 3.0 * wb ) * ( zsq + rsq ) / zsq ); + d = wt * r / z; + cd = 1.0 - d * d / 2.0; + f = cd * ( 1.0 - wt ); + +/* Post-refraction x,y,z */ + vr[0] = x * f; + vr[1] = y * f; + vr[2] = cd * ( z + d * r ) + ( z1 - z ); +} Index: trunk/MagicSoft/slalib/refz.c =================================================================== --- trunk/MagicSoft/slalib/refz.c (revision 731) +++ trunk/MagicSoft/slalib/refz.c (revision 731) @@ -0,0 +1,132 @@ +#include "slalib.h" +#include "slamac.h" +void slaRefz ( double zu, double refa, double refb, double *zr ) +/* +** - - - - - - - - +** s l a R e f z +** - - - - - - - - +** +** Adjust an unrefracted zenith distance to include the effect of +** atmospheric refraction, using the simple A tan z + B tan^3 z +** model. +** +** Given: +** zu double unrefracted zenith distance of the source (radian) +** refa double A: tan z coefficient (radian) +** refb double B: tan^3 z coefficient (radian) +** +** Returned: +** *zr double refracted zenith distance (radian) +** +** Notes: +** +** 1 This routine applies the adjustment for refraction in the +** opposite sense to the usual one - it takes an unrefracted +** (in vacuo) position and produces an observed (refracted) +** position, whereas the A tan Z + B tan^3 Z model strictly +** applies to the case where an observed position is to have the +** refraction removed. The unrefracted to refracted case is +** harder, and requires an inverted form of the text-book +** refraction models; the formula used here is based on the +** Newton-Raphson method. For the utmost numerical consistency +** with the refracted to unrefracted model, two iterations are +** carried out, achieving agreement at the 1D-11 arcseconds level +** for a ZD of 80 degrees. The inherent accuracy of the model +** is, of course, far worse than this - see the documentation for +** slaRefco for more information. +** +** 2 At ZD 83 degrees, the rapidly-worsening A tan Z + B tan^3 Z +** model is abandoned and an empirical formula takes over. Over a +** wide range of observer heights and corresponding temperatures and +** pressures, the following levels of accuracy (arcsec) are achieved, +** relative to numerical integration through a model atmosphere: +** +** ZR error +** +** 80 0.4 +** 81 0.8 +** 82 1.5 +** 83 3.2 +** 84 4.9 +** 85 5.8 +** 86 6.1 +** 87 7.1 +** 88 10 +** 89 20 +** 90 40 +** 91 100 } relevant only to +** 92 200 } high-elevation sites +** +** The high-ZD model is scaled to match the normal model at the +** transition point; there is no glitch. +** +** +** 3 Beyond 93 deg zenith distance, the refraction is held at its +** 93 deg value. +** +** 4 See also the routine slaRefv, which performs the adjustment in +** Cartesian Az/El coordinates, and with the emphasis on speed +** rather than numerical accuracy. +** +** Defined in slamac.h: DR2D +** +** Last revision: 4 June 1997 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + double zu1, zl, s, c, t, tsq, tcu, ref, e, e2; + +/* Coefficients for high ZD model (used beyond ZD 83 deg */ + const double c1 = 0.55445, + c2 = -0.01133, + c3 = 0.00202, + c4 = 0.28385, + c5 = 0.02390; + +/* Largest usable ZD (deg) */ + const double z93 = 93.0; + +/* ZD at which one model hands over to the other (radians) */ + const double z83 = 83.0 / DR2D; + +/* High-ZD-model prediction (deg) for that point */ + const double ref83 = ( c1 + c2 * 7.0 + c3 * 49.0 ) / + ( 1.0 + c4 * 7.0 + c5 * 49.0 ); + + +/* Perform calculations for zu or 83 deg, whichever is smaller */ + zu1 = gmin ( zu, z83 ); + +/* Functions of ZD */ + zl = zu1; + s = sin ( zl ); + c = cos ( zl ); + t = s / c; + tsq = t * t; + tcu = t * tsq; + +/* Refracted ZD (mathematically to better than 1mas at 70 deg) */ + zl -= ( refa * t + refb * tcu ) + / ( 1.0 + ( refa + 3.0 * refb * tsq ) / ( c * c ) ); + +/* Further iteration */ + s = sin ( zl ); + c = cos ( zl ); + t = s / c; + tsq = t * t; + tcu = t * tsq; + ref = zu1 - zl + ( zl - zu1 + refa * t + refb * tcu ) + / ( 1.0 + ( refa + 3.0 * refb * tsq ) / ( c * c ) ); + +/* Special handling for large zu */ + if ( zu > zu1 ) { + e = 90.0 - gmin ( z93, zu * DR2D ); + e2 = e * e; + ref = ( ref / ref83 ) * ( c1 + c2 * e + c3 * e2 ) / + ( 1.0 + c4 * e + c5 * e2 ); + } + +/* Refracted ZD */ + *zr = zu - ref; +} Index: trunk/MagicSoft/slalib/rverot.c =================================================================== --- trunk/MagicSoft/slalib/rverot.c (revision 731) +++ trunk/MagicSoft/slalib/rverot.c (revision 731) @@ -0,0 +1,46 @@ +#include "slalib.h" +#include "slamac.h" +float slaRverot ( float phi, float ra, float da, float st ) +/* +** - - - - - - - - - - +** s l a R v e r o t +** - - - - - - - - - - +** +** Velocity component in a given direction due to Earth rotation. +** +** (single precision) +** +** Given: +** phi float latitude of observing station (geodetic) +** ra,da float apparent RA,Dec +** st float local apparent sidereal time +** +** phi, ra, dec and st are all in radians. +** +** Result: +** Component of Earth rotation in direction ra,da (km/s) +** +** Sign convention: +** The result is +ve when the observer is receding from the +** given point on the sky. +** +** Accuracy: +** The simple algorithm used assumes a spherical Earth, of +** a radius chosen to give results accurate to about 0.0005 km/s +** for observing stations at typical latitudes and heights. For +** applications requiring greater precision, use the routine +** slaPvobs. +** +** Last revision: 9 April 1998 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +#define ESPEED 0.4655 /* Nominal mean sidereal speed of Earth equator + in km/s (the actual value is about 0.4651) */ + +{ + return (float) ( ESPEED * cos ( (double) phi ) * + sin ( (double) ( st - ra ) ) * + cos ( (double) da ) ); +} Index: trunk/MagicSoft/slalib/rvgalc.c =================================================================== --- trunk/MagicSoft/slalib/rvgalc.c (revision 731) +++ trunk/MagicSoft/slalib/rvgalc.c (revision 731) @@ -0,0 +1,65 @@ +#include "slalib.h" +#include "slamac.h" +float slaRvgalc ( float r2000, float d2000 ) +/* +** - - - - - - - - - - +** s l a R v g a l c +** - - - - - - - - - - +** +** Velocity component in a given direction due to the rotation +** of the Galaxy. +** +** (single precision) +** +** Given: +** r2000,d2000 float J2000.0 mean RA,Dec (radians) +** +** Result: +** Component of dynamical LSR motion in direction r2000,d2000 (km/s) +** +** Sign convention: +** The result is +ve when the dynamical LSR is receding from the +** given point on the sky. +** +** Called: +** slaCs2c, slaVdv +** +** Note: The Local Standard of Rest used here is a point in the +** vicinity of the Sun which is in a circular orbit around +** the Galactic centre. Sometimes called the "dynamical" LSR, +** it is not to be confused with a "kinematical" LSR, which +** is the mean standard of rest of star catalogues or stellar +** populations. +** +** Reference: The orbital speed of 220 km/s used here comes from +** Kerr & Lynden-Bell (1986), MNRAS, 221, p1023. +** +** Last revision: 23 March 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** +** LSR velocity due to Galactic rotation +** +** Speed = 220 km/s +** +** Apex = L2,B2 90deg, 0deg +** = RA,Dec 21 12 01.1 +48 19 47 J2000.0 +** +** This is expressed in the form of a J2000.0 x,y,z vector: +** +** va(1) = x = -speed*cos(ra)*cos(dec) +** va(2) = y = -speed*sin(ra)*cos(dec) +** va(3) = z = -speed*sin(dec) +*/ + static float va[3] = { -108.70408f, 97.86251f, -164.33610f }; + float vb[3]; + +/* Convert given J2000 RA,dec to x,y,z */ + slaCs2c ( r2000, d2000, vb ); + +/* Compute dot product with LSR motion vector */ + return slaVdv ( va, vb ); +} Index: trunk/MagicSoft/slalib/rvlg.c =================================================================== --- trunk/MagicSoft/slalib/rvlg.c (revision 731) +++ trunk/MagicSoft/slalib/rvlg.c (revision 731) @@ -0,0 +1,58 @@ +#include "slalib.h" +#include "slamac.h" +float slaRvlg ( float r2000, float d2000 ) +/* +** - - - - - - - - +** s l a R v l g +** - - - - - - - - +** +** Velocity component in a given direction due to the combination +** of the rotation of the Galaxy and the motion of the Galaxy +** relative to the mean motion of the local group. +** +** (single precision) +** +** Given: +** r2000,d2000 float J2000.0 mean RA,Dec (radians) +** +** Result: +** Component of solar motion in direction r2000,d2000 (km/s) +** +** Sign convention: +** The result is +ve when the Sun is receding from the +** given point on the sky. +** +** Reference: +** IAU trans 1976, 168, p201. +** +** Called: +** slaCs2c, slaVdv +** +** Last revision: 15 July 1993 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** Solar velocity due to galactic rotation and translation +** +** speed = 300 km/s +** +** apex = l2,b2 90deg, 0deg +** = RA,dec 21 12 01.1 +48 19 47 J2000.0 +** +** This is expressed in the form of a J2000.0 x,y,z vector: +** +** va(1) = x = -speed*cos(ra)*cos(dec) +** va(2) = y = -speed*sin(ra)*cos(dec) +** va(3) = z = -speed*sin(dec) +*/ + static float va[3] = { -148.23284f, 133.44888f, -224.09467f }; + float vb[3]; + +/* Convert given J2000 RA,dec to x,y,z */ + slaCs2c ( r2000, d2000, vb ); + +/* Compute dot product with solar motion vector */ + return slaVdv ( va, vb); +} Index: trunk/MagicSoft/slalib/rvlsrd.c =================================================================== --- trunk/MagicSoft/slalib/rvlsrd.c (revision 731) +++ trunk/MagicSoft/slalib/rvlsrd.c (revision 731) @@ -0,0 +1,68 @@ +#include "slalib.h" +#include "slamac.h" +float slaRvlsrd ( float r2000, float d2000 ) +/* +** - - - - - - - - - - +** s l a R v l s r d +** - - - - - - - - - - +** +** Velocity component in a given direction due to the Sun's +** motion with respect to the dynamical Local Standard of Rest. +** +** (single precision) +** +** Given: +** r2000,d2000 float J2000.0 mean RA,Dec (radians) +** +** Result: +** Component of "peculiar" solar motion in direction R2000,D2000 (km/s) +** +** Sign convention: +** The result is +ve when the Sun is receding from the given point on +** the sky. +** +** Note: The Local Standard of Rest used here is the "dynamical" LSR, +** a point in the vicinity of the Sun which is in a circular +** orbit around the Galactic centre. The Sun's motion with +** respect to the dynamical LSR is called the "peculiar" solar +** motion. +** +** There is another type of LSR, called a "kinematical" LSR. A +** kinematical LSR is the mean standard of rest of specified star +** catalogues or stellar populations, and several slightly +** different kinematical LSRs are in use. The Sun's motion with +** respect to an agreed kinematical LSR is known as the "standard" +** solar motion. To obtain a radial velocity correction with +** respect to an adopted kinematical LSR use the routine slaRvlsrk. +** +** Reference: Delhaye (1965), in "Stars and Stellar Systems", vol 5, p73. +** +** Called: slaCs2c, slaVdv +** +** Last revision: 11 March 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** Peculiar solar motion from Delhaye 1965: in Galactic Cartesian +** coordinates (+9,+12,+7) km/s. This corresponds to about 16.6 km/s +** towards Galactic coordinates L2 = 53 deg, B2 = +25 deg, or RA,Dec +** 17 49 58.7 +28 07 04 J2000. +** +** The solar motion is expressed here in the form of a J2000.0 +** equatorial Cartesian vector: +** +** va(1) = x = -speed*cos(ra)*cos(dec) +** va(2) = y = -speed*sin(ra)*cos(dec) +** va(3) = z = -speed*sin(dec) +*/ + static float va[3] = { 0.63823f, 14.58542f, -7.80116f }; + float vb[3]; + +/* Convert given J2000 RA,dec to x,y,z */ + slaCs2c ( r2000, d2000, vb ); + +/* Compute dot product with solar motion vector */ + return slaVdv ( va, vb ); +} Index: trunk/MagicSoft/slalib/rvlsrk.c =================================================================== --- trunk/MagicSoft/slalib/rvlsrk.c (revision 731) +++ trunk/MagicSoft/slalib/rvlsrk.c (revision 731) @@ -0,0 +1,68 @@ +#include "slalib.h" +#include "slamac.h" +float slaRvlsrk ( float r2000, float d2000 ) +/* +** - - - - - - - - - - +** s l a R v l s r k +** - - - - - - - - - - +** +** Velocity component in a given direction due to the Sun's motion +** with respect to an adopted kinematic Local Standard of Rest. +** +** (single precision) +** +** Given: +** r2000,d2000 float J2000.0 mean RA,Dec (radians) +** +** Result: +** Component of "standard" solar motion in direction R2000,D2000 (km/s) +** +** Sign convention: +** The result is +ve when the Sun is receding from the given point on +** the sky. +** +** Note: The Local Standard of Rest used here is one of several +** "kinematical" LSRs in common use. A kinematical LSR is the +** mean standard of rest of specified star catalogues or stellar +** populations. The Sun's motion with respect to a kinematical +** LSR is known as the "standard" solar motion. +** +** There is another sort of LSR, the "dynamical" LSR, which is a +** point in the vicinity of the Sun which is in a circular orbit +** around the Galactic centre. The Sun's motion with respect to +** the dynamical LSR is called the "peculiar" solar motion. To +** obtain a radial velocity correction with respect to the +** dynamical LSR use the routine slaRvlsrd. +** +** Reference: Delhaye (1965), in "Stars and Stellar Systems", vol 5, p73. +** +** Called: slaCs2c, slaVdv +** +** Last revision: 27 November 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ +/* +** +** Standard solar motion (from Methods of Experimental Physics, ed Meeks, +** vol 12, part C, sec 6.1.5.2, p281): +** +** 20 km/s towards RA 18h Dec +30d (1900). +** +** The solar motion is expressed here in the form of a J2000.0 +** equatorial Cartesian vector: +** +** va(1) = x = -speed*cos(ra)*cos(dec) +** va(2) = y = -speed*sin(ra)*cos(dec) +** va(3) = z = -speed*sin(dec) +*/ + static float va[3] = { -0.29000f, 17.31726f, -10.00141f }; + float vb[3]; + +/* Convert given J2000 RA,dec to x,y,z */ + slaCs2c ( r2000, d2000, vb ); + +/* Compute dot product with solar motion vector */ + return slaVdv ( va, vb ); +} Index: trunk/MagicSoft/slalib/s2tp.c =================================================================== --- trunk/MagicSoft/slalib/s2tp.c (revision 731) +++ trunk/MagicSoft/slalib/s2tp.c (revision 731) @@ -0,0 +1,63 @@ +#include "slalib.h" +#include "slamac.h" +void slaS2tp ( float ra, float dec, float raz, float decz, + float *xi, float *eta, int *j ) +/* +** - - - - - - - - +** s l a S 2 t p +** - - - - - - - - +** +** Projection of spherical coordinates onto tangent plane +** ('gnomonic' projection - 'standard coordinates'). +** +** (single precision) +** +** Given: +** ra,dec float spherical coordinates of point to be projected +** raz,decz float spherical coordinates of tangent point +** +** Returned: +** *xi,*eta float rectangular coordinates on tangent plane +** *j int status: 0 = OK, star on tangent plane +** 1 = error, star too far from axis +** 2 = error, antistar on tangent plane +** 3 = error, antistar too far from axis +** +** Last revision: 17 August 1999 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +#define TINY 1e-6f +{ + float sdecz, sdec, cdecz, cdec, radif, sradif, cradif, denom; + + +/* Trig functions */ + sdecz = (float) sin ( decz ); + sdec = (float) sin ( dec ); + cdecz = (float) cos ( decz ); + cdec = (float) cos ( dec ); + radif = ra - raz; + sradif = (float) sin ( radif ); + cradif = (float) cos ( radif ); + +/* Reciprocal of star vector length to tangent plane */ + denom = sdec * sdecz + cdec * cdecz * cradif; + +/* Handle vectors too far from axis */ + if ( denom > TINY ) { + *j = 0; + } else if ( denom >= 0.0f ) { + *j = 1; + denom = TINY; + } else if ( denom > -TINY ) { + *j = 2; + denom = -TINY; + } else { + *j = 3; + } + +/* Compute tangent plane coordinates (even in dubious cases) */ + *xi = cdec * sradif / denom; + *eta = ( sdec * cdecz - cdec * sdecz * cradif ) / denom; +} Index: trunk/MagicSoft/slalib/sep.c =================================================================== --- trunk/MagicSoft/slalib/sep.c (revision 731) +++ trunk/MagicSoft/slalib/sep.c (revision 731) @@ -0,0 +1,48 @@ +#include "slalib.h" +#include "slamac.h" +float slaSep ( float a1, float b1, float a2, float b2 ) +/* +** - - - - - - - +** s l a S e p +** - - - - - - - +** +** Angle between two points on a sphere. +** +** (single precision) +** +** Given: +** a1,b1 float spherical coordinates of one point +** a2,b2 float spherical coordinates of the other point +** +** (The spherical coordinates are RA,Dec, long,lat etc, in radians.) +** +** The result is the angle, in radians, between the two points. It +** is always positive. +** +** Called: slaCs2c +** +** Last revision: 5 October 1994 +** +** Copyright P.T.Wallace. All rights reserved. +*/ +{ + int i; + float d, v1[3], v2[3], s2, c2; + +/* Convert coordinates from spherical to Cartesian */ + slaCs2c ( a1, b1, v1 ); + slaCs2c ( a2, b2, v2 ); + +/* Modulus squared of half the difference vector */ + s2 = 0.0f; + for ( i = 0; i < 3; i++ ) { + d = v1[i] - v2[i]; + s2 += d * d; + } + s2 /= 4.0f; + +/* Angle between the vectors */ + c2 = 1.0f - s2; + return (float) + ( 2.0 * atan2 ( sqrt ( s2 ), sqrt ( gmax ( 0.0f, c2 ) ) ) ); +} Index: trunk/MagicSoft/slalib/slalib.h =================================================================== --- trunk/MagicSoft/slalib/slalib.h (revision 731) +++ trunk/MagicSoft/slalib/slalib.h (revision 731) @@ -0,0 +1,487 @@ +#ifndef SLALIBHDEF +#define SLALIBHDEF + +#ifdef __cplusplus +extern "C" { +#endif + +#include + +/* +** - - - - - - - - - +** s l a l i b . h +** - - - - - - - - - +** +** Prototype function declarations for slalib library. +** +** Last revision: 27 January 2000 +** +** Copyright P.T.Wallace. All rights reserved. +*/ + +void slaAddet ( double rm, double dm, double eq, double *rc, double *dc ); + +void slaAfin ( char *string, int *iptr, float *a, int *j ); + +double slaAirmas ( double zd ); + +void slaAltaz ( double ha, double dec, double phi, + double *az, double *azd, double *azdd, + double *el, double *eld, double *eldd, + double *pa, double *pad, double *padd ); + +void slaAmp ( double ra, double da, double date, double eq, + double *rm, double *dm ); + +void slaAmpqk ( double ra, double da, double amprms[21], + double *rm, double *dm ); + +void slaAop ( double rap, double dap, double date, double dut, + double elongm, double phim, double hm, double xp, + double yp, double tdk, double pmb, double rh, + double wl, double tlr, + double *aob, double *zob, double *hob, + double *dob, double *rob ); + +void slaAoppa ( double date, double dut, double elongm, double phim, + double hm, double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, double aoprms[14] ); + +void slaAoppat ( double date, double aoprms[14] ); + +void slaAopqk ( double rap, double dap, double aoprms[14], + double *aob, double *zob, double *hob, + double *dob, double *rob ); + +void slaAtmdsp ( double tdk, double pmb, double rh, double wl1, + double a1, double b1, double wl2, double *a2, double *b2 ); + +void slaAv2m ( float axvec[3], float rmat[3][3] ); + +float slaBear ( float a1, float b1, float a2, float b2 ); + +void slaCaf2r ( int ideg, int iamin, float asec, float *rad, int *j ); + +void slaCaldj ( int iy, int im, int id, double *djm, int *j ); + +void slaCalyd ( int iy, int im, int id, int *ny, int *nd, int *j ); + +void slaCc2s ( float v[3], float *a, float *b ); + +void slaCc62s ( float v[6], float *a, float *b, float *r, + float *ad, float *bd, float *rd ); + +void slaCd2tf ( int ndp, float days, char *sign, int ihmsf[4] ); + +void slaCldj ( int iy, int im, int id, double *djm, int *j ); + +void slaClyd ( int iy, int im, int id, int *ny, int *nd, int *jstat ); + +void slaCombn ( int nsel, int ncand, int list[], int *j ); + +void slaCr2af ( int ndp, float angle, char *sign, int idmsf[4] ); + +void slaCr2tf ( int ndp, float angle, char *sign, int ihmsf[4] ); + +void slaCs2c ( float a, float b, float v[3] ); + +void slaCs2c6 ( float a, float b, float r, float ad, + float bd, float rd, float v[6] ); + +void slaCtf2d ( int ihour, int imin, float sec, float *days, int *j ); + +void slaCtf2r ( int ihour, int imin, float sec, float *rad, int *j ); + +void slaDaf2r ( int ideg, int iamin, double asec, double *rad, int *j ); + +void slaDafin ( char *string, int *iptr, double *a, int *j ); + +double slaDat ( double dju ); + +void slaDav2m ( double axvec[3], double rmat[3][3] ); + +double slaDbear ( double a1, double b1, double a2, double b2 ); + +void slaDbjin ( char *string, int *nstrt, + double *dreslt, int *jf1, int *jf2 ); + +void slaDc62s ( double v[6], double *a, double *b, double *r, + double *ad, double *bd, double *rd ); + +void slaDcc2s ( double v[3], double *a, double *b ); + +void slaDcmpf ( double coeffs[6], double *xz, double *yz, double *xs, + double *ys, double *perp, double *orient ); + +void slaDcs2c ( double a, double b, double v[3] ); + +void slaDd2tf ( int ndp, double days, char *sign, int ihmsf[4] ); + +void slaDe2h ( double ha, double dec, double phi, + double *az, double *el ); + +void slaDeuler ( char *order, double phi, double theta, double psi, + double rmat[3][3] ); + +void slaDfltin ( char *string, int *nstrt, double *dreslt, int *jflag ); + +void slaDh2e ( double az, double el, double phi, double *ha, double *dec); + +void slaDimxv ( double dm[3][3], double va[3], double vb[3] ); + +void slaDjcal ( int ndp, double djm, int iymdf[4], int *j ); + +void slaDjcl ( double djm, int *iy, int *im, int *id, double *fd, int *j ); + +void slaDm2av ( double rmat[3][3], double axvec[3] ); + +void slaDmat ( int n, double *a, double *y, double *d, int *jf, int *iw ); + +void slaDmoon ( double date, double pv[6] ); + +void slaDmxm ( double a[3][3], double b[3][3], double c[3][3] ); + +void slaDmxv ( double dm[3][3], double va[3], double vb[3] ); + +double slaDpav ( double v1[3], double v2[3] ); + +void slaDr2af ( int ndp, double angle, char *sign, int idmsf[4] ); + +void slaDr2tf ( int ndp, double angle, char *sign, int ihmsf[4] ); + +double slaDrange ( double angle ); + +double slaDranrm ( double angle ); + +void slaDs2c6 ( double a, double b, double r, double ad, double bd, + double rd, double v[6] ); + +void slaDs2tp ( double ra, double dec, double raz, double decz, + double *xi, double *eta, int *j ); + +double slaDsep ( double a1, double b1, double a2, double b2 ); + +double slaDt ( double epoch ); + +void slaDtf2d ( int ihour, int imin, double sec, double *days, int *j ); + +void slaDtf2r ( int ihour, int imin, double sec, double *rad, int *j ); + +void slaDtp2s ( double xi, double eta, double raz, double decz, + double *ra, double *dec ); + +void slaDtp2v ( double xi, double eta, double v0[3], double v[3] ); + +void slaDtps2c ( double xi, double eta, double ra, double dec, + double *raz1, double *decz1, + double *raz2, double *decz2, int *n ); + +void slaDtpv2c ( double xi, double eta, double v[3], + double v01[3], double v02[3], int *n ); + +double slaDtt ( double dju ); + +void slaDv2tp ( double v[3], double v0[3], double *xi, double *eta, int *j ); + +double slaDvdv ( double va[3], double vb[3] ); + +void slaDvn ( double v[3], double uv[3], double *vm ); + +void slaDvxv ( double va[3], double vb[3], double vc[3] ); + +void slaE2h ( float ha, float dec, float phi, float *az, float *el ); + +void slaEarth ( int iy, int id, float fd, float posvel[6] ); + +void slaEcleq ( double dl, double db, double date, double *dr, double *dd ); + +void slaEcmat ( double date, double rmat[3][3] ); + +void slaEcor ( float rm, float dm, int iy, int id, float fd, + float *rv, float *tl ); + +void slaEg50 ( double dr, double dd, double *dl, double *db ); + +void slaEl2ue ( double date, int jform, double epoch, double orbinc, + double anode, double perih, double aorq, double e, + double aorl, double dm, double u[], int *jstat ); + +double slaEpb ( double date ); + +double slaEpb2d ( double epb ); + +double slaEpco ( char k0, char k, double e ); + +double slaEpj ( double date ); + +double slaEpj2d ( double epj ); + +void slaEqecl ( double dr, double dd, double date, double *dl, double *db ); + +double slaEqeqx ( double date ); + +void slaEqgal ( double dr, double dd, double *dl, double *db ); + +void slaEtrms ( double ep, double ev[3] ); + +void slaEuler ( char *order, float phi, float theta, float psi, + float rmat[3][3] ); + +void slaEvp ( double date, double deqx, + double dvb[3], double dpb[3], + double dvh[3], double dph[3] ); + +void slaFitxy ( int itype, int np, double xye[][2], double xym[][2], + double coeffs[6], int *j ); + +void slaFk425 ( double r1950, double d1950, double dr1950, + double dd1950, double p1950, double v1950, + double *r2000, double *d2000, double *dr2000, + double *dd2000, double *p2000, double *v2000 ); + +void slaFk45z ( double r1950, double d1950, double bepoch, + double *r2000, double *d2000 ); + +void slaFk524 ( double r2000, double d2000, double dr2000, + double dd2000, double p2000, double v2000, + double *r1950, double *d1950, double *dr1950, + double *dd1950, double *p1950, double *v1950 ); + +void slaFk52h ( double r5, double d5, double dr5, double dd5, + double *dr, double *dh, double *drh, double *ddh ); + +void slaFk54z ( double r2000, double d2000, double bepoch, + double *r1950, double *d1950, + double *dr1950, double *dd1950 ); + +void slaFk5hz ( double r5, double d5, double epoch, + double *rh, double *dh ); + +void slaFlotin ( char *string, int *nstrt, float *reslt, int *jflag ); + +void slaGaleq ( double dl, double db, double *dr, double *dd ); + +void slaGalsup ( double dl, double db, double *dsl, double *dsb ); + +void slaGe50 ( double dl, double db, double *dr, double *dd ); + +void slaGeoc ( double p, double h, double *r, double *z ); + +double slaGmst ( double ut1 ); + +double slaGmsta ( double date, double ut1 ); + +void slaH2e ( float az, float el, float phi, float *ha, float *dec ); + +void slaH2fk5 ( double dr, double dh, double drh, double ddh, + double *r5, double *d5, double *dr5, double *dd5 ); + +void slaHfk5z ( double rh, double dh, double epoch, + double *r5, double *d5, double *dr5, double *dd5 ); + +void slaImxv ( float rm[3][3], float va[3], float vb[3] ); + +void slaIntin ( char *string, int *nstrt, long *ireslt, int *jflag ); + +void slaInvf ( double fwds[6], double bkwds[6], int *j ); + +void slaKbj ( int jb, double e, char *k, int *j ); + +void slaM2av ( float rmat[3][3], float axvec[3] ); + +void slaMap ( double rm, double dm, double pr, double pd, + double px, double rv, double eq, double date, + double *ra, double *da ); + +void slaMappa ( double eq, double date, double amprms[21] ); + +void slaMapqk ( double rm, double dm, double pr, double pd, + double px, double rv, double amprms[21], + double *ra, double *da ); + +void slaMapqkz ( double rm, double dm, double amprms[21], + double *ra, double *da ); + +void slaMoon ( int iy, int id, float fd, float posvel[6] ); + +void slaMxm ( float a[3][3], float b[3][3], float c[3][3] ); + +void slaMxv ( float rm[3][3], float va[3], float vb[3] ); + +void slaNut ( double date, double rmatn[3][3] ); + +void slaNutc ( double date, double *dpsi, double *deps, double *eps0 ); + +void slaOap ( char *type, double ob1, double ob2, double date, + double dut, double elongm, double phim, double hm, + double xp, double yp, double tdk, double pmb, + double rh, double wl, double tlr, + double *rap, double *dap ); + +void slaOapqk ( char *type, double ob1, double ob2, double aoprms[14], + double *rap, double *dap ); + +void slaObs ( int n, char *c, char *name, double *w, double *p, double *h ); + +double slaPa ( double ha, double dec, double phi ); + +double slaPav ( float v1[3], float v2[3] ); + +void slaPcd ( double disco, double *x, double *y ); + +void slaPda2h ( double p, double d, double a, + double *h1, int *j1, double *h2, int *j2 ); + +void slaPdq2h ( double p, double d, double q, + double *h1, int *j1, double *h2, int *j2 ); + +void slaPermut ( int n, int istate[], int iorder[], int *j ); + +void slaPertel (int jform, double date0, double date1, + double epoch0, double orbi0, double anode0, + double perih0, double aorq0, double e0, double am0, + double *epoch1, double *orbi1, double *anode1, + double *perih1, double *aorq1, double *e1, double *am1, + int *jstat ); + +void slaPertue ( double date, double u[], int *jstat ); + +void slaPlanel ( double date, int jform, double epoch, double orbinc, + double anode, double perih, double aorq, double e, + double aorl, double dm, double pv[6], int *jstat ); + +void slaPlanet ( double date, int np, double pv[6], int *j ); + +void slaPlante ( double date, double elong, double phi, int jform, + double epoch, double orbinc, double anode, double perih, + double aorq, double e, double aorl, double dm, + double *ra, double *dec, double *r, int *jstat ); + +void slaPm ( double r0, double d0, double pr, double pd, + double px, double rv, double ep0, double ep1, + double *r1, double *d1 ); + +void slaPolmo ( double elongm, double phim, double xp, double yp, + double *elong, double *phi, double *daz ); + +void slaPrebn ( double bep0, double bep1, double rmatp[3][3] ); + +void slaPrec ( double ep0, double ep1, double rmatp[3][3] ); + +void slaPrecl ( double ep0, double ep1, double rmatp[3][3] ); + +void slaPreces ( char sys[3], double ep0, double ep1, + double *ra, double *dc ); + +void slaPrenut ( double epoch, double date, double rmatpn[3][3] ); + +void slaPv2el ( double pv[], double date, double pmass, int jformr, + int *jform, double *epoch, double *orbinc, + double *anode, double *perih, double *aorq, double *e, + double *aorl, double *dm, int *jstat ); + +void slaPv2ue ( double pv[], double date, double pmass, + double u[], int *jstat ); + +void slaPvobs ( double p, double h, double stl, double pv[6] ); + +void slaPxy ( int np, double xye[][2], double xym[][2], + double coeffs[6], + double xyp[][2], double *xrms, double *yrms, double *rrms ); + +float slaRange ( float angle ); + +float slaRanorm ( float angle ); + +double slaRcc ( double tdb, double ut1, double wl, double u, double v ); + +void slaRdplan ( double date, int np, double elong, double phi, + double *ra, double *dec, double *diam ); + +void slaRefco ( double hm, double tdk, double pmb, double rh, + double wl, double phi, double tlr, double eps, + double *refa, double *refb ); + +void slaRefcoq ( double tdk, double pmb, double rh, double wl, + double *refa, double *refb ); + +void slaRefro ( double zobs, double hm, double tdk, double pmb, + double rh, double wl, double phi, double tlr, double eps, + double *ref ); + +void slaRefv ( double vu[3], double refa, double refb, double vr[3] ); + +void slaRefz ( double zu, double refa, double refb, double *zr ); + +float slaRverot ( float phi, float ra, float da, float st ); + +float slaRvgalc ( float r2000, float d2000 ); + +float slaRvlg ( float r2000, float d2000 ); + +float slaRvlsrd ( float r2000, float d2000 ); + +float slaRvlsrk ( float r2000, float d2000 ); + +void slaS2tp ( float ra, float dec, float raz, float decz, + float *xi, float *eta, int *j ); + +float slaSep ( float a1, float b1, float a2, float b2 ); + +void slaSmat ( int n, float *a, float *y, float *d, int *jf, int *iw ); + +void slaSubet ( double rc, double dc, double eq, + double *rm, double *dm ); + +void slaSupgal ( double dsl, double dsb, double *dl, double *db ); + +void slaSvd ( int m, int n, int mp, int np, + double *a, double *w, double *v, double *work, + int *jstat ); + +void slaSvdcov ( int n, int np, int nc, + double *w, double *v, double *work, double *cvm ); + +void slaSvdsol ( int m, int n, int mp, int np, + double *b, double *u, double *w, double *v, + double *work, double *x ); + +void slaTp2s ( float xi, float eta, float raz, float decz, + float *ra, float *dec ); + +void slaTp2v ( float xi, float eta, float v0[3], float v[3] ); + +void slaTps2c ( float xi, float eta, float ra, float dec, + float *raz1, float *decz1, + float *raz2, float *decz2, int *n ); + +void slaTpv2c ( float xi, float eta, float v[3], + float v01[3], float v02[3], int *n ); + +void slaUe2el ( double u[], int jformr, + int *jform, double *epoch, double *orbinc, + double *anode, double *perih, double *aorq, double *e, + double *aorl, double *dm, int *jstat ); + +void slaUe2pv ( double date, double u[], double pv[], int *jstat ); + +void slaUnpcd ( double disco, double *x, double *y ); + +void slaV2tp ( float v[3], float v0[3], float *xi, float *eta, int *j ); + +float slaVdv ( float va[3], float vb[3] ); + +void slaVn ( float v[3], float uv[3], float *vm ); + +void slaVxv ( float va[3], float vb[3], float vc[3] ); + +void slaXy2xy ( double x1, double y1, double coeffs[6], + double *x2, double *y2 ); + +double slaZd ( double ha, double dec, double phi ); + +#ifdef __cplusplus +} +#endif + +#endif