SUBROUTINE ARR_SLCOPD( NDIM, DIMS, IN, LBND, UBND, OUT, STATUS )
*+
* Name:
* ARR_SLCOPD
* Purpose:
* Extract a slice of DOUBLE PRECISION elements from an array
* Language:
* Starlink Fortran
* Invocation:
* CALL ARR_SLCOPD( NDIM, DIMS, IN, LBND, UBND, OUT, STATUS )
* Description:
* Extracts a slice from an array of DOUBLE PRECISIONs of dimensionality less
* than or equal 7.
* Arguments:
* NDIM = INTEGER (given)
* Dimensionality of input array
* DIMS[NDIM] = INTEGER (given)
* Dimensions of input array
* IN[] = DOUBLE PRECISION (given)
* The input data
* LBND[NDIM] = INTEGER (given)
* Lower indices of slice
* UBND[NDIM] = INTEGER (given)
* Upper indices of slice
* OUT[] = DOUBLE PRECISION (returned)
* The output slice
* STATUS = INTEGER (given)
* 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}...
* References:
* ARR Subroutine Guide : http://www.sr.bham.ac.uk/asterix-docs/Programmer/Guides/arr.html
* Keywords:
* package:arr, usage:public
* Copyright:
* Copyright (C) University of Birmingham, 1995
* Authors:
* DJA: David J. Allan (Jet-X, University of Birmingham)
* {enter_new_authors_here}
* History:
* 20 Sep 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 NDIM, DIMS(*), LBND(*), UBND(*)
DOUBLE PRECISION IN(*)
* Arguments Returned:
DOUBLE PRECISION OUT(*)
* Status:
INTEGER STATUS ! Global status
* Local Variables:
INTEGER I ! Loop over dimensions
INTEGER IDIMS(ADI__MXDIM) ! I/p dimensions
INTEGER ILBND(ADI__MXDIM) ! Slice lower bound
INTEGER ODIMS(ADI__MXDIM) ! O/p dimensions
*.
* Check inherited global status.
IF ( STATUS .NE. SAI__OK ) RETURN
* Construct output dimensions and make local copy of input dimensions
DO I = 1, NDIM
IDIMS(I) = DIMS(I)
ILBND(I) = LBND(I)
ODIMS(I) = UBND(I) - LBND(I) + 1
END DO
* Pad both input and output dimensions
CALL AR7_PAD( NDIM, IDIMS, STATUS )
CALL AR7_PAD( NDIM, ILBND, STATUS )
CALL AR7_PAD( NDIM, ODIMS, STATUS )
* Copy the data
CALL ARR_SLCOPD_INT( IDIMS(1), IDIMS(2), IDIMS(3), IDIMS(4),
: IDIMS(5), IDIMS(6), IDIMS(7), IN,
: ILBND(1), ILBND(2), ILBND(3), ILBND(4),
: ILBND(5), ILBND(6), ILBND(7),
: ODIMS(1), ODIMS(2), ODIMS(3), ODIMS(4),
: ODIMS(5), ODIMS(6), ODIMS(7),
: OUT, STATUS )
END