Inline documentation updated; XMLGen added; some cleanup of no-longer…

…-used functions added

README.md

@@ -1,3 +1,73 @@
+       Framework for Unified Downscaling of GCMs Empirically (FUDGE)
+
+This file is part of the NOAA-GFDL FUDGE project (Framework for Unified Downscaling of GCMs Empirically), referred to as NOAA-GFDL/FUDGE. The majority of this code was written by authors at the Geophysical Fluid Dynamics Laboratory (GFDL), who are providing the code with the disclaimer shown below.
+
 Disclaimer
+----------
 
 The United States Department of Commerce (DOC) GitHub project code is provided on an "as is" basis and the user assumes responsibility for its use. DOC has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any claims against the Department of Commerce stemming from the use of its GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government.
+
+  What is it?
+  -----------
+
+  FUDGE is a tool for exploring the possible space of downscaling methods by 
+running experiments that vary over downscaling method, downscaling method parameters, 
+data used in the downscaling process, and pre- and post-downscaling adjustment
+of the data. 
+
+  The Latest Version
+  ------------------
+
+  The latest verified version is the darkchocolate release. For more
+  information, please consult the release notes.
+
+  Documentation
+  -------------
+
+  The documentation included with this release is located in 
+  the documentation/ directory. There is supplematary documentation located
+  in a readme file within the Rsuite and 
+
+  Requirements
+  ------------
+
+  This code requires access to:
+  - R 2.15 or higher
+  -- R packages ncdf4, ncdf4.helpers, CDFt, PCICt, udunits2, Runit? Do those tests get included? 
+  - nco 4.0.3 or higher
+  - netcdf 4.0.1 or higher
+  - python 2.7.1
+  -- python packages pprint,datetime,getopt, os, shutil, shlex, 
+     sys, subprocess, optparse, argparse
+  --* GFDL-specific programs *--  
+  - gcp 2.3 or higher
+  - moab 7 or higher
+
+  Please see the file called INSTALL.  Platform specific notes can be
+  found in README.platforms.
+
+  Licensing
+  ---------
+
+  Please see the file called license.md
+
+  Caveats and warnings
+  -----------------------------
+
+  1. This code has been designed for work with the GDFL machines. We make no guarantee that it 
+  will still work properly outside of the GFDL. 
+
+  2. This code is a work in progress. The darkchocolate workflow has passed its current tests, 
+  but is still undergoing revision. 
+
+  3. In the course of development, we found that the internal data structures were changing too
+  fast for unit regression tests to be useful, and switched to regression tests upon the downscaled
+  output. However, those regression tests rely on the GFDL filesystem for input data, and the incusion
+  of the end-products of downscaling files to check against would have dramatically increased the size 
+  of the repository.
+
+  Contacts
+  --------
+     o Principle Investigator: Keith Dixon, [email protected]
+     o [email protected]
+     o [email protected]

Rsuite/Drivers/LoadLib.R

@@ -5,9 +5,7 @@ LoadLib <- function(ds.method){
   library(ncdf4)
   library(PCICt)
   library(udunits2)
-  #library(CDFt)
   library(ncdf4.helpers)
-  #library(abind)
   if(grepl('CDFt', ds.method)){
         print("Importing CDFt library")       
 	library(CDFt)

Rsuite/Drivers/UtilityFunctions.R

@@ -4,10 +4,6 @@
 #'Functions may switch out of here as the code adapts
 #'Carolyn Whitlock, January 2015
 
-# post_ds = list(mask1=list(type='PR', qc.mask='off', adjust.out='off', loc='outloop', 
-#                            qc_args=list(thold='us_trace', freqadj='off')), 
-#                mask2=list(type='flag.neg',adjust.out='off',qc.mask='on', loc='inloop',
-#                            qc_options=list('na')))
 
 index.a.list <- function(list, index, val){
   #Returns the list if the member of the 

Rsuite/FudgeIO/CF.R

@@ -1,7 +1,12 @@
 # Aparna Radhakrishnan, 08/08/2014
 GetCFName <- function(var.name){
-  #'Function to retrieve standard_name,long_name and units for a given variable, if available
-  #' TODO : Interface with udunits2 and [cf-units]
+  #'Function to retrieve standard_name,long_name and units for a given variable, if available, 
+  #'according to the Climate and Forecast (CF) conventions
+  #'@param var.name: The short name of the variable being looked up
+  #'@return A list of three elements: 'cfname', the CF-compliant standard name, 
+  #''cfunits', the CF-compliant units used, and 'cflongname', the conventional 
+  #'long name for the variable in question (longnames aren't standardized, but there
+  #'are preferred naming conventions)
   cflist <- ("none") 
   if((var.name == "tasmax") | (var.name == "tasmin")){
      cfname <- "air_temperature"

Rsuite/FudgeIO/GetMiniFileName.R

@@ -1,5 +1,6 @@
 GetMiniFileName <- function(variable,freq,model,scenario,ds.region,start.period,end.period,i.index,j.range.suffix){
-#Constructs minifile names
+#'Constructs minifile names in a FUDGE-compliant format
+#'from the information contained in the runcode. 
 root.filename <- paste(variable,"_",freq,"_",model,"_",scenario,"_",ds.region,"_",start.period,"-",end.period,sep='')
 suffix.filename <- paste(".I",i.index,"_",j.range.suffix,".nc",sep='')
 

Rsuite/FudgeIO/ReadMaskNC.R

@@ -1,11 +1,11 @@
 #'ReadMaskNC.R
 #'Reads in a NetCDF file representing one or more masks  - variables
-#'where all values data is expected to be calculated are 1, and all
-#'missing values are NA. 
+#'where all values for which a calculation will be preformed are 1, 
+#'and all missing values are NA
 #'@param mask.nc: A ncdf4 obejct returned by OpenNC
 #'@param var.name: The variable name within the file. If not used, 
 #'the function defaults to returning all variables identified as 
-#'masks within the file
+#'masks within the file (i.e. containing the word 'mask' in the var name)
 #'@param verbose: Whether or not to print debugging information. Defaults
 #'to FALSE.
 #'@return A list containing the data from the file under data, and the
@@ -30,77 +30,6 @@ ReadMaskNC <- function(mask.nc,var.name=NA,verbose=FALSE, get.bounds.vars=FALSE)
     mask <- ncvar_get(mask.nc,mask.name, collapse_degen=FALSE) #verbose adds too much info
     mask.list[[mask.name]] <- mask
   }    
-#   message('All mask vars obtained; starting dimension vars')
-#   dimvec <- c("lat", "lon", "time")
-#   dimvec.writestring <- c('y', 'x', 't1')
-#   offsets <- c("j_offset", "i_offset")
-#   dim.list <- list()
-#   var.list <- list()
-#   for (dim in 1:length(dimvec)){
-#     #      dimvar <- ncvar_get(mask.nc, dimvec[dim], collapse_degen=FALSE, verbose=verbose)
-#     dimname <- dimvec[dim]
-#     dimvar <- mask.nc$dim[[dimname]]$vals
-#     dim.var.list <- list()
-#     if (!is.null(dimvar))
-#       if (dimname=='time'){
-#         #grab calendar
-#         calendar <- mask.nc$dim$time$calendar
-#         #grab origin for later use
-#         origin <- mask.nc$dim$time$units
-#         dim.list$time <- CreateTimeseries(dimvar, origin, calendar, sourcefile = mask.nc$filename)
-#         dim.list$tseries <- dimvar
-#         attr(dim.list$tseries, "origin") <- origin
-#         message(paste("Adding time dimension"))
-#         #          print(paste("origin: ", attr(dim.list$tseries, "origin")))
-#         #If selected, look for metadata variables
-#         if ("bnds" %in% names(mask.nc$dim) && get.bounds.vars==TRUE){             # || "bounds" %in% names(mask.nc$dim)
-#           message("Searching for time bounds")
-#           bounds.var <- paste(dimname, "_", "bnds", sep="")
-#           if (bounds.var %in% names(mask.nc$var) && get.bounds.vars==TRUE){
-#             var.list[[bounds.var]]$vals <- ncvar_get(mask.nc, bounds.var)
-#             #Create a string of the form "c(bnds, varname.of.bnds)"
-#             #dim.string <- paste("c(bnds,", dimvec.writestring[dim], ")", sep="")
-#             dim.string <- dimvec.writestring[dim]
-#             var.list[[bounds.var]]$info <- create.ncvar.list(mask.nc, bounds.var, dim.string)
-#           }else{
-#             message('No var time_bnds found within file despite bnds dim; proceeding without it')
-#           }
-#         }
-#         #Assign the var list back into the dimension structure
-#         #dim.list[[dimname]]$vars <- dim.var.list
-#       }else{
-#         dim.list[[dimname]] <- dimvar
-#         message(paste("Adding", dimname, 'dimension'))
-#         ##If selected, look for metadata variables (i.e. lat_bnds, j_offset)
-#         if ("bnds" %in% names(mask.nc$dim) && get.bounds.vars==TRUE){             # || "bounds" %in% names(mask.nc$dim)
-#           bounds.var <- paste(dimname, "_", "bnds", sep="")
-#           print(bounds.var)
-#           print((bounds.var %in% names(mask.nc$var)))
-#           if (bounds.var %in% names(mask.nc$var)){
-#             var.list[[bounds.var]]$vals <- ncvar_get(mask.nc, bounds.var)
-#             #dim.list[[dimname]]$vars$vals[[bounds.var]] <- ncvar_get(mask.nc, bounds.var)
-#             #Create a string of the form "c(bnds, varname.of.bnds)"
-#             #dim.string <- paste("c(bnds,", dimvec.writestring[dim], ")", sep="")
-#             dim.string <- dimvec.writestring[dim]
-#             var.list[[bounds.var]]$info <- create.ncvar.list(mask.nc, bounds.var, dim.string)
-#           }else{
-#             message(paste('No var ', dimname, "_bnds found within file despite bnds dim; proceeding without it", sep=""))
-#           }
-#         }
-#         #Determine if there is an i or j offset that could be used
-#         if (offsets[dim] %in% names(mask.nc$var)){
-#           var.list[[offsets[dim]]]$vals <- ncvar_get(mask.nc, offsets[dim])
-#           dim.string <- "NULL"
-#           var.list[[offsets[dim]]]$info <- create.ncvar.list(mask.nc, offsets[dim], dim.string)
-#           attr(var.list[[offsets[dim]]], "comments") <- ncatt_get(mask.nc, offsets[dim], "comments")$value
-#           attr(var.list[[offsets[dim]]], "missing_value") <- ncatt_get(mask.nc, offsets[dim], "missing_value")$value
-#         }
-#         #Assign the var list back into the dimension structure
-#         #dim.list$vars <- dim.var.list
-#       }
-#   }
-  #######################################################
-#  listout <- list('masks' = mask.list, 'dim' = dim.list, 'vars'=var.list)
   listout <- list('masks' = mask.list)
   attr(listout, "filename") <- mask.nc$filename
   nc_close(mask.nc)

Rsuite/FudgeIO/ReadNC.R

@@ -11,7 +11,11 @@ ReadNC <- function(nc.object,var.name=NA,dstart=NA,dcount=NA,dim='none',verbose=
   #'@param dim: Which dimensions to include in the netCDF object. Can be one of 'temporal', 
   #'which queries the dimension associated with the T axis, 'spatial', which queries the dimensions associated with the
   #'X, Y and Z axes, and 'none', which makes no query. The dimensions queried also affect the other variables returned;
-  #''temporal' returns all variables that reference the T axis underneath the $vars list of the output, and 
+  #''temporal' returns all variables that reference only the T axis underneath the $vars list of the output, and 'spatial' 
+  #'returns all variables that reference only one or more of the spatial axes under the $vars list.
+  #'@param force_3_dimensions: Whether to collapse degenerate non- x, y, t dimensions for more standardized
+  #'calculation. Defaults to FALSE.
+  #'@param verbose: Whether to print extended status messages. Defaults to FALSE.
   #'
   #'@returns A list containing the following elements: 
   #'  $clim.in: A 3-dimensional array of the values in the variable with the same dimensions

Rsuite/FudgeIO/WriteNC.R

@@ -12,8 +12,8 @@ WriteNC <-  function(filename,data.array,var.name,xlon,ylat,prec='double', missv
   #'be written to file. 
   #'@param var.name: The short name of the NetCDF variable being written. In the
   #'current FUDGE driver, picked up from the input var list.
-  #'@param units: The units of the NetCDF variable. In the current FUDGE driver, 
-  #'obtained by CFChecker
+  #'@param units: The units of the NetCDF variable. Obtained from the original 
+  #'target dataset
   #'@param lname: The long name of the NetCDF variable being written. In the current 
   #'FUDGE driver, generated by CF.R
   #'@param cfname: The CF-standard-compliant name of the variable being written.
@@ -51,10 +51,8 @@ WriteNC <-  function(filename,data.array,var.name,xlon,ylat,prec='double', missv
     #' If CFNAME undefined in the call, pull information from CF.R. Use default otherwise. 
     print(cfname)
     if(cfname == var.name){
-      ###CEW comment: should be sourced from calls in driver script
-      #    source(paste(FUDGEROOT,"Rsuite/FudgeIO/src/","CF.R",sep=""))
       cflist <- GetCFName(var.name)
-      if(is.list(cflist)){     ###CEW: Changed because was throwing a warning when cflist != "none"
+      if(is.list(cflist)){
         cfname <- cflist$cfname
         lname <- cflist$cflongname
         print(paste("cfname:",cfname,sep=''))
@@ -78,7 +76,6 @@ WriteNC <-  function(filename,data.array,var.name,xlon,ylat,prec='double', missv
       message(paste("defining var", var))
       var.dim <- unlist(strsplit(attr(var.data[[v]], "dimids"), ","))
       var.dimlist <- list()
-      #if(is.null(var.dim)){
       if(var.dim[1]=='NA'){
         var.dimlist <- NULL
       }else{
@@ -96,15 +93,13 @@ WriteNC <-  function(filename,data.array,var.name,xlon,ylat,prec='double', missv
       print(attr(var.data[[var]], "units"))
       var.dat[[var]] <- ncvar_def(var, #var.data[[v]], #Don't forget to add the data in somewhere 
                                   units=attr(var.data[[var]], "units"), #Add check for adding units back in if not present
-                                  #units="",
                                   dim=var.dimlist, 
                                   #missval=as.numeric(attr(var.data[[var]], "missval") ), #Add check for this as well. 
                                   longname = attr(var.data[[var]], "longname"), 
-                                  prec = attr(var.data[[var]], "prec") #This oen gave me hives last time.
+                                  prec = attr(var.data[[var]], "prec")
                                   )
     }
     print(length(var.dat))
-    #save('var.dat', file="/home/cew/Code/testing/ncvars.out")
     message("creating nc objects")
     nc.obj <- nc_create(filename, var.dat)
     message("placing nc vars")

Rsuite/FudgePreDS/ApplySpatialMask.R

@@ -4,11 +4,9 @@
 #' (most likely latitude and longitude)
 #' @return A 3-dimensional array of the same dimensions as the input data, with all x and y-coordinates where
 #' the mask contained a "NA" replaced with a "NA".
-#' @example insert example here
+#' @example
 #' @references \url{link to the FUDGE API documentation}
-#' TODO: Type up specifications for input files, because there are 
-#' some assumptions being made about what is and is not a mask
-ApplySpatialMask<-function(data, mask){   #, maskname="spatial_mask", dataLon, dataLat
+ApplySpatialMask<-function(data, mask){
   #Assume a 2-D mask and 3-D data
   if(!is.null(mask)){
     if(length(mask[1,])!=length(data[1,,1])||length(mask[,1])!=length(data[,1,1])){

Rsuite/FudgePreDS/ApplyTemporalMask.R

@@ -1,4 +1,4 @@
-#'Applies temporal masks to a one-dimensional dataset generated by TrainDriver.
+#'Applies temporal masks to a one-dimensional dataset, presumably generated by TrainDriver.
 #'At some point in the future, mask should be able to be a) a timeseries of the same
 #'length, b) a shorter (365-day) timseries, c) a longer, subsettable timeseries.
 #'For now, it should be enough to get the 
@@ -28,4 +28,3 @@ ApplyTemporalMask<-function(data, mask){
       tempvar <- data * mask
       return(tempvar)
 }
-#       #tempvar <- abind(lapply(1:dim(data)[3], function(i) data[,,i] * mask.data[[i]]),along=2) #along=3

Rsuite/FudgePreDS/CreateTimeWindowList.R

@@ -8,12 +8,13 @@
 #' @param method="generic": The method included, if it will change the checks that need to
 #' be performed on the intial data. CDFt, for example, currently has a check for 
 #' overlapping masks on all predictors
-#' @return A list containing (in this version) three elements (one for the hist.train,
-#' hist.targ and fut.train), each containing the timeseries associated with each mask 
-#' (used in cross-validation) and the named masks contained within the file. 
-#' @example insert example here
+#' @param time.prune.mask: A mask used to trim downscaled output into a single time series
+#' when the future predictor dataset uses masks that overlap (i.e. pm2weeks)
+#' @return A list containing three or four elements (one for the hist.train,
+#' hist.targ and fut.train, plus an element for the time trimming mask if included), 
+#' each containing a list of the named masks within that file
+#' @example
 #' @references \url{link to the FUDGE API documentation}
-#' TODO: set function to perform checks for more than one esdgen dataset
 #' TODO: Is there a good way to preallocate lists for speeed in this place?
 #' TODO: Develop better mask comparison when more than one mask is present
 
@@ -61,8 +62,6 @@ RemoveBounds<-function(names){
                  names!="i_offset"&names!="j_offset"&names!="height"])
 }
 
-
-
 # CheckJulian <- function(calendar, timeseries, origin){
 #   #Checks to see whether or not the Julian calendar
 #   #is supported over the date range, and returns

Rsuite/FudgePreDS/MaskPRSeries.R

@@ -16,8 +16,10 @@
 #'case for synthetic data), will only accept 'zero' or a user-defined
 #'threshold.
 #'@param lopt.drizzle : The option for applying a drizzle adjustment. 
-#'Converts the parameter for trace precipitation in the adjusted data
-#'to the 
+#'Determines the threshold of preciptiation required for the same frequency 
+#'of days with > 0 precipitation in the historical GCM as are present in the
+#'historical observation dataset, and then applies that threshold to the historic
+#'predictor and future predictor data. 
 #'@param lopt.conserve: The option for preserving trace precipitation.
 #'If present, the total amount of precipitation is conserved in the input 
 #'datasets; missing trace precipitation is averaged over the days with
@@ -28,8 +30,6 @@
 #'after downscaling based on the future predictor (CF, MF) mask during
 #'post-downscaling adjustment.
 #'
-#'TODO: Add *major* lat/lon coordiante agreement QC checks
-#'
 
 AdjustWetdays <- function(ref.data, ref.units=NULL, 
                           adjust.data=NA, adjust.units=NULL, 

Rsuite/FudgePreDS/SetDSMethodInfo.R

@@ -15,16 +15,11 @@ SetDSMethodInfo <- function(ds.method){
                 'CDFtv1' = setCDFt(),
                 'simple.bias.correct' = setSimple.Bias.Correct(),
                 'nothing' = setNothing(), 'Nothing' = setNothing(),     
-                'general.bias.correct' = setGeneral.Bias.Correct(),
          "BCQM" = setBiasCorrection(), 
          "EDQM" = setEquiDistant(), 
          "CFQM" = setChangeFactor(),
-         "BCQM_DF" = setBiasCorrection(), 
-         "EDQM_DF" = setEquiDistant(), 
-         "CFQM_DF" = setChangeFactor(),
          "QMAP" = setChangeFactor(),
          "DeltaSD" = setDeltaSD(),
-         "EDQMv2" = setEquiDistant(),
                 ReturnDownscaleError(ds.method))
   #Function returns nothing, just sets globals
 }
@@ -68,19 +63,6 @@ setSimple.Bias.Correct <- function(){
   names.of.args <<- c("ds.method", "qc.method")
 }
 
-setGeneral.Bias.Correct <- function(){
-  #Sets global variables if the DS method used is CDFt
-  #Is it possible to use cross-validation with this method?
-  crossval.possible <<- TRUE #TODO: ASK JRL about this! It might be possible to combine two methods
-  #for which that is not possible.
-  # Does this method use some of the same data to train the 
-  # ESD equations/quantiles AND generate the downscaled data?
-  train.and.use.same <<- TRUE #Temporarily set to TRUE for testing purposes; supposed to be FALSE
-  #In hindsight, I am not even sure that this applies here. 
-  # What are the arguments to the args() parameter that are accepted? 
-  names.of.args <<- c("ds.method", "qc.method", "compare.factor")
-}
-
 setNothing <- function(){
   #Sets global variables if the DS method used is CDFt
   #Is it possible to use cross-validation with this method?