SUBROUTINE CELROT( STATUS )
*+
*  Name:
*     CELROT

*  Purpose:
*     Determine rotation required to rotate input to specified celestial system

*  Language:
*     Starlink Fortran

*  Type of Module:
*     ASTERIX task

*  Invocation:
*     CALL CELROT( STATUS )

*  Arguments:
*     STATUS = INTEGER (Given and Returned)
*        The global status.

*  Description:
*     {routine_description}

*  Usage:
*     celrot {parameter_usage}

*  Environment Parameters:
*     INP = CHAR (read)
*        Input dataset
*     GRID = CHAR (read)
*        Grid wanted, FK4, FK5, ECL or GAL

*  Examples:
*     {routine_example_text}
*        {routine_example_description}

*  Pitfalls:
*     {pitfall_description}...

*  Notes:
*     {routine_notes}...

*  Prior Requirements:
*     {routine_prior_requirements}...

*  Side Effects:
*     {routine_side_effects}...

*  Algorithm:
*     {algorithm_description}...

*  Accuracy:
*     {routine_accuracy}

*  Timing:
*     {routine_timing}

*  Implementation Status:
*     {routine_implementation_status}

*  External Routines Used:
*     {name_of_facility_or_package}:
*        {routine_used}...

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  References:
*     {task_references}...

*  Keywords:
*     celrot, usage:public

*  Copyright:
*     Copyright (C) University of Birmingham, 1995

*  Authors:
*     DJA: David J. Allan (Jet-X, University of Birmingham)
*     {enter_new_authors_here}

*  History:
*     23 Feb 1996 V2.0-0 (DJA):
*        Original version.
*     {enter_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
      
*  Type Definitions:
      IMPLICIT NONE              ! No implicit typing

*  Global Constants:
      INCLUDE 'SAE_PAR'          ! Standard SAE constants
      INCLUDE 'MATH_PAR'

*  Status:
      INTEGER			STATUS             	! Global status

*  External References:
      EXTERNAL			CHR_INSET
        LOGICAL			CHR_INSET

*  Local Constants:
      CHARACTER*20		AGRIDS
 	PARAMETER		( AGRIDS = 'FK4,FK5,ECL,GAL' )

      CHARACTER*30		VERSION
        PARAMETER		( VERSION = 'CELROT Version V2.0-0' )

*  Local Variables:
      CHARACTER*3		GRID			! Grid required

      DOUBLE PRECISION		CPOS(2)			! New centre position
      DOUBLE PRECISION		EPOCH			! Input epoch
      DOUBLE PRECISION		ROT			! Rotation angle
      DOUBLE PRECISION		PPOS(2)			! New +ve X position
      DOUBLE PRECISION		TPOS(2)			! Temp position

      REAL			APOS(2)			! An axis position
      REAL			EQNX			! input equinox

      INTEGER			IFID			! Input file
      INTEGER			NSYSID			! New astrometry
      INTEGER			SYSID, PIXID, PRJID	! Input astrometry
*.

*  Check inherited global status.
      IF ( STATUS .NE. SAI__OK ) RETURN

*  Version id
      CALL MSG_PRNT( VERSION )

*  Initialise ASTERIX
      CALL AST_INIT()

*  Associate input
      CALL USI_ASSOC( 'INP', 'BinDS|EventDS', 'READ', IFID, STATUS )

*  Read astrometry from input
      CALL WCI_GETIDS( IFID, PIXID, PRJID, SYSID, STATUS )
      IF ( STATUS .NE. SAI__OK ) GOTO 99

*  Get grid, and check valid
      CALL USI_GET0C( 'GRID', GRID, STATUS )
      CALL CHR_UCASE( GRID )
      IF ( STATUS .EQ. SAI__OK ) THEN

*    One of allowed grids?
        IF ( CHR_INSET( AGRIDS, GRID ) ) THEN

*      Create new frame using equinox and epoch from input
          CALL ADI_CGET0R( SYSID, 'EQUINOX', EQNX, STATUS )
          CALL ADI_CGET0D( SYSID, 'EPOCH', EPOCH, STATUS )
          CALL WCI_NEWSYS( GRID, EQNX, EPOCH, NSYSID, STATUS )

*      Get the position of the field centre and a point on the +ve X-axis
*      in the new frame. The offset in X is fine for degrees and arcmin.
          APOS(1) = 0.0
          APOS(2) = 0.0
          CALL WCI_CNA2S( APOS, PIXID, PRJID, TPOS, STATUS )
          CALL WCI_CNS2S( SYSID, TPOS, NSYSID, CPOS, STATUS )
          APOS(1) = 0.1
          APOS(2) = 0.0
          CALL WCI_CNA2S( APOS, PIXID, PRJID, TPOS, STATUS )
          CALL WCI_CNS2S( SYSID, TPOS, NSYSID, PPOS, STATUS )

*      The rotation angle is just the argument of the vector PPOS - TPOS
          ROT = ATAN2( PPOS(1)-CPOS(1), PPOS(2)-CPOS(2) )
          ROT = ROT * MATH__DRTOD - 90.0D0
          IF ( ROT .LT. -180D0 ) ROT = 360D0 + ROT
          IF ( ROT .LT. 0.0 ) ROT = 360D0 + ROT

*      Echo it to the user
          CALL MSG_SETD( 'R', ROT )
          CALL MSG_PRNT( '^R degrees' )
          CALL MSG_SETD( 'LAT', CPOS(1)*MATH__DRTOD )
          CALL MSG_SETD( 'LON', CPOS(2)*MATH__DRTOD )
          CALL MSG_PRNT( 'New centre ^LAT ^LON' )
          CALL MSG_SETD( 'LAT', PPOS(1)*MATH__DRTOD )
          CALL MSG_SETD( 'LON', PPOS(2)*MATH__DRTOD )
          CALL MSG_PRNT( '+ve deviate ^LAT ^LON' )

        ELSE
          CALL MSG_SETC( 'G', GRID )
          CALL MSG_SETC( 'GS', AGRIDS )
          STATUS = SAI__ERROR
          CALL ERR_REP( ' ', 'Unrecognised grid /^G/, should '/
     :                  /'be one of ^GS', STATUS )
        END IF

      END IF

*  Tidy up
 99   CALL AST_CLOSE()
      CALL AST_ERR( STATUS )

      END