C*****************************************************************************
C
C	             Data Transfer Function Test Controller (#2)
C
C-----------------------------------------------------------------------------
C
C Program	: Test Data Transfer/ TData2.For
C Author	: John Malcolmson
C Date		: July 1986
C Language	: Fortran 77
C Notes		: The program is chained to by the Libtst program.
C
C*****************************************************************************

	Program TData2

C--------------------------------- IMPORT -----------------------------------)
C
C	FROM DATAT IMPORT AS
C
		Integer*4	DtIFSdat, DtIWSdat
		Integer*4	DtISpfn,  DtICSpfn, DtIFSpfn, DtIWSpfn
		Integer*4	DtIWrite, DtICwrit, DtIFWrit, DtIWWrit
		Integer*4	DtJWrite, DtJCwrit, DtJFWrit, DtJWWrit
C
C	END IMPORT
C
C----------------------------------------------------------------------------)

		Integer*4	AStat(14)
		Character*6     Alabl(14)
		Integer*4	jsize
		Integer*2	dblk(4)

		Include 'SRC:Tbegin.for'
		IF (page) Call SetPage('Data Transfer2 Functions\',pnum )

c  Do the ISDATx tests

		Astat(01) = DtIfsdat()
		ALabl(01) = 'ISDATF'
		Astat(02) = DtIwsdat()
		ALabl(02) = 'ISDATW'

c  Do the ISPFNx tests

		Astat(03) = DtISpfn()
		ALabl(03) = 'ISPFN'
		Astat(04) = DtIcspfn()
		ALabl(04) = 'ISPFNC'
		Astat(05) = DtIfspfn()
		ALabl(05) = 'ISPFNF'
		Astat(06) = DtIwspfn()
		ALabl(06) = 'ISPFNW'

c  Do the IWRITx tests

		Astat(07) = DtIwrite()
		ALabl(07) = 'IWRITE'
		Astat(08) = DtIcwrit()
		ALabl(08) = 'IWRITC'
		Astat(09) = DtIfwrit()
		ALabl(09) = 'IWRITF'
		Astat(10) = DtIwwrit()
		ALabl(10) = 'IWRITW'

c  Do the JWRITx tests

c  Call JSETUP to determine the MSCP disk partition environment.
c  It puts a suitable DBLK and device size in common JSETCM so that
c  the test routines can use JGETDV (see DATAT.FOR).  
c
c  These tests are tight for space and heavily overlayed.  The call 
c  to JSETUP is here only to keep the space it uses (with IGTDUS) 
c  out of the test overlays.

		ichan = IGETC()
		i = JSETUP( ichan, dblk, jsize)
		call IFREEC( ichan)

		Astat(11) = DtJwrite()
		ALabl(11) = 'JWRITE'
		Astat(12) = DtJcwrit()
		ALabl(12) = 'JWRITC'
		Astat(13) = DtJfwrit()
		ALabl(13) = 'JWRITF'
		Astat(14) = DtJwwrit()
		ALabl(14) = 'JWRITW'

		Call CentLn(
	1 '===== Data Transfer2 Function Error Report Summary =====\' )
		Rprt = Report( Astat, Alabl, 14 )

		Call CentLn(
	1 '===== End of Data Transfer2 Function Report =====\' )
		Call WriteLn

		Call GetPage( Pnum )
		Call StsCon( Appnd, Page, Pnum, Param(-3) )
		param(ABS(param(0))) = param(ABS(param(0))) + rprt
		CALL IRAD50(12, 'BINLIBTSTSAV', Spec )
		Call CloseOutput

		IF (IIAND(Ispy('300'O),2**12) .ne. 2**12) THEN

C			VSpec = Spec
C			Call Irad50( 12, 'SY VBGCHNSAV', Spec )
C			Call Chain( Spec, param, 56 )
			Call Chain( Spec, param(-7), 52 )

		ELSE

			Call Chain( Spec, param(-7), 52 )

		END IF

 9999	CALL EXIT
	END