Skip to content
Snippets Groups Projects
Commit 80e974bf authored by wactbprot's avatar wactbprot
Browse files

devel srg vg

parent 345558e6
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
cal/ce3.calDeltaVDeltat.R
+ 21
− 6
View file @ 80e974bf
......@@ -49,7 +49,7 @@ ce3.calDeltaVDeltat <- function(ccc){
ttype <- paste("t_N_", i, sep="")
turntype <- paste("turn_", i, sep="")
mptype <- paste("mean_p_", i, sep="")
cctype <- paste("R_", i, sep="")
## delta t
mp <- getConstVal(a$cm, mptype)
......@@ -61,7 +61,8 @@ ce3.calDeltaVDeltat <- function(ccc){
SLOPE <- getSubList(a$cm,stype)
slope <- getConstVal(NA,NA,SLOPE)
correlCoef <- getConstVal(a$cm, cctype)
tconv <- getConvFactor(ccc,tUnit, MT$Unit)
##
## die Extrapolation erfolgt zu mean(mp)
......@@ -69,13 +70,28 @@ ce3.calDeltaVDeltat <- function(ccc){
## sz-Drücke; die "Extrapolationslänge"
## wird so minimal.
## ------------------------------------##
out <- which(correlCoef < 0.95)
mt <- mt - min(mt)
ci <- mp - slope * mt
t0 <- (mean(mp) - ci) / slope
t0 <- (mean(mp) - ci) / slope
# if(length(out) > 0){
# t0[out] <- NA
# msg <- paste(msg
# , "exclude saw tooth:"
# , toString(out)
# , "because of bad (<0.95) correlation")
# }
nt <- length(t0)
deltat <- diff(t0) * tconv
## ------------------------------------##
## Güte des SZ: Steigung mp ~ mt möglichst klein
gSlope[j] <- as.numeric(lm(mp ~ mt)$coefficients[2])
mSlope[j] <- mean(slope)
......@@ -97,9 +113,8 @@ 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 <- deltaV / deltat * (1 - dcorr[j])
dVdt <- deltaV / deltat * (1 - dcorr[j])
L[j] <- mean(dVdt)
sdL[j] <- sd(dVdt)
lL[j] <- length(dVdt)
......
cal/ce3.writePind.R
+ 6
− 6
View file @ 80e974bf
......@@ -68,17 +68,17 @@ ce3.writePind <- function(ccc){
R <- getConstVal(a$cc, "R" )
T <- getConstVal(a$cav, "Tuhv")
if( a$cmag == "Ar"){
if( a$cmscg == "Ar"){
M <- getConstVal(a$cc, "molWeight_Ar" )
msg <- paste(msg, "; gas:", a$cmag)
msg <- paste(msg, "; gas:", a$cmscg)
}
if( a$cmag == "N2"){
if( a$cmscg == "N2"){
M <- getConstVal(a$cc, "molWeight_N2" )
msg <- paste(msg, "; gas:", a$cmag)
msg <- paste(msg, "; gas:", a$cmscg)
}
if( a$cmag == "D2"){
if( a$cmscg == "D2"){
M <- getConstVal(a$cc, "molWeight_D2" )
msg <- paste(msg, "; gas:", a$cmag)
msg <- paste(msg, "; gas:", a$cmscg)
}
if(CAL$Unit == "mbar"){
......
devel/srg_vg.R 0 → 100644
+ 123
− 0
View file @ 80e974bf
## --
## wactbprot/2011-05-25
## --
library(methods, quietly =TRUE)
library(bitops, quietly =TRUE)
library(RJSONIO, quietly =TRUE)
library(RCurl, quietly =TRUE)
library(R4CouchDB,quietly =TRUE)
cdb <- cdbIni()
cdb$DBName <- "vaclab_work" ## DBName
infList <- list()
infList$srcPath <- "/usr/local/lib/r4vl"
setwd(infList$srcPath)
source("load.R")
pUnit <- "mbar"
#cdb$id <- "89e85b1c42ee6a9b70864a7612251a7e" # 14. & 15.10.2014 EDW Kalib 75093_0002
cdb$id <- "4a3f871adca4554d648e3a75fa1e05fe" # 14. & 03.12.2014 EDW Kalib 75079_0002
sigma.F13 <- 1.0945
doc <- cdbGetDoc(cdb)$res
doc <- refreshAnalysis(cdb, doc)
doc <- refreshResult(cdb, doc)
a <- abbrevList(doc)
d <- getConstVal(a$cmco, "d")
rho <- getConstVal(a$cmco,"rho" )
sigma <- getConstVal(a$cmco,"0" )
R <- getConstVal(a$cc, "R" )
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, "offset")
K <- sqrt(8*R*(296.5)/(pi*M))*pi*d*rho/2000/sigma.F13 # mbar
doc <- ce3.writePind(doc)
pcal <- K * (dcr - rd)
pind <- ind - offset
doc$Calibration$Analysis$Values$Pressure <-
setCcl(doc$Calibration$Analysis$Values$Pressure
, "cal"
, pUnit
, pcal
, "p_cal mit SRG bestimmt"
)
doc$Calibration$Analysis$Values$Error <-
setCcl(doc$Calibration$Analysis$Values$Error
, "relative"
, "1"
, (ind-offset)/pcal -1
)
## ------------------Uncert p_ind ------------------------
doc <- cuco.uncertDigit(doc)
doc <- cuco.uncertSync(doc)
doc <- cuco.uncertExpSd(doc)
doc <- cuco.uncertGasPurity(doc)
a <- abbrevList(doc)
u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit")
u2 <- getConstVal(a$cav$Uncertainty, "uncertExpSd")
u3 <- getConstVal(a$cav$Uncertainty, "uncertGasPurity")
u4 <- getConstVal(a$cav$Uncertainty, "uncertSync")
uncertges <- sqrt(u1^2 + u2^2 + u3^2 + u4^2 )
doc$Calibration$Analysis$Values$Uncertainty <-
setCcl(doc$Calibration$Analysis$Values$Uncertainty
,"uncertPind_rel"
,"1"
,uncertges
,"digit, gas, exsd, sync (k=1)"
)
doc$Calibration$Analysis$Values$Uncertainty <-
setCcl(doc$Calibration$Analysis$Values$Uncertainty
,"uncertPind_abs"
,pUnit
,uncertges * pind
)
## ------------------Uncert p_cal ------------------------
a <- abbrevList(doc)
u1 <- getConstVal(a$cmco, "srg13_u1") #rel
u2 <- getConstVal(a$cmco, "srg13_u2") #rel
u3 <- getConstVal(a$cmco, "srg13_u3") #rel
u4 <- getConstVal(a$cmco, "srg13_u4") #abs mbar
u5 <- getConstVal(a$cmco, "srg13_u5") #rel
uncertges <- sqrt(u1^2 + u2^2 + u3^2 + (u4/pcal)^2 + u5^2)
doc$Calibration$Analysis$Values$Uncertainty <-
setCcl(doc$Calibration$Analysis$Values$Uncertainty
, "uncertPcal_rel"
, "1"
, uncertges
, "SRG bestimmt (k=1)")
doc$Calibration$Analysis$Values$Uncertainty <-
setCcl(doc$Calibration$Analysis$Values$Uncertainty
, "uncertPcal_abs"
, pUnit
, uncertges * pcal
, "SRG bestimmt (k=1)")
doc <- ce3.uncertTotal(doc)
doc <- dispatchResSum(doc)
cdb$DBName <- "vaclab_work" ## DBName
cdb$dataList <- doc
res <- cdbUpdateDoc(cdb)$res
\ No newline at end of file
load.R
+ 1
− 1
View file @ 80e974bf
## --
## wactbprot/2014-03-25
## --
library(xlsx, quietly =TRUE)
#library(xlsx, quietly =TRUE)
library(knitr, quietly =TRUE)
library(methods, quietly =TRUE)
library(bitops, quietly =TRUE)
......
scripts/analyse_CE3_YAMP.R
+ 6
− 4
View file @ 80e974bf
......@@ -4,13 +4,14 @@ if(length(doc$Calibration) > 0){
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)
##
doc <- dispatchResCal(doc)
......@@ -22,7 +23,7 @@ if(length(doc$Calibration) > 0){
doc <- fm3.uncertDeltaV(doc)
doc <- fm3.uncertDeltaVDeltat(doc)
doc <- fm3.uncertDeltat(doc)
doc <- fm3.uncertPres(doc)
doc <- fm3.uncertConstC(doc)
......@@ -34,7 +35,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)
......@@ -52,5 +53,6 @@ if(length(doc$Calibration) > 0){
doc <- dispatchResCal(doc)
doc <- dispatchResSum(doc)
#
doc <- ce3.compareCDGs(doc)
doc <- ce3.compareCDGs(doc)
#}
}
utils/calSigma.R
+ 6
− 6
View file @ 80e974bf
......@@ -53,17 +53,17 @@ calSigma <- function( ccc ){
if(a$cs == "CE3"){
T <- getConstVal(a$cav, "Tuhv")
}
if( a$cmag == "Ar"){
if( a$cmscg == "Ar"){
M <- getConstVal(a$cc, "molWeight_Ar" )
msg <- paste(msg, "; a$cmag:", a$cmag)
msg <- paste(msg, "; a$cmscg:", a$cmscg)
}
if( a$cmag == "N2"){
if( a$cmscg == "N2"){
M <- getConstVal(a$cc, "molWeight_N2" )
msg <- paste(msg, "; gas:", a$cmag)
msg <- paste(msg, "; gas:", a$cmscg)
}
if( a$cmag == "D2"){
if( a$cmscg == "D2"){
M <- getConstVal(a$cc, "molWeight_D2" )
msg <- paste(msg, "; gas:", a$cmag)
msg <- paste(msg, "; gas:", a$cmscg)
}
IndUnit <- CAL$Unit
......
utils/resError.R
+ 1
− 1
View file @ 80e974bf
......@@ -7,7 +7,7 @@ resError <- function(ccc){
p.target <- as.numeric(a$cpt$Values$Pressure$Value)
maxdev <- as.numeric(a$cpt$MaxDev)
k <- 2 # Erweiterungsfaktor
maxdev <- 0.25
##-------------##
## pcal
##-------------##
......
utils/resSrgError.R
+ 2
− 1
View file @ 80e974bf
......@@ -8,7 +8,7 @@ resSrgError <- function(ccc){
maxdev <- as.numeric(a$cpt$MaxDev)
k <- 2 # Erweiterungsfaktor
## 10% max. Abw. vom Zieldruck als default
if(length(maxdev) == 0) maxdev <- 0.10
if(length(maxdev) == 0) maxdev <- 0.30
##-------------##
## pcal
......@@ -45,6 +45,7 @@ resSrgError <- function(ccc){
i.out <- NULL
i.take <- which(pcal > (p.target[i] *(1- maxdev)) &
pcal < (p.target[i] *(1+ maxdev)))
print(itake)
msg <- paste(msg,"; For target pressure:",p.target[i],
"I take the points:", toString(i.take))
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment