Commit e77366ff authored by Francois Tessier's avatar Francois Tessier

Add a MPIIO-based TAPIOCA module in BT

parent 8604a22b
......@@ -38,6 +38,10 @@ exec: $(OBJS)
${MAKE} bt-full; \
elif [ x$(SUBTYPE) = xFULL ] ; then \
${MAKE} bt-full; \
elif [ x$(SUBTYPE) = xtapioca ] ; then \
${MAKE} bt-tapioca; \
elif [ x$(SUBTYPE) = xTAPIOCA ] ; then \
${MAKE} bt-tapioca; \
elif [ x$(SUBTYPE) = xsimple ] ; then \
${MAKE} bt-simple; \
elif [ x$(SUBTYPE) = xSIMPLE ] ; then \
......@@ -60,6 +64,9 @@ bt-bt: ${OBJS} btio.o
bt-full: ${OBJS} full_mpiio.o btio_common.o
${FLINK} ${FLINKFLAGS} -o ${PROGRAM}.mpi_io_full ${OBJS} btio_common.o full_mpiio.o ${FMPI_LIB}
bt-tapioca: ${OBJS} tapioca.o btio_common.o
${FLINK} ${FLINKFLAGS} -o ${PROGRAM}.tapioca ${OBJS} btio_common.o tapioca.o ${FMPI_LIB}
bt-simple: ${OBJS} simple_mpiio.o btio_common.o
${FLINK} ${FLINKFLAGS} -o ${PROGRAM}.mpi_io_simple ${OBJS} btio_common.o simple_mpiio.o ${FMPI_LIB}
......@@ -99,8 +106,10 @@ btio_common.o: btio_common.f mpinpb.h npbparams.h
fortran_io.o: fortran_io.f mpinpb.h npbparams.h
simple_mpiio.o: simple_mpiio.f mpinpb.h npbparams.h
full_mpiio.o: full_mpiio.f mpinpb.h npbparams.h
tapioca.o: tapioca.f mpinpb.h npbparams.h
epio.o: epio.f mpinpb.h npbparams.h
clean:
- rm -f *.o *~ mputil* common/*.o
- rm -f npbparams.h core btio.full.out
\ No newline at end of file
- rm -f npbparams.h core btio.full.out
- rm -f ${HOME}/install/${ARCHI}/bin/bt.*
\ No newline at end of file
......@@ -132,9 +132,10 @@ c set default to No-File-Hints with a value of 0
write(*, 1003) no_nodes
if (iotype .eq. 1) write(*, 1006) 'FULL MPI-IO', wr_interval
if (iotype .eq. 2) write(*, 1006) 'SIMPLE MPI-IO', wr_interval
if (iotype .eq. 3) write(*, 1006) 'EPIO', wr_interval
if (iotype .eq. 4) write(*, 1006) 'FORTRAN IO', wr_interval
if (iotype .eq. 2) write(*, 1006) 'TAPIOCA IO', wr_interval
if (iotype .eq. 3) write(*, 1006) 'SIMPLE MPI-IO', wr_interval
if (iotype .eq. 4) write(*, 1006) 'EPIO', wr_interval
if (iotype .eq. 5) write(*, 1006) 'FORTRAN IO', wr_interval
1000 format(//, ' NAS Parallel Benchmarks 3.3 -- BT Benchmark ',/)
1001 format(' Size: ', i4, 'x', i4, 'x', i4)
......
200 number of time steps
0.0001d0 dt for class A = 0.0008d0. class B = 0.0003d0 class C = 0.0001d0
162 162 162
5 0 write interval (optional read interval) for BTIO
2 4194304 number of nodes in collective buffering and buffer size for BTIO
......@@ -17,6 +17,7 @@ export TAPIOCA_PIPELINING=true
NPROCS=64
CLASS=C
IO=mpi_io_full
IO=tapioca
#IO=mpi_io_full
mpirun -f $COBALT_NODEFILE -n $NPROCS bt.${CLASS}.${NPROCS}.${IO}
......@@ -92,7 +92,7 @@ int ipow2(int i);
int isqrt2(int i);
enum benchmark_types {SP, BT, LU, MG, FT, IS, DT, EP, CG};
enum iotypes { NONE = 0, FULL, SIMPLE, EPIO, FORTRAN};
enum iotypes { NONE = 0, FULL, TAPIOCA, SIMPLE, EPIO, FORTRAN};
int main(int argc, char *argv[])
{
......@@ -186,6 +186,8 @@ void get_info(int argc, char *argv[], int *typep, int *nprocsp, char *classp,
} else {
if (!strcmp(argv[4], "full") || !strcmp(argv[4], "FULL")) {
*subtypep = FULL;
} else if (!strcmp(argv[4], "tapioca") || !strcmp(argv[4], "TAPIOCA")) {
*subtypep = TAPIOCA;
} else if (!strcmp(argv[4], "simple") || !strcmp(argv[4], "SIMPLE")) {
*subtypep = SIMPLE;
} else if (!strcmp(argv[4], "epio") || !strcmp(argv[4], "EPIO")) {
......@@ -327,6 +329,9 @@ void read_info(int type, int *nprocsp, char *classp, int *subtypep)
}
if (!strcmp(subtype_str, "full") || !strcmp(subtype_str, "FULL")) {
*subtypep = FULL;
} else if (!strcmp(subtype_str, "tapioca") ||
!strcmp(subtype_str, "TAPIOCA")) {
*subtypep = TAPIOCA;
} else if (!strcmp(subtype_str, "simple") ||
!strcmp(subtype_str, "SIMPLE")) {
*subtypep = SIMPLE;
......@@ -391,7 +396,7 @@ void read_info(int type, int *nprocsp, char *classp, int *subtypep)
void write_info(int type, int nprocs, char class, int subtype)
{
FILE *fp;
char *BT_TYPES[] = {"NONE", "FULL", "SIMPLE", "EPIO", "FORTRAN"};
char *BT_TYPES[] = {"NONE", "FULL", "TAPIOCA", "SIMPLE", "EPIO", "FORTRAN"};
fp = fopen(FILENAME, "w");
if (fp == NULL) {
......@@ -558,6 +563,9 @@ void write_bt_info(FILE *fp, int nprocs, char class, int io)
case FULL:
fprintf(fp, "%sparameter (filenm = trim(filepath)//'/btio.full.out')\n", FINDENT);
break;
case TAPIOCA:
fprintf(fp, "%sparameter (filenm = trim(filepath)//'/btio.tapioca.out')\n", FINDENT);
break;
case SIMPLE:
fprintf(fp, "%sparameter (filenm = trim(filepath)//'/btio.simple.out')\n", FINDENT);
break;
......
c---------------------------------------------------------------------
c---------------------------------------------------------------------
subroutine setup_btio
c---------------------------------------------------------------------
c---------------------------------------------------------------------
include 'header.h'
include 'mpinpb.h'
integer ierr
integer mstatus(MPI_STATUS_SIZE)
integer sizes(4), starts(4), subsizes(4)
integer cell_btype(maxcells), cell_ftype(maxcells)
integer cell_blength(maxcells)
integer info
character*20 cb_nodes, cb_size
integer c, m
integer cell_disp(maxcells)
call mpi_bcast(collbuf_nodes, 1, MPI_INTEGER,
> root, comm_setup, ierr)
call mpi_bcast(collbuf_size, 1, MPI_INTEGER,
> root, comm_setup, ierr)
if (collbuf_nodes .eq. 0) then
info = MPI_INFO_NULL
else
write (cb_nodes,*) collbuf_nodes
write (cb_size,*) collbuf_size
call MPI_Info_create(info, ierr)
call MPI_Info_set(info, 'cb_nodes', cb_nodes, ierr)
call MPI_Info_set(info, 'cb_buffer_size', cb_size, ierr)
call MPI_Info_set(info, 'collective_buffering', 'true', ierr)
endif
call MPI_Type_contiguous(5, MPI_DOUBLE_PRECISION,
$ element, ierr)
call MPI_Type_commit(element, ierr)
call MPI_Type_extent(element, eltext, ierr)
do c = 1, ncells
c
c Outer array dimensions ar same for every cell
c
sizes(1) = IMAX+4
sizes(2) = JMAX+4
sizes(3) = KMAX+4
c
c 4th dimension is cell number, total of maxcells cells
c
sizes(4) = maxcells
c
c Internal dimensions of cells can differ slightly between cells
c
subsizes(1) = cell_size(1, c)
subsizes(2) = cell_size(2, c)
subsizes(3) = cell_size(3, c)
c
c Cell is 4th dimension, 1 cell per cell type to handle varying
c cell sub-array sizes
c
subsizes(4) = 1
c
c type constructors use 0-based start addresses
c
starts(1) = 2
starts(2) = 2
starts(3) = 2
starts(4) = c-1
c
c Create buftype for a cell
c
call MPI_Type_create_subarray(4, sizes, subsizes,
$ starts, MPI_ORDER_FORTRAN, element,
$ cell_btype(c), ierr)
c
c block length and displacement for joining cells -
c 1 cell buftype per block, cell buftypes have own displacment
c generated from cell number (4th array dimension)
c
cell_blength(c) = 1
cell_disp(c) = 0
enddo
c
c Create combined buftype for all cells
c
call MPI_Type_struct(ncells, cell_blength, cell_disp,
$ cell_btype, combined_btype, ierr)
call MPI_Type_commit(combined_btype, ierr)
do c = 1, ncells
c
c Entire array size
c
sizes(1) = PROBLEM_SIZE
sizes(2) = PROBLEM_SIZE
sizes(3) = PROBLEM_SIZE
c
c Size of c'th cell
c
subsizes(1) = cell_size(1, c)
subsizes(2) = cell_size(2, c)
subsizes(3) = cell_size(3, c)
c
c Starting point in full array of c'th cell
c
starts(1) = cell_low(1,c)
starts(2) = cell_low(2,c)
starts(3) = cell_low(3,c)
call MPI_Type_create_subarray(3, sizes, subsizes,
$ starts, MPI_ORDER_FORTRAN,
$ element, cell_ftype(c), ierr)
cell_blength(c) = 1
cell_disp(c) = 0
enddo
call MPI_Type_struct(ncells, cell_blength, cell_disp,
$ cell_ftype, combined_ftype, ierr)
call MPI_Type_commit(combined_ftype, 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)
if (ierr .ne. MPI_SUCCESS) then
print *, 'Error opening file'
stop
endif
call MPI_File_set_view(fp, iseek, element,
$ combined_ftype, 'native', info, ierr)
if (ierr .ne. MPI_SUCCESS) then
print *, 'Error setting file view'
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 mstatus(MPI_STATUS_SIZE)
integer ierr
call MPI_File_write_at_all(fp, iseek, u,
$ 1, combined_btype, mstatus, ierr)
if (ierr .ne. MPI_SUCCESS) then
print *, 'Error writing to file'
stop
endif
call MPI_Type_size(combined_btype, iosize, ierr)
iseek = iseek + iosize/eltext
idump_sub = idump_sub + 1
if (rd_interval .gt. 0) then
if (idump_sub .ge. rd_interval) then
iseek = 0
call acc_sub_norms(idump+1)
iseek = 0
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 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
call MPI_File_read_at_all(fp, iseek, u,
$ 1, combined_btype, mstatus, ierr)
if (ierr .ne. MPI_SUCCESS) then
print *, 'Error reading back file'
call MPI_File_close(fp, ierr)
stop
endif
call MPI_Type_size(combined_btype, iosize, ierr)
iseek = iseek + iosize/eltext
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, element, combined_ftype,
$ '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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment