1! 2! Copyright (C) 2015, Northwestern University 3! See COPYRIGHT notice in top-level directory. 4! 5! $Id: fill_mode.f 2476 2016-09-06 01:05:33Z wkliao $ 6 7! 8! This example shows how to use 9! 1. nfmpi_set_fill() to enable fill mode 10! 2. nfmpi_def_var_fill() to define the variable's fill value 11! 3. nfmpi_inq_var_fill() to inquire the variable's fill mode information 12! 4. nfmpi_put_vara_int_all() to write two 2D 4-byte integer array in parallel. 13! It first defines a netCDF record variable of size global_nx * NFMPI_UNLIMITED 14! where 15! global_nx == (nx * number of MPI processes) and 16! It then defines a netCDF variable of size global_nx * global_ny where 17! global_nx == (nx * number of MPI processes) and 18! global_ny == ny 19! The data partitioning pattern for both variables are a column-wise 20! partitioning across all processes. Each process writes a subarray of size 21! nx * ny. Note the description above follows the Fortran array index order. 22! 23! Example commands for MPI run and outputs from running ncmpidump on the 24! NC file produced by this example program: 25! 26! % mpif77 -O2 -o fill_mode fill_mode.f -lpnetcdf 27! % mpiexec -n 4 ./fill_mode /pvfs2/wkliao/testfile.nc 28! 29! % ncmpidump /pvfs2/wkliao/testfile.nc 30! netcdf testfile { 31! // file format: CDF-5 (big variables) 32! dimensions: 33! REC_DIM = UNLIMITED ; // (2 currently) 34! X = 20 ; 35! Y = 3 ; 36! variables: 37! int rec_var(REC_DIM, X) ; 38! rec_var:_FillValue = -1 ; 39! int fix_var(Y, X) ; 40! fix_var:_FillValue = -2147483647 ; 41! data: 42! 43! rec_var = 44! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, 45! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _ ; 46! 47! fix_var = 48! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, 49! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _, 50! 0, 0, 0, 0, _, 1, 1, 1, 1, _, 2, 2, 2, 2, _, 3, 3, 3, 3, _ ; 51! } 52! 53 subroutine check(err, message) 54 implicit none 55 include 'mpif.h' 56 include 'pnetcdf.inc' 57 integer err 58 character message*(*) 59 60 ! It is a good idea to check returned value for possible error 61 if (err .NE. NF_NOERR) then 62 write(6,*) message//' '//nfmpi_strerror(err) 63 call MPI_Abort(MPI_COMM_WORLD, -1, err) 64 end if 65 end ! subroutine check 66 67 program main 68 implicit none 69 include 'mpif.h' 70 include 'pnetcdf.inc' 71 72 character*256 filename, cmd 73 integer i, j, err, ierr, nprocs, rank, get_args 74 integer cmode, ncid, rec_varid, fix_varid, dimid(2) 75 integer no_fill, fill_value, old_mode 76 integer*8 nx, ny, global_nx, global_ny, one 77 integer*8 starts(2), counts(2) 78 PARAMETER(nx=5, ny=3) 79 integer buf(nx,ny) 80 integer*8 malloc_size, sum_size 81 logical verbose 82 integer dummy 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 one = 1 89 ! take filename from command-line argument if there is any 90 if (rank .EQ. 0) then 91 verbose = .TRUE. 92 filename = "testfile.nc" 93 ierr = get_args(2, cmd, filename, verbose, dummy) 94 endif 95 call MPI_Bcast(ierr, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, err) 96 if (ierr .EQ. 0) goto 999 97 98 call MPI_Bcast(verbose, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, 99 + err) 100 call MPI_Bcast(filename, 256, MPI_CHARACTER, 0, 101 + MPI_COMM_WORLD, err) 102 103 ! set parameters 104 global_nx = nx * nprocs 105 global_ny = ny 106 107 do i=1, ny 108 do j=1, nx 109 buf(j,i) = rank 110 enddo 111 enddo 112 113 ! create file, truncate it if exists 114 cmode = IOR(NF_CLOBBER, NF_64BIT_DATA) 115 err = nfmpi_create(MPI_COMM_WORLD, filename, cmode, 116 + MPI_INFO_NULL, ncid) 117 call check(err, 'In nfmpi_create: ') 118 119 ! define dimensions x and y 120 err = nfmpi_def_dim(ncid, "REC_DIM", NFMPI_UNLIMITED,dimid(2)) 121 call check(err, 'In nfmpi_def_dim REC_DIM: ') 122 err = nfmpi_def_dim(ncid, "X", global_nx, dimid(1)) 123 call check(err, 'In nfmpi_def_dim X: ') 124 125 ! define a 2D record variable of integer type 126 err = nfmpi_def_var(ncid, "rec_var", NF_INT, 2, dimid, 127 + rec_varid) 128 call check(err, 'In nfmpi_def_var: ') 129 130 err = nfmpi_def_dim(ncid, "Y", global_ny, dimid(2)) 131 call check(err, 'In nfmpi_def_dim Y: ') 132 133 ! define a 2D fixed-size variable of integer type 134 err = nfmpi_def_var(ncid, "fix_var", NF_INT, 2, dimid, 135 + fix_varid) 136 call check(err, 'In nfmpi_def_var: ') 137 138 ! set the fill mode to NF_FILL for entire file 139 err = nfmpi_set_fill(ncid, NF_FILL, old_mode) 140 call check(err, 'In nfmpi_set_fill: ') 141 if (verbose) then 142 if (old_mode .EQ. NF_FILL) then 143 print*,"The old fill mode is NF_FILL" 144 else 145 print*,"The old fill mode is NF_NOFILL" 146 endif 147 endif 148 149 ! set the fill mode back to NF_NOFILL for entire file 150 err = nfmpi_set_fill(ncid, NF_NOFILL, old_mode) 151 call check(err, 'In nfmpi_set_fill: ') 152 153 ! set the variable's fill mode to NF_FILL with default fill value 154 err = nfmpi_def_var_fill(ncid, fix_varid, 0, NF_FILL_INT) 155 call check(err, 'In nfmpi_def_var_fill: ') 156 157 ! set a customized fill value -1 158 fill_value = -1 159 err = nfmpi_put_att_int(ncid, rec_varid, "_FillValue", NF_INT, 160 + one, fill_value) 161 call check(err, 'In nfmpi_put_att_int: ') 162 163 ! do not forget to exit define mode 164 err = nfmpi_enddef(ncid) 165 call check(err, 'In nfmpi_enddef: ') 166 167 ! now we are in data mode 168 169 ! Note that in Fortran, array indices start with 1 170 starts(1) = nx * rank + 1 171 starts(2) = 1 172 counts(1) = nx 173 counts(2) = ny 174 175 ! do not write the variable in full 176 counts(1) = counts(1) - 1 177 err = nfmpi_put_vara_int_all(ncid, fix_varid, starts, counts, 178 + buf) 179 call check(err, 'In nfmpi_put_vara_int_all: ') 180 181 err = nfmpi_inq_var_fill(ncid, fix_varid, no_fill, fill_value) 182 if (no_fill .NE. 0) 183 + print*,"Error: expecting no_fill to be 0" 184 if (fill_value .NE. NF_FILL_INT) 185 + print*,"Error: expecting no_fill to be ",NF_FILL_INT, 186 + " but got ", fill_value 187 188 ! fill the 1st record of the record variable 189 starts(2) = 1 190 err = nfmpi_fill_var_rec(ncid, rec_varid, starts(2)) 191 call check(err, 'In nfmpi_fill_var_rec: ') 192 193 ! write to the 1st record 194 counts(2) = 1 195 err = nfmpi_put_vara_int_all(ncid, rec_varid, starts, counts, 196 + buf) 197 call check(err, 'In nfmpi_put_vara_int_all: ') 198 199 ! fill the 2nd record of the record variable 200 starts(2) = 2 201 err = nfmpi_fill_var_rec(ncid, rec_varid, starts(2)) 202 call check(err, 'In nfmpi_fill_var_rec: ') 203 204 ! write to the 2nd record 205 err = nfmpi_put_vara_int_all(ncid, rec_varid, starts, counts, 206 + buf) 207 208 ! close the file 209 err = nfmpi_close(ncid) 210 call check(err, 'In nfmpi_close: ') 211 212 ! check if there is any PnetCDF internal malloc residue 213 998 format(A,I13,A) 214 err = nfmpi_inq_malloc_size(malloc_size) 215 if (err .EQ. NF_NOERR) then 216 call MPI_Reduce(malloc_size, sum_size, 1, MPI_INTEGER8, 217 + MPI_SUM, 0, MPI_COMM_WORLD, err) 218 if (rank .EQ. 0 .AND. sum_size .GT. 0) 219 + print 998, 220 + 'heap memory allocated by PnetCDF internally has ', 221 + sum_size/1048576, ' MiB yet to be freed' 222 endif 223 224 999 call MPI_Finalize(err) 225 ! call EXIT(0) ! EXIT() is a GNU extension 226 end ! program main 227 228