implement MultiProcess. and bug fix in color flow match when num of c…

…olored particle is zero
hep-platform · Jul 23, 2013 · 58ac841 · 58ac841
1 parent 8550ff1
commit 58ac841
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 12 deletions.
diff --git a/lib/HEP/Automation/EventChain/Driver.hs b/lib/HEP/Automation/EventChain/Driver.hs
@@ -30,6 +30,7 @@ import qualified Data.Conduit.Util.Control as CU
 import           Data.Conduit.Zlib
 import qualified Data.Traversable as T
 import qualified Data.HashMap.Lazy as HM
+import qualified Data.Map as M
 import           Data.Maybe 
 import           System.Directory 
 import           System.Posix.Env 
@@ -152,6 +153,11 @@ genPhase2 mdl sset pdir sp pset (numev, sn) = do
            runPYTHIA
            runPGS           
            runClean         
+         (_:_, RunPYTHIA8) -> do 
+           sanitizeLHE
+           runPYTHIA8
+           runPGS           
+           runClean         
          (_:_, NoPYTHIA) -> do 
            sanitizeLHE
        cleanHepFiles  
@@ -185,3 +191,18 @@ genPhase3 mdl sset pdir sp pset (numev, sn) wdavcfg =
         wsetup = wsetup' { ws_storage = 
                              WebDAVRemoteDir 
                                (pdRemoteDirBase pdir </> pdRemoteDirPrefix pdir ++ "_" ++ pname) }
+
+-- | 
+genMultiProcess :: (Model model) => model -> ScriptSetup -> MultiProc -> ModelParam model 
+                -> WebDAVConfig 
+                -> (String, NumOfEv, SetNum)  
+                -> IO ()
+genMultiProcess mdl ssetup mp param wdavcfg (pname,nev,sn) = do 
+  case M.lookup pname (mpMultiProcessParts mp) of 
+    Nothing -> return ()
+    Just sproc -> do 
+      let pdir = mpProcDir mp
+      genPhase1 mdl ssetup pdir sproc param (nev,sn)
+      genPhase2 mdl ssetup pdir sproc param (nev,sn)
+      genPhase3 mdl ssetup pdir sproc param (nev,sn) wdavcfg
+      return ()
diff --git a/lib/HEP/Automation/EventChain/LHEConn.hs b/lib/HEP/Automation/EventChain/LHEConn.hs
@@ -175,7 +175,9 @@ accumTotalEvent g =
               icols = filter (/= 0) (concatMap ((\x -> [fst x, snd x]) . icolup ) pinfos)
               maxid = maximum ptlids 
               maxicol = maximum icols
-              minicol = minimum icols 
+              minicol = minimum icols
+              deltaicol = if null icols then 0 else maxicol - minicol
+
           (stid,stcol,rmap,stmm) <- get
           let rpinfo = (snd . head . mlhev_incoming ) mev
           (change,coloffset,rmap1) <- maybe 
@@ -190,7 +192,7 @@ accumTotalEvent g =
               rmap3 = insertAll kro rmap2
               rmap4 = insertAll krm rmap3 
           put ( stid+maxid-1
-              , stcol+maxicol-minicol+1-coloffset 
+              , stcol+deltaicol+1-coloffset 
               , rmap4
               , stmm')
 

diff --git a/lib/HEP/Automation/EventChain/Match.hs b/lib/HEP/Automation/EventChain/Match.hs
@@ -53,15 +53,15 @@ matchOr msg m xs = msum' (msg ++ ": no match in matchOr with " ++ show xs) (map
 actT :: (Functor m, Monad m) => InOutDir -> (ParticleID,[PDGID]) -> MatchM m (ParticleID,PtlInfo) 
 actT dir (pid,ids) = (pid,) <$> matchOr "actT" (match1 dir) ids
 
---  msum' "no match in actT" (map (match1 dir) ids)
 
 -- |
 actD :: (Functor m, Monad m, Show p) => InOutDir -> PtlProcPDG p -> MatchM m (ParticleID,(p,PtlInfo))
-actD dir PtlProcPDG {..} = (ptl_ptlid,) <$> matchOr "actD" m ptl_procs
+actD dir PtlProcPDG {..} = do
+    st <- get 
+    (ptl_ptlid,) <$> matchOr ("actD:" ++ show st ++ ":") m ptl_procs
   where m proc = (proc_procid proc,) <$> match1 dir (proc_pdgid proc) 
 
 
--- msum' "no match in actD" (map m ptl_procs)
 
 -- |
 checkD :: (Functor m, Monad m, Show p) => InOutDir -> DecayID p 

diff --git a/lib/HEP/Automation/EventChain/Type/MultiProcess.hs b/lib/HEP/Automation/EventChain/Type/MultiProcess.hs
@@ -17,19 +17,23 @@ module HEP.Automation.EventChain.Type.MultiProcess
 , SetNum (..)
 , SingleProc(..)
 , ProcDir(..)
-, MultiProc (..) 
+, MultiProc 
+, mpProcDir
+, mpMultiProcessParts
+, mkMultiProc
 ) where
-
+
+import Control.Applicative ((<$>),(<*>)) 
 import qualified Data.Map as M
 -- 
 import HEP.Automation.MadGraph.SetupType 
 --
 import HEP.Automation.EventChain.Type.Spec
 import HEP.Automation.EventChain.Type.Process
 
-newtype NumOfEv = NumOfEv { unNumOfEv :: Int }
+newtype NumOfEv = NumOfEv { unNumOfEv :: Int } deriving (Show)
 
-newtype SetNum = SetNum { unSetNum :: Int } 
+newtype SetNum = SetNum { unSetNum :: Int } deriving (Show)
 
 data SingleProc = SingleProc { spName :: String 
                              , spCross :: DCross 
@@ -41,11 +45,16 @@ data ProcDir = ProcDir { pdWorkDirPrefix :: String
                        , pdRemoteDirBase :: FilePath 
                        , pdRemoteDirPrefix :: String 
                        }
-data MultiProc = MultiProc { mpName :: String 
-                           , mpProcDir :: ProcDir 
-                           , mpMultiProcessMap :: M.Map String SingleProc 
+
+data MultiProc = MultiProc { mpProcDir :: ProcDir 
+                           , mpMultiProcessParts :: M.Map String SingleProc 
                            }
 
+mkMultiProc :: ProcDir -> [SingleProc] -> MultiProc 
+mkMultiProc pdir sprocs = let lst = map ((,) <$> spName <*> id) sprocs
+                          in MultiProc pdir (M.fromList lst) 
+
+
 {-
 mkSingleProc :: String -> DCross -> ProcSpecMap -> (NumOfEv -> SetNum -> RunSetup) -> SingleProc
 mkSingleProc n c m r = MultiProcPart n c (mkCrossIDIdx (mkDICross c)) m r