From 0ef9ac941303e1126331580c8c02186e099e1a67 Mon Sep 17 00:00:00 2001 From: Hollos Roland Date: Wed, 18 Dec 2019 17:12:04 +0100 Subject: [PATCH] daily output list --- RBBGCMuso/NAMESPACE | 1 + RBBGCMuso/R/calibMuso.R | 7 +++++++ RBBGCMuso/R/getOutPutList.R | 27 +++++++++++++++++++++++++++ RBBGCMuso/R/outputMapping.R | 6 +++++- RBBGCMuso/R/setupMuso.R | 13 ++++++++++++- RBBGCMuso/getOutPutList.R | 27 +++++++++++++++++++++++++++ RBBGCMuso/man/getDailyOutputList.Rd | 18 ++++++++++++++++++ 7 files changed, 97 insertions(+), 2 deletions(-) create mode 100644 RBBGCMuso/R/getOutPutList.R create mode 100644 RBBGCMuso/getOutPutList.R create mode 100644 RBBGCMuso/man/getDailyOutputList.Rd diff --git a/RBBGCMuso/NAMESPACE b/RBBGCMuso/NAMESPACE index 865bffe..111ce49 100644 --- a/RBBGCMuso/NAMESPACE +++ b/RBBGCMuso/NAMESPACE @@ -7,6 +7,7 @@ export(cleanupMuso) export(compareMuso) export(copyMusoExampleTo) export(corrigMuso) +export(getDailyOutputList) export(getMeteoData1BGC) export(getyearlycum) export(getyearlymax) diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index efca8e5..2d47511 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -141,6 +141,13 @@ calibMuso <- function(settings=NULL, calibrationPar=NULL, settings$outputVars[[1]]<-outputVarChanges[[1]] settings$numData <- round(settings$numData*outputVarChanges[[2]]) } + + # if(modifyOriginal){ + # suppressWarnings(dir.create()) + # sapply(c(iniInput,epc),) + # + # } + if(!skipSpinup) { diff --git a/RBBGCMuso/R/getOutPutList.R b/RBBGCMuso/R/getOutPutList.R new file mode 100644 index 0000000..583afcf --- /dev/null +++ b/RBBGCMuso/R/getOutPutList.R @@ -0,0 +1,27 @@ +#' getDailyOutputList +#' +#' bla bla +#' @param settings bla +#' @export + + +getDailyOutputList <- function(settings=NULL){ + if(is.null(settings)){ + settings<- setupMuso() + } + settings$dailyOutputTable +} + +#' getAnnualOutputList +#' +#' bla bla +#' @param settings bla +#' @export + + +getDailyOutputList <- function(settings=NULL){ + if(is.null(settings)){ + settings<- setupMuso() + } + settings$annualOutputTable +} diff --git a/RBBGCMuso/R/outputMapping.R b/RBBGCMuso/R/outputMapping.R index 7120654..f99ee85 100644 --- a/RBBGCMuso/R/outputMapping.R +++ b/RBBGCMuso/R/outputMapping.R @@ -32,7 +32,11 @@ updateMusoMapping<-function(output_map_init="output_map_init.c"){ musoMapping <- function(code, mapData=getOption("RMuso_varTable")[[as.character(getOption("RMuso_version"))]]){ if(is.null(mapData)){ - return(unlist(mMapping[which(mMapping[,1]==code),2])) #mMapping is package-scoped system variable generated by udateMusoMapping + return(unlist(tryCatch(mMapping[which(mMapping[,1]==code),2],error = function(e){ + + stop(sprintf("The code %s in inifile is not valid muso output variable code",code)) + +}))) #mMapping is package-scoped system variable generated by udateMusoMapping } else { return(unlist(mapData[which(mapData[,1]==code),2])) } diff --git a/RBBGCMuso/R/setupMuso.R b/RBBGCMuso/R/setupMuso.R index 190f3a3..d606dfb 100644 --- a/RBBGCMuso/R/setupMuso.R +++ b/RBBGCMuso/R/setupMuso.R @@ -159,6 +159,8 @@ setupMuso <- function(executable=NULL, error = function(e){ stop("Cannot read indexes of output variables from the normal ini file, please make sure you have not skiped a line after the flag: \"DAILY_OUTPUT\"") }) + + dailyVarCodes<-unlist(lapply(dailyVarCodes, function(x) unlist(strsplit(x,"[\ \t]"))[1])) dailyVarnames<-unlist(lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))) outIndex<-grep("ANNUAL_OUTPUT",iniFiles[[2]])+1 @@ -268,6 +270,10 @@ setupMuso <- function(executable=NULL, } epcFiles <- tryCatch(sapply(iniFiles,function(x){(searchBellow(x,"EPC_FILE"))}),error = function(e){""}) metInput <- tryCatch(sapply(iniFiles,function(x){(searchBellow(x,"MET_INPUT"))}),error = function(e){""}) + dailyOutputTable <- cbind.data.frame(seq_along(dailyVarCodes),dailyVarCodes,outputVars[[1]]) + colnames(dailyOutputTable) <- c("index","code","name") + annualOutputTable <- cbind.data.frame(seq_along(annualVarCodes),annualVarCodes,outputVars[[2]]) + colnames(dailyOutputTable) <- c("index","code","name") settings = list(executable = executable, calibrationPar = calibrationPar, @@ -293,7 +299,9 @@ setupMuso <- function(executable=NULL, outputVars=outputVars, soilFile=soilFiles, dailyVarCodes= gsub("\\s.*","",dailyVarCodes), - annualVarCodes = gsub("\\s.*","",annualVarCodes) + annualVarCodes = gsub("\\s.*","",annualVarCodes), + dailyOutputTable=dailyOutputTable, + annualOutputTable=annualOutputTable ) # if(getOption("RMuso_version")==6){ @@ -324,6 +332,9 @@ setupMuso <- function(executable=NULL, # writeLines(iniFiles[[2]],iniInput[[2]]) # } # } + + suppressWarnings(dir.create(file.path(inputLoc,"bck"))) + # sapply(iniFiles,epc) return(settings) } diff --git a/RBBGCMuso/getOutPutList.R b/RBBGCMuso/getOutPutList.R new file mode 100644 index 0000000..583afcf --- /dev/null +++ b/RBBGCMuso/getOutPutList.R @@ -0,0 +1,27 @@ +#' getDailyOutputList +#' +#' bla bla +#' @param settings bla +#' @export + + +getDailyOutputList <- function(settings=NULL){ + if(is.null(settings)){ + settings<- setupMuso() + } + settings$dailyOutputTable +} + +#' getAnnualOutputList +#' +#' bla bla +#' @param settings bla +#' @export + + +getDailyOutputList <- function(settings=NULL){ + if(is.null(settings)){ + settings<- setupMuso() + } + settings$annualOutputTable +} diff --git a/RBBGCMuso/man/getDailyOutputList.Rd b/RBBGCMuso/man/getDailyOutputList.Rd new file mode 100644 index 0000000..cfb0c76 --- /dev/null +++ b/RBBGCMuso/man/getDailyOutputList.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/getOutPutList.R +\name{getDailyOutputList} +\alias{getDailyOutputList} +\title{getDailyOutputList} +\usage{ +getDailyOutputList(settings = NULL) + +getDailyOutputList(settings = NULL) +} +\arguments{ +\item{settings}{bla} +} +\description{ +bla bla + +bla bla +}