!-------------------------------------------------------------------------! ! ! ! N A S P A R A L L E L B E N C H M A R K S 2.3 ! ! ! ! S E R I A L V E R S I O N S ! ! ! ! E P ! ! ! !-------------------------------------------------------------------------! ! ! ! This benchmark is a serial version of the NPB EP code. ! ! ! ! Permission to use, copy, distribute and modify this software ! ! for any purpose with or without fee is hereby granted. We ! ! request, however, that all derived work reference the NAS ! ! Parallel Benchmarks 2.3. This software is provided "as is" ! ! without express or implied warranty. ! ! ! ! Information on NPB 2.3, including the technical report, the ! ! original specifications, source code, results and information ! ! on how to submit new results, is available at: ! ! ! ! http://www.nas.nasa.gov/NAS/NPB/ ! ! ! ! Send comments or suggestions to npb@nas.nasa.gov ! ! Send bug reports to npb-bugs@nas.nasa.gov ! ! ! ! NAS Parallel Benchmarks Group ! ! NASA Ames Research Center ! ! Mail Stop: T27A-1 ! ! Moffett Field, CA 94035-1000 ! ! ! ! E-mail: npb@nas.nasa.gov ! ! Fax: (415) 604-3957 ! ! ! !-------------------------------------------------------------------------! c--------------------------------------------------------------------- c c Author: P. O. Frederickson c D. H. Bailey c A. C. Woo c--------------------------------------------------------------------- c--------------------------------------------------------------------- program EMBAR c--------------------------------------------------------------------- C c This is the serial version of the APP Benchmark 1, c the "embarassingly parallel" benchmark. c c c M is the Log_2 of the number of complex pairs of uniform (0, 1) random c numbers. MK is the Log_2 of the size of each batch of uniform random c numbers. MK can be set for convenience on a given system, since it does c not affect the results. implicit none include 'npbparams.h' double precision Mops, epsilon, a, s, t1, t2, t3, t4, x, x1, > x2, q, sx, sy, tm, an, tt, gc, dum(3) c > x2, q, sx, sy, tm, an, tt, gc, dum(3), c > timer_read integer mk, mm, nn, nk, nq, np, ierr, node, no_nodes, > i, ik, kk, l, k, nit, ierrcode, no_large_nodes, > np_add, k_offset, j logical verified, timers_enabled parameter (timers_enabled = .false.) c external randlc, timer_read double precision randlc, qq character*13 size parameter (mk = 16, mm = m - mk, nn = 2 ** mm, > nk = 2 ** mk, nq = 10, epsilon=1.d-8, > a = 1220703125.d0, s = 271828183.d0) common/storage/ x(2*nk), q(0:nq-1), qq(10000) data dum /1.d0, 1.d0, 1.d0/ c Because the size of the problem is too large to store in a 32-bit c integer for some classes, we put it into a string (for printing). c Have to strip off the decimal point put in there by the floating c point print statement (internal file) write(*, 1000) c write(size, '(f12.0)' ) 2.d0**(m+1) c do j =13,1,-1 c if (size(j:j) .eq. '.') size(j:j) = ' ' c end do c write (*,1001) size write(*,1001) 2.d0**(m+1) 1000 format(//,' NAS Parallel Benchmarks 2.3-serial version', > ' - EP Benchmark', /) c 1001 format(' Number of random numbers generated: ', a14) 1001 format(' Number of random numbers generated: ', f12.0) 1003 format(' Number of active processes: ', i12, /) verified = .false. c Compute the number of "batches" of random number pairs generated c per processor. Adjust if the number of processors does not evenly c divide the total number np = nn c Call the random number generator functions and initialize c the x-array to reduce the effects of paging on the timings. c Also, call all mathematical functions that are used. Make c sure these initializations cannot be eliminated as dead code. call vranlc(0, dum(1), dum(2), dum(3)) dum(1) = randlc(dum(2), dum(3)) do 5 i = 1, 2*nk x(i) = -1.d99 5 continue Mops = log(sqrt(abs(max(1.d0,1.d0)))) c call timer_clear(1) c call timer_clear(2) c call timer_clear(3) c call timer_start(1) call vranlc(0, t1, a, x) c Compute AN = A ^ (2 * NK) (mod 2^46). t1 = a do 100 i = 1, mk + 1 t2 = randlc(t1, t1) 100 continue an = t1 tt = s gc = 0.d0 sx = 0.d0 sy = 0.d0 do 110 i = 0, nq - 1 q(i) = 0.d0 110 continue c Each instance of this loop may be performed independently. We compute c the k offsets separately to take into account the fact that some nodes c have more numbers to generate than others k_offset = -1 do 150 k = 1, np kk = k_offset + k t1 = s t2 = an c Find starting seed t1 for this kk. do 120 i = 1, 100 ik = kk / 2 if (2 * ik .ne. kk) t3 = randlc(t1, t2) if (ik .eq. 0) goto 130 t3 = randlc(t2, t2) kk = ik 120 continue c Compute uniform pseudorandom numbers. 130 continue c if (timers_enabled) call timer_start(3) call vranlc(2 * nk, t1, a, x) c if (timers_enabled) call timer_stop(3) c Compute Gaussian deviates by acceptance-rejection method and c tally counts in concentric square annuli. This loop is not c vectorizable. c if (timers_enabled) call timer_start(2) do 140 i = 1, nk x1 = 2.d0 * x(2*i-1) - 1.d0 x2 = 2.d0 * x(2*i) - 1.d0 t1 = x1 ** 2 + x2 ** 2 if (t1 .le. 1.d0) then t2 = sqrt(-2.d0 * log(t1) / t1) t3 = (x1 * t2) t4 = (x2 * t2) l = max(abs(t3), abs(t4)) q(l) = q(l) + 1.d0 sx = sx + t3 sy = sy + t4 endif 140 continue c if (timers_enabled) call timer_stop(2) 150 continue do 160 i = 0, nq - 1 gc = gc + q(i) 160 continue c call timer_stop(1) c tm = timer_read(1) tm = 1.0 nit=0 if (m.eq.24) then if((abs((sx- (-3.247834652034740D3))/sx).le.epsilon).and. > (abs((sy- (-6.958407078382297D3))/sy).le.epsilon)) > verified = .TRUE. elseif (m.eq.25) then if ((abs((sx- (-2.863319731645753D+03))/sx).le.epsilon).and. > (abs((sy- (-6.320053679109499D+03))/sy).le.epsilon)) > verified = .TRUE. elseif (m.eq.28) then if ((abs((sx- (-4.295875165629892D3))/sx).le.epsilon).and. > (abs((sy- (-1.580732573678431D4))/sy).le.epsilon)) > verified = .TRUE. elseif (m.eq.30) then if ((abs((sx- (4.033815542441498D4))/sx).le.epsilon).and. > (abs((sy- (-2.660669192809235D4))/sy).le.epsilon)) > verified = .true. elseif (m.eq.32) then if ((abs((sx- (4.764367927995374D+04))/sx).le.epsilon).and. > (abs((sy- (-8.084072988043731D+04))/sy).le.epsilon)) > verified = .true. endif Mops = 2.d0**(m+1)/tm/1000000.d0 write (6,11) tm, m, gc, sx, sy, (i, q(i), i = 0, nq - 1) 11 format ('EP Benchmark Results:'//'CPU Time =',f10.4/'N = 2^', > i5/'No. Gaussian Pairs =',f15.0/'Sums = ',1p,2d25.15/ > 'Counts:'/(i3,0p,f15.0)) if(verified) then write (6,*) ' VERIFICATION SUCCESSFUL ' else write (6,*) ' VERIFICATION FAILED ' endif c call print_results('EP', class, m+1, 0, 0, nit, c > tm, Mops, c > 'Random numbers generated', c > verified, npbversion, compiletime, cs1, c > cs2, cs3, cs4, cs5, cs6, cs7) c c if (timers_enabled) then c print *, 'Total time: ', timer_read(1) c print *, 'Gaussian pairs: ', timer_read(2) c print *, 'Random numbers: ', timer_read(3) c endif c end c--------------------------------------------------------------------- c--------------------------------------------------------------------- double precision function randlc (x, a) c--------------------------------------------------------------------- c--------------------------------------------------------------------- c--------------------------------------------------------------------- c c This routine returns a uniform pseudorandom double precision number in the c range (0, 1) by using the linear congruential generator c c x_{k+1} = a x_k (mod 2^46) c c where 0 < x_k < 2^46 and 0 < a < 2^46. This scheme generates 2^44 numbers c before repeating. The argument A is the same as 'a' in the above formula, c and X is the same as x_0. A and X must be odd double precision integers c in the range (1, 2^46). The returned value RANDLC is normalized to be c between 0 and 1, i.e. RANDLC = 2^(-46) * x_1. X is updated to contain c the new seed x_1, so that subsequent calls to RANDLC using the same c arguments will generate a continuous sequence. c c This routine should produce the same results on any computer with at least c 48 mantissa bits in double precision floating point data. On 64 bit c systems, double precision should be disabled. c c David H. Bailey October 26, 1990 c c--------------------------------------------------------------------- implicit none double precision r23,r46,t23,t46,a,x,t1,t2,t3,t4,a1,a2,x1,x2,z parameter (r23 = 0.5d0 ** 23, r46 = r23 ** 2, t23 = 2.d0 ** 23, > t46 = t23 ** 2) c--------------------------------------------------------------------- c Break A into two parts such that A = 2^23 * A1 + A2. c--------------------------------------------------------------------- t1 = r23 * a a1 = int (t1) a2 = a - t23 * a1 c--------------------------------------------------------------------- c Break X into two parts such that X = 2^23 * X1 + X2, compute c Z = A1 * X2 + A2 * X1 (mod 2^23), and then c X = 2^23 * Z + A2 * X2 (mod 2^46). c--------------------------------------------------------------------- t1 = r23 * x x1 = int (t1) x2 = x - t23 * x1 t1 = a1 * x2 + a2 * x1 t2 = int (r23 * t1) z = t1 - t23 * t2 t3 = t23 * z + a2 * x2 t4 = int (r46 * t3) x = t3 - t46 * t4 randlc = r46 * x return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine vranlc (n, x, a, y) c--------------------------------------------------------------------- c--------------------------------------------------------------------- c--------------------------------------------------------------------- c c This routine generates N uniform pseudorandom double precision numbers in c the range (0, 1) by using the linear congruential generator c c x_{k+1} = a x_k (mod 2^46) c c where 0 < x_k < 2^46 and 0 < a < 2^46. This scheme generates 2^44 numbers c before repeating. The argument A is the same as 'a' in the above formula, c and X is the same as x_0. A and X must be odd double precision integers c in the range (1, 2^46). The N results are placed in Y and are normalized c to be between 0 and 1. X is updated to contain the new seed, so that c subsequent calls to VRANLC using the same arguments will generate a c continuous sequence. If N is zero, only initialization is performed, and c the variables X, A and Y are ignored. c c This routine is the standard version designed for scalar or RISC systems. c However, it should produce the same results on any single processor c computer with at least 48 mantissa bits in double precision floating point c data. On 64 bit systems, double precision should be disabled. c c--------------------------------------------------------------------- implicit none integer i,n double precision y,r23,r46,t23,t46,a,x,t1,t2,t3,t4,a1,a2,x1,x2,z dimension y(*) parameter (r23 = 0.5d0 ** 23, r46 = r23 ** 2, t23 = 2.d0 ** 23, > t46 = t23 ** 2) c--------------------------------------------------------------------- c Break A into two parts such that A = 2^23 * A1 + A2. c--------------------------------------------------------------------- t1 = r23 * a a1 = int (t1) a2 = a - t23 * a1 c--------------------------------------------------------------------- c Generate N results. This loop is not vectorizable. c--------------------------------------------------------------------- do i = 1, n c--------------------------------------------------------------------- c Break X into two parts such that X = 2^23 * X1 + X2, compute c Z = A1 * X2 + A2 * X1 (mod 2^23), and then c X = 2^23 * Z + A2 * X2 (mod 2^46). c--------------------------------------------------------------------- t1 = r23 * x x1 = int (t1) x2 = x - t23 * x1 t1 = a1 * x2 + a2 * x1 t2 = int (r23 * t1) z = t1 - t23 * t2 t3 = t23 * z + a2 * x2 t4 = int (r46 * t3) x = t3 - t46 * t4 y(i) = r46 * x enddo return end