hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Major update, big improvement.

Browse Source
This commit is contained in:
hollorol 2018-03-13 16:24:03 +01:00
parent 900e97397d
commit 957bb9055d
14 changed files with 450 additions and 375 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
RBBGCMuso/DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: RBBGCMuso Package: RBBGCMuso
Title: An R package for BiomeBGC-MuSo ecosystem modelling Title: An R package for BiomeBGC-MuSo ecosystem modelling
Version: 0.3.3.0-0 Version: 0.4.0.0-0
Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre")) Authors@R: person("Roland", "Hollo's", , "hollorol@gmail.com", role = c("aut", "cre"))
Description: What the package does (one paragraph). Description: What the package does (one paragraph).
Depends: R (>= 2.10) Depends: R (>= 2.10)

83
RBBGCMuso/R/calibMuso.R
View File

@ -20,7 +20,7 @@
#' @export #' @export
calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE){ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logfilename=NULL, keepEpc=FALSE, export=FALSE, silent=FALSE, aggressive=FALSE, leapYear=FALSE,keepBinary=FALSE, binayPlace="./"){
########################################################################## ##########################################################################
@ -29,12 +29,12 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ##Copy the variables from settings
inputloc <- settings$inputloc inputLoc <- settings$inputLoc
outputloc <- settings$outputloc outputLoc <- settings$outputLoc
executable <- settings$executable executable <- settings$executable
ininput <- settings$ininput iniInput <- settings$iniInput
epc <- settings$epcinput epc <- settings$epcInput
calibrationpar <- settings$calibrationpar calibrationPar <- settings$calibrationPar
whereAmI<-getwd() whereAmI<-getwd()
@ -57,7 +57,7 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
##alma ##alma
if(silent!=TRUE){ if(silent!=TRUE){
if(length(grep("(dayout$)|(log$)",list.files(inputloc)))>0){ 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") 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")
} }
@ -65,19 +65,19 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
} }
if(aggressive==TRUE){ if(aggressive==TRUE){
cleanupMuso(location=outputloc,deep = TRUE) cleanupMuso(location=outputLoc,deep = TRUE)
} }
##change the epc file if and only if there are given parameters ##change the epc file if and only if there are given parameters
if(!is.null(parameters)){ if(!is.null(parameters)){
changemulline(filename=epc[2],calibrationpar,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. ##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. ## Set the working directory to the inputLoc temporary.
setwd(inputloc) setwd(inputLoc)
##Run the model for the spinup run. ##Run the model for the spinup run.
@ -85,19 +85,19 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
if(silent){#silenc mode if(silent){#silenc mode
if(Linuxp){ if(Linuxp){
#In this case, in linux machines #In this case, in linux machines
system(paste(executable,ininput[1],"> /dev/null",sep=" ")) system(paste(executable,iniInput[1],"> /dev/null",sep=" "))
} else { } else {
#In windows machines there is a show.output.on.console option #In windows machines there is a show.output.on.console option
system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE) system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE)
} }
} else { } else {
system(paste(executable,ininput[1],sep=" ")) system(paste(executable,iniInput[1],sep=" "))
} }
logspinup<-list.files(outputloc)[grep("log$",list.files(outputloc))]#load the logfiles logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
if(length(logspinup)==0){ if(length(logspinup)==0){
return("Modell Failure")#in that case the modell did not create even a logfile return("Modell Failure")#in that case the modell did not create even a logfile
} }
@ -105,10 +105,10 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
if(length(logspinup)>1){ if(length(logspinup)>1){
spincrash<-TRUE spincrash<-TRUE
} else { } else {
if(identical(tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1),character(0))){ if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){
spincrash<-TRUE spincrash<-TRUE
} else { } else {
spincrash<-(tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)!=1) spincrash<-(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1)
} }
} }
@ -121,17 +121,17 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
################################################################# #################################################################
##for the sake of safe we set the location again ##for the sake of safe we set the location again
setwd(inputloc) setwd(inputLoc)
if(silent){ if(silent){
if(Linuxp){ if(Linuxp){
system(paste(executable,ininput[2],"> /dev/null",sep=" ")) system(paste(executable,iniInput[2],"> /dev/null",sep=" "))
} else { } else {
system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE) system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE)
} }
} else { } else {
system(paste(executable,ininput[2],sep=" ")) system(paste(executable,iniInput[2],sep=" "))
} }
@ -142,10 +142,13 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
"m"=(Reva<-getmonthlyout(settings)), "m"=(Reva<-getmonthlyout(settings)),
"y"=(Reva<-getyearlyout(settings)) "y"=(Reva<-getyearlyout(settings))
) )
if(keepBinary){
file.copy(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
logfiles <- list.files(outputloc)[grep("log$",list.files(outputloc))]#creating a vector for logfilenames
############################################### ###############################################
#############LOG SECTION####################### #############LOG SECTION#######################
@ -153,13 +156,13 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
perror<-as.numeric(as.vector(lapply(paste(outputloc,logfiles,sep="/"),function(x) tail(readLines(x,-1),1)))) #vector of spinup and normalrun error perror<-as.numeric(as.vector(lapply(paste(outputLoc,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((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
#If log or ERROR directory does not exists create it! #If log or ERROR directory does not exists create it!
dirName<-paste(inputloc,"LOG",sep="") dirName<-paste(inputLoc,"LOG",sep="")
dirERROR<-paste(inputloc,"ERROR",sep="") dirERROR<-paste(inputLoc,"ERROR",sep="")
if(!dir.exists(dirName)){ if(!dir.exists(dirName)){
dir.create(dirName) dir.create(dirName)
@ -190,8 +193,8 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
} else { } else {
epcdir <- dirname(epc[1]) epcdir <- dirname(epc[1])
WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") WRONGEPC<-paste(inputLoc,"WRONGEPC",sep="")
EPCS<-paste(inputloc,"EPCS",sep="") EPCS<-paste(inputLoc,"EPCS",sep="")
if(!dir.exists(WRONGEPC)){ if(!dir.exists(WRONGEPC)){
dir.create(WRONGEPC) dir.create(WRONGEPC)
@ -216,11 +219,11 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
if(debugging=="stamplog"){ if(debugging=="stamplog"){
stampnum<-stamp(dirName) stampnum<-stamp(dirName)
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -229,10 +232,10 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
} else { if(debugging){ } else { if(debugging){
if(is.null(logfilename)){ if(is.null(logfilename)){
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName,"/", x, sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -241,10 +244,10 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
} else { } else {
if(inputloc==outputloc){#These are very ugly solutions for a string problem: inputloc: "./", if outputloc equalent of inputloc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's) if(inputLoc==outputLoc){#These are very ugly solutions for a string problem: inputLoc: "./", if outputLoc equalent of inputLoc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's)
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -254,16 +257,16 @@ calibMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, logf
}} }}
cleanupMuso(location=outputloc,deep = TRUE) cleanupMuso(location=outputLoc,deep = TRUE)
if(errorsign==1){ if(errorsign==1){
return("Modell Failure") return("Modell Failure")
} }
if(timee=="d"){ if(timee=="d"){
colnames(Reva) <- unlist(settings$outputvars[[1]]) colnames(Reva) <- unlist(settings$outputVars[[1]])
} else { } else {
if(timee=="y") if(timee=="y")
colnames(Reva) <- unlist(settings$outputvars[[2]]) colnames(Reva) <- unlist(settings$outputVars[[2]])
} }

6
RBBGCMuso/R/changeMuso.R
View File

@ -6,11 +6,11 @@
#' @author Roland Hollos #' @author Roland Hollos
#' @keywords internal #' @keywords internal
changemulline <- function(filename,calibrationpar,contents){ changemulline <- function(filename,calibrationPar,contents){
##This is the function which is capable change multiple specific lines to other using their row numbers. ##This is the function which is capable change multiple specific lines to other using their row numbers.
##The function uses the previous changspecline function to operate. ##The function uses the previous changspecline function to operate.
##From now changespecline is in the forarcheologist file, because its no longer needed ##From now changespecline is in the forarcheologist file, because its no longer needed
varnum <- length(calibrationpar) varnum <- length(calibrationPar)
contents <- as.list(contents) contents <- as.list(contents)
if(length(contents)!=varnum) if(length(contents)!=varnum)
{ {
@ -20,7 +20,7 @@ changemulline <- function(filename,calibrationpar,contents){
readedFile = readLines(filename,-1) readedFile = readLines(filename,-1)
for(i in 1:varnum){ for(i in 1:varnum){
readedFile[calibrationpar[i]] <- paste(contents[[i]],collapse = " ") readedFile[calibrationPar[i]] <- paste(contents[[i]],collapse = " ")
} }
writeLines(unlist(readedFile),filename) writeLines(unlist(readedFile),filename)

4
RBBGCMuso/R/getOutput.R
View File

@ -12,9 +12,9 @@ getthespecdata<-function(settings,colnumbers){
} }
getdailyout<-function(settings){ getdailyout<-function(settings){
binaryname<-paste(settings$inputloc,settings$outputnames,".dayout",sep="") binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="")
d<-file(binaryname,"rb") d<-file(binaryname,"rb")
dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numdata[1])),(settings$numyears*365),byrow=TRUE) dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE)
close(d) close(d)
return(dayoutput) return(dayoutput)
} }

3
RBBGCMuso/R/musoTime.R
View File

@ -86,6 +86,7 @@ sumDaysOfPeriod <- function(year, periodlen, corrigated=TRUE){
return(days) return(days)
} else { } else {
days <- periodlen*365 days <- periodlen*365
return(days)
} }
} }
@ -121,7 +122,7 @@ musoDate <- function(settings,timestep="d",combined=TRUE, corrigated=TRUE, forma
days <- sumDaysOfPeriod(settings$startyear,settings$numyears, corrigated=corrigated) days <- sumDaysOfPeriod(settings$startyear,settings$numYears, corrigated=corrigated)
dates <- matrix(rep(NA,days*3),ncol=3) dates <- matrix(rep(NA,days*3),ncol=3)
dates[1,] <- c(1,1,settings$startyear) dates[1,] <- c(1,1,settings$startyear)

6
RBBGCMuso/R/outputMapping.R
View File

@ -9,7 +9,7 @@
updateMusoMapping<-function(output_map_init="output_map_init.c"){ updateMusoMapping<-function(output_map_init="output_map_init.c"){
outputRaw<-grep("\\[",readLines("output_map_init",-1),value=TRUE) outputRaw<-grep("\\[",readLines(output_map_init,-1),value=TRUE)
codes <- as.vector(lapply(outputRaw, function (x) as.numeric(unlist(strsplit(unlist(strsplit(x,"\\["))[2],"\\]"))[1]))) codes <- as.vector(lapply(outputRaw, function (x) as.numeric(unlist(strsplit(unlist(strsplit(x,"\\["))[2],"\\]"))[1])))
names <- unlist(lapply(outputRaw, function (x) unlist(strsplit(unlist(strsplit(x,">"))[2],";"))[1])) names <- unlist(lapply(outputRaw, function (x) unlist(strsplit(unlist(strsplit(x,">"))[2],";"))[1]))
@ -31,9 +31,9 @@ updateMusoMapping<-function(output_map_init="output_map_init.c"){
musoMapping <- function(code, mapData=NULL){ musoMapping <- function(code, mapData=NULL){
if(is.null(mapData)){ if(is.null(mapData)){
return(unlist(mMapping[which(mMapping[,1]==code),2])) #mMapping is package-scoped system variable generated by uudateMusoMapping return(unlist(mMapping[which(mMapping[,1]==code),2])) #mMapping is package-scoped system variable generated by udateMusoMapping
} else { } else {
return(unlist(mapData[which(mapData[,1]==650),2])) return(unlist(mapData[which(mapData[,1]==code),2]))
} }
} }

74
RBBGCMuso/R/rungetMuso.R
View File

@ -31,12 +31,12 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ##Copy the variables from settings
inputloc <- settings$inputloc inputLoc <- settings$inputLoc
outputloc <- settings$outputloc outputLoc <- settings$outputLoc
executable <- settings$executable executable <- settings$executable
ininput <- settings$ininput iniInput <- settings$iniInput
epc <- settings$epcinput epc <- settings$epcInput
calibrationpar <- settings$calibrationpar calibrationPar <- settings$calibrationPar
whereAmI<-getwd() whereAmI<-getwd()
############################################################# #############################################################
@ -48,7 +48,7 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
if(silent!=TRUE){ if(silent!=TRUE){
if(length(grep("(dayout$)|(log$)",list.files(inputloc)))>0){ 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") 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")
} }
@ -56,13 +56,13 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
} }
if(aggressive==TRUE){ if(aggressive==TRUE){
cleanupMuso(location=outputloc, deep=TRUE) cleanupMuso(location=outputLoc, deep=TRUE)
} }
##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. ##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. ## Set the working directory to the inputLoc temporary.
setwd(inputloc) setwd(inputLoc)
##Run the model for the spinup run. ##Run the model for the spinup run.
@ -70,19 +70,19 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
if(silent){#silenc mode if(silent){#silenc mode
if(Linuxp){ if(Linuxp){
#In this case, in linux machines #In this case, in linux machines
system(paste(executable,ininput[1],"> /dev/null",sep=" ")) system(paste(executable,iniInput[1],"> /dev/null",sep=" "))
} else { } else {
#In windows machines there is a show.output.on.console option #In windows machines there is a show.output.on.console option
system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE) system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE)
} }
} else { } else {
system(paste(executable,ininput[1],sep=" ")) system(paste(executable,iniInput[1],sep=" "))
} }
logspinup<-list.files(outputloc)[grep("log$",list.files(outputloc))]#load the logfiles logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles
if(length(logspinup)==0){ if(length(logspinup)==0){
return("Modell Failure")#in that case the modell did not create even a logfile return("Modell Failure")#in that case the modell did not create even a logfile
} }
@ -91,10 +91,10 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
if(length(logspinup)>1){ if(length(logspinup)>1){
spincrash<-TRUE spincrash<-TRUE
} else { } else {
if(identical(tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1),character(0))){ if(identical(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1),character(0))){
spincrash<-TRUE spincrash<-TRUE
} else { } else {
spincrash<-(tail(readLines(paste(outputloc,logspinup,sep="/"),-1),1)!=1) spincrash<-(tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)!=1)
} }
} }
@ -107,17 +107,17 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
################################################################# #################################################################
##for the sake of safe we set the location again ##for the sake of safe we set the location again
setwd(inputloc) setwd(inputLoc)
if(silent){ if(silent){
if(Linuxp){ if(Linuxp){
system(paste(executable,ininput[2],"> /dev/null",sep=" ")) system(paste(executable,iniInput[2],"> /dev/null",sep=" "))
} else { } else {
system(paste(executable,ininput[2],sep=" "),show.output.on.console = FALSE) system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE)
} }
} else { } else {
system(paste(executable,ininput[2],sep=" ")) system(paste(executable,iniInput[2],sep=" "))
} }
@ -131,18 +131,18 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
} }
logfiles <- list.files(outputloc)[grep("log$",list.files(outputloc))]#creating a vector for logfilenames logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]#creating a vector for logfilenames
############################################### ###############################################
#############LOG SECTION####################### #############LOG SECTION#######################
############################################### ###############################################
perror<-as.numeric(as.vector(lapply(paste(outputloc,logfiles,sep="/"),function(x) tail(readLines(x,-1),1)))) #vector of spinup and normalrun error perror<-as.numeric(as.vector(lapply(paste(outputLoc,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((debugging=="stamplog")|(debugging==TRUE)){#If debugging option turned on
##If log or ERROR directory does not exists create it! ##If log or ERROR directory does not exists create it!
dirName<-paste(inputloc,"LOG",sep="") dirName<-paste(inputLoc,"LOG",sep="")
dirERROR<-paste(inputloc,"ERROR",sep="") dirERROR<-paste(inputLoc,"ERROR",sep="")
if(!dir.exists(dirName)){ if(!dir.exists(dirName)){
dir.create(dirName) dir.create(dirName)
@ -173,8 +173,8 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
} else { } else {
epcdir <- dirname(epc[1]) epcdir <- dirname(epc[1])
WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") WRONGEPC<-paste(inputLoc,"WRONGEPC",sep="")
EPCS<-paste(inputloc,"EPCS",sep="") EPCS<-paste(inputLoc,"EPCS",sep="")
if(!dir.exists(WRONGEPC)){ if(!dir.exists(WRONGEPC)){
dir.create(WRONGEPC) dir.create(WRONGEPC)
@ -200,11 +200,11 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
if(debugging=="stamplog"){ if(debugging=="stamplog"){
stampnum<-stamp(dirName) stampnum<-stamp(dirName)
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -213,10 +213,10 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
} else { if(debugging){ } else { if(debugging){
if(is.null(logfilename)){ if(is.null(logfilename)){
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName,"/", x, sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -225,10 +225,10 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
} else { } else {
if(inputloc==outputloc){#These are very ugly solutions for a string problem: inputloc: "./", if outputloc equalent of inputloc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's) if(inputLoc==outputLoc){#These are very ugly solutions for a string problem: inputLoc: "./", if outputLoc equalent of inputLoc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's)
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -238,16 +238,16 @@ rungetMuso <- function(settings, timee="d", debugging=FALSE, logfilename=NULL, k
}} }}
cleanupMuso(location=outputloc) cleanupMuso(location=outputLoc)
if(errorsign==1){ if(errorsign==1){
return("Modell Failure") return("Modell Failure")
} }
if(timee=="d"){ if(timee=="d"){
colnames(Reva) <- unlist(settings$outputvars[[1]]) colnames(Reva) <- unlist(settings$outputVars[[1]])
} else { } else {
if(timee=="y") if(timee=="y")
colnames(Reva) <- unlist(settings$outputvars[[2]]) colnames(Reva) <- unlist(settings$outputVars[[2]])
} }
if(leapYear){ if(leapYear){

2
RBBGCMuso/R/rungettanul.R
View File

@ -14,7 +14,7 @@
## executable <- settings$executable ## executable <- settings$executable
## ininput <- settings$ininput ## ininput <- settings$ininput
## epc <- settings$epcinput ## epc <- settings$epcinput
## calibrationpar <- settings$calibrationpar ## calibrationPar <- settings$calibrationPar
## whereAmI<-getwd() ## whereAmI<-getwd()
## ############################################################# ## #############################################################

421
RBBGCMuso/R/setupMuso.R
View File

@ -5,253 +5,168 @@
#' @author Roland Hollos #' @author Roland Hollos
#' @param parallel Do you want to run multiple modell paralelly, if yes, set this variable to TRUE #' @param parallel Do you want to run multiple modell paralelly, if yes, set this variable to TRUE
#' @param executable This parameter stores the place of the modell-executable file. In normal usage, you don't have to be set this, because a RBBgcmuso package contains allways the latest modell executable. In spite of this, if you would like to use this package for modell development or just want to use different models (for example for comparison), you will find it useful #' @param executable This parameter stores the place of the modell-executable file. In normal usage, you don't have to be set this, because a RBBgcmuso package contains allways the latest modell executable. In spite of this, if you would like to use this package for modell development or just want to use different models (for example for comparison), you will find it useful
#' @param calibrationpar You may want to change some parameters in your epc file, before you run the modell. You have to select the appropirate modell parameters. You can refence to these with the number of the line in the epc file where the variables are. It indexes from one. You should use a vector for this, like: c(1,5,8) #' @param calibrationPar You may want to change some parameters in your epc file, before you run the modell. You have to select the appropirate modell parameters. You can refence to these with the number of the line in the epc file where the variables are. It indexes from one. You should use a vector for this, like: c(1,5,8)
#' @param outputloc Where should the modell puts its outputs. You should give a location for it via this variable, for example: outputloc="/place/of/the/outputs/" #' @param outputLoc Where should the modell puts its outputs. You should give a location for it via this variable, for example: outputLoc="/place/of/the/outputs/"
#' @param inputloc Usually it is the root directory, where you put the inifiles for the modell #' @param inputLoc Usually it is the root directory, where you put the iniFiles for the modell
#' @param metinput Via metinput parameter, you can tell the modell where are the meteorological files. As default it reads this from the inifiles. #' @param metInput Via metInput parameter, you can tell the modell where are the meteorological files. As default it reads this from the iniFiles.
#' @param CO2input Via CO2 parameter, you can tell the modell where are the CO2 data files. As default it reads this from the inifiles. #' @param CO2Input Via CO2 parameter, you can tell the modell where are the CO2 data files. As default it reads this from the iniFiles.
#' @param plantinput Via planting parameter, you can tell the modell where are the data files, which contains the planting informations. As default it reads this from the inifiles. #' @param plantInput Via planting parameter, you can tell the modell where are the data files, which contains the planting informations. As default it reads this from the iniFiles.
#' @param thininput Via thining parameter, you can tell the modell where are the data files, which contains the thining informations. As default it reads this from the inifiles. #' @param thinInput Via thining parameter, you can tell the modell where are the data files, which contains the thining informations. As default it reads this from the iniFiles.
#' @param mowinput Via mowing parameter, you can tell the modell where are the data files, which contains the mowing informations. As default it reads this from the inifiles. #' @param mowInput Via mowing parameter, you can tell the modell where are the data files, which contains the mowing informations. As default it reads this from the iniFiles.
#' @param grazinput Via grazing parameter, you can tell the modell where are the data files, which contains the grazing informations. As default it reads this from the inifiles. #' @param grazInput Via grazing parameter, you can tell the modell where are the data files, which contains the grazing informations. As default it reads this from the iniFiles.
#' @param harvinput Via harvesting parameter, you can tell the modell where are the data files, which contains the harvesting informations. As default it reads this from the inifiles. #' @param harvInput Via harvesting parameter, you can tell the modell where are the data files, which contains the harvesting informations. As default it reads this from the iniFiles.
#' @param plouginput Via ploughing parameter, you can tell the modell where are the data files, which contains the ploughing informations. As default it reads this from the inifiles. #' @param plougInput Via ploughing parameter, you can tell the modell where are the data files, which contains the ploughing informations. As default it reads this from the iniFiles.
#' @param fertinput Via fertilizing parameter, you can tell the modell where are the fertilizing data files, which contains the fertilizing informations. As default it reads this from the inifiles. #' @param fertInput Via fertilizing parameter, you can tell the modell where are the fertilizing data files, which contains the fertilizing informations. As default it reads this from the iniFiles.
#' @param irrinput Via irrigation parameter, you can tell the modell where are the data files, which contains the irrigation informations. As default it reads this from the inifiles. #' @param irrInput Via irrigation parameter, you can tell the modell where are the data files, which contains the irrigation informations. As default it reads this from the iniFiles.
#' @param nitinput Via this parameter, you can tell the modell where are the NO2 data files. As default it reads this from the inifiles. #' @param nitInput Via this parameter, you can tell the modell where are the NO2 data files. As default it reads this from the iniFiles.
#' @param ininput Via this parameter, you can tell the modell where are the ini files. As default it reads this from the inifiles. #' @param iniInput Via this parameter, you can tell the modell where are the ini files. As default it reads this from the iniFiles.
#' @param epcinput Via this parameter, you can tell the modell where are the epc data files. As default it reads this from the inifiles. #' @param epcInput Via this parameter, you can tell the modell where are the epc data files. As default it reads this from the iniFiles.
#' @usage setupMuso(executable=NULL, parallel = F, calibrationpar =c(1), #' @usage setupMuso(executable=NULL, parallel = F, calibrationPar =c(1),
#' outputloc=NULL, inputloc=NULL, #' outputLoc=NULL, inputLoc=NULL,
#' metinput=NULL, CO2input=NULL, #' metInput=NULL, CO2Input=NULL,
#' plantinput=NULL, thininput=NULL, #' plantInput=NULL, thinInput=NULL,
#' mowinput=NULL, grazinput=NULL, #' mowInput=NULL, grazInput=NULL,
#' harvinput=NULL, plouginput=NULL, #' harvInput=NULL, plougInput=NULL,
#' fertinput=NULL, irrinput=NULL, #' fertInput=NULL, irrInput=NULL,
#' nitinput=NULL, ininput=NULL, epcinput=NULL) #' nitInput=NULL, iniInput=NULL, epcInput=NULL)
#' @return The output is a the modell setting list wich contains the following elements: #' @return The output is a the modell setting list wich contains the following elements:
#' executable, calibrationpar, outputloc, outputname, inputloc, ininput, metinput, epcinput,thininput,CO2input, mowinput, grazinput, harvinput, plouginput, fertinput, irrinput, nitinput, inputfiles, numdata, startyear, numyears, outputvars #' executable, calibrationPar, outputLoc, outputName, inputLoc, iniInput, metInput, epcInput,thinInput,CO2Input, mowInput, grazInput, harvInput, plougInput, fertInput, irrInput, nitInput, inputFiles, numData, startyear, numYears, outputVars
#' @export #' @export
setupMuso <- function(executable=NULL, setupMuso <- function(executable=NULL,
parallel = F, parallel = F,
calibrationpar =c(1), calibrationPar =c(1),
outputloc=NULL, outputLoc=NULL,
inputloc=NULL, inputLoc=NULL,
metinput=NULL, metInput=NULL,
CO2input=NULL, CO2Input=NULL,
plantinput=NULL, plantInput=NULL,
thininput=NULL, thinInput=NULL,
mowinput=NULL, mowInput=NULL,
grazinput=NULL, grazInput=NULL,
harvinput=NULL, harvInput=NULL,
plouginput=NULL, plougInput=NULL,
fertinput=NULL, fertInput=NULL,
irrinput=NULL, irrInput=NULL,
nitinput=NULL, nitInput=NULL,
ininput=NULL, iniInput=NULL,
epcinput=NULL, epcInput=NULL,
mapData=NULL mapData=NULL,
leapYear=FALSE,
version=5
){ ){
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
writep <- 0
if(is.null(mapData)&version==4){
mData <- mMapping4
}
inputParser <- function(string,fileName,counter,value=TRUE){ inputParser <- function(string,fileName,counter,value=TRUE){
unlist(strsplit(grep(string,fileName,value=TRUE),"[\ \t]"))[counter] unlist(strsplit(grep(string,fileName,value=TRUE),"[\ \t]"))[counter]
} }
outMaker <- function(inputVar,grepString,filep){
if(is.null(inputloc)){ tempVar <- eval(parse(text=inputVar))
inputloc<- "./" if(is.null(tempVar)){
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))
} else { } else {
inp <- unlist(strsplit(inputloc,"")) #This is the charactervector of the given imput location tempVar["spinup"] <- inputParser(string=grepString,fileName=iniFiles$spinup,counter=1,value=TRUE)
tempVar["normal"] <- inputParser(string=grepString,fileName=iniFiles$normal,counter=1,value=TRUE)
if(inp[length(inp)]!="/"){
inp<-c(inp,"/")
inputloc <- paste(inp,collapse = "")
rm(inp)
}# If inp not ends in / paste one at the end, then make a string, that will be the new inputloc
##Example: "a/b/c ==> a/b/c/"
} }
inichangedp <- FALSE
if(is.null(ininput)){ } else {
spinups<-grep("s.ini$",list.files(inputloc),value=TRUE) iniFiles$spinup[grep(grepString,iniFiles$spinup)] <<- paste0(tempVar[1],"\t ",grepString)
normals<-grep("n.ini$",list.files(inputloc),value=TRUE)
if(length(tempVar)==2){
iniFiles$normal[grep(" grepString",iniFiles$normal)] <<- paste0(tempVar[2],"\t ",grepString)
}
}
return(tempVar)
}
if(is.null(inputLoc)){
inputLoc<- "./"}
#iniChangedp <- FALSE
if(is.null(iniInput)){
spinups<-grep("s.ini$",list.files(inputLoc),value=TRUE)
normals<-grep("n.ini$",list.files(inputLoc),value=TRUE)
if(length(spinups)==1){ if(length(spinups)==1){
ininput[1]<-paste(inputloc,spinups,sep="") iniInput[1]<-file.path(inputLoc,spinups)
} else {return(print("There are multiple or no spinup files, please choose"))} } else {stop("There are multiple or no spinup ini files, please choose")}
if(length(normals)==1){ if(length(normals)==1){
ininput[2]<-paste(inputloc,normals,sep="") iniInput[2]<-file.path(inputLoc,normals)
} else {return(print("There are multiple or no normal files, please choose"))} } else {stop("There are multiple or no normal ini files, please choose")}
} }
##read the ini files for the further changes ##read the ini files for the further changes
inifiles<-lapply(ininput, function (x) readLines(x,-1)) iniFiles<-lapply(iniInput, function (x) readLines(x,-1))
inifiles[[1]] <- gsub("\\","/", inifiles[[1]],fixed=TRUE) #replacing \ to / iniFiles[[1]] <- gsub("\\","/", iniFiles[[1]],fixed=TRUE) #replacing \ to /
inifiles[[2]] <- gsub("\\","/", inifiles[[2]],fixed=TRUE) #replacing \ to / iniFiles[[2]] <- gsub("\\","/", iniFiles[[2]],fixed=TRUE) #replacing \ to /
names(iniFiles) <- c("spinup","normal")
if(is.null(epcinput)){
epcflag=TRUE
epcinput[1] <- paste0(inputloc,inputParser(string=" EPC file name",fileName=inifiles[[1]],counter=1,value=TRUE))
epcinput[2] <- paste0(inputloc,inputParser(string=" EPC file name",fileName=inifiles[[2]],counter=1,value=TRUE))
} else {
inifiles[[1]][grep(" EPC file name",inifiles[[1]])]<-paste(epcinput[1],"\t EPC file name",sep="")
if(length(epcinput)==2){
inifiles[[2]][grep(" EPC file name",inifiles[[2]])]<-paste(epcinput[2],"\t EPC file name",sep="")
}
}
if(is.null(metinput)){
metflag=TRUE
metinput[1] <- unlist(strsplit(grep(" met file name",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
metinput[2] <- unlist(strsplit(grep(" met file name",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep(" met file name",inifiles[[1]])]<-paste(metinput[1],"\t met file name",sep="")
if(length(metinput)==2){ inputs <- lapply(1:nrow(grepHelper), function (x) {
inifiles[[2]][grep(" met file name",inifiles[[2]])]<-paste(metinput[2],"\t EPC file name",sep="")
}}
if(is.null(CO2input)){ outMaker(grepHelper[x,1],grepHelper[x,2],grepHelper[x,3])
CO2flag=TRUE
CO2input[1] <- unlist(strsplit(grep(" CO2 file",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
CO2input[2] <- unlist(strsplit(grep(" CO2 file",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep(" CO2 file",inifiles[[1]])]<-paste(CO2input[1],"\t CO2 file",sep="")
if(length(CO2input)==2){ })
inifiles[[2]][grep(" CO2 file",inifiles[[2]])]<-paste(CO2input[2],"\t CO2 file",sep="") names(inputs) <- grepHelper$inputVar
}} ## grepHelper is in sysdata.rda it is a table like this:
##
## inputVar string isFile
## 1 epcInput EPC file name TRUE
## 2 metInput met file name TRUE
## 3 CO2Input CO2 file TRUE
## 4 nitInput N-dep file TRUE
## 5 thinInput do THINNING FALSE
## 6 plantInput do PLANTING FALSE
## 7 mowInput do MOWING FALSE
## 8 grazInput do GRAZING FALSE
## 9 harvInput do HARVESTING FALSE
## 10 plougInput do PLOUGHING FALSE
## 11 fertInput do FERTILIZING FALSE
## 12 irrInput do IRRIGATION FALSE
# return(inputs) debug element
if(is.null(nitinput)){
nitflag=TRUE
nitinput[1] <- unlist(strsplit(grep("N-dep file",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
nitinput[2] <- unlist(strsplit(grep("N-dep file",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("N-dep file",inifiles[[1]])]<-paste(nitinput[1],"N-dep file",sep="N-dep file")
if(length(epcinput)==2){
inifiles[[2]][grep("N-dep file",inifiles[[2]])]<-paste(nitinput[2],"N-dep file",sep="")
}}
if(is.null(thininput)){
thinflag=TRUE
thininput[1] <- unlist(strsplit(grep("do THINNING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
thininput[2] <- unlist(strsplit(grep("do THINNING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do THINNING",inifiles[[1]])]<-paste(thininput[1],"do THINNING",sep="")
if(length(thininput)==2){
inifiles[[2]][grep("do THINNING",inifiles[[2]])]<-paste(thininput[2],"do THINNING",sep="")
}}
if(is.null(plantinput)){
plantflag=TRUE
plantinput[1] <- unlist(strsplit(grep("do PLANTING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
plantinput[2] <- unlist(strsplit(grep("do PLANTING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do PLANTING",inifiles[[1]])]<-paste(plantinput[1],"do PLANTING",sep="")
if(length(plantinput)==2){
inifiles[[2]][grep("do PLANTING",inifiles[[2]])]<-paste(plantinput[2],"do PLANTING",sep="")
}}
if(is.null(mowinput)){
mowflag=TRUE
mowinput[1] <- unlist(strsplit(grep("do MOWING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
mowinput[2] <- unlist(strsplit(grep("do MOWING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do MOWING",inifiles[[1]])]<-paste(mowinput[1],"do MOWING",sep="")
if(length(mowinput)==2){
inifiles[[2]][grep("do MOWING",inifiles[[2]])]<-paste(mowinput[2],"do MOWING",sep="")
}}
if(is.null(grazinput)){
grazflag=TRUE
grazinput[1] <- unlist(strsplit(grep("do GRAZING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
grazinput[2] <- unlist(strsplit(grep("do GRAZING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do GRAZING",inifiles[[1]])]<-paste(grazinput[1],"do GRAZING",sep="")
if(length(grazinput)==2){
inifiles[[2]][grep("do GRAZING",inifiles[[2]])]<-paste(grazinput[2],"do GRAZING",sep="")
}}
if(is.null(harvinput)){
harvflag=TRUE
harvinput[1] <- unlist(strsplit(grep("do HARVESTING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
harvinput[2] <- unlist(strsplit(grep("do HARVESTING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do HARVESTING",inifiles[[1]])]<-paste(harvinput[1],"do HARVESTING",sep="")
if(length(harvinput)==2){
inifiles[[2]][grep("do HARVESTING",inifiles[[2]])]<-paste(harvinput[2],"do HARVESTING",sep="")
}}
if(is.null(plouginput)){
plougflag=TRUE
plouginput[1] <- unlist(strsplit(grep("do PLOUGHING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
plouginput[2] <- unlist(strsplit(grep("do PLOUGHING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do PLOUGHING",inifiles[[1]])]<-paste(plouginput[1],"do PLOUGHING",sep="")
if(length(plouginput)==2){
inifiles[[2]][grep("do PLOUGHING",inifiles[[2]])]<-paste(plouginput[2],"do PLOUGHING",sep="")
}}
if(is.null(fertinput)){
fertflag=TRUE
fertinput[1] <- unlist(strsplit(grep("do FERTILIZING",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
fertinput[2] <- unlist(strsplit(grep("do FERTILIZING",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do FERTILIZING",inifiles[[1]])]<-paste(fertinput[1],"do FERTILIZING",sep="")
if(length(fertinput)==2){
inifiles[[2]][grep("do FERTILIZING",inifiles[[2]])]<-paste(fertinput[2],"do FERTILIZING",sep="")
}}
if(is.null(irrinput)){
irrflag=TRUE
irrinput[1] <- unlist(strsplit(grep("do IRRIGATION",inifiles[[1]],value=TRUE),"[\ \t]"))[1]
irrinput[2] <- unlist(strsplit(grep("do IRRIGATION",inifiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
inifiles[[1]][grep("do IRRIGATION",inifiles[[1]])]<-paste(irrinput[1],"do IRRIGATION",sep="")
if(length(irrinput)==2){
inifiles[[2]][grep("do IRRIGATION",inifiles[[2]])]<-paste(irrinput[2],"do IRRIGATION",sep="")
}}
if(is.null(mapData)){ if(is.null(mapData)){
c<-grep("DAILY_OUTPUT",inifiles[[2]])+1 c<-grep("DAILY_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1])
dailyVarCodes<-inifiles[[2]][(c+1):(c+numVar)] dailyVarCodes<-iniFiles[[2]][(c+1):(c+numVar)]
dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1])) dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))
c<-grep("ANNUAL_OUTPUT",inifiles[[2]])+1 c<-grep("ANNUAL_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1])
annualVarCodes<-inifiles[[2]][(c+1):(c+numVar)] annualVarCodes<-iniFiles[[2]][(c+1):(c+numVar)]
annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1])) annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1]))
outputvars<-list(dailyVarnames,annualVarnames)} else { outputVars<-list(dailyVarnames,annualVarnames)} else {
c<-grep("DAILY_OUTPUT",inifiles[[2]])+1 c<-grep("DAILY_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1])
dailyVarCodes<-inifiles[[2]][(c+1):(c+numVar)] dailyVarCodes<-iniFiles[[2]][(c+1):(c+numVar)]
dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData)) dailyVarnames<-lapply(dailyVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData))
c<-grep("ANNUAL_OUTPUT",inifiles[[2]])+1 c<-grep("ANNUAL_OUTPUT",iniFiles[[2]])+1
numVar<-as.numeric(unlist(strsplit(inifiles[[2]][c],"[\ \t]"))[1]) numVar<-as.numeric(unlist(strsplit(iniFiles[[2]][c],"[\ \t]"))[1])
annualVarCodes<-inifiles[[2]][(c+1):(c+numVar)] annualVarCodes<-iniFiles[[2]][(c+1):(c+numVar)]
annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData)) annualVarnames<-lapply(annualVarCodes, function(x) musoMapping(unlist(strsplit(x,"[\ \t]"))[1],mapData))
outputvars<-list(dailyVarnames,annualVarnames) outputVars<-list(dailyVarnames,annualVarnames)
@ -261,76 +176,78 @@ setupMuso <- function(executable=NULL,
if(is.null(executable)){ if(is.null(executable)){
if(Linuxp){ if(Linuxp){
executable<-paste(inputloc,"muso",sep="") executable<-file.path(inputLoc,"muso")
} else { } else {
executable<-paste(inputloc,"muso.exe",sep="") executable<-file.path(inputLoc,"muso.exe")
} }
} else { } else {
file.copy(executable,inputloc) file.copy(executable,inputLoc)
} }
outputname <- unlist(strsplit(inifiles[[2]][grep("OUTPUT_CONTROL",inifiles[[2]])+1],"[\ \t]"))[1] outputName <- 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] ## 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) ##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] ## outputName <- unlist(strsplit(grep("prefix for output files",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
if(is.null(outputname)){ if(is.null(outputName)){
cat("I cannot find outputname, in your default ini file \n Please make sure that the line wich contains the name alse contains the prefix and the outmut keywords!") stop("I cannot find outputName in your default ini file \n Please make sure that the line wich contains the name also contains the prefix and the outmut keywords!")
} }
## outputname<-unlist(read.table(ininput[2],skip=93,nrows = 1))[1] ## outputName<-unlist(read.table(iniInput[2],skip=93,nrows = 1))[1]
if(is.null(outputloc)){ if(is.null(outputLoc)){
## outputloc<-paste((rev(rev(unlist(strsplit(outputname,"/")))[-1])),collapse="/") ## outputLoc<-paste((rev(rev(unlist(strsplit(outputName,"/")))[-1])),collapse="/")
outputloc <- dirname(outputname) outputLoc <- dirname(outputName)
} }
inputfiles<-c(ininput,epcinput,metinput) inputFiles<-c(iniInput,epcInput,metInput)
numdata<-rep(NA,3) numData<-rep(NA,3)
numyears <- as.numeric(unlist(strsplit(grep("simulation years",inifiles[[2]],value=TRUE),"[\ \t]"))[1]) numYears <- as.numeric(unlist(strsplit(grep("simulation years",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])
## numyears<-unlist(read.table(ininput[2],skip = 14,nrows = 1)[1]) ## numYears<-unlist(read.table(iniInput[2],skip = 14,nrows = 1)[1])
numvalues <- as.numeric(unlist(strsplit(grep("number of daily output variables",inifiles[[2]],value=TRUE),"[\ \t]"))[1]) numValues <- as.numeric(unlist(strsplit(grep("number of daily output variables",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])
## numvalues<-unlist(read.table(ininput[2],skip=102,nrows = 1)[1]) ## numValues will be replaced to numVar
startyear <- as.numeric(unlist(strsplit(grep("first simulation year",inifiles[[2]],value=TRUE),"[\ \t]"))[1]) ## numValues<-unlist(read.table(iniInput[2],skip=102,nrows = 1)[1])
numdata[1]<-numyears*numvalues*365 startyear <- as.numeric(unlist(strsplit(grep("first simulation year",iniFiles[[2]],value=TRUE),"[\ \t]"))[1])
numdata[2]<-numyears*numvalues*12 numData[1] <- numValues * sumDaysOfPeriod(startyear,numYears,corrigated=leapYear)
numdata[3]<-numyears*numvalues
numData[2] <- numYears * numValues*12
numData[3] <- numYears * numValues
##Writing out changed ini-file ##Writing out changed ini-file
writeLines(inifiles[[1]],ininput[1]) writeLines(iniFiles[[1]],iniInput[1])
writeLines(inifiles[[2]],ininput[2]) writeLines(iniFiles[[2]],iniInput[2])
settings = list(executable = executable, settings = list(executable = executable,
calibrationpar = calibrationpar, calibrationPar = calibrationPar,
outputloc=outputloc, outputLoc=outputLoc,
outputnames=outputname, outputNames=outputName,
inputloc=inputloc, inputLoc=inputLoc,
ininput=ininput, iniInput=iniInput,
metinput=metinput, metInput=metInput,
epcinput=epcinput, epcInput=epcInput,
thininput=thininput, thinInput=thinInput,
CO2input=CO2input, CO2Input=CO2Input,
mowinput=mowinput, mowInput=mowInput,
grazinput=grazinput, grazInput=grazInput,
harvinput=harvinput, harvInput=harvInput,
plouginput=plouginput, plougInput=plougInput,
fertinput=fertinput, fertInput=fertInput,
irrinput=irrinput, irrInput=irrInput,
nitinput=nitinput, nitInput=nitInput,
inputfiles=inputfiles, inputFiles=inputFiles,
numdata=numdata, numData=numData,
startyear=startyear, startyear=startyear,
numyears=numyears, numYears=numYears,
outputvars=outputvars outputVars=outputVars
) )
if(!(epcflag&CO2flag&nitflag&thinflag&plantflag&mowflag&grazflag&harvflag&plougflag&fertflag&irrflag)){ if(writep!=nrow(grepHelper)){
writeLines(inifiles[[1]],ininput[[1]]) writeLines(iniFiles[[1]],iniInput[[1]])
if(epcinput[1]!=epcinput[2]){ if(epcInput[1]!=epcInput[2]){ #Change need here
writeLines(inifiles[[2]],ininput[[2]]) writeLines(iniFiles[[2]],iniInput[[2]])
} }
} }
return(settings) return(settings)

60
RBBGCMuso/R/spinupMuso.R
View File

@ -23,12 +23,12 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
Linuxp <-(Sys.info()[1]=="Linux") Linuxp <-(Sys.info()[1]=="Linux")
##Copy the variables from settings ##Copy the variables from settings
inputloc <- settings$inputloc inputLoc <- settings$inputLoc
outputloc <- settings$outputloc outputLoc <- settings$outputLoc
executable <- settings$executable executable <- settings$executable
ininput <- settings$ininput iniInput <- settings$iniInput
epc <- settings$epcinput epc <- settings$epcInput
calibrationpar <- settings$calibrationpar calibrationPar <- settings$calibrationPar
whereAmI<-getwd() whereAmI<-getwd()
@ -39,22 +39,22 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory
if(silent!=TRUE){ if(silent!=TRUE){
if(length(grep("(dayout$)|(log$)",list.files(inputloc)))>0){ 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")}} 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")}}
##With the aggressive option every unneeded file will deleted ##With the aggressive option every unneeded file will deleted
if(aggressive==TRUE){ if(aggressive==TRUE){
cleanupMuso(location=outputloc)} cleanupMuso(location=outputLoc)}
##change the epc file if and only if there are given parameters ##change the epc file if and only if there are given parameters
if(!is.null(parameters)){ if(!is.null(parameters)){
changemulline(filename=epc[1], calibrationpar, parameters)} changemulline(filename=epc[1], 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. ##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. ## Set the working directory to the inputLoc temporary.
setwd(inputloc) setwd(inputLoc)
##Run the spinup ##Run the spinup
@ -62,22 +62,22 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
if(silent){#silenc mode if(silent){#silenc mode
if(Linuxp){ if(Linuxp){
#In this case, in linux machines #In this case, in linux machines
system(paste(executable,ininput[1],"> /dev/null",sep=" ")) system(paste(executable,iniInput[1],"> /dev/null",sep=" "))
} else { } else {
#In windows machines there is a show.output.on.console option #In windows machines there is a show.output.on.console option
system(paste(executable,ininput[1],sep=" "),show.output.on.console = FALSE)} system(paste(executable,iniInput[1],sep=" "),show.output.on.console = FALSE)}
} else { } else {
system(paste(executable,ininput[1],sep=" "))} system(paste(executable,iniInput[1],sep=" "))}
############################################### ###############################################
#############LOG SECTION####################### #############LOG SECTION#######################
############################################### ###############################################
logspinup<-list.files(outputloc)[grep("log$",list.files(outputloc))] 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
logfiles <- list.files(outputloc)[grep("log$",list.files(outputloc))] logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))]
dirName<-paste(inputloc,"/LOG",sep="") dirName<-paste(inputLoc,"/LOG",sep="")
dirERROR<-paste(inputloc,"/ERROR",sep="") dirERROR<-paste(inputLoc,"/ERROR",sep="")
if(!dir.exists(dirName)){ if(!dir.exists(dirName)){
dir.create(dirName)} dir.create(dirName)}
@ -99,8 +99,8 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
} else { } else {
epcdir <- dirname(epc[1]) epcdir <- dirname(epc[1])
WRONGEPC<-paste(inputloc,"WRONGEPC",sep="") WRONGEPC<-paste(inputLoc,"WRONGEPC",sep="")
EPCS<-paste(inputloc,"EPCS",sep="") EPCS<-paste(inputLoc,"EPCS",sep="")
if(!dir.exists(WRONGEPC)){ if(!dir.exists(WRONGEPC)){
dir.create(WRONGEPC) dir.create(WRONGEPC)
@ -126,11 +126,11 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
if(debugging=="stamplog"){ if(debugging=="stamplog"){
stampnum<-stamp(dirName) stampnum<-stamp(dirName)
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -139,10 +139,10 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
} else { if(debugging){ } else { if(debugging){
if(is.null(logfilename)){ if(is.null(logfilename)){
if(inputloc==outputloc){ if(inputLoc==outputLoc){
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName,"/", x, sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName,"/", x, sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -151,10 +151,10 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
} else { } else {
if(inputloc==outputloc){#These are very ugly solutions for a string problem: inputloc: "./", if outputloc equalent of inputloc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's) if(inputLoc==outputLoc){#These are very ugly solutions for a string problem: inputLoc: "./", if outputLoc equalent of inputLoc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's)
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} else { } else {
lapply( logfiles, function (x) file.rename(from=paste(outputloc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep="")))
} }
if(errorsign==1){ if(errorsign==1){
@ -164,7 +164,7 @@ spinupMuso <- function(settings, parameters=NULL, debugging=FALSE, logfilename=N
}} }}
cleanupMuso(location=outputloc) cleanupMuso(location=outputLoc)
if(errorsign==1){ if(errorsign==1){

BIN
RBBGCMuso/R/sysdata.rda
View File

Binary file not shown.

BIN
RBBGCMuso_0.3.2.0-0.tar.gz
View File

Binary file not shown.

BIN
RBBGCMuso_0.4.0.0-0.tar.gz Normal file
View File

Binary file not shown.

154
forarcheologists
View File

@ -94,3 +94,157 @@
## TOT[lineNumber]<-content ## TOT[lineNumber]<-content
## writeLines(TOT,file) ## writeLines(TOT,file)
## } ## }
###Old solution for path joins, now I use file.path() function
## if(is.null(inputLoc)){
## inputLoc<- "./"
## } else {
## file.path(inputLoc,"")
## }
## inp <- unlist(strsplit(inputLoc,"")) #This is the charactervector of the given imput location
## if(inp[length(inp)]!="/"){
## inp<-c(inp,"/")
## inputLoc <- paste(inp,collapse = "")
## rm(inp)
## }# If inp not ends in / paste one at the end, then make a string, that will be the new inputLoc
## ##Example: "a/b/c ==> a/b/c/"
if(is.null(epcInput)){
epcflag=TRUE
epcInput[1] <- paste0(inputLoc,inputParser(string=" EPC file name",fileName=iniFiles[[1]],counter=1,value=TRUE))
epcInput[2] <- paste0(inputLoc,inputParser(string=" EPC file name",fileName=iniFiles[[2]],counter=1,value=TRUE))
} else {
iniFiles[[1]][grep(" EPC file name",iniFiles[[1]])]<-paste(epcInput[1],"\t EPC file name",sep="")
if(length(epcInput)==2){
iniFiles[[2]][grep(" EPC file name",iniFiles[[2]])]<-paste(epcInput[2],"\t EPC file name",sep="")
}
}
if(is.null(metInput)){
metflag=TRUE
metInput[1] <- unlist(strsplit(grep(" met file name",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
metInput[2] <- unlist(strsplit(grep(" met file name",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep(" met file name",iniFiles[[1]])]<-paste(metInput[1],"\t met file name",sep="")
if(length(metInput)==2){
iniFiles[[2]][grep(" met file name",iniFiles[[2]])]<-paste(metInput[2],"\t met file name",sep="")
}}
if(is.null(CO2Input)){
CO2flag=TRUE
CO2Input[1] <- unlist(strsplit(grep(" CO2 file",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
CO2Input[2] <- unlist(strsplit(grep(" CO2 file",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep(" CO2 file",iniFiles[[1]])]<-paste(CO2Input[1],"\t CO2 file",sep="")
if(length(CO2Input)==2){
iniFiles[[2]][grep(" CO2 file",iniFiles[[2]])]<-paste(CO2Input[2],"\t CO2 file",sep="")
}}
if(is.null(nitInput)){
nitflag=TRUE
nitInput[1] <- unlist(strsplit(grep("N-dep file",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
nitInput[2] <- unlist(strsplit(grep("N-dep file",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("N-dep file",iniFiles[[1]])]<-paste(nitInput[1],"N-dep file",sep="N-dep file")
if(length(epcInput)==2){
iniFiles[[2]][grep("N-dep file",iniFiles[[2]])]<-paste(nitInput[2],"N-dep file",sep="")
}}
if(is.null(thinInput)){
thinflag=TRUE
thinInput[1] <- unlist(strsplit(grep("do THINNING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
thinInput[2] <- unlist(strsplit(grep("do THINNING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do THINNING",iniFiles[[1]])]<-paste(thinInput[1],"do THINNING",sep="")
if(length(thinInput)==2){
iniFiles[[2]][grep("do THINNING",iniFiles[[2]])]<-paste(thinInput[2],"do THINNING",sep="")
}}
if(is.null(plantInput)){
plantflag=TRUE
plantInput[1] <- unlist(strsplit(grep("do PLANTING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
plantInput[2] <- unlist(strsplit(grep("do PLANTING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do PLANTING",iniFiles[[1]])]<-paste(plantInput[1],"do PLANTING",sep="")
if(length(plantInput)==2){
iniFiles[[2]][grep("do PLANTING",iniFiles[[2]])]<-paste(plantInput[2],"do PLANTING",sep="")
}}
if(is.null(mowInput)){
mowflag=TRUE
mowInput[1] <- unlist(strsplit(grep("do MOWING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
mowInput[2] <- unlist(strsplit(grep("do MOWING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do MOWING",iniFiles[[1]])]<-paste(mowInput[1],"do MOWING",sep="")
if(length(mowInput)==2){
iniFiles[[2]][grep("do MOWING",iniFiles[[2]])]<-paste(mowInput[2],"do MOWING",sep="")
}}
if(is.null(grazInput)){
grazflag=TRUE
grazInput[1] <- unlist(strsplit(grep("do GRAZING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
grazInput[2] <- unlist(strsplit(grep("do GRAZING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do GRAZING",iniFiles[[1]])]<-paste(grazInput[1],"do GRAZING",sep="")
if(length(grazInput)==2){
iniFiles[[2]][grep("do GRAZING",iniFiles[[2]])]<-paste(grazInput[2],"do GRAZING",sep="")
}}
if(is.null(harvInput)){
harvflag=TRUE
harvInput[1] <- unlist(strsplit(grep("do HARVESTING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
harvInput[2] <- unlist(strsplit(grep("do HARVESTING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do HARVESTING",iniFiles[[1]])]<-paste(harvInput[1],"do HARVESTING",sep="")
if(length(harvInput)==2){
iniFiles[[2]][grep("do HARVESTING",iniFiles[[2]])]<-paste(harvInput[2],"do HARVESTING",sep="")
}}
if(is.null(plougInput)){
plougflag=TRUE
plougInput[1] <- unlist(strsplit(grep("do PLOUGHING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
plougInput[2] <- unlist(strsplit(grep("do PLOUGHING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do PLOUGHING",iniFiles[[1]])]<-paste(plougInput[1],"do PLOUGHING",sep="")
if(length(plougInput)==2){
iniFiles[[2]][grep("do PLOUGHING",iniFiles[[2]])]<-paste(plougInput[2],"do PLOUGHING",sep="")
}}
if(is.null(fertInput)){
fertflag=TRUE
fertInput[1] <- unlist(strsplit(grep("do FERTILIZING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
fertInput[2] <- unlist(strsplit(grep("do FERTILIZING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do FERTILIZING",iniFiles[[1]])]<-paste(fertInput[1],"do FERTILIZING",sep="")
if(length(fertInput)==2){
iniFiles[[2]][grep("do FERTILIZING",iniFiles[[2]])]<-paste(fertInput[2],"do FERTILIZING",sep="")
}}
if(is.null(irrInput)){
irrflag=TRUE
irrInput[1] <- unlist(strsplit(grep("do IRRIGATION",iniFiles[[1]],value=TRUE),"[\ \t]"))[1]
irrInput[2] <- unlist(strsplit(grep("do IRRIGATION",iniFiles[[2]],value=TRUE),"[\ \t]"))[1]
} else {
iniFiles[[1]][grep("do IRRIGATION",iniFiles[[1]])]<-paste(irrInput[1],"do IRRIGATION",sep="")
if(length(irrInput)==2){
iniFiles[[2]][grep("do IRRIGATION",iniFiles[[2]])]<-paste(irrInput[2],"do IRRIGATION",sep="")
}}