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

go on with cuco.uncert*.R

	geändert:   cal/ce3.writePind.R
	neue Datei:   cal/se1.writePind.R
	geändert:   devel/calYampSE1.R
	geändert:   scripts/analyse_SE1_YAMP.R
	geändert:   uncert/cuco.uncertDigit.R
	geändert:   uncert/cuco.uncertPind.R
	neue Datei:   uncert/cuco.uncertPrise.R
	neue Datei:   uncert/cuco.uncertVisc.R
	umbenannt:    uncert/se1.uncertTotal.R -> uncert/se1.uncertPcal.R
	geändert:   uncert/se1.uncertTotal.R
parent a0d3f768
No related branches found
No related tags found
No related merge requests found
...@@ -53,25 +53,19 @@ ce3.writePind <- function(ccc){ ...@@ -53,25 +53,19 @@ ce3.writePind <- function(ccc){
!is.null(OFF) & !is.null(OFF) &
IND$Unit == "DCR" & IND$Unit == "DCR" &
OFF$Unit == "DCR"){ OFF$Unit == "DCR"){
ind <- getConstVal(NA,NA,IND) ind <- getConstVal(NA,NA,IND)
off <- getConstVal(NA,NA,OFF) off <- getConstVal(NA,NA,OFF)
d <- getConstVal(a$cmco1, "d") d <- getConstVal(a$cmco1, "d")
rho <- getConstVal(a$cmco1,"rho" ) rho <- getConstVal(a$cmco1,"rho" )
sigma <- getConstVal(a$cmco1,"sigma" ) sigma <- getConstVal(a$cmco1,"sigma" )
dcr <- ind - off
dcr <- ind - off R <- getConstVal(a$cc, "R" )
T <- getConstVal(a$cav, "Tuhv")
R <- getConstVal(a$cc, "R" )
if(a$cs == "SE1"){
T <- getConstVal(a$cav, "after")
}
if(a$cs == "CE3"){
T <- getConstVal(a$cav, "Tuhv")
}
if( a$cmag == "Ar"){ if( a$cmag == "Ar"){
M <- getConstVal(a$cc, "molWeight_Ar" ) M <- getConstVal(a$cc, "molWeight_Ar" )
msg <- paste(msg, "; gas:", a$cmag) msg <- paste(msg, "; gas:", a$cmag)
......
se1.writePind <- function(ccc){
msg <- "written by se1.writePind()"
a <- abbrevList(ccc)
pUnit <- "mbar"
if(length(a$cpt)>0){
if(length(a$cpt$Pressures)>0){
if(length(a$cpt$Pressures$Unit)>0){
pUnit <- a$cpt$Pressures$Unit
}
}
}
CAL <- getSubList(a$cav, "cal")
cal <- getConstVal(NA,NA,CAL)
## the tribut to god of schemeless design
IND <- getSubList(a$cmv, "p_ind")
if(is.null(IND)){
IND <- getSubList(a$cmv, "ind")
}
OFF <- getSubList(a$cmv, "p_ind_offset")
if(is.null(OFF)){
OFF <- getSubList(a$cmv, "ind_offset")
}
if(is.null(OFF)){
OFF <- getSubList(a$cmv, "offset")
}
## Druckeinheiten wie Pa, Torr ...
if(!is.null(IND) &
!is.null(OFF) &
IND$Unit != "DCR"){
ind <- getConstVal(NA,NA,IND) * getConvFactor(ccc,pUnit,IND$Unit)
off <- getConstVal(NA,NA,OFF) * getConvFactor(ccc,pUnit,OFF$Unit)
}
## Strom (für Sensitivity)
if(!is.null(IND) &
!is.null(OFF) &
IND$Unit == "A"){
ind <- getConstVal(NA,NA,IND)
off <- getConstVal(NA,NA,OFF)
}
## DCR
if(!is.null(IND) &
!is.null(OFF) &
IND$Unit == "DCR" &
OFF$Unit == "DCR"){
ind <- getConstVal(NA,NA,IND)
off <- getConstVal(NA,NA,OFF)
d <- getConstVal(a$cmco1, "d")
rho <- getConstVal(a$cmco1,"rho" )
sigma <- getConstVal(a$cmco1,"sigma" )
dcr <- ind - off
R <- getConstVal(a$cc, "R" )
T <- getConstVal(a$cav, "after")
if( a$cmag == "Ar"){
M <- getConstVal(a$cc, "molWeight_Ar" )
msg <- paste(msg, "; gas:", a$cmag)
}
if( a$cmag == "N2"){
M <- getConstVal(a$cc, "molWeight_N2" )
msg <- paste(msg, "; gas:", a$cmag)
}
if( a$cmag == "D2"){
M <- getConstVal(a$cc, "molWeight_D2" )
msg <- paste(msg, "; gas:", a$cmag)
}
if(CAL$Unit == "mbar"){
indUnit <- "mbar"
K <- sqrt(8*R*(T)/(pi*M))*pi*d*rho/2000
corrind <- K * dcr/sigma
ind <- K * ind
off <- K * off
}
}
if(length(ind) > 0 & length(off) > 0){
ccc$Calibration$Analysis$Values$Pressure <-
setCcl(ccc$Calibration$Analysis$Values$Pressure, "ind",
pUnit,
ind,
paste(msg)
)
ccc$Calibration$Analysis$Values$Pressure <-
setCcl(ccc$Calibration$Analysis$Values$Pressure, "ind_offset",
pUnit,
off,
paste(msg)
)
ccc$Calibration$Analysis$Values$Pressure <-
setCcl(ccc$Calibration$Analysis$Values$Pressure, "ind_corr",
pUnit,
ind - off,
paste(msg, ";p_ind - p_ind_offset")
)
}
return(ccc)
}
...@@ -27,6 +27,7 @@ doc <- se1.calPfill(doc) ...@@ -27,6 +27,7 @@ doc <- se1.calPfill(doc)
doc <- se1.calf(doc) doc <- se1.calf(doc)
doc <- se1.calRGC(doc) doc <- se1.calRGC(doc)
doc <- se1.calPcal(doc) doc <- se1.calPcal(doc)
doc <- se1.writePind(doc)
doc <- se1.uncertPfill(doc) doc <- se1.uncertPfill(doc)
doc <- se1.uncertf(doc) doc <- se1.uncertf(doc)
...@@ -41,6 +42,18 @@ doc <- se1.uncertValve(doc) ...@@ -41,6 +42,18 @@ doc <- se1.uncertValve(doc)
doc <- se1.uncertInh(doc) doc <- se1.uncertInh(doc)
doc <- se1.uncertPres(doc) doc <- se1.uncertPres(doc)
doc <- se1.uncertRep(doc) doc <- se1.uncertRep(doc)
if(a$cs == "SE1" & a$cpt$Type == "srg_error"){
doc <- cuco.uncertVisc(doc)
doc <- cuco.uncertDigit(doc)
doc <- cuco.uncertPOffset(doc)
doc <- cuco.uncertOffsetDrift(doc)
doc <- cuco.uncertExpSd(doc)
}
doc <- se1.uncertPcal(doc)
doc <- cuco.uncertPind(doc)
doc <- se1.uncertTotal(doc) doc <- se1.uncertTotal(doc)
doc <- dispatchResCal( doc ) doc <- dispatchResCal( doc )
......
...@@ -22,5 +22,12 @@ if(length(doc$Calibration) > 0){ ...@@ -22,5 +22,12 @@ if(length(doc$Calibration) > 0){
## ... customer calibration object (cuco) related ## ... customer calibration object (cuco) related
doc <- se1.uncertTotal(doc)
}
doc <- se1.uncertTotal(doc)
## misc
doc <- writeRes(doc)
} }
...@@ -9,16 +9,18 @@ cuco.uncertDigit <- function(ccc){ ...@@ -9,16 +9,18 @@ cuco.uncertDigit <- function(ccc){
pind <- getConstVal(NA,NA,PIND) pind <- getConstVal(NA,NA,PIND)
digit <- getConstVal(a$cmco1, un) digit <- getConstVal(a$cmco1, un)
print(digit)
if(length(digit) == 0){ if(length(digit) == 0){
digit <- 0.02 digit <- 0.02
} }
fp <- formatC(pind,format="E") fp <- formatC(pind,format="E")
di <- formatC(digit,format="f")
m <- regexec("E[+-][0-9]*$",fp) m <- regexec("E[+-][0-9]*$",fp)
u <- as.numeric(paste(digit,unlist(regmatches(fp, m)), sep=""))*0.29 u <- as.numeric(paste(di,unlist(regmatches(fp, m)), sep=""))*0.29
ccc$Calibration$Analysis$Values$Uncertainty <- ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty, setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertDigit", "uncertDigit",
......
cuco.uncertPind <- function(ccc){ cuco.uncertPind <- function(ccc){
msg <- "calculated by cuco.uncertPind" msg <- "calculated by cuco.uncertPind"
a <- abbrevList(ccc)
PIND <- getSubList(a$cav, "ind")
pind <- getConstVal(NA,NA,PIND)
a <- abbrevList(ccc) if(a$cs == "CE3" & a$cpt$Type == "error"){
u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit")
PIND <- getSubList(a$cav, "ind") u2 <- getConstVal(a$cav$Uncertainty, "uncertExpSd")
pind <- getConstVal(NA,NA,PIND) u3 <- getConstVal(a$cav$Uncertainty, "uncertGasPurity")
u4 <- getConstVal(a$cav$Uncertainty, "uncertOffsetDrift")
u5 <- getConstVal(a$cav$Uncertainty, "uncertOffset")
u6 <- getConstVal(a$cav$Uncertainty, "uncertSync")
uncertges <- sqrt(u1^2 +
u2^2 +
u3^2 +
u4^2 +
u5^2 +
u6^2)
} ## ce3 error
u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit") if(a$cs == "SE1" & a$cpt$Type == "srg_error"){
u2 <- getConstVal(a$cav$Uncertainty, "uncertExpSd") u1 <- getConstVal(a$cav$Uncertainty, "uncertDigit")
u3 <- getConstVal(a$cav$Uncertainty, "uncertGasPurity") u2 <- getConstVal(a$cav$Uncertainty, "uncertExpSd")
u4 <- getConstVal(a$cav$Uncertainty, "uncertOffsetDrift") u3 <- getConstVal(a$cav$Uncertainty, "uncertOffsetDrift")
u5 <- getConstVal(a$cav$Uncertainty, "uncertOffset") u4 <- getConstVal(a$cav$Uncertainty, "uncertOffset")
u6 <- getConstVal(a$cav$Uncertainty, "uncertSync") u5 <- getConstVal(a$cav$Uncertainty, "uncertVisc")
u6 <- getConstVal(a$cav$Uncertainty, "uncertPrise")
uncertges <- sqrt(u1^2 +
u2^2 +
u3^2 +
u4^2 +
u5^2 +
u6^2)
} ## se1 srg_error
uncertges <- sqrt(u1^2 + ccc$Calibration$Analysis$Values$Uncertainty <-
u2^2 + setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
u3^2 + "uncertPind_rel",
u4^2 + "1",
u5^2 + uncertges,
u6^2) paste(msg, " (k=1)"))
ccc$Calibration$Analysis$Values$Uncertainty <- ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty, setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertPind_rel", "uncertPind_abs",
"1", PIND$Unit,
uncertges, uncertges * pind,
paste(msg, " (k=1)")) paste(msg, " (k=1)"))
ccc$Calibration$Analysis$Values$Uncertainty <- return(ccc)
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertPind_abs",
PIND$Unit,
uncertges * pind,
paste(msg, " (k=1)"))
return(ccc)
} }
cuco.uncertPrise <- function(ccc){
msg <- "calculated by cuco.uncertPrise"
unit<- "mbar"
a <- abbrevList(ccc)
un <- "uncertPrise"
PIND <- getSubList(a$cav, "ind")
pind <- getConstVal(NA,NA,PIND)
U <- getSubList(a$cmco1, un)
u <- getConstVal(NA,NA, U)
if(length(u) == 0){
if(PIND$Unit == "mbar"){
u <- 5.6e-10
U <- list(Unit = "mbar")
}
}
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
"1",
u / pind,
msg)
return(ccc)
}
cuco.uncertVisc <- function(ccc){
msg <- "calculated by cuco.uncertVisc()"
unit<- "mbar"
a <- abbrevList(ccc)
un <- "uncertVisc"
PCAL <- getSubList(a$cav, "cal")
pcal <- getConstVal(NA,NA,PCAL)
U <- getSubList(a$cmco1, un)
u <- getConstVal(NA,NA, U)
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
un,
"1",
u * pcal,
msg)
return(ccc)
}
se1.uncertPcal <- function(ccc){
msg <- "calculated by se1.uncertPcal()"
a <- abbrevList(ccc)
PCAL <- getSubList(a$cav$Pressure, "cal")
pcal <- getConstVal(NA, NA, PCAL)
uges <- sqrt(
getConstVal(a$cav$Uncertainty, "uncertPfill") ^2 +
getConstVal(a$cav$Uncertainty, "uncertf") ^2 +
getConstVal(a$cav$Uncertainty, "uncertdT") ^2 +
getConstVal(a$cav$Uncertainty, "uncertT1") ^2 +
getConstVal(a$cav$Uncertainty, "uncertRg") ^2 +
getConstVal(a$cav$Uncertainty, "uncertAds") ^2 +
getConstVal(a$cav$Uncertainty, "uncertVz") ^2 +
getConstVal(a$cav$Uncertainty, "uncertGas") ^2 +
getConstVal(a$cav$Uncertainty, "uncertAtm") ^2 +
getConstVal(a$cav$Uncertainty, "uncertValve") ^2 +
getConstVal(a$cav$Uncertainty, "uncertPres") ^2 +
getConstVal(a$cav$Uncertainty, "uncertRep") ^2 )
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertPcal_rel",
"1",
uges,
paste(msg, " (k=1)"))
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertPcal_abs",
PCAL$Unit,
uges * pcal,
paste(msg, " (k=1)"))
return(ccc)
}
se1.uncertTotal <- function(ccc){ se1.uncertTotal <- function(ccc){
msg <- "calculated by se1.uncertComb()" msg <- "calculated by se1.uncertComb()"
a <- abbrevList(ccc) a <- abbrevList(ccc)
PCAL <- getSubList(a$cav$Pressure, "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)
uc <- sqrt( ccc$Calibration$Analysis$Values$Uncertainty <-
getConstVal(a$cav$Uncertainty, "uncertPfill") ^2 + setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
getConstVal(a$cav$Uncertainty, "uncertf") ^2 + "uncertTotal_rel",
getConstVal(a$cav$Uncertainty, "uncertdT") ^2 + "1",
getConstVal(a$cav$Uncertainty, "uncertT1") ^2 + u,
getConstVal(a$cav$Uncertainty, "uncertRg") ^2 + paste(msg, " (k=1)"))
getConstVal(a$cav$Uncertainty, "uncertAds") ^2 +
getConstVal(a$cav$Uncertainty, "uncertVz") ^2 +
getConstVal(a$cav$Uncertainty, "uncertGas") ^2 +
getConstVal(a$cav$Uncertainty, "uncertAtm") ^2 +
getConstVal(a$cav$Uncertainty, "uncertValve") ^2 +
getConstVal(a$cav$Uncertainty, "uncertPres") ^2 +
getConstVal(a$cav$Uncertainty, "uncertRep") ^2 )
ccc$Calibration$Analysis$Values$Uncertainty <- ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty, setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
"uncertComb", "uncertTotal_abs",
"1", PCAL$Unit,
uc, u * pcal,
paste(msg, "u(k=1)")) paste(msg, " (k=1)"))
return(ccc) return(ccc)
} }
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment