diff --git a/NAMESPACE b/NAMESPACE
index af76d821d72f8da42d0930dd0ea697cb48241e95..52615129209664fa3ab71063afc17af3fc962a62 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,14 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(SicInput,POSIXt)
+S3method(SicInput,data.frame)
+S3method(SicInput,matrix)
+S3method(SicInput,numeric)
+S3method(merge,SicInput)
+export(SicInput)
+export(SicLocation)
+export(SicLocations)
 export(cfg_tmp_project)
-export(convert_sic_params)
 export(create_section_txt)
 export(create_uniform_reach_txt)
 export(dem_to_reach)
@@ -17,7 +24,10 @@ export(read_bin_result_matrix)
 export(set_initial_conditions)
 export(sic_import_reaches)
 export(sic_run_export)
-export(sic_run_fortran)
+export(sic_run_mesh)
+export(sic_run_steady)
+export(sic_run_unsteady)
+export(sic_write_par)
 export(split_reach)
 import(magrittr)
 import(utils)
diff --git a/R/convert_sic_params.R b/R/convert_sic_params.R
index 2d8a24a3502845109d6b1affcfd34e652085b91e..8b137891791fe96927ad78e64b0aad7bded08bdc 100644
--- a/R/convert_sic_params.R
+++ b/R/convert_sic_params.R
@@ -1,26 +1 @@
-#' Convert a list of parameters into command line arguments for Fortran SIC programs
-#'
-#' This function is called by [sic_run_fortran] to convert list of parameters into a [character] command line parameters.
-#'
-#' The parameter `INTERF` is set to 0 (zero) by default.
-#'
-#' @param params a [list] of [character] containing the parameters to send to the fortran program with format `list(param=value, ...)`
-#' @template param_cfg
-#'
-#' @return A [character] with each parameter is converted to `[key param]=[value param]` and each parameter separated by a space character.
-#' @export
-#'
-#' @examples
-#' \dontrun{
-#' cfg <- cfg_tmp_project()
-#' convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg)
-#' }
-convert_sic_params <- function(params, cfg = loadConfig()) {
-  if (!"INTERF" %in% names(params)) {
-    params <- c(list(INTERF = cfg$sic$fortran$prms$INTERF), params)
-  }
-  params <- sapply(names(params), function(key) {
-    paste(key, params[[key]], sep= "=")
-  })
-  paste(params, collapse = " ")
-}
+
diff --git a/R/get_result.R b/R/get_result.R
index dea3db655cbabb3790c093abbb26a5013e5e9552..f4f358262ce9935ae82922d4aadb80000c5810ae 100644
--- a/R/get_result.R
+++ b/R/get_result.R
@@ -1,6 +1,6 @@
 #' Get a selection of variables from a simulation result
 #'
-#' @inheritParams sic_run_export
+#' @inheritParams sic_run_mesh
 #' @param filters [character] conditions to select columns in result table, see details
 #' @param m [matrix] of results produced by [read_bin_result_matrix]
 #'
@@ -11,7 +11,7 @@
 #' @examples
 #' \dontrun{
 #' cfg <- cfg_tmp_project()
-#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+#' sic_run_steady(cfg, scenario = 1)
 #' get_result(cfg, 1, filters = c("bf==4", "var=='Z'"))
 #' }
 get_result <- function(cfg,
@@ -47,7 +47,7 @@ get_result <- function(cfg,
 
 #' Read matrix of SIC simulation result file
 #'
-#' @inheritParams sic_run_export
+#' @inheritParams sic_run_mesh
 #'
 #' @return [matrix] with the simulation results
 #' @export
@@ -55,7 +55,7 @@ get_result <- function(cfg,
 #' @examples
 #' \dontrun{
 #' cfg <- cfg_tmp_project()
-#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+#' sic_run_steady(cfg, scenario = 1)
 #' m <- read_bin_result_matrix(cfg, 1)
 #' str(m)
 #' }
@@ -90,7 +90,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) {
 
 #' Get correspondence between network object and columns in result binary file
 #'
-#' @inheritParams sic_run_export
+#' @inheritParams sic_run_mesh
 #'
 #' @return a [data.frame] with following columns:
 #'
@@ -98,7 +98,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) {
 #' - "var": the name of the calculated variable
 #' - "col": the column number in the matrix produced by [read_bin_result_matrix]
 #'
-#' @warning
+#' @section Warning:
 #' Up to now, this function only handle results at sections.
 #'
 #' @export
@@ -108,7 +108,7 @@ read_bin_result_matrix <- function(cfg, scenario, variant = 0) {
 #' @examples
 #' \dontrun{
 #' cfg <- cfg_tmp_project()
-#' sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+#' sic_run_steady(cfg, scenario = 1)
 #' df <- get_result_tree(cfg, 1)
 #' head(df)
 #' }
diff --git a/R/set_initial_conditions.R b/R/set_initial_conditions.R
index 9c4bf9dafcb8c311b4ba567afa5acf944c9775c9..a0ce6d6772e99cd3ce5e1f04e2890ab98312be72 100644
--- a/R/set_initial_conditions.R
+++ b/R/set_initial_conditions.R
@@ -2,30 +2,25 @@
 #'
 #' Import initial conditions from a scenario/variant result calculation to a new scenario/variant.
 #'
-#' @param params [numeric], arguments passed to Edisic for importing initial conditions. See details
+#' @param iniParams [numeric], arguments passed to Edisic for importing initial conditions. See details
 #' @template param_cfg
 #'
-#' @details `params` [numeric] vector of length 5. Each number correspond to:
+#' @details `iniParams` [numeric] vector of length 5. Each number correspond to:
 #'
 #' 1. number of the scenario from which import initial conditions
-#' 1. number of the variant from which import initial conditions (Use "0" for no variant)
-#' 1. Time in seconds of the initial conditions to import (Use "0" for a single permanent simulation with no time steps)
-#' 1. number of the scenario where the initial conditions are exported to
-#' 1. number of the variant where the initial conditions are exported to  (Use "0" for no variant)
+#' 2. number of the variant from which import initial conditions (Use "0" for no variant)
+#' 3. Time in seconds of the initial conditions to import (Use "0" for a single permanent simulation with no time steps)
+#' 4. number of the scenario where the initial conditions are exported to
+#' 5. number of the variant where the initial conditions are exported to  (Use "0" for no variant)
 #'
 #' @export
 #'
-#' @examples
-#' \dontrun{
-#' # Import initial conditions from the scenario #1 without variant at time 0s
-#' # to the variant #1 in the scenario #1
-#' set_initial_conditions(c(1, 0, 0, 1, 1))
-#' }
-set_initial_conditions <- function(params, cfg = loadConfig()) {
-  if (!is.numeric(params) || length(params) != 5) {
-    stop("`params` should be a numeric of length 5")
+#' @inherit sic_run_mesh return examples
+set_initial_conditions <- function(iniParams, cfg = loadConfig()) {
+  if (!is.numeric(iniParams) || length(iniParams) != 5) {
+    stop("`iniParams` should be a numeric of length 5")
   }
-  sArgs <- paste(params, collapse = " ")
+  sArgs <- paste(iniParams, collapse = " ")
   cmd_line <- shQuote(
     paste(
       file.path(cfg$sic$path, cfg$sic$edisic),
diff --git a/R/sic_inputs.R b/R/sic_inputs.R
new file mode 100644
index 0000000000000000000000000000000000000000..f1c2d0bb724ce0de4434433374d45a704bdcf23b
--- /dev/null
+++ b/R/sic_inputs.R
@@ -0,0 +1,270 @@
+#' Get PAR filename for a given scenario in a SIC project
+#'
+#' @inheritParams sic_run_export
+#'
+#' @return A [character] with the path of the PAR file
+#' @noRd
+#'
+sic_get_par_filename <- function(cfg, scenario) {
+  x <- read_xml(cfg$project$path)
+  xPath <- sprintf("/Reseau/Flu[@nScenario=%d]/NomFicPar", scenario)
+  file <- x %>% xml_find_first(xPath) %>% xml_text
+  return(file.path(dirname(cfg$project$path), file))
+}
+
+#' Write a PAR file for SIC simulation
+#'
+#' Write inputs  in a PAR file respectively to \url{https://sic.g-eau.fr/Format-of-the-par-file}.
+#'
+#' @inheritParams sic_run_mesh
+#'
+#' @return Nothing.
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Setting the model configuration
+#' cfg <- cfg_tmp_project()
+#'
+#' # How to impose an hydrograph at the upstream offtake of the model?
+#' # Define the location of the upstream boundary condition to set
+#' locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q"))
+#' # Define its time series
+#' sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds
+#'                                 v = c(5, 20, 5)),     # flows
+#'                       locations = locations)
+#' # Write the parameters in the PAR file
+#' sic_write_par(cfg, 1, sicInputs)
+#' }
+sic_write_par <- function(cfg, scenario, sicInputs) {
+
+  if (is.null(attr(cfg, "config"))) {
+    stop("`cfg` should be created with `loadConfig()`")
+  }
+  stopifnot(is.numeric(scenario),
+            length(scenario) == 1,
+            inherits(sicInputs, "SicInput") || inherits(sicInputs, "SicInputs"))
+  if (inherits(sicInputs, "SicInput")) sicInputs <- merge(sicInputs)
+
+  sParFileName = sic_get_par_filename(cfg, scenario)
+
+  df = data.frame(C1 = "// PAR file for SIC",
+                  C2 = "automatically generated by rsci2",
+                  C3 = "",
+                  stringsAsFactors = FALSE)
+  i = 0
+  for (input in sicInputs) {
+    i = i + 1
+    # Localisation
+    if (is.null(input$locations)) {
+      dfLoc <- NULL
+    } else {
+      dfLoc <- data.frame(C1 = paste0("L", i), C2 = input$locations, C3 = "", stringsAsFactors = FALSE)
+    }
+    if (is.data.frame(input$data)) {
+      dfHeader <- data.frame(C1 = paste0("X", i), C2 = "LOI", C3 = ifelse(input$interpolated, "R", "E"))
+      dfData <- cbind(rep(paste0("X", i), nrow(input$data)), input$data)
+      names(dfData) <- names(df)
+      dfData <- rbind(dfHeader, dfData)
+    } else {
+      dfData <- data.frame(C1 = paste0("X", i), C2 = input$data, C3 = "")
+    }
+    df = rbind(df, dfLoc, dfData)
+  }
+  write.table(df, file = sParFileName, col.names = F, row.names = F, sep = "\t", quote = F)
+}
+
+#' Create a SIC input for a PAR file
+#'
+#' @param x either a fixed input, a [numeric] vector of time in seconds,
+#'          a [POSIXt] vector of time, a [matrix] or a [data.frame] with 2 columns (time and value)
+#' @param values a [numeric] vector used if `x` is a vector of [numeric] or [POSIXt]
+#' @param start a [POSIXt] indicating the start time to use as time zero in the simulation
+#' @param locations input locations created with [SicLocation] or [SicLocations]
+#' @param interpolated Interpolation mode `TRUE` for "ramp" mode and `FALSE` for "step" mode
+#' @param ... used for S3 method compatibility
+#'
+#' @return A *SicInput* object which is a list with the following items:
+#'
+#' - `locations`: a [SicLocations] object
+#' - `data`: [numeric], the fixed value, or [data.frame], the time series to apply to the locations
+#' - `interpolated`: [logical], interpolation mode
+#'
+#' @rdname SicInput
+#' @family SicInput
+#' @export
+#'
+#' @examples
+#' # How to impose 5 m3/s in the upstream offtake of the model?
+#' # Define location of the boundary condition to set
+#' locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q"))
+#' # Define its value
+#' sicInputs <- SicInput(5, locations = locations)
+#'
+#' # How to impose an hydrograph at the upstream offtake of the model?
+#' sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds
+#'                                 v = c(5, 20, 5)),     # flows
+#'                       locations = locations)
+SicInput <- function(x, ...) {
+  UseMethod("SicInput", x)
+}
+
+#' @rdname SicInput
+#' @export
+SicInput.numeric <- function(x, values = NULL, locations, interpolated = TRUE, ...) {
+  if (!(inherits(locations, "SicLocation") || inherits(locations, "SicLocations"))){
+    stop("`locations` should be of class 'SicLocation' or 'SicLocations'")
+  }
+  if (is.null(values)) {
+    if (length(x) != 1)
+      stop("For a single value `x` should be of length 1")
+    data <- x
+  } else {
+    if (length(x) != length(values))
+      stop("Lenghts of `x` and `values`should be equal.")
+    data <- data.frame(t = x,
+                       v = values)
+  }
+  sicInput <- list(
+    locations = locations,
+    data = data,
+    interpolated = interpolated
+  )
+  class(sicInput) <- c("SicInput", class(sicInput))
+  return(sicInput)
+}
+
+#' @rdname SicInput
+#' @export
+SicInput.POSIXt <- function(x, values, start = NULL, ...) {
+  if (is.null(start)) start = x[1]
+  if (!inherits(start, "POSIXt"))
+    stop("`start` should be of class 'POSIXt'.")
+
+  # Conversion in seconds
+  x <- as.numeric(difftime(x, start, units = "secs"))
+
+  if (any(x < 0))
+    stop("Negative time detected. Check the start time or the time series order.")
+
+  SicInput(x, values, ...)
+}
+
+#' @rdname SicInput
+#' @export
+SicInput.data.frame <- function(x, ...) {
+  SicInput(x[,1], x[, 2], ...)
+}
+
+#' @rdname SicInput
+#' @export
+SicInput.matrix <- function(x, ...) {
+  SicInput(x[,1], x[, 2], ...)
+}
+
+#' Merge SicInput objects into a list
+#'
+#' @param x a [SicInput] object to merge
+#' @param y a [SicInput] object to merge
+#' @param ... other [SicInput] objects to merge
+#'
+#' @details The list of parameter is compliant with the `merge` S3 method
+#' available in R, so this method can either be called by typing
+#' `merge` or `merge.SicInput`.
+#'
+#' @return A `SicInputs` object which is a list of [SicInput]
+#' @export
+#'
+#' @examples
+#' # How to impose 5 m3/s in the upstream offtake of the model?
+#' # Define location of the boundary condition to set
+#' locations <- SicLocation(list(Nd = 1, Pr = 1, car = "Q"))
+#' # Define its value
+#' sicInputUpstream <- SicInput(5, locations = locations)
+#'
+#' # Opening a gate at 0.5 m
+#' sicInputGate <- SicInput(
+#'   0.5,
+#'   locations = SicLocations(list(Bf = 3, Sn = 2, Ouv = 1, Car = "Ouverture"))
+#' )
+#'
+#' # Merging all inputs
+#' sicInputs <- merge(sicInputUpstream, sicInputGate)
+#'
+merge.SicInput <- function(x, y = NULL, ...) {
+  sicInputs <- list(x, y, ...)
+  sicInputs[sapply(sicInputs, is.null)] <- NULL
+  class(sicInputs) <- c("SicInputs", class(sicInputs))
+  return(sicInputs)
+}
+
+#' Set locations of a SIC model input
+#'
+#' Do the same as [SicLocation] for eventually several locations
+#'
+#' @param ... One or several [list] describing a location (See [SicLocation])
+#'
+#' @return a *SicLocations* object which is a [list] of [SicLocation].
+#' @family SicInput
+#' @export
+#'
+#' @examples
+#' # Applying the same flow to offtakes located in nodes number 1 to 10
+#' locations <- lapply(seq(10), function(i) { list(Nd = i, Pr = 1, Car = "Q")})
+#' locations <- do.call(SicLocations, locations)
+#' sicInputOfftakes <- SicInput(-0.5, locations = locations)
+SicLocations <- function(...) {
+  locations <- list(...)
+  if (length(locations) == 1) locations <- locations[[1]]
+  # Handle a single location in the parameters
+  if (length(locations[[1]]) == 1) locations <- list(locations)
+  if(!is.list(locations)) stop("`locations` must be a list")
+  l <- sapply(locations, SicLocation)
+  class(l) <- c("SicLocations", class(l))
+  return(l)
+}
+
+#' Set a location of a SIC model input
+#'
+#' @param location a [list] containing the location keys (see details)
+#'
+#' @return a *SicLocation* object which is a [character] string in the same format as the locations described in the sic documentation of PAR files: \url{https://sic.g-eau.fr/Format-of-the-par-file}.
+#'
+#' @family SicInput
+#' @export
+#'
+#' @inherit SicInput return examples
+#'
+SicLocation <- function(location) {
+  names(location) <- toupper(names(location))
+  # Checks
+  availLoc <- c("BF", "ND", "PR", "ST", "OUV", "SN", "PBF", "CAR")
+  availCar <- c("Q", "Z", "KMin", "KMoy", "Inf", "CoteRadier", "Largeur",
+                "Ouverture", "CoefQR", "SurverseHauteur", "CoefQSurverse",
+                "TanAl", "CoefQT", "CoteAxe", "Rayon", "D", "JMax", "S1S2",
+                "Decal", "Decrement", "CoteAmont")
+  if (!is.list(location)) stop("Each `location` must be a list")
+  if (!"CAR" %in% names(location)) stop("Each location should have at least an item 'CAR'")
+  if (!any(names(location) %in% c("BF", "ND")))
+    stop("a location should have at least an item 'BF' or 'ND'")
+  dfIncompat <- expand.grid(c("BF", "SN", "PBF"), c("ND", "PR", "ST"))
+  lapply(seq_len(nrow(dfIncompat)), function(i) {
+    if (all(unlist(dfIncompat[i, ]) %in% names(location)))
+      stop("These items can't be together in a location: ", paste(paste0("'", unlist(dfIncompat[i, ]), "'"), collapse = ", "))
+  })
+  if (any(names(location) %in% c("SN", "PBF")) & !"BF" %in% names(location))
+    stop("Location with 'SN' or 'PBF' item should have an item 'BF'")
+  # Create location string
+  l <- lapply(names(location), function(objType) {
+    if (!objType %in% availLoc) stop("Unknown location type: ", objType)
+    if (objType == "CAR" && !location[[objType]] %in% availCar)
+      stop("Value '", location[[objType]], "' of item 'CAR' unsupported. It should be one of: ",
+           paste(paste0("'", availCar, "'"), sep = ", "))
+    if (objType != "CAR" && !is.numeric(location[[objType]]))
+      stop("Item '", objType, "' should be numeric.")
+    return(paste(objType, location[[objType]], sep = "="))
+  })
+  s <- paste(unlist(l), collapse = "\t")
+  class(s) <- c("SicLocation", class(s))
+  return(s)
+}
diff --git a/R/sic_run_export.R b/R/sic_run_export.R
index bf56ec78ccdec5faaab735c7569e733dcb90a139..cf14f8a2b2dc4ec1072b52bba86862476874a0fa 100644
--- a/R/sic_run_export.R
+++ b/R/sic_run_export.R
@@ -2,9 +2,7 @@
 #'
 #' @details
 #' `params` parameter is a list representing parameters available in \url{https://sic.g-eau.fr/sicexport-utilitaire-d-exportation} to set the model network location of exported results. The string parameter `/x=n /yy=ii` in the command line is here represented by `list(xxx = nnn, yy = ii)`.
-#'
-#' @param scenario [numeric], the scenario to read
-#' @param variant [numeric], the variant to read
+#' @inheritParams sic_run_mesh
 #' @param params [list] location parameters of the result, see details.
 #' @template param_cfg
 #'
@@ -14,7 +12,7 @@
 #' @examples
 #' \dontrun{
 #' params <- list(SCE=1)
-#' sic_run_fortran("fluvia", params)
+#' sic_run_steady(cfg, scenario = 1)
 #' # For exporting result in sections at time 0
 #' sic_run_export(scenario = 1, params = list(t = 0))
 #' }
diff --git a/R/sic_run_fortran.R b/R/sic_run_fortran.R
index cb649c5f976be647b5ddc7c02c74e227a23eb267..759dd529b59ef59862cf2112666eeba6e090063d 100644
--- a/R/sic_run_fortran.R
+++ b/R/sic_run_fortran.R
@@ -1,23 +1,81 @@
-#' Run Talweg, Fluvia or Sirene
+#' Run Talweg, Fluvia or Sirene for a configured project
 #'
-#' @param prog [character], the program to run. Should be one of "talweg"
+#' Use `sic_run_mesh` to run the mesh generator, `sic_run_steady` for steady flow
+#' simulation, and `sic_run_unsteady` for unsteady flow simulation.
+#'
+#' @param scenario [numeric], the scenario to use
+#' @param variant [numeric], the variant to use (0 by default means no variant)
 #' @param params [list] or [character], see details
+#' @param sicInputs A [SicInput] object or a list of [SicInput] objects create by [merge.SicInput]
+#'                  used to create a PAR file injectig inputs for the simulation
+#' @param iniParams 5-length [numeric] [vector], see [set_initial_conditions] for details
 #' @template param_cfg
 #'
-#' @details If argument `params` is a [list], arguments are injected in the command line by taking the items of the list with the conversion
-#' `[key]=[value]`. If argument `params` is a [character]
+#' @details The argument `params` handles the parameters describe in
+#' [SIC documentation](https://sic.g-eau.fr/Execution-de-TALWEG-FLUVIA-et).
+#' If argument `params` is a [list], arguments are injected in the command line
+#' by taking the items of the list with the conversion `[key]=[value]`.
+#' By default, the parameter `INTERF=0` is added to the command line.
+#' If argument `params` is a [character] string it is directly used as parameters of the command line.
 #'
 #' @return Error code returned by [shell].
 #' @export
 #'
 #' @examples
 #' \dontrun{
+#' # Set up the configuration model
+#' cfg <- cfg_tmp_project()
+#'
+#' # Generate the mesh of the model
+#' sic_run_mesh(cfg)
+#'
 #' # Run steady simulation for the scenario #1
+#' sic_run_steady(cfg, scenario = 1)
+#'
+#' # Import initial condition from scenario 1
+#' # to scenario 1, variant 1 for unsteady flow simulation
+#' set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg)
+#'
+#' # Run unsteady flow simulation
+#' sic_run_unsteady(cfg, scenario = 1, variant = 1)
+#'
+#' # Or initiate and run the same unsteady flow simulation in one call
+#' sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1))
+#' }
+sic_run_mesh <- function(cfg, params = list()) {
+  sic_run_fortran(cfg, "talweg", params)
+}
+
+#' Convert a list of parameters into command line arguments for Fortran SIC programs
+#'
+#' This function is called by [sic_run_fortran] to convert list of parameters into a [character] command line parameters.
+#'
+#' The parameter `INTERF` is set to 0 (zero) by default.
+#'
+#' @param params a [list] of [character] containing the parameters to send to the fortran program with format `list(param=value, ...)`
+#' @template param_cfg
+#'
+#' @return A [character] with each parameter is converted to `[key param]=[value param]` and each parameter separated by a space character.
+#' @noRd
+#'
+#' @examples
+#' \dontrun{
 #' cfg <- cfg_tmp_project()
-#' params <- list(SCE=1)
-#' sic_run_fortran("fluvia", params, cfg = cfg)
-#'}
-sic_run_fortran <- function(prog, params = list(), cfg = loadConfig()) {
+#' convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg)
+#' }
+convert_sic_params <- function(params, cfg = loadConfig()) {
+  if (!"INTERF" %in% names(params)) {
+    params <- c(list(INTERF = cfg$sic$fortran$prms$INTERF), params)
+  }
+  params <- sapply(names(params), function(key) {
+    paste(key, params[[key]], sep= "=")
+  })
+  paste(params, collapse = " ")
+}
+
+#' @param prog [character], the program to run. Should be one of "talweg"
+#' @noRd
+sic_run_fortran <- function(cfg, prog, params) {
   if (is.list(params)) params <- convert_sic_params(params, cfg)
   cmd_line <- shQuote(
     paste(
@@ -28,11 +86,36 @@ sic_run_fortran <- function(prog, params = list(), cfg = loadConfig()) {
     type = "cmd2"
   )
   logger::log_debug(cmd_line)
-  ret <- shell(
+  shell(
     cmd_line,
     wait = T,
     translate = T
   )
-  file.remove("FLUVIA.INI", "SIRENE.INI")
-  return(ret)
+}
+
+#' @noRd
+sic_run_simulation <- function(cfg, prog, scenario, variant, sicInputs, params) {
+  if (!is.null(sicInputs)) {
+    sic_write_par(cfg, scenario, sicInputs)
+  }
+  params <- c(list(SCE = scenario, VAR = variant), params)
+  sic_run_fortran(cfg, prog, params)
+}
+
+#' @rdname sic_run_mesh
+#' @export
+sic_run_steady <- function(cfg, scenario, variant = 0, sicInputs = NULL, params = list()) {
+  sic_run_simulation(cfg, "fluvia", scenario, variant, sicInputs, params)
+}
+
+#' @rdname sic_run_mesh
+#' @export
+sic_run_unsteady <- function(cfg, scenario = iniParams[4], variant = iniParams[5], sicInputs = NULL, iniParams = NULL, params = list()) {
+  if (!is.null(iniParams)) {
+    sic_run_steady(cfg, scenario = iniParams[1], variant = iniParams[1])
+    set_initial_conditions(iniParams, cfg)
+  }
+  if (is.null(scenario)) stop("`scenario` should be defined")
+  if (is.null(variant)) variant <- 0
+  sic_run_simulation(cfg, "sirene", scenario, variant, sicInputs, params)
 }
diff --git a/R/split_reach.R b/R/split_reach.R
index e6850990aa4c84384dd99acf7b0ab4e05e33e76b..ce02a351cc284107f447cbaa60d79c12757bd5b4 100644
--- a/R/split_reach.R
+++ b/R/split_reach.R
@@ -7,6 +7,21 @@
 #' @export
 #'
 #' @examples
+#' # Create a 10km long trapezoidal uniform reach
+#' profT <- list(
+#'   B = 2,
+#'   S = (6 - 2) / 2 / 2,
+#'   ZF = 100,
+#'   ZB = 100 + 2
+#' )
+#' min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100),
+#'                                       upstream_bed_elevation = 10 + 2000 * 0.002,
+#'                                       slope = 0.002,
+#'                                       section_type = "T",
+#'                                       profile = profT)
+#' # Split into reaches of 2000 m
+#' reaches <- split_reach(min_reach, seq(0, 10000, 2000))
+#'
 split_reach <- function(reach, x_limits) {
   if(length(x_limits) < 2) {
     stop("`x_limits` length must be greater or equal to 2")
@@ -16,6 +31,8 @@ split_reach <- function(reach, x_limits) {
 
 #' Select portion of a reach between two chainages
 #'
+#' This function is used by [split_reach] for selecting sections of each reach.
+#'
 #' @param reach A ReachTxt object
 #' @param x_limits 2-length [numeric], min and max chainage
 #'
@@ -23,6 +40,21 @@ split_reach <- function(reach, x_limits) {
 #' @export
 #'
 #' @examples
+#' # Create a 10km long trapezoidal uniform reach
+#' profT <- list(
+#'   B = 2,
+#'   S = (6 - 2) / 2 / 2,
+#'   ZF = 100,
+#'   ZB = 100 + 2
+#' )
+#' min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100),
+#'                                       upstream_bed_elevation = 10 + 2000 * 0.002,
+#'                                       slope = 0.002,
+#'                                       section_type = "T",
+#'                                       profile = profT)
+#' # Extract sections between chainage 2000 m and 4000 m
+#' sel_reach <- extract_reach(min_reach, c(2000, 4000))
+#'
 extract_reach <- function(reach, x_limits) {
   reach_names <- names(reach)
   x_limits <- sprintf("%08d", x_limits)
diff --git a/man/SicInput.Rd b/man/SicInput.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..69623cb32ada80f7a530598c63c3b33e7e1713f2
--- /dev/null
+++ b/man/SicInput.Rd
@@ -0,0 +1,63 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_inputs.R
+\name{SicInput}
+\alias{SicInput}
+\alias{SicInput.numeric}
+\alias{SicInput.POSIXt}
+\alias{SicInput.data.frame}
+\alias{SicInput.matrix}
+\title{Create a SIC input for a PAR file}
+\usage{
+SicInput(x, ...)
+
+\method{SicInput}{numeric}(x, values = NULL, locations, interpolated = TRUE, ...)
+
+\method{SicInput}{POSIXt}(x, values, start = NULL, ...)
+
+\method{SicInput}{data.frame}(x, ...)
+
+\method{SicInput}{matrix}(x, ...)
+}
+\arguments{
+\item{x}{either a fixed input, a \link{numeric} vector of time in seconds,
+a \link{POSIXt} vector of time, a \link{matrix} or a \link{data.frame} with 2 columns (time and value)}
+
+\item{...}{used for S3 method compatibility}
+
+\item{values}{a \link{numeric} vector used if \code{x} is a vector of \link{numeric} or \link{POSIXt}}
+
+\item{locations}{input locations created with \link{SicLocation} or \link{SicLocations}}
+
+\item{interpolated}{Interpolation mode \code{TRUE} for "ramp" mode and \code{FALSE} for "step" mode}
+
+\item{start}{a \link{POSIXt} indicating the start time to use as time zero in the simulation}
+}
+\value{
+A \emph{SicInput} object which is a list with the following items:
+\itemize{
+\item \code{locations}: a \link{SicLocations} object
+\item \code{data}: \link{numeric}, the fixed value, or \link{data.frame}, the time series to apply to the locations
+\item \code{interpolated}: \link{logical}, interpolation mode
+}
+}
+\description{
+Create a SIC input for a PAR file
+}
+\examples{
+# How to impose 5 m3/s in the upstream offtake of the model?
+# Define location of the boundary condition to set
+locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q"))
+# Define its value
+sicInputs <- SicInput(5, locations = locations)
+
+# How to impose an hydrograph at the upstream offtake of the model?
+sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds
+                                v = c(5, 20, 5)),     # flows
+                      locations = locations)
+}
+\seealso{
+Other SicInput: 
+\code{\link{SicLocations}()},
+\code{\link{SicLocation}()}
+}
+\concept{SicInput}
diff --git a/man/SicLocation.Rd b/man/SicLocation.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..919d056c37b8cd6ccf493549914fd4b32ec9538a
--- /dev/null
+++ b/man/SicLocation.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_inputs.R
+\name{SicLocation}
+\alias{SicLocation}
+\title{Set a location of a SIC model input}
+\usage{
+SicLocation(location)
+}
+\arguments{
+\item{location}{a \link{list} containing the location keys (see details)}
+}
+\value{
+a \emph{SicLocation} object which is a \link{character} string in the same format as the locations described in the sic documentation of PAR files: \url{https://sic.g-eau.fr/Format-of-the-par-file}.
+}
+\description{
+Set a location of a SIC model input
+}
+\examples{
+# How to impose 5 m3/s in the upstream offtake of the model?
+# Define location of the boundary condition to set
+locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q"))
+# Define its value
+sicInputs <- SicInput(5, locations = locations)
+
+# How to impose an hydrograph at the upstream offtake of the model?
+sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds
+                                v = c(5, 20, 5)),     # flows
+                      locations = locations)
+}
+\seealso{
+Other SicInput: 
+\code{\link{SicInput}()},
+\code{\link{SicLocations}()}
+}
+\concept{SicInput}
diff --git a/man/SicLocations.Rd b/man/SicLocations.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..fbb1cd58ee3466572d6beddc0a27c5207cfba345
--- /dev/null
+++ b/man/SicLocations.Rd
@@ -0,0 +1,29 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_inputs.R
+\name{SicLocations}
+\alias{SicLocations}
+\title{Set locations of a SIC model input}
+\usage{
+SicLocations(...)
+}
+\arguments{
+\item{...}{One or several \link{list} describing a location (See \link{SicLocation})}
+}
+\value{
+a \emph{SicLocations} object which is a \link{list} of \link{SicLocation}.
+}
+\description{
+Do the same as \link{SicLocation} for eventually several locations
+}
+\examples{
+# Applying the same flow to offtakes located in nodes number 1 to 10
+locations <- lapply(seq(10), function(i) { list(Nd = i, Pr = 1, Car = "Q")})
+locations <- do.call(SicLocations, locations)
+sicInputOfftakes <- SicInput(-0.5, locations = locations)
+}
+\seealso{
+Other SicInput: 
+\code{\link{SicInput}()},
+\code{\link{SicLocation}()}
+}
+\concept{SicInput}
diff --git a/man/convert_sic_params.Rd b/man/convert_sic_params.Rd
deleted file mode 100644
index a861cea558378a3203e2be5f81c945cdc0b06deb..0000000000000000000000000000000000000000
--- a/man/convert_sic_params.Rd
+++ /dev/null
@@ -1,28 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/convert_sic_params.R
-\name{convert_sic_params}
-\alias{convert_sic_params}
-\title{Convert a list of parameters into command line arguments for Fortran SIC programs}
-\usage{
-convert_sic_params(params, cfg = loadConfig())
-}
-\arguments{
-\item{params}{a \link{list} of \link{character} containing the parameters to send to the fortran program with format \code{list(param=value, ...)}}
-
-\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
-}
-\value{
-A \link{character} with each parameter is converted to \verb{[key param]=[value param]} and each parameter separated by a space character.
-}
-\description{
-This function is called by \link{sic_run_fortran} to convert list of parameters into a \link{character} command line parameters.
-}
-\details{
-The parameter \code{INTERF} is set to 0 (zero) by default.
-}
-\examples{
-\dontrun{
-cfg <- cfg_tmp_project()
-convert_sic_params(list(SCE = 1, VAR = 1), cfg = cfg)
-}
-}
diff --git a/man/extract_reach.Rd b/man/extract_reach.Rd
index 7b62ec508798c4676e1518f47bf286a30f3408a2..150d650c930d34231bd907716e83d85e59ad1448 100644
--- a/man/extract_reach.Rd
+++ b/man/extract_reach.Rd
@@ -15,5 +15,22 @@ extract_reach(reach, x_limits)
 A ReachTxt object containing the selected sections.
 }
 \description{
-Select portion of a reach between two chainages
+This function is used by \link{split_reach} for selecting sections of each reach.
+}
+\examples{
+# Create a 10km long trapezoidal uniform reach
+profT <- list(
+  B = 2,
+  S = (6 - 2) / 2 / 2,
+  ZF = 100,
+  ZB = 100 + 2
+)
+min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100),
+                                      upstream_bed_elevation = 10 + 2000 * 0.002,
+                                      slope = 0.002,
+                                      section_type = "T",
+                                      profile = profT)
+# Extract sections between chainage 2000 m and 4000 m
+sel_reach <- extract_reach(min_reach, c(2000, 4000))
+
 }
diff --git a/man/get_result.Rd b/man/get_result.Rd
index 056115768a5f2a594adaf65f96d921879316c776..2d4dd7b38fe517eb89d0efa1e49323d0e6b36282 100644
--- a/man/get_result.Rd
+++ b/man/get_result.Rd
@@ -15,9 +15,9 @@ get_result(
 \arguments{
 \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
 
-\item{scenario}{\link{numeric}, the scenario to read}
+\item{scenario}{\link{numeric}, the scenario to use}
 
-\item{variant}{\link{numeric}, the variant to read}
+\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)}
 
 \item{filters}{\link{character} conditions to select columns in result table, see details}
 
@@ -32,7 +32,7 @@ Get a selection of variables from a simulation result
 \examples{
 \dontrun{
 cfg <- cfg_tmp_project()
-sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+sic_run_steady(cfg, scenario = 1)
 get_result(cfg, 1, filters = c("bf==4", "var=='Z'"))
 }
 }
diff --git a/man/get_result_tree.Rd b/man/get_result_tree.Rd
index 782f33d5c18be16e8eedec717e9158df4e7f7a47..b29d8f38199c00ba7101b701ba080520394a7f07 100644
--- a/man/get_result_tree.Rd
+++ b/man/get_result_tree.Rd
@@ -9,9 +9,9 @@ get_result_tree(cfg, scenario, variant = 0)
 \arguments{
 \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
 
-\item{scenario}{\link{numeric}, the scenario to read}
+\item{scenario}{\link{numeric}, the scenario to use}
 
-\item{variant}{\link{numeric}, the variant to read}
+\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)}
 }
 \value{
 a \link{data.frame} with following columns:
@@ -24,10 +24,15 @@ a \link{data.frame} with following columns:
 \description{
 Get correspondence between network object and columns in result binary file
 }
+\section{Warning}{
+
+Up to now, this function only handle results at sections.
+}
+
 \examples{
 \dontrun{
 cfg <- cfg_tmp_project()
-sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+sic_run_steady(cfg, scenario = 1)
 df <- get_result_tree(cfg, 1)
 head(df)
 }
diff --git a/man/merge.SicInput.Rd b/man/merge.SicInput.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..95cf45b834e46f80c17be075124a0d8145e3aa9e
--- /dev/null
+++ b/man/merge.SicInput.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_inputs.R
+\name{merge.SicInput}
+\alias{merge.SicInput}
+\title{Merge SicInput objects into a list}
+\usage{
+\method{merge}{SicInput}(x, y = NULL, ...)
+}
+\arguments{
+\item{x}{a \link{SicInput} object to merge}
+
+\item{y}{a \link{SicInput} object to merge}
+
+\item{...}{other \link{SicInput} objects to merge}
+}
+\value{
+A \code{SicInputs} object which is a list of \link{SicInput}
+}
+\description{
+Merge SicInput objects into a list
+}
+\details{
+The list of parameter is compliant with the \code{merge} S3 method
+available in R, so this method can either be called by typing
+\code{merge} or \code{merge.SicInput}.
+}
+\examples{
+# How to impose 5 m3/s in the upstream offtake of the model?
+# Define location of the boundary condition to set
+locations <- SicLocation(list(Nd = 1, Pr = 1, car = "Q"))
+# Define its value
+sicInputUpstream <- SicInput(5, locations = locations)
+
+# Opening a gate at 0.5 m
+sicInputGate <- SicInput(
+  0.5,
+  locations = SicLocations(list(Bf = 3, Sn = 2, Ouv = 1, Car = "Ouverture"))
+)
+
+# Merging all inputs
+sicInputs <- merge(sicInputUpstream, sicInputGate)
+
+}
diff --git a/man/read_bin_result_matrix.Rd b/man/read_bin_result_matrix.Rd
index c0e2bab1b2ad39de53b8c1c59b3849a4032ae552..00a0b45ade33af4ce38415fcf2c7ac6caa8e5d7a 100644
--- a/man/read_bin_result_matrix.Rd
+++ b/man/read_bin_result_matrix.Rd
@@ -9,9 +9,9 @@ read_bin_result_matrix(cfg, scenario, variant = 0)
 \arguments{
 \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
 
-\item{scenario}{\link{numeric}, the scenario to read}
+\item{scenario}{\link{numeric}, the scenario to use}
 
-\item{variant}{\link{numeric}, the variant to read}
+\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)}
 }
 \value{
 \link{matrix} with the simulation results
@@ -22,7 +22,7 @@ Read matrix of SIC simulation result file
 \examples{
 \dontrun{
 cfg <- cfg_tmp_project()
-sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+sic_run_steady(cfg, scenario = 1)
 m <- read_bin_result_matrix(cfg, 1)
 str(m)
 }
diff --git a/man/set_initial_conditions.Rd b/man/set_initial_conditions.Rd
index 9d1b02a60261256d7fb2d05755b3769384b3eb38..4caca8957fdd0aa1ff16116a2956730fdd291aca 100644
--- a/man/set_initial_conditions.Rd
+++ b/man/set_initial_conditions.Rd
@@ -4,18 +4,21 @@
 \alias{set_initial_conditions}
 \title{Import initial conditions}
 \usage{
-set_initial_conditions(params, cfg = loadConfig())
+set_initial_conditions(iniParams, cfg = loadConfig())
 }
 \arguments{
-\item{params}{\link{numeric}, arguments passed to Edisic for importing initial conditions. See details}
+\item{iniParams}{\link{numeric}, arguments passed to Edisic for importing initial conditions. See details}
 
 \item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
 }
+\value{
+Error code returned by \link{shell}.
+}
 \description{
 Import initial conditions from a scenario/variant result calculation to a new scenario/variant.
 }
 \details{
-\code{params} \link{numeric} vector of length 5. Each number correspond to:
+\code{iniParams} \link{numeric} vector of length 5. Each number correspond to:
 \enumerate{
 \item number of the scenario from which import initial conditions
 \item number of the variant from which import initial conditions (Use "0" for no variant)
@@ -26,8 +29,23 @@ Import initial conditions from a scenario/variant result calculation to a new sc
 }
 \examples{
 \dontrun{
-# Import initial conditions from the scenario #1 without variant at time 0s
-# to the variant #1 in the scenario #1
-set_initial_conditions(c(1, 0, 0, 1, 1))
+# Set up the configuration model
+cfg <- cfg_tmp_project()
+
+# Generate the mesh of the model
+sic_run_mesh(cfg)
+
+# Run steady simulation for the scenario #1
+sic_run_steady(cfg, scenario = 1)
+
+# Import initial condition from scenario 1
+# to scenario 1, variant 1 for unsteady flow simulation
+set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg)
+
+# Run unsteady flow simulation
+sic_run_unsteady(cfg, scenario = 1, variant = 1)
+
+# Or initiate and run the same unsteady flow simulation in one call
+sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1))
 }
 }
diff --git a/man/sic_run_export.Rd b/man/sic_run_export.Rd
index aea06aa93fd29e4b58d06c14abf93851960e54e8..4481d61c4aba93e0c9dca7a6fb78b630a6da34af 100644
--- a/man/sic_run_export.Rd
+++ b/man/sic_run_export.Rd
@@ -7,9 +7,9 @@
 sic_run_export(scenario, variant = 0, params, cfg = loadConfig())
 }
 \arguments{
-\item{scenario}{\link{numeric}, the scenario to read}
+\item{scenario}{\link{numeric}, the scenario to use}
 
-\item{variant}{\link{numeric}, the variant to read}
+\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)}
 
 \item{params}{\link{list} location parameters of the result, see details.}
 
@@ -27,7 +27,7 @@ Run SicExport and read the exported file
 \examples{
 \dontrun{
 params <- list(SCE=1)
-sic_run_fortran("fluvia", params)
+sic_run_steady(cfg, scenario = 1)
 # For exporting result in sections at time 0
 sic_run_export(scenario = 1, params = list(t = 0))
 }
diff --git a/man/sic_run_fortran.Rd b/man/sic_run_fortran.Rd
deleted file mode 100644
index 0c972bbded282694e097bedd9dc105ca2b1b6bd2..0000000000000000000000000000000000000000
--- a/man/sic_run_fortran.Rd
+++ /dev/null
@@ -1,33 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/sic_run_fortran.R
-\name{sic_run_fortran}
-\alias{sic_run_fortran}
-\title{Run Talweg, Fluvia or Sirene}
-\usage{
-sic_run_fortran(prog, params = list(), cfg = loadConfig())
-}
-\arguments{
-\item{prog}{\link{character}, the program to run. Should be one of "talweg"}
-
-\item{params}{\link{list} or \link{character}, see details}
-
-\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
-}
-\value{
-Error code returned by \link{shell}.
-}
-\description{
-Run Talweg, Fluvia or Sirene
-}
-\details{
-If argument \code{params} is a \link{list}, arguments are injected in the command line by taking the items of the list with the conversion
-\verb{[key]=[value]}. If argument \code{params} is a \link{character}
-}
-\examples{
-\dontrun{
-# Run steady simulation for the scenario #1
-cfg <- cfg_tmp_project()
-params <- list(SCE=1)
-sic_run_fortran("fluvia", params, cfg = cfg)
-}
-}
diff --git a/man/sic_run_mesh.Rd b/man/sic_run_mesh.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..a564a3e3d045bda4d5d1ba14b5ac3cce0cfb8138
--- /dev/null
+++ b/man/sic_run_mesh.Rd
@@ -0,0 +1,72 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_run_fortran.R
+\name{sic_run_mesh}
+\alias{sic_run_mesh}
+\alias{sic_run_steady}
+\alias{sic_run_unsteady}
+\title{Run Talweg, Fluvia or Sirene for a configured project}
+\usage{
+sic_run_mesh(cfg, params = list())
+
+sic_run_steady(cfg, scenario, variant = 0, sicInputs = NULL, params = list())
+
+sic_run_unsteady(
+  cfg,
+  scenario = iniParams[4],
+  variant = iniParams[5],
+  sicInputs = NULL,
+  iniParams = NULL,
+  params = list()
+)
+}
+\arguments{
+\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
+
+\item{params}{\link{list} or \link{character}, see details}
+
+\item{scenario}{\link{numeric}, the scenario to use}
+
+\item{variant}{\link{numeric}, the variant to use (0 by default means no variant)}
+
+\item{sicInputs}{A \link{SicInput} object or a list of \link{SicInput} objects create by \link{merge.SicInput}
+used to create a PAR file injectig inputs for the simulation}
+
+\item{iniParams}{5-length \link{numeric} \link{vector}, see \link{set_initial_conditions} for details}
+}
+\value{
+Error code returned by \link{shell}.
+}
+\description{
+Use \code{sic_run_mesh} to run the mesh generator, \code{sic_run_steady} for steady flow
+simulation, and \code{sic_run_unsteady} for unsteady flow simulation.
+}
+\details{
+The argument \code{params} handles the parameters describe in
+\href{https://sic.g-eau.fr/Execution-de-TALWEG-FLUVIA-et}{SIC documentation}.
+If argument \code{params} is a \link{list}, arguments are injected in the command line
+by taking the items of the list with the conversion \verb{[key]=[value]}.
+By default, the parameter \code{INTERF=0} is added to the command line.
+If argument \code{params} is a \link{character} string it is directly used as parameters of the command line.
+}
+\examples{
+\dontrun{
+# Set up the configuration model
+cfg <- cfg_tmp_project()
+
+# Generate the mesh of the model
+sic_run_mesh(cfg)
+
+# Run steady simulation for the scenario #1
+sic_run_steady(cfg, scenario = 1)
+
+# Import initial condition from scenario 1
+# to scenario 1, variant 1 for unsteady flow simulation
+set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg)
+
+# Run unsteady flow simulation
+sic_run_unsteady(cfg, scenario = 1, variant = 1)
+
+# Or initiate and run the same unsteady flow simulation in one call
+sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1))
+}
+}
diff --git a/man/sic_write_par.Rd b/man/sic_write_par.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..c74bb11d401cbfab92951611feb4b5f7030b8c72
--- /dev/null
+++ b/man/sic_write_par.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sic_inputs.R
+\name{sic_write_par}
+\alias{sic_write_par}
+\title{Write a PAR file for SIC simulation}
+\usage{
+sic_write_par(cfg, scenario, sicInputs)
+}
+\arguments{
+\item{cfg}{a \link{config} object. Configuration to use. See \link{loadConfig} for details}
+
+\item{scenario}{\link{numeric}, the scenario to use}
+
+\item{sicInputs}{A \link{SicInput} object or a list of \link{SicInput} objects create by \link{merge.SicInput}
+used to create a PAR file injectig inputs for the simulation}
+}
+\value{
+Nothing.
+}
+\description{
+Write inputs  in a PAR file respectively to \url{https://sic.g-eau.fr/Format-of-the-par-file}.
+}
+\examples{
+\dontrun{
+# Setting the model configuration
+cfg <- cfg_tmp_project()
+
+# How to impose an hydrograph at the upstream offtake of the model?
+# Define the location of the upstream boundary condition to set
+locations <- SicLocations(list(Nd = 1, Pr = 1, car = "Q"))
+# Define its time series
+sicInputs <- SicInput(data.frame(t = c(0, 3600, 7200), # time in seconds
+                                v = c(5, 20, 5)),     # flows
+                      locations = locations)
+# Write the parameters in the PAR file
+sic_write_par(cfg, 1, sicInputs)
+}
+}
diff --git a/man/split_reach.Rd b/man/split_reach.Rd
index fe18d7eca4062dbf16e9f0e11ea5d9b5f5c1f6f6..0fde60fa7eb6fa9683baced212a9926d93d4a0bd 100644
--- a/man/split_reach.Rd
+++ b/man/split_reach.Rd
@@ -17,3 +17,20 @@ A \link{list} of ReachTxt objects
 \description{
 Split a reach into a list of reaches
 }
+\examples{
+# Create a 10km long trapezoidal uniform reach
+profT <- list(
+  B = 2,
+  S = (6 - 2) / 2 / 2,
+  ZF = 100,
+  ZB = 100 + 2
+)
+min_reach <- create_uniform_reach_txt(abscissas = seq(0, 10000, 100),
+                                      upstream_bed_elevation = 10 + 2000 * 0.002,
+                                      slope = 0.002,
+                                      section_type = "T",
+                                      profile = profT)
+# Split into reaches of 2000 m
+reaches <- split_reach(min_reach, seq(0, 10000, 2000))
+
+}
diff --git a/tests/testthat/test-get_result.R b/tests/testthat/test-get_result.R
index cbe939ddd9679d0a2f93ccab4a7216de527ff526..36407e676f42910ab2a7a4e03a5cf8fd895542a2 100644
--- a/tests/testthat/test-get_result.R
+++ b/tests/testthat/test-get_result.R
@@ -1,7 +1,7 @@
 skip_on_ci()
 
 cfg <- cfg_tmp_project()
-sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+sic_run_steady(cfg, scenario = 1)
 
 test_that("get_result returns a matrix with correct colnames", {
   result <- get_result(cfg, 1, filters = c("bf=4", "var='Z'"))
diff --git a/tests/testthat/test-set_initial_conditions.R b/tests/testthat/test-set_initial_conditions.R
index 4aad0fceb8c6999ae05d4a6a1642456841ed44fe..619abafffe624dd3c42bb14e402dcbe23c560de9 100644
--- a/tests/testthat/test-set_initial_conditions.R
+++ b/tests/testthat/test-set_initial_conditions.R
@@ -2,8 +2,8 @@ skip_on_ci()
 
 test_that("set_initial_conditions works", {
   cfg <- cfg_tmp_project()
-  sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+  sic_run_steady(cfg, scenario = 1)
   set_initial_conditions(c(1, 0, 0, 1, 1), cfg = cfg)
-  sic_run_fortran("sirene", list(SCE = 1, VAR = 1), cfg = cfg)
+  sic_run_unsteady(cfg, scenario = 1, variant = 1)
   expect_true(file.exists(gsub("\\.xml", "_1_1.res", cfg$project$path)))
 })
diff --git a/tests/testthat/test-sic_run_export.R b/tests/testthat/test-sic_run_export.R
index f7e8598bd5f83e7184e2f60cf1e149a75c10939f..172a58f9342c309fed721f3ff460b028950ca71b 100644
--- a/tests/testthat/test-sic_run_export.R
+++ b/tests/testthat/test-sic_run_export.R
@@ -3,7 +3,7 @@ skip_on_ci()
 cfg <- cfg_tmp_project()
 
 test_that("RunExport on Fluvia run works", {
-  sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+  sic_run_steady(cfg, scenario = 1)
   m <- sic_run_export(scenario = 1, params = list(t = 0), cfg = cfg)
   expect_type(m, "double")
   expect_equal(colnames(m)[1:3], c("Bief", "Section", "Abscisse"))
diff --git a/tests/testthat/test-sic_run_fortran.R b/tests/testthat/test-sic_run_fortran.R
index 5d811fef85209aee370b3708df3895acf2225dc6..f042faa96777a430ef6d7752c028e2283984a628 100644
--- a/tests/testthat/test-sic_run_fortran.R
+++ b/tests/testthat/test-sic_run_fortran.R
@@ -2,14 +2,20 @@ skip_on_ci()
 
 cfg <- cfg_tmp_project()
 
-test_that("fluvia on SCE=1 should create a binary result file", {
-  sic_run_fortran("fluvia", list(SCE = 1), cfg = cfg)
+test_that("fluvia with scenario = 1 should create a binary result file", {
+  sic_run_steady(cfg, scenario = 1)
   expect_true(file.exists(gsub("\\.xml", "_1_0.res", cfg$project$path)))
   expect_true(file.exists(gsub("\\.xml", "_1_0.rci", cfg$project$path)))
 })
 
 test_that("talweg should update xml project", {
   mtime_before <- file.mtime(cfg$project$path)
-  sic_run_fortran("talweg", cfg = cfg)
+  sic_run_mesh(cfg)
   expect_gt(file.mtime(cfg$project$path), mtime_before)
 })
+
+test_that("'One call' unsteady flow simulation works", {
+  cfg <- cfg_tmp_project()
+  sic_run_unsteady(cfg, iniParams = c(1, 0, 0, 1, 1))
+  expect_true(file.exists(gsub("\\.xml", "_1_1.res", cfg$project$path)))
+})
diff --git a/tests/testthat/test-sic_set_inputs.R b/tests/testthat/test-sic_set_inputs.R
new file mode 100644
index 0000000000000000000000000000000000000000..731d3bc8cb8c13c6b43aea9e2b638df3dfd8a082
--- /dev/null
+++ b/tests/testthat/test-sic_set_inputs.R
@@ -0,0 +1,81 @@
+locations <- SicLocations(list(bf = 1, sn = 1, car = "Z"),
+                          list(Nd = 1, Pr = 1, car = "Q"))
+input <- SicInput(5, locations = locations)
+dfTest <- data.frame(t = seq(0, by = 600, length.out = 11),
+                     v = sin(0:10))
+input2 <- SicInput(dfTest, locations = SicLocation(list(Nd = 1, Car = "Z")))
+
+test_that("SicLocation shoud return errors with incoherent parameters", {
+  expect_error(SicLocation(list(bf = 1, sn = 2)),
+               regexp = "Each location should have at least an item 'CAR'")
+  expect_error(SicLocation(list(bf = 1, nd = 2, car = "Q")),
+               regexp = "These items can't be together in a location", fixed = TRUE)
+})
+
+test_that("SicLocation should works", {
+  expect_s3_class(SicLocation(list(bf = 1, sn = 1, car = "Q")), "SicLocation")
+  expect_equal(unclass(SicLocation(list(bf = 1, sn = 1, car = "Q"))),
+               "BF=1\tSN=1\tCAR=Q")
+})
+
+test_that("SicLocations should work", {
+  expect_s3_class(SicLocations(list(list(bf = 1, sn = 1, car = "Q"))), "SicLocations")
+  expect_equal(SicLocations(list(list(bf = 1, sn = 1, car = "Q")))[1],
+               "BF=1\tSN=1\tCAR=Q")
+})
+
+test_that("SiCinput should work with fixed value", {
+  input <- SicInput(5, locations = locations)
+  expect_s3_class(input, "SicInput")
+  expect_equal(input$locations, locations)
+  expect_equal(input$data, 5)
+
+})
+
+test_that("SiCinput should work with time in seconds", {
+  input <- SicInput(dfTest$t, dfTest$v, locations = locations)
+  expect_equal(input$data, dfTest)
+})
+
+test_that("SiCinput should work with time in POSIXt", {
+  input <- SicInput(seq(as.POSIXct("2020-01-05 00:00:00", tz = "UTC"),
+                        by = 600, length.out = 11),
+                    dfTest$v,
+                    locations = locations)
+  expect_equal(input$data, dfTest)
+})
+
+test_that("SicInput should work with data.frame and matrix", {
+  input <- SicInput(dfTest, locations = locations)
+  expect_equal(input$data, dfTest)
+  input <- SicInput(as.matrix(dfTest), locations = locations)
+  expect_equal(input$data, dfTest)
+})
+
+
+test_that("merge.SicInputs should work", {
+  inputs <- merge(input)
+  expect_length(inputs, 1)
+  inputs <- merge(input, input2)
+  expect_length(inputs, 2)
+  expect_equal(unclass(inputs[[2]]$locations), "ND=1\tCAR=Z")
+})
+
+skip_on_ci()
+cfg <- cfg_tmp_project()
+
+test_that("sic_write_par should return errors with wrong parameters", {
+  expect_error(sic_write_par("toto", 1, input), regexp = "loadConfig")
+  expect_error(sic_write_par(cfg, "toto", input), regexp = "is.numeric")
+  expect_error(sic_write_par(cfg, 1, list()), regexp = "sicInputs")
+  expect_error(sic_write_par(cfg, c(1, 2), input), regexp = "length")
+})
+
+test_that("sic_write_par should works", {
+  sic_write_par(cfg, 1, merge(input, input2))
+  file <- sic_get_par_filename(cfg, 1)
+  expect_true(file.exists(file))
+  s <- readLines(file)
+  expect_equal(gsub("(\t)+$", "", s[2]), "L1\tBF=1\tSN=1\tCAR=Z")
+  expect_equal(gsub("(\t)+$", "",s[4]), "X1\t5")
+})