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