This function returns information on model structure components and parameters used, given a FUSE model.

FUSEinfo.R

#' This function returns information on model structure components and parameters used, given FUSE model.
#'
#' @param mid FUSE model structure ID number (integer from 1 to 1248).
#' @number default is TRUE (returns the model options numbers, if FALSE it returns model options names)
#'
#' @examples
#' # FUSEinfo(mid=60)
#'

FUSEinfo <- function(mid, number=TRUE) {

  # Model structure info #######################################################
  # load list of availabe models
  load(system.file("data/modlist.rda", package = "fuse"))
  modlist <- modlist # to remove NOTE in R CMD check

  xnumber <- xtext <- c("rferr" = NA,
                        "arch1" = NA,
                        "arch2" = NA,
                        "qsurf" = NA,
                        "qperc" = NA,
                        "esoil" = NA,
                        "qintf" = NA,
                        "q_tdh" = NA)

  selectedmodel<-list("rferr"=modlist[mid,2],
                      "arch1"=modlist[mid,3],
                      "arch2"=modlist[mid,4],
                      "qsurf"=modlist[mid,5],
                      "qperc"=modlist[mid,6],
                      "esoil"=modlist[mid,7],
                      "qintf"=modlist[mid,8],
                      "q_tdh"=modlist[mid,9])

  #---------------------------------------------------------------------------
  #(1) rainfall error
  if (selectedmodel$rferr == 11) {
    xnumber["rferr"] <- 11
    xtext["rferr"] <- "additive_e" # additive rainfall error
  }

  if (selectedmodel$rferr == 12) {
    xnumber["rferr"] <- 12
    xtext["rferr"] <- "multiplc_e" # multiplicative rainfall error
  }
  #---------------------------------------------------------------------------
  #(2) upper-layer architecture
  if (selectedmodel$arch1 == 21) {
    xnumber["arch1"] <- 21
    xtext["arch1"] <- "onestate_1" # upper layer defined by a single state variable)")
  }

  if (selectedmodel$arch1 == 22) {
    xnumber["arch1"] <- 22
    xtext["arch1"] <- "tension1_1" # upper layer broken up into tension and free storage)")
  }

  if (selectedmodel$arch1 == 23) {
    xnumber["arch1"] <- 23
    xtext["arch1"] <- "tension2_1" # tension storage sub-divided into recharge and excess)")
  }
  #---------------------------------------------------------------------------
  #(3) lower-layer architecture and baseflow
  if (selectedmodel$arch2 == 31) {
    xnumber["arch2"] <- 31
    xtext["arch2"] <- "fixedsiz_2" # baseflow reservoir of fixed size)")
  }

  if (selectedmodel$arch2 == 32) {
    xnumber["arch2"] <- 32
    xtext["arch2"] <- "tens2pll_2" # tension reservoir plus two parallel tanks)")
  }

  if (selectedmodel$arch2 == 33) {
    xnumber["arch2"] <- 33
    xtext["arch2"] <- "unlimfrc_2" # baseflow resvr of unlimited size (0-HUGE), frac rate)")
  }

  if (selectedmodel$arch2 == 34) {
    xnumber["arch2"] <- 34
    xtext["arch2"] <- "unlimpow_2" # baseflow resvr of unlimited size (0-HUGE), power recession)")
  }
  #if (selectedmodel$arch2 == 35) {xnumber["arch2"] <- 35   }else{     xtext["arch2"] <- "topmdexp_2 (Topmodel exponential reservoir (not in modlist?))")
  #---------------------------------------------------------------------------
  #(4) surface runoff
  if (selectedmodel$qsurf == 41) {
    xnumber["qsurf"] <- 41
    xtext["qsurf"] <- "arno_x_vic" # ARNO/Xzang/VIC parameterization (upper zone control))")
  }

  if (selectedmodel$qsurf == 42) {
    xnumber["qsurf"] <- 42
    xtext["qsurf"] <- "prms_varnt" # PRMS variant (fraction of upper tension storage))")
  }

  if (selectedmodel$qsurf == 43) {
    xnumber["qsurf"] <- 43
    xtext["qsurf"] <- "tmdl_param" # TOPMODEL parameterization (only valid for TOPMODEL qb))")
  }
  #---------------------------------------------------------------------------
  #(5) percolation
  if (selectedmodel$qperc == 51) {
    xnumber["qperc"] <- 51
    xtext["qperc"] <- "perc_f2sat" # water from (field cap to sat) avail for percolation)")
  }
  if (selectedmodel$qperc == 52) {
    xnumber["qperc"] <- 52
    xtext["qperc"] <- "perc_lower" # perc defined by moisture content in lower layer (SAC))")
  }
  if (selectedmodel$qperc == 53) {
    xnumber["qperc"] <- 53
    xtext["qperc"] <- "perc_w2sat" # water from (wilt pt to sat) avail for percolation)")
  }
  #---------------------------------------------------------------------------
  #(6) evaporation
  if (selectedmodel$esoil == 61) {
    xnumber["esoil"] <- 61
    xtext["esoil"] <- "rootweight" # root weighting)")
  }
  if (selectedmodel$esoil == 62) {
    xnumber["esoil"] <- 62
    xtext["esoil"] <- "sequential" # evaporation model)")
  }
  #---------------------------------------------------------------------------
  #(7) interflow
  if (selectedmodel$qintf == 71) {
    xnumber["qintf"] <- 71
    xtext["qintf"] <- "intflwnone" # no interflow)")
  }
  if (selectedmodel$qintf == 72) {
    xnumber["qintf"] <- 72
    xtext["qintf"] <- "intflwsome" # interflow)")
  }
  #---------------------------------------------------------------------------
  #(8) time delay in runoff
  if (selectedmodel$q_tdh == 81) {
    xnumber["q_tdh"] <- 81
    xtext["q_tdh"] <- "no_routing" # no routing)")
  }
  if (selectedmodel$q_tdh == 82) {
    xnumber["q_tdh"] <- 82
    xtext["q_tdh"] <- "rout_gamma" # use a Gamma distribution with shape parameter = 2.5)")
  }
  #---------------------------------------------------------------------------

  model <- data.frame(matrix(xnumber,ncol=8,nrow=1))
  names(model) <- names(xnumber)
  rm(selectedmodel,modlist)

  # Parameters info ############################################################
  parameters <- data.frame(matrix(FALSE,ncol=24,nrow=1))
  names(parameters) <- c("rferr_add","rferr_mlt","maxwatr_1","maxwatr_2",
                         "fracten","frchzne","fprimqb","rtfrac1","percrte",
                         "percexp","sacpmlt","sacpexp","percfrac","iflwrte",
                         "baserte","qb_powr","qb_prms","qbrate_2a",
                         "qbrate_2b","sareamax","axv_bexp","loglamb",
                         "tishape","timedelay")

  # (1) rainfall errors
  if(model$rferr == 11) parameters$rferr_add <- TRUE # additive_e
  if(model$rferr == 12) parameters$rferr_mlt <- TRUE # multiplc_e

  # (2) upper-layer architecture
  parameters$maxwatr_1 <- TRUE # maximum total storage in layer1 (mm)
  parameters$fracten   <- TRUE # frac total storage as tension storage (-)
  # even with a single state, tension and free storage should be defined!
  # if(model$arch1 == 21) {} (onestate_1, no other parameters needed)
  # if(model$arch1 == 22) {} (tension1_1, no other parameters needed)
  if(model$arch1 == 23) {
    # tension2_1 = tension storage sub-divided into recharge and excess
    parameters$frchzne <- TRUE # PRMS: frac tension storage in recharge zone (-)
  }

  # (3) lower-layer architecture / baseflow
  parameters$maxwatr_2 <- TRUE # maximum total storage in layer2 (mm)
  parameters$loglamb   <- TRUE # mean value of the log-transformed topographic index (m)
  parameters$tishape   <- TRUE # shape parameter for the topo index Gamma distribution (-)
  parameters$qb_powr   <- TRUE # baseflow exponent (-)
  # fixedsiz_2 power-law relation, no parameters needed for the topo index distribution
  if(model$arch2 == 31) {
    parameters$baserte   <- TRUE
  }
  # tens2pll_2 (tension reservoir plus two parallel tanks)
  if(model$arch2 == 32) {
    parameters$percfrac  <- TRUE  # fraction of percolation to tension storage (-)
    parameters$fprimqb   <- TRUE  # SAC: fraction of baseflow in primary resvr (-)
    parameters$qbrate_2a <- TRUE  # baseflow depletion rate for primary resvr (day-1)
    parameters$qbrate_2b <- TRUE  # baseflow depletion rate for secondary resvr (day-1)
  }
  # unlimfrc_2 (baseflow resvr of unlimited size (0-huge), frac rate)
  if(model$arch2 == 33) {
    parameters$qb_prms   <- TRUE  # baseflow depletion rate (day-1)
  }
  # unlimpow_2 (topmodel option = power-law transmissivity profile)
  if(model$arch2 == 34) {
    parameters$baserte   <- TRUE  # baseflow rate (mm day-1)
  }

  # (4) surface runoff
  # arno_x_vic = arno/xzang/vic parameterization (upper zone control)
  if(model$qsurf == 41) parameters$axv_bexp <- TRUE
  # prms_varnt = prms variant (fraction of upper tension storage)
  if(model$qsurf == 42) parameters$sareamax <- TRUE
  # tmdl_param = topmodel parameterization
  # if(model$qsurf == 43) {}
  # need the topographic index if we don't have it for baseflow
  # need the topmodel power if we don't have it for baseflow

  # (5) percolation
  # perc_f2sat, perc_w2sat = standard equation k(theta)**c
  if(model$qperc == 51||model$qperc == 53) {
    parameters$percrte   <- TRUE             # percolation rate (mm day-1)
    parameters$percexp   <- TRUE             # percolation exponent (-)
  }

  # perc_lower = perc defined by moisture content in lower layer (sac)
  if(model$qperc == 52) {
    parameters$sacpmlt   <- TRUE             # multiplier in the SAC model for dry lower layer (-)
    parameters$sacpexp   <- TRUE             # exponent in the SAC model for dry lower layer (-)
  }

  # (6) evaporation
  if(model$esoil == 61) {
    parameters$rtfrac1 <- TRUE   # fraction of roots in the upper layer (-)
  }

  # (7) interflow
  if(model$qintf == 72) {
    parameters$iflwrte <- TRUE   # interflow rate (mm day-1)
  }

  # (8) routing
  if(model$q_tdh == 82) {
    parameters$timedelay <- TRUE   # timedelay (days)
  }

  if (number==TRUE) {
    return(cbind(model,parameters))
  }else{
    model <- data.frame(matrix(xtext,ncol=8,nrow=1))
    names(model) <- names(xtext)
    return(cbind(model,parameters))
  }

}