function status = nc_varput(ncfile, variable, data, start,count, stride)
% NC_VARPUT:  Write data into a NetCDF NetCDF file.
%
% USAGE:  status = nc_varput(file, var, data, start, count, stride );
%
% PARAMETERS:
%   status:  -1 for failure, 0 for success
%   
% Example:
%    status = nc_varput('foo.cdf', 'x', data, [0 0], [2 3])
%    file:  name of input netcdf file
%    var:  name of variable to write to
%    data:  to be written to netcdf file
%    start:  
%        coordinates where we start writing.  Optional.  If not supplied,
%        assume [0,..].  If we are given a start, then we must be 
%        given a count as well.
%    count:  
%        how many values to write along each dimension. Optional.  If not
%        supplied, assume as much as can be written.
%    stride: how far between written elements along each
%            dimension.  Default is [1 1 1...].  Optional. 
%
% Currently, the proper error status flag is NOT set if the
% 'varput' operation fails due to improper "start" or "count"
% arguments.  If no error message is given but the data has
% obviously not be written, check that.
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% $Name:  $
% $Id: nc_varput.m,v 1.1 2005/06/29 16:07:00 brian Exp $
% AUTHOR:  johnevans@acm.org
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%






%
% Assume failure until told otherwise.
status = -1;

%
% Suppress netcdf error messages.
mexnc ( 'setopts', 0 );



%
% Must have at least 3 input arguments, no more than 6
% Three inputs means to write an entire dataset (put_var_xxx or put_var1_xxx).
% Five inputs means to write part of a dataset with default stride (put_vara_xxx).
% Six inputs means strided writes (put_vars_xxx).
if nargin < 3 | nargin == 4 | nargin > 6
	fprintf ( 2, '%s:  number of input arguments is cannot possibly be correct.\n', mfilename );
	help nc_varput;
	return;
end





%
% One optional output argument.
if ( nargout > 1 )
	fprintf ( 2, '%s:  at most 1 output argument is allowed.\n', mfilename );
	help nc_varput;
	return;
end


%
% open the file.  
[ncid, status] = mexnc('open', ncfile, 'write');
if (status < 0)

	ncerr_msg = mexnc ( 'strerror', status );
	fprintf ( 2, '%s:  ''open'' failed on %s (%s).\n', mfilename, ncfile, ncerr_msg  );
	status = -1;
	return;

end




%
% check to see if the variable already exists.  If it does,
% then we should only have 5 input arguments.
[varid, status] = mexnc('INQ_VARID', ncid, variable );
if ( status ~= 0 )
	ncerr_msg = mexnc ( 'strerror', status );
	fprintf ( 2, '%s:  INQ_VARID failed on %s (%s).\n' , mfilename, variable, ncerr_msg );	
	mexnc ( 'close', ncid );
	status = -1;
	return;
end
if ( varid < 0 )
	fprintf ( 2, '%s:  Could not find variable %s in file %s.\n' , mfilename, variable, ncfile );	
	mexnc ( 'close', ncid );
	status = -1;
	return;
end



%
% Get variable information.
[var_name,var_type,nvdims,var_dim,natts, status]=mexnc('INQ_VAR',ncid,varid);
if status < 0 
	ncerr_msg = mexnc ( 'strerror', status );
	fprintf ( 2, '%s:  ''varinq'' operation failed on %s, variable (%s).\n', mfilename, ncfile, variable, ncerr_msg );
	mexnc ( 'close', ncid );
	status = -1;
	return;
end

%
% Find out who is the unlimited dimension.
[unlimdim, status] = mexnc ( 'inq_unlimdim', ncid );
if status < 0 
	ncerr_msg = mexnc ( 'strerror', status );
	fprintf ( 2, '%s:  ''inq_unlimdim'' operation failed on %s,  (%s).\n', mfilename, ncfile, ncerr_msg );
	mexnc ( 'close', ncid );
	status = -1;
	return;
end



%
% Figure out which write routine we will use.  If the target variable is a singleton, then we must use
% VARPUT1.  If a stride was given, we must use VARPUTG.  Otherwise just use VARPUT.
if nvdims == 0
	write_op = 'put_var1';
elseif nargin == 3
	write_op = 'put_var';
elseif nargin == 5
	write_op = 'put_vara';
elseif nargin == 6
	write_op = 'put_vars';
else
	msg = sprintf ( '%s:  unhandled write op.  How did we come to this??\n', mfilename );
	error ( msg );
end



%
% Must determine how big the target variable is in order to properly set
% the start and count arguments.
if nvdims == 0

	%
	% Must be a singleton variable with no defined dimensions.  
	switch nargin

	case 3
		%
		% This is the case of "nc_varput ( file, var, data );"
		start = 0;
		count = 1;

	case 5
		%
		% This is the case of "nc_varput ( file, var, data, start, count );"
		if ( start ~= 0 ) | (count ~= 1 )
			fprintf ( 2, '%s:  in case of singleton variable, ''start'' and ''count'' need not (and probably shoud not) be supplied.  If you are the pedantic type (and you know if you are), then make start = [0] and count = [1].  Nothing else makes sense anyway.\n', mfilename );
			mexnc ( 'close', ncid );
			status = -1;
			return;
		end

	otherwise
		fprintf ( 2, '%s:  The output variable is a singleton, but the number of input arguments are not consistent with that.\n', mfilename );
		status = -1;
		return
	end

	nc_start = 0;
	nc_count = 1;

else
	%
	% Case of variable with well-defined dimensions.  Much easier.
	for n=1:nvdims,
		dimid=var_dim(n);
		[dim_name,dim_size,status]=mexnc('INQ_DIM',ncid,dimid);
		if status < 0 
			ncerr_msg = mexnc ( 'strerror', status );
			format = '%s:  ''INQ_DIM'' operation failed on dimid %d, variable (%s).\n';
			fprintf ( 2, format, mfilename, ncfile, variable, ncerr_msg );
			mexnc ( 'close', ncid );
			status = -1;
			return;
		end
		nc_count(n)=dim_size;
		var_size(n) = dim_size;
	end
end



nc_start = zeros(size(nc_count));
nc_stride = ones(size(nc_count));




%
% If restrictions were specified, set them here.
if ( nargin > 3 )
	
	if ( length(start) ~= length(count) )
		fprintf ( 2, '%s:  start and count arguments do not have the same length.\n', mfilename );
		mexnc ( 'close', ncid );
		status = -1;
		return
	end

end


%
% If only 3 inputs and if not a singleton variable, then START is [0,..] and COUNT is 
% the size of the data.  
if ( nargin ==3 ) & ( nvdims > 0 )
	start = zeros(1,nvdims);
	count = size(data);
end


%
% if using the stride, then the non-singleton dimensions have to be set to 
% what the user gave us
% For example.  If we have a variable with time, depth, lat, and lon 
% as dimensions, but depth, lat, and lon are all singleton dimensions,
% then nc_size would be [nt 1 1 1], but var_size could be [5 1].  What
% we need to do is to padd
if nargin >= 6
	rank = length(nc_count);
	if ( length(stride) ~= rank )
		format = '%s:  we were given a stride, but it does not match the rank %d of the variable in the netcdf file.\n';
		fprintf ( 2, format.\n', mfilename, rank );
		status = -1;
		return
	end
end


%
% We are now in a position to do a check on the input var size vs. 
% the known size in the netcdf file.  If we don't do this, it would 
% be possible to send a larger then expected chunk of data to the 
% netcdf file, have parts of it get lopped off in order to fit, and 
% never be the wiser.
switch ( write_op )

case 'put_var1'

	%
	% Just check that the length of the input data was 1.
	dsize = prod ( size(data) );
	if dsize ~= 1
		fprintf ( 2, '%s:  write_op was ''put_var1'', but the length of the data was %d.\n', mfilename, dsize );
		status = -1;
		return
	end

case 'put_var'

	%
	% Since 'put_var' writes all the data, check that the
	% extents match up exactly.  
	%
	% Are there any singleton dimensions?  If so, we need to ac
	dsize = size(data);
	bad_size = 0;
	for k = 1:length(nc_count)
		if nc_count(k) == 1
			continue;
		end
		if nc_count(k) ~= dsize(k)
			bad_size = 1;
		end
	end
	if bad_size
		ncsize_string = sprintf ( '%d ', nc_count );
		varsize_string = sprintf ( '%d ', dsize );
		format = '%s:  write_op was ''put_var'', but the input data size is [ %s] and the netcdf variable size is [ %s].\n';
		fprintf ( 2, format, mfilename, varsize_string, ncsize_string );
		status = -1;
		return
	end


case { 'put_vara', 'put_vars' }

	%
	% Just check that the chunk of data the user gave us is the same
	% size as the given count.  This works for put_vars as well.
	dsize = size(data);
	n = length(dsize);

	%
	% special case for singleton variable.
	if nvdims == 1

		%
		% check length of input.
		if prod(dsize) ~= count
			format = '%s:  write_op was ''%s'', but the input data size is %d and the given count size is %d.\n';
			fprintf ( 2, format, mfilename, write_op, prod(dsize), count );
			status = -1;
			return
		end

	else

		if n < nvdims
			%
			% There were trailing singleton dimensions.  Handle them
			% by appending ones on out to the end.
			ndiff = nvdims - n
			dsize = [dsize ones(1,ndiff)];
		end
		if any(dsize-count)
			dsize_string = sprintf ( '%d ', dsize );
			count_string = sprintf ( '%d ', count );
			format = '%s:  write_op was ''%s'', but the input data size is [ %s] and the given count size is [ %s].\n';
			fprintf ( 2, format, mfilename, write_op, dsize_string, count_string );
			status = -1;
			return
		end
	end

otherwise
	%
	% do nothing, wait until later to check
	;
end


%
% Scale the data if we have the appropriate attributes.
have_scale_factor = 0;
have_add_offset = 0;
[sf_datatype, att_len, status] = mexnc('INQ_ATT', ncid, varid, 'scale_factor' );
if ( status == 0 )
	have_scale_factor = 1;
end
[ao_datatype, att_len, status] = mexnc('INQ_ATT', ncid, varid, 'add_offset' );
if ( status == 0 )
	have_add_offset = 1;
end
if ( have_scale_factor & have_add_offset )

	[scale_factor, status] = mexnc ( 'get_att_double', ncid, varid, 'scale_factor' );
	if ( status ~= 0 )
		fprintf ( 2, '%s:  ATT_GET_DOUBLE failed on scale_factor.\n', mfilename );
		mexnc('close',ncid);
		status = -1;
		return
	end
	[add_offset, status] = mexnc ( 'get_att_double', ncid, varid, 'add_offset' );
	if ( status ~= 0 )
		fprintf ( 2, '%s:  ATT_GET_DOUBLE failed on add_offset.\n', mfilename );
		mexnc('close',ncid);
		status = -1;
		return
	end

	data = (double(data) - add_offset) / scale_factor;

end


%
% Handle the fill value, if any.  Change those values into NaN.
[att_datatype, att_len, status] = mexnc('INQ_ATT', ncid, varid, '_FillValue' );
if ( status == 0 )

	switch ( class(data) )
	case 'double'
		[fill_value, status] = mexnc ( 'get_att_double', ncid, varid, '_FillValue' );
	case 'single'
		[fill_value, status] = mexnc ( 'get_att_float', ncid, varid, '_FillValue' );
	case 'int32'
		[fill_value, status] = mexnc ( 'get_att_int', ncid, varid, '_FillValue' );
	case 'int16'
		[fill_value, status] = mexnc ( 'get_att_short', ncid, varid, '_FillValue' );
	case 'int8'
		[fill_value, status] = mexnc ( 'get_att_schar', ncid, varid, '_FillValue' );
	case 'uint8'
		[fill_value, status] = mexnc ( 'get_att_uchar', ncid, varid, '_FillValue' );
	case 'char'
		[fill_value, status] = mexnc ( 'get_att_text', ncid, varid, '_FillValue' );
	otherwise
		msg = sprintf ( '%s:  unhandled datatype %s\n', mfilename, nc_datatype_string(var_type) );
		mexnc('close',ncid);
		status = -1;
		return
	end

	if ( status ~= 0 )
		ncerrmsg = mexnc ( 'strerror', status );
		fprintf ( 2, '%s:  GET_ATT_XXX failed on _FillValue, var %s, file %s (%s).\n', mfilename, varname, ncfile, ncerrmsg );
		mexnc('close',ncid);
		status = -1;
		return
	end


	ind = find(isnan(data));
	data(ind) = fill_value;

end

	

%
% write the data
pdata = permute(data,fliplr([1:ndims(data)]));
switch ( write_op )

	case 'put_var1'
		switch ( class(data) )
		case 'double'
			status = mexnc ( 'put_var1_double', ncid, varid, start, pdata  );
		case 'single'
			status = mexnc ( 'put_var1_float', ncid, varid, start, pdata );
		case 'int32'
			status = mexnc ( 'put_var1_int', ncid, varid, start, pdata );
		case 'int16'
			status = mexnc ( 'put_var1_short', ncid, varid, start, pdata );
		case 'int8'
			status = mexnc ( 'put_var1_schar', ncid, varid, start, pdata );
		case 'uint8'
			status = mexnc ( 'put_var1_uchar', ncid, varid, start, pdata );
		case 'char'
			status = mexnc ( 'put_var1_text', ncid, varid, start, pdata );
		otherwise
			msg = sprintf ( '%s:  unhandled data class %s\n', mfilename, class(pdata) );
			mexnc('close',ncid);
			status = -1;
			return
		end

	case 'put_var'
		switch ( class(data) )
		case 'double'
			status = mexnc ( 'put_var_double', ncid, varid,  pdata  );
		case 'single'
			status = mexnc ( 'put_var_float', ncid, varid,  pdata );
		case 'int32'
			status = mexnc ( 'put_var_int', ncid, varid,  pdata );
		case 'int16'
			status = mexnc ( 'put_var_short', ncid, varid,  pdata );
		case 'int8'
			status = mexnc ( 'put_var_schar', ncid, varid,  pdata );
		case 'uint8'
			status = mexnc ( 'put_var_uchar', ncid, varid,  pdata );
		case 'char'
			status = mexnc ( 'put_var_text', ncid, varid,  pdata );
		otherwise
			msg = sprintf ( '%s:  unhandled data class %s\n', mfilename, class(pdata) );
			mexnc('close',ncid);
			status = -1;
			return
		end
	
	case 'put_vara'
		switch ( class(data) )
		case 'double'
			status = mexnc ( 'put_vara_double', ncid, varid, start, count,  pdata  );
		case 'single'
			status = mexnc ( 'put_vara_float', ncid, varid,  start, count, pdata );
		case 'int32'
			status = mexnc ( 'put_vara_int', ncid, varid, start, count,  pdata );
		case 'int16'
			status = mexnc ( 'put_vara_short', ncid, varid, start, count,  pdata );
		case 'int8'
			status = mexnc ( 'put_vara_schar', ncid, varid,  start, count, pdata );
		case 'uint8'
			status = mexnc ( 'put_vara_uchar', ncid, varid, start, count,  pdata );
		case 'char'
			status = mexnc ( 'put_vara_text', ncid, varid, start, count,  pdata );
		otherwise
			msg = sprintf ( '%s:  unhandled data class %s\n', mfilename, class(pdata) );
			mexnc('close',ncid);
			status = -1;
			return
		end

	case 'put_vars'
		switch ( class(data) )
		case 'double'
			status = mexnc ( 'put_vars_double', ncid, varid, start, count, stride,  pdata  );
		case 'single'
			status = mexnc ( 'put_vars_float', ncid, varid,  start, count, stride, pdata );
		case 'int32'
			status = mexnc ( 'put_vars_int', ncid, varid, start, count, stride,  pdata );
		case 'int16'
			status = mexnc ( 'put_vars_short', ncid, varid, start, count, stride,  pdata );
		case 'int8'
			status = mexnc ( 'put_vars_schar', ncid, varid, start, count, stride, pdata );
		case 'uint8'
			status = mexnc ( 'put_vars_uchar', ncid, varid, start, count, stride,  pdata );
		case 'char'
			status = mexnc ( 'put_vars_text', ncid, varid, start, count, stride,  pdata );
		otherwise
			msg = sprintf ( '%s:  unhandled data class %s\n', mfilename, class(pdata) );
			mexnc('close',ncid);
			status = -1;
			return
		end

	otherwise 
		fprintf ( 2, '%s:  unknown write operation''%s''.\n', mfilename, write_op );
		mexnc ( 'close', ncid );
		status = -1;
		return;


end

if ( status < 0 )
	ncerr = mexnc ( 'strerror', status );
	fprintf ( 2, '%s:  write operation ''%s'' failed on %s with error ''%s'', file %s.\n', mfilename, write_op, variable, ncerr, ncfile );
	mexnc ( 'close', ncid );
	status = -1;
	return;
end

status = mexnc ( 'close', ncid );

%
% If we got this far, then we must have succeeded.
status = 0;


return
