*
* $Id: main.F,v 1.1.1.1 1996/03/08 15:21:46 mclareni Exp $
*
* $Log: main.F,v $
* Revision 1.1.1.1  1996/03/08 15:21:46  mclareni
* Epio
*
*
#if !defined(CERNLIB_ND100B16)
#include "pilot.h"
#if defined(CERNLIB_CDC)
      PROGRAM PTEST(OUTPUT,TAPE11,TAPE12,TAPE13)
#endif
#include "testc.inc"
#if defined(CERNLIB_APOLLO)
%INCLUDE '/sys/ins/base.ins.ftn'
%INCLUDE '/sys/ins/error.ins.ftn'
%INCLUDE '/sys/ins/streams.ins.ftn'
      INTEGER*4 STATUS_$RETURNED
      INTEGER*2 ATT_$REC(39)
      CHARACTER*10 FILNAM
      DATA FILNAM/'FOR011.DAT'/
      DATA (ATT_$REC(J),J=35,39)/'FO','R0','11','.D','AT'/
      DATA ATT_$REC(2)/10/
#endif
C--- RESET DEBUG FLAG
      DBUGFL=.FALSE.
C--- NWOUT = NO. OF WORDS / RECORD
      NWOUT=500
C--- NREC = NO. OF IDENTICAL RECORDS WRITTEN EACH TIME
      NREC=3
      NH=9
      PRINT 2001
      CALL EPINIT
#if defined(CERNLIB_PH32BIT)
      NWPR1=1024
      NWPR2=1768
      NWPR3=1774
      NWPR4=883
      CALL EPSETW(11,29,1,IERR)
#endif
#if !defined(CERNLIB_PH32BIT)
      NWPR1=1036
      NWPR2=1780
      NWPR3=1786
      NWPR4=889
#endif
#if defined(CERNLIB_IBM)
      CALL VMCMS(
     -'FILEDEF IOFILE11 DISK EPIOT1 DATA A (RECFM U BLOCK 3600',IVMERR)
      CALL VMCMS(
     -'FILEDEF IOFILE12 DISK EPIOT2 DATA A (RECFM U BLOCK 3600',IVMERR)
      CALL VMCMS(
     -'FILEDEF IOFILE13 DISK EPIOT3 DATA A (RECFM U BLOCK 3600',IVMERR)
#endif
C--- TEST L.R.H. SPLITTING IN SOME DETAIL
      CALL SPLIT1
      PRINT 2002
#if defined(CERNLIB_IBM)
      CALL VMCMS('ERASE EPIOT1 DATA A',IVMERR)
#endif
#if defined(CERNLIB_MAKEXT11)||defined(CERNLIB_READXT11)
      IF(.TRUE.)  GOTO 200
#endif
#if defined(CERNLIB_VAXMAG)
      CLOSE (11)
#endif
#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
C
C     FOR THE APOLLO THE STORY IS DIFFERENT. WE NEED TO CLOSE
C     THE STREAM ASSOCIATED WITH 'FOR011', AND THEN TO DELETE
C     THE FILE.
C
      CALL STREAM_$INQUIRE(
     1      STREAM_$IRM_STRID,
     2       STREAM_$NAME_UNCONDITIONAL,
     3        ATT_$REC,
     4         ERROR_$MASK,
     6          STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE FILE IS THERE
C
      CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE STREAM HAS BEEN CLOSED
C
      CALL NAME_$DELETE_FILE(FILNAM,INT2(10),STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE FILE HAS BEEN DELETED
C
#endif
#if (!defined(CERNLIB_VAXLONG))&&(!defined(CERNLIB_STRA))&&(!defined(CERNLIB_UNIX))
C--- WRITE WRONG BLOCK, REWIND + TEST
      CALL TEST1
      PRINT 2003
#endif
#if defined(CERNLIB_IBM)
      CALL VMCMS('ERASE EPIOT1 DATA A',IVMERR)
#endif
#if (defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_APOMAG))
C
C     FOR THE APOLLO THE STORY IS DIFFERENT. WE NEED TO CLOSE
C     THE STREAM ASSOCIATED WITH 'FOR011', AND THEN TO DELETE
C     THE FILE.
C
      CALL STREAM_$INQUIRE(
     1      STREAM_$IRM_STRID,
     2       STREAM_$NAME_UNCONDITIONAL,
     3        ATT_$REC,
     4         ERROR_$MASK,
     6          STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE FILE IS THERE
C
      CALL STREAM_$CLOSE(ATT_$REC,STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE STREAM HAS BEEN CLOSED
C
      CALL NAME_$DELETE_FILE(FILNAM,INT2(10),STATUS_$RETURNED)
      IF(STATUS_$RETURNED.NE.STATUS_$OK)
     1   CALL PFM_$SIGNAL(STATUS_$RETURNED)
C
C     THE FILE HAS BEEN DELETED
C
#endif
C--- DEFINE HEADER
      DO 1  I=1,NH
    1 IH(I)=100+I
C--- WRITE TEST DATA ONTO UNIT 11
      NPASS=1
#if defined(CERNLIB_PH32BIT)
      CALL EPSETW(11,29,1,IERR)
#endif
      CALL WR11
      PRINT 2004,NPASS
      NPASS=2
C--- SET NEW BLOCK SIZE
#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
      CALL EPSETW(11,1,1440,IERR)
      IF(IERR.NE.0)  CALL ERREX(1)
#endif
C--- WRITE AGAIN
      CALL WR11
      PRINT 2004,NPASS
C--- RESET BLOCK SIZE
#if (!defined(CERNLIB_STF77))&&(!defined(CERNLIB_STF77VX))
      CALL EPSETW(11,1,1800,IERR)
      IF(IERR.NE.0)  CALL ERREX(2)
#endif
      CALL EPRWND(11,IBUF11,IERR)
      IF(IERR.NE.0)  CALL ERREX(36)
C--- READ 11, WRITE 12 + 13
      CALL RWR123
      N=2*ICALL
      PRINT 2005,N
C--- REWIND ALL THREE, READ BACK AND CHECK WITH
C    HEADER BUFFER CUT, DATA BUFFER CUT, NORMAL BUFFER
      CALL TEST2
  200 CONTINUE
C--- TERMINATE
      PRINT 3001
      STOP
#if !defined(CERNLIB_CDC)
2001  FORMAT('1 ++++++++++ EPTEST3 - START OF EXECUTION ++++++++')
2002  FORMAT(/,' ROUTINE SPLIT1 SUCCESSFUL',//)
2003  FORMAT(/,' ROUTINE TEST1 SUCCESSFUL')
2004  FORMAT(/,' ROUTINE WR11 SUCCESSFUL, PASS =',I5)
2005  FORMAT(/,' ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =',I10,//)
3001  FORMAT(///,1X,10(10H++++++++++),//,
     1          '        EPTEST3 - NORMAL TERMINATION, ALL TESTS DONE',
     2   //,    1X,10(10H++++++++++),/////)
#endif
#if defined(CERNLIB_CDC)
2001  FORMAT("1 ++++++++++ EPTEST3 - START OF EXECUTION ++++++++")
2002  FORMAT(/," ROUTINE SPLIT1 SUCCESSFUL",//)
2003  FORMAT(/," ROUTINE TEST1 SUCCESSFUL")
2004  FORMAT(/," ROUTINE WR11 SUCCESSFUL, PASS =",I5)
2005  FORMAT(/," ROUTINE RWR123 SUCCESSFUL - NO. OF REC.S =",I10,//)
3001  FORMAT(///,1X,10(10H++++++++++),//,
     1          "        EPTEST3 - NORMAL TERMINATION, ALL TESTS DONE",
     2   //,    1X,10(10H++++++++++),/////)
#endif
      END
#endif