next up previous
Next: Example of using Up: No Title Previous: Simple RECIO Example

ADAM RECIO Example

The following FORTRAN listing is the previous example implemented as an ADAM task.

*+  GETCHILD - copy CHILD objects from an IAM file
      SUBROUTINE GETCHILD ( STATUS )
*    Description :
*     Copy valid CHILD objects from an IAM dataset and write them to a
*     new IAM dataset.
*    Invocation :
*     CALL GETCHILD ( STATUS )
*    Parameters :
*     STATUS=INTEGER (given and returned)
*           global status
*    Method :
*     Open the input file for read and the output file for write.
*     Read through the input file inspecting records, and append any
*     relevant ones to the output file.
*    Authors :
*     B.D.Kelly (ROE)
*    History :
*     10.05.1995: original (BDK)
*    endhistory
*    Type Definitions :
      IMPLICIT NONE
*    Global constants :
      INCLUDE 'SAE_PAR'
      INCLUDE 'IAMREC_PAR'

*    Status :
      INTEGER STATUS

*    Local variables :
      INTEGER BUFFER(32)      ! record buffer
      INTEGER INFILE          ! RECIO number for input file
      INTEGER OUTFILE         ! RECIO number for output file
      INTEGER ENDFILE         ! end-of-file variable
      INTEGER RECLEN          ! record length in bytes
      CHARACTER*80 INPUT      ! name of input file
      CHARACTER*80 OUTPUT     ! name of output file
      CHARACTER*132 ERRMSG    ! error message from RECIO
*-

      IF ( STATUS .NE. SAI__OK ) RETURN


      CALL PAR_GET0C ( 'INPUT', INPUT, STATUS )
      CALL PAR_GET0C ( 'OUTPUT', OUTPUT, STATUS )

      RECIO_OPENR ( INPUT, INFILE, STATUS )
      RECIO_OPENW ( OUTPUT, OUTFILE, STATUS )

      RECLEN = IAMREC__NUMPARS * 4
      ENDFILE = 0

      DO WHILE ( ( ENDFILE .EQ. 0 ) .AND. ( STATUS .EQ. SAI__OK ) )
         CALL RECIO_READ ( INFILE, RECLEN, BUFFER, ENDFILE, STATUS )
         IF ( ( ENDFILE .EQ. 0 ) .AND. ( STATUS .EQ. SAI__OK ) ) THEN
            IF ( ( BUFFER(IAMREC__BLEND) .GT. 0 ) .AND. 
     :        ( BUFFER(IAMREC__QUALITY) .GE. 0 ) ) THEN
               RECIO_WRITE ( OUTFILE, RECLEN, BUFFER, STATUS )
            ENDIF
         ENDIF
      ENDDO

      IF ( STATUS .NE. SAI__OK ) THEN
         CALL RECIO_ERRTRAN ( ERRMSG, STATUS )
         CALL ERR_REP ( ' ', ERRMSG, STATUS )
      ENDIF

      END



SuperCOSMOS development
Tue Aug 20 12:03:21 BST 1996