Forked from HYCAR-Hydro / airGR
Source project has a limited visibility.
CreateCalibOptions.R 10.56 KiB
CreateCalibOptions <-
  function(FUN_MOD,
           FUN_CALIB = Calibration_Michel,
           FUN_TRANSFO = NULL,
           FixedParam = NULL,
           SearchRanges = NULL,
           StartParamList = NULL,
           StartParamDistrib = NULL) {
    ObjectClass <- NULL
    ##check_FUN_MOD
    BOOL <- FALSE
    if (identical(FUN_MOD, RunModel_GR4H)) {
      ObjectClass <- c(ObjectClass, "GR4H")
      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_CemaNeigeGR4J)) {
      ObjectClass <- c(ObjectClass, "CemaNeigeGR4J")
      BOOL <- TRUE
    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 (!BOOL) {
      stop("incorrect FUN_MOD for use in CreateCalibOptions \n")
      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 \n")
      return(NULL)
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
} ##check_FUN_TRANSFO if (is.null(FUN_TRANSFO)) { ##_set_FUN1 if (identical(FUN_MOD, RunModel_GR4H)) { FUN1 <- TransfoParam_GR4H } 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)) { FUN1 <- TransfoParam_CemaNeige } if (is.null(FUN1)) { stop("FUN1 was not found \n") return(NULL) } ##_set_FUN2 FUN2 <- TransfoParam_CemaNeige ##_set_FUN_TRANSFO if (sum(ObjectClass %in% c("GR4H", "GR4J", "GR5J", "GR6J", "GR2M", "GR1A", "CemaNeige")) > 0) { FUN_TRANSFO <- FUN1 } else { FUN_TRANSFO <- function(ParamIn, Direction) { Bool <- is.matrix(ParamIn) if (Bool == FALSE) { ParamIn <- rbind(ParamIn) } ParamOut <- NA * ParamIn NParam <- ncol(ParamIn) if (NParam <= 3) { ParamOut[, 1:(NParam - 2)] <- FUN1(cbind(ParamIn[, 1:(NParam - 2)]), Direction) } else { ParamOut[, 1:(NParam - 2)] <- FUN1(ParamIn[, 1:(NParam - 2)], Direction) } ParamOut[, (NParam - 1):NParam] <- FUN2(ParamIn[, (NParam - 1):NParam], Direction) if (Bool == FALSE) { ParamOut <- ParamOut[1, ] } return(ParamOut) } } } if (is.null(FUN_TRANSFO)) { stop("FUN_TRANSFO was not found \n") return(NULL) } ##NParam if ("GR4H" %in% ObjectClass) { NParam <- 4 }