R/utility_tools.R

In JFeldbauer/rodeoFABM: Create FABM fortran90 code from data.frames.

#' Function to compile GOTM-FABM
#'
#' This function compiles GOTM-FABM with FABM source code generated by gen_fabm_code().
#' It assumes that you allready have run cmake within the build directory
#' @param build_dir build directory
#' @param src_dir GOTM source directory. The directory the GOTM source code was cloned into from github
#' @param fabm_file forthran source file for FABM created by gen_fabm_code()
#' @param funs_file Path to additional text files containing functions that should be compiled alon
#'    with the generateds fortran files
#' @keywords FABM, GOTM, compile
#' @author Johannes Feldbauer
#' @export
#' @examples
#' \dontrun{
#' library(readODS)
#' library(rodeoFABM)
#'
#' # copy example ods file
#' example_model <- system.file("extdata/simple_model.ods", package= 'rodeoFABM')
#' dir.create('example') # Create example folder
#' file.copy(from = example_model, to = 'example',recursive = TRUE)
#' setwd('example') # Change working directory to example folder
#'
#' # read in example ods file
#' odf_file <- "simple_model.ods"
#' vars <- read_ods(odf_file,1)
#' pars <- read_ods(odf_file,2)
#' funs <- read_ods(odf_file,3)
#' pros <- read_ods(odf_file,4)
#' stoi <- read_ods(odf_file,5)
#'
#' # generate fabm code
#' gen_fabm_code(vars,pars,funs,pros,stoi,"simple_model.f90",diags = TRUE)
#' # build GOTM
#' build_GOTM(build_dir = "../build",fabm_file = "simple_model.f90",
#'            src_dir = "../gotm")
#' }
#'
build_GOTM <- function(build_dir,src_dir,fabm_file, funs_file = NULL){

  # name of the fortran file within the FABM directory
  src_file = "rodeo.F90"
  
  
  # add subfolder to source dir
  src_root <-file.path(src_dir, "extern", "fabm", "src", "models", "tuddhyb")
  src_dir <- file.path(src_dir, "extern", "fabm", "src", "models", "tuddhyb", "rodeo")

  # Set original working directory
  oldwd <- getwd()

  # this way if the function exits for any reason, success or failure, wd are reset:
  on.exit({
    setwd(oldwd)
  })

  # copy FABM file to source directory
  cat("copying file ", fabm_file," to ", src_dir, "\n")
  file.copy(fabm_file, file.path(src_dir, src_file), overwrite = TRUE)

  # if given copy function files to source directory
  if(length(funs_file) > 0) {
    cat(paste0("Copying function files to ", src_dir, "\n"))
    sapply(funs_file, function(f)file.copy(f, file.path(src_dir, f), overwrite = TRUE))
  
    # update makefile
    cmakef <- paste0("add_library(fabm_models_tuddhyb OBJECT\n", "\t\ttuddhyb_model_library.F90\n",
                     paste0("\t\trodeo/",funs_file,"\n", collapse = ""), "\t\trodeo/rodeo.F90\n",
                     "\t\t)\n","add_dependencies(fabm_models_tuddhyb fabm_base)")
  } else {
    cmakef <- paste0("add_library(fabm_models_tuddhyb OBJECT\n", "\t\ttuddhyb_model_library.F90\n",
                     "\t\trodeo/rodeo.F90\n", "\t\t)\n",
                     "add_dependencies(fabm_models_tuddhyb fabm_base)")
  }
  # write CMakeFiles.txt
 cat(cmakef, file = file.path(src_root, "CMakeLists.txt"))
  
  
  # complie
  setwd(build_dir)
  cat("compiling \n\n")
  system2("make")

  # copy new gotm executable to original directory
  file.copy("gotm",file.path(oldwd,"gotm"),overwrite = TRUE)
  cat("finished \n")

}


#' Function to clone GOTM-FABM from github
#'
#' This function clones GOTM-FABM from the GOTM github page and prepares comiplation using cmake.
#' Requires cmake. Builds the lake branche of GOTM
#' @param build_dir Directory to build GOTM-FABM in.
#' @param src_dir Directory to save the source code in.
#' @param newest_version Boolean. Should the newest version of GOTM be used. Might break if there
#'   are substantial changes in GOTM. Fallback uses the Version of November 2019.
#' @keywords FABM, GOTM, compile
#' @author Johannes Feldbauer
#' @export
#' @examples
#' \dontrun{
#' clone_GOTM(build_dir = "build",src_dir = "gotm")
#' }

clone_GOTM <- function(build_dir = "build",src_dir = "gotm", newest_version = TRUE){


  # Set original working directory
  oldwd <- getwd()

  # this way if the function exits for any reason, success or failure, wd are reset:
  on.exit({
    setwd(oldwd)
  })

  # clone GOTM-FABM to source directory
  if(!dir.exists(src_dir)){
    dir.create(src_dir)
  }

  system(paste0("git clone --recursive https://github.com/gotm-model/code.git ",src_dir))
  setwd(src_dir)

  # go to specific version
  if(!newest_version){
    system("git reset --hard 33062b0fe30ffec546db9536c3ee6af263845307")
  }
  # switch to lake branch
  system("git checkout origin/lake")

  # fetch submodules
  system("git submodule update --init --recursive")

  setwd(oldwd)

  # create and switch into build folder
  if(!dir.exists(build_dir)){
    dir.create(build_dir)
  }
  # copy FABM file to make FABM aware of rodeoFABM model
  cm_file <- system.file(file.path("extdata","FABM_files","CMakeLists.txt"), package= 'rodeoFABM')
  file.copy(from = cm_file, to = file.path(src_dir,"extern","fabm","src"),
            recursive = TRUE,overwrite = TRUE)
  rodeo_files <- system.file(file.path("extdata","FABM_files","models","tuddhyb"),
                             package= 'rodeoFABM')
  file.copy(from = rodeo_files, to = file.path(src_dir,"extern","fabm","src","models"),
            recursive = TRUE,overwrite = TRUE)

  setwd(build_dir)

  # build make files using cmake with correct flags for FABM and STIM
  system(paste0("cmake ",file.path("..",src_dir),
                " -DGOTM_USE_FABM=on -DGOTM_USE_STIM=on -DFABM_INSTITUTES=tuddhyb"))

  setwd(oldwd)
  cat("finished \n")

}