Subject: C code needed

From: Bob Jackson <[email-masked]>
Date: Thu, 14 Apr 94 13:06:32 EDT

Does anyone know of any C code port of the
following Fortran module which does
B1950->J2000 coordinate conversion?

			Bob

**************************************************

C MODIFIED:  30-AUG-1985, M. JOHNSTON
C Inserted BLOCK DATA CONST into PRECESS_B1950_TO_J2000.  Block data's are not
C automatically loaded by the linker from a library (they must be explicitly
C included).  With the above change, the common blocks used by the precess
C routines are always initialized properly.

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Unit Type
C ---------
C
	SUBROUTINE
C
C Invocation Name And Calling Sequence
C ------------------------------------
C
     # PRECESSJ2000
C     #	PRECESS_B1950_TO_J2000
     #	    (
     #		IDENT,				! Input
     #		IUNIT,				! Input
     #		VECTOR,				! Input/Output
     #		PRA,  				! Input/Output
     #		PRD,				! Input/Output
     #		VRAD,				! Input/Output
     #		PLX,				! Input/Output
     #		ALP,				! Output
     #		DEL				! Output
     #	    )
C
CH   Version  1.1B   12-DEC-84 13:18:19     MEDEIROS       Design/code inspection                                                
CH
C Keyphrase
C ---------
C	Precesses coordinates from epoch B1950 to J2000.
C
C Description
C -----------
C 	This module was adapted from the J2000 routine supplied by Jane Russell
C	and the US Naval Observatory.  Every attempt was made to leave the
C	code as close to the virgin material as possible, even though much
C	of it must be considered as tolerable exceptions to STScI preferred
C	programming standards.
C
C ********** STANDARD SOFTWARE FOR CONVERTING B1950.0 FK4-BASED ********ILO00060
C ********** POSITIONS AND PROPER MOTIONS TO J2000.0 FK5-BASED  ********ILO00070
C **********              POSITIONS AND PROPER MOTIONS          ********ILO00080
C **********         FOR THE MAIN CAMPAIGN OF PROJECT MERIT     ********ILO00090
C                                                                       ILO00100
C            THIS PROGRAM WAS DEVELOPED AT AN ANALYSIS CENTER OF        ILO00130
C            OPTICAL ASTROMETRY (IPMS) UNDER THE COOPERATION WITH       ILO00140
C            THE TOKYO ASTRONOMICAL OBSERVATORY.                        ILO00150
C                                                                       ILO00160
C     PROGRAM DEVELOPERS: K. TANIKAWA AND K. YOKOYAMA (IPMS)            ILO00170
C     MODIFIED FOR USE AT USNO BY D. MCCARTHY                           ILO00180
C                                                                       ILO00190
C  ******************************************************************   ILO00240
C IN THIS PROGRAM,  CONVERSION IS DONE                                  ILO00250
C                                                                       ILO00260
C    FROM   EPOCH B1950.0 FK4-BASED POSITIONS AND PROPER MOTIONS OF STARILO00270
C                 (REFERRED TO AS OLD, HEREAFTER)                       ILO00280
C                                                                       ILO00290
C    TO     EPOCH J2000.0 FK5-BASED POSITIONS AND PROPER MOTIONS OF STARILO00300
C                 (REFERRED TO AS NEW, HEREAFTER).                      ILO00310
C                                                                       ILO00320
C           IN ACCORDANCE WITH IAU RESOLUTIONS                          ILO00330
C                                                                       ILO00340
C         REFERENCE : S.AOKI, M.SOMA, H.KINOSHITA AND K.INOUE           ILO00350
C                                                                       ILO00360
C                CONVERSION MATRIX OF EPOCH B1950.0 FK4-BASED           ILO00370
C                POSITIONS OF STARS TO EPOCH J2000.0 POSITIONS          ILO00380
C                IN ACCORDANCE WITH THE NEW IAU RESOLUTIONS             ILO00390
C                                                                       ILO00400
C                SUBMITTED TO ASTRONOMY & ASTROPHYSICS, 1983            ILO00410
C  ******************************************************************   ILO00420
C
C Source File Name
C ----------------
C	TOJ2000.FOR
C
C History
C -------
C    Version       Date         Author          Description
C	1	19-JUL-1984	McLaughlin	Conversion from supplied code
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	IMPLICIT	NONE
C
C Argument Declaration and Definitions
C ------------------------------------
	CHARACTER*16   IDENT    ! Star identification, used only if optional
    			        !  prntout of results is selected
	INTEGER*4      IUNIT    ! Flag and output unit for printout of results;
			        !  if this parameter is greater than 0, results
			        !  are printed on FORTRAN unit "IUNIT"
	REAL*8      VECTOR(3)   ! Unit 3-vector coordinates
	REAL*8	    PRA		! Proper motion in right ascension [seconds of
				!  arc per tropical century]
	REAL*8      PRD		! Proper motion in declination [seconds of arc
				!  per tropical century]
	REAL*8	    VRAD	! Radial velocity [kilometers/second]
	REAL*8	    PLX		! Parallax [Seconds of arc]
	REAL*8	    ALP		! Right Ascension [Seconds of time]
	REAL*8	    DEL		! Declination [Seconds of arc]
C
C Modules Referenced
C ------------------
	EXTERNAL   CNVPOS
C			 USNO supplied routine which converts old positions
C			  proper motions to new positions and proper motions
	EXTERNAL   POSOUT
C			 USNO supplied routine which prints out the positions,
C			  proper moions, parallaxes, and radial velocities
C

C --- BLOCK DATA CONST INSERTED HERE TO ENSURE THAT COMMON BLOCKS ARE
C --- INITIALIZED

C---formerly:        BLOCK DATA CONST
C                                                                       ILO01180
C ########################   SPECIFICATION   ###########################ILO01190
C                                                                       ILO01200
C           DEFINITION OF CONSTANTS AND PARAMETERS NECESSARY IN         ILO01210
C           THE CONVERSION                                              ILO01220
C                                                                       ILO01230
C  PRODUCT                                                              ILO01240
C           A(3)  : CONSTANT VECTOR USED IN SUBROUTINE ETERMS           ILO01250
C           VA(3) : THE SAME AS ABOVE                                   ILO01260
C           C(6,6): TRANSFORMATION MATRIX FROM THE OLD POSITIONS AND    ILO01270
C                   VELOCITIES TO THE NEW POSITIONS AND VELOCITIES      ILO01280
C                   USED IN SUBROUTINE CNVRDR                           ILO01290
C           *** NOTE THAT THE FOLLOWING ARE TAKEN INTO ACCOUNT TO       ILO01300
C               CONSTRUCT THE TRANSFORMATION MATRIX.                    ILO01310
C                                                                       ILO01320
C               1) CONVERSION OF STANDARD EPOCH FROM B1950.0 TO J2000.0 ILO01330
C               2) CONVERSION OF THE UNIT OF PROPER MOTION FROM         ILO01340
C                  TROPICAL CENTURY INTERVAL TO JULIAN CENTURY INTERVAL ILO01350
C               3) ADOPTION OF 0.035 SECONDS OF TIME FOR THE EQUINOX    ILO01360
C                  CORRECTION AT J1950.0, AND 0.085 SECONDS OF TIME     ILO01370
C                  FOR THE EQUINOX MOTION PER JULIAN CENTURY            ILO01380
C               4) THE CONTINUITY OF UT1 IS GUARANTEED AT 1984 JAN. 1.0.ILO01390
C                                                                       ILO01400
C           DTOR,MTOR,STOR                                              ILO01410
C                 : COEFFICIENTS OF CONVERSION FROM DEGREES, MINUTES    ILO01420
C                   AND SECONDS, RESPECTIVELY TO RADIANS                ILO01430
C           RTOD,RTOM,RTOS                                              ILO01440
C                 : COEFFICIENTS OF CONVERSION FROM RADIANS TO          ILO01450
C                   DEGREES, MINUTES AND SECONDS, RESPECTIVELY          ILO01460
C                                                                       ILO01470
C ######################################################################ILO01510
C                                                                       ILO01520

C -- REMOVED IMPLICIT NONE AND REPLACED BY EXPLICIT DECLARATIONS:
C --  IMPLICIT REAL*8 (A-H,O-Z)                                         ILO01530
      REAL*8 A,VA
      REAL*8 C
      REAL*8 PI,RTOD,DTOR,RTOM,MTOR,RTOS,STOR
C                                                                       ILO01550
      COMMON /COMA  / A(3),VA(3)                                        
      COMMON /COMMAT/ C(6,6)                                            
      COMMON /COMPI / PI,RTOD,DTOR,RTOM,MTOR,RTOS,STOR                  
C                                                                       
      DATA  A/-1.62557D-6, -0.31919D-6, -0.13843D-6/
      DATA VA/ 1.245D-3,   -1.580D-3,   -0.659D-3/
C                                                                       ILO01640
	DATA    C(1,1),C(1,2),C(1,3),C(1,4),C(1,5),C(1,6),
     #		C(2,1),C(2,2),C(2,3),C(2,4),C(2,5),C(2,6),
     #		C(3,1),C(3,2),C(3,3),C(3,4),C(3,5),C(3,6),
     #		C(4,1),C(4,2),C(4,3),C(4,4),C(4,5),C(4,6),
     #		C(5,1),C(5,2),C(5,3),C(5,4),C(5,5),C(5,6),
     #		C(6,1),C(6,2),C(6,3),C(6,4),C(6,5),C(6,6)
     &  /  .9999256782D0,  -.0111820610D0,  -.0048579477D0,             
     &      2.4239502D-6,   -2.71066D-8,     -1.17766D-8,               
     &     .0111820609D0,   .9999374784D0,  -.0000271765D0,             
     &      2.71066D-8,      2.4239788D-6,   -6.59D-11,                 
     &     .0048579479D0,  -.0000271474D0,   .9999881997D0,             
     &      1.17766D-8,     -6.58D-11,        2.4241017D-6,             
     &    -.00055D0,      -.23854D0,         .43574D0,                  
     &     .99994704D0,   -.01118251D0,     -.00485767D0,               
     &     .23849D0,      -.00267D0,        -.00854D0,                  
     &     .01118251D0,    .99995883D0,     -.00002718D0,               
     &    -.43562D0,       .01225D0,         .00212D0,                  
     &     .00485767D0,   -.00002714D0,     1.00000956D0/               
C                                                                       ILO01790
      DATA PI/ 3.141592653589793238D0/
C                                                                       ILO01960
C                            DTOR, MTOR AND STOR ARE COEFFICIENTS       ILO01970
C                            OF CONVERSION FROM DEGREE, MINUTE AND      ILO01980
C                            SECOND, RESPECTIVELY TO RADIAN             ILO01990
	DATA DTOR/ 0.17453292519943E-01/
        DATA MTOR/ 0.29088820866572E-03/
  	DATA STOR/ 0.48481368110954E-05/
C                                                                       ILO02030
C                            RTOD, RTOM AND RTOS ARE COEFFICIENTS       ILO02040
C                            OF CONVERSION FROM RADIAN TO DEGREE        ILO02050
C                            MINUTE AND SECOND, RESPECTIVELY            ILO02060
	DATA RTOD/ 0.57295779513082E+02/
	DATA RTOM/ 0.34377467707849E+04/
	DATA RTOS/ 0.20626480624710E+06/
C                                                                       ILO02100
C --- END OF FORMER BLOCK DATA CONST 

C Begin Executable Code
C ---------------------
C
C                   CONVERT THE OLD POSITIONS AND PROPER MOTIONS        ILO00970
C                   TO THE NEW POSITIONS AND PROPER MOTIONS.            ILO00980
C                                                                       ILO00990
      CALL CNVPOS(VECTOR,ALP,DEL,PRA,PRD,VRAD,PLX)
C                                                                       ILO01030
C                   OUTPUT THE NEW POSITIONS AND PROPER MOTIONS OF STARSILO01050
C                                                                       ILO01080
      IF(IUNIT.GT.0 .AND. IUNIT.LT.100) CALL POSOUT(ALP,DEL,PRA,PRD,
     #		VRAD,PLX,IDENT,IUNIT)
C                                                                       ILO01100
C                                                                       ILO01110
	RETURN
	END

      SUBROUTINE POSOUT(ALP,DEL,PRA,PRD,VRAD,PLX,IDENT,IUNIT)
C                                                                       ILO04260
C ########################   SPECIFICATION   ###########################ILO04270
C                                                                       ILO04280
C           FOR CHECK PURPOSE, PRINT OUT THE POSITIONS AND PROPER       ILO04290
C           MOTIONS, PARALLAX, AND RADIAL VELOCITY OF STARS.            ILO04300
C                                                                       ILO04310
C  INPUT                                                                ILO04320
C           ALP       : RIGHT ASCENSION OF STAR   (SECONDS OF TIME)
C           DEL       : DECLINATION OF STAR   (SECONDS OF ARC)
C           PRA       : PROPER MOTION IN RIGHT ASCENSION OF STAR
C                          (SECONDS OF arc PER TROPICAL CENTURY WHEN
C                           CALLED IN SUBROUTINE OLDPOS)                ILO04430
C                          (SECONDS OF TIME PER JULIAN CENTURY WHEN     ILO04440
C                           CALLED IN SUBROUTINE NEWPOS)                ILO04450
C           PRD       : PROPER MOTION IN DECLINATION OF STAR
C                          (SECONDS OF ARC PER TROPICAL CENTURY WHEN    ILO04470
C                           CALLED IN SUBROUTINE OLDPOS)                ILO04480
C                          (SECONDS OF ARC PER JULIAN CENTURY WHEN      ILO04490
C                           CALLED IN SUBROUTINE NEWPOS)                ILO04500
C           VRAD      : RADIAL VELOCITY OF STAR (KM/SEC)
C                       =0.0 IF RADIAL VELOCITY IS NOT KNOWN            ILO04520
C           PLX       : PARALLAX OF STAR        (SECONDS OF ARC)
C                       =0.0 IF PARALLAX IS NOT KNOWN                   ILO04540
C           IDENT     : CATALOG IDENTIFICATION OF THE STAR
C                                                                       ILO04560
C                                                                       ILO04790
C  CALLER ROUTINE                                                       ILO04800
C           SUBROUTINE J2000
C                                                                       ILO04830
C ######################################################################ILO04840
C                                                                       ILO04850
      IMPLICIT REAL*8 (A-H,O-Z)                                         
C                                                                       ILO04870
	CHARACTER*16  IDENT
      INTEGER*2 SGN,BLNK,NEG                                            
C                                                                       ILO04940
      DATA BLNK/' '/,NEG/'-'/                                           
C                                                                       ILO04960
        IF(ALP.LT.0.0D0) ALP=ALP+3600.0D0*24.0D0
C                                                                       ILO05000
C                            TIME HOUR, TIME MINUTE AND TIME SECOND     ILO05010
C                            PART OF RIGHT ASCENSION                    ILO05020
        IAH=ALP/3600.0D0
        DAH=IAH                                                         
        IAM=(ALP-DAH*3600.0D0)/60.0D0
        DAM=IAM                                                         
        AS = ALP-DAH*3600.0D0-DAM*60.0D0
C                                                                       ILO05080
C                            DEGREE, ARC MINUTE, ARC SECOND PART OF     ILO05090
C                            DECLINATION                                ILO05100
        IDH=DEL/3600.0D0
        DDH=IDH                                                         
        IDM=(DABS(DEL)-DABS(DDH)*3600.0D0)/60.0D0
        DDM=IDM                                                         
        DS=  DABS(DEL)-DABS(DDH)*3600.0D0-DDM*60.0D0
C                                                                       ILO05160
        IDH=IABS(IDH)                                                   
        IF(DEL.LT.0.0D0) SGN=NEG
        IF(DEL.GE.0.0D0) SGN=BLNK
C                                                                       ILO05200
        WRITE(IUNIT,6100)  IDENT,IAH,IAM,AS,SGN,IDH,IDM,DS,PRA,PRD,
     #		PLX,VRAD
C                                                                       ILO05240
 6100 FORMAT(1X,A16,2X,2I3,F7.3,2X,A1,2I3,F7.3,F9.3,F8.2,1X,F8.3,2X,
     &       F8.1)
C                                                                       ILO05370
      RETURN                                                            
      END                                                               
      SUBROUTINE CNVPOS(VECTOR,ALP,DEL,PRA,PRD,VRAD,PLX)
C                                                                       ILO05440
C ########################   SPECIFICATION   ###########################ILO05450
C                                                                       ILO05460
C           CONVERT THE OLD POSITIONS AND PROPER MOTIONS                ILO05470
C           TO THE NEW POSITIONS AND PROPER MOTIONS.                    ILO05480
C                                                                       ILO05490
C  INPUT                                                                ILO05500
C	    VECTOR    : Unit 3_vector coordinates
C           PRA       : PROPER MOTION IN RIGHT ASCENSION OF STAR
C                           (SECONDS OF arc PER TROPICAL CENTURY)
C           PRD       : PROPER MOTION IN DECLINATION OF STAR
C                           (SECONDS OF ARC PER TROPICAL CENTURY)       ILO05590
C           VRAD      : RADIAL VELOCITY OF STAR (KM/SEC)
C           PLX       : PARALLAX OF STAR   (SECONDS OF ARC)
C                                                                       ILO05630
C  PRODUCT                                                              ILO05640
C           ALP       : RIGHT ASCENSION OF STAR   (SECONDS OF TIME)
C           DEL       : DECLINATION OF STAR   (SECONDS OF ARC)
C           PRA       : PROPER MOTION IN RIGHT ASCENSION OF STAR
C                          (SECONDS OF arc PER JULIAN CENTURY)
C           PRD       : PROPER MOTION IN DECLINATION OF STAR
C                          (SECONDS OF ARC PER JULIAN CENTURY)          ILO05730
C           VRAD      : RADIAL VELOCITY OF STAR (KM/SEC)
C                       =0.0 IF RADIAL VELOCITY IS NOT KNOWN            ILO05750
C           PLX       : PARALLAX OF STAR        (SECONDS OF ARC)
C                       =0.0 IF PARALLAX IS NOT KNOWN                   ILO05770
C                                                                       ILO05790
C  CALLED ROUTINE                                                       ILO05830
C           SUBROUTINE GTXYZ0                                           ILO05840
C           SUBROUTINE ETERMS                                           ILO05850
C           SUBROUTINE CNVRDR                                           ILO05860
C           SUBROUTINE XYTOAD                                           ILO05870
C           SUBROUTINE DSTORT                                           ILO05880
C                                                                       ILO05890
C ######################################################################ILO05900
C                                                                       
      IMPLICIT REAL*8 (A-H,O-Z)                                         
      REAL*8   VECTOR(3)
C                                                                       ILO05930
C                CALCULATE THE POSITION AND SPACE MOTION VECTORS        ILO06030
C                OF A STAR, FROM THE OLD FK4-BASED CATALOGUE            ILO06040
C                POSITION AND PROPER MOTION AT B1950.0.                 ILO06050
C                                                                       ILO06060
        CALL GTXYZ0(VECTOR,PRA,PRD,VRAD,PLX)
C                                                                       ILO06080
C                                                                       ILO06090
C                REMOVE THE E-TERMS OF ABERRATION AND THE EFFECTS OF    ILO06110
C                THEIR VARIATIONS FROM THE OLD POSITION AND SPACE       ILO06120
C                MOTION VECTORS AT B1950.0.                             ILO06130
C                                                                       ILO06140
        CALL ETERMS                                                     
C                                                                       ILO06160
C                                                                       ILO06170
C                CONVERT THE OLD POSITION AND SPACE MOTION VECTORS AT   ILO06190
C                B1950.0 TO THE NEW FK5-BASED POSITION AND SPACE MOTION ILO06200
C                VECTORS AT J2000.0.                                    ILO06210
C                                                                       ILO06220
        CALL CNVRDR                                                     
C                                                                       ILO06240
C                                                                       ILO06250
C                CALCULATE NEW VALUES OF RIGHT ASCENSION, DECLINATION,  ILO06270
C                THEIR PROPER MOTIONS, PARALLAX AND RADIAL VELOCITY     ILO06280
C                FROM THE NEW POSITION AND SPACE MOTION VECTORS         ILO06290
C                AT J2000.0 ON FK5 SYSTEM.                              ILO06300
C                                                                       ILO06310
        CALL XYTOAD(VECTOR,ALP,DEL,PRA,PRD,VRAD,PLX)
C                                                                       ILO06330
C                                                                       ILO06340
C                CORRECT THE POSITIONS AND PROPER MOTIONS OF THE        ILO06360
C                EPOCH J2000.0 FOR DISTORTIONS IN THE FK4 SYSTEM        ILO06370
C                (FK5-FK4 SYSTEMATIC DIFFERENCE), WHEN KNOWN.           ILO06380
C                FOR THE TIME BEING (TILL THE FK5 IS PUBLISHED),        ILO06390
C                SUBROUTINE DSTORT IS NOT EFFECTIVE.                    ILO06400
C                                                                       ILO06410
        CALL DSTORT                                                     
C                                                                       ILO06470
      RETURN                                                            
      END                                                               
      SUBROUTINE GTXYZ0(VECTOR,PA,PD,VR,PX)
C                                                                       ILO06550
C ########################   SPECIFICATION   ###########################ILO06560
C                                                                       ILO06570
C                CALCULATE THE POSITION AND SPACE MOTION VECTORS        ILO06580
C                OF A STAR, FROM THE OLD FK4-BASED CATALOGUE            ILO06590
C                POSITION AND PROPER MOTION AT B1950.0.                 ILO06600
C                                                                       ILO06610
C  INPUT                                                                ILO06620
C	    VECTOR : Unit 3_vector coordinates
C           PA    : PROPER MOTION IN RIGHT ASCENSION                    ILO06650
C                         (IN SECONDS OF arc  PER TROPICAL CENTURY)
C           PD    : PROPER MOTION IN DECLINATION                        ILO06670
C                         (IN SECONDS OF ARC PER TROPICAL CENTURY)      ILO06680
C           VR    : RADIAL VELOCITY (IN KM/SEC)                         ILO06690
C           PX    : PARALLAX        (IN SECONDS OF ARC)                 ILO06700
C           DTOR,MTOR,STOR                                              ILO06710
C                 : COEFFICIENTS OF CONVERSION FROM DEGREE, MINUTE      ILO06720
C                   AND SECOND, RESPECTIVELY TO RADIAN                  ILO06730
C           RTOD,RTOM,RTOS                                              ILO06740
C                 : COEFFICIENTS OF CONVERSION FROM RADIAN TO           ILO06750
C                   DEGREE, MINUTE AND SECOND, RESPECTIVELY             ILO06760
C  PRODUCT                                                              ILO06770
C           X0(3) : POSITION VECTOR OF THE STAR AT B1950.0 BASED ON     ILO06780
C                   THE OLD RIGHT ASCENSION AND DECLINATION AT B1950.0  ILO06790
C           VX0(3): SPACE MOTION VECTOR OF THE STAR AT B1950.0 BASED ON ILO06800
C                   THE OLD RIGHT ASCENSION AND DECLINATION, AND THEIR  ILO06810
C                   PROPER MOTIONS AT B1950.0                           ILO06820
C           PX0   : PARALLAX IN THE OLD CATALOGUE                       ILO06830
C                   SENT OUT TO SUBROUTINE XYTOAD                       ILO06840
C                                                                       ILO06850
C  CALLER ROUTINE                                                       ILO06860
C           SUBROUTINE CNVPOS                                           ILO06870
C                                                                       ILO06880
C ######################################################################ILO06890
C                                                                       ILO06900
      IMPLICIT REAL*8 (A-H,O-Z)                                         
      REAL*8 VECTOR(3)
      REAL*8 MTOR                                                       
C                                                                       ILO06930
      COMMON /COMR0 / X0(3),VX0(3)                                      
      COMMON /OLDPLX/ PX0                                               
      COMMON /COMPI / PI,RTOD,DTOR,RTOM,MTOR,RTOS,STOR                  
C                                                                       ILO06970
C                          CEF=(KM/AU)(TROPICAL CENTURY/SEC)            ILO06980
      DATA CEF/21.094502D0/                                             
C                                                                       ILO07000
C                         STORE THE PARALLAX IN THE OLD CATALOGUE FOR   ILO07010
C                         THE USE IN SUBROUTINE XYTOAD                  ILO07020
      PX0=PX                                                            
C                                                                       ILO07040
C			Convert Unit 3_vector to RA and Dec ! NEW CODE
	CALL DCARSPH (VECTOR,ALP,DEL)			    ! NEW CODE
	ALP = ALP * RTOS / 15.0				    ! NEW CODE
	DEL = DEL * RTOS 				    ! NEW CODE
 
      COSD=DCOS(DEL*STOR)
      SIND=DSIN(DEL*STOR)
      COSA=DCOS(ALP*15.0D0*STOR)
      SINA=DSIN(ALP*15.0D0*STOR)
C                                                                       ILO07090
C                         THREE COMPONENTS OF RECTANGULAR COORDINATES   ILO07100
      X0(1)= VECTOR(1)
      X0(2)= VECTOR(2)
      X0(3)= VECTOR(3)
C                                                                       ILO07140
C                         THREE COMPONENTS OF RECTANGULAR VELOCITIES    ILO07150
      VX0(1)= -PD*SIND*COSA-  PA*X0(2)
      VX0(2)= -PD*SIND*SINA+  PA*X0(1)
      VX0(3)=  PD*COSD                                                  
C                                                                       ILO07190
      IF(VR.EQ.0.0D0 .OR. PX.EQ.0.0D0) RETURN                             
C                                                                       ILO07210
C                         THE CASE WHEN RADIAL VELOCITY AND PARALLAX    ILO07220
C                         ARE KNOWN                                     ILO07230
      VX0(1)=VX0(1)+CEF*VR*PX*X0(1)                                     
      VX0(2)=VX0(2)+CEF*VR*PX*X0(2)                                     
      VX0(3)=VX0(3)+CEF*VR*PX*X0(3)                                     
C                                                                       ILO07270
C                                                                       ILO07280
      RETURN                                                            
      END                                                               
      SUBROUTINE ETERMS                                                 
C                                                                       ILO07360
C ########################   SPECIFICATION   ###########################ILO07370
C                                                                       ILO07380
C                REMOVE THE E-TERMS OF ABERRATION AND THE EFFECTS OF    ILO07390
C                THEIR VARIATIONS FROM THE OLD POSITION AND SPACE       ILO07400
C                MOTION VECTORS AT B1950.0.                             ILO07410
C                                                                       ILO07420
C  INPUT                                                                ILO07430
C           X0(3) : POSITION VECTOR OF THE STAR AT B1950.0 BASED ON     ILO07440
C                   THE OLD RIGHT ASCENSION AND DECLINATION AT B1950.0  ILO07450
C           VX0(3): SPACE MOTION VECTOR OF THE STAR AT B1950.0 BASED ON ILO07460
C                   THE OLD RIGHT ASCENSION AND DECLINATION, AND THEIR  ILO07470
C                   PROPER MOTIONS AT B1950.0                           ILO07480
C           A(3)  : CONSTANT VECTOR DEFINED IN SUBROUTINE CONST         ILO07490
C           VA(3) : THE SAME AS ABOVE                                   ILO07500
C  PRODUCT                                                              ILO07510
C           X1(3) : POSITION VECTOR OF THE STAR AT B1950.0 BASED ON     ILO07520
C                   THE OLD RIGHT ASCENSION AND DECLINATION AT B1950.0  ILO07530
C                   FREE FROM THE EFFECTS OF THE E-TERMS OF ABERRATION  ILO07540
C           VX1(3): SPACE MOTION VECTOR OF THE STAR AT B1950.0 BASED ON ILO07550
C                   THE OLD RIGHT ASCENSION AND DECLINATION, AND THEIR  ILO07560
C                   PROPER MOTIONS AT B1950.0                           ILO07570
C                   FREE FROM THE EFFECTS OF THE E-TERMS OF ABERRATION  ILO07580
C                   AND THEIR VARIATIONS                                ILO07590
C                                                                       ILO07600
C  CALLER ROUTINE                                                       ILO07610
C           SUBROUTINE CNVPOS                                           ILO07620
C                                                                       ILO07630
C ######################################################################ILO07640
C                                                                       ILO07650
      IMPLICIT REAL*8 (A-H,O-Z)                                         
C                                                                       ILO07670
      COMMON /COMA  / A(3),VA(3)                                        
      COMMON /COMR0 / X0(3),VX0(3)                                      
      COMMON /COMR1 / X1(3),VX1(3)                                      
C                                                                       ILO07710
      C1=0.0D0                                                           
      C2=0.0D0                                                           
      DO 10 I=1,3                                                       
        C1=C1+X0(I)*A(I)                                                
        C2=C2+X0(I)*VA(I)                                               
   10 CONTINUE                                                          
C                                                                       ILO07780
C                                                                       ILO07790
      DO 20 I=1,3                                                       
        X1(I) =X0(I) -A(I) +C1*X0(I)                                    
        VX1(I)=VX0(I)-VA(I)+C2*X0(I)                                    
   20 CONTINUE                                                          
C                                                                       ILO07840
C*******************************************************************    ILO07850
C             ---- CHECK ----                                           ILO07860
C IF THE FOLLOWING DO LOOP IS EFFECTIVE, THEN EFFECTS OF E-TERMS OF     ILO07870
C ABERRATION WILL NOT BE REMOVED.                                       ILO07880
CC              DO 30 I=1,3                                             ILO07890
CC                 X1(I)=X0(I)                                          ILO07900
CC                 VX1(I)=VX0(I)                                        ILO07910
CC 30           CONTINUE                                                ILO07920
C*******************************************************************    ILO07930
C                                                                       ILO07940
      RETURN                                                            
      END                                                               
      SUBROUTINE CNVRDR                                                 
C                                                                       ILO08020
C ########################   SPECIFICATION   ###########################ILO08030
C                                                                       ILO08040
C                CONVERT THE OLD POSITION AND SPACE MOTION VECTORS AT   ILO08050
C                B1950.0 TO THE NEW FK5-BASED POSITION AND SPACE MOTION ILO08060
C                VECTORS AT J2000.0.                                    ILO08070
C                                                                       ILO08080
C  INPUT                                                                ILO08090
C           X1(3) : POSITION VECTOR OF THE STAR AT B1950.0 BASED ON     ILO08100
C                   THE OLD RIGHT ASCENSION AND DECLINATION AT B1950.0  ILO08110
C                   FREE FROM THE EFFECTS OF THE E-TERMS OF ABERRATION  ILO08120
C           VX1(3): SPACE MOTION VECTOR OF THE STAR AT B1950.0 BASED ON ILO08130
C                   THE OLD RIGHT ASCENSION AND DECLINATION, AND THEIR  ILO08140
C                   PROPER MOTIONS AT B1950.0                           ILO08150
C                   FREE FROM THE EFFECTS OF THE E-TERMS OF ABERRATION  ILO08160
C                   AND THEIR VARIATIONS                                ILO08170
C           C(6,6): TRANSFORMATION MATRIX FROM THE OLD POSITION AND     ILO08180
C                   SPACE MOTION VECTORS AT B1950.0 TO THE NEW POSITION ILO08190
C                   AND SPACE MOTION VECTORS AT J2000.0                 ILO08200
C                   THEIR VALUES ARE GIVEN IN SUBROUTINE CONST          ILO08210
C  PRODUCT                                                              ILO08220
C           X(3)  : POSITION VECTOR OF THE STAR AT J2000.0 ON FK5 SYSTEMILO08230
C           VX(3) : SPACE MOTION VECTOR OF THE STAR AT J2000.0 ON FK5   ILO08240
C                   SYSTEM                                              ILO08250
C                                                                       ILO08260
C  CALLER ROUTINE                                                       ILO08270
C           SUBROUTINE CNVPOS                                           ILO08280
C                                                                       ILO08290
C ######################################################################ILO08300
C                                                                       ILO08310
      IMPLICIT REAL*8 (A-H,O-Z)                                         
C                                                                       ILO08330
      COMMON /COMMAT/ C(6,6)                                            
      COMMON /COMR1 / X1(3),VX1(3)                                      
      COMMON /COMR  / X(3),VX(3)                                        
C                                                                       ILO08370
      DO 10 I=1,3                                                       
        X(I)=0.0D0                                                       
        VX(I)=0.0D0                                                      
   10 CONTINUE                                                          
C                                                                       ILO08420
C                                                                       ILO08430
      DO 30 I=1,3                                                       
        DO 20 J=1,3                                                     
          X(I) = X(I)+C(I,J) * X1(J) + C(I,J+3) * VX1(J)                
          VX(I)=VX(I)+C(I+3,J)*X1(J) + C(I+3,J+3)*VX1(J)                
   20   CONTINUE                                                        
   30 CONTINUE                                                          
C                                                                       ILO08500
C                                                                       ILO08510
      RETURN                                                            
      END                                                               
      SUBROUTINE XYTOAD(VECTOR,ALP,DEL,PA,PD,VR,PX)
C                                                                       ILO08580
C ########################   SPECIFICATION   ###########################ILO08590
C                                                                       ILO08600
C                CALCULATE NEW VALUES OF RIGHT ASCENSION, DECLINATION,  ILO08610
C                THEIR PROPER MOTIONS, PARALLAX AND RADIAL VELOCITY     ILO08620
C                FROM THE NEW POSITION AND SPACE MOTION VECTORS         ILO08630
C                AT J2000.0 ON FK5 SYSTEM.                              ILO08640
C                                                                       ILO08650
C  INPUT                                                                ILO08660
C           X(3)  : THREE COMPONENTS OF RECTANGULAR COORDINATES         ILO08670
C                   CORRESPONDING TO THE NEW CATALOGUE POSITION         ILO08680
C           VX(3) : THREE COMPONENTS OF RECTANGULAR VELOCITIES          ILO08690
C                   CORRESPONDING TO THE NEW CATALOGUE POSITION         ILO08700
C                   AND PROPER MOTION                                   ILO08710
C           PX0   : PARALLAX IN THE OLD CATALOGUE                       ILO08720
C           DTOR,MTOR,STOR                                              ILO08730
C                 : COEFFICIENTS OF CONVERSION FROM DEGREE, MINUTE      ILO08740
C                   AND SECOND, RESPECTIVELY TO RADIAN                  ILO08750
C           RTOD,RTOM,RTOS                                              ILO08760
C                 : COEFFICIENTS OF CONVERSION FROM RADIAN TO           ILO08770
C                   DEGREE, MINUTE AND SECOND, RESPECTIVELY             ILO08780
C  PRODUCT                                                              ILO08790
C	    VECTOR : Unit 3_vector coordinates
C           ALP   : RIGHT ASCENSION (IN SECONDS OF TIME)                ILO08800
C           DEL   : DECLINATION     (IN SECONDS OF ARC)                 ILO08810
C           PA    : PROPER MOTION IN RIGHT ASCENSION                    ILO08820
C                         (IN SECONDS OF arc PER JULIAN CENTURY)
C           PD    : PROPER MOTION IN DECLINATION                        ILO08840
C                         (IN SECONDS OF ARC PER JULIAN CENTURY)        ILO08850
C           VR    : RADIAL VELOCITY (IN KM/SEC)                         ILO08860
C           PX    : PARALLAX        (IN SECONDS OF ARC)                 ILO08870
C        ABOVE VARIABLES ARE THE NEW POSITION AND PROPER MOTION         ILO08880
C                                                                       ILO08890
C  CALLER ROUTINE                                                       ILO08900
C           SUBROUTINE CNVPOS                                           ILO08910
C                                                                       ILO08920
C ######################################################################ILO08930
C                                                                       ILO08940
      IMPLICIT REAL*8 (A-H,O-Z)                                         
      REAL*8 MTOR                                                       
      real*8	vector(3)
C                                                                       ILO08970
      COMMON /COMR  / X(3),VX(3)                                        
      COMMON /OLDPLX/ PX0                                               
      COMMON /COMPI / PI,RTOD,DTOR,RTOM,MTOR,RTOS,STOR                  
C                                                                       ILO09010
C                           R2 = X**2 + Y**2 +Z**2                      ILO09020
C                           RS2= X**2 + Y**2                            ILO09030
C                           R  = (X**2 + Y**2 + Z**2)**0.5              ILO09040
C                           RS = (X**2 + Y**2)**0.5                     ILO09050
      R2=X(1)**2+X(2)**2+X(3)**2                                        
      RS2=X(1)**2+X(2)**2                                               
      R=DSQRT(R2)                                                       
      RS=DSQRT(RS2)                                                     
C                                                                       ILO09100
C                           CDCA=COS(DELTA)*COS(ALPHA)                  ILO09110
C                           CDSA=COS(DELTA)*SIN(ALPHA)                  ILO09120
C                           SD  =SIN(DELTA)                             ILO09130
      CDCA = X(1)/R                                                     
      CDSA = X(2)/R                                                     
      SD   = X(3)/R                                                     
C                                                                       ILO09170
C                           PA : PROPER MOTION IN RIGHT ASCENSION       ILO09180
C                           PD : PROPER MOTION IN DECLINATION           ILO09190
C                           VR : RADIAL VELOCITY                        ILO09200
C                           PX : PARALLAX                               ILO09210
      PA = (X(1)*VX(2)-VX(1)*X(2))/RS2
      PD = ( VX(3)*RS2-X(3)*(X(1)*VX(1)+X(2)*VX(2)) )/R2/RS             
      IF(PX0.GT.0.0D0)                                                   
     &  VR = 0.047404704D0*( X(1)*VX(1)+X(2)*VX(2)+X(3)*VX(3) )/PX0/R   
      PX = PX0/R                                                        
C                                                                       ILO09270
C  ******************************************************************   ILO09280
C NOTE : IN THE FOLLOWING CALCULATIONS                                  ILO09290
C    DATAN2 IS THE DOUBLE PRECISION FUNCTION ARCTANGENT. IT HAS         ILO09300
C    TWO ARGUMENTS, FIRST BEING THE Y-COORDINATE AND THE SECOND         ILO09310
C    THE X-COORDINATE.  ITS RANGE IS FROM -PI TO +PI                    ILO09320
C  ******************************************************************   ILO09330
C                                                                       ILO09340
      IF(CDCA.EQ.0.0D0) GO TO 10                                         
          ALP=DATAN2(CDSA,CDCA)                                         
      IF(ALP.LT.0.0D0) ALP=PI*2.0D0+ALP                                   
            GO TO 20                                                    
   10 CONTINUE                                                          
      ALP=PI-DSIGN(1.0D0,CDSA)*PI/2.0D0                                   
   20 CONTINUE                                                          
C                                                                       ILO09420
C                                                                       ILO09430
        CD=CDCA**2+CDSA**2                                              
        CD=DSQRT(CD)                                                    
        DEL=DATAN2(SD,CD)                                               
C                                                                       ILO09470
C                         CONVERSIONS FROM RADIANS TO SECONDS OF TIME   ILO09480
C                         AND SECONDS OF ARC                            ILO09490
        ALP=ALP*RTOS/15.0D0                                              
        DEL=DEL*RTOS                                                    
C                                                                       ILO09520
C                                                                       ILO09530
	vector(1) = x(1)				! new code
	vector(2) = x(2)				! new code
	vector(3) = x(3)				! new code

      RETURN                                                            
      END                                                               
      SUBROUTINE DSTORT                                                 
C                                                                       ILO09600
C  SPECIFICATION                                                        ILO09610
C           CORRECT THE POSITION AND PROPER MOTION OF THE EPOCH         ILO09620
C           J2000.0 FOR DISTORTIONS IN THE FK4 SYSTEM (FK5-FK4          ILO09630
C           SYSTEMATIC DIFFERENCE), WHEN KNOWN                          ILO09640
C                                                                       ILO09650
C                                                                       ILO09660
      RETURN                                                            
      END