SUBROUTINE ARR_SELEM1R( PTR, DIM, INDEX, VAL, STATUS ) *+ * Name: * ARR_SELEM1R * Purpose: * Sets element of REAL array given pointer, index and value * Language: * Starlink Fortran * Invocation: * CALL ARR_SELEM1R( PTR, DIM, INDEX, VAL, STATUS ) * Description: * Sets element of REAL array given pointer, index and value. The index * is checked for legality. * Arguments: * PTR = INTEGER (given) * Address of the array * DIM = INTEGER (given) * Size of the array * INDEX = INTEGER (given) * Index of the element whose value is to be set * VAL = REAL (given) * The new value of the array element * 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} * 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: * 8 Mar 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 PTR ! Address of array INTEGER DIM ! Its dimension INTEGER INDEX ! Element wanted REAL VAL ! Element value * Status: INTEGER STATUS ! Global status *. * Check inherited global status. IF ( STATUS .EQ. SAI__OK ) THEN * Index is legal? IF ( (INDEX.GT.0) .AND. (INDEX.LE.DIM) ) THEN CALL ARR_SELEM1R_INT( %VAL(PTR), INDEX, VAL ) * Negative index? ELSE IF ( INDEX .LE. 0 ) THEN STATUS = SAI__ERROR CALL ERR_REP( ' ', 'AST_ERR: zero or negative array index', : STATUS ) ELSE IF ( INDEX .GT. DIM ) THEN STATUS = SAI__ERROR CALL ERR_REP(' ','AST_ERR: array index exceeds size of array', : STATUS) END IF IF (STATUS.NE.SAI__OK) THEN CALL AST_REXIT( 'ARR_SELEM1R', STATUS ) END IF END IF END