Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/coarray_36.f @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/coarray_36.f Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,347 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib" } +! +! PR fortran/64771 +! +! Contributed by Alessandro Fanfarill +! +! Reduced version of the full NAS CG benchmark +! + +!-------------------------------------------------------------------------! +! ! +! N A S P A R A L L E L B E N C H M A R K S 3.3 ! +! ! +! C G ! +! ! +!-------------------------------------------------------------------------! +! ! +! This benchmark is part of the NAS Parallel Benchmark 3.3 suite. ! +! It is described in NAS Technical Reports 95-020 and 02-007 ! +! ! +! 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 3.3. This software is provided "as is" ! +! without express or implied warranty. ! +! ! +! Information on NPB 3.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/Software/NPB/ ! +! ! +! Send comments or suggestions to npb@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: (650) 604-3957 ! +! ! +!-------------------------------------------------------------------------! + + +c--------------------------------------------------------------------- +c +c Authors: M. Yarrow +c C. Kuszmaul +c R. F. Van der Wijngaart +c H. Jin +c +c--------------------------------------------------------------------- + + +c--------------------------------------------------------------------- +c--------------------------------------------------------------------- + program cg +c--------------------------------------------------------------------- +c--------------------------------------------------------------------- + implicit none + + integer na, nonzer, niter + double precision shift, rcond + parameter( na=75000, + > nonzer=13, + > niter=75, + > shift=60., + > rcond=1.0d-1 ) + + + + integer num_proc_rows, num_proc_cols + parameter( num_proc_rows = 2, num_proc_cols = 2) + integer num_procs + parameter( num_procs = num_proc_cols * num_proc_rows ) + + integer nz + parameter( nz = na*(nonzer+1)/num_procs*(nonzer+1)+nonzer + > + na*(nonzer+2+num_procs/256)/num_proc_cols ) + + common / partit_size / naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + integer naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + + + common / main_int_mem / colidx, rowstr, + > iv, arow, acol + integer colidx(nz), rowstr(na+1), + > iv(2*na+1), arow(nz), acol(nz) + + +c--------------------------------- +c Coarray Decalarations +c--------------------------------- + double precision v(na+1)[0:*], aelt(nz)[0:*], a(nz)[0:*], + > x(na/num_proc_rows+2)[0:*], + > z(na/num_proc_rows+2)[0:*], + > p(na/num_proc_rows+2)[0:*], + > q(na/num_proc_rows+2)[0:*], + > r(na/num_proc_rows+2)[0:*], + > w(na/num_proc_rows+2)[0:*] + + + common /urando/ amult, tran + double precision amult, tran + + + + integer l2npcols + integer reduce_exch_proc(num_proc_cols) + integer reduce_send_starts(num_proc_cols) + integer reduce_send_lengths(num_proc_cols) + integer reduce_recv_lengths(num_proc_cols) + integer reduce_rrecv_starts(num_proc_cols) +c--------------------------------- +c Coarray Decalarations +c--------------------------------- + integer reduce_recv_starts(num_proc_cols)[0:*] + + integer i, j, k, it, me, nprocs, root + + double precision zeta, randlc + external randlc + double precision rnorm +c--------------------------------- +c Coarray Decalarations +c--------------------------------- + double precision norm_temp1(2)[0:*], norm_temp2(2)[0:*] + + double precision t, tmax, mflops + double precision u(1), umax(1) + external timer_read + double precision timer_read + character class + logical verified + double precision zeta_verify_value, epsilon, err + +c--------------------------------------------------------------------- +c Explicit interface for conj_grad, due to coarray args +c--------------------------------------------------------------------- + interface + + subroutine conj_grad ( colidx, + > rowstr, + > x, + > z, + > a, + > p, + > q, + > r, + > w, + > rnorm, + > l2npcols, + > reduce_exch_proc, + > reduce_send_starts, + > reduce_send_lengths, + > reduce_recv_starts, + > reduce_recv_lengths, + > reduce_rrecv_starts ) + + common / partit_size / naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + + integer naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + + double precision x(*), + > z(*), + > a(nzz) + integer colidx(nzz), rowstr(naa+1) + + double precision p(*), + > q(*)[0:*], + > r(*)[0:*], + > w(*)[0:*] ! used as work temporary + + integer l2npcols + integer reduce_exch_proc(l2npcols) + integer reduce_send_starts(l2npcols) + integer reduce_send_lengths(l2npcols) + integer reduce_recv_starts(l2npcols)[0:*] + integer reduce_recv_lengths(l2npcols) + integer reduce_rrecv_starts(l2npcols) + + double precision rnorm + + end subroutine + + end interface + +c--------------------------------------------------------------------- +c The call to the conjugate gradient routine: +c--------------------------------------------------------------------- + call conj_grad ( colidx, + > rowstr, + > x, + > z, + > a, + > p, + > q, + > r, + > w, + > rnorm, + > l2npcols, + > reduce_exch_proc, + > reduce_send_starts, + > reduce_send_lengths, + > reduce_recv_starts, + > reduce_recv_lengths, + > reduce_rrecv_starts ) + + + sync all + + end ! end main + +c--------------------------------------------------------------------- +c--------------------------------------------------------------------- + subroutine conj_grad ( colidx, + > rowstr, + > x, + > z, + > a, + > p, + > q, + > r, + > w, + > rnorm, + > l2npcols, + > reduce_exch_proc, + > reduce_send_starts, + > reduce_send_lengths, + > reduce_recv_starts, + > reduce_recv_lengths, + > reduce_rrecv_starts ) +c--------------------------------------------------------------------- +c--------------------------------------------------------------------- + +c--------------------------------------------------------------------- +c Floaging point arrays here are named as in NPB1 spec discussion of +c CG algorithm +c--------------------------------------------------------------------- + + implicit none + +c include 'cafnpb.h' + + common / partit_size / naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + integer naa, nzz, + > npcols, nprows, + > proc_col, proc_row, + > firstrow, + > lastrow, + > firstcol, + > lastcol, + > exch_proc, + > exch_recv_length, + > send_start, + > send_len + + + + double precision x(*), + > z(*), + > a(nzz) + integer colidx(nzz), rowstr(naa+1) + + double precision p(*), + > q(*)[0:*], + > r(*)[0:*], + > w(*)[0:*] ! used as work temporary + + integer l2npcols + integer reduce_exch_proc(l2npcols) + integer reduce_send_starts(l2npcols) + integer reduce_send_lengths(l2npcols) + integer reduce_recv_starts(l2npcols)[0:*] + integer reduce_recv_lengths(l2npcols) + integer reduce_rrecv_starts(l2npcols) + + integer recv_start_idx, recv_end_idx, send_start_idx, + > send_end_idx, recv_length + + integer i, j, k, ierr + integer cgit, cgitmax + + double precision, save :: d[0:*], rho[0:*] + double precision sum, rho0, alpha, beta, rnorm + + external timer_read + double precision timer_read + + data cgitmax / 25 / + + + return + end ! end of routine conj_grad +