C This software FIVT.FOR is part of the Compaq Visual Fortran kit.
C
C This software is provided as an example that demonstrates a particular
C feature/function of the licensed product. The software is not intended to
C provide a complete solution to any application problem but rather is provided
C as a teaching mechanism.
C
C Users may incorporate any part of this sample into their own source after 
C making appropriate changes to make it suitable for the intended application.
C
C	Installation Verification Test for Compaq Visual Fortran V6.2
C
	OPTIONS/F77

	PROGRAM		FIVP
	CHARACTER	LINE*123
	CHARACTER*(*)	C_FMT_S, C_FMT_F
	INTEGER		I, IOS, LENGTH, POSITION
	REAL		A

C
C	Try a structure/record
C
	STRUCTURE	/STR/
		INTEGER*4	FLD
	END STRUCTURE
	RECORD	/STR/	REC

	PARAMETER
	1 (C_FMT_S = '(''     Compaq Visual Fortran '', A, '' IVT passed'')',
	2  C_FMT_F = '('' **** Compaq Fortran Test failed ****'')')

C	Just a simple DO loop
C
	LENGTH = 0
	DO I = 1, 10
	    LENGTH = LENGTH + I
	ENDDO

	REC.FLD = LENGTH

C	First test the RTL by trying to read a record from the input stream
C
	READ (5, 99, ERR=1) I, A
99	FORMAT(1X, I4, F6.2)

C	Now verify that what you have read is what you expected
C
	IF ( I**3 .NE. 64  .OR.  ABS(A - 3.14) .GT. 1.0E-6 ) GO TO 1
	IF (ABS( 1.0 - (COS(A)**2 + SIN(A)**2) )  .GT.  1.0E-6) GO TO 1

C	Now test that the new RTL is being used.
C
	IF ( ABS(SIND(90.0) - 1.0) .GT. 1.0E-6) GOTO 1

C	Now open the listing file and obtain the version number
C
	OPEN (UNIT=10, STATUS='OLD', NAME='FIVT.LST', ERR=1)

C	The version is found on the first line of the program listing
C
	READ (10, '(A)', IOSTAT=IOS) LINE
	CLOSE (UNIT=10, ERR=1)


C	Find the character position and length of the version number
C
	POSITION = INDEX(LINE, 'Compaq Visual Fortran ')
	LENGTH =   INDEX(LINE(POSITION+22:), ' ') - 1

C	Now check that everything is OK and print the appropriate message
C
	IF ( IOS .NE. 0  .OR.  POSITION .EQ. 0  .OR.  LENGTH .LT. 4 ) GO TO 101
	POSITION = POSITION + 22
	WRITE (6,C_FMT_S) LINE(POSITION:POSITION+LENGTH-1)

C	Successful installation, exit quietly
C
	CALL EXIT (0)


C	One of the above errors has occurred, write the failure message
C
101	type *, "Listing format has changed!"
1	WRITE (6,C_FMT_F)
	CALL EXIT (1)
	END
