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
The following interface file could be used. This will cause prompts for parameters STRUCTURE and COMPONENT1, and take the dynamic defaults for INPUT and COMPONENT2 (unless values are given on the command line).
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
The resultant session, accepting suggested values would look like this:
% 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
HDSPAR - HDS Parameter Routines