introduce a new function, called: calibMuso

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)}
+}

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############################
@@ -35,11 +35,6 @@ rungetMuso <- function(settings,parameters=NULL, timee="d", debugging=FALSE, log
         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()