* X04ADF Example Program Text * Mark 19 Release. NAG Copyright 1999. * .. Parameters .. INTEGER NOUT PARAMETER (NOUT=6) INTEGER ICHAN PARAMETER (ICHAN=4) CHARACTER*11 FNAME PARAMETER (FNAME='success.res') * .. Local Scalars .. INTEGER IFAIL LOGICAL EX, OP * .. External Subroutines .. EXTERNAL X04ACF, X04ADF * .. Executable Statements .. WRITE (NOUT,*) 'X04ADF Example Program Results' * * Test successful open and close for write * IFAIL = 1 * CALL X04ACF(ICHAN,FNAME,1,IFAIL) * INQUIRE (ICHAN,EXIST=EX,OPENED=OP) IF ((IFAIL.EQ.0) .AND. EX .AND. OP) THEN WRITE (NOUT,99998) WRITE (ICHAN,99998) ELSE WRITE (NOUT,99999) FNAME, ICHAN END IF * IFAIL = 1 * CALL X04ADF(ICHAN,IFAIL) * INQUIRE (ICHAN,OPENED=OP) IF ((IFAIL.EQ.0) .AND. ( .NOT. OP)) THEN WRITE (NOUT,99997) ELSE WRITE (NOUT,99996) FNAME, ICHAN END IF * * Test successful open and close for read * IFAIL = 1 * CALL X04ACF(ICHAN,FNAME,0,IFAIL) * INQUIRE (ICHAN,EXIST=EX,OPENED=OP) IF ((IFAIL.EQ.0) .AND. EX .AND. OP) THEN WRITE (NOUT,99994) ELSE WRITE (NOUT,99995) FNAME, ICHAN END IF * IFAIL = 1 * CALL X04ADF(ICHAN,IFAIL) * INQUIRE (ICHAN,OPENED=OP) IF ((IFAIL.EQ.0) .AND. ( .NOT. OP)) THEN WRITE (NOUT,99997) ELSE WRITE (NOUT,99996) FNAME, ICHAN END IF * STOP * 99999 FORMAT (' ** FAILS to open "',A,'" and connect file to channel ', + I2) 99998 FORMAT (' OK file successfully opened for writing') 99997 FORMAT (' OK file successfully closed') 99996 FORMAT (' ** FAILS to close "',A,'" on channel ',I2) 99995 FORMAT (' ** FAILS to open "',A,'" for reading on channel ',I2) 99994 FORMAT (' OK file successfully opened for reading') END