|
| 1 | +! |
| 2 | +! Copyright (C) 2012, Northwestern University and Argonne National Laboratory |
| 3 | +! See COPYRIGHT notice in top-level directory. |
| 4 | +! |
| 5 | +! $Id: column_wise.f90 2476 2016-09-06 01:05:33Z wkliao $ |
| 6 | + |
| 7 | +! This example makes a number of nonblocking API calls, each writes a single |
| 8 | +! row of a 2D integer array. Each process writes NY rows and any two |
| 9 | +! consecutive rows are of nprocs-row distance apart from each other. |
| 10 | +! In this case, the fileview of each process interleaves with all other processes. |
| 11 | +! If simply concatenating fileviews of all the nonblocking calls will result |
| 12 | +! in a fileview that violates the MPI-IO requirement on the fileview of which |
| 13 | +! flattened file offsets must be monotonically non-decreasing. PnetCDF handles |
| 14 | +! this case by breaking down each nonblocking call into a list of offset-length |
| 15 | +! pairs, merging the pairs across multiple nonblocking calls, and sorting |
| 16 | +! them into an increasing order. The sorted pairs are used to construct a |
| 17 | +! fileview that meets the monotonically non-decreasing offset requirement, |
| 18 | +! and thus the nonblocking requests can be serviced by a single MPI-IO call. |
| 19 | +! |
| 20 | +! The compile and run commands are given below, together with an ncmpidump of |
| 21 | +! the output file. Note ncdump is in C order (row major). |
| 22 | +! |
| 23 | +! % mpif90 -O2 -o column_wise column_wise.f90 -lpnetcdf |
| 24 | +! % mpiexec -n 4 ./column_wise /pvfs2/wkliao/testfile.nc |
| 25 | +! |
| 26 | +! % ncmpidump /pvfs2/wkliao/testfile.nc |
| 27 | +! netcdf testfile { |
| 28 | +! // file format: CDF-5 (big variables) |
| 29 | +! dimensions: |
| 30 | +! Y = 10 ; |
| 31 | +! X = 16 ; |
| 32 | +! variables: |
| 33 | +! int var(Y, X) ; |
| 34 | +! data: |
| 35 | +! |
| 36 | +! var = |
| 37 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 38 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 39 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 40 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 41 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 42 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 43 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 44 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 45 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, |
| 46 | +! 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3 ; |
| 47 | +! } |
| 48 | +! |
| 49 | + |
| 50 | +subroutine check(err, message) |
| 51 | + use mpi |
| 52 | + use pnetcdf |
| 53 | + implicit none |
| 54 | + integer err |
| 55 | + character(len=*) message |
| 56 | + |
| 57 | + ! It is a good idea to check returned value for possible error |
| 58 | + if (err .NE. NF90_NOERR) then |
| 59 | + write(6,*) trim(message), trim(nf90mpi_strerror(err)) |
| 60 | + call MPI_Abort(MPI_COMM_WORLD, -1, err) |
| 61 | + end if |
| 62 | +end subroutine check |
| 63 | + |
| 64 | +program main |
| 65 | + use mpi |
| 66 | + use pnetcdf |
| 67 | + implicit none |
| 68 | + |
| 69 | + integer NY, NX |
| 70 | + PARAMETER(NX=10, NY=4) |
| 71 | + |
| 72 | + character(LEN=256) filename, cmd |
| 73 | + integer i, rank, nprocs, err, num_reqs, ierr, get_args, dummy |
| 74 | + integer ncid, cmode, varid, dimid(2) |
| 75 | + integer buf(NX, NY) |
| 76 | + integer reqs(NY), sts(NY) |
| 77 | + integer(kind=MPI_OFFSET_KIND) G_NY, myOff, block_start, & |
| 78 | + block_len, global_nx |
| 79 | + integer(kind=MPI_OFFSET_KIND) start(2), count(2) |
| 80 | + integer(kind=MPI_OFFSET_KIND) malloc_size, sum_size |
| 81 | + logical verbose |
| 82 | + integer info |
| 83 | + |
| 84 | + call MPI_Init(err) |
| 85 | + call MPI_Comm_rank(MPI_COMM_WORLD, rank, err) |
| 86 | + call MPI_Comm_size(MPI_COMM_WORLD, nprocs, err) |
| 87 | + |
| 88 | + ! take filename from command-line argument if there is any |
| 89 | + if (rank .EQ. 0) then |
| 90 | + verbose = .TRUE. |
| 91 | + filename = "testfile.nc" |
| 92 | + ierr = get_args(2, cmd, filename, verbose, dummy) |
| 93 | + endif |
| 94 | + call MPI_Bcast(ierr, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, err) |
| 95 | + if (ierr .EQ. 0) goto 999 |
| 96 | + |
| 97 | + call MPI_Bcast(verbose, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, err) |
| 98 | + call MPI_Bcast(filename, 256, MPI_CHARACTER, 0, MPI_COMM_WORLD, err) |
| 99 | + |
| 100 | + ! set an MPI-IO hint to disable file offset alignment for |
| 101 | + ! fixed-size variables |
| 102 | + call MPI_Info_create(info, err) |
| 103 | + call MPI_Info_set(info, "nc_var_align_size", "1", err) |
| 104 | + |
| 105 | + ! create file, truncate it if exists |
| 106 | + cmode = IOR(NF90_CLOBBER, NF90_64BIT_DATA) |
| 107 | + err = nf90mpi_create(MPI_COMM_WORLD, filename, cmode, & |
| 108 | + info, ncid) |
| 109 | + call check(err, 'In nf90mpi_create: ') |
| 110 | + |
| 111 | + call MPI_Info_free(info, err) |
| 112 | + |
| 113 | + ! the global array is NX * (NY * nprocs) */ |
| 114 | + G_NY = NY * nprocs |
| 115 | + myOff = NY * rank |
| 116 | + |
| 117 | + ! define dimensions |
| 118 | + global_nx = NX |
| 119 | + err = nf90mpi_def_dim(ncid, 'Y', global_nx, dimid(2)) |
| 120 | + call check(err, 'In nf90mpi_def_dim Y') |
| 121 | + |
| 122 | + err = nf90mpi_def_dim(ncid, 'X', G_NY, dimid(1)) |
| 123 | + call check(err, 'In nf90mpi_def_dim X') |
| 124 | + |
| 125 | + err = nf90mpi_def_var(ncid, 'var', NF90_INT, dimid, varid) |
| 126 | + call check(err, 'In nf90mpi_def_var var') |
| 127 | + |
| 128 | + ! do not forget to exit define mode |
| 129 | + err = nf90mpi_enddef(ncid) |
| 130 | + call check(err, 'In nf90mpi_enddef: ') |
| 131 | + |
| 132 | + ! First, fill the entire array with zeros, using a blocking I/O. |
| 133 | + ! Every process writes a subarray of size NX * NY |
| 134 | + buf = 0 |
| 135 | + start(1) = myOff+1 |
| 136 | + start(2) = 1 |
| 137 | + count(1) = NY |
| 138 | + count(2) = NX |
| 139 | + err = nf90mpi_put_var_all(ncid, varid, buf, start, count) |
| 140 | + call check(err, 'In nf90mpi_put_var_all: ') |
| 141 | + |
| 142 | + ! initialize the buffer with rank ID |
| 143 | + buf = rank |
| 144 | + |
| 145 | + ! each proc writes NY columns of the 2D array, block_len controls the |
| 146 | + ! the number of contiguous columns at a time |
| 147 | + block_start = 0 |
| 148 | + block_len = 2 ! can be 1, 2, 3, ..., NY |
| 149 | + if (block_len > NY) block_len = NY |
| 150 | + |
| 151 | + start(1) = rank + 1 |
| 152 | + start(2) = 1 |
| 153 | + count(1) = 1 |
| 154 | + count(2) = NX |
| 155 | + num_reqs = 0 |
| 156 | + |
| 157 | + do i=1, NY |
| 158 | + num_reqs = num_reqs + 1 |
| 159 | + err = nf90mpi_iput_var(ncid, varid, buf(:,i), & |
| 160 | + reqs(num_reqs), start, count) |
| 161 | + call check(err, 'In nf90mpi_iput_var: ') |
| 162 | + |
| 163 | + start(1) = start(1) + nprocs |
| 164 | + enddo |
| 165 | + |
| 166 | + err = nf90mpi_wait_all(ncid, num_reqs, reqs, sts) |
| 167 | + call check(err, 'In nf90mpi_wait_all: ') |
| 168 | + |
| 169 | + ! check status of all requests |
| 170 | + do i=1, num_reqs |
| 171 | + if (sts(i) .NE. NF90_NOERR) then |
| 172 | + print*, "Error: nonblocking write fails on request", & |
| 173 | + i, ' ', nf90mpi_strerror(sts(i)) |
| 174 | + endif |
| 175 | + enddo |
| 176 | + |
| 177 | + err = nf90mpi_close(ncid) |
| 178 | + call check(err, 'In nf90mpi_close: ') |
| 179 | + |
| 180 | + ! check if there is any PnetCDF internal malloc residue |
| 181 | +998 format(A,I13,A) |
| 182 | + err = nf90mpi_inq_malloc_size(malloc_size) |
| 183 | + if (err == NF90_NOERR) then |
| 184 | + call MPI_Reduce(malloc_size, sum_size, 1, MPI_INTEGER8, & |
| 185 | + MPI_SUM, 0, MPI_COMM_WORLD, err) |
| 186 | + if (rank .EQ. 0 .AND. sum_size .GT. 0_MPI_OFFSET_KIND) print 998, & |
| 187 | + 'heap memory allocated by PnetCDF internally has ', & |
| 188 | + sum_size/1048576, ' MiB yet to be freed' |
| 189 | + endif |
| 190 | + |
| 191 | +999 call MPI_Finalize(err) |
| 192 | + ! call EXIT(0) ! EXIT() is a GNU extension |
| 193 | + |
| 194 | +end program main |
0 commit comments