SUBROUTINE THDSPAR( STATUS)
  *   Exercise the HDSPAR routines
  *
  *   The program creates a structure (parameter ’STRUCTURE’) and an
  *   INTEGER array component (parameter ’COMPONENT1’) if they do not
  *   already exist. (These would normally be a top-level structure and
  *   a component of it.)
  *   A REAL array is then written to the component and the component
  *   set as the dynamic default for the parameter ’INPUT’.
  *   A REAL array is then read from the data object associated with the
  *   ’INPUT’ parameter - if the dynamic default is chosen, this will be
  *   the INTEGER component just written.
  *   The input array is then displayed. (Note that conversion will have
  *   occurred in writing a REAL array to an INTEGER component.)
  *   The INPUT object is then set as the dynamic default for COMPONENT2
  *   and then deleted.
  *   COMPONENT2 is then created if it does not exist (it should not
  *   exist if the dynamic default is used) and a second attempt made to
  *   create it, expecting error DAT__COMEX.
  
        INCLUDE ’DAT_PAR’
        INCLUDE ’PAR_ERR’
  
        INTEGER STATUS
        INTEGER NDIMS
        INTEGER DIMS(2), ACTDIMS(2)
        INTEGER I, J
        REAL ARR(2,3)
        CHARACTER*(DAT__SZLOC) LOC1, LOC2
  
        DATA ARR/1.1,2.2,3.3,4.4,5.5,6.6/
  
        NDIMS = 2
        DIMS(1) = 2
        DIMS(2) = 3
  
  *   Create a structure if it does not already exist.
        CALL DAT_EXIST( ’STRUCTURE’, ’WRITE’, LOC1, STATUS )
        IF ( STATUS .EQ. PAR__ERROR ) THEN
           CALL ERR_REP( ’ ’, ’Structure did not exist’, STATUS )
           CALL ERR_FLUSH( STATUS )
           CALL DAT_CREAT( ’STRUCTURE’, ’STRUC’, 0, DIMS, STATUS )
        ENDIF
  
  *   Cancel the structure parameter.
        CALL DAT_CANCL( ’STRUCTURE’, STATUS )
  
  *   Create a component if it does not already exist.
        CALL DAT_EXIST( ’COMPONENT1’, ’WRITE’, LOC1, STATUS )
        IF ( STATUS .EQ. PAR__ERROR ) THEN
           CALL ERR_ANNUL( STATUS )
           CALL MSG_OUT( ’ ’, ’Component did not exist.’, STATUS )
           CALL DAT_CREAT( ’COMPONENT1’, ’_INTEGER’, 2, DIMS, STATUS )
        ENDIF
  
  *   Get a locator for the specified component and write to it.
        CALL DAT_ASSOC( ’COMPONENT1’, ’WRITE’, LOC2, STATUS )
        CALL DAT_PUTNR( LOC2, NDIMS, DIMS, ARR, DIMS, STATUS )
  
  *   Update the disk - we can’t see the effect of this.
        CALL DAT_UPDAT( ’COMPONENT1’, STATUS )
  
  *   Set the specified component as the dynamic default for ’INPUT’.
        CALL DAT_DEF( ’INPUT’, LOC2, STATUS )
  
  *   The above locator may now be annulled.
        CALL DAT_CANCL( ’COMPONENT1’, STATUS )
  
  *   Get a locator for the ’INPUT’ component and read from it.
        CALL DAT_ASSOC( ’INPUT’, ’READ’, LOC1, STATUS )
        CALL DAT_GETNR( LOC1, NDIMS, DIMS, ARR, ACTDIMS, STATUS )
  
  *   Display the input data.
        CALL MSG_OUT( ’ ’, ’Input array is:’, STATUS )
        DO 20 J = 1,ACTDIMS(2)
           DO 10 I = 1, ACTDIMS(1)
              CALL MSG_SETR( ’ROW’, ARR(I,J) )
              CALL MSG_SETC( ’ROW’, ’ ’ )
     10    CONTINUE
           CALL MSG_OUT( ’ ’, ’^ROW’, STATUS )
     20 CONTINUE
  
  *   Set the ’INPUT’ object as dynamic default for ’COMPONENT2’,
        CALL DAT_DEF( ’COMPONENT2’, LOC1, STATUS )
  
  *   Delete the ’INPUT’ component.
        CALL DAT_DELET( ’INPUT’, STATUS )
  
  *   Check that ’COMPONENT2’ does not exist
  *   and create it.
        CALL DAT_EXIST( ’COMPONENT2’, ’WRITE’, LOC1, STATUS )
        IF ( STATUS .EQ. PAR__ERROR ) THEN
           CALL ERR_REP( ’ ’, ’Component did not exist.’, STATUS )
           CALL ERR_FLUSH( STATUS )
           CALL DAT_CREAT( ’COMPONENT2’, ’_INTEGER’, 2, DIMS, STATUS )
        ENDIF
  
  *   Attempt to create it again - expect an error.
        CALL MSG_OUT( ’ ’, ’Expect error DAT__COMEX.’, STATUS )
        CALL DAT_CREAT( ’COMPONENT2’, ’_INTEGER’, 2, DIMS, STATUS )
  
        END

  interface THDSPAR
   parameter STRUCTURE
     position 1
     type univ
     access write
     vpath prompt
     ppath default
     default created
   endparameter
   parameter COMPONENT1
     position 2
     type univ
     access update
     vpath prompt
     ppath default
     default created.comp
   endparameter
   parameter INPUT
     position 3
     type univ
     access read
     vpath dynamic
   endparameter
   parameter COMPONENT2
     position 4
     type univ
     vpath dynamic
   endparameter
  endinterface
  

  % thdspar
  STRUCTURE /@created/ >
  COMPONENT1 /@created.comp/ >
  Input array is:
  1 2
  3 4
  5 6
  !! SUBPAR: Error finding component ’COMP’ in
  !     "/tmp_mnt/mount_nfs/user1/dec/ajc/test/created.sdf"CREATED.COMP
  !  Component did not exist
  Expect error DAT__COMEX
  !! DAT_NEW: Error creating a new HDS component.
  !  Application exit status DAT__COMEX, Component already exists