| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| |
| subroutine setup_btio |
| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| |
| include 'header.h' |
| include 'mpinpb.h' |
| |
| character*(128) newfilenm |
| integer m, ierr |
| |
| if (node.eq.root) record_length = 40/fortran_rec_sz |
| call mpi_bcast(record_length, 1, MPI_INTEGER, |
| > root, comm_setup, ierr) |
| |
| open (unit=99, file=filenm, |
| $ form='unformatted', access='direct', |
| $ recl=record_length) |
| |
| 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 ix, jio, kio, cio |
| |
| do cio=1,ncells |
| do kio=0, cell_size(3,cio)-1 |
| do jio=0, cell_size(2,cio)-1 |
| iseek=(cell_low(1,cio) + |
| $ PROBLEM_SIZE*((cell_low(2,cio)+jio) + |
| $ PROBLEM_SIZE*((cell_low(3,cio)+kio) + |
| $ PROBLEM_SIZE*idump_sub))) |
| |
| do ix=0,cell_size(1,cio)-1 |
| write(99, rec=iseek+ix+1) |
| $ u(1,ix, jio,kio,cio), |
| $ u(2,ix, jio,kio,cio), |
| $ u(3,ix, jio,kio,cio), |
| $ u(4,ix, jio,kio,cio), |
| $ u(5,ix, jio,kio,cio) |
| enddo |
| 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 ix, jio, kio, cio, ii, m, ichunk |
| 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=(cell_low(1,cio) + |
| $ PROBLEM_SIZE*((cell_low(2,cio)+jio) + |
| $ PROBLEM_SIZE*((cell_low(3,cio)+kio) + |
| $ PROBLEM_SIZE*ii))) |
| |
| |
| do ix=0,cell_size(1,cio)-1 |
| read(99, rec=iseek+ix+1) |
| $ u(1,ix, jio,kio,cio), |
| $ u(2,ix, jio,kio,cio), |
| $ u(3,ix, jio,kio,cio), |
| $ u(4,ix, jio,kio,cio), |
| $ u(5,ix, jio,kio,cio) |
| enddo |
| 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--------------------------------------------------------------------- |
| |
| close(unit=99) |
| |
| return |
| end |
| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| |
| subroutine accumulate_norms(xce_acc) |
| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| include 'header.h' |
| include 'mpinpb.h' |
| |
| double precision xce_acc(5) |
| integer m |
| |
| if (rd_interval .gt. 0) goto 20 |
| |
| open (unit=99, file=filenm, |
| $ form='unformatted', access='direct', |
| $ recl=record_length) |
| |
| c clear the last time step |
| |
| call clear_timestep |
| |
| c read back the time steps and accumulate norms |
| |
| call acc_sub_norms(idump) |
| |
| close(unit=99) |
| |
| 20 continue |
| do m = 1, 5 |
| xce_acc(m) = xce_sub(m) / dble(idump) |
| end do |
| |
| return |
| end |
