diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R new file mode 100644 index 0000000..99d588d --- /dev/null +++ b/RBBGCMuso/R/calibMuso.R @@ -0,0 +1,216 @@ +#' This runs the BBGC-MuSo model +#' @author Roland Hollós +#' @param filename Name of the initialisation files +#' @return No return, outputs are written to file +#' @usage The function works only, if ... + +Linuxp <-(Sys.info()[1]=="Linux") + +calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE){ + +############################################################# +############################spinup run############################ + ########################################################## + + ##Copy the variables from settings + inputloc <- settings$inputloc + executable <- settings$executable + ininput <- settings$ininput + epc <- settings$epcinput + calibrationpar <- settings$calibrationpar + + + ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory +##alma + + if(silent!=TRUE){ + if(length(grep("(dayout$)|(log$)",list.files(inputloc)))>0){ + cat(" \n \n WARMING: there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n") + + } + + } + + if(aggressive==TRUE){ + cleanupMuso() + } + + ##change the epc file if and only if there are given parameters + if(!is.null(parameters)){ + changemulline(filename=epc[2],calibrationpar,parameters) + } + + ##We change the working directory becase of the model, but we want to avoid sideeffects, so we save the current location and after that we will change everything to it. + + whereAmI<-getwd() + ## Set the working directory to the inputloc temporary. + setwd(inputloc) + + + ##Run the model for the spinup run. + + if(silent){#silenc mode + if(Linuxp){ + #In this case, in linux machines + system(paste(executable,ininput[1],"> /dev/null",sep=" ")) + } else { + #In windows machines there is a show.output.on.console option + system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE) + } + + } else { + system(paste(executable,ininput[1],sep=" ")) + } + + + + logspinup<-list.files(inputloc)[grep("log$",list.files(inputloc))]#load the logfiles + if(length(logspinup)==0){ + return("Modell Failure")#in that case the modell did not create even a logfile + } + + spincrash<-tail(readLines(paste(inputloc,logspinup,sep=""),-1),1)==0 #If the last line in the logfile is 0 There are mistakes so the spinup crashes + + if(!spincrash){##If spinup did not crashed, run the normal run. + + ##################################################################### + ###########################normal run######################### + ################################################################# + + ##for the sake of safe we set the location again + setwd(inputloc) + + if(silent){ + if(Linuxp){ + system(paste(executable,ininput[2],"> /dev/null",sep=" ")) + } else { + system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE) + } + + } else { + system(paste(executable,ininput[2],sep=" ")) + } + + + ##read the output + + switch(timee, + "d"=(Reva<-getdailyout(settings)), + "m"=(Reva<-getmonthlyout(settings)), + "y"=(Reva<-getyearlyout(settings)) + ) + } + + + logfiles <- list.files(inputloc)[grep("log$",list.files(inputloc))]#creating a vector for logfilenames + +############################################### +#############LOG SECTION####################### +############################################### + + perror<-as.numeric(as.vector(lapply(paste(inputloc,logfiles,sep=""),function(x) tail(readLines(x,-1),1)))) #vector of spinup and normalrun error + + if((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on + #If log or ERROR directory does not exists create it! + dirName<-paste(inputloc,"LOG",sep="") + dirERROR<-paste(inputloc,"ERROR",sep="") + + if(!dir.exists(dirName)){ + dir.create(dirName) + } + + if(!dir.exists(dirERROR)){ + dir.create(dirERROR) + } + } + +##if errorsign is 1 there is error, if it is 0 everything ok + if(length(perror)>sum(perror)){ + errorsign <- 1 + } else { + errorsign <- 0 + } + + + if(keepEpc){#if keepepc option tured on + + if(length(unique(dirname(epc)))>1){ + print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?") + } else { + epcdir <- dirname(epc[1]) + + WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") + EPCS<-paste(inputloc,"EPCS",sep="") + + if(!dir.exists(WRONGEPC)){ + dir.create(WRONGEPC) + } + + if(!dir.exists(EPCS)){ + dir.create(EPCS) + } + + epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))] + stampnum<-stamp(EPCS) + lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep=""))) + if(errorsign==1){ + lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC)) + } + + } + } + + + + + + if(debugging=="stamplog"){ + stampnum<-stamp(dirName) + lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) + if(errorsign==1){ + lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))} + + } else { if(debugging){ + if(is.null(logfilename)){ + lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName,"/", x, sep=""))) + if(errorsign==1){ + lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR)) + } + + } else { + lapply( logfiles, function (x) file.rename(from=paste(inputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) + if(errorsign==1){ + lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR)) + } + } + + }} + + cleanupMuso() + if(errorsign==1){ + return("Modell Failure") + } + + if(timee=="d"){ + colnames(Reva) <- unlist(settings$outputvars[[1]]) + } else { + if(timee=="y") + colnames(Reva) <- unlist(settings$outputvars[[2]]) + } + + if(export!=FALSE){ + setwd(whereAmI) + + ## switch(fextension(export), + ## "csv"=(write.csv(Reva,export)), + ## "xlsx"=(), + ## "odt"= + + + ## ) + + + } else{ + setwd(whereAmI) + return(Reva)} +} diff --git a/RBBGCMuso/R/rungetMuso.R b/RBBGCMuso/R/rungetMuso.R index 39b90a0..9652215 100644 --- a/RBBGCMuso/R/rungetMuso.R +++ b/RBBGCMuso/R/rungetMuso.R @@ -6,7 +6,7 @@ Linuxp <-(Sys.info()[1]=="Linux") -rungetMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE){ +rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE){ ############################################################# ############################spinup run############################ @@ -34,11 +34,6 @@ rungetMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, log if(aggressive==TRUE){ cleanupMuso() } - - ##change the epc file if and only if there are given parameters - if(!is.null(parameters)){ - changemulline(filename=epc[2],calibrationpar,parameters) - } ##We change the working directory becase of the model, but we want to avoid sideeffects, so we save the current location and after that we will change everything to it. diff --git a/RBBGCMuso_0.1.7.tar.gz.bcg b/RBBGCMuso_0.1.7.tar.gz.bcg deleted file mode 100644 index c7f096c..0000000 Binary files a/RBBGCMuso_0.1.7.tar.gz.bcg and /dev/null differ diff --git a/RBBGCMuso_0.1.8.tar.gz b/RBBGCMuso_0.1.8.tar.gz index 351f26c..148f272 100644 Binary files a/RBBGCMuso_0.1.8.tar.gz and b/RBBGCMuso_0.1.8.tar.gz differ diff --git a/RBBGCMuso_0.1.8.tar.gz.bck b/RBBGCMuso_0.1.8.tar.gz.bck new file mode 100644 index 0000000..351f26c Binary files /dev/null and b/RBBGCMuso_0.1.8.tar.gz.bck differ diff --git a/RBBGCMuso_0.1.7.tar.gz b/RBBGCMuso_archive/RBBGCMuso_0.1.7.tar.gz similarity index 100% rename from RBBGCMuso_0.1.7.tar.gz rename to RBBGCMuso_archive/RBBGCMuso_0.1.7.tar.gz