Commit dd5301e2 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.3.2.19 CLEAN: uppercase and lowercase corrected for Fortran subroutines original declaration

Showing with 30 additions and 30 deletions
+30 -30
Package: airGR Package: airGR
Type: Package Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.3.2.18 Version: 1.3.2.19
Date: 2019-06-19 Date: 2019-06-19
Authors@R: c( Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
...@@ -14,7 +14,7 @@ output: ...@@ -14,7 +14,7 @@ output:
### 1.3.2.18 Release Notes (2019-06-19) ### 1.3.2.19 Release Notes (2019-06-19)
#### New features #### New features
......
...@@ -79,7 +79,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) { ...@@ -79,7 +79,7 @@ RunModel_CemaNeige <- function(InputsModel, RunOptions, Param) {
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*time_mult + 40*time_mult) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*time_mult + 40*time_mult) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige", PACKAGE = "airGR", RESULTS <- .Fortran("frun_cemaneige", PACKAGE = "airGR",
## inputs ## inputs
LInputs = as.integer(length(IndPeriod1)), ### length of input and output series LInputs = as.integer(length(IndPeriod1)), ### length of input and output series
InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/time step] InputsPrecip = InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/time step]
......
...@@ -64,7 +64,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){ ...@@ -64,7 +64,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20*24 + 40*24) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR", RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h] InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/h]
...@@ -113,7 +113,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){ ...@@ -113,7 +113,7 @@ RunModel_CemaNeigeGR4H <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR4H",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr4h",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/h] InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/h]
......
...@@ -64,7 +64,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){ ...@@ -64,7 +64,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR", RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
...@@ -113,7 +113,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){ ...@@ -113,7 +113,7 @@ RunModel_CemaNeigeGR4J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR4J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr4j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
......
...@@ -62,7 +62,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ ...@@ -62,7 +62,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR", RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
...@@ -111,7 +111,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){ ...@@ -111,7 +111,7 @@ RunModel_CemaNeigeGR5J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR5J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr5j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
......
...@@ -66,7 +66,7 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){ ...@@ -66,7 +66,7 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){
} else { } else {
StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)] StateStartCemaNeige <- RunOptions$IniStates[(7 + 20 + 40) + c(iLayer, iLayer+NLayers, iLayer+2*NLayers, iLayer+3*NLayers)]
} }
RESULTS <- .Fortran("frun_CemaNeige",PACKAGE="airGR", RESULTS <- .Fortran("frun_cemaneige",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$LayerPrecip[[iLayer]][IndPeriod1], ### input series of total precipitation [mm/d]
...@@ -116,7 +116,7 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){ ...@@ -116,7 +116,7 @@ RunModel_CemaNeigeGR6J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR6J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr6j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d] InputsPrecip=CatchMeltAndPliq, ### input series of total precipitation [mm/d]
......
...@@ -42,7 +42,7 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param){ ...@@ -42,7 +42,7 @@ RunModel_GR2M <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR2M",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr2M",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/month] InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/month]
......
...@@ -47,7 +47,7 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param){ ...@@ -47,7 +47,7 @@ RunModel_GR4H <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR4H",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr4h",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h] InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
......
...@@ -46,7 +46,7 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param){ ...@@ -46,7 +46,7 @@ RunModel_GR4J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR4J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr4j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
......
...@@ -47,7 +47,7 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param){ ...@@ -47,7 +47,7 @@ RunModel_GR5J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR5J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr5j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
......
...@@ -52,7 +52,7 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param){ ...@@ -52,7 +52,7 @@ RunModel_GR6J <- function(InputsModel,RunOptions,Param){
} }
##Call_fortan ##Call_fortan
RESULTS <- .Fortran("frun_GR6J",PACKAGE="airGR", RESULTS <- .Fortran("frun_gr6j",PACKAGE="airGR",
##inputs ##inputs
LInputs=LInputSeries, ### length of input and output series LInputs=LInputSeries, ### length of input and output series
InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d] InputsPrecip=InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/d]
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
SUBROUTINE frun_CEMANEIGE( SUBROUTINE frun_cemaneige(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/time step] & InputsPrecip , ! [double] input series of total precipitation [mm/time step]
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
& StateEnd ) ! [double] state variables at the end of the model run & StateEnd ) ! [double] state variables at the end of the model run
!DEC$ ATTRIBUTES DLLEXPORT :: frun_CemaNeige !DEC$ ATTRIBUTES DLLEXPORT :: frun_cemaneige
Implicit None Implicit None
......
SUBROUTINE frun_GR1A( SUBROUTINE frun_gr1a(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/year] & InputsPrecip , ! [double] input series of total precipitation [mm/year]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (none here) & StateEnd ) ! [double] state variables at the end of the model run (none here)
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR1A !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr1a
Implicit None Implicit None
......
SUBROUTINE frun_GR2M( SUBROUTINE frun_gr2m(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/month] & InputsPrecip , ! [double] input series of total precipitation [mm/month]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (store levels [mm]) & StateEnd ) ! [double] state variables at the end of the model run (store levels [mm])
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR2M !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr2m
Implicit None Implicit None
......
SUBROUTINE frun_GR4H( SUBROUTINE frun_gr4h(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/hour] & InputsPrecip , ! [double] input series of total precipitation [mm/hour]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm]) & StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm])
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR4H !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr4h
Implicit None Implicit None
......
SUBROUTINE frun_GR4J( SUBROUTINE frun_gr4j(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/day] & InputsPrecip , ! [double] input series of total precipitation [mm/day]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm]) & StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm])
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR4J !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr4j
Implicit None Implicit None
......
SUBROUTINE frun_GR5J( SUBROUTINE frun_gr5j(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/day] & InputsPrecip , ! [double] input series of total precipitation [mm/day]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm]) & StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm])
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR5J !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr5j
Implicit None Implicit None
......
SUBROUTINE frun_GR6J( SUBROUTINE frun_gr6j(
!inputs !inputs
& LInputs , ! [integer] length of input and output series & LInputs , ! [integer] length of input and output series
& InputsPrecip , ! [double] input series of total precipitation [mm/day] & InputsPrecip , ! [double] input series of total precipitation [mm/day]
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
& StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm]) & StateEnd ) ! [double] state variables at the end of the model run (store levels [mm] and Unit Hydrograph (UH) storages [mm])
!DEC$ ATTRIBUTES DLLEXPORT :: frun_GR6J !DEC$ ATTRIBUTES DLLEXPORT :: frun_gr6j
Implicit None Implicit None
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment