| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| |
| subroutine setup_btio |
| |
| c--------------------------------------------------------------------- |
| c--------------------------------------------------------------------- |
| |
| include 'header.h' |
| include 'mpinpb.h' |
| |
| character*(128) newfilenm |
| integer m |
| |
| if (node .lt. 10000) then |
| write (newfilenm, 996) filenm,node |
| else |
| print *, 'error generating file names (> 10000 nodes)' |
| stop |
| endif |
| |
| 996 format (a,'.',i4.4) |
| |
| open (unit=99, file=newfilenm, form='unformatted', |
| $ status='unknown') |
| |
| 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, iio, jio, kio, cio, aio |
| |
| do cio=1,ncells |
| write(99) |
| $ ((((u(aio,ix, jio,kio,cio),aio=1,5), |
| $ ix=0, cell_size(1,cio)-1), |
| $ jio=0, cell_size(2,cio)-1), |
| $ kio=0, cell_size(3,cio)-1) |
| enddo |
| |
| idump_sub = idump_sub + 1 |
| if (rd_interval .gt. 0) then |
| if (idump_sub .ge. rd_interval) then |
| |
| rewind(99) |
| call acc_sub_norms(idump+1) |
| |
| rewind(99) |
| 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 |
| read(99) |
| $ ((((u(m,ix, jio,kio,cio),m=1,5), |
| $ ix=0, cell_size(1,cio)-1), |
| $ jio=0, cell_size(2,cio)-1), |
| $ kio=0, cell_size(3,cio)-1) |
| 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) |
| |
| character*(128) newfilenm |
| integer m |
| |
| if (rd_interval .gt. 0) goto 20 |
| |
| if (node .lt. 10000) then |
| write (newfilenm, 996) filenm,node |
| else |
| print *, 'error generating file names (> 10000 nodes)' |
| stop |
| endif |
| |
| 996 format (a,'.',i4.4) |
| |
| open (unit=99, file=newfilenm, |
| $ form='unformatted') |
| |
| 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 |
