diff --git a/DESCRIPTION b/DESCRIPTION index 929a7dc15741639089a4d2b0121505b96ca77880..00073abebce491b5cc9f7a4699d7656e48ad76fe 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.2.3.4 +Version: 1.2.4.0 Date: 2019-02-19 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), diff --git a/NEWS.rmd b/NEWS.rmd index 223d6e1c21c6174f6faaf5b3add5d9b5ec5d2964..0ae1d69c14127d9f6fd3dc59f9361d86fb827a69 100644 --- a/NEWS.rmd +++ b/NEWS.rmd @@ -13,7 +13,7 @@ output: -### 1.2.3.4 Release Notes (2019-02-19) +### 1.2.4.0 Release Notes (2019-02-21) diff --git a/R/RunModel_CemaNeigeGR5J.R b/R/RunModel_CemaNeigeGR5J.R index 5457034a5448479d8497f05a45d59bce1be39e2d..fc58b9c9a32668f33d92ebd0350f2647a5b830a2 100644 --- a/R/RunModel_CemaNeigeGR5J.R +++ b/R/RunModel_CemaNeigeGR5J.R @@ -1,9 +1,17 @@ -RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ - - NParam <- 7; - FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt", "Temp"); +RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param, IsHyst = FALSE){ + + + ## Arguments_check + if (!is.logical(IsHyst) | length(IsHyst) != 1L) { + stop("'IsHyst' must be a 'logical' of length 1") + return(NULL) + } + + NParam <- ifelse(IsHyst, 9L, 7L) + NStates <- 4L + FortranOutputsCemaNeige <- c("Pliq","Psol","SnowPack","ThermalState","Gratio","PotMelt","Melt","PliqAndMelt", "Temp", "Gthreshold", "Glocalmax"); FortranOutputsMod <- c("PotEvap", "Precip", "Prod", "Pn", "Ps", "AE", "Perc", "PR", "Q9", "Q1", "Rout", "Exch", - "AExch1", "AExch2", "AExch", "QR", "QD", "Qsim"); + "AExch1", "AExch2", "AExch", "QR", "QD", "Qsim"); ##Arguments_check if(inherits(InputsModel,"InputsModel")==FALSE){ stop("InputsModel must be of class 'InputsModel' \n"); return(NULL); } @@ -37,11 +45,11 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp,RunOptions$IndPeriod_Run); LInputSeries <- as.integer(length(IndPeriod1)) IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries; - ParamCemaNeige <- Param[(length(Param)-1):length(Param)]; - NParamMod <- as.integer(length(Param)-2); + ParamCemaNeige <- Param[(length(Param)-1-2*as.integer(IsHyst)):length(Param)]; + NParamMod <- as.integer(length(Param)-(2+2*as.integer(IsHyst))); ParamMod <- Param[1:NParamMod]; NLayers <- length(InputsModel$LayerPrecip); - NStatesMod <- as.integer(length(RunOptions$IniStates)-2*NLayers); + NStatesMod <- as.integer(length(RunOptions$IniStates)-NStates*NLayers); ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim; ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim; @@ -52,6 +60,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ } else { IndOutputsCemaNeige <- which(FortranOutputsCemaNeige %in% RunOptions$Outputs_Sim); } CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- "CemaNeigeLayers"; + ##Call_DLL_CemaNeige_________________________ for(iLayer in 1:NLayers){ StateStartCemaNeige <- RunOptions$IniStates[(7+20+40) + c(iLayer, iLayer+NLayers)] @@ -62,15 +71,16 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ InputsFracSolidPrecip=InputsModel$LayerFracSolidPrecip[[iLayer]][IndPeriod1], ### input series of fraction of solid precipitation [0-1] InputsTemp=InputsModel$LayerTemp[[iLayer]][IndPeriod1], ### input series of air mean temperature [degC] MeanAnSolidPrecip=RunOptions$MeanAnSolidPrecip[iLayer], ### value of annual mean solid precip [mm/y] - NParam=as.integer(2), ### number of model parameter = 2 - Param=ParamCemaNeige, ### parameter set - NStates=as.integer(2), ### number of state variables used for model initialising = 2 + NParam=as.integer(NParam), ### number of model parameter = 2 + Param=as.double(ParamCemaNeige), ### parameter set + NStates=as.integer(NStates), ### number of state variables used for model initialising = 2 StateStart=StateStartCemaNeige, ### state variables used when the model run starts + IsHyst = as.integer(IsHyst), ### use of hysteresis NOutputs=as.integer(length(IndOutputsCemaNeige)), ### number of output series IndOutputs=IndOutputsCemaNeige, ### indices of output series ##outputs Outputs=matrix(as.double(-999.999),nrow=LInputSeries,ncol=length(IndOutputsCemaNeige)), ### output series [mm] - StateEnd=rep(as.double(-999.999),as.integer(2)) ### state variables at the end of the model run (reservoir levels [mm] and HU) + StateEnd=rep(as.double(-999.999),as.integer(NStates)) ### state variables at the end of the model run (reservoir levels [mm] and HU) ) RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; @@ -84,7 +94,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ if(ExportStateEnd){ CemaNeigeStateEnd <- c(CemaNeigeStateEnd,RESULTS$StateEnd); } rm(RESULTS); } ###ENDFOR_iLayer - names(CemaNeigeLayers) <- paste("Layer",formatC(1:NLayers,width=2,flag="0"),sep=""); + names(CemaNeigeLayers) <- sprintf("Layer%02i", seq_len(NLayers)) } ###ENDIF_RunSnowModule if(inherits(RunOptions,"CemaNeige")==FALSE){ CemaNeigeLayers <- list(); CemaNeigeStateEnd <- NULL; NameCemaNeigeLayers <- NULL; @@ -121,11 +131,14 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ RESULTS$Outputs[ round(RESULTS$Outputs ,3)==(-999.999)] <- NA; RESULTS$StateEnd[round(RESULTS$StateEnd,3)==(-999.999)] <- NA; if (ExportStateEnd) { + idNStates <- seq_len(NStates*NLayers) %% NStates RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_CemaNeigeGR5J, InputsModel = InputsModel, ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL, UH1 = NULL, UH2 = RESULTS$StateEnd[(1:40)+(7+20)], - GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(2*NLayers)[seq_len(2*NLayers) %% 2 == 1]], - eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(2*NLayers)[seq_len(2*NLayers) %% 2 == 0]], + GCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 3]], + eTGCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 2]], + GthrCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 1]], + GlocmaxCemaNeigeLayers = CemaNeigeStateEnd[seq_len(NStates*NLayers)[idNStates == 0]], verbose = FALSE) } @@ -160,6 +173,9 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ ##End rm(RESULTS); class(OutputsModel) <- c("OutputsModel","daily","GR","CemaNeige"); + if(IsHyst) { + class(OutputsModel) <- c(class(OutputsModel), "hysteresis") + } return(OutputsModel); }