From: "LEE HIGBIE @SEO/23-6, DTN: 545-4225 11-Feb-1991 1527" <[email-masked]>

Include file:
INCLUDE 'VEC-PAR.INCL'

	PARAMETER (NPARHD=100,NPAR2=2,NPARM1=-1,NPARMN=1000000)

	COMMON /ONESH/ XS1(200),XS2(200),XS3(200)
	COMMON /DBL/ DS1(200),DS2(200),DS3(200)
	DOUBLE PRECISION DS1,DS2,DS3
	COMMON /CMPLX/ CS1(200),CS2(200),CS3(200)
	COMPLEX CS1,CS2,CS3
	COMMON /ONELN/ XL1(20 000 000),XL2(20 000 000),XL3(200 000)

	COMMON /TWO/ XP1(200,200), XP2(200,200),XP3(200,200)
	COMMON /TWO/ XPS1(8,8)
	COMMON /MANY/ T1(5,5,5),T2(5,5,5),F1(5,5,5,5),F2(5,5,5,5)
	COMMON /MANY/ FV1(5,5,5,5,5),FV2(5,5,5,5,5)

	COMMON /VARBLS/MV1,MV2,NV1,NV2,NV3,V1, V2, ISC1,M,N
	COMMON /INTGRS/ I1(200),I2(200),I3(200),I,J,K,L
	COMMON /LGCLS/ L1(200), L2(200),L3(200)
	LOGICAL L1,L2,L3
	INTEGER*2 IS1, IS2, IS3
	LOGICAL*1 LS1, LS2, LS3
	COMMON/BAD/LS1,LS2(17),LS3(13),IS1,IS2(17),IS3(13),XS4(100)
	CHARACTER*1 CH1(200),CH2(200)

Program:
	PROGRAM VECTST
C	********************************************

C	This program was written by Lee Higbie, 
C	Digital Equipment Corportation.

C	) Digital Equipment Corporation, 1990.

C	Each CDEC$ line should have an equivalent compiler
C	directive or assertion inserted for the compiler
C	under test.

C	CLH comment inserted before areas of non-standard Fortan
C	that may require commenting-out for some compilers
C	********************************************
C
	INCLUDE 'VEC-PAR.INCL/LIST'

C	The included declaratives listed above are inlcuded in 
C	all the test subroutines.  They are listed here for 
C	reference.

	DATA NV1,NV2,NV3 /100,1,-1/

C	Initialize all arrays, just in case

	DO 500 I=1,200
	XS1(I) = FLOAT(I)
	XS2(I) = FLOAT(I)+1.0
	XS3(I) = FLOAT(I-1)
	CS1(I) = FLOAT(I)*(1.0,1.0)
	CS2(I) = FLOAT(I)*(1.0,0.0)
	CS3(I) = FLOAT(I)*(0.0,1.0)
	DS1(I) = FLOAT(I)
	DS2(I) = FLOAT(I+1)
	DS3(I) = FLOAT(I-1)
	I1(I) = I
	I2(I) = I+1
	I3(I) = I-1
500	CONTINUE

	DO 610 I=1,200
	  DO 600 J=1,200
	  XP1(I,J) = FLOAT(I+J)
	  XP2(I,J) = FLOAT(I*J)
	  XP3(I,J) = FLOAT(I*J-1)
600	  CONTINUE
610	CONTINUE

	DO 700 I=1,2000000
	XL1(I) = FLOAT(I)
	XL2(I) = FLOAT(I+1)
	XL3(I) = FLOAT(I-1)
700	CONTINUE

C	About 250 VECTORIZATION TESTS:

	CALL SIMPLE
C 	45 simple vectorization tests.  Some of these are more
C	    tests of the target hardware than the compiler.

	CALL SUBSCR
C	50 subscript tests.

	CALL MLTILP
C	 8 tests that require rearranging the 
C	   structure of nests of loops

	CALL BRNCHG
C	36 tests involving branching

	CALL RCRSON
C	35 tests for carefulness of 
C	   ambiguity checking.

	CALL GLOBAL
C	28 tests that involve external 
C	   routines.  All vectorizable.

	CALL TSTDIR
C	 6 tests of compiler directives, diagnostics 
C	    and warnings.

	CALL MISC
C	18 tests that do not readily 
C  	   fit into earlier groups.

	CALL NDCODE
C	25 tests where the code generated 
C	   by the compiler may need to be
C	   checked to really determine 
C	   how well the compiler did.

	STOP
	END
	FUNCTION VCTFN(X,Y)
	VCTFN = X**2 + Y**2
	RETURN
	END
	SUBROUTINE VCTSUB(X,Y,Z)
	X = X**2 + Y**2 + Z**2
	RETURN
	END
	SUBROUTINE SETNV(I1)
C	To check for multi-routine compilation.  Sets argument to
C	    a positive cnst.
	I1 = 2
	RETURN
	END
	SUBROUTINE NOSET
C	To check for multi-routine compilation.  Doesn't change NV2
	COMMON /ONELN/ XL1(2000000),XL2(2000000),XL3(2000000)
	COMMON /VARBLS/MV1,MV2,NV1,NV2,NV3,V1, V2, ISC1,M,N
	PARAMETER (NPARHD=100,NPAR2=2,NPARM1=-1,NPARMN=1000000)
	NV3 = 2
	RETURN
	END
	SUBROUTINE MAYSET
C	To check for multi-routine compilation.  Scalar vars are 
C	    unknown after CALL to this routine
	COMMON /ONELN/ XL1(2000000),XL2(2000000),XL3(2000000)
	COMMON /VARBLS/MV1,MV2,NV1,NV2,NV3,V1, V2, ISC1,M,N
	PARAMETER (NPARHD=100,NPAR2=2,NPARM1=-1,NPARMN=1000000)
	READ *,MV1,MV2,NV1,NV2,NV3,M,N
	RETURN
	END
	SUBROUTINE VCTSB2(X,Y,Z,M,N)
	DIMENSION X(N),Y(N),Z(N)
C	Checks to see if M=2 is known to subroutine or if code is
C	    moved to CALLer and expanded in-line.
	DO 100 I=1,N-3
	   X(I) = X(I+M)*Y(I) + Z(I)
100	CONTINUE
	RETURN
	END
	SUBROUTINE VCTSB3(X,Y,Z,M,N)
	DIMENSION X(N),Y(N),Z(N)
C	TBS:  to be supplied?????
	DO 100 I=1,N-3
	   X(I) = X(I+M)*Y(I) + Z(I)
100	CONTINUE
	RETURN
	END

	SUBROUTINE SIMPLE
	INCLUDE 'VEC-PAR.INCL'

C 	45 simple vectorization tests.  Some of these are more
C	    tests of the target hardware than the compiler.

	DO 100 I=1,NPARHD
	 XS1(I) = XS2(I) + XS3(I)
100 	CONTINUE

C	Two tests for length (loop trip count restrictions) restrictions
	DO 200 I=1,N
	 XS1(I) = XS2(I) + XS3(I)
200 	CONTINUE

	DO 300 I=1,200 000
	 XL1(I) = XL2(I) + XL3(I)
300 	CONTINUE

	DO 400 I=1,20 000 000
	 XL1(I) = XL2(I)
400	CONTINUE

	DO 500 I=1,100 000 000
	 XL1(I) = XL2(I)*2
500	CONTINUE

C	Test for limits on stride
	DO 600 I=1,30, 1000
	 XL1(I) = XL2(I)+1
600	CONTINUE

	DO 700 I=1,30, 1000 000
	 XL1(I) = XL2(I)+1
700	CONTINUE

	DO 800 I=1,30, 10 000 000
	 XL2(I) = XL1(I)*3.3
800	CONTINUE

C	Vectorize integer and Boolean loops?
	DO 1000 I=1,NPARHD
	 I1(I) = I2(I) + I3(I)
1000 	CONTINUE

CLH	Following loop is non-standard Fortran
	DO 1100 I=1,NPARHD
	 L1(I) = L2(I) .OR. L3(I)
1100 	CONTINUE

C	Logical above, double precision below, then complex
	DO 1200 I=1,NPARHD
	 DS1(I) = DS2(I) + DS3(I)
1200 	CONTINUE

	DO 1300 I=1,NPARHD
	 CS1(I) = CS2(I) + CS3(I)
1300 	CONTINUE

C	Vectorize short integer and short Boolean loops?
	DO 1400 I=1,N
	 IS2(I) = IS2(I) + IS3(I)
1400 	CONTINUE

CLH	Following loop is non-standard Fortran
	DO 1500 I=1,N
	 LS2(I) = LS2(I) .OR. LS3(I)
1500 	CONTINUE

C	Mixed single and double
	DO 2000 I=1,NPARHD
	 DS1(I) = (DS2(I) + DS3(I))*XS1(I)
2000 	CONTINUE

C	Mixed single real and complex 
	DO 2100 I=1,NPARHD
	 CS1(I) = (CS2(I) + CS3(I))*XS1(I)
2100 	CONTINUE

	DO 2200 I=1,NPARHD
	 XS1(I) = XS2(I)*XS3(I)
	 CS1(I) = (CS2(I) + CS3(I))*XS1(I)
2200 	CONTINUE

	DO 2300 I=1,NPARHD
	 XS1(I) = XS2(I)*XS3(I)
	 DS1(I) = DS2(I) + DS3(I)
	 CS1(I) = (CS2(I) + CS3(I))*XS1(I)
2300 	CONTINUE

	DO 2400 I=1,NPARHD
	 XS1(I) = XS2(I)*XS3(I)
	 DS1(I) = DS2(I) + DS3(I)
	 CS1(I) = (CS2(I) + CS3(I))*XS1(I)
	 L1(I) = L2(I) .AND. L3(I)
2400 	CONTINUE
	
	DO 2500 I=1,NPARHD
	 XS1(I) = XS2(I)*XS3(I)
	 DS1(I) = DS2(I) + DS3(I)
	 CS1(I) = (CS2(I) + CS3(I))*XS1(I)
	 L1(I) = L2(I) .AND. L3(I)
	 I1(I) = I2(I) * I3(I) 
2500 	CONTINUE

C	Three tests that see if character data bothers vectorization
	DO 2600 I=1,N
	 CH1(I) = CH2(I) 
2600 	CONTINUE

	DO 2700 I=1,N
	 CH1(I) = CH2(I+11) 
2700 	CONTINUE

	DO 2800 I=1,N
	 L1(I) = CH1(I) .EQ. CH2(I) 
2800 	CONTINUE

C 	Tests using short control vairables.
	DO 3000 I=1,IS1
	 XS1(I) = XS2(I) + XS3(I)
3000 	CONTINUE

	DO 3100 IS1=1,NPARHD
	 XS1(IS1) = XS2(IS1) + XS3(IS1)
3100 	CONTINUE

	DO 3200 I=IS2(N),I2(M)
	 XS1(I) = XS2(I) + XS3(I)
3200 	CONTINUE

C	Loops to see where vectorization begins.
C	Test to see where vectorization begins  ONE TEST
C	Test is passed as long as some vectorize and some don't.
	DO 3310 I=1,1
	 XS1(I) = XS2(I) + XS3(I)	
3310	CONTINUE
	DO 3320 I=1,2
	 XS1(I) = XS2(I) + XS3(I)	
3320	CONTINUE
	DO 3330 I=1,3
	 XS1(I) = XS2(I) + XS3(I)	
3330	CONTINUE
	DO 3340 I=1,4
	 XS1(I) = XS2(I) + XS3(I)	
3340	CONTINUE
	DO 3350 I=1,5
	 XS1(I) = XS2(I) + XS3(I)	
3350	CONTINUE
	DO 3360 I=1,6
	 XS1(I) = XS2(I) + XS3(I)	
3360	CONTINUE
	DO 3370 I=1,7
	 XS1(I) = XS2(I) + XS3(I)	
3370	CONTINUE
	DO 3380 I=1,8
	 XS1(I) = XS2(I) + XS3(I)	
3380	CONTINUE
	DO 3390 I=1,9
	 XS1(I) = XS2(I) + XS3(I)	
3390	CONTINUE
C	End of length measure.	    END OF ONE TEST

	CALL MAYSET
C	Loops to see where vectorization begins with ambiguity.
C	Test to see where vectorization begins  ONE TEST.
C	Test is failed if vectorization is same as in test 3300
C	     above or if conditional vectorization is not done.
	DO 3410 I=1,2
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3410	CONTINUE
	DO 3420 I=1,3
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3420	CONTINUE
	DO 3430 I=1,4
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3430	CONTINUE
	DO 3440 I=1,5
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3440	CONTINUE
	DO 3450 I=1,6
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3450	CONTINUE
	DO 3460 I=1,7
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3460	CONTINUE
	DO 3470 I=1,8
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3470	CONTINUE
	DO 3480 I=1,9
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3480	CONTINUE
	DO 3490 I=1,10
	 XS1(I) = XS2(I+NV2) + XS3(I)	
3490	CONTINUE
C	End of length measure.	    END OF ONE TEST

C	Should not vectorize next four loops,  too short.        
	N=2
	DO 4000 I=1,N
	 XS1(I) = XS2(I) + XS3(I)	
4000	CONTINUE

	DO 4100 I=1,N
	 XS1(I) = XS2(I) + XS3(I)	
4100	CONTINUE

CDEC$	  ASSERT(M.LE.2)
	DO 4200 I=1,M
	 XS1(I) = XS2(I) + XS3(I)	
4200	CONTINUE

	DO 4300 I=1,M
	 XS1(I) = XS2(I) + XS3(I)	
4300	CONTINUE

C	Tests where loop indices are not as obvious as in a simple loop
	K = 0
	DO 5000 I=1,NPARHD
	 K = K + 2
	 XS1(I) = XS2(K) + XS3(I)	
5000	CONTINUE

	DO 5100 I=1,NPARHD
	 K = K - 2
	 XS1(I) = XS2(K) + XS3(I)	
5100	CONTINUE

	K = 0
	DO 5200 I=1,NPARHD
	 K = K + NV1
	 XS1(I) = XS2(K) + XS3(I)	
5200	CONTINUE

	DO 5300 I=1,MIN(ALOG(FLOAT(N)), FLOAT(NPARHD))
	 XS1(I) = XS2(I) + XS3(I)
5300	CONTINUE

C	Check for usability of mixture of index types
	IS1 = NV1
	DO 5400 I=1,100
	    IS1 = IS1+1
	    XS1(I) = XS2(IS1) + XS3(I)
5400 	CONTINUE

C	Check for usability of mixture of index types and strides
	IS1 = NV1
	DO 5500 I=1,100
	    IS1 = IS1+NV2
	    XS1(I) = XS2(IS1) + XS3(I)
5500 	CONTINUE

C	Check for vectorization of scalar-appearing temporary vars
C	Tests with scalar temporaries that should be
C	   promoted to vectors
	DO 6000 I=1,NPARHD
	 V1 = XS1(I)**2 + XS2(I)**2
	 XL1(I) = V1
	 XL2(I) = 1.0/V1
6000	CONTINUE

	CALL MAYSET
	DO 6100 I=2,NPARHD
	    V1 = XS2(I)*XS3(I)
	    V2 = XS2(I-1) * XS3(I-1)
	    XS1(I) = (V1+V2)*(V1-V2)
6100	CONTINUE

	CALL MAYSET
	V2 = XS2(1)*XS3(1)
	DO 6200 I=2,NPARHD
	    V1 = XS2(I)*XS3(I)
	    XS1(I) = (V1+V2)*(V1-V2)
	    V2 = XS2(I) * XS3(I)
6200	CONTINUE

	CALL MAYSET
	V1 = XS2(1)*XS3(1)
	V2 = XS2(1)*XS3(1)
	DO 6300 I=2,NPARHD
	    XS1(I) = (V1+V2)*(V1-V2)
	    V1 = XS2(I) + XS3(I)
	    V2 = XS2(I) * XS3(I) * V1
6300	CONTINUE

C	Can scalar temps be reused?
	CALL MAYSET
	DO 6400 I=2,NPARHD
	    V1 = XS2(1)*XS3(1)
	    V2 = XS2(1)*XS3(1)
	    XS1(I) = (V1+V2)*(V1-V2)
	    V1 = XS2(I) + XS3(I)
	    V2 = XS2(I) * XS3(I) * V1
	    XP1(I,NPAR2) = V1*V2
	    V1 = XS2(I)**2
	    V2 = XS3(I)**2
6400	CONTINUE

C	Can lots of scalar temps be used?
	CALL MAYSET
	V1 = XS2(1)*XS3(1)
	V2 = XS2(1)*XS3(1)
	DO 6500 I=2,NPARHD
	    XS1(I) = (V1+V2)*(V1-V2)
	    V3 = XS2(I) + XS3(I)
	    V4 = XS2(I) * XS3(I) * V1
	    V5 = XS3(I) + V3*V4
	    V6 = XS2(I)*XP2(I,NPAR2)
	    V7 = V6*V5+V3
	    V8 = V7-V6
	    V9 = V8**2
	    XP1(I,NPAR2) = V1*V2+V3*V4 * V9
	    V1 = XS2(I)**2
	    V2 = XS3(I)**2
6500	CONTINUE

C	Will swap vectorize?
	CALL MAYSET
	DO 6600 I=1,N
	 V1 = XS1(I)
	 XS1(I) = XS2(I)
	 XS2(I) = V1
6600	CONTINUE

	RETURN
	END

	SUBROUTINE SUBSCR
	INCLUDE 'VEC-PAR.INCL'

C	50 subscript tests.

	DO 100 I=1,NPARHD
	 XS1(I) = XS2(I+1)+XS3(I-3)
100	CONTINUE

	DO 200 I=1,NPARHD
	 XS1(I*2) = XS2(2*I+1)+XS3(3*I-3)
200	CONTINUE
	
	DO 300 I=1,NPARHD,NPAR2
	 XS1(I) = XS2(I+1)+XS3(I-3)
300	CONTINUE

	DO 400 I=1,NPARHD,NPAR2
	 XS1(I*2) = XS2(2*I+1)+XS3(3*I-3)
400	CONTINUE
	
	DO 500 I=1,NPARHD,NPAR2
	 XS1(I*NV1) = XS2(2*I+1)+XS3(3*I-3)
500	CONTINUE

C	Next loop includes a gather
	DO 600 I=1,NPARHD,NPAR2
	 XS1(I) = XS2(I1(I)+1)+XS3(3*I-3)
600	CONTINUE

C 	See if it can vectorize loop indexes (iota fns)
	DO 700 I=1,NPARHD,NPAR2
	 XS1(I) = I
700	CONTINUE

	DO 800 I=1,NPARHD,NPAR2
	 XS1(I) = FLOAT(I)*3.141590
800	CONTINUE

	DO 900 I=1,N
	  XS1(I) = I*(I-1)+1
900	CONTINUE

	DO 1100 I=1,NPARHD,NPAR2
	  XP1(I,I) = 1.1
1100	  CONTINUE

	DO 1210 I=1,NPARHD,NPAR2
	  DO 1200 J=1, I
	  XP1(NPARHD-I+1,J) = 1.144 * XP2(I+J, I-J)
1200	  CONTINUE
1210	CONTINUE

C	K Subscript is not linear, gather required
	K=1
	DO 1300 I=1,N
	 K = K * 2
	 XS1(I) = XL2(K) + XS3(I)	
1300	CONTINUE

C	Tests to see how complicated the subscript can be
	DO 2100 I=1,NPARHD
	 XS1(I*3+13) = XS2(I*2+1)+XS3(3*I-3)
2100	CONTINUE

	DO 2200 I=1,NPARHD,NPAR2
	 XS1(I*3+13*NV1+NV2) = XS2(I*2*NV2+(NV3+NPAR2)*I+1)+XS3(3*I-3)
2200	CONTINUE

	DO 2300 I=1,NPARHD
	 MV2 = NV3*N+NPARHD-NPAR2*J
	 MV3 = NV3*N+NPARM1+NPAR2*J
	 XS1(I*3+13*NV1+NV2) = XS2(I*2*MV2+(NV3+NPAR2)*I+1)+XS3(3*I-3)
	 XS1(I*3+13*NV1+MV3) = XS2(I*2*NV2+(NV3+NPAR2)*I+1)+XS3(3*I-3)
2300	CONTINUE

C	Tests for various subscript generation techniques
	CALL MAYSET
	DO 2400 I=1, NPARHD
	    NV1 = NV1+1
	    MV1 = MV1-1
	    XS1(I) = XS2(NV1)*XS3(MV1)
2400	CONTINUE

	CALL MAYSET
	DO 2500 I=1, NPARHD
	    NV1 = NV1+1
	    MV1 = MV1-1
	    XS1(I) = XS2(NV1)*XS3(MV1)
2500	CONTINUE

	CALL MAYSET
	DO 2600 I=1, NPARHD
	    NV1 = NV1+1
	    MV1 = MV1-IS1
	    XS1(I) = XS2(NV1)*XS3(MV1)
2600	CONTINUE

	CALL MAYSET
	DO 2700 I=1, NPARHD
	    NV1 = NV1+1
	    MV1 = I+NV1-1
	    XS1(I) = XS2(NV1)*XS3(MV1)
2700	CONTINUE

C	Test for interlacing of assignments
	DO 3000 I=2,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I-1) = XS2(I)*XS3(I) + XS3(I-1)
3000	CONTINUE

	DO 3100 I=2,NPARHD
	  XS1(I) = XS1(I)*XS2(I-1) + XS3(I)
	  XS2(I) = XS2(I)*XS3(I) + XS3(I-1)
3100	CONTINUE

C	Lower triangular system 
	DO 3200 I=1,N
	   DO 3200 J=1,I-1
	      DO 3200 K = J+1,N
	        XP1(K,I) = XP1(K,I) + XP1(K,J)*XP1(J,I)
3200	CONTINUE

C	Another test for interlacing of assignments
	DO 3300 I=2,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I) = XS2(I)*XS3(I) + XS1(I+1)
3300	CONTINUE

C	Gather required because of I*I subscript in next loop
	DO 3400 I=1,NPARHD,NPAR2
	 XS1(I*I) = XS2(I*2+1)+XS3(3*I-3)
3400	CONTINUE

C	Test to see if strides are accounted for.
	DO 3500 I=2,NPARHD,2
	  XS1(I) = XS1(I-1)*XS2(I) + XS3(I)
3500	CONTINUE

	DO 3600 I=3,NPARHD,3
	  XS1(I) = XS1(I-1)*XS2(I) + XS1(I-2)*XS3(I)
3600	CONTINUE

	DO 3700 I=NPARHD,2,-2
	  XS1(I) = XS1(I-1)*XS2(I) + XS3(I)
3700	CONTINUE

C	Checks for knowledge of variable value in stride
	NV2 = -3
	DO 3800 I=NPARHD,3,NV2
	  XS1(I) = XS1(I-1)*XS2(I) + XS1(I-2)*XS3(I)
	  XL1(I+1) = XL1(I-1)*XS2(I) + XL1(I)*XS3(I)
3800	CONTINUE

C	Next is one where the stride is larger than the length of the
C	  vector registers so recursion does not preclude vectorization.
	DO 3900 I=2,NPARHD
	  XL1(I+550) = XL1(I)*XS2(I) + XL1(I-1)*XS3(I)
3900	CONTINUE

C	Test where vectorization should not be done or where various
C	special tricks are required to assure correctness
C	Cannot safely vectorize--may have recursion;
C	    directives required to tell compiler there is no 
C	    overlap in input and output index vectors.   See 
C	    loop 4600 below and loop 2100 in RCRSON 
C	    for vectorizing versions.

C	Test passes if loop is NOT vectorized.
	DO 4000  I=1, NPARHD
	  XS1(I1(I)) = XS1(I2(I))*XS3(I)
4000	CONTINUE

C	Cannot safely vectorize because offset is unknown.  Test 
C	    passed if conditional vectorization used.
	CALL MAYSET
	DO 4100 I=1,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I+NV2) = XS2(I)*XS3(I) + XS3(I-1)
4100	CONTINUE

C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
	DO 4200 I=1,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I+NV2) = XS2(I)*XS3(I) + XS3(I-1)
4200	CONTINUE

CDEC$	  ASSERT(NV2 .GT. 0)
C			    ====>  NOT vectorizable
C	    Test passed if ASSERT statement available in dialect
C	    and works.
	DO 4300 I=1,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I+NV2) = XS2(I)*XS3(I) + XS3(I-1)
4300	CONTINUE

C			    Next one is vectorizable
	DO 4400 I=2,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I-NV2) = XS2(I)*XS3(I) + XS3(I-1)
4400	CONTINUE

C	Will it be broken into several loops?
	CALL MAYSET
	DO 4500 I=1,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I) = XS2(I+NV2)*XS3(I) + XS3(I-1)
4500	CONTINUE

	DO 4600  I=1, NPARHD
	  XS1(I2(I)) = XS1(I2(I))*XS3(I)
4600	CONTINUE

C	Test to see if a loop is reordered
	DO 5000 I=2,NPARHD
	  XS1(I) = XS1(I)*XS2(I-1) + XS3(I)
	  XS2(I) = XS2(I+1)*XS3(I) + XS3(I-1)
5000	CONTINUE

C	Test to see if a loop is separated into vector and scalar loops.
	DO 5100 I=2,NPARHD
	  XS1(I) = XS1(I) + XS3(I)
	  XS2(I) = XS2(I-1)*XS3(I) + XS3(I-1)
	  XS3(I) = XS3(I)**2
5100	CONTINUE

C	Tougher test for separating vector and scalar portions
	DO 5200 I=2,NPARHD
	   XS1(I-1) = XS2(I-1)*V1
	   XS3(I-1) = XS1(I-1)*V2
	   XL1(I) = XS3(I-1) + XP1(I,NPAR2)
	   XS2(I) = XL2(I+1) + XL2(I-1)
	   XL2(I) = XL3(I) + V1
	   XL3(I+1) = XL2(I) *V1*V2
5200	CONTINUE

C	Another type of vector/scalar loop separation test.
C	    All but first term can be done in vector mode.
	DO 5300 I=2,NPARHD
	    XS1(I) = XS1(I-1)*XS2(I) + XL1(I)**3+(XS2(I)+XL2(I))*
     +	      (XS3(I)+XL2(I)) + (XS2(I)+XL2(I))**2
5300	CONTINUE

C	Test for subscripts extracted from floating point variables
C	   Floating ==> integer conversion required ==> gather req'd
	DO 5400 I=1,NPARHD
	  J = XS3(I)*XS2(I) + XS3(I)
	  XS1(I+NV2) = XS2(I)*XS3(J) + XS3(I-1)
5400	CONTINUE

C	Like 5200 loop but scatter required
	DO 5500 I=1,NPARHD
	  J = XL1(I)*XS2(I) + XS3(I)
	  XS1(J+NV2) = XS2(I)*XS3(J) + XS3(I-1)
5500	CONTINUE

C	Like 5400 loop:  gather required
	DO 5600 I=1,NPARHD,2
	  XS1(I+NV2) = XS2(1+I/3)*XS3(J) + XS3(I-1)
5600	CONTINUE

C	Tests on many dimensional arrays
	DO 6000 I=1,N
	 T1(I,J,K) = T2(I,J,K)*F1(K,J,I,M)
6000	CONTINUE

	DO 6100 I=1,N
	 T1(I,J,I) = T2(I,I,K)*F1(I,J,M,I)
6100	CONTINUE

	DO 6200 I=1,N
	 K=N-I
	 J= J+1
	 T1(I,J,I) = T2(I,I,K)*F1(I,J,M,I)
6200	CONTINUE
	
	DO 6300 I=1,N
	 K=N-I
	 J= J+1
	 T1(I,J,I) = T2(I,I,K)*F1(I,J,M,I)+ FV1(I,NP2,J,K,I)*
     +      FV2(I,I,I,J,K)
6300	CONTINUE

	DO 6400 I=1,IS2(1)
	  DO 6400 J=1,IS2(2)
	    DO 6400 K=1,IS2(3)
	      T1(I,J,K) = T2(I,J,K)**3
	      DO 6400 L=1,IS2(4)
		F1(I,J,K,L) = (F2(I,J,K,L)/T1(I,J,K))**2
		DO 6400 M=1,IS2(5)
		  FV1(I,J,K,L,M)=FV2(I,J,K,L,M)**2-2.0
6400	CONTINUE

CDEC$ 	  ASSERT(MV1.NE.MV2)
	DO 6500 I=2, NPARHD
	    XP1(MV1,I) = XP1(MV2,I-1)*XS1(I) + XP2(MV2,I-1)*XS2(I)
	    XP2(MV1,I) = XP2(MV2,I-1)*XS1(I) + XP1(MV2,I-1)*XS2(I)
6500	CONTINUE

	CALL MAYSET
	MV1 = 1
	MV2 = 2
	DO 6600 I=2, NPARHD
	    XP1(MV1,I) = XP1(MV2,I-1)*XS1(I) + XP2(MV2,I-1)*XS2(I)
	    XP2(MV1,I) = XP2(MV2,I-1)*XS1(I) + XP1(MV2,I-1)*XS2(I)
6600	CONTINUE

	RETURN
	END

	SUBROUTINE MLTILP
	INCLUDE 'VEC-PAR.INCL'

	DIMENSION ZA(2,200), ZB(200,2)

C	8 tests involving loop decomposition and reordering

C	Tests to see if first half and second half of loop are 
C	    separately vectorized.
	DO 100 I=1,NPARHD
	    XS1(I) = XS1(NPARHD-I+1)
100	CONTINUE

	DO 200 I=1,NPARHD
	    XS1(I) = XS1(NPARHD-I+1)*V1 +XS2(I)
200	CONTINUE

	CALL MAYSET
CDEC$	ASSERT(NV2.GT.0)  
	DO 310 J=1,N
	    DO 300 I=1,NPARHD
		XP1(I,J) = XP1(I+NV2, N-J+1)
300	    CONTINUE
310	CONTINUE

C	Loop interchanging is needed for the next ones
	DO 1010 J=1,N
	    DO 1000 I=2,NPARHD
		XP1(I,J) = XP1(I-1, J)*XP2(I,J)
1000	    CONTINUE
1010	CONTINUE

	DO 1120 J=2,N
	    DO 1100 I=2,NPARHD
		XP1(I,J) = XP1(I-1,J)*XP2(I,J)
1100	    CONTINUE
	    DO 1110 I=2,NPARHD
		XP1(I,J) = XP1(I,J-1)*XP2(I,J)
1110	    CONTINUE
1120	CONTINUE

C 	Wavefront can move diagonally across grid here.  In other 
C	    words, logically replace the next two DOs with a single
C	    two-dimensional DO sweeping the 2-D grid from corner to
C	    corner.
	CALL MAYSET
	DO 2010 J=2,NPARHD
	    DO 2000 I=2,NPARHD
		XP1(I,J)=(XP1(I-1,J)+XP1(I,J-1))*V2+XP1(I,J)
2000	    CONTINUE
2010	CONTINUE

C	Does dimension info carry forward to loop ordering code?
C	    Following two passed, if loop order interchanged.
	CALL MAYSET
	DO 3000 I=1,M
	  DO 3000 J=1,N
	    ZA(J,I) = SQRT(XP1(I,J))
3000	CONTINUE

	DO 3100 I=1,M
	  DO 3100 J=1,N
	    ZB(I,J) = SQRT(XP1(I,J))
3100	CONTINUE

	RETURN
	END

	SUBROUTINE BRNCHG
	INCLUDE 'VEC-PAR.INCL'

C	36 tests involving branching

	DO 100 I=1,N
	 XS1(I) = XS2(I)
	 IF (XS2(I) .EQ. 0.0) XS1(I) = XS3(I)
100	CONTINUE

	DO 200 I=1,N
	 IF (XS2(I) .LT. 0.0) XS1(I) = XS2(I)**2
	 IF (XS2(I) .GE. 0.0) XS1(I) = XS3(I)
200	CONTINUE

	DO 300 I=1,N
	 IF (XS2(I) .LT. 0.0) XS1(I) = XS2(I)**2
	 IF (XS2(I) .GE. 0.0) XS1(I) = XS3(I)
	 IF (XS2(I) .GE. 1.0) XS1(I) = XS3(I)**3
300	CONTINUE

C	Probably shouldn't vectorize the next one, faster in scalar
	DO 400 I=1,N
	 IF (XS2(I) .LE. -2.0) XS1(I) = (XS2(I)- XS3(I))**2
	 IF (XS2(I) .LT. 0.0) XS1(I) = XS2(I)**2
	 IF (XS2(I) .GE. 0.0) XS1(I) = XS3(I)
	 IF (XS2(I) .GE. 1.0) XS1(I) = XS3(I)**3
	 IF (XS2(I) .GE. 2.0) XS1(I) = (XS2(I)+ XS3(I))**2
	 IF (XS2(I) .GE. 3.0) XS1(I) = EXP(XL1(I))
	 IF (XS2(I) .GE. 4.0) XS1(I) = XL3(I)**3
	 IF (XS2(I) .GE. 5.0) XS1(I) = (XL2(I)+ XL3(I))**2
400	CONTINUE

	DO 500 I=1,N
	 XS1(I) = EXP(XS2(I))
500	CONTINUE

	DO 600 I=1,N
	 XS1(I) = ATAN(XS2(I))
600	CONTINUE

	DO 700 I=1,N
	 XS1(I) = ATAN2(XS2(I),XS3(I))
700	CONTINUE

	DO 800 I=1,N
	 XS1(I) = ATAN2(XS2(I),V2)
800	CONTINUE

	DO 900 I=1,N
	 XS1(I) = XS2(I)**2+XS3(I)
	 IF(I .EQ. 1) THEN 
	   XS1(I) = 0.0
	   ELSE IF(I .EQ. N) THEN 
	      XS1(I) = 1.0
	   ELSE IF(XS3(I).GT.1.E22) THEN 
	       XS1(I) = 1.E22
	   ENDIF
900	CONTINUE

C	Various branching constructs 
	DO 1000 I=1,NPARHD
	  IF(L1(I)) THEN
	    XS1(I) = XS2(I)**2
	  ELSE
	    XS1(I) = XS3(I)**2
	  ENDIF
1000	CONTINUE

	DO 1100 I=1,NPARHD
	  IF(L1(I)) THEN
	    XS1(I) = XS2(I)**2
	  ELSE
	    XL1(I) = XS3(I)**2
	  ENDIF
1100	CONTINUE

	DO 1200 I=1,NPARHD
	  V1 = XS2(I)**2 + XS3(I)**2
	  IF(V1 .NE. 0) THEN
	    XS1(I) = XS2(I)**2
	  ELSE
	    XS1(I) = XS3(I)**2
	  ENDIF
1200	CONTINUE

	DO 1300 I=1,NPARHD
	  V1 = XS2(I)**2 + XS3(I)**2
	  IF(V1 .NE. 0) THEN
	    XS1(I) = V1
	  ELSE
	    XS1(I) = XS3(I)**2
	  ENDIF
1300	CONTINUE
	DO 1400 I=1,NPARHD
	  V1 = XS2(I)**2 + XS3(I)**2
	  IF(V1 .NE. 0) THEN
	    XS1(I) = SQRT(V1)
	  ELSE
	    XS1(I) = XS3(I)**2
	  ENDIF
1400	CONTINUE

C	IF test in next loops implies gather, scatter, compress or
C	    expand required
	J=1
	DO 1500 I=1,NPARHD
	  IF(L1(I)) THEN
	    XS1(I) = XS2(J)**2
	    J=J+1
	  ENDIF
1500	CONTINUE

	J=0
	DO 1600 I=1,NPARHD
	  J=J+1
	  IF(L1(I)) THEN
	    XS1(I) = XS2(J)**2
	    J=J+1
	  ENDIF
1600	CONTINUE

	J=0
C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
	DO 1700 I=1,NPARHD
	  J=J+1
	  IF(L1(I)) THEN
	    XS1(I) = XS2(J)**2
	    J=J+I1(I)
	  ENDIF
1700	CONTINUE

C	Unusual loops like those from some schrelecht programs
	DO 2000 I=MAX(J,K),N
	  XP1(I,K) =  XP1(I,K) + XP2(J,I)*XP2(I,K)
2000	CONTINUE

	DO 2150 I=1,N
	  IF (XS1(I)) 2100,2110,2120
2100	   CONTINUE
	     XL1(I) = XS1(I)**2
	     GOTO 2150
2110	   CONTINUE
	     XL1(I) = XS2(I)**2
	     GOTO 2150
2120	   CONTINUE
	     XL1(I) = XS3(I)**2
2150	CONTINUE

	DO 2250 I=1,N
	   GOTO(2200,2210,2220) I1(I)
2200	   CONTINUE
	     XL1(I) = XS1(I)**2
	     GOTO 2250
2210	   CONTINUE
	     XL1(I) = XS2(I)**2
	     GOTO 2250
2220	   CONTINUE
	     XL1(I) = XS3(I)**2
2250	CONTINUE

	J=13
	DO 2300 I=1,NPARHD
	   IF(L1(I)) THEN
	      J=J+1
	      XS1(I) = XS1(J)*XS2(J) + XS3(I)
	   ELSE
	      J=J+1
	      XS1(I) = XS2(J)*XS3(J+2) - XS3(I)
	   ENDIF
2300	CONTINUE

	DO 3000 I=1,NPARHD
	   IF(L1(I)) THEN
		V1 = XS1(I)**2 + XS2(I)**2
	   ELSE 
		V1 = XS1(I) + XS2(I)
	   ENDIF
	   XL1(I) = V1
	   XL2(I) = 2.0*V1
3000	CONTINUE

C 	Loop interchange needed despite embedded IF
	DO 3110 I=1,NPARHD
	    IF(L1(I)) THEN
		DO 3100 J=1, NPARHD
		    XP1(I,J) = XP1(I,J-1)*XP3(I,J) + XP2(I,J-1)
3100		CONTINUE
	     ENDIF
3110	CONTINUE

C	The next loops can be rewritten as loops with
C	    index-tests, like the 2000, 2100 loops NDCODE
	K=NPARHD
	DO 4000 I=1,NPARHD
	    XS1(I) = XS2(K)
	    K=I
4000	CONTINUE

	L=1
	K=NPARHD
	DO 4100 I=1,NPARHD
	    XS1(I) = (XS2(K)+XS3(L))*V2
	    K=I
	    L=NPARHD-I+1
4100	CONTINUE

	L=1
	K=NPARHD
	DO 4200 I=1,NPARHD
	    XS1(I) = (XS2(K)+XS3(L))*V2
	    L=K
	    K=I
4200	CONTINUE

C	Compress and expand loops--special type of 
C	   gather/scatter
	J=1
	DO 5000 I=1,NPARHD
	    IF(L1(I)) THEN
		XS1(I) = XS2(J)
		J=J+1
	    ENDIF
5000	CONTINUE

	J=1
	DO 5100 I=1,NPARHD
	    IF(L1(I)) THEN
		XS1(J) = XS2(I)
		J=J+1
	    ENDIF
5100	CONTINUE
	J=1

C	Gather and scatter both required in next loops.
	J=1	
	K=1
	DO 5200 I=1,NPARHD
	    IF(L1(I)) THEN
		XS1(K) = XS2(J)
		J=J+1
	    ENDIF
	    IF(L2(I)) K=K+1
5200	CONTINUE

C$DIR  NO_RECURRENCE
CDIR$  IVDEP
	J=1	
	K=1
CDEC$  INIT_DEP_FWD
	DO 5300 I=1,NPARHD
	    IF(L1(I)) THEN
		XS1(K) = XS1(J)
		J=J+1
	    ENDIF
	    IF(L2(I)) K=K+1
5300	CONTINUE

	J=1	
	K=1
	DO 5400 I=1,NPARHD
	    IF(L2(I)) J=J+1
	    IF(L1(I)) THEN
		XS1(K) = XS2(J)
		K=K+1
	    ENDIF
5400	CONTINUE

C	In effect, the I/O statements below are vectorizable
	DO 6000 I=1,NPARHD
	    XS1(I) = XS2(I)**2 + XS3(I)
	    READ (6,1) XS3(I)
1	    FORMAT(3E15.5)
6000	CONTINUE

	DO 6100 I=1,NPARHD
	    XS1(I) = XS2(I)**2 + V2
	    READ (6,1) V2
6100	CONTINUE

	DO 6200 I=1,NPARHD
	    XS1(I) = XS2(I)**2 + V2*V1
	    READ (6,1) V1,V2,V3
6200	CONTINUE

	DO 6300 I=1,NPARHD
	    XS1(I) = XS2(I)**2 + V2
	    WRITE (5,1) XS1(I)
6300	CONTINUE

	DO 6400 I=1,NPARHD
	    XS1(I) = XS2(I)**2 + V2
	    IF(XS1(I).LT.0) STOP 'UGH'
6400	CONTINUE

	RETURN
	END

	SUBROUTINE RCRSON
	INCLUDE 'VEC-PAR.INCL'

	DIMENSION ZA(200),ZC(2), ZD(2),ZE(2)
	EQUIVALENCE (ZA,ZD), (ZA(4),ZE), (ZA(100),ZC)

C	35 tests for carefulness of ambiguity checking.

	DO 100 I=1,N
	 XS1(I) = XS1(I+NPAR2)+XS3(I)	    !Parmtr NPAR2 positive
100	CONTINUE

C	NV2 is unknown.  Test passed if execution-time checking done.
	DO 200 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
200	CONTINUE

C	Test passed if compiler directives allows vectorization.
C$DIR  NO_RECURRENCE
CDIR$  IVDEP
CDEC$  INIT_DEP_FWD
	DO 300 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
300	CONTINUE

	NV2 = 2
	DO 400 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
400	CONTINUE

C	NV2 is still known now, but may have been forgotten.
	DO 500 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
500	CONTINUE

C	NOSET doesn't change the value of NV2 -- it's still 2
	CALL NOSET
	DO 600 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
600	CONTINUE

C	Test passed if ASSERT is allowed
	CALL NOSET
CDEC$	ASSERT (NV2 .GT. 0)
	DO 700 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
700	CONTINUE

C	SETNV sets the value of NV2 to 2 ==> still vectorizable
	CALL SETNV(NV2)
	DO 800 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
800	CONTINUE

	NV2 = 3
	DO 1010 I=1,N
	 DO 1000 J=1,M
 	   XP1(I,J) = XP1(I+NV2,J-1)+XS3(I)
1000	 CONTINUE
1010	CONTINUE
	
	DO 1110 J=1,N
	 DO 1100 I=1,M
 	   XP1(I,J) = XP1(I+NV2,J-1)+XS3(I)
1100	 CONTINUE
1110	CONTINUE

	DO 1210 I=1,N
	 DO 1200 J=1,M
 	   XP1(J,I) = XP1(J+NPAR2,I)+XS3(J)
1200	 CONTINUE
1210	CONTINUE

	 DO 1300 J=1,M
 	   XP1(I,J) = XP1(I+NV2,J+NV3)+XS3(I)
1300	 CONTINUE

	CALL MAYSET
 	DO 1410 I=1,N
C$DIR  NO_RECURRENCE
CDIR$  IVDEP
CDEC$  INIT_DEP_FWD
	 DO 1400 J=1,M
 	   XP1(I,J) = XP1(I+NV2,J+NV3)+XS3(I)
1400	 CONTINUE
1410	CONTINUE

	NV2 = 2
	DO 1510 I=1,N
	 DO 1500 J=1,M
 	   XP1(I,J) = XP1(I+NV2,J+NV3)+XS3(I)
1500	 CONTINUE
1510	CONTINUE

	DO 1610 I=1,N
	 DO 1600 J=1,M
 	   XP1(I,J) = XP1(I+NV2,J+NV3)+XS3(I)
1600	 CONTINUE
1610	CONTINUE

C	???  what did I have in mind here???
	DO 1710 I=1,N
	 DO 1700 J=1,M
 	   XP1(I,J) = XP1(J,I)*XP2(J,I)
1700	 CONTINUE
1710	CONTINUE

C	Following loop uses more difficult subscript.
C	    J is actually 1 so it is vectorizable
	K=NPAR2*2
	J=NPAR2-1
	DO 2000  I=1, NPARHD
	  XS1(I) = XS1(I+J)*XS3(I) + XS2(I)
2000	CONTINUE

C	Following test is ambiguous because of possible 
C	    overlap of input and output subscript values.
C	    Implies directive required.
C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
C	Tell compiler that there is no overlap
	DO 2100  I=1, NPARHD
	  XS1(I1(I)) = XS1(I2(I))*XS3(I)
2100	CONTINUE

C	NVL is known in 2310 loop but may have been forgotten.
C	    NVL is local so MAYSET cannot change it.
	NVL = 2
	DO 2200 I=1,N
	 XS1(I) = XS1(I+NVL)*XS3(I)+XS2(I)
2200	CONTINUE
	CALL MAYSET
	DO 2210 I=1,N
	 XS1(I) = XS1(I+NVL)*XS3(I)+XS2(I)
2210	CONTINUE

C	Is limit checking careful enough to see no overlap in
C	     next loop
	CALL MAYSET
	DO 2300 I=1,NPARHD-1
	    XS1(I) = XS1(2*NPARHD-I)*XS3(I)+XS2(I)
2300	CONTINUE

C	Should (or can) vectorize the J (3010) loop 
C	  but not the I (3000) loop.
	IF(NV2.LT.0) THEN
	   DO 3000 I=1,N
	     XS1(I) = XS1(I+NV2)+XS3(I)
3000	   CONTINUE
	ELSE
	   DO 3010 J=1,N
	     XS1(J) = XS1(J+NV2)+XS3(J)
3010	   CONTINUE
	ENDIF

C	Should (or can) vectorize the J (3110) loop 
C	  but not the I (3100) loop.
	NV3 = NV2-5
	IF(NV2.LT.5) THEN
	   DO 3100 I=1,N
	     XS1(I) = XS1(I+NV3)+XS3(I)
3100	   CONTINUE
	ELSE
	   DO 3110 J=1,N
	     XS1(J) = XS1(J+NV3)+XS3(J)
3110	   CONTINUE
	ENDIF

C	Should (or can) vectorize the J (3210) loop 
C	  but not the I (3200) loop.
	IF(NV2.LT.5) THEN
	   NV3 = NV2-5
	   DO 3200 I=1,N
	     XS1(I) = XS1(I+NV3)+XS3(I)
3200	   CONTINUE
	ELSE
	   NV3 = NV2-5
	   DO 3210 J=1,N
	     XS1(J) = XS1(J+NV3)+XS3(J)
3210	   CONTINUE
	ENDIF

C	Should (or can) vectorize the J (3310) loop 
C	  but not the I (3300) loop.
	NV3 = (NV2-5)*2 +1
	IF(NV2.LT.5) THEN
	   DO 3300 I=1,N
	     XS1(I) = XS1(I+NV3)+XS3(I)
3300	   CONTINUE
	ELSE
	   DO 3310 J=1,N
	     XS1(J) = XS1(J+NV3)+XS3(J)
3310	   CONTINUE
	ENDIF

C	The next group of loops are all involve simple linear recursion
C	    and can be vectorized by recursive doubling, e.g.

C	NOTES:	1.  If these tests are passed, some of the other tests
C		should be rechecked to ensure recursive doubling 
C		didn't make it look like other tests passed or 
C		failed when the contrary was true.
C		2.  These tests have very large trip counts so
C		recursive doubling makes sense here even when it 
C		may not in those other cases.

C	Sets the array to the XL1(1) value, but looks like recursion
	DO 4000 I=1,NPARMN
	  XL1(I) = XL1(1)
4000	CONTINUE

C	Sets the array to the XL1(1) value, but looks like recursion
	DO 4100 I=2,NPARMN
	  XL1(I) = XL1(I-1)
4100	CONTINUE

C	Sets the array to XL1(1) + (I-1) * V1, but looks recursive
	DO 4200 I=2,NPARMN
	  XL1(I) = XL1(I-1) + V1
4200	CONTINUE

C	Like above but a product instead of a sum recursion
	DO 4300 I=2,NPARMN
	  XL1(I) = XL1(I-1) * V2
4300	CONTINUE

	DO 4400 I=2,NPARMN
	  XL1(I) = XL1(I-1) * V2 + XL3(I)
4400	CONTINUE

	DO 4500 I=2,NPARMN
	  XL1(I) = XL1(I-1) * V2 + XL3(I)*XL1(I-2) +XL2(I) 
4500	CONTINUE

C	Next tests are for EQUIVALENCE checking.  NONE of
C	    these should vectorize (at least not without 
C	    recursive doubling).
	DO 5000 I=1,NPARHD
	    ZE(I) = ZA(I)*XS1(I) + XS2(I)
5000	CONTINUE

	DO 5100 I=1,NPARHD
	    ZE(I) = ZD(I)*XS1(I) + XS2(I)
5100	CONTINUE

 	DO 5200 I=1,NPARHD
	    ZD(I+NV2) = ZA(I)*XS1(I) + XS2(I)
5200	CONTINUE

C	Similar to those above but here there is no overlap, 
C	    so these should vectorize.
 	DO 5300 I=1,64
	    ZC(I) = ZA(I)*XS1(I) + XS2(I)
5300	CONTINUE

 	DO 5400 I=1,64
	    ZC(I) = ZD(I)*XS1(I) + XS2(I)
5400	CONTINUE

	RETURN
	END

	SUBROUTINE GLOBAL
	INCLUDE 'VEC-PAR.INCL'

	DIMENSION ZA(200),ZB(200), ZC(200),ZD(200)

CDIR$	VFUNCTION VCTFN
	VINLNF(X,Y,Z) = X**2 + Y**2 + Z**2
	JLOC = 12345

C	28 tests that involve subroutines.  All vectorizable.

	DO 100 I=1,N
	 XS1(I) = AMAX(XS2(I),XS3(I),XL2(I))
100	CONTINUE

	DO 200 I=1,N
	 XS1(I) = ABS(XS2(I)**3 + XS3(I)**2)*XL2(I)
200	CONTINUE

	DO 300 I=1,N
	 XS1(I) = SQRT(XS2(I)**2 + XS3(I)**2)*XL2(I)
300	CONTINUE

	DO 400 I=1,N
	 XS1(I) = VINLNF(XS1(I), XS2(I), XS3(I))
400	CONTINUE

C	Next loops test vectorization of Intrinsic Functions
	DO 1000 I=1,NPARHD
	 XS1(I) = XS2(I)**N
1000	CONTINUE

	DO 1100 I=1,NPARHD
	 XS1(I) = XS2(I)**V1
1100	CONTINUE

	DO 1200 I=1,NPARHD
	 XS1(I) = EXP( I*V1*ALOG(XS2(I)) )
1200	CONTINUE

C	Next two probably vectorize if written like one above.
	DO 1300 I=1,NPARHD
	 XS1(I) = XS2(I)**I
1300	CONTINUE

	DO 1400 I=1,NPARHD
	 XS1(I) = XS2(I)**(I*V1)
1400	CONTINUE

	DO 1500 I=1,NPARHD
	 XS1(I) = XS2(I)**N*SIN(XS2(I))*EXP(XS3(I))
1500	CONTINUE

	DO 1600 I=1,NPARHD
	 XS1(I) = SQRT(SQRT(XS2(I)**2+XS3(I)**2))
1600	CONTINUE

	DO 1700 I=1,NPARHD
	 XS1(I) = TAN(SQRT(SQRT(XS2(I)**2+XS3(I)**2)))
1700	CONTINUE

C	Does it know intrinsics have no side-effects?
	DO 1800 I=1,NPARHD
	    V1 = XS2(I)*3.14159
	    XS1(I) = TAN(SQRT(SQRT(XS2(I)**2+XS3(I)**2)))
	    XL1(I) = V1
1800	CONTINUE

C	Does it know intrinsics have no side-effects?
	DO 1900 I=1,NPARHD
	    V1 = SIN(XS2(I))*3.14159
	    XS1(I) = TAN(SQRT(SQRT(XS2(I)**2+XS3(I)**2)))
	    XL1(I) = V1*XS1(I)+XS3(I)
1900	CONTINUE

C	More intrinsic function tests
	DO 2000 I=1,NPARHD
	 XS1(I) = AMAX(XS2(I)**2, XS3(I)**2)
2000	CONTINUE

	DO 2100 I=1,NPARHD
	 XS1(I) = AMAX(XS2(I)**2, XS3(I)**2, XS2(I)**3)
2100	CONTINUE

	DO 2200 I=1,NPARHD
	 XS1(I) = AMAX(XS2(I)**2, XS3(I)**2, XS2(I)**3, XS1(I))
2200	CONTINUE

C	A cleverly written random number generator/compiler needed
C	  (A vector random number generator needed to vectorize)
	DO 2300 I=1,NPARDH
	 XS1(I) = XS3(I)**2 * RAN(JLOC)
2300	CONTINUE

C	Vectorized WRITE needed for next one
	DO 2400 I=1,NPARDH
	 WRITE(6,1) XS1(I),XS3(I)
1	 FORMAT(' The values are:',2E20.10)
2400	CONTINUE

	DO 2400 I=1,NPARDH
	 XS1(I) = XS3(I)**2 * RAN(JLOC)
	 WRITE(6,1) XS1(I),XS3(I)
2400	CONTINUE

C	For Cray, VCTFN must be written in Assembly language
C	    or the VFUNCTION directive must be removed (and then
C	    there will be no vectorization).
	DO 3000 I=1,N
	 XS1(I) = VCTFN(XS2(I),XS3(I))
3000	CONTINUE

C	The next loops can vectorize if the loop code is moved into
C           the loop, the loop into the subroutine, or some similar
C	    multi-routine analysis.

C	Various attacks that work for next two.  The subroutines need
C	    to get info that fourth argument is positive.
C	Statement numbers on CONTINUES included for referencing only.
	CALL VCTSB2(XS2,XS3,XL2, 2, NPARHD)
3100	CONTINUE

	NV2 = 2
	CALL VCTSB2(XS2,XS3,XL2, NV2,NPARHD)
3200	CONTINUE

C 	Subroutine code must be moved in line in next one because
C	    of poor CALLing structure.
	DO 3300 I=1,N
	 CALL VCTSUB(XS2(I),XS3(I),XL2(I))
3300	CONTINUE

C 	Subroutine code must be moved in line in next one because
C	    of poor CALLing structure.
	DO 3400 I=1,N
	   XS1(I) = XS3(I)*XL2(I)
	   CALL VCTSUB(XS2(I),XS3(I),XL2(I))
3400	CONTINUE

C	Next loops are vectorizable because Z* are local so the
C	    subroutine CALLs cannot interfere with them.
	DO 4000 I=1, NPARHD
	    ZA(I) = ZB(I)*ZC(I)
	    CALL ANYTHG
4000	CONTINUE

	DO 4100 I=1, NPARHD
	    ZA(I) = ZB(I)*ZC(I)
	    CALL ANYTHG
	    ZD(I) = ZB(I) - ZC(I)
4100	CONTINUE

	DO 4200 I=1, NPARHD
	    ZA(I) = ZB(I)*ZC(I)
	    VLOC = ZA(I)**2
	    CALL ANYTHG
	    ZD(I) = VLOC-ZB(I)
4200	CONTINUE

	RETURN
	END

	SUBROUTINE TSTDIR
	INCLUDE 'VEC-PAR.INCL'

C	 6 tests of assertion statements and directives.

C	Test to see if ASSERT carries forward
CDEC$   ASSERT(NV2.GT.0)
	DO 100 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
100	CONTINUE
	DO 110 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
110	CONTINUE

C	Test to see what happens with conflicting ASSERTs.  At
C	    least a warning should be given.
CDEC$	ASSERT(I.GT.I+NV2)
CDEC$	ASSERT(NV2.GT. 0)
	DO 200 I=1,N
	 XS1(I) = XS1(I+NV2)+XS3(I)
200	CONTINUE

C	Should (or can) vectorize the J (1010) loop 
C	  but not the I (1000) loop.  Is compiler smart enough
C	  to do what's right, not what it's told to do?
C	  Or at least give a warning that there's a conflict?
	IF(NV2.LT.0) THEN
C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
	   DO 1000 I=1,N
	     XS1(I) = XS1(I+NV2)+XS3(I)
1000	   CONTINUE
	ELSE
	   DO 1010 J=1,N
	     XS1(J) = XS1(J+NV2)+XS3(J)
1010	   CONTINUE
	ENDIF

C	  Is compiler smart enough 
C	  to do what's right, not what it's told to do?
C	  Or at least give a warning that there's a conflict?
	IF(NV2.LT.0) THEN
CDEC$	  ASSERT(NV2.GE.0)
	   DO 1100 I=1,N
	     XS1(I) = XS1(I+NV2)+XS3(I)
1100	   CONTINUE
	ENDIF

C	Test for conflicting directives--diags should be given
CDEC$	  ASSERT(NV2 .GT. 0)
C			    ====>  NOT vectorizable
C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
	DO 2000 I=1,NPARHD
	  XS1(I) = XS1(I)*XS2(I) + XS3(I)
	  XS2(I+NV2) = XS2(I)*XS3(I) + XS3(I-1)
2000	CONTINUE

C	  Is compiler smart enough 
C	  to do what's right, not what it's told to do?
C	  Or at least give a warning that there's a conflict?
C$DIR	  NO_RECURRENCE
CDIR$	  IVDEP
CDEC$	  INIT_DEP_FWD
	DO 2100 I=2, NPARHD
	    XS1(I) = XS1(I-1)*XS2(I)+XS3(I)
2100	CONTINUE

C	Need directives for:  listing control, no-vectorization.
C	Listing and similar directives NOT tested

	RETURN
	END

	SUBROUTINE MISC
	INCLUDE 'VEC-PAR.INCL'

C	18 tests that do not readily fit into earlier groups.

C	Sum-Reduction loop
	J=11
	 DO 100 I=1,N
	   XS1(J) = XS1(J) + XS3(I)	
100	 CONTINUE

	 DO 200 I=1,N
	   XS1(J) = XS1(J) + XS3(I)*XS2(I)*I+SQRT(XS2(I)**3)
200	 CONTINUE

C 	Running convolution type codes
	DO 310 J=1,M
	 DO 300 I=1,N
	   XS1(J) = XS1(J) + XS3(I+J)*XS2(I+J)
300	 CONTINUE
310	 CONTINUE

C 	Running convolution type codes
	DO 410 J=1,M
	 DO 400 I=1,N
	   XS1(J) = XS1(J) + SQRT(XS3(I+J)**2 + XS2(I+J)**2)
400	 CONTINUE
410	 CONTINUE

C 	Running convolution type codes
	DO 510 J=1,M
	 DO 500 I=1,N
	    V2 = XP1(I,J)*XP2(I,J-1)
	    V3 = XP1(I,J)-XP2(I-1,J)
	    XS1(J) = XS1(J) + XS3(I+J)*XS2(I+J) + V2*V3
500	 CONTINUE
510	 CONTINUE

C	Product-Reduction loop
	J=1
	 DO 600 I=1,N
	   XS1(J) = XS1(J) * XS3(I)	
600	 CONTINUE

C	Messy loop that should vectorize
	 DO 1000 I=1,N
	   V1 = XL1(I)*XS2(I-1)
	   V2 = XL1(I)**2 + XS3(I)**3
	   XV3 = V1*V2 + XS2(I+3)
	   XP1(I,NV1) = V1+V2*XV3
	   V1 = XP2(I,NV1)*XS3(I) + XS2(I+3)
	   V2 = XV3 * V1 + XP2(NV2, I)
	   XP3(NV2,I) = V1*V2 + ABS(XV3)
	   V1 = (XL1(I) + XS2(I))*V2
	   XS1(I) = XL1(J) + XS3(I)*XS2(I)*I+SQRT(V1**3)
1000	 CONTINUE

C	Uses a temporary variable that = I*cst
	V1 = 0
	DO 2000 I=1,N
	  V1 = V1 + V2  
	  XS1(I) = V1
2000	CONTINUE

C	Uses a temporary variable that = I*cst
	V1 = 0
	DO 2100 I=1,N
	  V1 = V1 + V2  
	  XS1(I) = V1
	  XS2(I) = V1**2
	  XS3(I) = SIN(V1 + XS2(I))
2100	CONTINUE

C	Search-type loops
	DO 3000 I=1,N
	  XS1(I) = XS2(I)**2
	  IF(XS3(I).LT.0.4) GOTO 3010
3000	CONTINUE
3010	CONTINUE

	DO 3100 I=1,NPARHD
	  IF(I1(I) .EQ. NV1) GOTO 3110
3100	CONTINUE
3110	CONTINUE

C	Search for max element
	XMAX = XS3(1)
	DO 3200 I=2,N
	  IF(XS3(I) .LT. XMAX) XMAX = XS3(I)
3200	CONTINUE

C	Search for max element and its index
	XMAX = XS3(I)
	IMAX = 1
	DO 3300 I=2,N
	  IF(XS3(I) .LT. XMAX) THEN
	    XMAX = XS3(I)
	    IMAX = I
	  ENDIF
3300	CONTINUE

	DO 4000 I=1,N
	  XS1(I) = XS2(I)**2
	  IF(I.GT.44) GOTO 4010
4000	CONTINUE
4010	CONTINUE

	I=1
4100	CONTINUE
	  XS1(I) = XS2(I)**2
	  I=I+1
	IF(I.LT.N) GOTO 4100

	I=1
4200	CONTINUE
	  XS1(I) = XS2(I)**2
	  I=I+1
	IF(I.GT.N) GOTO 4210
	GOTO 4200
4210	CONTINUE

	I=1
4300	CONTINUE
	I=I+1
	IF(I.GT.N) GOTO 4310
	  XS1(I) = XS2(I)**2
	GOTO 4300
4310	CONTINUE

CLH	Following loop is non-standard Fortran
C	Statement numbers on CONTINUE included for referencing only.
	I=0
	DO WHILE (I .LT. N)
	  I=I+1
	  XS1(I) = XS2(I)*XS3(I)
	ENDDO
4400	CONTINUE
	
	RETURN
	END

	SUBROUTINE NDCODE
	INCLUDE 'VEC-PAR.INCL'

	VINLNF(X,Y,Z) = X**2 + Y**2 + Z**3

CDIR$	  CODE

C	25 tests where the code generated by the compiler needs to be 
C	    checked to really determine how well the compiler did.

C	Test passed if converted to one loop or interchanged.
	CALL S100
	DO 100 I=1,200
	  DO 100 J=1,200
	    XP1(I,J) = 0.0
100	CONTINUE

C	Test passed if converted to one loop or interchanged.
	CALL S200
	DO 200 I=1,200
	  DO 200 J=1,2
	    XP1(I,J) = 0.0
200	CONTINUE

C	Test passed if loop order interchanged
	CALL S300
	DO 300 I=1,100
	  DO 300 J=1,2
	    XP1(I,J) = 0.0
300	CONTINUE

C	Test passed if scalar-vector operations
C	are used, not broadcasting the scalar.
	CALL S400
	DO 400 I=1,N
	 XS1(I) = VINLNF(XS1(I), XS2(I), V1)
400	CONTINUE

C	Test passed if converted to one loop.
	CALL S500
	DO 500 I=1,8
	  DO 500 J=1,8
	    XPS1(I,J) = 0.0
500	CONTINUE

C	Test passed if loop order is interchanged in this convolution
	CALL S600
	M = N/2
	DO 600 I = 1+M, 200000-M
	  DO 600 J=-M, M
	    XL1(I) = XL1(I) + XL2(I+J)*XS1(J+M+1)
600	CONTINUE

C	Test passed if loop order is interchanged in this convolution
	CALL S700
	DO 700 I = 1+(N/2), 200000-(N/2)
	  DO 700 J=-(N/2), (N/2)
	    XL1(I) = XL1(I) + XL2(I+J)*XS1(J+(N/2)+1)
700	CONTINUE

C	Loops below should be interchanged only for the first 
C    	    half of the values of the outermost loop.
	CALL S800
	DO 820 I=1,M
	  DO 810 J=1,2**M, 2**(M-I)
	    DO 800 K=1,2**M, 2**I
	      XS1(K) = (XS2(J) + XS2(2**M-J+1))*XS3(I)
800	    CONTINUE
810	  CONTINUE
820	CONTINUE

C	Matrix multiply -- convert to outer-product form?
	CALL S1000
	DO 1020 I=1,M
	  DO 1010 J=1,N
	    DO 1000 K=1,L
		XP1(I,J) = XP1(I,J) + XP2(I,K)*XP3(K,J)
1000	   CONTINUE
1010	CONTINUE
1020	CONTINUE

C	Also convertible, but not just a matrix multiply
	CALL S1100
	DO 1110 I=1,M
	  DO 1100 J=1,N
	    DO 1100 K=1,L
		XP1(I,J) = XP1(I,J) + XP2(I,K)*XP3(K,J)+XS3(J)
1100	   CONTINUE
1110	CONTINUE

C	There are redundant stores below:  either a diag or dead
C	    code elimination should be done, preferably a 
C	diagnostic given that code is ridiculous.
	CALL S1200
	DO 1210 I=1,NPARHD,NPAR2
	  DO 1200 J=1, I
	  XP1(NPARHD-I+1,I) = 1.144 * XP2(I+J, I-J)
1200	  CONTINUE
1210	CONTINUE

C	Should do as a loop from 2,N with explicit code for I=1 case
	CALL S2000
	DO 2000 I=1,N
	 XS1(I) = XS2(I)**2+XS3(I)
	 IF(I .EQ. 1) XS1(I) = 0.0
2000	CONTINUE

C	Should do as a loop from 2,N-1 with explicit code for 
C	    I=1 and for I=N cases
	CALL S2100
	DO 2100 I=1,N
	 XS1(I) = XS2(I)**2+XS3(I)
	 IF(I .EQ. 1) THEN 
	   XS1(I) = 0.0
	   ELSE IF(I .EQ. N) THEN  
	      XS1(I) = 1.0
	   ENDIF
2100	CONTINUE

C	Should move the IF test outside the loop below
	CALL S2200
	DO 2200 I=1,NPARHD
	    IF(LI(1)) THEN
		XS1(I) = XS2(I)+XS3(I)**2
	    ENDIF
2200	CONTINUE

C	Following loop should be a block of vector code with no
C	    strip-mining loop surrounding.  Duplicate of loop 2000
C	    in SIMPLE.
	CALL S3000
	DO 3000 I=1,64
	 XS1(I) = XS2(I) + XS3(I)	
3000	CONTINUE

C	Should get an interrupt on overflow but not on
C	    zero XS3 values
	CALL S4000
	DO 4000 I=1,N
	 IF(XS3(I).NE.0) XS1(I) = XS2(I)/XS3(I)
4000	CONTINUE

C	Should get an interrupt on divide by zero below but not above.
	CALL S4100
	DO 4100 I=1,N
	 XS1(I) = XS2(I)/XS3(I)
4100	CONTINUE

C	K Subscript is linear, NO gather required.
	CALL S5000
	K=1
	DO 5000 I=1,N
	  K = K+1
	  XS1(I) = XL2(K) + XS3(I)
	  K=K+2
	  XS2(K) = XS1(I)*XS3(I)
	  K=K+1
	  XL1(K) = XL2(K)* XS3(I)
5000	CONTINUE

C	Checks to see if several loops are coalesced into a single one.
	CALL S5100
	DO 5100 I=1,NPARHD
	    XS1(I) = 0.0
5100	CONTINUE
	    XS2(I) = 1.0
5110	CONTINUE
	DO 5120 I=1,NPARHD
	    XS3(I) = 2.0
5120	CONTINUE
	DO 5130 I=1,NPARHD
	    XL1(I) = -1.0
5130	CONTINUE
	DO 5140 I=1,NPARHD
	    XL2(I) = -12.0
5140	CONTINUE
C	Five loops above are a single test for loop coalescing.

C	Check to see if one loop is separated into several.
	CALL S5200
	DO 5200 I=1,NPARHD
	    IF(I.LT.11) XS1(I) = 0.0
	    IF((I.GE.11).AND.(I.LT.33)) XS1(I) = 1.0
	    IF(I.GE.33) XS1(I) = 3.0
5200	CONTINUE

C	Check to see if several loops are concatenated into one.
	CALL S5300
	DO 5300 I=1,13
	    XS1(I) = 1.0
5300	CONTINUE
	DO 5310 I=14,33
	    XS1(I) = 1.0
5310	CONTINUE
	DO 5320 I=34,NAPRHD
	    XS1(I) = 1.0
5320	CONTINUE
C	Three loops above are a single test for loop concatenation.

C	Test for rerolling loop.  Test is passed by converting to a 
C	   loop of increment 1.
	CALL S5400
	DO 5410 I=1,5,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)	
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5410	CONTINUE
	DO 5420 I=1,10,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)	
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5420	CONTINUE
	DO 5430 I=1,20,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5430	CONTINUE
	DO 5440 I=1,30,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)	
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5440	CONTINUE
	DO 5450 I=1,50,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)	
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5450	CONTINUE
C	End of single rerolling test

C 	Second rerolling test:  should be a loop of incr=1, length = 64.
	CALL S5500
	DO 5500 I=1,60,5
	 XS1(I) = XS2(I)*XS3(I)+XS2(I+1)*XS3(I+1)+XS2(I+2)*XS3(I+2)	
     +     + XS2(I+3)*XS3(I+3)+XS2(I+4)*XS3(I+4)
5500	CONTINUE

C	Compute v1**n
	CALL S6000
	DO 6000 I=1, N
	    X = X*V1
6000	CONTINUE

C	Evaluate polynomial
	CALL S6100
	DO 6100 I=1, N
	    X = X*V1+V2
6100	CONTINUE

C*****
C	Other tests not included:
C	    Scalar optimiztion such as loop unrolling
C	    Array bounds checking outside of loops, not in loops
C*****

	RETURN
	END