SUBROUTINE S8D(N,K,T,D,A,TIMES,AA)
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c CVS Info
c $Date: 2005/01/10 21:55:52 $
c $Revision: 1.2 $
c $RCSfile: s8d.f,v $
c $Name: rel_5 $
c
c This subroutine generates the random data for the small dense matrix
c version of Benchmark #8.
c
c Parameters:
c
c Provided by calling routine:
c N = The size of the A matrices
c K = The number of A matrices
c T = The length of the D array
c
c Returned by this routine:
c D = An array of length T, holding integers mod K
c A = K real NxN matrices of positive real numbers
c TIMES = An NxK long array of positive real numbers
c AA = An NxN matrix of positive real numbers
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
INTEGER T
INTEGER I,J,K,KK,N
c
c
c Which matrix to use in each step
INTEGER D(T)
c
clfs Allocate another matrix to seed instead of D because
clfs RAND expects an array of type INTEGER*8
c
cwah INTEGER,POINTER::D8(:)
INTEGER K8
c The matrices
REAL A(N,N,K)
c
c The scaling factor by which to multiply the columns of AA in order to
c obtain the A matrices
REAL TIMES(N,K)
c
c An array from which to generate the A matrices
REAL AA(N*N)
C--CVS variable declaration
TYPE CVS
sequence
character( 160 ) string
integer stringend
END TYPE CVS
C--CVS initilaize variables
TYPE( CVS ),save :: CVS_INFO =
$ CVS("BMARKGRP $Date: 2005/01/10 21:55:52 $ $Revision: 1.2 $" //
$ "$RCSfile: s8d.f,v $ $Name: rel_5 $", 0)
c
c Random number generation function
c INTEGER IRAND
c
c Generate random numbers between 1 and K for the D array
cwah allocate(D8(T),STAT=I)
CALL VRAND(0,D,T)
K8=K
cwah DO I = 1,T
cwah D(I) = MOD(D(I),K) + 1
cwah ENDDO
DO I = 1,T
D(I) = MOD(D(I),K8) + 1
ENDDO
c
c Initialize a matrix AA from which to generate the A matrices
CALL RANDIV(N,N,AA)
c PRINT *,'AA '
c DO i = 1,N*N
c PRINT *,'AA(',i,') = ',AA(i)
c ENDDO
c
c Initialize the scaling factors from which to derive the A matrices from
c the AA matrix
CALL RANDIV(N,K,TIMES)
c PRINT *,'TIMES '
c DO i = 1,N
c DO j = 1,N
c PRINT *,'TIMES(',i,',',j,') = ',TIMES(i,j)
c ENDDO
c ENDDO
c
c Generate the A matrices from the AA matrix and the scaling factors
Do I = 1,N
Do J = 1,N
Do KK = 1,K
A(I,J,KK) = AA(I+N*J-N) * TIMES(J,KK)
Enddo ! KK
Enddo ! J
Enddo ! I
c
c
c
c PRINT *,'D(1..20) = ',(D(I),I=1,20)
c DO i = 1,N
c DO j = 1,N
c DO kk = 1,K
c PRINT *,'A(',i,',',j,',',kk,') = ',A(i,j,kk)
c ENDDO
c ENDDO
c ENDDO
c
c
RETURN
END
SUBROUTINE RANDIV(M,N,A)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Subroutine to produce M N-long lists of random numbers, with wide
c variance in their magnitudes, but whose sum is 1.0.
c
c Each list is done independently from the others, so we will talk
c about only one. The algorithm is to start with an N-long partition,
c whose sum of eventual numbers is known to be 1.0. The partition is
c split into two partitions, the dividing point being random. The sum
c is also split randomly, with one part going to one partition, the
c other part to the other partition. If both partitions contain
c more than one element, one is pushed onto the stack and the
c other is processed further. If either contains only one element,
c its sum is the final value of that element, so it is done and
c we work on the other partition without pushing this one on
c the stack. If both contain only one element, we pop a previously
c pushed partition off the stack and work on it. We then repeat
c the above until the stack is empty and there is no partition
c we are currently working on, which occurs after N-1 steps.
c Finally, we shuffle the positions of the elements.
c
c Notice that we require 3*(N-1) random numbers per list: one for
c splitting the partitions, one for splitting the sums, and one for
c the final shuffle. These random numbers will be computed as needed.
c
c Parameters:
c
c Provided by calling routine:
c M = Number of lists to generate
c N = Length of each list
c
c Returned by this routine:
c A = M by N Array to hold results
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
REAL A(M,N)
c
c Maximum allowed values of M and N
PARAMETER( MM = 100)
c
c The stack of the end points of the partitions
INTEGER STKEND(MM,MM)
c
c The stack of the starting points of the partitions
INTEGER STKST(MM,MM)
c
c The stack pointer (number of partitions found but not current)
INTEGER IPTR(MM)
c
c The starting and end points of the current partition
INTEGER ISTART(MM),IEND(MM)
c
c The sum of the elements in the current partition
REAL RSUM(MM)
c
c An array to hold randum real numbers between 0 and 1
REAL RND(MM, MM)
c
c Random number generation function
c INTEGER IRAND
c
c Check values of M and N against MM
IF((M .GT. MM) .OR. (N .GT. MM)) THEN
PRINT 5,M,N,MM
5 FORMAT('Error in RANDIV. M = ',I5,' N = ',I5,
$ ' Maximum allowed = ',I6)
STOP
ENDIF
c
c Initalize the array of random real numbers
X = .5**32
DO 20 I = 1, N
DO 10 J = 1, M
INT = IRAND(0)
RND(J,I) = X*INT
10 CONTINUE
20 CONTINUE
c
DO i = 1,N
DO j = 1,M
ENDDO
ENDDO
c
c Initialize the sum to be 1.0, the partition to begin at the first
c element and end at the last, and the stack to be empty
DO 30 K = 1,M
STKEND(K,1) = N
ISTART(K) = 1
IEND(K) = N
IPTR(K) = 1
RSUM(K) = 1.0
30 CONTINUE
c
c We are guaranteed to finish in exactly N-1 steps
DO 50 ISTEP = 1,N-1
DO 40 K = 1,M
c
c Find the length of the current partition
IDIFF = IEND(K) - ISTART(K)
c
c Split the current sum
RAND1 = RSUM(K)*RND(K,ISTEP)
RAND2 = RSUM(K) - RAND1
c
c Default the next current sum to be the one for the first partition
TSUM = RAND1
c
c Push the sum for the other partition onto the stack
RND(K,IPTR(K)+1) = RAND2
c
c Calculate the end of the first partition by splitting the current
c partition
ITEND = (IRAND(0) * X)*IDIFF + ISTART(K)
c
c The start of the second partition is just past the end of the first
STKST(K,IPTR(K)+1) = ITEND + 1
c
c The end of the 2nd partition is the end of the current partition
STKEND(K,IPTR(K)+1) = IEND(K)
c
c The start of the first partition is the start of the current one
ITSTRT = ISTART(K)
c
c Assume both partitions are longer than 1
INC = 1
c
c Save the two sums in case the length of their partition is 1 -- will
c be overwritten later if not
A(K,ISTART(K)) = RAND1
A(K,IEND(K)) = RAND2
c
c Is the first partition of length 1? If so, then ...
IF (ITEND .EQ. ITSTRT) THEN
c
c ... we don't have to push onto the stack
INC = 0
c
c The next current start, end, and sum are those of the second partition
ITSTRT = ITSTRT + 1
ITEND = IEND(K)
TSUM = RAND2
c
c Unless the second partition is also of length 1, in which case ...
IF (IDIFF .EQ. 1) THEN
c
c ... we pop the next current start, end, and sum from the stack
INC = -1
ITSTRT = STKST(K,IPTR(K))
ITEND = STKEND(K,IPTR(K))
TSUM = RND(K,IPTR(K))
END IF
c
c If the first partition is not of length one but the second is, ...
ELSE IF (ITEND .EQ. IEND(K)-1) THEN
c
c ... the next current start, end, and sum are as assumed above, but
c we don't need to push the 2nd partition onto the stack
INC = 0
END IF
c
c Update the current start, end, and sum, as well as the stack pointer
ISTART(K) = ITSTRT
IEND(K) = ITEND
IPTR(K) = IPTR(K) + INC
RSUM(K) = TSUM
40 CONTINUE
50 CONTINUE
c
c Do the final shuffle
DO 70 I = N,2,-1
DO 60 K = 1,M
ITMP = (IRAND(0)*X*I) + 1
TMP = A(K,I)
A(K,I) = A(K,ITMP)
A(K,ITMP) = TMP
60 CONTINUE
70 CONTINUE
RETURN
END