INTEGER FUNCTION DCGEOM_ARGUS(SOURCE,KEY14,RTKEY)
$$IMPLICIT
INTEGER SOURCE,KEY14,RTKEY
C----------------------------------------------------------------------
C-
C- Purpose and Methods : Drift Chamber constants initialisation
C- for all ARGUS algorythms
C- Only stereo layers
C-
C- Created 1-NOV-1992 Alexander Andryakov
C-
C----------------------------------------------------------------------
$$INCLUDE 'RTDB$LIBRARY:GEOBNK.INC'
$$INCLUDE 'K$INC:ERLEVL.INC'
$$INCLUDE 'K$INC:JOBSTA.INC'
$$INCLUDE 'K$ITRK:CTIDRI.INC'
C
C External Functions:-
C ====================
INTEGER GTDBVA
C
C Local Declarations:-
C ====================
C
REAL btidra,btiddp,btidst,btidsc,bcell_size
DIMENSION
& btidra(nlayero),btiddp(nlayero),btidst(nlayero),btidsc(nlayero)
+ ,bcell_size(NLAYERO)
C
REAL DENSEP,DENSAL,DENSBE,XBE1
REAL DEPXY,EPXYI,XREPXY,DAL,ALI,XRAL,DFE,FEI,XRFE
REAL DCU,CUI,XRCU,DAG,AGI,XRAG,DPBO,PBOI,XRPBO
REAL DBE,BEI,XRBE
EQUIVALENCE
+(TIDEVX(1,1),DEPXY),(TIDEVX(2,1),EPXYI),(TIDEVX(3,1),XREPXY),
+(TIDEVX(1,2),DAL), (TIDEVX(2,2),ALI), (TIDEVX(3,2),XRAL),
+(TIDEVX(1,3),DFE), (TIDEVX(2,3),FEI), (TIDEVX(3,3),XRFE),
+(TIDEVX(1,4),DCU), (TIDEVX(2,4),CUI), (TIDEVX(3,4),XRCU),
+(TIDEVX(1,5),DAG), (TIDEVX(2,5),AGI), (TIDEVX(3,5),XRAG),
+(TIDEVX(1,6),DPBO), (TIDEVX(2,6),PBOI), (TIDEVX(3,6),XRPBO),
+(TIDEVX(1,7),DBE), (TIDEVX(2,7),BEI), (TIDEVX(3,7),XRBE)
REAL RMN1,RMN2,XEPXY1,XFE1,XAG1,XAL1
REAL XEPXY2,XAL2,XCU2,XPBO2,XBE2
EQUIVALENCE
+(TIRGVX( 1),RMN1),(TIRGVX( 2),RMN2),(TIRGVX( 3),XEPXY1),
+(TIRGVX( 4),XFE1),(TIRGVX( 5),XAG1),(TIRGVX( 6),XAL1),
+(TIRGVX( 7),XEPXY2),(TIRGVX( 8),XAL2),(TIRGVX( 9),XCU2),
+(TIRGVX(10),XPBO2),(TIRGVX(11),XBE2)
C
INTEGER ISL,STATUS,NPLTOT
INTEGER NBMAX,NBVA
INTEGER II,ADDR,NIL,LAYERTYPE
REAL VALUES(600)
REAL Acf,Zcf,X0cf,RHOcf
REAL Abe,Zbe,X0be,RHObe
REAL THCHWI,THBP
C
CHARACTER IDXID*2 /'GE'/
CHARACTER BNKNA*4
C
DCGEOM_ARGUS = 0
C
C GEOMETRY DESCRIPTION
C-
C- Drift chamber Generic Geometry Informations bank
C-
BNKNA = 'DGGI'
VERNUM = 0 ! THIS IS A VERSION NUMBER
NBMAX = DGGTKE ! LAST PARAMETER ( = BANK SIZE)
STATUS = GTDBVA(IDXID,SOURCE,VERNUM,NRUN,RTKEY,BNKNA,
. NBMAX,VALUES,NBVA)
IF (STATUS.EQ.0) THEN
ZMAX = VALUES(DGGLHE) + VALUES(DGGLOF)
RMN1 = VALUES(DGGDRI) ! 25. cm chamber inner wall radius
THCHWI = VALUES(DGGTHI) ! 0.07 cm " thick
ELSE
CALL ERLOGR('DCGEOM',ERWARN,0,
& STATUS, 'failure calling GTDBVA for bank DGGI')
DCGEOM_ARGUS = STATUS
RETURN
ENDIF
C-
C- Beam Pipe Description bank
C-
BNKNA = 'BPDE'
VERNUM = 0 ! THIS IS A VERSION NUMBER
NBMAX = 35
STATUS = GTDBVA(IDXID,SOURCE,VERNUM,NRUN,RTKEY,BNKNA,
. NBMAX,VALUES,NBVA)
IF (STATUS.EQ.0) THEN
RMN2 = VALUES(BPDIRS) ! 10. cm pipe inner wall radius
THBP = VALUES(BPDBTH) ! 0.05 cm " thick.
ELSE
CALL ERLOGR('DCGEOM',ERWARN,0,
& STATUS, 'failure calling GTDBVA for bank BPDE')
DCGEOM_ARGUS = STATUS
RETURN
ENDIF
C-
C- Stereo layers (radii and stereo angles) from the
C- Drift Chamber Layer Description bank
C-
BNKNA = 'DCLD'
VERNUM = 0 ! THIS IS A VERSION NUMBER
NBMAX = 599 ! 4 + 5 INFOS/LAYER * 119 LAYERS
STATUS = GTDBVA(IDXID,SOURCE,VERNUM,NRUN,RTKEY,BNKNA,
. NBMAX,VALUES,NBVA)
IF (STATUS.EQ.0) THEN
ADDR = VALUES(DCLHDS)
NPLTOT = VALUES(DCLNBL)
NIL = VALUES(DCLNIL)
C
NLAYER = 0
DO II = 1,NPLTOT
C
C If this is a layer of sense wires, fill the ARGUS common
LAYERTYPE = VALUES(ADDR+DCLLTY)
IF (LAYERTYPE .EQ. 2) THEN
NLAYER = NLAYER+1
IF (NLAYER.LE.12) THEN
CELL_SIZE(NLAYER) = 2.
ELSE
CELL_SIZE(NLAYER) = 3.
ENDIF
TIDRA(NLAYER) = VALUES(ADDR+DCLLRD)
TIDST(NLAYER) = VALUES(ADDR+DCLSAT)
TIDSC(NLAYER) = SQRT(1.-TIDST(NLAYER)*TIDST(NLAYER))
TIDDP(NLAYER) = 2.*VALUES(ADDR+DCLDPH)
ENDIF
ADDR = ADDR + NIL
ENDDO
ELSE
CALL ERLOGR('DCGEOM',ERWARN,0,
& STATUS, 'failure calling GTDBVA for bank DCLD')
DCGEOM_ARGUS = STATUS
RETURN
ENDIF
c
c Transformation to inverse order (necessary for p.r. and track fit)
c
DO ISL=1,NLAYER
BTIDRA(ISL)=TIDRA(ISL)
BTIDDP(ISL)=TIDDP(ISL)
BTIDST(ISL)=TIDST(ISL)
BTIDSC(ISL)=TIDSC(ISL)
BCELL_SIZE(ISL)=CELL_SIZE(ISL)
ENDDO
DO ISL=1,NLAYER
TIDRA(NLAYER-ISL+1)=BTIDRA(ISL)
TIDDP(NLAYER-ISL+1)=BTIDDP(ISL)
TIDST(NLAYER-ISL+1)=BTIDST(ISL)
TIDSC(NLAYER-ISL+1)=BTIDSC(ISL)
CELL_SIZE(NLAYER-ISL+1)=BCELL_SIZE(ISL)
ENDDO
C
C MATERIAL DESCRIPTION
C-
C- Average radiation length (Gas+Wires) SHOULD BE TAKEN FROM DB
C-
TIDRL(2)=140000.
TIDRL(1)=83700. ! GAS+WIRE
C-
C- THE FOLLOWING VARIABLES ARE DEFINED BUT FOR THE CORRESPONDING MATERIAL
C THE ENERGY LOSS IS NOT COMPUTED (CORRESPINDING THICK. ARE SET TO 0)
C THEY WILL DISAPPEAR WHEN THE ARGVTX CODE WILL BE CEANED UP
DEPXY = 1.566E-4
EPXYI = 13103.
XREPXY= 42.00
DFE = 1.429E-4
FEI = 3573.
XRFE = 13.84
DCU = 1.401E-4
CUI = 3174.
XRCU = 12.86
DAG = 1.338E-4
AGI = 2174.
XRAG = 8.97
DPBO = 1.245E-4
PBOI = 1354.
XRPBO = 6.89
DENSEP = 1.57
C MATERIAL DESCRI. FOR CHAMBER WALL AND PIPE.
C ENERGY LOSS IS COMPUTED ACCORDIMG TO:
C DE/DEX=C1/BETA**2(LN{C2*(P/M)**2}-BETA**2)
C C1=4*PI*N_a*M_e*c**2*R_e**2*Z/A = 0.000307*Z/A [Gev g-1 cm**2]
C C2=2*M_e*c**2/I =62500./Z**.9 [adimensional]
C I = 16*10**6/Z**.9 [Gev]
C DAL,ALI,XRAL = C1,C2, X0 [g cm-2] for chamber wall (carbon fiber)
C DBE,ABE,XRBE same for beam pipe (berilium)
C The A,Z,XO[cm],RHO[g/cm**3] should be taken from DB. For the moment we put here the values
C untill the DB will be filled with the material constants)
Acf = 11.907
Zcf = 5.965
X0cf = 26.8
RHOcf = 1.57
Abe = 9.01
Zbe = 4.0
X0be = 35.3
RHObe = 1.848
C
DAL = 0.000307*(Zcf/Acf)
ALI = 62500./Zcf**.9
XRAL = X0cf*RHOcf
DBE = 0.000307*(Zbe/Abe)
BEI = 62500./Zbe**.9
XRBE = X0be*RHObe
C-
DENSAL = RHOcf
DENSBE = RHObe
C-
C- thicknesses (in g/cm**2) of chamber and tube walls.
C-
C the followin are set to 0 (it it a trick to ignore the material, see previous
c comment)
XFE1 =0.
XAG1 =0.
XEPXY1=0.
XEPXY2=0.
XCU2 =0.
XPBO2=0.
C- thicknesses (in g/cm**2) of chamber and tube walls.
XAL1 =THCHWI*DENSAL ! Thck of that material (cf) at rmn1 (inner chamber wall)
XAL2 =0. ! Thck of that material (cf) at rmn2 (beam pipe wall)
XBE1 =0. ! Thck of that material (Be) at rmn1 (inner chamber wall)
XBE2 =THBP*DENSBE ! Thck of that material (Be) at rmn2 (beam pipe wall)
WRITE(6,*)RMN1,THCHWI,RMN2,THBP
WRITE(6,*)DAL,ALI,XRAL,DENSAL,XAL1
WRITE(6,*)DBE,BEI,XRBE,DENSBE,XBE2
C
RETURN
END
[KLOE]
[Offline Doc]
[TRK Files]
Generated with Light on Thu Apr 8 13:00:16 MET DST 1999
.
Mail comments and suggestions.
