diff --git a/RBBGCMuso/R/calibMuso.R b/RBBGCMuso/R/calibMuso.R index 1c08443..825481e 100644 --- a/RBBGCMuso/R/calibMuso.R +++ b/RBBGCMuso/R/calibMuso.R @@ -19,11 +19,11 @@ #' @import utils #' @export -calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE,keepBinary=FALSE, binayPlace="./", fileToChange="epc"){ +calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE,keepBinary=FALSE, binaryPlace="./", fileToChange="epc"){ ########################################################################## -###########################Set local variables######################## +###########################Set local variables and places######################## ######################################################################## Linuxp <-(Sys.info()[1]=="Linux") @@ -37,6 +37,9 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf whereAmI<-getwd() + ## Set the working directory to the inputLoc temporarly. + setwd(inputLoc) + ########################################################################## ###########################Defining Functions######################## @@ -55,18 +58,20 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf ##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){ - warning("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(silent!=TRUE){ + ## if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){ + ## warning("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(location=outputLoc,deep = TRUE) - } + ## if(aggressive==TRUE){ + ## cleanupMuso(location=outputLoc,deep = TRUE) + ## } + + ##change the epc file if and only if there are given parameters if(!is.null(parameters)){ @@ -80,9 +85,6 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf ##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. - ## Set the working directory to the inputLoc temporary. - setwd(inputLoc) - ##Run the model for the spinup run. @@ -102,6 +104,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles + if(length(logspinup)==0){ return("Modell Failure")#in that case the modell did not create even a logfile } @@ -146,11 +149,13 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf "m"=(Reva<-getmonthlyout(settings)), "y"=(Reva<-getyearlyout(settings)) ) + if(keepBinary){ - file.copy(grep("out$",list.files(outputLoc),value=TRUE) + file.copy(file.path(outputLoc,grep("out$",list.files(outputLoc),value=TRUE)) ,file.path(binaryPlace,paste0(stamp(binaryPlace),"-",grep("out$",list.files(outputLoc),value=TRUE)))) } } + logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames diff --git a/RBBGCMuso/R/getOutput.R b/RBBGCMuso/R/getOutput.R index 24d6486..1f4d196 100644 --- a/RBBGCMuso/R/getOutput.R +++ b/RBBGCMuso/R/getOutput.R @@ -12,8 +12,9 @@ getthespecdata<-function(settings,colnumbers){ } getdailyout<-function(settings){ - binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="") + binaryname<-paste0(settings$outputLoc,"/",settings$outputNames[2],".dayout") d<-file(binaryname,"rb") + ##leapyear is not implemented yet in this function dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE) close(d) return(dayoutput) diff --git a/RBBGCMuso/R/normalMuso.R b/RBBGCMuso/R/normalMuso.R index 36d834c..6a4464e 100644 --- a/RBBGCMuso/R/normalMuso.R +++ b/RBBGCMuso/R/normalMuso.R @@ -1,44 +1,54 @@ -normalMuso<- function(settings,parameters=c(" ECOPHYS"),timee="d",debugging=FALSE,logfilename=NULL){ +normalMuso<- function(settings,parameters=NULL,timee="d",debugging=FALSE,logfilename=NULL,keepEpc=FALSE, export=FALSE,silent=FALSE,aggressive=FALSE,leapYear=FALSE, binaryPlace="./",fileToChange="epc"){ - Linuxp <-(Sys.info()[1]=="Linux") - ######################################################## -###############################Preparational functions############### -##################################################### +########################################################################## +###########################Set local variables######################## +######################################################################## - numcut<-function(string){ - #This function returns only the starting numbers of a string - unlist(strsplit(grep("^[0-9]",string,value = TRUE),"[aAzZ-]"))[1] - } - -numcutall<-function(vector){ - #numcall apply numcut for all elements of a string vector -as.numeric(unlist(apply(as.matrix(vector),1,numcut))) -} - -stamp<-function(path="./"){ - #It gives back a stamp wich is the maximum number of the output numcall - numbers<-numcutall(list.files(path)) - if(length(numbers)==0){ - return (0)} else { - return(max(numbers))} -} + Linuxp <-(Sys.info()[1]=="Linux") + ##Copy the variables from settings + inputLoc <- settings$inputLoc + outputLoc <- settings$outputLoc + executable <- settings$executable + iniInput <- settings$iniInput + epc <- settings$epcInput + calibrationPar <- settings$calibrationPar + whereAmI<-getwd() - changemulline(settings,parameters) + - inputloc<-settings$inputloc - executable<-settings$executable - ininput<-settings$ininput + + if(!is.null(parameters)){ + + switch(fileToChange, + "epc"=(changemulline(filename=epc[2],calibrationPar,parameters)), + "ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)), + "both"=(stop("This option is not implemented yet, please choose epc or ini")) + ) + } - - setwd(inputloc) + setwd(inputLoc) #normal run - system(paste(executable,ininput[2],sep=" ")) + + if(silent){ + if(Linuxp){ + system(paste(executable,iniInput[2],"> /dev/null",sep=" ")) + } else { + system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE) + } + + } else { + system(paste(executable,iniInput[2],sep=" ")) + } + + + + system(paste(executable,iniInput[2],sep=" ")) switch(timee, "d"=(Reva<-getdailyout(settings)), diff --git a/RBBGCMuso/R/setupMuso.R b/RBBGCMuso/R/setupMuso.R index 0383548..ba2b862 100644 --- a/RBBGCMuso/R/setupMuso.R +++ b/RBBGCMuso/R/setupMuso.R @@ -72,8 +72,8 @@ setupMuso <- function(executable=NULL, writep <<- writep+1 if(filep) { - tempVar["spinup"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE)) - tempVar["normal"] <- paste0(inputLoc,inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE)) + tempVar["spinup"] <- file.path(inputLoc,inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE)) + tempVar["normal"] <- file.path(inputLoc,inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE)) } else { tempVar["spinup"] <- inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE) tempVar["normal"] <- inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE) @@ -89,9 +89,12 @@ setupMuso <- function(executable=NULL, } return(tempVar) } - + if(is.null(inputLoc)){ - inputLoc<- "./"} + inputLoc<- normalizePath("./") + } else{ + inputLoc <- normalizePath(inputLoc) + } #iniChangedp <- FALSE @@ -183,8 +186,9 @@ setupMuso <- function(executable=NULL, } else { file.copy(executable,inputLoc) } - - outputName <- unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1] + outputName <- character(2) + outputName[1] <- basename(unlist(strsplit(iniFiles[[1]][grep("OUTPUT_CONTROL",iniFiles[[1]])+1],"[\ \t]"))[1]) + outputName[2] <- basename(unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1]) ## outputName <- unlist(strsplit(grep("output",grep("prefix",iniFiles[[2]],value=TRUE),value=TRUE),"[\ \t]"))[1] ##THIS IS AN UGLY SOLUTION, WHICH NEEDS AN UPGRADE!!! FiXED (2017.09.11) ## outputName <- unlist(strsplit(grep("prefix for output files",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] @@ -197,7 +201,13 @@ setupMuso <- function(executable=NULL, if(is.null(outputLoc)){ ## outputLoc<-paste((rev(rev(unlist(strsplit(outputName,"/")))[-1])),collapse="/") - outputLoc <- dirname(outputName) + outputLoc <- dirname(unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1]) + if(substr(outputLoc,start = 1,stop = 1)!="/"){ + ##if the outputName is not absolute path make it absolute + outputLoc <- file.path(inputLoc,outputLoc) + } + } else { + outputLoc <- normalizePath(outputLoc) } @@ -219,6 +229,9 @@ setupMuso <- function(executable=NULL, writeLines(iniFiles[[1]],iniInput[1]) writeLines(iniFiles[[2]],iniInput[2]) + + suppressWarnings(file.remove(file.path(outputLoc,outputNames[1]))) + suppressWarnings(file.remove(file.path(outputLoc,outputNames[2]))) settings = list(executable = executable, calibrationPar = calibrationPar, @@ -246,7 +259,7 @@ setupMuso <- function(executable=NULL, if(writep!=nrow(grepHelper)){ writeLines(iniFiles[[1]],iniInput[[1]]) - if(epcInput[1]!=epcInput[2]){ #Change need here + if(inputs$epcInput[1]!=inputs$epc$Input[2]){ #Change need here writeLines(iniFiles[[2]],iniInput[[2]]) } } diff --git a/RBBGCMuso/R/spinupMuso.R b/RBBGCMuso/R/spinupMuso.R index 60e5c58..6d8374e 100644 --- a/RBBGCMuso/R/spinupMuso.R +++ b/RBBGCMuso/R/spinupMuso.R @@ -15,7 +15,7 @@ #' logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE) #' @export -spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE){ +spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=NULL, keepEpc=FALSE, silent=FALSE, aggressive=FALSE, fileToChange="epc"){ ########################################################################## ###########################Set local variables######################## @@ -40,16 +40,23 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N 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")}} + warning(" \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")}} ##With the aggressive option every unneeded file will deleted if(aggressive==TRUE){ - cleanupMuso(location=outputLoc)} + cleanupMuso(location=outputLoc,deep=TRUE)} ##change the epc file if and only if there are given parameters + ## if(!is.null(parameters)){ + ## changemulline(filename=epc[1], calibrationPar, parameters)} if(!is.null(parameters)){ - changemulline(filename=epc[1], calibrationPar, parameters)} + switch(fileToChange, + "epc"=(changemulline(filename=epc[2],calibrationPar,parameters)), + "ini"=(changemulline(filename=iniInput[2],calibrationPar,parameters)), + "both"=(stop("This option is not implemented yet, please choose epc or ini")) + ) + } ##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. @@ -73,7 +80,24 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N #############LOG SECTION####################### ############################################### logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))] - spincrash<-tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)==0 + ## spincrash<-tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)==0 + + logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles + + if(length(logspinup)==0){ + spincrash <- TRUE + } + + if(length(logspinup)>1){ + spincrash <- TRUE + } else { + if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){ + spincrash <- TRUE + } else { + spincrash <- (tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1) + } + } + logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))] dirName<-paste(inputLoc,"/LOG",sep="") @@ -164,7 +188,7 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N }} - cleanupMuso(location=outputLoc) + #cleanupMuso(location=outputLoc) if(errorsign==1){ diff --git a/forarcheologists b/forarcheologists index 9905a78..90f0ad7 100644 --- a/forarcheologists +++ b/forarcheologists @@ -248,3 +248,39 @@ if(length(irrInput)==2){ iniFiles[[2]][grep("do IRRIGATION",iniFiles[[2]])]<-paste(irrInput[2],"do IRRIGATION",sep="") }} +getthewholedata<-function(settings){ + f1<-settings$ininput[2] + filename = paste(settings$inputloc,settings$outputname,"_ann.txt",sep="") + alloutput<-read.table(filename,skip=22, header = FALSE) + return(alloutput) +} + +getthespecdata<-function(settings,colnumbers){ + filename<-paste(settings$inputloc,settings$outputname,"_ann.txt",sep="") + specoutput<-read.table(filename,skip=22, header = FALSE)[,colnumbers] + return(specoutput) +} + +getdailyout<-function(settings){ + binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="") + d<-file(binaryname,"rb") + dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE) + close(d) + return(dayoutput) +} + +getmonthlyout<-function(settings){ + binaryname<-paste(settings$inputloc,settings$outputname,".monavgout",sep="") + d<-file(binaryname,"rb") + monoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[2])),(settings$numyears*12),byrow=TRUE) + close(d) + return(monoutput) +} + +getyearlyout<-function(settings){ + binaryname<-paste(settings$inputloc,settings$outputname,".annout",sep="") + d<-file(binaryname,"rb") + yearoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[3])),(settings$numyears),byrow=TRUE) + close(d) + return(yearoutput) +}