7 Using the NDF library calls

 7.1 Example 7 – Using NDF library calls to update an NDF
 7.2 Creating a new NDF
 7.3 Example 8a – Creating a new NDF (the bare essentials)
 7.4 Example 8b – Putting a title into the NDF
 7.5 Example 8c – Creating a data and variance array in an NDF

To illustrate the NDF library calls, let’s change the code clip.f so that the IMG calls are replaced by NDF calls. Enter the following code and save it as clip2.f.

7.1 Example 7 – Using NDF library calls to update an NDF

Code:

        SUBROUTINE CLIP2(STATUS)
  C
        IMPLICIT NONE
        INCLUDE ’SAE_PAR’
        INTEGER STATUS, NDF1, NELM, PTR1
        REAL MIN, MAX
  C
  C Enable the NDF calls
  C
        CALL NDF_BEGIN
  C
  C Associate the input NDF with some convenient label.
  C In this case, let’s call it NDF1. We’re also going to
  C access the file in such a way that it is UPDATEd.
  C
        CALL NDF_ASSOC(’INPUT’,’UPDATE’,NDF1,STATUS)
  C
  C Map the NDF data array
  C
        CALL NDF_MAP(NDF1,’Data’,’_REAL’,’UPDATE’,PTR1,NELM,STATUS)
  C
  C Now get the threshold values
  C
        WRITE (*,*) ’Enter min and max values >’
        READ (*,*), MIN, MAX
  C
  C Do the clipping.
  C
        CALL CLIPIT(NELM,%VAL(PTR1),MIN,MAX,STATUS)
  C
  C Close the NDF
  C
        CALL NDF_END(STATUS)
        END
  
        SUBROUTINE CLIPIT(NELM,VALUE,MIN,MAX,STATUS)
  C
        IMPLICIT NONE
        INCLUDE ’SAE_PAR’
        INTEGER NELM, STATUS, COUNTER, NCHANGE
        REAL VALUE(NELM), MIN, MAX
  C
  C Check everything is OK
  C
        IF (STATUS .NE. SAI__OK) RETURN
        DO COUNTER = 1, NELM
          IF (VALUE(COUNTER).GT.MAX .OR. VALUE(COUNTER).LT.MIN) THEN
          VALUE (COUNTER) = 0.0
          NCHANGE = NCHANGE + 1
          ENDIF
        END DO
        WRITE (*,*) NCHANGE, ’ points were changed.’
        END

Interface file clip2.ifl:

  interface clip2
     parameter INPUT
        prompt ’Input NDF’
     endparameter
  endinterface

and compile it using

  % alink clip2.f -L/star/lib ‘ndf_link_adam‘

noting the change in the library you’re linking your code to. Try running the application and compare its performance with the one that used the IMG library. You shouldn’t notice any difference.

Note that you can still access GIF, IRAF, ASCII etc. formats just as you could with the IMG library. All you have to remember is to start “Convert” first. The NDF library is more versatile in terms of available file formats than its name would suggest.

You’ll probably notice that a lot of the methodology behind the NDF library is similar to that which we used for the IMG library in part one. We still label NDFs. We still map them with pointers. One change you might have noticed is that when we mapped the NDF, we explicitly stated it was the ‘Data’ structure we wanted to map. As we’ll see later, we are not limited to this.

7.2 Creating a new NDF

In the last example, an NDF was made by updating an old one. In this section, there are three examples of creating a new NDF. The third example is the most complete, so the reader who is in a hurry could skip the first two examples.

7.3 Example 8a – Creating a new NDF (the bare essentials)

Code:

         SUBROUTINE CREATE(STATUS)
  *
  * This code just makes an empty, square NDF
  *
  * Parameters
  *
  * LBND = _INTEGER (Read)
  *  Lower Bounds
  *
  * UBND =  _INTEGER (Read)
  *  Upper Bounds
  *
  * OUT = NDF (Read)
  *  Output NDF
  *
         IMPLICIT NONE     ! No implicit typing
         INCLUDE ’SAE_PAR’ ! SAE constants
         INTEGER STATUS    ! Global status
         INTEGER NDIM      ! Number of dimensions of NDF
         INTEGER LBND      ! Lower bound
         INTEGER UBND      ! Upper bound
         INTEGER INDF      ! NDF Identifier
         PARAMETER(NDIM=2) ! Set Number of Dimensions = 2
  *
  * Start NDF context
  *
         CALL NDF_BEGIN
  *
  * Check status
  *
         IF (STATUS .NE. SAI__OK) RETURN
  *
  * Read in the bounds of the NDF
  *
         CALL PAR_GET0I(’LBND’,LBND,STATUS)
         CALL PAR_GET0I(’UBND’,UBND,STATUS)
  *
  * Create the new NDF
  *
         CALL NDF_CREAT(’OUT’,’_REAL’,NDIM,LBND,UBND,INDF,STATUS)
  *
  * Finish up
  *
         CALL NDF_END(STATUS)
         END

Interface file:

  interface CREATE
  
    parameter LBND
      position 1
      type _INTEGER
      prompt ’Lower bound’
    endparameter
  
    parameter UBND
      position 2
      type _INTEGER
      prompt ’Upper bound’
    endparameter
  
    parameter OUT
      position 3
      prompt ’Output NDF’
    endparameter
  
  endinterface

Running this code gives:

  % create
  LBND - Lower bound > 0
  UBND - Upper bound > 100
  OUT - Output NDF > jon
  !! The NDF structure /home/TEST/jon has been
  !     released from the NDF_ system with its data component in an undefined
  !     state (possible programming error).
  !  NDF_END: Error ending an NDF context.
  !  Application exit status NDF__DUDEF, data component undefined

This rather ghastly error merely means that the file is empty. Using hdstrace to list the contents of the NDF gives:

  JON  <NDF>
  
     DATA_ARRAY     <ARRAY>         {structure}
        DATA(101,1)    <_REAL>         {undefined}
        ORIGIN(2)      <_INTEGER>      0,0
  
  End of Trace.

Now let’s see how we can begin to put information into the NDF.

7.4 Example 8b – Putting a title into the NDF

Code:

         SUBROUTINE CREATE2(STATUS)
  *
  * This code just makes a square NDF with a Title Component
  *
  * Parameters
  *
  * LBND = _INTEGER (Read)
  *  Lower Bounds
  *
  * UBND =  _INTEGER (Read)
  *  Upper Bounds
  *
  * OUT = NDF (Read)
  *  Output NDF
  *
  * TITLE = LITERAL (Read)
  *  The NDF title
  *
         IMPLICIT NONE     ! No implicit typing
         INCLUDE ’SAE_PAR’ ! SAE constants
         INTEGER STATUS    ! Global status
         INTEGER NDIM      ! Number of dimensions of NDF
         INTEGER LBND      ! Lower bound
         INTEGER UBND      ! Upper bound
         INTEGER INDF      ! NDF Identifier
         PARAMETER(NDIM=2) ! Set Number of Dimensions = 2
  *
  * Start NDF context
  *
         CALL NDF_BEGIN
  *
  * Check status
  *
         IF (STATUS .NE. SAI__OK) RETURN
  *
  * Read in the bounds of the NDF
  *
         CALL PAR_GET0I(’LBND’,LBND,STATUS)
         CALL PAR_GET0I(’UBND’,UBND,STATUS)
  *
  * Create the new NDF
  *
         CALL NDF_CREAT(’OUT’,’_REAL’,NDIM,LBND,UBND,INDF,STATUS)
  *
  * Reset the old title if there is one
  *
         CALL NDF_RESET(INDF,’Title’,STATUS)
  *
  * Get the new title
  *
         CALL NDF_CINP(’TITLE’,INDF,’Title’,STATUS)
  *
  * Tidy up
  *
         CALL NDF_END(STATUS)
         END

Interface file:

  interface CREATE2
  
    parameter LBND
      position 1
      type _INTEGER
      prompt ’Lower bound’
    endparameter
  
    parameter UBND
      position 2
      type _INTEGER
      prompt ’Upper bound’
    endparameter
  
    parameter OUT
      position 3
      prompt ’Output NDF’
    endparameter
  
    parameter TITLE
      position 4
      type ’Literal’
      prompt ’Title’
    endparameter
  
  endinterface

Again, on running this code, a warning is reported. However, hdstrace reports:

  JON2  <NDF>
  
     DATA_ARRAY     <ARRAY>         {structure}
        DATA(101,1)    <_REAL>         {undefined}
        ORIGIN(2)      <_INTEGER>      0,0
  
     TITLE          <_CHAR*4>       ’test’
  
  End of Trace.

7.5 Example 8c – Creating a data and variance array in an NDF

In this example, we put both a data array and variance array (we’ll mention these in more more detail in the next section) into the file. This is done purely by mapping them:

         SUBROUTINE CREATE3(STATUS)
  *
  * This code just makes a square NDF with a Title Component
  *
  * Parameters
  *
  * LBND = _INTEGER (Read)
  *  Lower Bounds
  *
  * UBND =  _INTEGER (Read)
  *  Upper Bounds
  *
  * OUT = NDF (Read)
  *  Output NDF
  *
  * TITLE = LITERAL (Read)
  *  The NDF title
  *
         IMPLICIT NONE     ! No implicit typing
         INCLUDE ’SAE_PAR’ ! Global SAE constants
         INTEGER STATUS    ! Global status
         INTEGER NDIM      ! Number of dimensions of NDF
         INTEGER LBND      ! Lower bound
         INTEGER UBND      ! Upper bound
         INTEGER INDF      ! NDF identifier
         INTEGER IPNTR     ! Data pointer
         INTEGER VPNTR     ! Variance pointer
         INTEGER NPIX      ! Number of pixels
         PARAMETER(NDIM=2) ! Set Number of Dimensions = 2
  *
  * Start NDF context
  *
         CALL NDF_BEGIN
  *
  * Check status
  *
         IF (STATUS .NE. SAI__OK) RETURN
  *
  * Read in the bounds of the NDF
  *
         CALL PAR_GET0I(’LBND’,LBND,STATUS)
         CALL PAR_GET0I(’UBND’,UBND,STATUS)
  *
  * Create the new NDF
  *
         CALL NDF_CREAT(’OUT’,’_REAL’,NDIM,LBND,UBND,INDF,STATUS)
  *
  * Reset the old title if there is one
  *
         CALL NDF_RESET(INDF,’Title’,STATUS)
  *
  * Get the new title
  *
         CALL NDF_CINP(’TITLE’,INDF,’Title’,STATUS)
  *
  * Map data and variance arrays to force them into existence
  *
         CALL NDF_MAP(INDF,’Data’,’_REAL’,’WRITE’,IPNTR,NPIX,STATUS)
         CALL NDF_MAP(INDF,’Variance’,’_REAL’,’WRITE’,VPNTR,NPIX,STATUS)
  *
  * Tidy up
  *
         CALL NDF_END(STATUS)
         END

Interface file:

  interface CREATE3
  
    parameter LBND
      position 1
      type _INTEGER
      prompt ’Lower bound’
    endparameter
  
    parameter UBND
      position 2
      type _INTEGER
      prompt ’Upper bound’
    endparameter
  
    parameter OUT
      position 3
      prompt ’Output NDF’
    endparameter
  
    parameter TITLE
      position 4
      type ’Literal’
      prompt ’Title’
    endparameter
  
  endinterface

Obviously an additional subroutine is needed to put useful values into the arrays.