Chapter 10
Writing ADAM tasks

 10.1 Introduction
 10.2 Compiling and Linking
 10.3 Tasks with Parameters
 10.4 STATUS and error handling
 10.5 Returning values to ICL
 10.6 Graphics with ADAM
 10.7 Accessing Data

10.1 Introduction

It is easy to write your own ADAM A-tasks which can be run from ICL in the same way as the KAPPA programs. This is the easiest way of allowing ICL to run your own FORTRAN programs1. A detailed discussion of writing A-tasks can be found in SG/4 and SUN/101.

Here is a simple example of an ADAM A-task. Its source code consists of the FORTRAN source file MYTASK.FOR containing the following:

      SUBROUTINE MYTASK(STATUS)
      IMPLICIT NONE
      INTEGER STATUS
  
      CALL MSG_OUT(’ ’,’Hello’,STATUS)
  
      END

The example task consisted essentially of just one statement — the call of MSG_OUT. This routine is part of a subroutine library which is provided for outputting information to the terminal. The MSG_ routines should always be used for terminal output from ADAM tasks. FORTRAN PRINT and WRITE statements must not be used for this purpose.

Every ADAM task also has an interface file. The interface file contains information on the parameters of the task. Our task doesn’t have any parameters so its interface file is fairly simple. It consists of the following in the file MYTASK.IFL.

      INTERFACE MYTASK
      ENDINTERFACE

10.2 Compiling and Linking

Before compiling and linking ADAM tasks we need to run the command ADAM_DEV which sets up appropriate definitions. This in turn requires that the command ADAMSTART has been run.

      $ ADAMSTART
      $ ADAM_DEV

The task can then be compiled and linked using the following commands:

      $ FOR MYTASK
      $ ALINK MYTASK

To run the task start up ICL and define a command to run the task using the ICL DEFINE command.

      ICL> DEFINE  TEST  MYTASK
      ICL> TEST
      Loading MYTASK into 03BCMYTASK
      Hello
      ICL> TEST
      Hello
      ICL>

The DEFINE command defines the command TEST to run the A-task MYTASK. For this to work, MYTASK has to be in the default directory. If it were somewhere else a directory specification could be included on MYTASK in the DEFINE command.

TEST then causes the task to be loaded and executed. Typing TEST again causes it to be executed a second time, but this time it doesn’t have to be loaded.

10.3 Tasks with Parameters

The following is an example of a task with a parameter. This task calculates the square of a number and outputs its value on the terminal.

        SUBROUTINE SQUARE(STATUS)
        INTEGER STATUS
        REAL R,RR
        CALL PAR_GET0R(’VALUE’,R,STATUS)
        RR = R*R
        CALL MSG_SETR(’RVAL’,R)
        CALL MSG_SETR(’RSQUARED’,RR)
        CALL MSG_OUT(’ ’,’The Square of ^RVAL is ^RSQUARED’,STATUS)
        END

This program uses the subroutine PAR_GET0R to get the value of the parameter VALUE (there are similar routines for other types). Output of the numbers is done using the routine MSG_SETR to give values to the tokens RVAL and RSQUARED which are then inserted into the MSG_OUT output string using the ^RVAL notation. The interface file for this example is given below.

    INTERFACE SQUARE
  
      PARAMETER VALUE
        TYPE _REAL
        POSITION 1
        VPATH PROMPT
        PPATH CURRENT
        PROMPT ’Number to be squared’
      ENDPARAMETER
  
    ENDINTERFACE

The interface file has an entry for the parameter VALUE. The TYPE field specifies the type of the parameter. The underscore prefix on ’_REAL’ identifies it as a primitive type (i.e. a simple number or string, rather than an HDS structure or Device name). The position field specifies the position that the parameter is expected in if it appears on the command line.

The VPATH entry specifies how the parameter value is to be obtained if it not found on the command line. In this case it is to be prompted for. The PPATH entry specifies how the default value that appears in the parameter prompt is to be obtained. In this case the CURRENT value (i.e. the value the parameter had at the end of the last execution of the command) is used. The PROMPT field gives the prompt string to be used.

Interface files are described in more detail in SUN/115.

To run this example we would compile and link it as described above and then use the following ICL commands:

      ICL> DEFINE SQUARE SQUARE
      ICL> SQUARE 12
      Loading SQUARE into 03BCSQUARE
      The Square of 12 is 144
      ICL> SQUARE (SQRT(3))
      The Square of 1.73205 is 3
      ICL> SQUARE
      VALUE - Number to be squared /0.173205E+01/ > 7
      The Square of 7 is 49
      ICL>

10.4 STATUS and error handling

Most ADAM subroutines have an integer parameter called STATUS. STATUS has a success value (SAI__OK) which each routine will return if it completes successfully. If the routine fails for some reason it will return an error code indicating the nature of the error. An ADAM A-task routine (such as SQUARE) will be called with a STATUS of SAI__OK. If it returns a bad status value to its caller this will result in an appropriate message being output.

There is a further important feature of the status convention. If an ADAM routine is called with its STATUS argument having an error value on input, then the routine will do nothing and will return immediately. This feature means that it is usually not necessary to check STATUS after each routine is called. A series of ADAM routines can be called with the STATUS being passed from one to the next. If an error occurs in one of them, the subsequent routines will do nothing and the final status will indicate the error code from the routine that failed. If this STATUS value is then returned by the A-task main routine to its caller an error message will result. Thus the error will be correctly processed with no special code being added to check for errors.

It is important, however, to take care that code that does not consist of calls to ADAM routines does not get executed after an error has occurred. For this reason our SQUARE example would be better written as:

        SUBROUTINE SQUARE(STATUS)
        INTEGER STATUS
        INCLUDE ’SAE_PAR’  ! This provides the ADAM status codes
        REAL R,RR
        CALL PAR_GET0R(’VALUE’,R,STATUS)
        IF (STATUS .EQ. SAI__OK) THEN
           RR = R*R
           CALL MSG_SETR(’RVAL’,R)
           CALL MSG_SETR(’RSQUARED’,RR)
           CALL MSG_OUT(’ ’,’The Square of ^RVAL is ^RSQUARED’,STATUS)
        ENDIF
        END

This ensures that if the STATUS from PAR_GET0R is bad the rest of the routine is not executed with an undefined value of R. It is actually not necessary to include MSG_OUT in the IF block as this would not execute if STATUS was bad.

More sophisticated error handling can be provided by using routines in the ERR_ package. These facilities are fully described in SUN/104.

10.5 Returning values to ICL

We have already seen how ICL can be used to supply values for ADAM task parameters. It is also possible for ADAM tasks to return values to ICL. The following modified version of SQUARE does not output its result on the terminal, but returns it to the parameter VALUE using a call to the routine PAR_PUT0R which is analogous to PAR_GET0R.

        SUBROUTINE SQUARE(STATUS)
        INTEGER STATUS
        REAL R,RR
        CALL PAR_GET0R(’VALUE’,R,STATUS)
        IF (STATUS .EQ. SAI__OK) THEN
           RR = R*R
           CALL PAR_PUT0R(’VALUE’,RR,STATUS)
        ENDIF
        END

We could run this from ICL as follows (having done a DEFINE SQUARE SQUARE) to define the command:

      ICL> X=5
      ICL> SQUARE (X)
      ICL> =X
      25
      ICL>

In order for the ADAM task to return a value to ICL we must use a variable for the parameter and place it on the command line. The variable name must be placed in parentheses, then the name of a temporary HDS object is substituted by ICL.

A modification of this scheme is needed with character variables to allow the case where the contents of the character variable is itself a device, file or object name. In such cases, the supplied name cannot be replaced by some other name so, to indicate that they may not be replaced, name values in variables must be preceded by @.

10.6 Graphics with ADAM

All graphics in ADAM is based on the use of the GKS graphics system. Most users, however, will not use the GKS routines directly but will use a higher level package such as SGS, NCAR or PGPLOT. The following example uses SGS to draw a circle on a selected graphics device. (SGS is described in SUN/85, and its use within ADAM in SUN/113.)

        SUBROUTINE CIRCLE(STATUS)
        IMPLICIT NONE
        INTEGER STATUS
        REAL RADIUS          ! Radius of circle
        INTEGER ZONE         ! SGS Zone
        INCLUDE ’SAE_PAR’    ! Adam Constants
  
  *   Get the radius of the circle
        CALL PAR_GET0R(’RADIUS’,RADIUS,STATUS)
  
  *   Get the graphics device, and open SGS
        CALL SGS_ASSOC(’DEVICE’,’WRITE’,ZONE,STATUS)
  
  *   Draw the circle
        IF (STATUS .EQ. SAI__OK) THEN
            CALL SGS_CIRCL(0.5,0.5,RADIUS)
        ENDIF
  
  *   Close the graphics workstation
  *   and cancel the parameter
        CALL SGS_CANCL(ZONE,STATUS)
  
  *   Close down SGS
        CALL SGS_DEACT(STATUS)
  
        END

The interface file for this example is as follows:

  INTERFACE CIRCLE
  
     PARAMETER RADIUS
        TYPE _REAL
        POSITION 1
        VPATH PROMPT
        PPATH CURRENT
        PROMPT ’Radius of Circle’
     ENDPARAMETER
  
     PARAMETER DEVICE
        PTYPE DEVICE
        POSITION 2
        VPATH PROMPT
        PPATH CURRENT
        PROMPT ’Graphics Device’
     ENDPARAMETER
  
  ENDINTERFACE

When SGS is used from ADAM no calls to SGS_OPEN and SGS_CLOSE are made. Instead the routines SGS_ASSOC and SGS_ANNUL are used. SGS_ASSOC makes the association between an ADAM parameter (DEVICE) and an SGS zone whose zone identifier is returned to the program in the ZONE parameter. When SGS plotting is finished SGS_ANNUL is called and given the same ZONE value. SGS_ASSOC has an additional parameter, the access mode, which has possible values ’READ’, ’WRITE’ and ’UPDATE’.

There are a number of similar pairs of _ASSOC and _CANCL routines in ADAM which work in similar ways. MAG_ASSOC and MAG_CANCL are used to handle magnetic tape devices, FIO_ASSOC and FIO_CANCL to handle file I/O etc. Many of them also have an _ANNUL subroutine which frees the associated resource but does not cancel the associated ADAM parameter.

To run CIRCLE from ICL we could either use:

      ICL> CIRCLE  0.3  ARGS1

or let it prompt for the parameters:

      ICL> CIRCLE
      RADIUS - Radius of Circle /0.300000E+00/ > 0.2
      DEVICE - Graphics Device /@ARGS1/ > PRINTRONIX
      ICL> $ PRINT/NOFEED PRINTRONIX.BIT
      ICL>

In the latter case the default values of the parameters are the values from the previous time (a result of using PPATH CURRENT). With a hard copy graphics device such as PRINTRONIX, a file is created which must then be sent to the device with a DCL PRINT command.

10.7 Accessing Data

The basic means of storing and accessing data for ADAM is the Hierarchical Data System (HDS). SUN/92 describes this system and the DAT_ package of routines that are used to access data in this form. In HDS a data file contains a number of named components which can either be primitive items (numbers, character strings or arrays) or can themselves be structures containing further components.

To simplify the exchange of data between different applications packages, Starlink have released a set of standards for representing data within HDS. This is the Extensible N-Dimensional Data Format (NDF) – it is described in SGP/38. A library of subroutines (the NDF library, described in SUN/33) is provided for accessing these standard structures and will generally be used when writing applications.

Below is a simple example that calculates the mean value of the data in an NDF. For such data files the data will be found in a component of the file, called .DATA.

        SUBROUTINE MEAN(STATUS)
        IMPLICIT NONE
        INTEGER STATUS
        INCLUDE ’SAE_PAR’
        INTEGER NELM                       ! Number of Data elements
        CHARACTER*(DAT__SZLOC) LOC         ! HDS locator
        INTEGER PNTR                       ! Pointer to Data
        REAL MN                            ! Mean value of data
  
  * Start an NDF context
        CALL NDF_BEGIN
  
  * Get locator to parameter
        CALL NDF_ASSOC(’INPUT’,’READ’,LOC,STATUS)
  
  * Map the data array
        CALL NDF_MAP(LOC,’DATA’,’_REAL’,’READ’,PNTR,NELM,STATUS)
  
  * If everything OK calculate mean value of data array and output it
        IF (STATUS .EQ. SAI__OK) THEN
            CALL MEAN_SUB(NELM,%VAL(PNTR),MN)
            CALL MSG_SETR(’MEAN’,MN)
            CALL MSG_OUT(’ ’,’Mean Value of Array is ^MEAN’,STATUS)
        ENDIF
  
  * End the NDF context
        CALL NDF_END(STATUS)
  
        END
  
  
        SUBROUTINE MEAN_SUB(NELM,ARRAY,MEAN)
  
  *  Subroutine to calculate the mean value of the array
  
        IMPLICIT NONE
        INTEGER NELM
        REAL ARRAY(NELM)
        REAL MEAN
        INTEGER I
  
        MEAN = 0.0
        DO I=1,NELM
           MEAN = MEAN + ARRAY(I)
        ENDDO
        MEAN = MEAN / NELM
        END
  

There are a number of points to note about this example:

The interface file for this example could be as follows:

  INTERFACE MEAN
  
     PARAMETER INPUT
        TYPE NDF
        POSITION 1
        VPATH PROMPT
        PPATH CURRENT
        PROMPT ’NDF to calculate Mean Value from’
     ENDPARAMETER
  
  ENDINTERFACE

The above example shows how to handle the case where an NDF file is used for input. Where output to an NDF file is involved it is usually necessary to create a new HDS file when the application runs. This can be achieved using routine NDF_CREAT or NDF_CREP. For details of their usage, see SUN/33.

1The alternative way is by using the DEFUSER command