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

*  Purpose:
*     Display attributes of a dataset in text form

*  Language:
*     Starlink Fortran

*  Type of Module:
*     ASTERIX task

*  Invocation:
*     CALL ASHOW( STATUS )

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

*  Description:
*     {routine_description}

*  Usage:
*     ASHOW {parameter_usage}

*  Environment Parameters:
*     INP = CHAR (Given) 
*        Name of file object whose attributes are to be displayed
*     ITEM = CHAR (Given)
*        The attribute to be displayed
*     DEV = CHAR (Given)
*        The name of the output text device

*  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:
*     ashow, usage:public

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

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

*  History:
*     13 Apr 1995 1.8-0 (DJA):
*        Original version.
*     14 Aug 1995 1.8-1 (DJA):
*        Improved timing report and added links option.
*      6 Sep 1995 2.0-0 (DJA):
*        Display selection info
*     {enter_changes_here}

*  Bugs:
*     {note_any_bugs_here}

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

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

*  Status:
      INTEGER			STATUS             	! Global status

*  External References:
      EXTERNAL			CHR_INSET
        LOGICAL			CHR_INSET

*  Local Constants:
      INTEGER			IC_WCS
        PARAMETER ( IC_WCS = 1 )
      INTEGER			IC_MIS
        PARAMETER ( IC_MIS = 2 )
      INTEGER			IC_TIM
        PARAMETER ( IC_TIM = 4 )
      INTEGER			IC_LNK
        PARAMETER ( IC_LNK = 8 )
      INTEGER			IC_SEL
        PARAMETER ( IC_SEL = 16 )
      INTEGER			IC_ALL
        PARAMETER ( IC_ALL = IC_WCS+IC_MIS+IC_TIM+IC_LNK+IC_SEL )

      CHARACTER*30		VERSION
        PARAMETER		( VERSION = 'ASHOW Version 2.0-0' )

*  Local Variables:
      CHARACTER*200		FILE, PATH		! File path info
      CHARACTER*20		ITEM			! Items to display

      INTEGER			IFID			! Input dataset id
      INTEGER			ITEMC			! Item code
      INTEGER			NLEV			! # path levels
      INTEGER			OCH			! Output channel
      INTEGER			OUTWID			! Output channel width
*.

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

*  Version id
      CALL MSG_PRNT( VERSION )

*  Initialise ASTERIX
      CALL AST_INIT()

*  Open the file
      CALL USI_ASSOC( 'INP', '*', 'READ', IFID, STATUS )

*  Get item to be displayed
      CALL USI_GET0C( 'ITEM', ITEM, STATUS )
      IF ( STATUS .EQ. SAI__OK ) THEN

*    Check against allowed alternatives
        IF ( ITEM .EQ. '*' ) THEN
          ITEMC = IC_ALL

*    Non-wildcard
        ELSE 

*      World coordinates?
          IF ( CHR_INSET( ITEM, 'WCS' ) ) THEN
            ITEMC = ITEMC + IC_WCS

          ELSE IF ( CHR_INSET( ITEM, 'MISS' ) ) THEN
            ITEMC = ITEMC + IC_MIS

          ELSE IF ( CHR_INSET( ITEM, 'TIME' ) ) THEN
            ITEMC = ITEMC + IC_TIM

          ELSE IF ( CHR_INSET( ITEM, 'LINKS' ) ) THEN
            ITEMC = ITEMC + IC_LNK

          ELSE IF ( CHR_INSET( ITEM, 'SEL' ) ) THEN
            ITEMC = ITEMC + IC_SEL

*      Otherwise error
          ELSE
            CALL MSG_SETC( 'ITEM', ITEM )
            STATUS = SAI__ERROR
            CALL ERR_REP( ' ', 'ASHOW item list contains unrecognised '/
     :       /'item /^ITEM/, see help for list of valid items', STATUS )

          END IF

        END IF

      END IF

*  Open the output channel
      CALL AIO_ASSOCO( 'DEV', 'LIST', OCH, OUTWID, STATUS )

*  All is well?
      IF ( STATUS .EQ. SAI__OK ) THEN

*    Write details of file
        CALL ADI_FTRACE( IFID, NLEV, PATH, FILE, STATUS )

*    Mission strings?
        IF ( AND( ITEMC, IC_MIS ) .NE. 0 ) THEN
          CALL ASHOW_MIS( IFID, OCH, STATUS )
        END IF

*    Timing
        IF ( AND( ITEMC, IC_TIM ) .NE. 0 ) THEN
          CALL ASHOW_TIM( IFID, OCH, STATUS )
        END IF

*    World coordinates?
        IF ( AND( ITEMC, IC_WCS ) .NE. 0 ) THEN
          CALL ASHOW_WCS( IFID, OCH, STATUS )
        END IF

*    File links
        IF ( AND( ITEMC, IC_LNK ) .NE. 0 ) THEN
          CALL ASHOW_LNK( IFID, OCH, STATUS )
        END IF

*    Dataset selection
        IF ( AND( ITEMC, IC_SEL ) .NE. 0 ) THEN
          CALL ASHOW_SEL( IFID, OCH, STATUS )
        END IF

      END IF

*  Close output device
      CALL AIO_CANCL( 'DEV', STATUS )

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

      END



      SUBROUTINE ASHOW_WCS( IFID, OCH, STATUS )
*+
*  Name:
*     ASHOW_WCS

*  Purpose:
*     Display world coordinates data

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_WCS( IFID, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     IFID = INTEGER (given)
*        Input dataset identifier
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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 'ADI_PAR'
      INCLUDE 'MATH_PAR'

*  Arguments Given:
      INTEGER			IFID			! Input dataset id
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  Local Variables:
      CHARACTER*1		EFORM			! Form of epoch
      CHARACTER*20		RAS, DECS		! RA,DEC in strings
      CHARACTER*3		SYS			! Coord system name

      DOUBLE PRECISION		EPOCH			! Equinox & epoch
      DOUBLE PRECISION		PNT(2)			! Pointing direction

      INTEGER			NVAL			! Values read from obj
      INTEGER			PIXID			! Pixellation
      INTEGER			PRJID			! Projection
      INTEGER			SYSID			! Coord system

      LOGICAL			THERE			! Object exists?
*.

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

*  Load WCS info
      CALL WCI_GETIDS( IFID, PIXID, PRJID, SYSID, STATUS )
      IF ( STATUS .NE. SAI__OK ) THEN
        CALL ERR_ANNUL( STATUS )
      END IF

*  Write heading
      CALL AIO_BLNK( OCH, STATUS )
      CALL AIO_IWRITE( OCH, 2, 'World Coordinates :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  First the coordinate system
      CALL AIO_IWRITE( OCH, 4, 'Coordinate system :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )
      CALL ASHOW_OB( SYSID, 'NAME', 'C', 'System name', ' ',
     :                'np', OCH, STATUS )
      CALL ASHOW_OB( SYSID, 'EQUINOX', 'D', 'Equinox', ' ',
     :                'np', OCH, STATUS )
      IF ( SYSID .NE. ADI__NULLID ) THEN
        CALL ADI_CGET0C( SYSID, 'EFORM', EFORM, STATUS )
        CALL ADI_CGET0D( SYSID, 'EPOCH', EPOCH, STATUS )
        CALL MSG_SETC( 'EF', EFORM )
        CALL MSG_SETD( 'EP', EPOCH )
        CALL AIO_IWRITE( OCH, 6, 'Epoch                : ^EF^EP', 
     :                   STATUS )
      ELSE
        CALL AIO_IWRITE( OCH, 6, '* not present *', STATUS )
      END IF
      CALL AIO_BLNK( OCH, STATUS )

*  The projection
      CALL AIO_IWRITE( OCH, 4, 'Coordinate reference & projection :',
     :                 STATUS )
      CALL AIO_BLNK( OCH, STATUS )
      IF ( SYSID .NE. ADI__NULLID ) THEN

*    Name of system
        CALL ADI_CGET0C( SYSID, 'NAME', SYS, STATUS )

*    Name of projection
        CALL ASHOW_OB( PRJID, 'NAME', 'C', 'Projection name', ' ',
     :                'np', OCH, STATUS )

*    Axis origin
        CALL ADI_CGET1D( PRJID, 'SPOINT', 2, PNT, NVAL, STATUS )
        IF ( SYS(1:2) .EQ. 'FK' ) THEN
          CALL STR_DRADTOC( PNT(1)*MATH__DDTOR, 'HHh MMm SS.SSs', RAS,
     :                      STATUS )
          CALL STR_DRADTOC( PNT(2)*MATH__DDTOR, 'SDDd MMm SS.Ss',DECS,
     :                      STATUS )
          CALL MSG_SETC( 'A', RAS )
          CALL MSG_SETC( 'B', DECS )
        ELSE
          CALL MSG_SETD( 'A', PNT(1) )
          CALL MSG_SETD( 'B', PNT(2) )
        END IF
        CALL AIO_IWRITE( OCH, 6, 'Axis origin          : ^A ^B', 
     :                   STATUS )

*    Centre of f.o.v
        CALL ADI_THERE( PRJID, 'NPOINT', THERE, STATUS )
        IF ( THERE ) THEN
          CALL ADI_CGET1D( PRJID, 'NPOINT', 2, PNT, NVAL, STATUS )
          IF ( SYS(1:2) .EQ. 'FK' ) THEN
            CALL STR_DRADTOC( PNT(1)*MATH__DDTOR, 'HHh MMm SS.SSs', RAS,
     :                      STATUS )
            CALL STR_DRADTOC( PNT(2)*MATH__DDTOR, 'SDDd MMm SS.Ss', 
     :                      DECS, STATUS )
            CALL MSG_SETC( 'A', RAS )
            CALL MSG_SETC( 'B', DECS )
          ELSE
            CALL MSG_SETD( 'A', PNT(1) )
            CALL MSG_SETD( 'B', PNT(2) )
          END IF
          CALL AIO_IWRITE( OCH, 6, 'FOV position         : ^A ^B', 
     :                     STATUS )
        END IF

      ELSE
        CALL AIO_IWRITE( OCH, 6, '* not present *', STATUS )
      END IF
      CALL AIO_BLNK( OCH, STATUS )

*  Report any errors
      IF ( STATUS .NE. SAI__OK ) CALL AST_REXIT( 'ASHOW_WCS', STATUS )

      END


      SUBROUTINE ASHOW_MIS( IFID, OCH, STATUS )
*+
*  Name:
*     ASHOW_MIS

*  Purpose:
*     Display detector configuration info

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_MIS( IFID, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     IFID = INTEGER (given)
*        Input dataset identifier
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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 'ADI_PAR'

*  Arguments Given:
      INTEGER			IFID			! Input dataset id
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  Local Variables:
      INTEGER			DETID			! DCI info
*.

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

*  Load mission strings
      CALL DCI_GETID( IFID, DETID, STATUS )
      IF ( STATUS .NE. SAI__OK ) THEN
        CALL ERR_ANNUL( STATUS )
      END IF

*  Write heading
      CALL AIO_BLNK( OCH, STATUS )
      CALL AIO_IWRITE( OCH, 2, 'Mission Description Strings :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  The observation details
      CALL AIO_IWRITE( OCH, 4, 'Observation Details :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Observer', 'C', 'Observer', ' ',
     :                'ig', OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Target', 'C', 'Target', ' ',
     :                'ig', OCH, STATUS )
      CALL AIO_BLNK( OCH, STATUS )
 
*  The hardware
      CALL AIO_IWRITE( OCH, 4, 'Instrument Configuration :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Mission', 'C', 'Mission', ' ',
     :                'ig', OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Instrument', 'C', 'Instrument', ' ',
     :                'ig', OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Detector', 'C', 'Detector', ' ',
     :                'ig', OCH, STATUS )
      CALL ASHOW_OB( DETID, 'Filter', 'C', 'Filter', ' ',
     :                'ig', OCH, STATUS )
      CALL ASHOW_OB( DETID, 'DataMode', 'C', 'Data mode', ' ',
     :                'ig', OCH, STATUS )

      CALL AIO_BLNK( OCH, STATUS )

*  Report any errors
      IF ( STATUS .NE. SAI__OK ) CALL AST_REXIT( 'ASHOW_MIS', STATUS )

      END



      SUBROUTINE ASHOW_TIM( IFID, OCH, STATUS )
*+
*  Name:
*     ASHOW_TIM

*  Purpose:
*     Display timing info

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_TIM( IFID, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     IFID = INTEGER (given)
*        Input dataset identifier
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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 'ADI_PAR'

*  Arguments Given:
      INTEGER			IFID			! Input dataset id
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  Local Variables:
      CHARACTER*8		DSTR, TSTR		! Date and time

      DOUBLE PRECISION		MJD			! MJD at start
      
      INTEGER			TIMID			! TCI info
*.

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

*  Load timing info
      CALL TCI_GETID( IFID, TIMID, STATUS )
      IF ( STATUS .NE. SAI__OK ) THEN
        CALL ERR_ANNUL( STATUS )
      END IF

*  Write heading
      CALL AIO_BLNK( OCH, STATUS )
      CALL AIO_IWRITE( OCH, 2, 'Timing Information :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  The observation details
      CALL AIO_IWRITE( OCH, 4, 'Observation Dates & Exposure Times :', 
     :                  STATUS )
      CALL AIO_BLNK( OCH, STATUS )

      CALL ADI_CGET0D( TIMID, 'MJDObs', MJD, STATUS )
      IF ( STATUS .EQ. SAI__OK ) THEN
        CALL TCI_MJD2DT( MJD, DSTR, TSTR, STATUS )
        CALL ASHOW_VAL( DSTR//' '//TSTR, 'Date/time at start', ' ', 
     :                  OCH, STATUS )
      ELSE
        CALL ERR_ANNUL( STATUS )
      END IF
      CALL ASHOW_OB( TIMID, 'MJDObs', 'D', 'MJD at start', ' ', 
     :                'np', OCH, STATUS )
      CALL ASHOW_OB( TIMID, 'TAIObs', 'C', 'TAI at start', 'days',
     :                'np', OCH, STATUS )
      CALL ASHOW_OB( TIMID, 'ObsLength', 'R', 'Obs. length', 'seconds',
     :                'np', OCH, STATUS )
      CALL ASHOW_OB( TIMID, 'Exposure', 'R', 'Exposure', 'seconds',
     :                'np', OCH, STATUS )
      CALL ASHOW_OB( TIMID, 'EffExposure', 'R', 'Effective exposure', 
     :                'seconds', 'ig', OCH, STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  Report any errors
      IF ( STATUS .NE. SAI__OK ) CALL AST_REXIT( 'ASHOW_TIM', STATUS )

      END



      SUBROUTINE ASHOW_LNK( IFID, OCH, STATUS )
*+
*  Name:
*     ASHOW_LNK

*  Purpose:
*     Display file links

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_TIM( IFID, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     IFID = INTEGER (given)
*        Input dataset identifier
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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 'ADI_PAR'

*  Arguments Given:
      INTEGER			IFID			! Input dataset id
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  External References:
      EXTERNAL			CHR_LEN
        INTEGER			CHR_LEN

*  Local Constants:
      INTEGER			NLINK
        PARAMETER		( NLINK = 2 )

*  Local Variables:
      CHARACTER*4		LNAMS(NLINK)		! Link names
      CHARACTER*40		LDESC(NLINK)		! Link descriptions
      CHARACTER*132		LINK			! Link value

      INTEGER			I			! Loop over links
      INTEGER			L			! Length of an LNAMS

      LOGICAL			OK			! Link is present

*  Local Data:
      DATA			LNAMS/'BGND', 'VIGN'/
      DATA			LDESC/'Background dataset',
     :                                'Vignetting factors'/
*.

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

*  Write heading
      CALL AIO_BLNK( OCH, STATUS )
      CALL AIO_IWRITE( OCH, 2, 'File link information :', STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  Write each link
      DO I = 1, NLINK

*    Link is present
        L = CHR_LEN( LNAMS(I) )
        CALL FRI_CHK( IFID, LNAMS(I)(:L), OK, STATUS )
        IF ( OK ) THEN
          CALL FRI_GETC( IFID, LNAMS(I)(:L),  LINK, STATUS )
          CALL ASHOW_VAL( LINK, LDESC(I), ' ', OCH, STATUS )
        ELSE
          CALL ASHOW_VAL( '* not set *', LDESC(I), ' ', OCH, STATUS )
        END IF

      END DO


*  Report any errors
      IF ( STATUS .NE. SAI__OK ) CALL AST_REXIT( 'ASHOW_LNK', STATUS )

      END


      SUBROUTINE ASHOW_SEL( IFID, OCH, STATUS )
*+
*  Name:
*     ASHOW_SEL

*  Purpose:
*     Display data selection

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_SEL( IFID, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     IFID = INTEGER (given)
*        Input dataset identifier
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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 'ADI_PAR'

*  Arguments Given:
      INTEGER			IFID			! Input dataset id
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  External References:
      EXTERNAL			CHR_LEN
        INTEGER			CHR_LEN

*  Local Variables:
      CHARACTER*132		ARDIN			! ARD text
      CHARACTER*40		CREATOR			! Selection author
      CHARACTER*20		SNAME			! Selection name
      CHARACTER*20		VARIANT			! Selector variant

      REAL			START, STOP		! Range pair

      INTEGER			BPTR, EPTR		! Mapped range pairs
      INTEGER			GRPID			! ARD identifier 
      INTEGER			I			! Loop over selections
      INTEGER			ICMP			! Loop over selectors
      INTEGER			ITXT			! Loop over ARD text
      INTEGER			L			! Length of ARDIN used
      INTEGER			NCMP			! # selectors
      INTEGER			NREC			! # selection records
      INTEGER			SELID			! Selection identifier
      INTEGER			SIID			! Selector identifier
      INTEGER			SID			! Selectors structure
      INTEGER			SIZE			! Amount of sel data
*.

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

*  Write heading
      CALL AIO_BLNK( OCH, STATUS )
      CALL AIO_IWRITE( OCH, 2, 'Dataset Selection Information :', 
     :                 STATUS )
      CALL AIO_BLNK( OCH, STATUS )

*  Get number of selection records
      CALL SLN_NREC( IFID, NREC, STATUS )

*  Display selections
      IF ( NREC .EQ. 0 ) THEN

        CALL AIO_IWRITE( OCH, 4, '** No selection data in input **',
     :                 STATUS )
        CALL AIO_BLNK( OCH, STATUS )

      ELSE

*    Write each selection
        DO I = 1, NREC

*      Announce this one
          CALL MSG_SETI( 'N', I )
          CALL AIO_IWRITE( OCH, 4, 'Selection Record ^N', STATUS )
          CALL AIO_BLNK( OCH, STATUS )
 
*      Get this record
          CALL SLN_GETREC( IFID, '*', I, SELID, STATUS )

*      Get program id
          CALL ADI_CGET0C( SELID, 'Version', CREATOR, STATUS )
          CALL ASHOW_VAL( CREATOR, 'Creator', ' ', OCH, STATUS )

*      Locate Selectors
          CALL ADI_FIND( SELID, 'Selectors', SID, STATUS )
          
*      Get number of components
          CALL ADI_NCMP( SID, NCMP, STATUS )
          DO ICMP = 1, NCMP

*        Index the selector
            CALL ADI_INDCMP( SID, ICMP, SIID, STATUS )

*        Get name and variant
            CALL ADI_NAME( SIID, SNAME, STATUS )
            CALL ADI_CGET0C( SIID, 'Variant', VARIANT, STATUS )

*        Switch on variant
            CALL ASHOW_VAL( 'Variant = '//VARIANT, SNAME, ' ', 
     :                      OCH, STATUS )
            IF ( VARIANT .EQ. 'AREA_DESCRIPTION' ) THEN
              CALL ADI_CGET0I( SIID, 'GRPID', GRPID, STATUS )

              CALL GRP_GRPSZ(GRPID,SIZE,STATUS)

              DO ITXT = 1, SIZE
                CALL GRP_GET( GRPID, ITXT, 1, ARDIN, STATUS )
                L = CHR_LEN(ARDIN)
                IF ( ITXT .EQ. 1 ) THEN
                  CALL ASHOW_VAL( ARDIN(:L), 'Description', ' ', 
     :                            OCH, STATUS )
                ELSE
                  CALL AIO_IWRITE( OCH, 29, ARDIN(:L), STATUS )
                END IF
              END DO

            ELSE IF ( VARIANT .EQ. 'RANGE_PAIRS' ) THEN

*          How many pairs?
              CALL ADI_CSIZE( SIID, 'START', SIZE, STATUS )

*          Map the data
              CALL ADI_CMAPR( SIID, 'START', 'READ', BPTR, STATUS )
              CALL ADI_CMAPR( SIID, 'STOP', 'READ', EPTR, STATUS )

*          Loop over pairs
              DO ITXT = 1, SIZE

*            Get these values
                CALL ARR_ELEM1R( BPTR, SIZE, ITXT, START, STATUS )
                CALL ARR_ELEM1R( EPTR, SIZE, ITXT, STOP, STATUS )

*            Print 'em out
                CALL MSG_SETR( 'START', START )
                CALL MSG_SETR( 'STOP', STOP )
                CALL MSG_MAKE( '^START -> ^STOP', ARDIN, L )
                IF ( ITXT .EQ. 1 ) THEN
                  CALL ASHOW_VAL( ARDIN(:L), 'Description', ' ', 
     :                            OCH, STATUS )
                ELSE
                  CALL AIO_IWRITE( OCH, 29, ARDIN(:L), STATUS )
                END IF
                
              END DO

*          Release range pairs data
              CALL ADI_CUNMAP( SIID, 'START', BPTR, STATUS )
              CALL ADI_CUNMAP( SIID, 'STOP', EPTR, STATUS )

            END IF

*        Release selector
            CALL ADI_ERASE( SIID, STATUS )

          END DO

*      Destroy it
          CALL ADI_ERASE( SID, STATUS )
          CALL ADI_ERASE( SELID, STATUS )

        END DO

      END IF

*  Report any errors
      IF ( STATUS .NE. SAI__OK ) CALL AST_REXIT( 'ASHOW_SEL', STATUS )

      END



      SUBROUTINE ASHOW_OB( OBJ, MEMBER, TYPE, DESCRIP, UNITS, IMODE, 
     :                      OCH, STATUS )
*+
*  Name:
*     ASHOW_OB

*  Purpose:
*     Format an ADI item

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_OBI( OBJ, MEMBER, TYPE, DESCRIP, UNITS, IMODE, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     OBJ = INTEGER (given)
*        ADI object to extract data from
*     MEMBER = CHARACTER*(*) (given)
*        Name of data member to extract
*     TYPE = CHARACTER*(*) (given)
*        Type code for item
*     DESCRIP = CHARACTER*(*)
*        Description of the object
*     UNITS = CHARACTER*(*)
*        Units of the object
*     IMODE = CHARACTER*(*)
*        How to handle missing data members
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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

*  Arguments Given:
      INTEGER			OBJ			! ADI object
      CHARACTER*(*)		MEMBER, TYPE
      CHARACTER*(*)		DESCRIP, UNITS
      CHARACTER*(*)		IMODE
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  Local Constants:
      INTEGER			IND			! Indentation
        PARAMETER		( IND = 6 )

*  Local Variables:
      CHARACTER*20		LDESCRIP
      CHARACTER*80		CVALUE

      DOUBLE PRECISION		DVALUE

      REAL			RVALUE

      INTEGER			IVALUE

      LOGICAL			OK			! Data is ok?
      LOGICAL			THERE			! Member exists?
*.

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

*  Local copy of description
      LDESCRIP = DESCRIP

*  Does member exist?
      CALL ADI_THERE( OBJ, MEMBER, THERE, STATUS )
      OK = .FALSE.
      IF ( THERE ) THEN

*    Extract data
        IF ( TYPE .EQ. 'C' ) THEN
          CALL ADI_CGET0C( OBJ, MEMBER, CVALUE, STATUS )
        ELSE IF ( TYPE .EQ. 'D' ) THEN
          CALL ADI_CGET0D( OBJ, MEMBER, DVALUE, STATUS )
        ELSE IF ( TYPE .EQ. 'R' ) THEN
          CALL ADI_CGET0R( OBJ, MEMBER, RVALUE, STATUS )
        ELSE IF ( TYPE .EQ. 'I' ) THEN
          CALL ADI_CGET0I( OBJ, MEMBER, IVALUE, STATUS )
        END IF

*    Trap errors
        IF ( STATUS .NE. SAI__OK ) THEN
          CALL ERR_ANNUL( STATUS )
        ELSE
          OK = .TRUE.
        END IF

      END IF
 
      IF ( OK ) THEN

*    Set tokens
        IF ( TYPE .EQ. 'C' ) THEN
          CALL MSG_SETC( 'VAL', CVALUE )
        ELSE IF ( TYPE .EQ. 'R' ) THEN
          CALL MSG_SETR( 'VAL', RVALUE )
        ELSE IF ( TYPE .EQ. 'D' ) THEN
          CALL MSG_SETD( 'VAL', DVALUE )
        ELSE IF ( TYPE .EQ. 'I' ) THEN
          CALL MSG_SETI( 'VAL', IVALUE )
        END IF
        CALL MSG_SETC( 'UNITS', UNITS )
        CALL AIO_IWRITE( OCH, IND, LDESCRIP//' : ^VAL ^UNITS', STATUS )

      ELSE IF ( IMODE .EQ. 'np' ) THEN
        IF ( THERE ) THEN
          CALL AIO_IWRITE( OCH, IND, LDESCRIP//' : * unreadable *',
     :           STATUS )
        ELSE
          CALL AIO_IWRITE( OCH, IND, LDESCRIP//' : * not present *',
     :           STATUS )
        END IF

      END IF

      END


      SUBROUTINE ASHOW_VAL( CVALUE, DESCRIP, UNITS, OCH, STATUS )
*+
*  Name:
*     ASHOW_VAL

*  Purpose:
*     Format an ADI item

*  Language:
*     Starlink Fortran

*  Invocation:
*     CALL ASHOW_OBI( CVALUE, DESCRIP, UNITS, OCH, STATUS )

*  Description:
*     {routine_description}

*  Arguments:
*     CVALUE = CHARACTER*(*) (given)
*        Value to format
*     DESCRIP = CHARACTER*(*)
*        Description of the object
*     UNITS = CHARACTER*(*)
*        Units of the object
*     OCH = INTEGER (given)
*        Output channel identifier
*     STATUS = INTEGER (given and returned)
*        The global status.

*  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}

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

*  Implementation Deficiencies:
*     {routine_deficiencies}...

*  Keywords:
*     ashow, usage:private

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

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

*  History:
*     13 Apr 1995 (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

*  Arguments Given:
      CHARACTER*(*)		CVALUE, DESCRIP, UNITS
      INTEGER			OCH			! Output channel

*  Status:
      INTEGER 			STATUS             	! Global status

*  Local Constants:
      INTEGER			IND			! Indentation
        PARAMETER		( IND = 6 )

*  Local Variables:
      CHARACTER*20		LDESCRIP
*.

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

*  Local copy of description
      LDESCRIP = DESCRIP

*    Set tokens
      CALL MSG_SETC( 'VAL', CVALUE )
      CALL MSG_SETC( 'UNITS', UNITS )
      CALL AIO_IWRITE( OCH, IND, LDESCRIP//' : ^VAL ^UNITS', STATUS )

      END