UtilsCalibOptions.R

.FunTransfo <- function(FeatFUN_MOD, FUN_SD) {

  IsHyst <- FeatFUN_MOD$IsHyst
  IsSD <- FeatFUN_MOD$IsSD

  ## set FUN_GR
  if (FeatFUN_MOD$NameFunMod == "Cemaneige") {
    if (IsHyst) {
      FUN_GR <- TransfoParam_CemaNeigeHyst
    } else {
      FUN_GR <- TransfoParam_CemaNeige
    }
  } else {
    # fatal error if the TransfoParam function does not exist
    FUN_GR <- match.fun(sprintf("TransfoParam_%s", FeatFUN_MOD$CodeModHydro))
  }

  ## set FUN_SNOW
  if ("CemaNeige" %in% FeatFUN_MOD$Class) {
    if (IsHyst) {
      FUN_SNOW <- TransfoParam_CemaNeigeHyst
    } else {
      FUN_SNOW <- TransfoParam_CemaNeige
    }
  }

  ## set FUN_ROUT

  if (IsSD) {
    if (identical(RunModel_Lag, FUN_SD)){
      FUN_ROUT <- TransfoParam_Lag
    } else if (identical(RunModel_LLR, FUN_SD)){
      FUN_ROUT <- TransfoParam_LLR
    }
  }

    ## set FUN_TRANSFO
  if (! "CemaNeige" %in% FeatFUN_MOD$Class) {
    if (!IsSD) {
      FUN_TRANSFO <- FUN_GR
    } else {
      FUN_TRANSFO <- function(ParamIn, Direction) {
        Bool <- is.matrix(ParamIn)
        if (!Bool) {
          ParamIn <- rbind(ParamIn)
        }

        ParamOut <- NA * ParamIn
        NParam   <- ncol(ParamIn)
        ParamOut[, (FeatFUN_MOD$NParamSD + 1):NParam] <- FUN_GR(ParamIn[, (FeatFUN_MOD$NParamSD + 1):NParam], Direction)

        if (identical(RunModel_Lag, FUN_SD)){
          ParamOut[, 1       ] <- FUN_ROUT(as.matrix(ParamIn[, 1]), Direction)
        } else if (identical(RunModel_LLR, FUN_SD)){
          ParamOut[, 1:FeatFUN_MOD$NParamSD] <- FUN_ROUT(ParamIn[, 1:FeatFUN_MOD$NParamSD], Direction)
        }

        if (!Bool) {
          ParamOut <- ParamOut[1, ]
        }
        return(ParamOut)
      }
    }
  } else {
    if (IsHyst & !IsSD) {
      FUN_TRANSFO <- function(ParamIn, Direction) {
        Bool <- is.matrix(ParamIn)
        if (!Bool) {
          ParamIn <- rbind(ParamIn)
        }