MkNudgingParams: Create a parameter file for nudging.

Description Usage Arguments See Also Examples

View source: R/mk_nudging_params.R

Description

Create a parameter file for nudging.

Usage

1
2
MkNudgingParams(gageId, R, G, tau, qThresh = NULL, expCoeff = NULL,
  outFile, overwrite = FALSE, rmBlankGages = TRUE)

Arguments

gageId

Character vector of gage identifiers also used in the timeslice files.

R

Numeric vector same length as gageId which describes the radius of influence at each gage.

G

Numeric vector same length as gageId which describes the nudging amplitude at each gage.

tau

Numeric vector same length as gageId which describes the size of the temporal half-window in minutes.

qThresh

Numeric [length(gageId), 12, nThresh] threshhold of flow for acf selection.

expCoeff

Numeric [length(gageId), 12, nThresh+1] actually the denominator in exp(-y/b).

outFile

Character path/file to the desired output file

overwrite

Logical, overwrite outFile if it already exists?

rmBlankGages

Take out gages where the name is blank?

See Also

Other nudging: AddRouteLinkGage, ChanObsToTimeSlice, EditFrxstPts

Examples

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
## Not run: 
  ## Once and future CONUS example snippett
  gageParams <- read.csv('~/ncar/WRF_Hydro/DOMAIN_library/CONUS/nhdRtIntersect.csv',
                         colClasses = 'character' )
                         
  ## Boulder creek domain PMO example
  gageParams <- data.frame( gageId = paste0('g',formatC(1:403,width=3,flag='0')), stringsAsFactors=FALSE)
  gageParams$R=0
  gageParams$G=1
  gageParams$tau=20
  MkNudgingParams(gageId=gageParams$gageId, R=gageParams$R, 
                  G=gageParams$G, tau=gageParams$tau, 
                  outFile='~/WRF_Hydro/Col_Bldr_Creek/PMO/nudgingParams.PMOallGages.nc', 
                  overwrite=TRUE)
# FRNG example
## The existing params file
if(FALSE) {
devtools::load_all()
## existing parameter file to change/extend
paramPath <- '~/WRF_Hydro/FRNG_NHD/RUN/prstTestFeb2016/DOMAIN/'
frnParams <- paste0(paramPath,'nudgingParams.rwValid5.nc')
gageParamId <- ncdump(frnParams,'stationId',q=TRUE)
gageParamR <- ncdump(frnParams,'R',q=TRUE)
gageParamG <- ncdump(frnParams,'G',q=TRUE)
gageParamTau <- ncdump(frnParams,'tau',q=TRUE)
nGages=length(gageParamId)

## the existing parameter file had blanks, remove them.
options(warn=1)
MkNudgingParams(gageId=gageParamId, R=gageParamR,
G=gageParamG, tau=gageParamTau,
outFile=paste0(paramPath,'nudgingParams.rwValid5.rmBlanks.nc'),
overwrite=TRUE, rmBlankGages=TRUE)


## Uniform tiny coefficient, simulate not having these parameters.
nGages <- length(gageParamId)
gageParamQThresh1 <- array(rep(c(1000000),each=nGages*12),dim=c(nGages,12,1))
gageExpCoeff1 <- array(rep(c(1e-38),each=nGages*12),dim=c(nGages,12,2))
print(
MkNudgingParams(gageId=gageParamId, R=gageParamR,
G=gageParamG, tau=gageParamTau,
qThresh=gageParamQThresh1,
expCoeff=gageExpCoeff1,
outFile=paste0(paramPath,'nudgingParams.rwValid5.rmBlanksPrstTinyExp.nc'),
overwrite=TRUE, rmBlankGages=TRUE)
)

## In this example the exponent only depends on threshold, not location nor month.
## The first threshold is negative, so only coefficients for the second threshold index should be
## applied and in this case will be tiny, so again have no effect.
nGages <- length(whGages <- which(trimws(gageParamId) != '' ))
#nGages <- length(gageParamId)
gageParamQThresh1 <- array(c(-100),dim=c(nGages,12,1))
## *** THIS IS THE CORRECT WAY OF FILLING THE ARRAY : KISS ***
gageExpCoeff1 <- array(c(1e-38,120),dim=c(nGages,12,2))
print(
MkNudgingParams(gageId=gageParamId[whGages], R=gageParamR[whGages],
G=gageParamG[whGages], tau=gageParamTau[whGages],
qThresh=gageParamQThresh1,
expCoeff=gageExpCoeff1,
outFile=paste0(paramPath,'nudgingParams.rwValid5.rmBlanksPrst1ThreshMed.nc'),
overwrite=TRUE, rmBlankGages=TRUE)
)
## CONUS
## In this example the exponent only depends on threshold, not location nor month.
## The first threshold is negative, so only coefficients for the second threshold index should be
## applied and in this case will be tiny, so again have no effect.
paramPath <- '~/WRF_Hydro/TESTING/TEST_FILES/CONUS/2015-12-04_20:08:06.b8e1e01c4cc2/STD/NUDGING/'
frnParams <- paste0(paramPath,'nudgingParams.nc')
gageParamId <- ncdump(frnParams,'stationId',q=TRUE)
gageParamR <- ncdump(frnParams,'R',q=TRUE)
gageParamG <- ncdump(frnParams,'G',q=TRUE)
gageParamTau <- ncdump(frnParams,'tau',q=TRUE)
nGages=length(gageParamId)

rmGages <- c("       05059500", "       05054000", "       05082500", "       10108400",
"       09183600", "       08387550", "       08158930", "       06470500",
"       06768000", "       05427943", "       05551675", "       03298135",
"       03352953", "       07083200", "       07358284", "       02458450",
"       02310678", "       02302010", "       02237700", "       02299472",
"     0212467595", "     0214676115", "       02011460", "       01446776",
"       12306500", "       11119750", "       10257549", "       11122010",
"       11276600", formatC('', width=15) )

nGages <- length(whGages <- which(!(gageParamId %in% rmGages)))
#nGages <- length(gageParamId)
gageParamQThresh1 <- array(c(-100),dim=c(nGages,12,1))

## *** THIS IS THE CORRECT WAY OF FILLING THE ARRAY : KISS ***
gageExpCoeff1 <- array(c(1e-38,120),dim=c(nGages,12,2))
print(
MkNudgingParams(gageId=gageParamId[whGages], R=gageParamR[whGages],
G=gageParamG[whGages], tau=gageParamTau[whGages],
qThresh=gageParamQThresh1,
expCoeff=gageExpCoeff1,
outFile=paste0(paramPath,'nudgingParams.conusPstActive.nc'),
overwrite=TRUE, rmBlankGages=TRUE)
)


#array(rep(c(.5,.8),each=4*12),dim=c(4,12,2))
}

## the existing parameter file had blanks, remove them.
options(warn=1)
MkNudgingParams(gageId=gageParamId, R=gageParamR, 
                G=gageParamG, tau=gageParamTau, 
                outFile=paste0(paramPath,'nudgingParams.rwValid5.rmBlanks.nc'),
                overwrite=TRUE, rmBlankGages=TRUE)


## In this example the exponent only depends on threshold, not location nor month.
gageParamqThresh1 = array(rep(c(.5,.8),each=4*12),dim=c(4,12,2))

MkNudgingParams(gageId=gageParams$gageId, R=gageParams$R, 
                G=gageParams$G, tau=gageParams$tau, 
                outFile=paste0(paramPath,'nudgingParams.rwValid5.persistence.nc'),
                overwrite=TRUE, rmBlankGages=TRUE)

## End(Not run)  #dontrun

NCAR/rwrfhydro documentation built on Feb. 28, 2021, 12:47 p.m.