many bugfixes

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,17 +58,19 @@ 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(silent!=TRUE){
-        if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){    
+    ##     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")
+    ##         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,12 +149,14 @@ 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
 
 ###############################################    

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)

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){
+    Linuxp <-(Sys.info()[1]=="Linux")
-    #This function returns only the starting numbers of a string
+    ##Copy the variables from settings
-    unlist(strsplit(grep("^[0-9]",string,value = TRUE),"[aAzZ-]"))[1]
+    inputLoc <- settings$inputLoc
+    outputLoc <- settings$outputLoc
+    executable <- settings$executable
+    iniInput <- settings$iniInput
+    epc <- settings$epcInput
+    calibrationPar <- settings$calibrationPar
+    whereAmI<-getwd()
+
+
+
+
+    
+
+
+        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)
+                                        #normal run
+
+    if(silent){
+        if(Linuxp){
+            system(paste(executable,iniInput[2],"> /dev/null",sep=" "))
+        } else {
+            system(paste(executable,iniInput[2],sep=" "),show.output.on.console = FALSE)
         }
         
-numcutall<-function(vector){
+    } else {
-    #numcall apply numcut for all elements of a string vector
+        system(paste(executable,iniInput[2],sep=" "))
-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))}
-}
 
 
     
-
+    system(paste(executable,iniInput[2],sep=" "))
-    changemulline(settings,parameters)
-
-    inputloc<-settings$inputloc
-    executable<-settings$executable
-    ininput<-settings$ininput
-
-
-
-
-    setwd(inputloc)
-                                        #normal run
-    system(paste(executable,ininput[2],sep=" "))
     
     switch(timee,
            "d"=(Reva<-getdailyout(settings)),

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["spinup"] <- file.path(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["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)
@@ -91,7 +91,10 @@ setupMuso <- function(executable=NULL,
     }
     
     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 <- character(2)
-    outputName <- unlist(strsplit(iniFiles[[2]][grep("OUTPUT_CONTROL",iniFiles[[2]])+1],"[\ \t]"))[1]
+    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)
     }
 
     
@@ -220,6 +230,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,
                     outputLoc=outputLoc,
@@ -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]])      
         }
     }

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){

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