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

cal/ce3.extrapC.R

@@ -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=""))

devel/calYampCe3.R

@@ -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)
 

uncert/ce3.uncertTotal.R

@@ -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)
   

uncert/cuco.uncertEmis.R

+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)
+}

uncert/cuco.uncertExpSd.R

@@ -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,

uncert/cuco.uncertGasPurity.R

@@ -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,

uncert/cuco.uncertPind.R

@@ -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")

uncert/cuco.uncertSync.R

@@ -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)
 }

utils/calSens.R

@@ -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 )
 }

utils/dispatchResCal.R

 dispatchResCal <- function(ccc){
     a <- abbrevList(ccc)
+
+   
     if(length(a$cp) > 0){
         if(length(a$cpt) > 0){