examples/smpi/NAS/BT/bt.f

   1 !-------------------------------------------------------------------------!
   2 !                                                                         !
   3 !        N  A  S     P A R A L L E L     B E N C H M A R K S  3.3         !
   4 !                                                                         !
   5 !                                   B T                                   !
   6 !                                                                         !
   7 !-------------------------------------------------------------------------!
   8 !                                                                         !
   9 !    This benchmark is part of the NAS Parallel Benchmark 3.3 suite.      !
  10 !    It is described in NAS Technical Reports 95-020 and 02-007.          !
  11 !                                                                         !
  12 !    Permission to use, copy, distribute and modify this software         !
  13 !    for any purpose with or without fee is hereby granted.  We           !
  14 !    request, however, that all derived work reference the NAS            !
  15 !    Parallel Benchmarks 3.3. This software is provided "as is"           !
  16 !    without express or implied warranty.                                 !
  17 !                                                                         !
  18 !    Information on NPB 3.3, including the technical report, the          !
  19 !    original specifications, source code, results and information        !
  20 !    on how to submit new results, is available at:                       !
  21 !                                                                         !
  22 !           http://www.nas.nasa.gov/Software/NPB/                         !
  23 !                                                                         !
  24 !    Send comments or suggestions to  npb@nas.nasa.gov                    !
  25 !                                                                         !
  26 !          NAS Parallel Benchmarks Group                                  !
  27 !          NASA Ames Research Center                                      !
  28 !          Mail Stop: T27A-1                                              !
  29 !          Moffett Field, CA   94035-1000                                 !
  30 !                                                                         !
  31 !          E-mail:  npb@nas.nasa.gov                                      !
  32 !          Fax:     (650) 604-3957                                        !
  33 !                                                                         !
  34 !-------------------------------------------------------------------------!
  35
  36 c---------------------------------------------------------------------
  37 c
  38 c Authors: R. F. Van der Wijngaart
  39 c          T. Harris
  40 c          M. Yarrow
  41 c
  42 c---------------------------------------------------------------------
  43
  44 c---------------------------------------------------------------------
  45        program MPBT
  46 c---------------------------------------------------------------------
  47
  48        include  'header.h'
  49        include  'mpinpb.h'
  50
  51        integer i, niter, step, c, error, fstatus
  52        double precision navg, mflops, mbytes, n3
  53
  54        external timer_read
  55        double precision t, tmax, tiominv, tpc, timer_read
  56        logical verified
  57        character class, cbuff*40
  58
  59        integer wr_interval
  60
  61        call setup_mpi
  62        if (.not. active) goto 999
  63
  64 c---------------------------------------------------------------------
  65 c      Root node reads input file (if it exists) else takes
  66 c      defaults from parameters
  67 c---------------------------------------------------------------------
  68        if (node .eq. root) then
  69
  70           write(*, 1000)
  71           open (unit=2,file='inputbt.data',status='old', iostat=fstatus)
  72 c
  73           rd_interval = 0
  74           if (fstatus .eq. 0) then
  75             write(*,233)
  76  233        format(' Reading from input file inputbt.data')
  77             read (2,*) niter
  78             read (2,*) dt
  79             read (2,*) grid_points(1), grid_points(2), grid_points(3)
  80             if (iotype .ne. 0) then
  81                 read (2,'(A)') cbuff
  82                 read (cbuff,*,iostat=i) wr_interval, rd_interval
  83                 if (i .ne. 0) rd_interval = 0
  84                 if (wr_interval .le. 0) wr_interval = wr_default
  85             endif
  86             if (iotype .eq. 1) then
  87                 read (2,*) collbuf_nodes, collbuf_size
  88                 write(*,*) 'collbuf_nodes ', collbuf_nodes
  89                 write(*,*) 'collbuf_size  ', collbuf_size
  90             endif
  91             close(2)
  92           else
  93             write(*,234)
  94             niter = niter_default
  95             dt    = dt_default
  96             grid_points(1) = problem_size
  97             grid_points(2) = problem_size
  98             grid_points(3) = problem_size
  99             wr_interval = wr_default
 100             if (iotype .eq. 1) then
 101 c             set number of nodes involved in collective buffering to 4,
 102 c             unless total number of nodes is smaller than that.
 103 c             set buffer size for collective buffering to 1MB per node
 104 c             collbuf_nodes = min(4,no_nodes)
 105 c             set default to No-File-Hints with a value of 0
 106               collbuf_nodes = 0
 107               collbuf_size = 1000000
 108             endif
 109           endif
 110  234      format(' No input file inputbt.data. Using compiled defaults')
 111
 112           write(*, 1001) grid_points(1), grid_points(2), grid_points(3)
 113           write(*, 1002) niter, dt
 114           if (no_nodes .ne. total_nodes) write(*, 1004) total_nodes
 115           if (no_nodes .ne. maxcells*maxcells)
 116      >        write(*, 1005) maxcells*maxcells
 117           write(*, 1003) no_nodes
 118
 119           if (iotype .eq. 1) write(*, 1006) 'FULL MPI-IO', wr_interval
 120           if (iotype .eq. 2) write(*, 1006) 'SIMPLE MPI-IO', wr_interval
 121           if (iotype .eq. 3) write(*, 1006) 'EPIO', wr_interval
 122           if (iotype .eq. 4) write(*, 1006) 'FORTRAN IO', wr_interval
 123
 124  1000 format(//, ' NAS Parallel Benchmarks 3.3 -- BT Benchmark ',/)
 125  1001     format(' Size: ', i4, 'x', i4, 'x', i4)
 126  1002     format(' Iterations: ', i4, '    dt: ', F11.7)
 127  1004     format(' Total number of processes: ', i5)
 128  1005     format(' WARNING: compiled for ', i5, ' processes ')
 129  1003     format(' Number of active processes: ', i5, /)
 130  1006     format(' BTIO -- ', A, ' write interval: ', i3 /)
 131
 132        endif
 133
 134        call mpi_bcast(niter, 1, MPI_INTEGER,
 135      >                root, comm_setup, error)
 136
 137        call mpi_bcast(dt, 1, dp_type,
 138      >                root, comm_setup, error)
 139
 140        call mpi_bcast(grid_points(1), 3, MPI_INTEGER,
 141      >                root, comm_setup, error)
 142
 143        call mpi_bcast(wr_interval, 1, MPI_INTEGER,
 144      >                root, comm_setup, error)
 145
 146        call mpi_bcast(rd_interval, 1, MPI_INTEGER,
 147      >                root, comm_setup, error)
 148
 149        call make_set
 150
 151        do  c = 1, maxcells
 152           if ( (cell_size(1,c) .gt. IMAX) .or.
 153      >         (cell_size(2,c) .gt. JMAX) .or.
 154      >         (cell_size(3,c) .gt. KMAX) ) then
 155              print *,node, c, (cell_size(i,c),i=1,3)
 156              print *,' Problem size too big for compiled array sizes'
 157              goto 999
 158           endif
 159        end do
 160
 161        call set_constants
 162
 163        call initialize
 164
 165        call setup_btio
 166        idump = 0
 167
 168        call lhsinit
 169
 170        call exact_rhs
 171
 172        call compute_buffer_size(5)
 173
 174 c---------------------------------------------------------------------
 175 c      do one time step to touch all code, and reinitialize
 176 c---------------------------------------------------------------------
 177        call adi
 178        call initialize
 179
 180        call timer_clear(2)
 181
 182 c---------------------------------------------------------------------
 183 c      Synchronize before placing time stamp
 184 c---------------------------------------------------------------------
 185        call mpi_barrier(comm_setup, error)
 186
 187        call timer_clear(1)
 188        call timer_start(1)
 189
 190        do  step = 1, niter
 191
 192           if (node .eq. root) then
 193              if (mod(step, 20) .eq. 0 .or. step .eq. niter .or.
 194      >           step .eq. 1) then
 195                 write(*, 200) step
 196  200            format(' Time step ', i4)
 197              endif
 198           endif
 199
 200           call adi
 201
 202           if (iotype .ne. 0) then
 203               call timer_start(2)
 204               if (mod(step, wr_interval).eq.0 .or. step .eq. niter) then
 205                   if (node .eq. root) then
 206                       print *, 'Writing data set, time step', step
 207                   endif
 208                   if (step .eq. niter .and. rd_interval .gt. 1) then
 209                       rd_interval = 1
 210                   endif
 211                   call output_timestep
 212                   idump = idump + 1
 213               endif
 214               call timer_stop(2)
 215           endif
 216        end do
 217
 218        call btio_cleanup
 219
 220        call timer_stop(1)
 221        t = timer_read(1)
 222
 223        call verify(niter, class, verified)
 224
 225        call mpi_reduce(t, tmax, 1,
 226      >                 dp_type, MPI_MAX,
 227      >                 root, comm_setup, error)
 228
 229        if (iotype .ne. 0) then
 230           t = timer_read(2)
 231           if (t .ne. 0.d0) t = 1.0d0 / t
 232           call mpi_reduce(t, tiominv, 1,
 233      >                    dp_type, MPI_SUM,
 234      >                    root, comm_setup, error)
 235        endif
 236
 237        if( node .eq. root ) then
 238           n3 = 1.0d0*grid_points(1)*grid_points(2)*grid_points(3)
 239           navg = (grid_points(1)+grid_points(2)+grid_points(3))/3.0
 240           if( tmax .ne. 0. ) then
 241              mflops = 1.0e-6*float(niter)*
 242      >     (3478.8*n3-17655.7*navg**2+28023.7*navg)
 243      >     / tmax
 244           else
 245              mflops = 0.0
 246           endif
 247
 248           if (iotype .ne. 0) then
 249              mbytes = n3 * 40.0 * idump * 1.0d-6
 250              tiominv = tiominv / no_nodes
 251              t = 0.0
 252              if (tiominv .ne. 0.) t = 1.d0 / tiominv
 253              tpc = 0.0
 254              if (tmax .ne. 0.) tpc = t * 100.0 / tmax
 255              write(*,1100) t, tpc, mbytes, mbytes*tiominv
 256  1100        format(/' BTIO -- statistics:'/
 257      >               '   I/O timing in seconds   : ', f14.2/
 258      >               '   I/O timing percentage   : ', f14.2/
 259      >               '   Total data written (MB) : ', f14.2/
 260      >               '   I/O data rate  (MB/sec) : ', f14.2)
 261           endif
 262
 263          call print_results('BT', class, grid_points(1),
 264      >     grid_points(2), grid_points(3), niter, maxcells*maxcells,
 265      >     total_nodes, tmax, mflops, '          floating point',
 266      >     verified, npbversion,compiletime, cs1, cs2, cs3, cs4, cs5,
 267      >     cs6, '(none)')
 268        endif
 269
 270  999   continue
 271        call mpi_barrier(MPI_COMM_WORLD, error)
 272        call mpi_finalize(error)
 273
 274        end
 275