Skip to content
Snippets Groups Projects
Commit bed74ee1 authored by Thomas Bock's avatar Thomas Bock :speech_balloon:
Browse files

...

parents 7cd7d008 a93b663e
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
cal/fm3.cdg_corr.r
+ 57
− 4
View file @ bed74ee1
......@@ -6,15 +6,68 @@
#' @export
#' @keywords
#'
### cdga 10T cdg
fn.cdga <- function(sl, prefix, sufix, x){
fname <- deparse(match.call()[[1]])
a <- getConstVal(sl, paste0(prefix, "A", sufix))
b <- getConstVal(sl, paste0(prefix, "B", sufix))
c <- getConstVal(sl, paste0(prefix, "C", sufix))
d <- getConstVal(sl, paste0(prefix, "D", sufix))
e <- getConstVal(sl, paste0(prefix, "E", sufix))
f <- getConstVal(sl, paste0(prefix, "F", sufix))
if(length(a) > 0 &
length(b) > 0 &
length(c) > 0 &
length(d) > 0 &
length(e) > 0 &
length(f) > 0){
return((a + c * x + e*x^2)/(1 + b*x + d*x^2 + f*x^3))
}else{
stop(paste("no params found in function:", fname))
}
}
### cdgb 1000T cdg
fn.cdgb <- function(sl, prefix, sufix, x){
fname <- deparse(match.call()[[1]])
a <- getConstVal(sl, paste0(prefix, "A", sufix))
b <- getConstVal(sl, paste0(prefix, "B", sufix))
c <- getConstVal(sl, paste0(prefix, "C", sufix))
d <- getConstVal(sl, paste0(prefix, "D", sufix))
e <- getConstVal(sl, paste0(prefix, "E", sufix))
f <- getConstVal(sl, paste0(prefix, "F", sufix))
g <- getConstVal(sl, paste0(prefix, "G", sufix))
if(length(a) > 0 &
length(b) > 0 &
length(c) > 0 &
length(d) > 0 &
length(e) > 0 &
length(f) > 0 &
length(g) > 0){
return((a + c*x + e*x^2 + g*x^3)/(1 + b*x + d*x^2 + f*x^3))
}else{
stop(paste("no params found in function:",fname))
}
}
fm3.cdg.corr <- function(doc, p, prefix , sufix, border){
a <- abbrevList(doc)
i.dev <- which(p$fill < border$x1)
if(length(i.dev) > 0){
F <- fn.7904(a$cco, prefix, sufix, p$fill[i.dev])
p$fill[i.dev] <- p$fill[i.dev] / (F + 1)
if( prefix == "cdgbCorr") {
f <- fn.cdgb(a$cco, prefix, sufix, p$fill[i.dev])
}
if( prefix == "cdgaCorr") {
f <- fn.cdga(a$cco, prefix, sufix, p$fill[i.dev])
}
p$fill[i.dev] <- p$fill[i.dev] / (f + 1)
}
return(p)
}
cal/fm3.conductance.r
+ 16
− 2
View file @ bed74ee1
......@@ -10,7 +10,7 @@ fm3.conductance <- function(doc){
fname <- deparse(match.call()[[1]])
msg <- paste("calculated by", fname)
c.B <- 0.9 ## Grenze Korrelation SZ
c.B <- 0.9 ## Grenze Korrelation SZ<<<<<<< HEAD
d.B <- 0.9 ## Grenze Korrelation Drift
t2mm <- getConstVal(a$cs, "turn_2_mm")
......@@ -87,14 +87,28 @@ fm3.conductance <- function(doc){
deltaV <- A * dh * mm32l
### Conductance L = dV/dt
dVdt <- mean(deltaV / deltat, na.rm = TRUE)
l.dev <- abs((deltaV / deltat - dVdt) / dVdt)
m.dev <- mean(l.dev, na.rm = TRUE)
## rm sz if dev > sz.border
if(!is.na(m.dev) & m.dev > sz.border){
r <- which.max(l.dev)
deltaV[r] <- NA
deltat[r] <- NA
dVdt <- mean(deltaV / deltat, na.rm = TRUE)
}
## print( deltaV / deltat /dVdt -1)
### Drift Korrektur dV/dt * (1 - m.D/m.SZ)
## wenn besser als d.B korreliert
dcorr[j] <- (1 - s.d[j]/s.m[j])
#if(R.d[j] > d.B){
dVdt <- dVdt * dcorr[j]
#}
#}
L[j] <- dVdt
......
cal/fm3.temperature.r
+ 1
− 1
View file @ bed74ee1
......@@ -20,7 +20,7 @@ fm3.temperature <- function(doc){
### Tfm
k101 <- getConstVal(a$cco,"agilentCorrCh101")
k102 <- getConstVal(a$cco,"agilentCorrCh101")
k102 <- getConstVal(a$cco,"agilentCorrCh102")
Tfm <- (#getConstVal(a$cmv$Temperature,"agilentCh101_before_lw")
#+ k101
+ getConstVal(a$cmv$Temperature,"agilentCh101_after_lw")
......
devel/ce3.r
+ 8
− 3
View file @ bed74ee1
......@@ -27,16 +27,21 @@ cdb <- cdbIni()
## cdb$id <- "cal-2018-ce3-kk-75085_0001"
## cdb$id <- "cal-2019-ce3-kk-75037_0001"
## cdb$id <- "cal-2019-ce3-kk-75012_0001"
<<<<<<< HEAD
## cdb$id <- "cal-2019-ce3-kk-75041_0001"
cdb$id <- "cal-2020-ce3-kk-75005_0001"
#cdb$DBName <- "vl_db"
=======
## cdb$id <- "cal-2019-ce3-kk-75095_0001"
## cdb$id <- "cal-2019-ce3-kk-75095_0001"
cdb$id <- "cal-2020-ce3-kk-75005_0001"
>>>>>>> a93b663efd7670ce2d7405fe95c3c5feb6f3efc2
cdb$DBName <- "vl_db"
doc <- cdbGetDoc(cdb)$res
a <- abbrevList(doc)
## doc <- cutValues(doc, 1:6)
## doc <- cutValues(doc, 1:11)
doc <- refreshAnalysis(doc)
doc <- refreshResult(doc)
doc <- fm3.pressure.fill(doc)
......@@ -100,7 +105,7 @@ if(length(a$ct) > 0){
## ## ## #
## ## doc <- ce3.compareCDGs(doc)
if(!FALSE){
if(FALSE){
# cdb$DBName <- "vl_db_work"
cdb$dataList <- doc
cdbUpdateDoc(cdb)$res
......
devel/srg_vg.r
+ 13
− 7
View file @ bed74ee1
......@@ -24,8 +24,16 @@ pUnit <- "mbar"
## cdb$id <- "cal-2019-ce3-kk-75037_0002" ##
## cdb$id <- "cal-2019-ce3-kk-75012_0002" ##
## cdb$id <- "cal-2019-ce3-kk-75041_0002" ##
<<<<<<< HEAD
cdb$id <- "cal-2019-ce3-kk-75095_0002" ##
sigma.F13 <- 1.099
=======
## cdb$id <- "cal-2019-ce3-kk-75095_0002" ##
cdb$id <- "cal-2019-ce3-kk-75045_0002" ##
sigma.F13 <- 1.112
#ind.conv <- 1.33322
ind.conv <- 1
>>>>>>> a93b663efd7670ce2d7405fe95c3c5feb6f3efc2
doc <- cdbGetDoc(cdb)$res
doc <- refreshAnalysis(doc)
......@@ -41,8 +49,8 @@ M <- getConstVal(a$cc, "molWeight_N2" )
dcr <- getConstVal(a$cmv$Pressure, "srg_pcal")
rd <- getConstVal(a$cmv$Pressure, "srg_pcal_offset")
ind <- getConstVal(a$cmv$Pressure, "ind")
offset <- getConstVal(a$cmv$Pressure, "ind_offset")
ind <- getConstVal(a$cmv$Pressure, "ind")*ind.conv
offset <- getConstVal(a$cmv$Pressure, "ind_offset")*ind.conv
## Tempetarure UHV
C2K <- getConstVal(a$cc, "C_2_K")
......@@ -67,13 +75,11 @@ doc$Calibration$Analysis$Values$Temperature <-
K <- sqrt(8*R*(Tuhv)/(pi*M))*pi*d*rho/2000/sigma.F13 # mbar
pcal <- K * (dcr - rd)
err <- (ind-offset)/pcal -1
cf <- pcal/(ind - offset)
doc <- ce3.pressure.ind(doc)
pind <- ind - offset
err <- pind/pcal -1
cf <- pcal/pind
doc$Calibration$Analysis$Values$Pressure <-
setCcl(doc$Calibration$Analysis$Values$Pressure
, "cal"
......
uncert/ce3.uncert_total_error.r
+ 9
− 7
View file @ bed74ee1
......@@ -3,25 +3,27 @@ ce3.uncert.total.error <- function(ccc){
fname <- deparse(match.call()[[1]])
msg <- paste("calculated by", fname)
e <- getConstVal(a$cav$Error, "relative")
cf <- getConstVal(a$cav$CorrectionFactor, "correctionFactor")
pind <- getConstVal(a$cav$Pressure, "ind_corr")
pcal <- getConstVal(a$cav$Pressure, "cal")
u1 <- getConstVal(a$cav$Uncertainty, "uncertPcal_rel")
u2r <- getConstVal(a$cav$Uncertainty, "uncertPind_rel")
u2a <- getConstVal(a$cav$Uncertainty, "uncertPind_abs")
u2 <- getConstVal(a$cav$Uncertainty, "uncertPind_rel")
ue <- pind/pcal*sqrt(u1^2 + u2^2) ## (QM)
ucf <- pcal^2/pind^2 * ue
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertTotal_cf",
"1",
sqrt(u1^2 + u2r^2) * cf,
ucf,
paste(msg, " (k=1)"))
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertTotal_e",
"1",
sqrt(u1^2 + (u2a/pind)^2) * 1/cf,
ue,
paste(msg, " (k=1)"))
return(ccc)
......
uncert/cuco.uncert_pressure_offset.r
+ 1
− 1
View file @ bed74ee1
......@@ -28,7 +28,7 @@ cuco.uncert.pressure.offset <- function(ccc){
}
uoff <- u / pind
print(u)
## es gibt sd-Daten aus der Messung
SdOff <- getSubList(a$cmv, "ind_offset")$SdValue
N <- getSubList(a$cmv, "ind_offset")$N
......
utils/results.r
+ 10
− 45
View file @ bed74ee1
......@@ -63,51 +63,6 @@ results <- function(ccc){
RESCF$UnitCell <- RESCF$Unit
rescf <- getConstVal(NA, NA, RESCF)
noOfP <- length(p.target)
## Ergebnisstabelle soll gleiche Länge wie
## target vekcor haben
td.pcal <- rep(NA, noOfP)
td.pind <- rep(NA, noOfP)
td.pindcorr <- rep(NA, noOfP)
td.utcf <- rep(NA, noOfP)
td.ute <- rep(NA, noOfP)
td.rese <- rep(NA, noOfP)
td.rescf <- rep(NA, noOfP)
## ## Zieldrücke einzeln durchgehen
## for(i in 1:noOfP){
## i.out <- NULL
## i.take <- which(pcal > (p.target[i] *(1 - maxdev)) &
## pcal < (p.target[i] *(1 + maxdev)))
## msg <- paste(msg,"; For target pressure:",p.target[i],
## "I take the points:", toString(i.take))
##
## if(length(i.take) > 1){
## ## ut ist schon k=2, eswerden alle Punkte genommen,
## ## bei dem e.delta kleiner als 3-sigma ist
## ## wobei e.delte die Abweichung vom Reverenzwert ist
## e.delta <- abs(result[i.take] - revV)
## # i.out <- which(e.delta > mean(ut[i.take])/k*3)
## #
## # if(length(i.out) > 0){
## # i.take <- i.take[-i.out]
## # msg <- paste(msg, "from these I skip the points: ",
## # toString(i.take[i.out]))
## # }
## }
## td.pcal[i] <- unlist(mean(pcal[i.take]))
## td.ute[i] <- unlist(mean(ute[i.take]))
## td.utcf[i] <- unlist(mean(utcf[i.take]))
## td.rese[i] <- unlist(mean(rese[i.take]))
## td.rescf[i] <- unlist(mean(rescf[i.take]))
## td.pind[i] <- unlist(mean(pind[i.take]))
## td.pindcorr[i] <- unlist(mean(pindcorr[i.take]))
## } #for
td.pcal <- unlist(pcal)
td.ute <- unlist(ute)
td.utcf <- unlist(utcf)
......@@ -116,6 +71,16 @@ results <- function(ccc){
td.pind <- unlist(pind)
td.pindcorr <- unlist(pindcorr)
o <- order(td.pcal)
td.pcal <- td.pcal[o]
td.ute <- td.ute[o]
td.utcf <- td.utcf[o]
td.rese <- td.rese[o]
td.rescf <- td.rescf[o]
td.pind <- td.pind[o]
td.pindcorr <- td.pindcorr[o]
PCAL$Value <- formatC(td.pcal, digits=3, format="E")
PIND$Value <- formatC(td.pind, digits=2, format="E")
PINDcorr$Value <- formatC(td.pindcorr, digits=2, format="E")
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment