Skip to content
Snippets Groups Projects
Commit 2bd6b7bd authored by wactbprot's avatar wactbprot
Browse files

basteleinen mit H2

parent fc0f10a0
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
cal/ce3.calDeltaVDeltat.R
+ 24
− 16
View file @ 2bd6b7bd
ce3.calDeltaVDeltat <- function(ccc){
msg <- "calculated by ce3.calDeltaVDeltat"
tUnit <- "s"
vUnit <- "l"
a <- abbrevList(ccc)
......@@ -12,6 +11,8 @@ ce3.calDeltaVDeltat <- function(ccc){
if(a$cmscok == "opK1" |a$cmscok == "opK2"|a$cmscok == "opK3"){
L <- NULL
sdL <- NULL
sddV <- NULL
sddt <- NULL
lL <- NULL
gamma <- NULL
Mp <- NULL
......@@ -43,6 +44,7 @@ ce3.calDeltaVDeltat <- function(ccc){
noOfSZ <- length(lwstart)
for(i in lwstart){
j <- j+1
stype <- paste("slope_x_",i, sep="")
mttype <- paste("mean_t_", i, sep="")
......@@ -74,17 +76,17 @@ ce3.calDeltaVDeltat <- function(ccc){
ci <- mp - slope * mt
t0 <- (mean(mp, na.rm =TRUE) - ci) / slope
out <- which(correlCoef < 0.98)
out <- which(correlCoef < 0.95)
if(length(out) > 0){
t0[out] <- NA
msg <- paste(msg
, "exclude saw tooth:"
, toString(out)
, "because of bad (<0.98) correlation")
, "because of bad (<0.95) correlation")
}
# deltat <- diff(t0) * tconv
## deltat <- diff(t0) * tconv
deltat <- c((t0[5] - t0[4])/1,
(t0[5] - t0[3])/2,
(t0[5] - t0[2])/3,
......@@ -95,6 +97,7 @@ ce3.calDeltaVDeltat <- function(ccc){
(t0[3] - t0[2])/1,
(t0[3] - t0[1])/2,
(t0[2] - t0[1])/1) * tconv
## ------------------------------------##
## Güte des SZ: Steigung mp ~ mt möglichst klein
......@@ -118,13 +121,18 @@ ce3.calDeltaVDeltat <- function(ccc){
i2 <- i1 + 1
A <- (fn.Afit(cf,h[i2]) - fn.Afit(cf,h[i1]))/(h[i2] - h[i1])
deltaV <- A * (h[i2] - h[i1]) * vconv
## Leitwert = dV/dt *(1- m.D/m.SZ)
dVdt <- mean(deltaV) / deltat * (1 - dcorr[j])
dVdt <- mean(deltaV, na.rm =TRUE) / mean(deltat, na.rm =TRUE) * (1 - dcorr[j])
L[j] <- mean(dVdt, na.rm =TRUE)
sdL[j] <- sd(dVdt, na.rm =TRUE)
lL[j] <- length(dVdt)
sddV[j] <- sd(deltaV, na.rm =TRUE)/ mean(deltaV, na.rm =TRUE)
sddt[j] <- sd(deltat, na.rm =TRUE)/ mean(deltat, na.rm =TRUE)
lL[j] <- length(diff(t0))
## ------------------------------------##
}
ccc$Calibration$Analysis$Values$Conductance <-
......@@ -138,13 +146,13 @@ ce3.calDeltaVDeltat <- function(ccc){
setCcl(ccc$Calibration$Analysis$Values$Conductance,
"sd_cnom",
"l/s",
sdL,
sqrt(sddV^2 + sddt^2) * L,
msg)
ccc$Calibration$Analysis$Values$Conductance <-
setCcl(ccc$Calibration$Analysis$Values$Conductance,
"N_cnom",
"l/s",
"1",
lL,
msg)
......
cal/ce3.calMfp.R
+ 6
− 2
View file @ 2bd6b7bd
......@@ -20,6 +20,10 @@ ce3.calMfp <- function(ccc){
M <- getConstVal(a$cc,"molWeight_D2") ## [M] = kg/mol
visc <- getConstVal(a$cc,"visc_D2")
}
if(a$cmsc$Gas =="H2"){
M <- getConstVal(a$cc,"molWeight_H2") ## [M] = kg/mol
visc <- getConstVal(a$cc,"visc_H2")
}
Mr <- M*1000 ## relative Teilchenmasse [Mr]=1
......
cal/ce3.calPcal.R
+ 41
− 43
View file @ 2bd6b7bd
......@@ -15,6 +15,7 @@ ce3.calPcal <- function(ccc){
if(a$cmscg =="N2") M <- getConstVal(a$cc,"molWeight_N2")
if(a$cmscg =="Ar") M <- getConstVal(a$cc,"molWeight_Ar")
if(a$cmscg =="D2") M <- getConstVal(a$cc,"molWeight_D2")
if(a$cmscg =="H2") M <- getConstVal(a$cc,"molWeight_H2")
if(a$cmscok == "opK1" | a$cmscok == "opK2"| a$cmscok == "opK4"){
......@@ -54,9 +55,6 @@ ce3.calPcal <- function(ccc){
pcal <- qpV * mbarls2pam3s/C2 * Pa2mbar
}
## spätestens hier ist klar, dass auf jeden Fall
## bald ein setter geschrieben gehört!
## done!
ccc$Calibration$Analysis$Values$Pressure <-
setCcl(ccc$Calibration$Analysis$Values$Pressure,
"cal",
......
cal/ce3.extrapC.R
+ 10
− 7
View file @ 2bd6b7bd
......@@ -11,7 +11,8 @@ ce3.extrapC <- function(ccc){
if(a$cmscok == "opK1" |a$cmscok == "opK2"|a$cmscok == "opK3"){
## andere Gase kommen noch
if(a$cmscg == "N2" || a$cmscg == "Ar"|| a$cmscg == "D2"){
if(a$cmscg == "N2" || a$cmscg == "Ar"|| a$cmscg == "D2"|| a$cmscg == "H2"){
ilw <- getConductIndex(ccc)
cf <- list()
......@@ -30,8 +31,11 @@ ce3.extrapC <- function(ccc){
cnom <- getConstVal(a$cav, "cnom")
cfm3 <- rep(NA, length(pfe))
dh <- rep(NA, length(pfe))
if(a$cmscg == "H2"){
gas <- "D2" ## 17.4.15 erste Messung mit H2 keine Parameter
}else{
gas <- a$cmscg
}
##'
##' kleiner Leitwert
##'
......@@ -80,12 +84,11 @@ ce3.extrapC <- function(ccc){
cmolecular <- dv2MolCSlope * pfill[ilw$iLwC] + dv2MolCIntercept
cfm3[ilw$iLwC] <- cmolecular
dh[ilw$iLwC] <- cnom[ilw$iLwC]/ cmolecular - 1
print(cmolecular)
print(ilw)
}
} # gas
ccc$Calibration$Analysis$Values$Conductance <-
setCcl(ccc$Calibration$Analysis$Values$Conductance,
"cfm3",
......
devel/calYampCe3.R
+ 14
− 11
View file @ 2bd6b7bd
......@@ -10,7 +10,7 @@ library(R4CouchDB,quietly =TRUE)
cdb <- cdbIni()
cdb$DBName <- "vaclab_db" ## DBName
cdb$DBName <- "vaclab_work" ## DBName
infList <- list()
infList$srcPath <- "/usr/local/lib/r4vl"
......@@ -22,25 +22,28 @@ source("load.R")
## devel/tests/calculations from here -----------------
#"1f72ec47286b685511b3cc38f0094533"#"1f72ec47286b685511b3cc38f009ceeb"
# cdb$id <- "171d3f673527b2564691cad26e0235e7"#
# cdb$id <- "626b4724c118b38468fc7a15a36e3e52"
cdb$id <- "7b797897f2572b681bb41c4a7b09766d"
cdb$id <- "67fd5fc5176edcaa157250a3440ecfb5"
## cdb$id <- "171d3f673527b2564691cad26e0235e7"#
## cdb$id <- "626b4724c118b38468fc7a15a36e3e52"
## cdb$id <- "7b797897f2572b681bb41c4a7b09766d"
## cdb$id <- "67fd5fc5176edcaa157250a3440ecfb5"
cdb$id <- "ac36e53c6c34d30886c210a6f608ad31" ## lwc, lw1, lw2
cdb$id <- "ac36e53c6c34d30886c210a6f60819ab"
doc <- cdbGetDoc(cdb)$res
if(TRUE){
if(TRUE){
doc <- refreshAnalysis(cdb,doc)
doc <- refreshResult(cdb,doc)
doc <- ce3.newCalT(doc)
doc <- ce3.newCalPfill(doc)
doc <- ce3.calPfill(doc)
doc <- ce3.calDeltaVDeltat(doc)
doc <- ce3.extrapC(doc)
doc <- ce3.calQ(doc)
doc <- ce3.calMfp(doc)
doc <- ce3.calPcal(doc)
##
doc <- ce3.writePind(doc)
##
......
scripts/analyse_CE3_YAMP.R
+ 5
− 2
View file @ 2bd6b7bd
......@@ -5,7 +5,9 @@ if(length(doc$Calibration) > 0){
doc <- ce3.newCalT(doc)
doc <- ce3.calPfill(doc)
doc <- ce3.calDeltaVDeltat(doc)
doc <- ce3.extrapC(doc)
doc <- ce3.calQ(doc)
doc <- ce3.calMfp(doc)
......@@ -35,7 +37,7 @@ if(length(doc$Calibration) > 0){
doc <- ce3.uncertTch(doc)
doc <- ce3.uncertF(doc)
doc <- ce3.uncertPcal(doc)
#if(FALSE){
## ... customer calibration object (cuco) related
doc <- cuco.uncertDigit(doc)
doc <- cuco.uncertPOffset(doc)
......@@ -54,5 +56,6 @@ if(length(doc$Calibration) > 0){
doc <- dispatchResSum(doc)
#
doc <- ce3.compareCDGs(doc)
#}
if(FALSE){
}
}
scripts/cal_CE3_SZ-PARAM.R
+ 9
− 3
View file @ 2bd6b7bd
......@@ -10,16 +10,22 @@ pcal <- as.numeric(infList$args[2])
a <- abbrevList(doc)
maxIter <- 100
## andere Gase kommen noch
if((a$cmscg == "N2" || a$cmscg == "Ar" || a$cmscg == "D2") & is.numeric(pcal)){
if((a$cmscg == "N2" || a$cmscg == "Ar" || a$cmscg == "D2"|| a$cmscg == "H2") & is.numeric(pcal)){
molLw <- getConstVal(a$cms,"dv2MolCIntercept")
if(a$cmscg == "H2"){
gas <- "D2"
}else{
gas <- a$cmscg
}
cf <- list()
if(pcal < 1e-4){
lw <- "lw1"
}
if(pcal < 9e-7){
#if(pcal < 9e-7){
if(pcal < 1e-5){ ## H2
lw <- "lw0"
}
if(pcal < 1e-10){
......
uncert/getConductIndex.R
+ 13
− 14
View file @ 2bd6b7bd
......@@ -6,36 +6,35 @@ getConductIndex <- function(ccc){
cnom <- getConstVal(a$cav, "cnom")
## --- LwC --- constLw ---
lwCList <- getSubList(a$cms, "useLwC")
iLwC <- which(pfill > as.double(lwCList$From) &
pfill < as.double(lwCList$To) )
pfill < as.double(lwCList$To)
)
## --- Lw2 --- kl. Lw ---
lw2List <- getSubList(a$cms, "useLw2")
iLw2 <- which((cnom > as.double(lw2List$From)) &
(cnom < as.double(lw2List$To)))
(cnom < 8e-6)#as.double(lw2List$To))
)
## --- Lw1 --- gr. Lw ---
lw1List <- getSubList(a$cms, "useLw1")
iLw1 <- which((cnom > as.double(lw1List$From)) &
(cnom < as.double(lw1List$To)))
(cnom < 1e-4)#as.double(lw1List$To))
)
## --- LwC --- constLw ---
lwCList <- getSubList(a$cms, "useLwC")
iLwC <- which(pfill > as.double(lwCList$From) &
pfill < 0.1#as.double(lwCList$To)
)
if(length(iLwC) > 0){
iout2 <- which(iLwC %in% iLw2)
if(length( iout2) == length(iLw2)){
iLw2 <- integer(0)
}else{
iLw2 <- iLw2[-iout2]
}
}
## -------------------
return(list(iLw1 = iLw1,
......
utils/resError.R
+ 2
− 1
View file @ 2bd6b7bd
......@@ -85,10 +85,11 @@ resError <- function(ccc){
## wobei e.delte die Abweichung vom Reverenzwert ist
e.delta <- abs(result[i.take] - revV)
i.out <- which(e.delta > mean(ut[i.take], na.rm = TRUE)/k*3)
print("öööÖÖÖÖÖÖÖÖÖ")
print("----------------")
print(i)
print(e.delta)
print( i.out)
print("----------------")
if(length(i.out) > 0){
i.take <- i.take[-i.out]
msg <- paste(msg, "from these I skip the points: ",
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment