2 c---------------------------------------------------------------------
3 c---------------------------------------------------------------------
7 c---------------------------------------------------------------------
8 c---------------------------------------------------------------------
17 if (node .eq. root) then
18 call MPI_File_delete(filenm, MPI_INFO_NULL, ierr)
21 call MPI_Barrier(comm_solve, ierr)
23 call MPI_File_open(comm_solve,
25 $ MPI_MODE_RDWR + MPI_MODE_CREATE,
30 call MPI_File_set_view(fp,
31 $ iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION,
32 $ 'native', MPI_INFO_NULL, ierr)
34 if (ierr .ne. MPI_SUCCESS) then
35 print *, 'Error opening file'
48 c---------------------------------------------------------------------
49 c---------------------------------------------------------------------
51 subroutine output_timestep
53 c---------------------------------------------------------------------
54 c---------------------------------------------------------------------
58 integer count, jio, kio, cio, aio
60 integer mstatus(MPI_STATUS_SIZE)
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)))
70 count=5*cell_size(1,cio)
72 call MPI_File_write_at(fp, iseek,
74 $ count, MPI_DOUBLE_PRECISION,
77 if (ierr .ne. MPI_SUCCESS) then
78 print *, 'Error writing to file'
85 idump_sub = idump_sub + 1
86 if (rd_interval .gt. 0) then
87 if (idump_sub .ge. rd_interval) then
89 call acc_sub_norms(idump+1)
98 c---------------------------------------------------------------------
99 c---------------------------------------------------------------------
101 subroutine acc_sub_norms(idump_cur)
108 integer count, jio, kio, cio, ii, m, ichunk
110 integer mstatus(MPI_STATUS_SIZE)
111 double precision xce_single(5)
113 ichunk = idump_cur - idump_sub + 1
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) +
123 count=5*cell_size(1,cio)
125 call MPI_File_read_at(fp, iseek,
126 $ u(1,0,jio,kio,cio),
127 $ count, MPI_DOUBLE_PRECISION,
130 if (ierr .ne. MPI_SUCCESS) then
131 print *, 'Error reading back file'
132 call MPI_File_close(fp, ierr)
139 if (node .eq. root) print *, 'Reading data set ', ii+ichunk
141 call error_norm(xce_single)
143 xce_sub(m) = xce_sub(m) + xce_single(m)
150 c---------------------------------------------------------------------
151 c---------------------------------------------------------------------
153 subroutine btio_cleanup
155 c---------------------------------------------------------------------
156 c---------------------------------------------------------------------
163 call MPI_File_close(fp, ierr)
168 c---------------------------------------------------------------------
169 c---------------------------------------------------------------------
171 subroutine accumulate_norms(xce_acc)
173 c---------------------------------------------------------------------
174 c---------------------------------------------------------------------
179 double precision xce_acc(5)
182 if (rd_interval .gt. 0) goto 20
184 call MPI_File_open(comm_solve,
192 call MPI_File_set_view(fp,
193 $ iseek, MPI_DOUBLE_PRECISION, MPI_DOUBLE_PRECISION,
194 $ 'native', MPI_INFO_NULL, ierr)
196 c clear the last time step
200 c read back the time steps and accumulate norms
202 call acc_sub_norms(idump)
204 call MPI_File_close(fp, ierr)
208 xce_acc(m) = xce_sub(m) / dble(idump)