examples/smpi/NAS/BT/simple_mpiio.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4
   5       subroutine setup_btio
   6
   7 c---------------------------------------------------------------------
   8 c---------------------------------------------------------------------
   9
  10       include 'header.h'
  11       include 'mpinpb.h'
  12
  13       integer m, ierr
  14
  15       iseek=0
  16
  17       if (node .eq. root) then
  18           call MPI_File_delete(filenm, MPI_INFO_NULL, ierr)
  19       endif
  20
  21       call MPI_Barrier(comm_solve, ierr)
  22
  23       call MPI_File_open(comm_solve,
  24      $          filenm,
  25      $          MPI_MODE_RDWR + MPI_MODE_CREATE,
  26      $          MPI_INFO_NULL,
  27      $          fp,
  28      $          ierr)
  29
  30       call MPI_File_set_view(fp,
  31      $          iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION,
  32      $          'native', MPI_INFO_NULL, ierr)
  33
  34       if (ierr .ne. MPI_SUCCESS) then
  35           print *, 'Error opening file'
  36           stop
  37       endif
  38
  39       do m = 1, 5
  40          xce_sub(m) = 0.d0
  41       end do
  42
  43       idump_sub = 0
  44
  45       return
  46       end
  47
  48 c---------------------------------------------------------------------
  49 c---------------------------------------------------------------------
  50
  51       subroutine output_timestep
  52
  53 c---------------------------------------------------------------------
  54 c---------------------------------------------------------------------
  55       include 'header.h'
  56       include 'mpinpb.h'
  57
  58       integer count, jio, kio, cio, aio
  59       integer ierr
  60       integer mstatus(MPI_STATUS_SIZE)
  61
  62       do cio=1,ncells
  63           do kio=0, cell_size(3,cio)-1
  64               do jio=0, cell_size(2,cio)-1
  65                   iseek=5*(cell_low(1,cio) +
  66      $                   PROBLEM_SIZE*((cell_low(2,cio)+jio) +
  67      $                   PROBLEM_SIZE*((cell_low(3,cio)+kio) +
  68      $                   PROBLEM_SIZE*idump_sub)))
  69
  70                   count=5*cell_size(1,cio)
  71
  72                   call MPI_File_write_at(fp, iseek,
  73      $                  u(1,0,jio,kio,cio),
  74      $                  count, MPI_DOUBLE_PRECISION,
  75      $                  mstatus, ierr)
  76
  77                   if (ierr .ne. MPI_SUCCESS) then
  78                       print *, 'Error writing to file'
  79                       stop
  80                   endif
  81               enddo
  82           enddo
  83       enddo
  84
  85       idump_sub = idump_sub + 1
  86       if (rd_interval .gt. 0) then
  87          if (idump_sub .ge. rd_interval) then
  88
  89             call acc_sub_norms(idump+1)
  90
  91             idump_sub = 0
  92          endif
  93       endif
  94
  95       return
  96       end
  97
  98 c---------------------------------------------------------------------
  99 c---------------------------------------------------------------------
 100
 101       subroutine acc_sub_norms(idump_cur)
 102
 103       include 'header.h'
 104       include 'mpinpb.h'
 105
 106       integer idump_cur
 107
 108       integer count, jio, kio, cio, ii, m, ichunk
 109       integer ierr
 110       integer mstatus(MPI_STATUS_SIZE)
 111       double precision xce_single(5)
 112
 113       ichunk = idump_cur - idump_sub + 1
 114       do ii=0, idump_sub-1
 115         do cio=1,ncells
 116           do kio=0, cell_size(3,cio)-1
 117               do jio=0, cell_size(2,cio)-1
 118                   iseek=5*(cell_low(1,cio) +
 119      $                   PROBLEM_SIZE*((cell_low(2,cio)+jio) +
 120      $                   PROBLEM_SIZE*((cell_low(3,cio)+kio) +
 121      $                   PROBLEM_SIZE*ii)))
 122
 123                   count=5*cell_size(1,cio)
 124
 125                   call MPI_File_read_at(fp, iseek,
 126      $                  u(1,0,jio,kio,cio),
 127      $                  count, MPI_DOUBLE_PRECISION,
 128      $                  mstatus, ierr)
 129
 130                   if (ierr .ne. MPI_SUCCESS) then
 131                       print *, 'Error reading back file'
 132                       call MPI_File_close(fp, ierr)
 133                       stop
 134                   endif
 135               enddo
 136           enddo
 137         enddo
 138
 139         if (node .eq. root) print *, 'Reading data set ', ii+ichunk
 140
 141         call error_norm(xce_single)
 142         do m = 1, 5
 143            xce_sub(m) = xce_sub(m) + xce_single(m)
 144         end do
 145       enddo
 146
 147       return
 148       end
 149
 150 c---------------------------------------------------------------------
 151 c---------------------------------------------------------------------
 152
 153       subroutine btio_cleanup
 154
 155 c---------------------------------------------------------------------
 156 c---------------------------------------------------------------------
 157
 158       include 'header.h'
 159       include 'mpinpb.h'
 160
 161       integer ierr
 162
 163       call MPI_File_close(fp, ierr)
 164
 165       return
 166       end
 167
 168 c---------------------------------------------------------------------
 169 c---------------------------------------------------------------------
 170
 171       subroutine accumulate_norms(xce_acc)
 172
 173 c---------------------------------------------------------------------
 174 c---------------------------------------------------------------------
 175
 176       include 'header.h'
 177       include 'mpinpb.h'
 178
 179       double precision xce_acc(5)
 180       integer m, ierr
 181
 182       if (rd_interval .gt. 0) goto 20
 183
 184       call MPI_File_open(comm_solve,
 185      $          filenm,
 186      $          MPI_MODE_RDONLY,
 187      $          MPI_INFO_NULL,
 188      $          fp,
 189      $          ierr)
 190
 191       iseek = 0
 192       call MPI_File_set_view(fp,
 193      $          iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION,
 194      $          'native', MPI_INFO_NULL, ierr)
 195
 196 c     clear the last time step
 197
 198       call clear_timestep
 199
 200 c     read back the time steps and accumulate norms
 201
 202       call acc_sub_norms(idump)
 203
 204       call MPI_File_close(fp, ierr)
 205
 206  20   continue
 207       do m = 1, 5
 208          xce_acc(m) = xce_sub(m) / dble(idump)
 209       end do
 210
 211       return
 212       end
 213