c $Id: svx_fvtx.f,v 1.1 2008/05/02 23:48:16 hubert Exp $ C File name: svx_fvtx.f ( was previously part of svx.f) C ------xxx---------- C C Original author: Hubert van Hecke, Dave Lee C Creation date: March, 2008 C C Purpose: Set up the Silicon Vertex Detector (FVTX) C C Revision History: code was lifted out of svx.f c *===================================================================================== SUBROUTINE svx_fvtx implicit none include 'gugeom.inc' ! contains irot, irotnull include 'gconst.inc' ! contains PI character*4 sil_name character*4 set_id /'SVX '/ ! Detector/hit set ID Integer nbitsv(7) /7*8/ ! Bits to pack vol. copy # Integer idtype /2001/ ! User def. detector type Integer nwpa /500/ ! Init. size of HITS banks Integer nwsa /500/ ! Init. size of DIGI banks integer iset, idet cxx INTEGER LNAM(6) cxx integer LNUM(6) /1,1,1,1,1,1/ Character*4 namesw(7) /'HALL','SIEN','SICG', & 'SIxx','SIPx','SISx','SSSx'/ integer sili_med_silicon /10/ ! Sensitive silicon nmed (nmat=50,Si) Integer sili_med_coldair /121/ ! Gas inside the SICG (cold air) integer sili_med_carbon /123/ ! carbon-carbon composite Integer sili_med_passive /26/ ! Ladder passive nmed (nmat=09,Al) integer sili_med_honeycomb /125/ ! 1/4" honeycomb, .5mm c-c skin, Al core c Hit component names character*4 inrNMSH(21) /'POSX','POSY','POSZ' ! Global positions & ,'DELE','TOFL' ! Energy loss & TOF & ,'P_ID','MOMX', 'MOMY', 'MOMZ' ! Particle ID & Entry mom. & ,'XILC','YILC','ZILC','XOLC','YOLC','ZOLC' ! Local entry & exit & ,'XIGL','YIGL','ZIGL','XOGL','YOGL','ZOGL'/ ! global entry & exit Integer nhh /21/ ! Number of hit components integer*4 inrNBITSH(21) /21*32/ ! Bits for packing the hits c Default setting of offsets and gains REAL inrORIG(21) /3*1000.,3*0.,3*1000.,6*1000.,6*1000./ ! offsets REAL inrFACT(21) /3*100000.,1.E7,1.e12,1.0,3*100000. & ,6*100000.,6*100000./ ! These gains give: c - 0.1 keV energy deposition resolution c - 0.0001 mm position resolution c - 0.01 MeV/c momentum resolution integer ivol1, ii, i, j, k, l, irx(48), irsh(12), istation, & irstation, icopy, irot1, irot2, wedges, nmed, idisk, ivolu character*4 wedge_name, support_name integer sili_endcap_layers /8/ ! 4 south, 4 north real stagger /0.0/ ! turn on endcap staggering in phi real stag_ang(12) /12*0.0/ ! small rotations of endcap planes real sili_endcap_z(8), panthk, rinner, routerb, routers, & support_thk, sens_off, chipwid, chiplen, chipthk, cstep, & dd, z_disk, stationzthick, deg, rad, alpha, beta, & pangle, wedge_thk, par(15), par_sisi_b(4), par_sisi_s(4), & par_s1(4), parb(4), pars(4), bwedge_lowx, bwedge_highx, & bwedge_len, swedge_lowx, swedge_highx, swedge_len, & bsil_lowx, bsil_highx, bsil_len, ssil_lowx, ssil_highx, & ssil_len, back_planthk, hdithk, silthk integer itf_lun ! phnx(Sili).par logical unit common /interface/itf_lun ! in pisa core; namelist is read namelist /sili_endcap_par/ ! from there. & sili_endcap_layers, sili_endcap_z, panthk, stagger, wedges, & bwedge_lowx, bwedge_highx, bwedge_len, & swedge_lowx, swedge_highx, swedge_len, & bsil_lowx, bsil_highx, bsil_len, & ssil_lowx, ssil_highx, ssil_len, & back_planthk, hdithk, silthk, chiplen, chipwid, chipthk, & rinner, support_thk *========================================================================================================================= rewind( unit = itf_lun ) read( itf_lun, nml = sili_endcap_par, err = 996 ) write (6,*)' SVX_FVTX.F:: installing endcaps' deg = 2*PI/360 ! To convert degrees into radians rad = 360/(2*PI) ! To convert radians into degrees pangle = (360/wedges) ! The total angle of each carbon panel if (stagger.gt.0) then stag_ang( 5) = 0. ! staggering angle in +phi direction stag_ang( 6) = 0.9375 ! 1x 360 / 96 / 4 stag_ang( 7) = 1.8750 ! 2x stag_ang( 8) = 2.8125 ! 3x stagger >0 PATTERN: stag_ang( 9) = 0. ! 0x (1 2 3 4 - 1 2 3 4) stag_ang(10) = 0.9735 ! 1x stag_ang(11) = 1.8750 ! 2x stag_ang(12) = 2.8125 ! 3x elseif(stagger.lt.0) then stag_ang( 8) = 0. ! staggering angle in +phi direction stag_ang( 6) = 0.9375 ! 1x 360 / 96 / 4 stag_ang( 5) = 1.8750 ! 2x stag_ang( 7) = 2.8125 ! 3x stagger <0 PATTERN: stag_ang( 9) = 0. ! 0x (3 2 4 1 - 1 4 2 3) stag_ang(11) = 0.9735 ! 1x stag_ang(12) = 1.8750 ! 2x stag_ang(10) = 2.8125 ! 3x endif do istation=5,12 ! make a rotation matrix for each station irot = irot + 1 ! such that all face in the same direction, irsh(istation) = irot ! and phi=0 starts at y=0, and goes positive. CALL GSROTM( irsh(istation), & 90., 90. +stag_ang(istation)*abs(stagger), & 90., 0. +stag_ang(istation)*abs(stagger), & 180., 0. ) enddo c C (1) This is the big wedge mother panel. Wedge mother volume contains the carbon back plane, c the HDI, the silicon sensor, and the 13 x 2 chips in mother volume SCHM wedge_thk=silthk+back_planthk+hdithk PAR(1) = bwedge_lowx/2 ! half length along x at -z PAR(2) = bwedge_highx/2 ! half length along x at +z PAR(3) = (wedge_thk)/2 ! half thickness (y) PAR(4) = bwedge_len/2 ! half length along z CALL GSVOLU( 'SIPB', 'TRD1 ', sili_med_coldair, PAR, 4, IVOL1) c c Wedge Back Plane c PAR(1) = bwedge_lowx/2 ! This is wedge carbon back plane inside SIPB PAR(2) = bwedge_highx/2 PAR(3) = back_planthk/2 PAR(4) = bwedge_len/2 CALL GSVOLU( 'SICB', 'TRD1 ', sili_med_carbon, PAR, 4, IVOL1) c c The HDI c PAR(1) = bwedge_lowx/2 ! This is wedge HDI inside SIPB PAR(2) = bwedge_highx/2 PAR(3) = hdithk/2 PAR(4) = bwedge_len/2 CALL GSVOLU( 'HDIB', 'TRD1 ', sili_med_carbon, PAR, 4, IVOL1) call gsatt ( 'HDIB', 'COLO', 3) ! HDI is green c c Silicon Sensor from 6" wafer c PAR(1) = bsil_lowx/2 ! This is a silicon sensor in SIPB, including dead area PAR(2) = bsil_highx/2 ! PAR(3) = silthk/2 PAR(4) = bsil_len/2 CALL GSVOLU( 'SISB', 'TRD1 ', sili_med_passive, PAR, 4, IVOL1) call gsatt ( 'SISB','COLO',6) ! silicon is magenta c c Silicon sensor active volume c PAR_sisi_b(1) = (bsil_lowx-.3)/2 ! This is a silicon sensor in SISB PAR_sisi_b(2) = (bsil_highx-.3)/2 ! PAR_sisi_b(3) = silthk/2 PAR_sisi_b(4) = (bsil_len-.2)/2 CALL GSVOLU( 'SISI', 'TRD1 ', sili_med_silicon, ! big sensitive silicon & PAR_sisi_b, 0, IVOL1) ! 0 parameters - POSP later CALL GSATT( 'SISI', 'WORK', 1) ! make volume sensitive call gsatt( 'SISI','COLO',6) ! silicon is magenta c Small Disk wedges C (1) This is the small wedge mother panel. Wedge mother volume contains the carbon back plane, c the HDI, the silicon sensor, and the 5 x 2 chips in mother volume SCHM PAR(1) = swedge_lowx/2 ! half length along x at -z PAR(2) = swedge_highx/2 ! half length along x at +z PAR(3) = (wedge_thk)/2 ! half thickness (y) PAR(4) = swedge_len/2 ! half length along z CALL GSVOLU( 'SIPS', 'TRD1 ', sili_med_coldair, PAR, 4, IVOL1) c c Wedge Back Plane c PAR(1) = swedge_lowx/2 ! This is wedge carbon back plane inside PAR(2) = swedge_highx/2 ! SIPS PAR(3) = back_planthk/2 PAR(4) = swedge_len/2 CALL GSVOLU( 'SICS', 'TRD1 ', sili_med_carbon, PAR, 4, IVOL1) c c The HDI c PAR(1) = swedge_lowx/2 ! This is wedge HDI inside SIPS PAR(2) = swedge_highx/2 PAR(3) = hdithk/2 PAR(4) = swedge_len/2 CALL GSVOLU( 'HDIS', 'TRD1 ', sili_med_carbon, PAR, 4, IVOL1) c c Silicon Sensor from 6" wafer c PAR_s1(1) = ssil_lowx/2 ! This is a silicon sensor SIPS PAR_s1(2) = ssil_highx/2 ! PAR_s1(3) = silthk/2 PAR_s1(4) = ssil_len/2 CALL GSVOLU('SISS','TRD1', sili_med_passive, PAR_s1, 4, IVOL1) ! 0 parameters c c Silicon sensor active volume c PAR_sisi_s(1) = (ssil_lowx-.3)/2 ! This is a silicon sensor in SISS PAR_sisi_s(2) = (ssil_highx-.3)/2 ! PAR_sisi_s(3) = silthk/2 PAR_sisi_s(4) = (ssil_len-.2)/2 c c FPHX chips c FPHX big Mother volume first, contains 13 FPHX chips c PAR(1) = chipwid/2 ! This is one row of readout chips inside SIPB PAR(2) = silthk/2 PAR(3) = .96*13./2 CALL GSVOLU( 'CHMB', 'BOX ', sili_med_passive, PAR, 3, IVOL1) ! c c FPHX small Mother volume first, contains 5 FPHX chips c PAR(1) = chipwid/2 ! This is one row of readout chips inside SIPS PAR(2) = silthk/2 PAR(3) = .96*5./2 CALL GSVOLU( 'CHMS', 'BOX ', sili_med_passive, PAR, 3, IVOL1) ! c c Now we need two support plates for disks c Big support plate c routerb = rinner + bwedge_len parb( 1) = rinner ! inner radius parb( 2) = routerb ! outer radius for station 2,3,4 parb( 3) = support_thk/2. ! c small support plate routers = rinner + swedge_len pars( 1) = rinner ! inner radius pars( 2) = routers ! outer radius for station 1 pars( 3) = support_thk/2. ! CALL GSVOLU('SUPS','TUBE',sili_med_honeycomb,pars, 3,ivolu) CALL GSVOLU('SUPB','TUBE',sili_med_honeycomb,parb, 3,ivolu) c c Disk mother volume to hold Wedges and support plate c stationzthick=support_thk+wedge_thk*2.+hdithk*2.+silthk*2.+1. parb( 1) = rinner ! inner radius parb( 2) = routerb +.5 ! outer radius for station 2,3,4 parb( 3) = stationzthick/2. ! pars( 1) = rinner ! inner radius pars( 2) = routers +.2 ! outer radius for station 1 pars( 3) = stationzthick/2. ! do idisk=5,12 ! define 4, 8 copies SI05 - SI12 write (sil_name, '(''SI'',I2.2)') idisk if (idisk.eq.8 .or. idisk.eq.9) then ! small disks CALL GSVOLU(sil_name,'TUBE',sili_med_coldair,pars, 3,ivolu) else ! big disks CALL GSVOLU(sil_name,'TUBE',sili_med_coldair,parb, 3,ivolu) endif enddo c================= now build the big wedge ======================= c position backplane,HDI,sensor and chip mother volume in wedge c irot=irot+1 irot1 = irot irot=irot+1 irot2 = irot sens_off=(bwedge_len-bsil_len)/2. CALL GSROTM(irot1,93.75,0.,90.,90.,3.75,0.) CALL GSROTM(irot2,90.-3.75,0.,90.,90.,-3.75,0.) panthk=back_planthk CALL GSPOS('SICB',1,'SIPB',0., ! carbon support & -wedge_thk/2.+panthk/2.,0.,irotnull,'ONLY') CALL GSPOS('HDIB',1,'SIPB',0., ! HDI & -wedge_thk/2.+panthk+hdithk/2.,0.,irotnull,'ONLY') CALL GSPOS('SISB',1,'SIPB',0., ! all silicon & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irotnull,'ONLY') CALL GSPOSP('SISI',1,'SISB',0.,0.,0.,irotnull,'ONLY', & par_sisi_b,4) ! big sensitive silicon silicon CALL GSPOS('CHMB',1,'SIPB',1.0, ! readout chips & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irot1,'ONLY') CALL GSPOS('CHMB',2,'SIPB',-1.0, ! readout chips & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irot2,'ONLY') c================= now build the small wedge ======================= c position backplane,HDI,sensor and chip mother volume in wedge c CALL GSPOS('SICS',1,'SIPS',0., & -wedge_thk/2.+panthk/2.,0.,irotnull,'ONLY') CALL GSPOS('HDIS',1,'SIPS',0., & -wedge_thk/2.+panthk+hdithk/2.,0.,irotnull,'ONLY') CALL GSPOS('SISS',1,'SIPS',0., & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irotnull,'ONLY') CALL GSPOSP('SISI',1,'SISS',0.,0.,0.,irotnull,'ONLY', & par_sisi_s,4) CALL GSPOS('CHMS',1,'SIPS',.8, & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irot1,'ONLY') CALL GSPOS('CHMS',2,'SIPS',-.8, & -wedge_thk/2.+panthk+hdithk+silthk/2.,sens_off,irot2,'ONLY') C================= Position the detectors ======================c do i = 0, wedges-1 ! make 48 matrices, these irot = irot+1 ! will be used several times irx(i+1) = irot beta = mod(i+1,2) * 180.0 alpha = 360.*(i+0.5)/wedges call gsrotm( irx(i+1), & 90.0, alpha + 90.0 - beta, & beta, 0.0, & 90.0, alpha ) enddo do idisk = 5,12 ! Place disks: loop north to south write (sil_name, '(''SI'',I2.2)') idisk ! SI05, SI06 ... SI12 z_disk = sili_endcap_z(idisk-4) ! z from par file irstation = irsh(idisk) ! rotation of this disk CALL GSPOS (sil_name, 1, 'SICG', ! Place this disk & 0., 0., z_disk , irotnull, 'ONLY') ! z = -zdist+(idisk-5)*zsep+halfz ! Now fill them with wedges: if (idisk.eq.8 .or. idisk.eq.9) then ! small wedge parameters: wedge_name = 'SIPS' support_name = 'SUPS' ! name dd = rinner + (routers-rinner)/2 ! center distance else ! big wedge parameters: wedge_name = 'SIPB' support_name = 'SUPB' ! big wedge name dd = rinner + (routerb-rinner)/2 ! center endif CALL GSPOS (support_name, idisk, sil_name, ! Place this support disk & 0., 0., 0. , irotnull, 'ONLY') ! do i = 0, wedges-1 if(mod(i+1,4).eq.1)then cstep=0.5 else if (mod(i+1,4).eq.2)then cstep=0.5 else if (mod(i+1,4).eq.3)then cstep=0.1 else if (mod(i+1,4).eq.0)then cstep=0.1 endif ! place wedges in disks, 'MANY' !!! CALL GSPOS (wedge_name , i+1, sil_name , & dd*cos(2*PI*(i+0.5)/wedges), & dd*sin(2*PI*(i+0.5)/wedges), & -(support_thk/2. +cstep)*(-1)**i , irx(i+1), 'MANY') enddo ! end placing 48 wedges in the station enddo ! loop over all stations *---------------------- ifvtx cables SNCC, SOCC: -------------------------------------* irot=irot+1 irot1 = irot CALL GSROTM(irot1,90.,0.,90.,270.,180.,0.) ! rotate about x par(1) = (sili_endcap_z(6)-sili_endcap_z(5)-1.0)/2. ! between station 1 and station 2 par(2) = rinner + swedge_len+0.8 par(3) = par(2) + hdithk par(4) = rinner + bwedge_len+0.6 par(5) = par(4) + hdithk nmed = sili_med_passive Call GSVOLU('SNCC','CONE',nmed,PAR,5,IVOL1) call GSPOS('SNCC',1,'SICG',0.,0.,sili_endcap_z(5)+par(1), & irotnull,'ONLY') call GSPOS('SNCC',2,'SICG',0.,0.,-sili_endcap_z(5)-par(1), & irot1,'ONLY') call gsatt('SNCC','SEEN',1) call GSATT('SNCC','COLO',4) ! Now a tapered cone for FVTX cables - par(1) = (sili_endcap_z(8)-sili_endcap_z(6)+.9)/2. ! between station 2 and station 4 par(2) = rinner + bwedge_len+0.7 par(3) = par(2) + hdithk*2. par(4) = rinner + bwedge_len+0.7 par(5) = par(4) + hdithk*4. nmed = sili_med_passive Call GSVOLU('SOCC','CONE',nmed,PAR,5,IVOL1) call GSPOS('SOCC',1,'SICG',0.,0.,sili_endcap_z(6)+par(1)-.9, & irotnull,'ONLY') call GSPOS('SOCC',2,'SICG',0.,0.,-sili_endcap_z(6)-par(1)+.9, & irot1,'ONLY') call gsatt('SOCC','SEEN',1) call GSATT('SOCC','COLO',4) *================= make disks part of set SVX ====================* * namesw = HALL, SIEN, SICG, SIxx, SIPy, SISI, where xx=05-12, y = B or S do idisk = 5,12 write (namesw(4),'(''SI'',I2.2)') idisk namesw(5) = 'SIPB' namesw(6) = 'SISB' namesw(7) = 'SISI' if (idisk.eq.8 .or. idisk.eq. 9) then namesw(5) = 'SIPS' namesw(6) = 'SISS' namesw(7) = 'SISI' endif call gsdet (set_id, namesw(4), 7, namesw, nbitsv, idtype, & nwpa, nwsa, iset, idet) call gsdeth(set_id, namesw(4), nhh,inrNMSH,inrNBITSH, & inrORIG,inrFACT) enddo *---- Hide some of the volumes, and set colors ----------------------* do idisk = 5,12 ! SI05, SI06 ... SI12 write (sil_name, '(''SI'',I2.2)') idisk call gsatt(sil_name, 'SEEN', 1) ! call gsatt(sil_name, 'COLO', 7) ! enddo CALL GSATT( 'SIPB', 'SEEN ', 0) ! big wedges in big stations CALL GSATT( 'SIPS', 'SEEN ', 0) ! small '' small '' CALL GSATT( 'SICB', 'SEEN ', 1) ! big carbon backplate CALL GSATT( 'HDIB', 'SEEN ', 1) ! big HDI CALL GSATT( 'SUPS', 'SEEN ', 1) ! small support plate CALL GSATT( 'SUPB', 'SEEN ', 1) ! BIG support plate CALL GSATT( 'SISB', 'SEEN ', 1) ! Big silicon CALL GSATT( 'SICS', 'SEEN ', 1) ! small carbon backplate CALL GSATT( 'HDIS', 'SEEN ', 1) ! small HDI CALL GSATT( 'SISS', 'SEEN ', 1) ! small silicon CALL GSATT( 'CHMB', 'SEEN ', 1) ! big readout chips CALL GSATT( 'CHMS', 'SEEN ', 1) ! small readout chips ! Add color to individual pieces CALL GSATT( 'SICB', 'COLO', 1) ! 1=black 2=red 5=yellow 8=white CALL GSATT( 'SICS', 'COLO', 1) ! 6=magenta CALL GSATT( 'SUPB', 'COLO', 2) ! 7=lightblue CALL GSATT( 'SUPS', 'COLO', 2) ! 8=white call GSATT( 'HDIS', 'COLO', 3) ! HDI is green call GSATT( 'SISS', 'COLO', 6) ! silicon is magenta call GSATT( 'SISI', 'COLO', 6) ! silicon is magenta call GSATT( 'CHMB', 'COLO', 4) ! readout chips are blue call GSATT( 'CHMS', 'COLO', 4) ! readout chips are blue return ! from subroutine svx_fvtx 996 stop 'FVTX - read error in sili_fvtx_par segment.' end ! end of subroutine svx_fvtx c=============================================================================c