C***********************************************************************
C                TEST SUITE FOR VECTORIZING COMPILERS                  *
C                        (File 2 of 2)                                 *
C                                                                      *
C  Version:   2.0                                                      *
C  Date:      3/14/88                                                  *
C  Authors:   Original loops from a variety of                         *
C             sources. Collection and synthesis by                     *
C                                                                      *
C             David Callahan  -  Tera Computer                         *
C             Jack Dongarra   -  University of Tennessee               *
C             David Levine    -  Argonne National Laboratory           *
C***********************************************************************
C  Version:   3.0                                                      *
C  Date:      1/4/91                                                   *
C  Authors:   David Levine    -  Executable version                    *
C***********************************************************************
C                         ---DESCRIPTION---                            *
C                                                                      *
C  This test consists of a variety of  loops that represent different  *
C  constructs  intended   to  test  the   analysis  capabilities of a  *
C  vectorizing  compiler.  Each loop is  executed with vector lengths  *
C  of 10, 100, and 1000.   Also included  are several simple  control  *
C  loops  intended  to  provide  a  baseline  measure  for  comparing  *
C  compiler performance on the more complicated loops.                 *
C                                                                      *
C  The  output from a  run  of the test  consists of seven columns of  *
C  data:                                                               *
C     Loop:        The name of the loop.                               *
C     VL:          The vector length the loop was run at.              *
C     Seconds:     The time in seconds to run the loop.                *
C     Checksum:    The checksum calculated when running the test.      *
C     PreComputed: The precomputed checksum (64-bit IEEE arithmetic).  *
C     Residual:    A measure of the accuracy of the calculated         *
C                  checksum versus the precomputed checksum.           *
C     No.:         The number of the loop in the test suite.           *
C                                                                      *
C  The  residual  calculation  is  intended  as  a  check  that   the  *
C  computation  was  done  correctly  and  that 64-bit arithmetic was  *
C  used.   Small   residuals    from    non-IEEE    arithmetic    and  *
C  nonassociativity  of   some calculations  are   acceptable.  Large  *
C  residuals  from   incorrect  computations or  the  use   of 32-bit  *
C  arithmetic are not acceptable.                                      *
C                                                                      *
C  The test  output  itself  does not report   any  results;  it just  *
C  contains data.  Absolute  measures  such as Mflops and  total time  *
C  used  are  not   appropriate    metrics  for  this  test.   Proper  *
C  interpretation of the results involves correlating the output from  *
C  scalar and vector runs  and the  loops which  have been vectorized  *
C  with the speedup achieved at different vector lengths.              *
C                                                                      *
C  These loops  are intended only  as  a partial test of the analysis  *
C  capabilities of a vectorizing compiler (and, by necessity,  a test  *
C  of the speed and  features  of the underlying   vector  hardware).  *
C  These loops  are  by no means  a  complete  test  of a vectorizing  *
C  compiler and should not be interpreted as such.                     *
C                                                                      *
C***********************************************************************
C                           ---DIRECTIONS---                           *
C                                                                      *
C  To  run this  test,  you will  need  to  supply  a  function named  *
C  second() that returns user CPU time.                                *
C                                                                      *
C  This test is distributed as two separate files, one containing the  *
C  driver  and  one containing the loops.   These  two files MUST  be  *
C  compiled separately.                                                *
C                                                                      *
C  Results must  be supplied from  both scalar and vector  runs using  *
C  the following rules for compilation:                                *
C                                                                      *
C     Compilation   of the  driver  file must  not  use any  compiler  *
C     optimizations (e.g., vectorization, function  inlining,  global  *
C     optimizations,...).   This   file   also must  not  be analyzed  *
C     interprocedurally to  gather information useful  in  optimizing  *
C     the test loops.                                                  *
C                                                                      *
C     The file containing the  loops must be compiled twice--once for  *
C     a scalar run and once for a vector run.                          *
C                                                                      *
C        For the scalar  run, global (scalar) optimizations should be  *
C        used.                                                         *
C                                                                      *
C        For  the  vector run,  in  addition   to  the  same   global  *
C        optimizations specified  in the scalar   run,  vectorization  *
C        and--if available--automatic  call generation to   optimized  *
C        library  routines,  function inlining,  and  interprocedural  *
C        analysis should be  used.  Note again that function inlining  *
C        and interprocedural  analysis  must  not be  used to  gather  *
C        information  about any of the  program  units  in the driver  *
C        program.                                                      *
C                                                                      *
C     No changes  may  be made  to   the   source code.   No compiler  *
C     directives may be used, nor may  a file  be split into separate  *
C     program units.  (The exception is  filling  in  the information  *
C     requested in subroutine "info" as described below.)              *
C                                                                      *
C     All files must be compiled to use 64-bit arithmetic.             *
C                                                                      *
C     The  outer  timing  loop  is  included  only   to increase  the  *
C     granularity of the calculation.  It should not be vectorizable.  *
C     If it is found to be so, please notify the authors.              *
C                                                                      *
C  All runs  must be  made  on a standalone  system  to minimize  any  *
C  external effects.                                                   *
C                                                                      *
C  On virtual memory computers,  runs should be  made with a physical  *
C  memory and working-set  size  large enough  that  any  performance  *
C  degradation from page  faults is negligible.   Also,  the  timings  *
C  should be repeatable  and you  must  ensure  that timing anomalies  *
C  resulting from paging effects are not present.                      *
C                                                                      *
C  You should edit subroutine "info"   (the  last subroutine  in  the  *
C  driver program) with  information specific to your  runs, so  that  *
C  the test output will be annotated automatically.                    *
C                                                                      *
C  Please return the following three files in an electronic format:    *
C                                                                      *
C  1. Test output from a scalar run.                                   *
C  2. Test output from a vector run.                                   *
C  3. Compiler output listing (source echo, diagnostics, and messages) *
C     showing which loops have been vectorized.                        *
C                                                                      *
C  The preferred media  for receipt, in order  of preference, are (1)  *
C  electronic mail, (2) 9-track  magnetic or  cartridge tape in  Unix  *
C  tar  format, (3) 5  IBM PC/DOS  floppy   diskette, or  (4) 9-track  *
C  magnetic  tape in  ascii  format,   80 characters per card,  fixed  *
C  records, 40 records per block, 1600bpi.  Please return to           *
C                                                                      *
C  David Levine       		                                       *
C  Mathematics and Computer Science Division                           *
C  Argonne National Laboratory                                         *
C  Argonne, Illinois 60439                                             *
C  levine@mcs.anl.gov                                                  *
C***********************************************************************
C%1.1
      subroutine s114(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     linear dependence testing
C     transpose vectorization
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s114 ')
      call system_clock(i1)
      do nl= 1,2*ntimes/n
!$omp parallel do schedule(runtime) if(n>129)
	  do j= 2,n
#ifdef __MIC__
!dir$ novector  ! vectorization is slow (MIC prefetch problem?)
#endif
		do i=1,j-1
		  aa(i,j)= aa(j,i)+bb(i,j)
		enddo
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)
      call check(chksum,2*(ntimes/n)*((n*n-n)/2),n,t2,'s114 ')
      return
      end
C%1.1
C%1.2
      subroutine s125(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     induction variable recognition
C     induction variable in two loops; collapsing possible
C
      integer ntimes,ld,n,i,nl,j,k,nn
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs1d,array
      integer*8 i1,i2,sc_rate
      parameter(nn= 2000)
      common/cdata /array(nn*nn)
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s125 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do
	  do j= 1,n
!dir$ vector nontemporal
		array((j-1)*n+1:j*n)= aa(:n,j)+bb(:n,j)*cc(:n,j)
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= cs1d(n*n,array)
      call check(chksum,(ntimes/n)*n*n,n,t2,'s125 ')
      return
      end
C%1.2
      subroutine s126(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
#ifdef _OPENMP
      USE omp_lib
#endif
C
C     induction variable recognition
C     induction variable in two loops; recurrence in inner loop
C
      integer ntimes,ld,n,i,nl,j,k,nn
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs2d,array
      integer*8 i1,i2,sc_rate
      parameter(nn= 2000)
      common/cdata /array(nn*nn)
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s126 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do private(k) if(n>129)
	  do i= 1,n
	      k= i*n+1-n
	      do j= 2,n
		  bb(i,j)= bb(i,j-1)+array(k)*cc(i,j)
		  k= k+1
		enddo
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= cs2d(n,bb)
      call check(chksum,(ntimes/n)*n*(n-1),n,t2,'s126 ')
      return
      end
C%1.4
      subroutine s141(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     nonlinear dependence testing
C     walk a row in a symmetric packed array
C     element a(i,j) for (j>i) stored in location j*(j-1)/2+i
C
#ifdef _OPENMP
      USE omp_lib
#endif
      integer ntimes,ld,n,i,nl,j,k,nn
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs1d,array
      real avgchunk
      integer*8 i1,i2,sc_rate
      integer nj(n)
      parameter(nn= 2000)
      common/cdata /array(nn*nn)
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s141 ')
      call system_clock(i1)
C	  do i= 1,n
C	      k= i*(i+1)/2
C	      do j= i,n
C		  array(k)= array(k)+bb(i,j)
C		  k= k+j
C		enddo
      do nl= 1,ntimes/n
!$omp parallel do private(k) schedule(dynamic,2) if(n>129)
	      do j= 1,n
		  k= j*(j-1)/2
#ifdef __MIC__
!dir$ unroll(0)
#endif
		  do i=1,j
		      array(k+i)= array(k+i)+bb(i,j)
		    enddo
		enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	    enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= cs1d(n*n,array)
      call check(chksum,(ntimes/n)*n*n,n,t2,'s141 ')
      return
      end
			
C%1.7
      subroutine s176(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     symbolics
C     convolution
C
      integer ntimes,ld,n,i,nl,j,m
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs1d
      integer*8 i1,i2,sc_rate
      m= n/2
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s176 ')
      call system_clock(i1)
      do nl= 1,4*ntimes/n
!$omp parallel do if(n>129)
	do i= 1,m
	  a(i)= a(i)+dot_product(b(i:i+m-1),c(m:1:-1))
	enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(4*(ntimes/n)))
      chksum= cs1d(n,a)
      call check(chksum,4*(ntimes/n)*(n/2)*(n/2),n,t2,'s176 ')
      return
      end
C%2.3
      subroutine s231(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
#ifdef _OPENMP
      USE omp_lib
#endif
C
C     loop interchange
C     loop with multiple dimension recursion
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t1,t2,chksum,ctime,dtime,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s231 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do simd if(n>129)
	  do i= 1,n
	    do j= 2,n
	      aa(i,j)= aa(i,j-1)+bb(i,j)
	      enddo
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)
      call check(chksum,(ntimes/n)*n*(n-1),n,t2,'s231 ')
      return
      end
C%2.3
      subroutine s232(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     loop interchange
C     interchanging of triangular loops
C
#ifdef _OPENMP
      USE omp_lib
#endif
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs2d
      real*8 tmp1,tmp2
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s232 ')
      call system_clock(i1)
      do nl= 1,2*ntimes/n
!$omp parallel do private(tmp1,tmp2)
!$OMP& schedule(auto) if(n>129)
	      do j= 1,n-1,2
		do i= 2,j
		  aa(i,j)= aa(i-1,j)*aa(i-1,j)+bb(i,j)
		enddo
            enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
        enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)
      call check(chksum,2*(ntimes/n)*((n*n-n)/2),n,t2,'s232 ')
      return
      end
C%2.3
      subroutine s233(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     loop interchange
C     interchanging with one of two inner loops
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t1,t2,chksum,ctime,dtime,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s233 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel
!$omp do
!dir$ no vector
	do j= 2,n
	  do i= 2,n
		bb(i,j)= bb(i-1,j)+cc(i,j)
		enddo
	    enddo
!$omp end do nowait
!$omp do simd
	  do i= 2,n
	      do j= 2,n
		aa(i,j)= aa(i,j-1)+cc(i,j)
		enddo
	    enddo
!$omp end parallel
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)+cs2d(n,bb)
      call check(chksum,(ntimes/n)*(n-1)*(2*n-2),n,t2,'s233 ')
      return
      end
C%2.3
      subroutine s234(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
#ifdef _OPENMP
      USE omp_lib
#endif
C
C     loop interchange
C     if loop to do loop, interchanging with if loop necessary
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t1,t2,chksum,ctime,dtime,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s234 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do simd if(n>129)
	  do i = 1,n
	      do j = 2,n
		  aa(i,j)= aa(i,j-1)+bb(i,j-1)*cc(i,j-1)
		enddo
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)
      call check(chksum,(ntimes/n)*n*(n-1),n,t2,'s234 ')
      return
      end
C%2.3
      subroutine s235(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
#ifdef _OPENMP
      USE omp_lib
#endif
C
C     loop interchanging
C     imperfectly nested loops
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t1,t2,chksum,ctime,dtime,cs1d,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s235 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do simd if(n>129)
	  do i=1,n
              a(i)= a(i)+b(i)*c(i)
	      do j= 2,n
		aa(i,j)= aa(i,j-1)+bb(i,j)*a(i)
		enddo
	    enddo
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(2*(ntimes/n)))
      chksum= cs2d(n,aa)+cs1d(n,a)
      call check(chksum,(ntimes/n)*n*(n-1),n,t2,'s235 ')
      return
      end
C%2.5
      subroutine s257(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     scalar and array expansion
C     array expansion
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,cs1d,cs2d,tmp
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s257 ')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel if(n>129)
!$omp do private(tmp)
!dir$ novector  ! outer loop vectorization is slow
	do j= 1,n-1
	  tmp= a(1)
	  do i= 2,n
		tmp= aa(i,j)-tmp
		aa(i,j)= tmp+bb(i,j)
	      enddo
	    enddo
!$omp end do nowait
!$omp single
	  do i= 2,n
		a(i)= aa(i,n)-a(i-1)
		aa(i,n)= a(i)+bb(i,n)
	      enddo
!$omp end single
!$omp end parallel
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= cs1d(n,a)+cs2d(n,aa)
      call check(chksum,(ntimes/n)*(n-1)*n,n,t2,'s257 ')
      return
      end
C%2.12
      subroutine s2102(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     diagonals
C     identity matrix, best results vectorize both inner and outer loops
C
      integer ntimes,ld,n,i,nl,j
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t1,t2,chksum,ctime,dtime,cs2d
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s2102')
      call system_clock(i1)
      do nl= 1,ntimes/n
!$omp parallel do if(n > 129)
	  do i= 1,n
              forall(j=1:n) aa(j,i)= merge(1.,0.,j==i)
	    end do
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,1.d0)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= cs2d(n,aa)
      call check(chksum,(ntimes/n)*n*n,n,t2,'s2102')
      return
      end
C%3.1
      subroutine s3110(ntimes,ld,n,ctime,dtime,a,b,c,d,e,aa,bb,cc)
C
C     reductions
C     if to max with index reduction, 2 dimensions
C
      integer ntimes,ld,n,i,nl,j,xindex,yindex,ml
      real*8 a(n),b(n),c(n),d(n),e(n),aa(ld,n),bb(ld,n),cc(ld,n)
      real*8 t2,chksum,ctime,dtime,max_
      integer*8 i1,i2,sc_rate
      call init(ld,n,a,b,c,d,e,aa,bb,cc,'s3110')
      call system_clock(i1)
      do nl= 1,ntimes/n
	  max_= aa(1,1)
	  xindex=1
	  yindex=1
!$omp parallel do if(n>129) reduction(max: max_)
!$omp& lastprivate(xindex,yindex) private(ml)
	  do j=1,n
	      ml= maxloc(aa(:n,j),dim=1)
	      if(aa(ml,j)>max_ .or. aa(ml,j)==max_ .and. j<yindex)then
		  xindex= ml
		  yindex= j
		  max_=aa(ml,j)
		endif
	    enddo
	  chksum= max_+float(xindex)+float(yindex)
	  call dummy(ld,n,a,b,c,d,e,aa,bb,cc,chksum)
	enddo
      call system_clock(i2,sc_rate)
      t2= (i2-i1)/dble(sc_rate)-ctime-(dtime*float(ntimes/n))
      chksum= max_+float(xindex)+float(yindex)
      call check(chksum,(ntimes/n)*n*n,n,t2,'s3110')
      return
      end
