CreateCalibOptions.R 15.68 KiB
CreateCalibOptions <- function(FUN_MOD,
                               FUN_CALIB = Calibration_Michel,
                               FUN_TRANSFO = NULL,
                               IsHyst = FALSE,
                               IsSD = FALSE,
                               FixedParam = NULL,
                               SearchRanges = NULL,
                               StartParamList = NULL,
                               StartParamDistrib = NULL) {
  ObjectClass <- NULL
  FUN_MOD     <- match.fun(FUN_MOD)
  FUN_CALIB   <- match.fun(FUN_CALIB)
  if(!is.null(FUN_TRANSFO)) {
    FUN_TRANSFO <- match.fun(FUN_TRANSFO)
  if (!is.logical(IsHyst) | length(IsHyst) != 1L) {
    stop("'IsHyst' must be a logical of length 1")
  if (!is.logical(IsSD) | length(IsSD) != 1L) {
    stop("'IsSD' must be a logical of length 1")
  ##check_FUN_MOD
  BOOL <- FALSE
  if (identical(FUN_MOD, RunModel_GR4H)) {
    ObjectClass <- c(ObjectClass, "GR4H")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR5H)) {
    ObjectClass <- c(ObjectClass, "GR5H")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR4J)) {
    ObjectClass <- c(ObjectClass, "GR4J")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR5J)) {
    ObjectClass <- c(ObjectClass, "GR5J")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR6J)) {
    ObjectClass <- c(ObjectClass, "GR6J")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR2M)) {
    ObjectClass <- c(ObjectClass, "GR2M")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_GR1A)) {
    ObjectClass <- c(ObjectClass, "GR1A")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_CemaNeige)) {
    ObjectClass <- c(ObjectClass, "CemaNeige")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4H)) {
    ObjectClass <- c(ObjectClass, "CemaNeigeGR4H")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_CemaNeigeGR5H)) {
    ObjectClass <- c(ObjectClass, "CemaNeigeGR5H")
    BOOL <- TRUE
  if (identical(FUN_MOD, RunModel_CemaNeigeGR4J)) {
    ObjectClass <- c(ObjectClass, "CemaNeigeGR4J")
    BOOL <- TRUE
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
if (identical(FUN_MOD, RunModel_CemaNeigeGR5J)) { ObjectClass <- c(ObjectClass, "CemaNeigeGR5J") BOOL <- TRUE } if (identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { ObjectClass <- c(ObjectClass, "CemaNeigeGR6J") BOOL <- TRUE } if (IsHyst) { ObjectClass <- c(ObjectClass, "hysteresis") } if (IsSD) { ObjectClass <- c(ObjectClass, "SD") } if (!BOOL) { stop("incorrect 'FUN_MOD' for use in 'CreateCalibOptions'") return(NULL) } ##check_FUN_CALIB BOOL <- FALSE if (identical(FUN_CALIB, Calibration_Michel)) { ObjectClass <- c(ObjectClass, "HBAN") BOOL <- TRUE } if (!BOOL) { stop("incorrect 'FUN_CALIB' for use in 'CreateCalibOptions'") return(NULL) } ##check_FUN_TRANSFO if (is.null(FUN_TRANSFO)) { ##_set_FUN1 if (identical(FUN_MOD, RunModel_GR4H) | identical(FUN_MOD, RunModel_CemaNeigeGR4H)) { FUN1 <- TransfoParam_GR4H } if (identical(FUN_MOD, RunModel_GR5H) | identical(FUN_MOD, RunModel_CemaNeigeGR5H)) { FUN1 <- TransfoParam_GR5H } if (identical(FUN_MOD, RunModel_GR4J) | identical(FUN_MOD, RunModel_CemaNeigeGR4J)) { FUN1 <- TransfoParam_GR4J } if (identical(FUN_MOD, RunModel_GR5J) | identical(FUN_MOD, RunModel_CemaNeigeGR5J)) { FUN1 <- TransfoParam_GR5J } if (identical(FUN_MOD, RunModel_GR6J) | identical(FUN_MOD, RunModel_CemaNeigeGR6J)) { FUN1 <- TransfoParam_GR6J } if (identical(FUN_MOD, RunModel_GR2M)) { FUN1 <- TransfoParam_GR2M } if (identical(FUN_MOD, RunModel_GR1A)) { FUN1 <- TransfoParam_GR1A } if (identical(FUN_MOD, RunModel_CemaNeige)) { if (IsHyst) { FUN1 <- TransfoParam_CemaNeigeHyst } else { FUN1 <- TransfoParam_CemaNeige } } if (is.null(FUN1)) { stop("'FUN1' was not found")