Utils.R

.message <- function(...) {
  # Function to use the 'message' R function with our custom settings
  # Default: new line at end of message, indent to 0, exdent to 3, 
  #  collapse to \n*
  args <- list(...)

  ## In case we need to specify message arguments
  if (!is.null(args[["appendLF"]])) {
    appendLF <- args[["appendLF"]]
  } else {
    ## Default value in message function
    appendLF <- TRUE
  } 
  if (!is.null(args[["domain"]])) {
    domain <- args[["domain"]]
  } else {
    ## Default value in message function
    domain <- NULL
  }
  args[["appendLF"]] <- NULL
  args[["domain"]] <- NULL

  ## To modify strwrap indent and exdent arguments
  if (!is.null(args[["indent"]])) {
    indent <- args[["indent"]]
  } else {
    indent <- 0
  }
  if (!is.null(args[["exdent"]])) {
    exdent <- args[["exdent"]]
  } else {
    exdent <- 3
  }
  args[["indent"]] <- NULL
  args[["exdent"]] <- NULL

  ## To modify paste collapse argument
  if (!is.null(args[["collapse"]])) {
    collapse <- args[["collapse"]]
  } else {
    collapse <- "\n*"
  }
  args[["collapse"]] <- NULL

  ## Message tag
  if (!is.null(args[["tag"]])) {
    tag <- args[["tag"]]
  } else {
    tag <- "* "
  }
  args[["tag"]] <- NULL

  message(paste0(tag, paste(strwrap(
    args, indent = indent, exdent = exdent
    ), collapse = collapse)), appendLF = appendLF, domain = domain)
}

.warning <- function(...) {
  # Function to use the 'warning' R function with our custom settings
  # Default: no call information, indent to 0, exdent to 3, 
  #  collapse to \n
  args <- list(...)

  ## In case we need to specify warning arguments
  if (!is.null(args[["call."]])) {
    call <- args[["call."]]
  } else {
    ## Default: don't show info about the call where the warning came up
    call <- FALSE
  }
  if (!is.null(args[["immediate."]])) {
    immediate <- args[["immediate."]]
  } else {
    ## Default value in warning function
    immediate <- FALSE
  }
  if (!is.null(args[["noBreaks."]])) {
    noBreaks <- args[["noBreaks."]]
  } else {
    ## Default value warning function
    noBreaks <- FALSE
  }
  if (!is.null(args[["domain"]])) {
    domain <- args[["domain"]]
  } else {
    ## Default value warning function
    domain <- NULL
  }
  args[["call."]] <- NULL
  args[["immediate."]] <- NULL
  args[["noBreaks."]] <- NULL
  args[["domain"]] <- NULL

  ## To modify strwrap indent and exdent arguments
  if (!is.null(args[["indent"]])) {
    indent <- args[["indent"]]
  } else {
    indent <- 0
  }
  if (!is.null(args[["exdent"]])) {
    exdent <- args[["exdent"]]
  } else {
    exdent <- 3
  }
  args[["indent"]] <- NULL
  args[["exdent"]] <- NULL

  ## To modify paste collapse argument
  if (!is.null(args[["collapse"]])) {
    collapse <- args[["collapse"]]
  } else {
    collapse <- "\n!"
  }
  args[["collapse"]] <- NULL

  ## Warning tag
  if (!is.null(args[["tag"]])) {
    tag <- args[["tag"]]
  } else {
    tag <- "! Warning: "
  }
  args[["tag"]] <- NULL

  warning(paste0(tag, paste(strwrap(
    args, indent = indent, exdent = exdent
    ), collapse = collapse)),  call. = call, immediate. = immediate, 
    noBreaks. = noBreaks, domain = domain)
}

# This function is a helper for the function .MergeArrays.
# It expects as inputs two named numeric vectors, and it extends them
# with dimensions of length 1 until an ordered common dimension
# format is reached.
.MergeArrayDims <- function(dims1, dims2) {
  new_dims1 <- c()
  new_dims2 <- c()
  while (length(dims1) > 0) {
    if (names(dims1)[1] %in% names(dims2)) {
      pos <- which(names(dims2) == names(dims1)[1])
      dims_to_add <- rep(1, pos - 1)
      if (length(dims_to_add) > 0) {
        names(dims_to_add) <- names(dims2[1:(pos - 1)])
      }
      new_dims1 <- c(new_dims1, dims_to_add, dims1[1])
      new_dims2 <- c(new_dims2, dims2[1:pos])
      dims1 <- dims1[-1]
      dims2 <- dims2[-c(1:pos)]
    } else {
      new_dims1 <- c(new_dims1, dims1[1])
      new_dims2 <- c(new_dims2, 1)
      names(new_dims2)[length(new_dims2)] <- names(dims1)[1]
      dims1 <- dims1[-1]
    }
  }
  if (length(dims2) > 0) {
    dims_to_add <- rep(1, length(dims2))
    names(dims_to_add) <- names(dims2)
    new_dims1 <- c(new_dims1, dims_to_add)
    new_dims2 <- c(new_dims2, dims2)
  }
  list(new_dims1, new_dims2)
}

# This function takes two named arrays and merges them, filling with
# NA where needed.
# dim(array1)
#          'b'   'c'         'e'   'f'
#           1     3           7     9
# dim(array2)
#    'a'   'b'         'd'         'f'   'g'
#     2     3           5           9     11
# dim(.MergeArrays(array1, array2, 'b'))
#    'a'   'b'   'c'   'e'   'd'   'f'   'g'
#     2     4     3     7     5     9     11
.MergeArrays <- function(array1, array2, along) {
  if (!(identical(names(dim(array1)), names(dim(array2))) &&
      identical(dim(array1)[-which(names(dim(array1)) == along)],
                dim(array2)[-which(names(dim(array2)) == along)]))) {
    new_dims <- .MergeArrayDims(dim(array1), dim(array2))
    dim(array1) <- new_dims[[1]]
    dim(array2) <- new_dims[[2]]
    for (j in 1:length(dim(array1))) {
      if (names(dim(array1))[j] != along) {
        if (dim(array1)[j] != dim(array2)[j]) {
          if (which.max(c(dim(array1)[j], dim(array2)[j])) == 1) {
            na_array_dims <- dim(array2)
            na_array_dims[j] <- dim(array1)[j] - dim(array2)[j]
            na_array <- array(dim = na_array_dims)
            array2 <- abind(array2, na_array, along = j)
            names(dim(array2)) <- names(na_array_dims)
          } else {
            na_array_dims <- dim(array1)
            na_array_dims[j] <- dim(array2)[j] - dim(array1)[j]
            na_array <- array(dim = na_array_dims)
            array1 <- abind(array1, na_array, along = j)
            names(dim(array1)) <- names(na_array_dims)
          }
        }
      }
    }
  }
  array1 <- abind(array1, array2, along = which(names(dim(array1)) == along))
  names(dim(array1)) <- names(dim(array2))
  array1
}

# The functions from here on are copies of some functions in 'ncdf4' package 
# with a small bugfix in ncvar_get_inner. When ncdf4 addresses this bug, these 
# function will be removed from this package.
# This code belongs to David Pierce.
.ncvar_size <- function( ncid, varid ) {

	if( mode(ncid) != 'numeric' ) 
		stop(paste("error, must be passed a numeric first arg: ncid2use, not an arg of mode", mode(ncid)))

	if( mode(varid) != 'numeric' )
		stop("Error, must be passed a numeric second arg: varid2use" )

	ndims <- .ncvar_ndims( ncid, varid )
	if( ndims == 0 )
		#return(vector())	changed DWP 2012-09-20
		return(1)		# indicates a scalar var

	rv         <- list()
	rv$error   <- -1
	rv$varsize <- integer(ndims)
	rv$ndims   <- -1
	rv <- .C("R_nc4_varsize",
		as.integer(ncid),
		as.integer(varid),
		ndims=as.integer(rv$ndims),
		varsize=as.integer(rv$varsize),
		error=as.integer(rv$error),
		PACKAGE="easyNCDF")
	if( rv$error != 0 ) 
		stop("error returned from C routine R_nc4_varsize")

	#-------------------------------------
	# Switch order from C-style to R-style
	#-------------------------------------
	rv$varsize <- rv$varsize[ ndims:1 ]

	return(rv$varsize)
}

.ncvar_type <- function( ncid, varid, output_string=FALSE ) {

	if( mode(ncid) != 'numeric' )
		stop("error, must be passed a numeric first arg: ncid2use")

	if( mode(varid) != 'numeric' )
		stop("Error, must be passed a numeric second arg: varid2use" )

	rv         <- list()
	rv$error   <- -1
	rv$precint <- -1

	rv <- .C("R_nc4_inq_vartype", 
		as.integer(ncid),
		as.integer(varid),	
		precint=as.integer(rv$precint),
		error=as.integer(rv$error),
		PACKAGE="easyNCDF")
	if( rv$error != 0 ) 
		stop("error returned from C call")
	return( rv$precint )
}

.ncvar_ndims <- function( ncid, varid ) {

	if( mode(ncid) != 'numeric' )
		stop(paste("error, ncvar_ndims must be passed a numeric first arg; mode of val passed=", mode(ncid)))

	if( mode(varid) != 'numeric' )
		stop("Error, ncvar_ndims must be passed a numeric second arg: varid2use" )

	rv <- list()
	rv$error <- -1
	rv$ndims <- -1
	rv <- .C("R_nc4_inq_varndims", 
		as.integer(ncid),
		as.integer(varid),
		ndims=as.integer(rv$ndims),
		error=as.integer(rv$error),
		PACKAGE="easyNCDF")
	if( rv$error != 0 ) 
		stop("error returned from C call")
	return( rv$ndims )
}

.blankstring_ncdf4 <- function( n ) {

	rv <- .Call("R_nc4_blankstring", as.integer(n), PACKAGE="easyNCDF")
	return( rv )
}

.ncvar_type_to_string <- function( precint ) {

	if( precint == 1 )
		prec <- "short"
	else if( precint == 2 )
		prec <- "int"
	else if( precint == 3 )
		prec <- "float"
	else if( precint == 4 )
		prec <- "double"
	else if( precint == 5 )
		prec <- "char"
	else if( precint == 6 )
		prec <- "byte"
	else if( precint == 7 )
		prec <- "unsigned byte"
	else if( precint == 8 )
		prec <- "unsigned short"
	else if( precint == 9 )
		prec <- "unsigned int"
	else if( precint == 10 )
		prec <- "8 byte int"
	else if( precint == 11 )
		prec <- "unsinged 8 byte int"
	else if( precint == 12 )
		prec <- "string"
	else
		stop(paste("Error, unrecognized type code of variable supplied:", precint ))

	return( prec )
}

.ncvar_get_inner <- function( ncid, varid, missval, addOffset=0., scaleFact=1.0, start=NA, count=NA, verbose=FALSE, signedbyte=TRUE, 
		collapse_degen=TRUE, raw_datavals=FALSE ) {

	if( ! is.numeric(ncid))
		stop("Error, first arg passed to ncvar_get_inner (ncid) must be a simple C-style integer that is passed directly to the C api")
	if( ! is.numeric(varid))

		stop("Error, second arg passed to ncvar_get_inner (varid) must be a simple C-style integer that is passed directly to the C api")

	if( verbose ) {
		print(paste("ncvar_get_inner: entering with (C-STYLE INTEGER ONLY) ncid=", ncid, 
			"varid=", varid ))
		print(paste("ncvar_get_inner: following line is collapse_degen:"))
		print(collapse_degen)
		}

	tmp_typename = c('short', 'int', 'float', 'double', 'char', 'byte' )

	have_start = (length(start)>1) || ((length(start)==1) && (!is.na(start)))
	have_count = (length(count)>1) || ((length(count)==1) && (!is.na(count)))

	sm <- storage.mode(start)
	if( (sm != "double") && (sm != "integer") && (sm != "logical"))
		stop(paste("passed a start argument of storage mode",sm,"; can only handle double or integer"))
	sm <- storage.mode(count)
	if( (sm != "double") && (sm != "integer") && (sm != "logical"))
		stop(paste("passed a 'count' argument with storage mode '",sm,"'; can only handle double or integer", sep=''))

	if( signedbyte )
		byte_style = 1	# 1=signed
	else
		byte_style = 2	# 2=unsigned

	varsize <- .ncvar_size ( ncid, varid )
	ndims   <- .ncvar_ndims( ncid, varid )
	if( verbose ) {
		print(paste("ndims:",ndims))
		print("ncvar_get: varsize:")
		print(varsize)
		}

	#------------------------------
	# Fix up start and count to use
	#------------------------------
	if( ndims == 0 ) {
		start <- 1
		count <- 1
		}
	else
		{
		if( ! have_start )
			start <- rep(1,ndims)	# Note: use R convention for now
		if( ! have_count )
			count <- varsize - start + 1	
		else
			{
			#------------------
			# Take care of -1's
			#------------------
			count <- ifelse( (count == -1), varsize-start+1, count)
			}
		}
	if( verbose ) {
		print("ncvar_get: start:")
		print(start)
		print("ncvar_get: count:")
		print(count)
		}

	if( ndims > 0 ) {
		if( length(start) != ndims ) 
			stop(paste("Error: variable has",ndims,"dims, but start has",length(start),"entries.  They must match!"))
		if( length(count) != ndims ) 
			stop(paste("Error: variable has",ndims,"dims, but count has",length(count),"entries.  They must match!"))
		}

	#----------------------------------------
	# Need to know how much space to allocate
	#----------------------------------------
	totvarsize <- prod(count)
	if( verbose )
		print(paste("ncvar_get: totvarsize:",totvarsize))
	
	#--------------------------------------------------
	# Switch from R to C convention for start and count
	#--------------------------------------------------
	c.start <- start[ ndims:1 ] - 1
	c.count <- count[ ndims:1 ]

	rv <- list()
	rv$error <- -1

	#---------------------------------
	# Get the correct type of variable
	#---------------------------------
	precint <- .ncvar_type( ncid, varid ) # 1=short, 2=int, 3=float, 4=double, 5=char, 6=byte, 7=ubyte, 8=ushort, 9=uint, 10=int64, 11=uint64, 12=string
	if( verbose )
		print(paste("ncvar_get_inner: getting var of type",tmp_typename[precint], 'id=', precint))

	if( (precint == 1) || (precint == 2) || (precint == 6) || (precint == 7) || (precint == 8)) {
		#--------------------------------
		# Short, Int, Byte, UByte, UShort
		#--------------------------------
		rv <- .Call("Rsx_nc4_get_vara_int", 
			as.integer(ncid),
			as.integer(varid),	
			as.integer(c.start),	# Already switched to C convention...
			as.integer(c.count),	# Already switched to C convention...
			as.integer(byte_style), # 1=signed, 2=unsigned
			PACKAGE="easyNCDF")
		if( rv$error != 0 ) 
			stop("C function Rsx_nc4_get_var_int returned error")
		data = rv$data
		}

	else if( (precint == 3) || (precint == 4)) {
		#----------------------------------------------------------------
		# Float, double where we have the C routine fix the missing value
		# 'imvstate' is: 0 if we do not have a missing value (it is NULL),
		# 1 if the missing value is NA, 2 if the missing value is present
		# and not NULL and not NA. These codes are used by the C routine
		#----------------------------------------------------------------
		if( is.null( missval )) {
			passed_missval = 0.0
			imvstate = as.integer(0)
			}
		else if( is.na(missval)) {
			passed_missval = 0.0
			imvstate = as.integer(1)
			}
		else
			{
			passed_missval = missval
			imvstate = as.integer(2)
			}

		if( raw_datavals )
			fixmiss = as.integer(0)	# setting 'raw_datavalues' to TRUE gives the actual raw numbers from the file, not processed at all
		else
			fixmiss = as.integer(1)

		if( verbose ) print('about to call Rsx_nc4_get_vara_double...')
		rv <- .Call("Rsx_nc4_get_vara_double", 
			as.integer(ncid),
			as.integer(varid),
			as.integer(c.start),	# Already switched to C convention...
			as.integer(c.count),	# Already switched to C convention...
			fixmiss,
			imvstate,
			as.double(passed_missval),
			PACKAGE="easyNCDF")
		if( rv$error != 0 ) 
			stop("C function R_nc4_get_vara_double returned error")
		if( verbose ) print('back from call to Rsx_nc4_get_vara_double...')
		data = rv$data
		}

	else if( (precint == 9) || (precint == 10) || (precint == 11)) {
		#---------------------------------------------
		# uint, int64, uint64
		# Thanks to Tom Hilinski of Colorado State for
		# fix to uint here
		#---------------------------------------------
		rv$data  <- double(totvarsize)
		fixmiss = as.integer(0)
		rv <- .Call("Rsx_nc4_get_vara_double", 
			as.integer(ncid),
			as.integer(varid),
			as.integer(c.start),	# Already switched to C convention...
			as.integer(c.count),	# Already switched to C convention...
			fixmiss,
			as.integer(-1),		# The 'imvstate' arg is unused in this call since no fixmiss
			as.double(0.0),		# the passed missing value is not used in this call since no fixmiss
			PACKAGE="easyNCDF")
		if( rv$error != 0 ) 
			stop("C function R_nc4_get_vara_double returned error")
		data = rv$data
		}

	else if( precint == 5 ) {
		#-----
		# Char 
		#-----
		strndims <- ndims - 1
		strlen   <- count[1] + 1
		strdim   <- 1
		if( strndims >= 1 ) {
			strdim <- count[2:ndims]
			nstr   <- prod(strdim)
			}
		else
			nstr <- 1
		if(verbose)
			print(paste("ndims:",ndims,"strndims:",strndims,"strlen:",strlen,"nstr:",nstr))

		#----------------------------------------------
		# Make a character string of the specified size
		#----------------------------------------------
		stor     <- .blankstring_ncdf4( totvarsize )
		stordata <- .blankstring_ncdf4(strlen)
		if( verbose )
			print(paste("length of stor string:",nchar(stor)))
		rv$tempstore <- stor
		rv$data      <- array(stordata, dim=strdim)

		rv <- .C("R_nc4_get_vara_text", 
			as.integer(ncid),
			as.integer(varid),
			as.integer(c.start),	# Already switched to C convention...
			as.integer(c.count),	# Already switched to C convention...
			tempstore=as.character(rv$tempstore),
			data=as.character(rv$data),
			error=as.integer(rv$error),
			PACKAGE="easyNCDF")
		if( rv$error != 0 ) 
			stop("C function R_nc4_get_var_text returned error")

		dim(rv$data) <- strdim
		}

	else if( precint == 12 ) {
		#-----------------------------
		# netcdf version 4 String type
		#-----------------------------
		rv <- .Call( "R_nc4_get_vara_string",
			as.integer(ncid),
			as.integer(varid),
			as.integer(c.start),    # Already switched to C convention...
			as.integer(c.count),    # Already switched to C convention...
			PACKAGE="easyNCDF" )
		}
	else
		{
		stop(paste("Trying to get variable of an unhandled type code: ",precint, "(", .ncvar_type_to_string(precint), ")"))
		}
	if( verbose ) {
		print(paste("ncvar_get_inner: C call returned",rv$error))
		print(paste("ncvar_get_inner: dim of directly returned array:"))
		print(dim(rv$data))
		}

	#--------------------------------------------------------
	# Set our dims...but collapse degenerate dimensions first
	#--------------------------------------------------------
	if( ndims > 0 ) {
		if( collapse_degen ) {
			count.nodegen <- vector()
			foundone <- 0
			for( i in 1:ndims )
				if( count[i] > 1 ) {
					count.nodegen <- append(count.nodegen, count[i])
					foundone <- 1
					}
			if( foundone == 0 ) 
				dim(rv$data) <- (1)
			else
				{
				if( verbose )
					print(paste("count.nodegen:",count.nodegen,"   Length of data:",length(rv$data)))
				if( precint != 5 )
					dim(rv$data) <- count.nodegen
				}
			}
		else if (precint != 5)
			dim(rv$data) = count

		if( verbose ) {
			print("ncvar_get: final dims of returned array:")
			print(dim(rv$data))
			}
		}

	#----------------------------------------------------------
	# Change missing values to "NA"s.  Note that 'varid2Rindex'
	# is NOT filled out for dimvars, so skip this if a dimvar
	# 1=short, 2=int, 3=float, 4=double, 5=char, 6=byte
	# NOTE: if type is 3 or 4 (float or double), the missing
	# value was already set by the C routine.
	#----------------------------------------------------------
	if( (!raw_datavals) && (precint != 5) && (precint != 3) && (precint != 4) ) {	# not char, float, or double
		if( verbose ) print("ncvar_get: setting missing values to NA")
		if( (precint==1) || (precint==2) || (precint==6) || (precint==7) || (precint==8) || (precint==9)) {
			#--------------------------------------
			# Short, Int, Byte, UByte, UShort, UInt
			#--------------------------------------
			if( verbose ) print(paste("ncvar_get_inner: setting ", tmp_typename[precint],"-type missing value of ", missval, " to NA", sep=''))
			if( ! is.na(missval) ) 
				rv$data[rv$data==missval] <- NA
			}
		else if( (precint==10) || (precint==11)) {
			#--------------------------------
			# 8-byte int, unsigned 8-byte int
			#--------------------------------
			if( ! is.na(missval) ) {
				tol <- abs(missval*1.e-5)
				if( verbose ) print(paste("ncvar_get_inner: setting ", tmp_typename[precint],"-type missing value of ", missval, 
					" (w/tolerance ", tol,") to NA", sep=''))
				rv$data[abs(rv$data-missval)<tol] <- NA
				}
			}
		}

	#--------------------------------------
	# Implement add_offset and scale_factor
	#--------------------------------------
	if( ! raw_datavals ) {
		if( (scaleFact != 1.0) || (addOffset != 0.0) ) {
			if( verbose ) 
				print(paste("ncvar_get: implementing add_offset=", addOffset, " and scaleFact=", scaleFact ))
			rv$data <- rv$data * scaleFact + addOffset
			}
		}

	return(rv$data)
}

.ncdf4_inner_open <- function( nc ) {

	if( class( nc ) != 'ncdf4' ) 
		stop(paste("ncdf4 library: internal error: ncdf4_inner_open called with an object that is NOT class ncdf4!"))

	rv <- list()

	if( is.null(nc$writable)) 
		stop(paste("Internal error: ncdf4_inner_open called with no $writable element on file", nc$filename))
	if( nc$writable )
		rv$cmode <- 1
	else
		rv$cmode <- 0

	rv$id    <- -1
	rv$error <- -1
	rv <- .C("R_nc4_open",
		as.character(nc$filename),
		as.integer(rv$cmode),		# write mode=1, read only=0
		id=as.integer(rv$id),		# note: nc$id is the simple integer ncid of the base file (root group in the file)
		error=as.integer(rv$error),
		PACKAGE="easyNCDF")
	if( rv$error != 0 ) 
		stop(paste("Error in nc_open trying to open file",nc$filename))

	return( rv$id )
}

.ncdf4_make_id <- function( id=-1, group_index=-1, group_id=-1, list_index=-1, isdimvar=FALSE ) {

	retval	  	  <- list( id=id, group_index=group_index, group_id=group_id,
				list_index=list_index, isdimvar=isdimvar )
	class(retval)  	  <- 'ncid4'
	return( retval )
}

.vobjtovarid4 <- function( nc, varid, verbose=FALSE, allowdimvar=TRUE) {

	if( verbose )
		print(paste("vobjtovarid4: entering"))

	if( class(nc) != 'ncdf4' )
		stop('First passed argument (nc) must be an object of class ncdf4, as returned by nc_open() or nc_create()')

	if( (class(varid) != 'ncvar4') && (class(varid) != 'ncdim4') && (class(varid) != 'ncid4') && (!is.character(varid)) && (!is.na(varid)))
		stop('Second passed argument (varid) must be an object of class ncvar4 or ncid4, the character string name of a variable, or a NA (indicating to use the only var in the file)')

	#-------------------------------------------------------------
	# Easiest case is if we were given a ncid object to begin with
	#-------------------------------------------------------------
	if( class(varid) == 'ncid4' ) {
		if(verbose) print("vobjtovarid4: passed varid was an ncid, easy exit")
		return( varid ) 	# an object of class 'ncid4', not a simple integer
		}

	#------------------------------------------------------------
	# Handle case where we are given a ncvar object to begin with
	#------------------------------------------------------------
	if( class(varid) == "ncvar4" ) {

		origvarid <- varid
		if(verbose)
			print(paste("vobjtovarid4: passed a ncvar class, name=",varid$name))
		varid <- nc$var[[varid$name]]$id # Note we do NOT use varid$id in case var is from different file (but names are same)
		if( is.null(varid)) {
			print('------------------------------------------------------')
			print(paste("Error, var '", origvarid$name,"' was not found in file '", nc$filename, "'", sep=''))
			print(paste('Hint: make SURE the variable was not only defined with a call to ncvar_def(), but also included in the list of variables passed to nc_create()'))
			stop('stopping')
			}
		if( class(varid) != 'ncid4' ) {
			print('------------------------------')
			print("here is varid:")
			print(varid)
			stop(paste("Internal error #E, returned varid is not a object of class ncid4"))
			}

		#-----------------------------------------------------------------
		# Make sure this varid that will be returned has valid information
		#-----------------------------------------------------------------
		varidOK <- ((varid$id>=0) && (varid$id<=100000) && (varid$group_id >= 0))
		if( is.na(varidOK) || (!varidOK)) {
			print("vobjtovarid4: I was passed a ncvar object, BUT this object does NOT refer to any valid var in the netcdf file!")
			print(paste("This happened for netCDF filename:",nc$filename))
			print("Here are the vars in the netCDF file:")
			for( ii in 1:nc$nvars )
				print(paste(ii,": ",nc$var[[ii]]$name, sep='' ))
			print(paste("The passed varid object (which does NOT exist in that file) is:"))
			print(origvarid)
			print(paste("Hint: make SURE the variable was not only defined with a call to ncvar_def(), but also included in the list of variables passed to nc_create()"))
			stop("stopping")
			}
		
		if( verbose )
			print(paste("vobjtovarid4: returning with varid deduced from a passed ncvar object; varid=",
				varid$group_id, varid$id))
		return(varid)	# an object of class 'ncid4'
		}

	#-------------------------------------------------------------
	# Handle case where we are given an ncdim object to begin with 
	#-------------------------------------------------------------
	if( class(varid) == "ncdim4" ) {

		if( ! allowdimvar )
			stop(paste("Error, I was NOT allowed to check dimvars, but the second argument passed was an object of class ncdim4!  Name=", varid$name))

		if(verbose)
			print(paste("vobjtovarid4: passed a ncdim class, name=",varid$name))

		#-----------------------------------------------------------
		# Go through and find if there is a dim in the file that has
		# the same name as this dim.  We do not immediately use
		# this dim's dimvarid in case the dim is from a different
		# file but has the same name.
		#-----------------------------------------------------------
		name2find = varid$name
		foundit   = FALSE
		for( idim in 1:nc$ndims ) {
			if( nc$dim[[idim]]$name == name2find ) {
				#-------------------------------------------
				# Remember we return the DIMVAR, not the dim
				#-------------------------------------------
				retval  = nc$dim[[idim]]$dimvarid	# an object of type 'ncid'
				foundit = TRUE
				break
				}
			}
		if( ! foundit )
			#-----------------------------------------------------------
			# Return an ncid that indicates this is a dimvar but it does
			# not exist in the file
			#-----------------------------------------------------------
			retval = .ncdf4_make_id( id=-1, group_index=-1, group_id=-1, list_index=-1, isdimvar=TRUE ) 

		if( class(retval) != 'ncid4' )
			stop(paste("Internal error #C, returned varid is not a object of class ncid4. Case with ncdim object passed; ncdim name=", varid$name))

		if( verbose )
			print(paste("vobjtovarid4: returning with varid deduced from a passed ncvar object; retval=",
				retval$group_id, retval$id))
		return(retval)	# an object of class 'ncid4'
		}

	#----------------------------------------------------------
	# If we get here, 'varid' can be a NA or a character string
	#----------------------------------------------------------

	#---------------------------------------------------------------------------
	# If varid is NA, then return the only var in the file (if there IS only one
	# var in the file).  If there is more than one var in the file, return the
	# one with the most dimensions, IF that highest-dimensionality var has more
	# dimensions than any other var in the file.  Otherwise, generate an error.
	#---------------------------------------------------------------------------
	if( (length(varid)==1) && is.na(varid)) {
		if( nc$nvars == 1 ) {
			varToUse   <- 1
			}
		else
			{
			#------------------------------------------------------------
			# Choose the most complicated var, if there is one, otherwise
			# halt with an error
			#------------------------------------------------------------
			varToUse   <- -1
			ndimsItHas <- -1
			for( ii in 1:nc$nvars ) {
				if( nc$var[[ii]]$ndims > ndimsItHas ) {
					varToUse <- ii
					ndimsItHas <- nc$var[[ii]]$ndims
					}
				}
			for( ii in 1:nc$nvars ) {
				if( (ii != varToUse) && (nc$var[[ii]]$ndims == ndimsItHas)) {
					stop(paste("File",nc$filename,"has more than one variable, so you must explicitly specify which one you want"))
					}
				}
			}
		varid <- nc$var[[varToUse]]$id	# remember, an object of class 'ncid4', not a simple int
		if( class(varid) != 'ncid4' )
			stop(paste("internal error #B, returned varid is not of class ncid4"))

		if( verbose )
			print(paste("vobjtovarid4: returning with only var in file; id=",
				nc$var[[varToUse]]$id$group_id, nc$var[[varToUse]]$id$id))
		return( varid )		# an object of class 'ncid4'
		}

	#---------------------------------------------------
	# If we get here, 'varid' must be a character string
	#---------------------------------------------------
	if( ! is.character(varid)) 
		stop("internal error: location #M: varid is not a character string!")

	origvarid <- varid

	#-------------------------------------------
	# Make sure var name follows our conventions
	#-------------------------------------------
	if( substr(varid,1,1) == '/' )
		stop(paste("Error, I was given a name that starts with a slash; fully qualified names NEVER start with a slash (this is required for backwards compatability).  Leave off the leading slash!"))

	#--------------------------------------------
	# See if any vars in this file have this name
	#--------------------------------------------
	varToUse <- -1
	if( nc$nvars > 0 ) {
		for( kk in 1:nc$nvars ) {
			if( origvarid == nc$var[[kk]]$name ) 	# check to see if fully qualified name matches
				varToUse <- kk
			}
		}

	#---------------------------------
	# Found a var with the right name,
	# return its ncid object
	#---------------------------------
	if( varToUse != -1 ) {
		if(verbose)
			print(paste("Variable named",origvarid,"found in file with varid=",
				nc$var[[varToUse]]$id$group_id, nc$var[[varToUse]]$id$id))
		varid <- nc$var[[varToUse]]$id	# remember, an object of class 'ncid4', not a simple int
		if( class(varid) != 'ncid4' ) {
			print('---- varid:')
			print(varid)
			stop(paste("internal error #A, returned varid is not of class ncid4"))
			}
		return( varid )		# an object of class 'ncid4'
		}

	#---------------------------------------------------------------
	# A var with this name was NOT found in the file.  But, it could
	# be the name of a dimvar in the file.  Check to see if we are
	# allowed to return dimvars in this case.
	#---------------------------------------------------------------
	if( ! allowdimvar ) {
		print("vobjtovarid4: error #G: I could not find the requested var in the file!")
		print(paste("requested var name:",origvarid))
		print(paste("file name:",nc$filename))
		print("Note: I was NOT allowed to check to see if this was a dimvar name")
		stop("Variable not found")
		}

	if(verbose)
		print(paste("Variable named",origvarid,"NOT found in file; looking for a dimvar with this name"))

	#-----------------------------------------------
	# Check to see if passed name matches a dim name
	#-----------------------------------------------
	for( i in 1:nc$ndims ) {
		if( origvarid == nc$dim[[i]]$name ) {
			#---------------------
			# Yes, it IS a dimvar!
			#---------------------
			varid <- nc$dim[[i]]$dimvarid 	# note: an object of class 'ncid4'.  $id will be -1 if there is no dimvar
			if( class(varid) != 'ncid4' )
				stop(paste("Internal error #D, returned varid is not a object of class ncid4"))
			if( verbose )
				print(paste("vobjtovarid4: returning with DIMvarid deduced from name; varid=",
					varid$group_id, varid$id))
			return(varid)	# an object of class 'ncid4'
			}
		}

	#------------------------------------------------------------
	# If we get here, no dimvar with the requested name was found
	#------------------------------------------------------------
	print("vobjtovarid4: error #F: I could not find the requsted var (or dimvar) in the file!")
	print(paste("var (or dimvar) name:",origvarid))
	print(paste("file name:",nc$filename))
	stop("Variable not found")
}

.ncvar_id_hier <- function( ncid, varname ) {

	if( mode(ncid) != 'numeric' )
		stop("error, must be passed a numeric first arg: ncid2use")

	if( mode(varname) != 'character' )
		stop("Error, must be passed a character second arg: varname" )

	rv         <- list()
	rv$varid   <- -1
	rv$groupid <- -1
	rv <- .C("R_nc4_inq_varid_hier", 
		as.integer(ncid),
		as.character(varname),
		groupid=as.integer(rv$groupid),
		varid=as.integer(rv$varid),
		PACKAGE="easyNCDF")

	retval = c( rv$varid, rv$groupid )
	return( retval )
}

.default_missval_ncdf4 <- function()  
{
	return(1.e30)
}

.ncvar_get <- function( nc, varid=NA, start=NA, count=NA, verbose=FALSE, signedbyte=TRUE, collapse_degen=TRUE, raw_datavals=FALSE ) {

	if( class(nc) != "ncdf4" )
		stop("first argument (nc) is not of class ncdf4!")

	if( verbose ) print(paste("ncvar_get: entering for read from file", nc$filename))

	if( (mode(varid) != 'character') && (class(varid) != 'ncvar4') && (class(varid) != 'ncdim4') && (! is.na(varid)))
		stop(paste("Error: second argument to ncvar_get must be an object of type ncvar or ncdim",
			"(both parts of the ncdf object returned by nc_open()), the character-string name of a variable or dimension",
			"or NA to get the default variable from the file.  If the file is netcdf version 4",
			"format and uses groups, then the fully qualified var name must be given, for",
			"example, model1/run5/Temperature"))


	#----------------------------------------------------
	# If we are running in safemode, must reopen the file
	#----------------------------------------------------
	if( nc$safemode ) {
		if( verbose ) print(paste("ncvar_get: safemode opening file"))
		nc$id = .ncdf4_inner_open( nc )
		}

	idobj = .vobjtovarid4( nc, varid, verbose=verbose, allowdimvar=TRUE )

	have_start = (length(start)>1) || ((length(start)==1) && (!is.na(start)))
	have_count = (length(count)>1) || ((length(count)==1) && (!is.na(count)))

	#-----------------------------------------------------------------
	# If we have a start or count, they must not have any NA's in them
	#-----------------------------------------------------------------
	if( have_start ) {
		for( i in 1:length(start)) {
			if( is.na(start[i]))
				stop(paste("Error, passed a 'start' argument that has NA values:", 
					paste(start,collapse=' ') ))
			}
		}
	if( have_count ) {
		for( i in 1:length(count)) {
			if( is.na(count[i]))
				stop(paste("Error, passed a 'count' argument that has NA values:", 
					paste(count,collapse=' ') ))
			}
		}

	#---------------------------------------------------------------------
	# Special check: if we are trying to get values from a dimvar, but the
	# dim does not have a dimvar, then just return 1:length(dim)
	#---------------------------------------------------------------------
	if( idobj$isdimvar ) {
		if( verbose ) print(paste("ncvar_get: passed object is a dimvar"))
		if( idobj$id == -1 ) {	# this happens if dim name was passed, but it has no dimvar
			#--------------------------------------------------------
			# Here we return default integers for dims with no dimvar
			#--------------------------------------------------------