cdga&b

cal/fm3.cdg_corr.r

@@ -6,15 +6,74 @@
 #' @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)
-                   
+    print(prefix)
+    print(i.dev)
     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])
+        }
+        print("öööööööööö")
+        print(p$fill[i.dev])
+        print(f)
+        print( 1. / (f + 1))
+        p$fill[i.dev] <- p$fill[i.dev] / (f + 1)
     }
     return(p)
 }

cal/fm3.conductance.r

@@ -10,7 +10,7 @@ fm3.conductance <- function(doc){
     fname  <- deparse(match.call()[[1]])
     msg    <- paste("calculated by", fname)
 
-    c.B    <- 0.2 ## Grenze Korrelation SZ
+    c.B    <- 0.99 ## Grenze Korrelation SZ
     d.B    <- 0.85 ## Grenze Korrelation Drift
 
     t2mm   <- getConstVal(a$cs, "turn_2_mm")
@@ -93,7 +93,7 @@ fm3.conductance <- function(doc){
             ## 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]
+            #   dVdt <-  dVdt * dcorr[j]
             }
 
 

devel/ce3.r

@@ -27,10 +27,9 @@ 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"
-cdb$id     <- "cal-2019-ce3-kk-75041_0001"
-#cdb$DBName <- "vl_db"
-cdb$DBName <- "vl_db"
+cdb$id     <- "cal-2019-ce3-kk-75095_0001"
 
+cdb$DBName <- "vl_db"
 
 doc        <- cdbGetDoc(cdb)$res
 
@@ -99,7 +98,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

@@ -23,9 +23,10 @@ pUnit  <- "mbar"
 ## cdb$id <- "cal-2019-ce3-kk-75036_0002" ##
 ## cdb$id <- "cal-2019-ce3-kk-75037_0002" ## 
 ## cdb$id <- "cal-2019-ce3-kk-75012_0002" ##
-cdb$id <- "cal-2019-ce3-kk-75041_0002" ##
-sigma.F13 <- 1.11
-
+## cdb$id <- "cal-2019-ce3-kk-75041_0002" ##
+cdb$id <- "cal-2019-ce3-kk-75095_0002" ##
+sigma.F13 <- 1.099
+ind.conv <- 1.33322
 doc    <- cdbGetDoc(cdb)$res
 doc    <- refreshAnalysis(doc)
 doc    <- refreshResult(doc)
@@ -40,8 +41,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")
@@ -66,13 +67,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"

utils/results.r

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