* $Id: geometry.g,v 1.162 2007/11/07 21:25:41 perev Exp $ * $Log: geometry.g,v $ * Revision 1.162 2007/11/07 21:25:41 perev * btofgeo6 added by X.Dong * * *************************************************************************** module geometry is the main steering module for the STAR geometry author Pavel Nevski Created August 1998 * * * Update history: * * 08/19/98, PN: tof is not part of year_2a * * 12/04/98, PN: RICH + upstream part + zero degree calo * * 09/26/99, E.Cains: 1H geometry added - one svt ladder at layer 3 * * 01/27/99, PN: RICH in 1H geometry is simulated with hits is quartz & fr* * 05/22/01, PN: starting with tag y2000 field is version 3 (direct map) * * 09/30/03, MP: see the many new CVS comments about recent check-ins * * 09/30/03, MP: converted the sub into a MODULE to allow for ZEBRA access* *************************************************************************** Structure GDAT {real mfscale, char gtag(2)} * list of system on/off switches: Logical CAVE,PIPE,SVTT,SISD,TPCE,FTPC, BTOF,VPDD,MAGP,CALB,ECAL,UPST, RICH,ZCAL,MFLD,BBCM,FPDM,PHMD, PIXL,ISTB,GEMB,FSTD,FTRO,FGTD, SHLD,QUAD,MUTD,IGTD,HPDT,ITSP, DUMM,SCON * Qualifiers: TPC TOF etc Logical mwc,pse,ems,svtw, on/.true./,off/.false./ * Codes: * 1 - full ctb, 2 - full TOFp based tof, 3 - partial TOFp based tof, * 4 - single TOFp tray, 5 - one TOFp and one TOFr, 6 - full TOFr based tof. * X.Dong - global parameters for TOF trays real tofX0, tofZ0 real Par(1000),field,dcay(5),shift(2),wdm Integer LENOCC,LL,IPRIN,Nsi,NsiMin,i,j,l,kgeom,nmod(2),nonf(3), ecal_config, ecal_fill, sisd_level, Nleft,Mleft,Rv,Rp,Wfr,Itof,mwx,mf ***************** historical note: *********************8 * CorrNum allows us to control incremental bug fixes in a more * organized manner -- ! Obsoleted 20050324 maxim! -- * The following are the versioning flags: Integer DensConfig, SvttConfig, BtofConfig, VpddConfig, FpdmConfig, SisdConfig, PipeConfig, CalbConfig, PixlConfig, IstbConfig, GembConfig, FstdConfig, FtroConfig, ConeConfig, FgtdConfig, TpceConfig, PhmdConfig, SvshConfig, SupoConfig, FtpcConfig, CaveConfig, ShldConfig, QuadConfig, MutdConfig, HpdtConfig, IgtdConfig * DensConfig, ! TPC gas density correction * SvttConfig, ! SVTT version * BtofConfig, ! BTOF trays * VpddConfig, ! VPDD * FpdmConfig, ! Forfward Pion Mult detectoe * SisdConfig, ! SSD * PipeConfig, ! Beam Pipe * CalbConfig, ! Barrel EMC * PixlConfig, ! Inner Pixel detector * HpdtConfig, ! Heavy Flavor Tracker * IstbConfig, ! Integrated Silicon Tracker * GembConfig, ! Inner GEM barrel tracker * IgtdConfig, ! GEM disks * FstdConfig, ! Forward Silicon tracker Disks * FtroConfig, ! FTPC Readout Electronics * ConeConfig, ! SVTT support cones and cables * FgtdConfig, ! Forward GEM tracker * TpceConfig, ! TPC * PhmdConfig ! Photon Multiplicity Detector * SvshConfig ! SVT Shield * SupoConfig ! FTPC support * FtpcConfig ! FTPC * ShldConfig ! Beam shield * QuadConfig ! All magnets from D0 and up * MutdConfig ! Muon Trigger System * Note that SisdConfig can take values in the tens, for example 20 * We do this to not proliferate additional version flags -- there has * been a correction which resulted in new code.. We check the value * and divide by 10 if necessary. character Commands*4000,Geom*8 * - - - - - - - - - - - - - - - - - +CDE,GCBANK,GCUNIT,GCPHYS,GCCUTS,GCFLAG,AGCKINE,QUEST. * temporarely until GCTLIT is not part of GCTMED: Integer Thrind ,Jmin,ItCkov,ImCkov,NpCkov common/GCTLIT/ Thrind(4),Jmin,ItCkov,ImCkov,NpCkov * - - - - - - - - - - - - - - - - - replace[;ON#{#;] with [ IF Index(Commands,'#1')>0 { j=Index(Commands,'#1'); l=j+Lenocc('#1')-1; if (Commands(j:j+3)=='YEAR') Geom=Commands(j:l); if (Commands(j:j) =='Y') Geom=Commands(j:l); Commands(j:l)=' '; ; (' #1: #2'); ] * If geometry was already built, the local DB will be dropped completely now * but the request for the next geometry should be saved in a temp. par arrray call ASLGETBA ('GEOM','DETP',1000,LL,Par) If (JVOLUM>0) call AGDROP ('*') * -------------------- set GSTAR absolute default ------------------------ * before parsing the request, set some default values: IPRIN = IDEBUG NtrSubEv = 1000 " automatic !" BtofConfig = 1 ! ctb only CalbConfig = 0 ! really make use of it starting in y2004 CaveConfig = 1 ! custom for shielding studies=2, wider for muon detector=3, and longer=4 ConeConfig = 1 ! 1 (def) old version, 2=more copper DensConfig = 0 ! gas density correction FgtdConfig = 1 ! version FpdmConfig = 0 ! 0 means the original source code FstdConfig = 0 ! 0=no, >1=version FtroConfig = 0 ! 0=no, >1=version FtpcConfig = 0 ! 0 version, 1=gas correction HpdtConfig = 0 ! 0=no, >1=version IstbConfig = 0 ! 0=no, >1=version IgtdConfig = 1 ! 1=old radii etc, 2=new ones GembConfig = 0 ! 0=no, >1=version MutdConfig = 0 ! same PhmdConfig = 0 ! No Photon multiplicity detectorby default PipeConfig = 2 ! Default, Be pipe used in most of the runs =<2003 PixlConfig = 0 ! 0=no, 1=inside the SVT, 2=inside CAVE, 3=with pipe support QuadConfig = 0 ! No D0 and quads by default ShldConfig = 0 ! No Beam Shield by default SisdConfig = 0 ! No Silicon strip by default SupoConfig = 0 ! 0 (def) old buggy version, 1=correction SvshConfig = 0 ! SVTT shield version SvttConfig = 0 ! SVTT version TpceConfig = 1 ! 1 (def) old version, 2=more structures in the backplane VpddConfig = 1 ! vpd... * Set only flags for the main configuration (everthing on, except for tof), * but no actual parameters (CUTS,Processes,MODES) are set or modified here. * If an empty or no DETP GEOM was issued, geometry is defined externally. field=5 " default" * "Canonical" detectors are all ON by default, {CAVE,PIPE,SVTT,TPCE,FTPC,BTOF,VPDD,CALB,ECAL,MAGP,MFLD,UPST,ZCAL} = off; * whereas some newer stuff is considered optional: {BBCM,FPDM,PHMD,PIXL,ISTB,GEMB,FSTD,SISD,FTRO,FGTD,SHLD,QUAD,MUTD,IGTD,HPDT,ITSP,DUMM,SCON} = off; {mwc,pse}=on " MultiWire Chambers, pseudopadrows " {ems,RICH}=off " TimeOfFlight, EM calorimeter Sector " Nsi=7; Wfr=0; Wdm=0; " SVT+SSD, wafer number and width as in code " NsiMin=1; " the innermost layer of SVT " svtw=on " water+water manifold in svt, off for Y2000 only" mwx=2 " for Year_1? mwx=1 limites x in mwc hits (1 { Call AGSFLAG ('GEOM',1) * convert input line into a string of upprecase characters CALL UHTOC(PAR(2),4,Commands,LL*4-4); Call CLTOU(Commands); * set geant processes and cuts only if any detp geometry was issued: {CUTGAM,CUTELE,CUTNEU,CUTHAD,CUTMUO,BCUTE,BCUTM,DCUTE,DCUTM,PPCUTM} =.001; {IDCAY,IANNI,IBREM,ICOMP,IHADR,IMUNU,IPAIR,IPHOT,ILOSS,IDRAY,IMULS} = 1; {IRAYL,ISTRA} = 0; TOFMAX = 1.e-4 * for(j=1;j>0;) { j=0; on HELP { you may select the following keywords: ; ;('---------------:----------------------------- '); ;('Configurations : complete,tpc_only,field_only '); ;(' : year_2a '); ;(' : year2000, year2001,year2002 '); ;(' : year2003, y2003a '); ;('Gcalor : Gcalor_on, Gcalor_off '); ;('Geant Physics : Hadr_on, Hadr_off '); ;('Geant Physics : Phys_off, Decay_Only '); ;('Geometry Detail: mwc_off, pse_off, 4th_off '); ;('Magnetic Field : Field_on/off, field=value '); ;('Auxillary keys : Debug_on/off, Split_on/off '); ;('--------------------------------------------- '); ;('Default: complete STAR with hadr_on,auto-split'); ;('--------------------------------------------- '); } **************************************************************************************** on SANDBOX { New Tracking: SandBox Gerrit "Everything OFF, unless stated otherwise" {CAVE,PIPE,SVTT,TPCE,FTPC,BTOF,VPDD,CALB,ECAL,MAGP,MFLD,UPST,ZCAL} = off; {BBCM,FPDM,PHMD,PIXL,ISTB,GEMB,FSTD,SISD,FTRO,FGTD,SHLD,QUAD,MUTD,IGTD,HPDT,ITSP,DUMM,SCON} = off; "CAVE: long cave" CAVE=on; CaveConfig=4; "SVT: gone" SVTT=off; "FTPC: gone" ftpc=off; "tpc: standard" TPCE=off; mwc=on " Multiwire chambers are read-out "; pse=on " inner sector has pseudo padrows "; "ctb: central trigger barrel "; Itof=2 " call btofgeo2 "; BtofConfig=5; "CALB" ems=on nmod={60,60}; shift={75,105}; " 60 sectors on both sides" "ECAL" ecal_config=1 " west wheel " ecal_fill=3 " all sectors filled " "beam-beam counter " BBCM=off; "forward pion detector " FPDM=off; "field version " MFLD=on; Mf=4; "tabulated field, with correction " "dunno" SvshConfig = 0; "SVT shield" DensConfig = 1; "gas density correction" SupoConfig = 1; "FTPC Support" SvttConfig = 0; "Photon Multiplicity Detector Version " PHMD=off; PhmdConfig = 1; "Silicon Strip Detector Version " SISD=off; SisdConfig = 65; "Beam pipe" PIPE=off; pipeConfig=4; "Active PIXEL detector" PIXL=off; PixlConfig=5; " newest version, thicker active Si" "Inner Silicon Tracker" ISTB=on; IstbConfig=0; "Forward Silicon Tracker: gone" FSTD=off; FstdConfig=0; "Forward GEM Tracker" FGTD=off; FgtdConfig=2; "Support cone: disabled" ITSP=off; } **************************************************************************************** on HADR_ON { all Geant Physics On; } on HADR_OFF { all Geant Physics on, except for hadronic interactions; IHADR=0} on GCALOR_ON { setting hadr 6 to activate hadronic showers; IHADR=6;} on PHYS_OFF { No Physics: only energy loss; {IDCAY,IANNI,IBREM,ICOMP,IHADR,IMUNU,IPAIR,IPHOT,IDRAY,IMULS}=0; Iloss=2} on DECAY_ONLY { Some Physics: decays, mult.scat and energy loss; {IANNI,IBREM,ICOMP,IHADR,IMUNU,IPAIR,IPHOT,IDRAY}=0; Iloss=2} on NO_BREM { No bremmstrahlung; IBREM=0;} on LOW_EM { Low cuts on ElectroMagnetic processes; CUTGAM=0.00001; CUTELE=0.00001; BCUTE =0.00001; BCUTM =0.00001; DCUTE =0.00001; DCUTM =0.00001; } on TPC_ONLY { Minimal geometry - only TPC; {PIPE,SVTT,ftpc,BTOF,VPDD,CALB,ECAL,MAGP,UPST,ZCAL,PHMD,FPDM,BBCM,SISD,FTRO}=off; } on TPC_AND_SVTT { Only TPC and SVT; {PIPE,ftpc,BTOF,VPDD,CALB,ECAL,MAGP,UPST,ZCAL,PHMD,FPDM,BBCM,FTRO}=off; } on SVTT_ON { Optional SVTT added on top of the minimal geo; SVTT=on; } on SVTT_OFF { Optionally remove the SVTT; SVTT=off; } on SISD_OFF { Optionally remove the SISD ssd; SISD=off; } on ONLY_SVTT { Only SVTT; {PIPE,TPCE,ftpc,BTOF,VPDD,CALB,ECAL,MAGP,UPST,ZCAL,PHMD,FPDM,BBCM,FTRO}=off; } * on PIPE_ON { Optional PIPE added on top of the minimal geo; PIPE=on; } on PIPE_OFF { Pipe optionally removed; PIPE=off; } * on FTPC_ON { Optional FTPC added on top of the minimal geo; ftpc=on; } on BTOF_ON { Optional BTOF added on top of the minimal geo; BTOF=on; } on ECAL_ON { Optional ECAL added on top of the minimal geo; ECAL=on; } on CALB_ON { Optional CALB added on top of the minimal geo; CALB=on; } on SHIELD_OFF { Can switch the shield off in the DEV geom; SHLD=off; } on PIXL_ON { Optional PIXL added on top of the minimal geo; PIXL=on; } on FIELD_ONLY { No geometry - only magnetic field; NtrSubEv=0; {CAVE,PIPE,SVTT,TPCE,ftpc,BTOF,VPDD,MAGP,CALB,ECAL,RICH,UPST,ZCAL}=off; } on FIELD_OFF { no magnetic field; field=0; } on FIELD_ON { Standard (5 KGs) field on; field=5; } i=Index(Commands,'FIELD=') if i>0 { j=i/4+3; field=Par(1+j); Commands(i:j*4)=' '; field; (' Modified field value =',F6.2,' KGS'); } on MWC_OFF { Trigger Multy-wire readout off; mwc=off; } on PSE_OFF { No TPC pseudo-padrow generated; pse=off; } on 4TH_OFF { SVT fourth layer off; Nsi=min(Nsi,6); } on SPLIT_OFF { events will not be split into subevents; NtrSubEv=0; } on SPLIT_ON { events will be split into subevents; NtrSubEv=1000; } on DEBUG_ON { verbose mode, some graphics; Idebug=max(Idebug,1); Itest=1; } on DEBUG_OFF { standard debug mode; {Idebug,Itest}=0; } } * sanity check - if something left in commands (unknown keyword), we stop! l=LENOCC(commands); if l>0 { print *,' Unknown command left => ', commands(1:l), ' <= ',l if (IPRIN==0) stop 'You better stop here to avoid problems' } } * -------------------- setup selected configuration ------------------------ * Now when all parameters and flags are ready, make gstar work as usually * ie put a MODE or/and DETP command and executing them for selected systems. * * - to save secondaries AFTER all decays: DETP TRAC DCAY 210 210 0.1 0.01 dcay={210,210,0.1,0.01} If LL>1 { call AgDETP new ('Trac'); call AgDETP add ('TracDCAY',dcay,4) } write(*,*) '****** ATTENTION ACHTUNG ATTENZIONE VNIMANIE UVAGA WEI ******' write(*,*) '******* THESE FLAGS ARE USED TO GENERATE THE GEOMETRY *******' write(*,*) ' BtofConfig: ',BtofConfig write(*,*) ' CaveConfig: ',CaveConfig write(*,*) ' CalbConfig: ',CalbConfig write(*,*) ' ConeConfig: ',ConeConfig write(*,*) ' DensConfig: ',DensConfig write(*,*) ' FgtdConfig: ',FgtdConfig write(*,*) ' FpdmConfig: ',FpdmConfig write(*,*) ' FstdConfig: ',FstdConfig write(*,*) ' FtpcConfig: ',FtpcConfig write(*,*) ' FtroConfig: ',FtroConfig write(*,*) ' HpdtConfig: ',HpdtConfig write(*,*) ' IstbConfig: ',IstbConfig write(*,*) ' MutdConfig: ',MutdConfig write(*,*) ' GembConfig: ',GembConfig write(*,*) ' PhmdConfig: ',PhmdConfig write(*,*) ' PipeConfig: ',PipeConfig write(*,*) ' PixlConfig: ',PixlConfig write(*,*) ' SvshConfig: ',SvshConfig write(*,*) ' SisdConfig: ',SisdConfig write(*,*) ' SupoConfig: ',SupoConfig write(*,*) ' SvttConfig: ',SvttConfig write(*,*) ' TpceConfig: ',TpceConfig write(*,*) ' VpddConfig: ',VpddConfig write(*,*) '***** FOR EXPERTS ONLY: LOOK UP GEOMETRY.G FOR DETAIL *******' if (RICH) ItCKOV = 1 if (CAVE) then call AgDETP new ('CAVE') call AgDETP add ('CVCF.config=',CaveConfig,1) call cavegeo endif * Pipe: If (LL>1) call AgDETP new ('PIPE') call AgDETP add ('pipv.pipeConfig=',pipeConfig,1); if (PIPE) Call pipegeo * Upstream (DX), shield, and D0+Q1+Q2+Q3 if (UPST) Call upstgeo if (SHLD) Call shldgeo if (QUAD) Call quadgeo * --- Call AGSFLAG('SIMU',2) * - to switch off the fourth svt layer: DETP SVTT SVTG.nlayer=6 If (LL>1 & SVTT) then call AgDETP new ('SVTT') if (Nsi < 7) call AgDETP add ('svtg.nlayer=', Nsi,1) if (NsiMin > 1) call AgDETP add ('svtg.nmin=', NsiMin,1) if (pipeConfig >= 4) call AgDETP add ('svtg.ifMany=', 1,1) if (Wfr > 0) call AgDETP add ('svtl(3).nwafer=',wfr,1) if (wdm > 0) call AgDETP add ('swca.WaferWid=', wdm,1) if (wdm > 0) call AgDETP add ('swca.WaferLen=', wdm,1) if (.not.svtw) call AgDETP add ('swam.Len=', 0, 1) endif ****************************************************************** * Take care of the correction level and call the appropriate constructor: if(SVTT .or. SCON) then * This applies to the newer versions of the svt code: * we can now switch to a better description of the cone * material (copper cables) thanks to a new measurement by * Dave Lynn call AgDETP add ('svtg.ConeVer=',ConeConfig ,1) ! could have more copper on the cone * Optionally, switch to a larger inner shield, AND smaller beampipe support if(SvshConfig==1) call AgDETP add ('svtg.SupportVer=',2 ,1) * Or, pick a shield that is slighly bigger outside according to Lilian's observation if(SvshConfig==2) call AgDETP add ('svtg.SupportVer=',3 ,1) if (SVTT) then * Ugly, but I don't want to hash function pointers in Fortran: if(SvttConfig==0) call svttgeo if(SvttConfig==1) call svttgeo1 if(SvttConfig==2) call svttgeo2 if(SvttConfig==3) call svttgeo3 if(SvttConfig==4) call svttgeo4 if(SvttConfig==5) call svttgeo5 if(SvttConfig==6) call svttgeo6 if(SvttConfig==7) call svttgeo7 if(SvttConfig==9) call svttgeo9 if(SvttConfig==10) call svttgeo10 endif if (SCON) then call scongeo endif endif * Set the proper configuration of the Silicon Strip Detector * See note on top about using MOD(10) to encode the geometry * cut, as opposed to configuration of the detector: if(SISD) then sisd_level=0 call AgDETP new ('SISD') * if SVT is present, position the SSD in it, otherwise need to position in CAVE (default) if(SVTT) { call AgDETP add ('ssdp.Placement=',1 ,1) }; * In the following, level means the version of the ssd geo code to be loaded * It is the most important decimal place of the SisdConfig, and we just check * for it here: if (SisdConfig>10) then sisd_level=SisdConfig/10 SisdConfig=SisdConfig-sisd_level*10 call AgDETP add ('ssdp.Config=',SisdConfig ,1) if (sisd_level.eq.1) then call sisdgeo1 elseif (sisd_level.eq.2) then call sisdgeo2 elseif (sisd_level.eq.3) then call sisdgeo3 elseif (sisd_level.eq.4) then call sisdgeo4 elseif (sisd_level.eq.5) then call sisdgeo5 elseif (sisd_level.eq.6) then call sisdgeo6 else ! Unimplemented level write(*,*) '******************* ERROR IN PARSING THE SSD GEOMETRY LEVEL! ******************' if (IPRIN==0) stop 'You better stop here to avoid problems' endif else * The original version (pretty much obsolete) call AgDETP add ('ssdp.Config=',SisdConfig ,1) call sisdgeo endif * write(*,*) '*** Silicon Strip Detector Config and Code Level: ',SisdConfig, ' ',sisd_level endif * - MWC or pseudo padrows needed ? DETP TPCE TPCG(1).MWCread=0 TPRS(1).super=1 * CRAY does not accept construction: IF (mwc==off) ... I do it differntly: * - for year_1 X in mwc hits was limited, keep this (mwx=1) If (LL>1 & TPCE) then call AgDETP new ('TPCE') * Attention -- this line below was effectively moved into individual year 1 declarations: * If (Geom(1:2)='_1') mwx=1 * Since we don't need the GEOM variable anymore in this context, we use it differently: * to simply contains the whole geometry tag such as year_1S or y2003a If ( .not. mwc ) mwx=0 If ( mwx <2 ) call AgDETP add ('tpcg(1).MWCread=',mwx,1) If (.not.pse) call AgDETP add ('tprs(1).super=' , 1, 1) endif * Back in July 2003 Yuri has discovered the discrepancy * in the gas density. The patch for this is activated here: (was: if(CorrNum>=3) ) if(DensConfig>0) call AgDETP add ('tpcg.gasCorr=',2 ,1) write(*,*) 'TPC' if (TPCE.and.TpceConfig==1) Call tpcegeo if (TPCE.and.TpceConfig==2) Call tpcegeo1 if (TPCE.and.TpceConfig==3) Call tpcegeo2 write(*,*) 'FTPC' if (ftpc) then if(FtpcConfig==0) Call ftpcgeo if(FtpcConfig==1) Call ftpcgeo1 * and look at the support pieces, was: if(CorrNum==0) if(SupoConfig==0) Call supogeo if(SupoConfig==1) Call supogeo1 endif * FTPC readout electronics barrel if (FTRO) Call ftrogeo write(*,*) 'BTOF' * - tof system should be on (for year 2): DETP BTOF BTOG.choice=2 If (LL>1 & BTOF) then call AgDETP new ('BTOF') call AgDETP add ('btog.choice=',BtofConfig,1) * X.Dong if(Itof>5) then call AgDETP add ('btog.X0=',tofX0,1) call AgDETP add ('btog.Z0=',tofZ0,1) endif * X.Dong.end endif if(BTOF) then if(Itof.eq.1) write(*,*) '***** ATTENTION : OLD VERSION OF BTOF NOT IMPLEMENTED - NO TOF CREATED *****' if(Itof.eq.2) call btofgeo2 if(Itof.eq.4) call btofgeo4 if(Itof.eq.5) call btofgeo5 if(Itof.eq.6) call btofgeo6 !X.Dong endif Call AGSFLAG('SIMU',1) ********************* Vertex Position Detector ******************* If (LL>1 & VPDD) then call AgDETP new ('VPDD') call AgDETP add ('vpdv.vpdConfig=',VpddConfig,1); if(VpddConfig<7) call vpddgeo if(VpddConfig=7) call vpddgeo2 endif ********************** BARREL CALORIMETER ************************ * - Set up the parameters for the barrel calorimeter If (LL>1 & CALB) then call AgDETP new ('CALB') if (ems) call AgDETP add ('calg.nmodule=',Nmod, 2) if (ems) call AgDETP add ('calg.shift=', shift,2) endif if (CALB) then ! Pick the version: if(CalbConfig==0) then write(*,*) '************** Creating the 1996-2003 version of the Barrel Calorimeter' Call calbgeo endif if(CalbConfig==1) then write(*,*) '************** Creating the 2004-2006 version of the Barrel Calorimeter' Call calbgeo1 endif if(CalbConfig==2) then write(*,*) '************** Creating the 2007- version of the Barrel Calorimeter' Call calbgeo2 endif endif ****************************************************************** * - Set up the parameters for the RICH counter if (LL>1 & RICH) then call AgDETP new ('Rich') if (Rv>0) call AgDETP add ('Rich.Version=', Rv,1) if (Rp>0) call AgDETP add ('Rich.Position=',Rp,1) if (Rp>0) call AgDETP add ('Rich.Cversion=',Rp,1) endif if (RICH) Call richgeo ****************************************************************** * - Set up the parameters for the endcap calorimeter If (LL>1 & ECAL) then call AgDETP new ('ECAL') call AgDETP add ('emcg.OnOff=' ,ecal_config,1) call AgDETP add ('emcg.FillMode=',ecal_fill,1) endif ****************************************************************** * The rest of steering: if (ECAL) Call ecalgeo if (BBCM) Call bbcmgeo if (FPDM.and.FpdmConfig==0) Call fpdmgeo if (FPDM.and.FpdmConfig==1) Call fpdmgeo1 if (FPDM.and.FpdmConfig==2) Call fpdmgeo2 if (FPDM.and.FpdmConfig==3) Call fpdmgeo3 if (ZCAL) Call zcalgeo if (MAGP) Call magpgeo if (MUTD.and.MutdConfig==1) Call mutdgeo if (MUTD.and.MutdConfig==2) Call mutdgeo2 if (MUTD.and.MutdConfig==3) Call mutdgeo3 if (PIXL.and.PixlConfig==1) Call pixlgeo if (PIXL.and.PixlConfig==2) Call pixlgeo1 if (PIXL.and.PixlConfig==3) Call pixlgeo2 if (PIXL.and.PixlConfig==4) Call pixlgeo3 if (PIXL.and.PixlConfig==5) then call AgDETP new ('PIXL') call AgDETP add ('PXLV.LadVer=',2.0,1) call pixlgeo3 endif if (ISTB.and.IstbConfig==0) Call istbgeo00 if (ISTB.and.IstbConfig==1) Call istbgeo if (ISTB.and.IstbConfig==2) Call istbgeo1 if (ISTB.and.IstbConfig==3) Call istbgeo2 if (ISTB.and.IstbConfig==4) Call istbgeo3 if (ISTB.and.IstbConfig==5) Call istbgeo4 if (ISTB.and.IstbConfig==6) Call istbgeo5 if (ISTB.and.IstbConfig==7) Call istbgeo6 if (ISTB.and.IstbConfig==8) Call istbgeo8 if (ISTB.and.IstbConfig==10) Call istbgeo10 if (GEMB.and.GembConfig>0) Call gembgeo if (FSTD.and.FstdConfig>0) then if(FstdConfig==2) then call AgDETP new ('FSTD') call AgDETP add ('fstg.Rmax=',22.3,1) endif Call fstdgeo endif if (FGTD.and.FgtdConfig==1) then Call fgtdgeo ! old, decomissioned elseif(FGTD.and.FgtdConfig==2) then write(*,*) '****** constructing the new 6-disk Forward Gem Tracker geometry ***********' Call fgtdgeo1 endif if (IGTD) then if(IgtdConfig==2) then call AgDETP new ('IGTD') call AgDETP add ('igtv.Config=',IgtdConfig ,1) endif Call igtdgeo endif if (HPDT.and.HpdtConfig>0) Call hpdtgeo if (ITSP) Call itspgeo ****************************************************************** * If PHMD is present and a non-zero version of the Photon Multiplicity Detector * is defined, pass the version number to its constructor * and create it: if (PHMD.and.PhmdConfig>0) then call AgDETP new ('PHMD') call AgDETP add ('PMVR.Config=', PhmdConfig,1) call phmdgeo endif ******************************************************************** if(DUMM) then call dummgeo endif **************** Magnetic Field ******************************** * * - reset magnetic field value (default is 5): DETP MFLD MFLG.Bfield=5 If (LL>1) then call AgDETP new ('MFLD') if (MFLD & field!=5) call AgDETP add ('MFLG(1).Bfield=',field,1) if (MFLD & mf!=0) call AgDETP add ('MFLG(1).version=',mf,1) * if (MFLD & mf>=4) call AgDETP add ('MFLG(1).nrp=',200,1) * if (MFLD & mf>=4) call AgDETP add ('MFLG(1).nzp=',800,1) endif * if (MFLD) Call mfldgeo * if JVOLUM>0 { Call ggclos If IDEBUG>0 { CALL ICLRWK(0,1); Call GDRAWC('CAVE',1,.2,10.,10.,.03,.03)} } IDEBUG = IPRIN ITEST = min(IPRIN,1) Call agphysi * automatic subevent size selection If NtrSubev > 0 { Call MZNEED(IXDIV,1000,'G') NLEFT = max(10,IQUEST(11)/1200) MLEFT = 10**Int(Alog10(Float(Nleft))-1) NtrSubEv = MLEFT*(NLEFT/MLEFT) Prin1 NtrSubEv; (' Ntrack per subevent = ',i6) } * * -------------------- persist certain global parameters ------------------- Fill GDAT ! GEANT run data mfscale=field/5.0 ! magnetic field scale (nominal) gtag={geom(1:4),geom(5:8)} ! geometry tag EndFill * end