local ncops;
/* DOCUMENT ncops.i -- netCDF operations
 *
 *  List of routines:
 * nc_openf:     opens a netCDF file for reading
 * nc_close:     closes a netCDF file
 * nc_unlimited: returns coordinate values of unlimited dimension
 * nc_getvar:    reads data for a variable
 * nc_getattr:   gets an attribute (or list of all attributes)
 * nc_getdims:   gets a list of variable dimensions
 * nc_getsize:   gets the size of a dimension
 * nc_dimsof:    returns dimension count array for a variable
 * nc_vartype:   returns variable type
 * nc_dimvardef: defines dimension and associated variable
 * nc_putvar:    writes data for a variable
 * nc_recvars:   return list of record variables
 *
 * Version: 1.5
 * Modified: 27 Jan 1999, R. Saravanan
 *
 * SEE ALSO: hops, yodel
 */

require, "netcdf.i";
require, "yodel.i";


func nc_openf( filename, &fhandle, &fmeta, update=, create= )
/* DOCUMENT  nc_openf, filename, fhandle, fmeta, update=0/1, create=0/1
 * Open netCDF file named FILENAME for reading, returning the file handle
 * FHANDLE, and the data descriptor FMETA.
 * If UPDATE==1, open it for reading/writing.
 * If CREATE==1, create a new netCDF file (FMETA is set to null in YORICK).
 * SEE ALSO: nc_close, nc_getattr, nc_getdims, nc_getsize, nc_getvar, nc_vartype, nc_dimsof
 */
{ func_name= "nc_openf"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

if (is_scalar(filename)) filename= [filename];

if (param_set(create)) {
  fhandle= [];
  fmeta=   nc_create(filename);
} else if (param_set(update)) {
  fhandle= nc_open(filename, "r+b");
  fmeta=   nc_file;
// Set default maximum file size to 1536MB
  set_filesize, fhandle, 0x60000000;
} else {
  fhandle= nc_open(filename, "rb");
  fmeta=   nc_file;
}

return timer_return(func_name);

}


func nc_close( &fhandle)
/* DOCUMENT  nc_close, fhandle
 * Set netCDF file handle FHANDLE to null.
 * SEE ALSO: nc_openf
 */
{ func_name= "nc_close"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

// Close netcdf file (DOES NOT SEEM TO WORK PROPERLY FOR NETCDF RECORD FILES)
// close, fhandle;

fhandle= NULL;

return timer_return(func_name);

}


func nc_unlimited( fhandle )
/* DOCUMENT  nc_unlimited(fhandle)
 * Returns the values of the unlimited dimension coordinate (usually time)
 * from netCDF file handle FHANDLE, or return NULL, if there is no unlimited
 * dimension.
 * SEE ALSO: nc_openf
 */
{ func_name= "nc_unlimited"; timer_call,func_name;

// Compatibility parameters (including error handling)

// compatible.pro:
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

return timer_return(func_name,get_times(fhandle));

}


func nc_getvar( fhandle, varname, offset=, count=,
                 wrapoffset=, wrapcount=, records=, fold=, transp=)
/* DOCUMENT  nc_getvar(fhandle, varname, offset=, count=,
                  wrapoffset=, wrapcount=, records=, fold=, transp=)
 * Read a hyperslab of data for variable VARNAME from netCDF file handle
 * FHANDLE, with optional OFFSET and COUNT parameters for each dimension.
 * If WRAPCOUNT is defined, it contains the length of the first dimension,
 * which assumed to be periodic. If, in addition, WRAPOFFSET is defined,
 * it contains the data offset to be ignored when enforcing periodicity.
 * If RECORDS is defined, it contains the number of records in the
 * unlimited dimension (usually time). (USED BY THE YORICK VERSION ONLY)
 * If FOLD is defined, it should be a 2-element array describing folding of
 * the last dimension: [offset, count, fold_count]. In this case the
 * last-but-one dimension describes folds of size fold_count in the last
 * dimension, whose original offset and count values are given by the
 * FOLD parameter. (OFFSET and COUNT should also be specified if FOLD is
 * specified.)
 * If TRANSP is specified, it should contain a list of dimensions that need
 * to be transposed with the next following dimension. E.g., TRANSP=[1,3]
 * transposes dimension 1 with 2 and dimension 3 with 4.
 * SEE ALSO: nc_openf, nc_getattr, nc_getdims, nc_getsize, nc_vartype
 */
{ func_name= "nc_getvar"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

if (param_set(transp)) {
// Handle transpose operation recursively

   value= nc_getvar( fhandle, varname, records=records,
                     offset=offset, count=count,
                     wrapoffset=wrapoffset, wrapcount=wrapcount,
                     fold=fold );

   ntransp= numberof(transp);
   for (j=I0; j <= ntransp-I1; j++) {
      value= transpose( value, [transp(j), transp(j)+1] );
   }

   return timer_return(func_name, value);
}

if (param_set(fold)) {
// Handle folding of last dimension recursively
   ndim= numberof(count);
   if ((ndim < 2) || (numberof(offset) != ndim))
      error, "OFFSET and COUNT should be specified for folding";

// Fold parameters
   offset0= fold(I0);
   count0= fold(I0+1);
   foldcount= fold(I0+2);

// Extract last count
   nlast= count(ndim-I1);

// Strip last dimension from offset/count
   offset1= offset(I0:I0+ndim-2);
   count1= count(I0:I0+ndim-2);

// Compute new offset
   offset1(ndim-I1-1)= offset1(ndim-I1-1) + foldcount*offset(ndim-I1) + offset0;

   if ( (offset0+count0) < ( offset1(ndim-I1-1)+count1(ndim-I1-1) +
                              (nlast-1)*foldcount ) )
      error, "Not enough data to read folded dimension";

// Read first fold
   value= nc_getvar( fhandle, varname, records=records,
                       offset=offset1, count=count1,
                       wrapoffset=wrapoffset, wrapcount=wrapcount  );

// Create output array
   outarr= array(value(I0), [2, prod(count1), nlast]);
   outarr(,I0)= value(*);

   for (j=1; j <= nlast-1; j++) {
//    Increment "last" offset
      offset1(ndim-I1-1)= offset1(ndim-I1-1) + foldcount;

//    Read next fold
      value= nc_getvar( fhandle, varname, records=records,
                          offset=offset1, count=count1,
                          wrapoffset=wrapoffset, wrapcount=wrapcount  );
      outarr(,I0+j)= value(*);

   }

// Reshape output array and return
   outdims= array(long,ndim+1);
   outdims(I0)= ndim;
   outdims(I0+1:I0+ndim)= count;
   reshape_array, outarr, outdims;
   return timer_return(func_name, outarr);
}

if (param_set(records)) {
// Loop through unlimited dimension (recursively)
  if (is_null(offset)) {
//  Zero offset
    recofset= 0;
    offset1= NULL;

  } else {
//  Record offset
    recofset= offset(0);

    if (numberof(offset) > 1)
      offset1= offset(:-1);
    else
      offset1= NULL;
  }

  if (is_null(count)) {
//  Read all records
    nrec= records;
    count1= NULL;

  } else {
//  Read specified number of records
    nrec= count(0);

    if (numberof(count) > 1)
      count1= count(:-1);
    else
      count1= NULL;
  }

// Jump to first record, and read it
  jr, fhandle, 1+recofset;
  rec1= nc_getvar( fhandle, varname, offset=offset1, count=count1,
                            wrapoffset=wrapoffset, wrapcount=wrapcount );

// Create data array to hold all records
  dims= dimsof(rec1);
  dims= dim_reshape( dims, mindim=dims(1)+1 );

  dims(dims(1)+1)= nrec;
  recs= array( structof(rec1), dims );
  recs(*,1)= rec1(*);

// Read remaining records
  for (i=2; i<=nrec; i++) {
    jr, fhandle, i+recofset;
    recs(..,i)= nc_getvar( fhandle, varname, offset=offset1, count=count1,
                           wrapoffset=wrapoffset, wrapcount=wrapcount );
  }

  return timer_return(func_name,recs);
}


if (param_set(wrapcount)) {
// Handle wrap-around first dimension recursively

// Wrap offset
   if (param_set(wrapoffset))
      woffset= wrapoffset ;
   else
      woffset= 0;

// X offset
   if (!is_null(offset)) {
      xoffset= woffset + ( (wrapcount + ((offset(I0)-woffset) % wrapcount)) 
                          % wrapcount );
   } else {
      xoffset= 0;
   }

// X count
   if (!is_null(count)) xcount= count(I0) ;
                           else xcount= wrapcount;

   if (xcount > wrapcount) 
      error, "Not that many data elements in first (wrap-around) dimension";

   if (xoffset+xcount-1 < woffset+wrapcount) {
//    No wrap-around; simply read data and return
      offset1= NULL;
      if (!is_null(offset)) {
         offset1= offset;
         offset1(I0)= xoffset;
      }

      return timer_return(func_name, nc_getvar(fhandle, varname, offset=offset1, count=count));
   }

// Compute the two counts for the two parts
   acount= woffset + wrapcount - xoffset;
   bcount= xcount - acount;

   count1= (count2 = NULL);
   if (!is_null(count)) {
//    Count vectors
      count1= (count2 = count);
      count1(I0)= acount;
      count2(I0)= bcount;
   }

   offset1= (offset2 = NULL);
   if (!is_null(offset)) {
//    Offset vectors
      offset1= (offset2 = offset);
      offset1(I0)= xoffset;
      offset2(I0)= woffset;
   }

// Get first part
 part= nc_getvar(fhandle, varname, offset=offset1, count=count1);

// Create whole array, and copy first part
 dims= dimsof(part);
 dims(2)= xcount;
 whole= array(structof(part), dims);
 whole(1:acount,)= part(,);

// Get second part, combine, and return
 part= nc_getvar(fhandle, varname, offset=offset2, count=count2);
 whole(acount+1:,)= part(,);
 return timer_return(func_name,whole);

}


if (is_void(offset) && is_void(count)) {
// No offset/count specification
  return timer_return(func_name,get_member(fhandle,varname));
}

// Determine number of dimensions and lower index
if (is_void(offset)) {
  ndim= numberof(count);
  lo= array(1,ndim);
} else {
  ndim= numberof(offset);
  lo= 1+offset;
}

if (ndim > 6)
 error,"NC_GETVAR needs to be modified to read more than six dimensions";

if (is_void(count)) {

 if (ndim == 1) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):));
 } else if (ndim == 2) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):,lo(2):));
 } else if (ndim == 3) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):));
 } else if (ndim == 4) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):));
 } else if (ndim == 5) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):,lo(5):));
 } else if (ndim == 6) {
  return timer_return(func_name,get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):,lo(5):,lo(6):));
 }

}

// Compute upper index
hi= lo + count - 1;

if (ndim == 1) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1)));
} else if (ndim == 2) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2)));
} else if (ndim == 3) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3)));
} else if (ndim == 4) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4)));
} else if (ndim == 5) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4),lo(5):hi(5)));
} else if (ndim == 6) {
 return timer_return(func_name,get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4),lo(5):hi(5),lo(6):hi(6)));
}

}


func nc_getattr( fmeta, varname, attname)
/* DOCUMENT  nc_getattr(fmeta, varname, attname)
 * Get attribute ATTNAME of variable VARNAME from netCDF file descriptor FMETA.
 * (Specify VARNAME == "" for global attributes)
 * If ATTNAME == "", a list of all attribute names is returned.
 * A null value is returned if the attribute does not exist
 * SEE ALSO: nc_openf, nc_getdims, nc_getsize, nc_getvar, nc_vartype
 */
{ func_name= "nc_getattr"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

if (varname == "") {
// Get global attribute
   attributes= *fmeta.attrs;

} else {
// Get variable attribute
   vars= *fmeta.vars;

// Locate variable
   iwhere= where(vars.name == varname);
   if (!is_array(iwhere)) error, "Variable '" + varname + "' not found";
   ivar= iwhere(1);

// List of variable attributes
   attributes = *vars(ivar).attrs;
}

// Examine all attributes
atts= NULL;

for (i=1; i <= numberof(attributes); i++) {
   if (attname == "") {
//     Append attribute name
       grow, atts, attributes(i).name;

   } else {
      if (attname == attributes(i).name) {
//       Get value of attribute
         attvalue= *attributes(i).data;

//       Append value of attribute (converting chars to strings)
         if (typeof(attvalue) == "char")
            atts= string(&attvalue);
         else
            atts= attvalue(1);
//       Return attribute
         return timer_return(func_name,atts);
      }
   }
}

return timer_return(func_name,atts);

}


func nc_getdims( fmeta, varname)
/* DOCUMENT  nc_getdims(fmeta, varname)
 * Return a list of strings containing the dimensions of variable VARNAME
 * in netCDF file descriptor FMETA.
 * SEE ALSO: nc_openf, nc_dimsof, nc_getsize, nc_vartype
 */
{ func_name= "nc_getdims"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

// List of all dimensions and variables
alldims= *fmeta.dims
vars= *fmeta.vars

// Locate variable
iwhere= where(vars.name == varname)
if (!is_array(iwhere)) error, "Variable '" + varname + "' not found"
ivar= iwhere(1);

// List of variable dimensions
dimlist = *vars(ivar).dimlist;
ndim= numberof(dimlist);

dimnames= NULL;
if (ndim > 0) {
  for (j=ndim; j > 0; j--) {
    k= dimlist(j)
    grow, dimnames, alldims(k+1).name
  }
}

return timer_return(func_name,dimnames);

}


func nc_getsize( fmeta, dimname)
/* DOCUMENT  nc_getsize(fmeta, dimname)
 * Return the size of dimension DIMNAME in netCDF file descriptor FMETA.
 * (returns 0 for non-existent dimensions)
 * SEE ALSO: nc_openf, nc_getattr, nc_getdims, nc_getvar, nc_vartype
 */
{ func_name= "nc_getsize"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];


// List of all dimensions
alldims= *fmeta.dims;

// Locate dimension, and return dimension size
iwhere= where(alldims.name == dimname);

if (is_array(iwhere))
  return timer_return(func_name,alldims(iwhere(1)).size);
else
  return timer_return(func_name,0);

}


func nc_dimsof( fmeta, varname, records= )
/* DOCUMENT  nc_dimsof(fmeta, varname, records= )
 * Returns dimension count array for variable VARNAME
 * in netCDF file descriptor FMETA.
 * If RECORDS is defined, it contains the number of records in the
 * unlimited dimension (usually time).
 * SEE ALSO: nc_openf, nc_getdims
 */
{ func_name= "nc_dimsof"; timer_call,func_name;

// Compatibility parameters (including error handling)

// compatible.pro:
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];


dimlist= nc_getdims(fmeta, varname);
dims= array(long, numberof(dimlist)+1 );
ndims= numberof(dimlist);
dims(I0)= ndims;

for (k=I0; k <= ndims-I1; k++) {
   dims(1+k)= nc_getsize(fmeta, dimlist(k));
}

if (dims(1+ndims-I1) == 0) {
// Unlimited (record) dimension
   if (!param_set(records))
      error, "RECORDS should be specified for unlimited dimension";

   dims(1+ndims-I1)= records;
}

return timer_return(func_name, dims);

}


func nc_vartype( fmeta, varname)
/* DOCUMENT  nc_vartype(fmeta, varname)
 * Return variable type string, if variable VARNAME exists
 * in netCDF file descriptor FMETA. Otherwise return a null string.
 * SEE ALSO: nc_openf, nc_getattr, nc_getdims, nc_getsize, nc_getvar
 */
{ func_name= "nc_vartype"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

// List of all variables
vars= *fmeta.vars;

// Locate variable
iwhere= where(vars.name == varname)
if (!is_array(iwhere)) return timer_return(func_name,"");
ivar= iwhere(1);

// Return variable type
type_names= ["char", "char", "short", "long", "float", "double"];
return timer_return(func_name,type_names(vars(ivar).type));

}


func nc_dimvardef( fmeta, dimname, dimsize, type)
/* DOCUMENT nc_dimvardef, fmeta, dimname, dimsize, type
 *     -or- nc_dimvardef, fmeta, dimname, "unlimited", type
 *   define a named dimension in netCDF file descriptor FMETA,
 *   and also defines the associated variable of the same name,
 *   with type TYPE.
 *   The DIMSIZE parameter is the length of the dimension,
 *   or the string "unlimited" for the unlimited dimension.
 *  (The numerical value 0 is the same as "unlimited".)
 * SEE ALSO: nc_dimdef, nc_vardef
 */
{ func_name= "nc_dimvardef"; timer_call,func_name;

// Compatibility parameters (including error handling)

// compatible.pro:
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];


// Define dimension
nc_dimdef, fmeta, dimname, dimsize;

// Define associated variable
if (typeof(dimsize) == "string") {
   record= 1;
} else {
   record= (dimsize == 0);
}

nc_vardef, fmeta, dimname, type, dimnames=[dimname], record=record;

return timer_return(func_name);

}


func nc_putvar( fhandle, varname, value, offset=, count=,
                                         record=, nchar=, reshape=)
/* DOCUMENT  nc_putvar, fhandle, varname, value, offset=, count=,
 *                      record=0/1, nchar=, reshape=0/1
 * Write a hyperslab of data VALUEs for variable VARNAME to netCDF file handle
 * FHANDLE, with optional OFFSET and COUNT parameters for each dimension.
 * If RECORD==1, OFFSET should be specified, and the last offset value
 *  would correspond to the offset in the unlimited dimension (usually time).
 *  (The RECORD parameter is used by the Yorick version only.)
 * If NCHAR is specified, strings are converted to character arrays
 * of  length NCHAR.
 * If RESHAPE==1, VALUE is reshaped to conform to COUNT, or
 *  if COUNT is null, VALUE is assumed to represent a scalar.
 * SEE ALSO: nc_openf, nc_enddef, nc_addrec
 */
{ func_name= "nc_putvar"; timer_call,func_name;
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

if (param_set(reshape)) {
// Reshape flag for output array
   reshape_flag= 0;

   ndim= numberof(count);
   dims= dimsof(value);

   if (dims(1) != ndim) {
      reshape_flag= 1;

   } else {
      if (ndim > 0) {
         reshape_flag= (max(abs(dims(2:1+ndim) - count)) != 0);
      }
   }

   if (reshape_flag) {
      if (ndim == 0) {
//       Write scalar and return
         if (numberof(value) != 1)
            error, "Incorrect no. of values for variable";
         nc_putvar, fhandle, varname, value(1), offset=offset, count=count,
                                                record=record, nchar=nchar;
         return timer_return(func_name);

      } else {
//       Write reshaped array and return
         newdim= array(long,ndim+1);
         newdim(1)= ndim;
         newdim(2:1+ndim)= count;
         temval= array(structof(value), newdim);

         if (numberof(value) != numberof(temval))
            error, "Incorrect no. of values for variable";

//       Copy reshaped value and output it
         temval(*)= value(*);
         nc_putvar, fhandle, varname, temval, offset=offset, count=count,
                                              record=record, nchar=nchar;
         return timer_return(func_name);
      }
   }

}

if (param_set(nchar) && (typeof(value) == "string")) {
// Convert strings to character arrays
   nstr= numberof(value);
   newvalue= array(char,nchar, nstr);
   for (j=I0; j <= nstr-I1; j++) {
      newvalue(I0:1+strlen(value(j))-I1,j)= *pointer(value(j));
   }

// New dimensions
   dims= dimsof(value);
   newdims= [dims(I0)+1, nchar];
   grow, newdims, dims(I0+1:);

   reshape_array, newvalue, newdims;

   if (is_null(count)) {
      count1= NULL;
   } else {
      count1= [nchar];
      grow, count1, count;
   }

   if (is_null(offset)) {
      offset1= NULL;
   } else {
      offset1= [0];
      grow, offset1, offset;
   }

// Write byte array and return
   nc_putvar, fhandle, varname, newvalue, offset=offset1, count=count1,
                                          record=record;
   return timer_return(func_name);
}

if (param_set(record)) {
// Loop through unlimited dimension (recursively)
  recofset= offset(0);
  if (numberof(offset) > 1) {
    offset1= offset(:-1);
  } else {
    offset1= NULL;
  }

  if (numberof(count) > 1) {
//  Write specified number of subrange records
    nrec= count(0);
    count1= count(:-1);

  } else if (numberof(count) == 1) {
//  Write specified number of full-range records
    nrec= count(0);
    count1= NULL;

  } else {
//  Write single full-range record
    nrec= 1;
    count1= NULL;
  }

// Jump to each record, and write values
  for (i=1; i<=nrec; i++) {
    jr, fhandle, i+recofset;
    get_member(fhandle,varname)= value(..,i);
  }

  return timer_return(func_name);
}

if (is_void(offset) && is_void(count)) {
// No offset/count specification
  get_member(fhandle,varname)= value;

  return timer_return(func_name);

}

// Determine number of dimensions and lower index
if (is_void(offset)) {
  ndim= numberof(count);
  lo= array(1,ndim);
} else {
  ndim= numberof(offset);
  lo= 1+offset;
}

if (ndim > 6)
 error,"NC_PUTVAR needs to be modified to write more than six dimensions";

if (is_void(count)) {

 if (ndim == 1) {
  get_member(fhandle,varname)(lo(1):)= value;
 } else if (ndim == 2) {
  get_member(fhandle,varname)(lo(1):,lo(2):)= value;
 } else if (ndim == 3) {
  get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):)= value;
 } else if (ndim == 4) {
  get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):)= value;
 } else if (ndim == 5) {
  get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):,lo(5):)= value;
 } else if (ndim == 6) {
  get_member(fhandle,varname)(lo(1):,lo(2):,lo(3):,lo(4):,lo(5):,lo(6):)= value;
 }

 return timer_return(func_name);

}

// Compute upper index
hi= lo + count - 1;

if (ndim == 1) {
 get_member(fhandle,varname)(lo(1):hi(1))= value;
} else if (ndim == 2) {
 get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2))= value;
} else if (ndim == 3) {
 get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3))= value;
} else if (ndim == 4) {
 get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4))= value;
} else if (ndim == 5) {
 get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4),lo(5):hi(5))= value;
} else if (ndim == 6) {
 get_member(fhandle,varname)(lo(1):hi(1),lo(2):hi(2),lo(3):hi(3),                                           lo(4):hi(4),lo(5):hi(5),lo(6):hi(6))= value;
}

return timer_return(func_name);

}


func nc_recvars( fmeta)
/* DOCUMENT  nc_recvars(fmeta)
 * Return list of all record variables in file, or null value if none.
 * (Variables with names starting with "time..." and "date..." are excluded)
 * SEE ALSO: nc_openf, nc_getattr, nc_getdims, nc_getsize, nc_vartype
 */
{

// Compatibility parameters (including error handling)

// compatible.pro:
// Parameters for IDL/Yorick compatibility (including error handling)

// Array starting index offset, and final index negative offset
// (0, 1 in IDL; 1, 0 in Yorick)
I0=1 ; I1=0;

// Null value ("" in IDL; [] in Yorick)
NULL= [];

// List of dimensions/variables in file
alldims= *fmeta.dims;
vars= *fmeta.vars;

recvars= [];

// Examine list of all variables
for (ivar=I0; ivar <= numberof(vars)-I1; ivar++) {

// Get variable dimension list
   dimlist= *vars(ivar).dimlist;

   if (numberof(dimlist) > 0) {
//    Check if variable contains record dimension
      vardims= alldims(dimlist+1);

      if (anyof(vardims.name == "time")) {
         varname= vars(ivar).name;
         timevar= 0;
         if (strlen(varname) >= 4) {
           timevar= (strtolower(strmid(varname,0,4)) == "time") ||
                    (strtolower(strmid(varname,0,4)) == "date");
         }
         if (!timevar) 
            grow, recvars, varname;
      }
   }
}

return  recvars;

}


func raw_not_cdf(f)
{
  i= array(char, 4);
  _read, f, 0, i;
  if (string(&i)!="CDF\001") return 1;  /* test magic number */

  xdr_primitives, f;

  numrecs= long(0);
  _read, f, 4, numrecs;

  /* Each of the major components of a netCDF file contains information
     not used by Yorick.  Specifically, dimensions are named, the file
     may have attributes, and any variable contained in the file may
     have attributes.  After a call to nc_open, this additional
     information is stored in the external variable nc_file.  */
  extern nc_file;

  pf= print(f);
  name= dir= "";
  sread, pf(where(strmatch(pf,"binary stream:"))), dir, name,
    format= "%s binary stream: %s";
  sread, pf(where(strmatch(pf,"In directory:"))), dir,
    format= " In directory: %s";

  address= 8;
  nc_dims= NC_ReadArray(f, address);
  nc_attrs= NC_ReadArray(f, address);
  nc_vars= NC_ReadArray(f, address);
  nc_file= NC_file(numrecs=numrecs, dims=&nc_dims, attrs=&nc_attrs,
		   vars=&nc_vars, filename=dir+name);

  if (_nc_declare(f, nc_file)) {
    /* check for presence of a file family */
    dims= dimsof(_nc_open_filename);
    ifile= (!is_void(dims) && dims(1));
    while (!_nc_add_next_file(f, ifile)) {
      i= array(char, 4);
      _read, f, 0, i;
      if (string(&i)!="CDF\001") break;  /* test magic number */
      _read, f, 4, numrecs;
      if (!numrecs) continue;
      nc_file.numrecs= numrecs;
      address= 8;
      dims= NC_ReadArray(f, address);
      attrs= NC_ReadArray(f, address);
      vars= NC_ReadArray(f, address);
// *** MODIFICATION ***
      if (numberof(dims)!=numberof(nc_dims) ||
	  anyof(dims.size!=nc_dims.size) ||
	  !_nc_declare(f, nc_file, vars))
        error, "File '"+_nc_open_filename(ifile)+"' has different structure";
    }
  }

  jr, f, 1;
  return 0;
}

func _nc_add_next_file(f, &ifile)
{
  /* modified add_next file checks whether nc_open has been called
   * with an explicit list of file names
   * -- eventually this should be installed in openb generally
   */
  if (!ifile) return add_next_file(f);
  ifile+= 1;
  if (ifile>numberof(_nc_open_filename)) return 1;
// *** MODIFICATION ***
  if (add_next_file(f, _nc_open_filename(ifile), 0))
     error, "File '"+_nc_open_filename(ifile)+"' not found";
  return 0;
}


/*
 *----------------------------------------------------------------------
 * RCS identification:
 * $Author:$; $Locker:$
 * $Revision:$; $Date:$ GMT; $State:$
 * $Source:$
 *--------------------------------------------------------------------
 * For GNU Emacs:
 * $Msg-digest-checksum: cab348c7fc67bd3fb563d1ed77f553b8 $
 *--------------------------------------------------------------------
 * Local Variables:
 * mode: C
 * msg-digest-active: t
 * End:
 *--------------------------------------------------------------------
 */