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

cuco uncert @sens

	geändert:   cal/ce3.extrapC.R
	geändert:   devel/calYampCe3.R
	geändert:   uncert/ce3.uncertTotal.R
	neue Datei:   uncert/cuco.uncertEmis.R
	geändert:   uncert/cuco.uncertExpSd.R
	geändert:   uncert/cuco.uncertGasPurity.R
	geändert:   uncert/cuco.uncertPind.R
	geändert:   uncert/cuco.uncertSync.R
	geändert:   utils/calSens.R
	geändert:   utils/dispatchResCal.R
parent cf3a9491
Branches
Tags
No related merge requests found
......@@ -54,7 +54,7 @@ ce3.extrapC <- function(ccc){
##' Hier noch die Differenz zur Fitfunktion
dh[ilw$iLw2] <- cnom[ilw$iLw2]/fn.2162(cf,plw[ilw$iLw2]) - 1
}
print(ilw)
if(length(ilw$iLw1) > 0){
cf$a <- getConstVal(a$cms, paste("grLw_",gas,"_A", sep=""))
cf$b <- getConstVal(a$cms, paste("grLw_",gas,"_B", sep=""))
......
......@@ -67,18 +67,18 @@ if(TRUE){
doc <- ce3.uncertPcal(doc)
## ... customer calibration object (cuco) related
# doc <- cuco.uncertDigit(doc)
# doc <- cuco.uncertPOffset(doc)
# doc <- cuco.uncertOffsetDrift(doc)
# doc <- cuco.uncertSync(doc)
# doc <- cuco.uncertExpSd(doc)
# doc <- cuco.uncertGasPurity(doc)
# doc <- cuco.uncertPind(doc)
#
# ## all
# doc <- ce3.uncertTotal(doc)
#
# ## misc
doc <- cuco.uncertDigit(doc)
doc <- cuco.uncertPOffset(doc)
doc <- cuco.uncertOffsetDrift(doc)
doc <- cuco.uncertSync(doc)
doc <- cuco.uncertExpSd(doc)
doc <- cuco.uncertGasPurity(doc)
doc <- cuco.uncertEmis(doc)
doc <- cuco.uncertPind(doc)
## all
doc <- ce3.uncertTotal(doc)
## misc
# doc <- ce3.compareCDGs(doc)
# doc <- writeRes(doc)
......
......@@ -3,27 +3,17 @@ ce3.uncertTotal <- function(ccc){
a <- abbrevList(ccc)
PCAL <- getSubList(a$cav, "cal")
pcal <- getConstVal(NA,NA,PCAL)
u1 <- getConstVal(a$cav$Uncertainty, "uncertPcal_rel")
u2 <- getConstVal(a$cav$Uncertainty, "uncertPind_rel")
u <- sqrt(u1^2+u2^2)
u <- sqrt(u1^2 + u2^2)
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertTotal_rel",
"1",
u,
paste(msg, " (k=1)"))
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertTotal_abs",
PCAL$Unit,
u * pcal,
paste(msg, " (k=1)"))
paste(msg, " (k=1)"))
return(ccc)
......
cuco.uncertEmis <- function(ccc){
msg <- "calculated by cuco.uncertExpSd"
a <- abbrevList(ccc)
un <- "uncertEmis"
PIND <- getSubList(a$cav, "ind")
pind <- getConstVal(NA,NA,PIND)
U <- getSubList(a$cmco1, un)
u <- getConstVal(NA, NA, U)
if(length(u) == 0){
u <- 0.002
U$Unit <- "1"
}
if(length(u) == 1){
u <- rep(u, length(pind))
}
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
"1",
u,
msg)
return(ccc)
}
......@@ -17,10 +17,12 @@ cuco.uncertExpSd <- function(ccc){
u <- 0.008
U$Unit <- "1"
}
if(U$Unit == "mbar"){
u <- u/pind
}
if(U$Unit == "mbar"){
u <- u/pind
}
if(length(u) == 1){
u <- rep(u, length(pind))
}
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
......
......@@ -19,6 +19,9 @@ cuco.uncertGasPurity <- function(ccc){
if(U$Unit == "mbar"){
u <- u/pind
}
if(length(u) == 1){
u <- rep(u, length(pind))
}
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
......
......@@ -20,6 +20,23 @@ cuco.uncertPind <- function(ccc){
u5^2 +
u6^2)
} ## ce3 error
if(a$cs == "CE3" & a$cpt$Type == "sens"){
u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit")
u2 <- getConstVal(a$cav$Uncertainty, "uncertExpSd")
u3 <- getConstVal(a$cav$Uncertainty, "uncertGasPurity")
u4 <- getConstVal(a$cav$Uncertainty, "uncertOffsetDrift")
u5 <- getConstVal(a$cav$Uncertainty, "uncertOffset")
u6 <- getConstVal(a$cav$Uncertainty, "uncertSync")
u7 <- getConstVal(a$cav$Uncertainty, "uncertEmis")
uncertges <- sqrt(u1^2 +
u2^2 +
u3^2 +
u4^2 +
u5^2 +
u6^2 +
u7^2)
} ## ce3 sens
if(a$cs == "SE1" & a$cpt$Type == "srg_error"){
u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit")
......
......@@ -11,6 +11,7 @@ cuco.uncertSync <- function(ccc){
U <- getSubList(a$cmco1, un)
u <- getConstVal(NA, NA, U)
if(length(u) == 0){
u <- 0.005
U$Unit <- "1"
......@@ -18,7 +19,9 @@ cuco.uncertSync <- function(ccc){
if(U$Unit == "mbar"){
u <- u/pind
}
if(length(u) == 1){
u <- rep(u, length(pind))
}
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
......@@ -26,5 +29,5 @@ cuco.uncertSync <- function(ccc){
u,
msg)
return(ccc)
return(ccc)
}
......@@ -4,29 +4,32 @@ calSens <- function( ccc ){
a <- abbrevList(ccc)
iUnit <- "A"
IE <- getSubList(a$cmco1, "ie")
iconv <- getConvFactor(ccc,iUnit, IE$Unit)
ie <- getConstVal(NA, NA, IE) * iconv
OFF <- getSubList(a$cav, "ind_offset")
IND <- getSubList(a$cav, "ind")
PCAL <- getSubList(a$cav, "cal")
ioff <- getConstVal(NA, NA, "ind_offset")
iind <- getConstVal(NA, NA, "ind")
pcal <- getConstVal(NA, NA, "cal")
if(OFF$Unit == IND$Unit &
IND$Unit == iUnit &
PCAL$Unit == "mbar"){
ccc$Calibration$Analysis$Values$Sensitivity <-
setCcl(ccc$Calibration$Analysis$Values$Sensitivity, "gauge_sens",
"1/mbar",
(iind - ioff)/(pcal * ie) ,
paste(msg, "Ie is given in 1st calib. obj. with: ", ie,IE$Unit))
}
#
# IE <- getSubList(a$cmco1, "ie")
# iconv <- getConvFactor(ccc,iUnit, IE$Unit)
# ie <- getConstVal(NA, NA, IE) * iconv
#
# OFF <- getSubList(a$cav, "ind_offset")
# IND <- getSubList(a$cav, "ind")
# PCAL <- getSubList(a$cav, "cal")
#
#
# ioff <- getConstVal(NA, NA, OFF )
# iind <- getConstVal(NA, NA, IND )
# pcal <- getConstVal(NA, NA, PCAL )
#
#
# if(OFF$Unit == IND$Unit &
# IND$Unit == iUnit &
# PCAL$Unit == "mbar"){
#
# ccc$Calibration$Analysis$Values$Sensitivity <-
# setCcl(ccc$Calibration$Analysis$Values$Sensitivity, "gauge_sens",
# "1/mbar",
# (iind - ioff)/(pcal * ie) ,
# paste(msg, "Ie is given in 1st calib. obj. with: ", ie,IE$Unit))
# }
return( ccc )
}
dispatchResCal <- function(ccc){
a <- abbrevList(ccc)
if(length(a$cp) > 0){
if(length(a$cpt) > 0){
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment