c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine setup_btio c--------------------------------------------------------------------- c--------------------------------------------------------------------- include 'header.h' include 'mpinpb.h' integer m, ierr iseek=0 if (node .eq. root) then call MPI_File_delete(filenm, MPI_INFO_NULL, ierr) endif call MPI_Barrier(comm_solve, ierr) call MPI_File_open(comm_solve, $ filenm, $ MPI_MODE_RDWR + MPI_MODE_CREATE, $ MPI_INFO_NULL, $ fp, $ ierr) call MPI_File_set_view(fp, $ iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION, $ 'native', MPI_INFO_NULL, ierr) if (ierr .ne. MPI_SUCCESS) then print *, 'Error opening file' stop endif do m = 1, 5 xce_sub(m) = 0.d0 end do idump_sub = 0 return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine output_timestep c--------------------------------------------------------------------- c--------------------------------------------------------------------- include 'header.h' include 'mpinpb.h' integer count, jio, kio, cio, aio integer ierr integer mstatus(MPI_STATUS_SIZE) do cio=1,ncells do kio=0, cell_size(3,cio)-1 do jio=0, cell_size(2,cio)-1 iseek=5*(cell_low(1,cio) + $ PROBLEM_SIZE*((cell_low(2,cio)+jio) + $ PROBLEM_SIZE*((cell_low(3,cio)+kio) + $ PROBLEM_SIZE*idump_sub))) count=5*cell_size(1,cio) call MPI_File_write_at(fp, iseek, $ u(1,0,jio,kio,cio), $ count, MPI_DOUBLE_PRECISION, $ mstatus, ierr) if (ierr .ne. MPI_SUCCESS) then print *, 'Error writing to file' stop endif enddo enddo enddo idump_sub = idump_sub + 1 if (rd_interval .gt. 0) then if (idump_sub .ge. rd_interval) then call acc_sub_norms(idump+1) idump_sub = 0 endif endif return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine acc_sub_norms(idump_cur) include 'header.h' include 'mpinpb.h' integer idump_cur integer count, jio, kio, cio, ii, m, ichunk integer ierr integer mstatus(MPI_STATUS_SIZE) double precision xce_single(5) ichunk = idump_cur - idump_sub + 1 do ii=0, idump_sub-1 do cio=1,ncells do kio=0, cell_size(3,cio)-1 do jio=0, cell_size(2,cio)-1 iseek=5*(cell_low(1,cio) + $ PROBLEM_SIZE*((cell_low(2,cio)+jio) + $ PROBLEM_SIZE*((cell_low(3,cio)+kio) + $ PROBLEM_SIZE*ii))) count=5*cell_size(1,cio) call MPI_File_read_at(fp, iseek, $ u(1,0,jio,kio,cio), $ count, MPI_DOUBLE_PRECISION, $ mstatus, ierr) if (ierr .ne. MPI_SUCCESS) then print *, 'Error reading back file' call MPI_File_close(fp, ierr) stop endif enddo enddo enddo if (node .eq. root) print *, 'Reading data set ', ii+ichunk call error_norm(xce_single) do m = 1, 5 xce_sub(m) = xce_sub(m) + xce_single(m) end do enddo return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine btio_cleanup c--------------------------------------------------------------------- c--------------------------------------------------------------------- include 'header.h' include 'mpinpb.h' integer ierr call MPI_File_close(fp, ierr) return end c--------------------------------------------------------------------- c--------------------------------------------------------------------- subroutine accumulate_norms(xce_acc) c--------------------------------------------------------------------- c--------------------------------------------------------------------- include 'header.h' include 'mpinpb.h' double precision xce_acc(5) integer m, ierr if (rd_interval .gt. 0) goto 20 call MPI_File_open(comm_solve, $ filenm, $ MPI_MODE_RDONLY, $ MPI_INFO_NULL, $ fp, $ ierr) iseek = 0 call MPI_File_set_view(fp, $ iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION, $ 'native', MPI_INFO_NULL, ierr) c clear the last time step call clear_timestep c read back the time steps and accumulate norms call acc_sub_norms(idump) call MPI_File_close(fp, ierr) 20 continue do m = 1, 5 xce_acc(m) = xce_sub(m) / dble(idump) end do return end