! ! Copyright (C) 2015, Northwestern University ! See COPYRIGHT notice in top-level directory. ! ! $Id$ ! ! This example shows how to use ! 1. nfmpi_set_fill() to enable fill mode ! 2. nfmpi_def_var_fill() to define the variable's fill value ! 3. nfmpi_inq_var_fill() to inquire the variable's fill mode information ! 4. nfmpi_put_vara_int_all() to write two 2D 4-byte integer array in parallel. ! It first defines a netCDF record variable of size global_nx * NFMPI_UNLIMITED ! where ! global_nx == (nx * number of MPI processes) and ! It then defines a netCDF variable of size global_nx * global_ny where ! global_nx == (nx * number of MPI processes) and ! global_ny == ny ! The data partitioning pattern for both variables are a column-wise ! partitioning across all processes. Each process writes a subarray of size ! nx * ny. Note the description above follows the Fortran array index order. ! ! Example commands for MPI run and outputs from running ncmpidump on the ! NC file produced by this example program: ! ! % mpif77 -O2 -o fill_mode fill_mode.f -lpnetcdf ! % mpiexec -n 4 ./fill_mode /pvfs2/wkliao/testfile.nc ! ! % ncmpidump /pvfs2/wkliao/testfile.nc ! netcdf testfile { ! // file format: CDF-5 (big variables) ! dimensions: ! REC_DIM = UNLIMITED ; // (2 currently) ! X = 20 ; ! Y = 3 ; ! variables: ! int rec_var(REC_DIM, X) ; ! rec_var:_FillValue = -1 ; ! int fix_var(Y, X) ; ! fix_var:_FillValue = -2147483647 ; ! data: ! ! rec_var = ! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, ! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _ ; ! ! fix_var = ! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, ! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, ! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _ ; ! } ! subroutine check(err, message) implicit none include 'mpif.h' include 'pnetcdf.inc' integer err character message*(*) ! It is a good idea to check returned value for possible error if (err .NE. NF_NOERR) then write(6,*) message//' '//nfmpi_strerror(err) call MPI_Abort(MPI_COMM_WORLD, -1, err) end if end ! subroutine check program main implicit none include 'mpif.h' include 'pnetcdf.inc' character*256 filename, cmd integer i, j, err, ierr, nprocs, rank, get_args integer cmode, ncid, rec_varid, fix_varid, dimid(2) integer no_fill, fill_value, old_mode integer*8 nx, ny, global_nx, global_ny, one integer*8 starts(2), counts(2) PARAMETER(nx=5, ny=3) integer buf(nx,ny) integer*8 malloc_size, sum_size logical verbose integer dummy call MPI_Init(err) call MPI_Comm_rank(MPI_COMM_WORLD, rank, err) call MPI_Comm_size(MPI_COMM_WORLD, nprocs, err) one = 1 ! take filename from command-line argument if there is any if (rank .EQ. 0) then verbose = .TRUE. filename = "testfile.nc" ierr = get_args(2, cmd, filename, verbose, dummy) endif call MPI_Bcast(ierr, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, err) if (ierr .EQ. 0) goto 999 call MPI_Bcast(verbose, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, + err) call MPI_Bcast(filename, 256, MPI_CHARACTER, 0, + MPI_COMM_WORLD, err) ! set parameters global_nx = nx * nprocs global_ny = ny do i=1, ny do j=1, nx buf(j,i) = rank enddo enddo ! create file, truncate it if exists cmode = IOR(NF_CLOBBER, NF_64BIT_DATA) err = nfmpi_create(MPI_COMM_WORLD, filename, cmode, + MPI_INFO_NULL, ncid) call check(err, 'In nfmpi_create: ') ! define dimensions x and y err = nfmpi_def_dim(ncid, "REC_DIM", NFMPI_UNLIMITED,dimid(2)) call check(err, 'In nfmpi_def_dim REC_DIM: ') err = nfmpi_def_dim(ncid, "X", global_nx, dimid(1)) call check(err, 'In nfmpi_def_dim X: ') ! define a 2D record variable of integer type err = nfmpi_def_var(ncid, "rec_var", NF_INT, 2, dimid, + rec_varid) call check(err, 'In nfmpi_def_var: ') err = nfmpi_def_dim(ncid, "Y", global_ny, dimid(2)) call check(err, 'In nfmpi_def_dim Y: ') ! define a 2D fixed-size variable of integer type err = nfmpi_def_var(ncid, "fix_var", NF_INT, 2, dimid, + fix_varid) call check(err, 'In nfmpi_def_var: ') ! set the fill mode to NF_FILL for entire file err = nfmpi_set_fill(ncid, NF_FILL, old_mode) call check(err, 'In nfmpi_set_fill: ') if (verbose) then if (old_mode .EQ. NF_FILL) then print*,"The old fill mode is NF_FILL" else print*,"The old fill mode is NF_NOFILL" endif endif ! set the fill mode back to NF_NOFILL for entire file err = nfmpi_set_fill(ncid, NF_NOFILL, old_mode) call check(err, 'In nfmpi_set_fill: ') ! set the variable's fill mode to NF_FILL with default fill value err = nfmpi_def_var_fill(ncid, fix_varid, 0, NF_FILL_INT) call check(err, 'In nfmpi_def_var_fill: ') ! set a customized fill value -1 fill_value = -1 err = nfmpi_put_att_int(ncid, rec_varid, "_FillValue", NF_INT, + one, fill_value) call check(err, 'In nfmpi_put_att_int: ') ! do not forget to exit define mode err = nfmpi_enddef(ncid) call check(err, 'In nfmpi_enddef: ') ! now we are in data mode ! Note that in Fortran, array indices start with 1 starts(1) = nx * rank + 1 starts(2) = 1 counts(1) = nx counts(2) = ny ! do not write the variable in full counts(1) = counts(1) - 1 err = nfmpi_put_vara_int_all(ncid, fix_varid, starts, counts, + buf) call check(err, 'In nfmpi_put_vara_int_all: ') err = nfmpi_inq_var_fill(ncid, fix_varid, no_fill, fill_value) if (no_fill .NE. 0) then print*,"Error: expecting no_fill to be 0" stop 2 endif if (fill_value .NE. NF_FILL_INT) then print*,"Error: expecting no_fill to be ",NF_FILL_INT, + " but got ", fill_value stop 2 endif ! fill the 1st record of the record variable starts(2) = 1 err = nfmpi_fill_var_rec(ncid, rec_varid, starts(2)) call check(err, 'In nfmpi_fill_var_rec: ') ! write to the 1st record counts(2) = 1 err = nfmpi_put_vara_int_all(ncid, rec_varid, starts, counts, + buf) call check(err, 'In nfmpi_put_vara_int_all: ') ! fill the 2nd record of the record variable starts(2) = 2 err = nfmpi_fill_var_rec(ncid, rec_varid, starts(2)) call check(err, 'In nfmpi_fill_var_rec: ') ! write to the 2nd record err = nfmpi_put_vara_int_all(ncid, rec_varid, starts, counts, + buf) call check(err, 'In nfmpi_put_vara_int_all: ') ! close the file err = nfmpi_close(ncid) call check(err, 'In nfmpi_close: ') ! check if there is any PnetCDF internal malloc residue 998 format(A,I13,A) err = nfmpi_inq_malloc_size(malloc_size) if (err .EQ. NF_NOERR) then call MPI_Reduce(malloc_size, sum_size, 1, MPI_INTEGER8, + MPI_SUM, 0, MPI_COMM_WORLD, err) if (rank .EQ. 0 .AND. sum_size .GT. 0) + print 998, + 'heap memory allocated by PnetCDF internally has ', + sum_size/1048576, ' MiB yet to be freed' endif 999 call MPI_Finalize(err) ! call EXIT(0) ! EXIT() is a GNU extension end ! program main