SUBROUTINE VER_PARS ( COLOR_VERV, Z_MVD_CENT ) IMPLICIT NONE C C DESCRIPTION: This subroutine reads in and saves the geometry parameters C for the MVD in a Zebra bank. A few of the parameters in C the output are calculated from inut parameters. Also, the C default values for the input parameters are established via C the data statements in this routine. C C ARGUMENTS: C INTEGER COLOR_VER ! color code for MVD pictures REAL Z_MVD_CENT ! z of MVD center C C MAP: C 1) CALLED BY: VER C 2) CALLS: MZFORM,MZBOOK C C AUTHOR: JPSullivan March 17, 1993 based on code from subroutine VER C originally written by JHK. C C REVISIONS: DATE NAME MODIFICATION C ------ ------ ------------------------------------- C Nov 9, 93 JPS Added new parameters defining enclosure C geometry C Jan 5, 94 JPS More new parameters C Jul 18,94 JPS Add check for NPH_SEGS.GT.6, update default C parameter values. C Jul 28,94 JPS Add z position of MVD center as a calling C parameter. It is saved in the output geometry. C Jan 9, 98 JPS Add new parameter MED_VER_DUMMY_MCM, add default C value for MED_VER_MCM, change defaults values of C R2_VER_ENC from 23.165 to 28.35 C DZ_VER_ENDPL from 0.109 to 0.10 C DZ_VER_MOPL from 0.048 to 0.054 C DVOEL(1) from 2.00 to 2.15 C DVOEL(2) from 0.055 to 0.076 C DZ_VER_PMB from 0.16 to 0.21 C R_VER_PMB from 19.0 to 25.0 C VER_EL_SPACE from 0.8 to 0.85 C VER_TH_BUS_CABLE from 0.043 to 0.25 C VER_W_BUS_CABLE from 3.0 to 7.5 C VER_W_BUS_CABLE from 3.0 to 7.5 C MED_VER_BUS_CABLE from 108 to 107 C C Sept 14, 00 JPS Changed default values of C DVOEL(2) from 0.076 to 0.0854 C VER_TH_BUS_CABLE from 0.25 to 0.305 C VER_W_BUS_CABLE from 7.5 to 4.0 C MED_VER_DUMMY_MCM from 106 to 102 (Al to rohacell) C Sept 18, 00 JPS Add N_CAGES, N_CAGE_TYPE, PAD_INSTALL_FLG C to this routine (namelist plus data statement C to define default values). C C GLOBAL SPECIFICATIONS: C include 'g77trigdef.inc' include 'guphnx.inc' C C FSTORE has the common where the detector specific data are stored. include 'fstore.inc' C C FPVLINK contains the zebra links for the vertex detector. In particular C it has the pointers into the common inside FSTORE where the vertex C detector event data and geometry parameters are stored. C It also contains various offset parameters related the the C structure of the vertex detector data banks. include 'sublink.inc' include 'fpvlink.inc' C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C INTERNAL SPECIFICATIONS: C INTEGER IOPARA ! new for release 2 ZEBRA C INTEGER IOPARU ! new for release 2 ZEBRA C INTEGER I !loop index INTEGER N_CAGES !total number of cages to be positioned INTEGER N_CAGE_TYPE(24) !0-6 = # Si detectors on cage INTEGER PAD_INSTALL_FLG(2) !(1)=1 means install south pads, !(2)=1 means install north pads C C--> Define dimensions of silicon strip ladders: C REAL DVISL(3) ! Box with X, Y, Z REAL DVOSL(3) ! Box with X, Y, Z C C--> Define dimensions of two different types of wafers: C REAL DVWR1(3) ! Box with X, Y, Z REAL DVWR2(3) ! Box with X, Y, Z INTEGER NWHOLE ! Number of wafers left out to form C ! the hole in the top of the upper layer INTEGER NWPERP ! Number of wafers per full sector C C--> Define dimensions of sensitive volume (strips) inside the wafer: C REAL PITCH ! Read-out interval INTEGER NSTRIP ! Number of strips in the wafer C C--> Define dimensions of silicon plates for the electronics: C REAL DVOEL(3) ! Box with X, Y, Z C C--> Define dimensions of support structure(ROHACELL): C REAL DVROH(4) ! Trapezoid with DX1, DX2, DY, DZ REAL WDVROH ! Width of the ribs INTEGER NHVROH ! Number of holes on the side C C--> Distance from the ladders to the beam axis: C REAL VISLR ! Radius for VISL REAL VOSLR ! Radius for VOSL C C--> Azimuthal angle to the midle of inner or outer panels: C REAL SV1PH ! For VISL_1 VOSL_1 INTEGER NPH_SEGS ! number of phi segments (ladders) C REAL R1_VER_ENC !inner radius of cylindrical enclosure shell REAL R2_VER_ENC !outer radius of cylindrical enclosure shell REAL DR_VER_ENC1 !thickness of "skin" layers (inside/outside) REAL DR_VER_ENC2 !thickness of "core" layer of enclosure shell REAL DZ_VER_ENC !half-length of cylindrical enclosure shell REAL R_VER_STRUT !inner radius of enclosure shell strut REAL DR_VER_STRUT !thickness of walls in strut tube REAL DZ_VER_ENDPL !half-thickness of walls on enclosure s endplate. REAL DZ_VER_PMB !half-thickness of MVD pad motherboards REAL Z_VER_PMB !z of MVD pad motherboards REAL R_VER_PMB !other radius of MVD pad motherboards REAL R1_VER_PAD !inner radius of pad silicon REAL R2_VER_PAD !outer radius of pad silicon REAL R_VER_MOPL !outer radius of mounting plate REAL DZ_VER_MOPL !half-thickness of barrel mounting plate REAL Z_VER_MOPL !z position of barrel mounting plate C REAL VER_EL_SPACE ! spacing between MCM s REAL VER_TH_BUS_CABLE ! thickness of bus cable (full, not half thicknes) REAL VER_W_BUS_CABLE ! width of bus cable (full, not half width) REAL VER_PLNM_THWALL ! thickness of plenum walls (full thickness) REAL R_VER_PLENA ! distance from beamline to plenum s closest edge REAL ANG_VER_PLENA ! tilt angle of plena (degrees) REAL VER_TH_CABL ! thickness of cables from Si to MCM (cm) C C-------------------------------------------------------------------------- C INTEGER COLOR_VERV ! Color (visible/invisible) INTEGER MED_VER_SEN ! Silicon sensitive INTEGER MED_VER_INS ! Silicon insensitive INTEGER MED_VER_ROH ! Rohacell support structure INTEGER MED_VER_ENC1 ! enclosure skin (Al) INTEGER MED_VER_ENC2 ! enclosure core (rohacell) INTEGER MED_VER_STRUT ! enclusure strut (carbon) INTEGER MED_VER_ENDPL ! enclosure endplate (Al) INTEGER MED_VER_PMB ! MVD pad motherboard (G10) INTEGER MED_VER_HE ! Helium as default filling material INTEGER MED_VER_MOPL ! medium for barrel mounting plate INTEGER MED_VER_BUS_CABLE ! tracking medium for "bus" cables INTEGER MED_VER_CABL ! tracking medium for Si to MCM cables INTEGER MED_VER_MCM ! MCM material INTEGER MED_VER_DUMMY_MCM ! dummy MCM material C C======================================================================== C NAMELIST STRUCTURE C------------------------------------------------------------------------------- C NAMELIST /VER_PAR/ DVISL, DVOSL, DVWR1, DVWR2, 1 NWHOLE, NWPERP, PITCH, NSTRIP, DVOEL, 2 DVROH, WDVROH, NHVROH, VISLR, VOSLR, SV1PH, 3 NPH_SEGS, COLOR_VER, MED_VER_SEN, MED_VER_INS, 4 MED_VER_ROH, R1_VER_ENC, R2_VER_ENC, 5 DR_VER_ENC1, DR_VER_ENC2, DZ_VER_ENC, 6 R_VER_STRUT, DR_VER_STRUT, MED_VER_ENC1, 7 MED_VER_ENC2, MED_VER_STRUT, DZ_VER_ENDPL, 8 MED_VER_ENDPL, DZ_VER_PMB, Z_VER_PMB, 9 R_VER_PMB, MED_VER_PMB, 1 MED_VER_HE,R1_VER_PAD, R2_VER_PAD, 2 R_VER_MOPL, MED_VER_MOPL, DZ_VER_MOPL, 3 Z_VER_MOPL, VER_EL_SPACE, VER_TH_BUS_CABLE, 4 VER_W_BUS_CABLE, VER_PLNM_THWALL, R_VER_PLENA, 5 ANG_VER_PLENA, VER_TH_CABL, MED_VER_BUS_CABLE, 6 MED_VER_CABL, MED_VER_MCM, MED_VER_DUMMY_MCM, 7 N_CAGES, N_CAGE_TYPE, PAD_INSTALL_FLG C C======================================================================== C Caution for users of this code: Most of the important geometry parameters C in this code are defined in the data statements below. An effort to keep C them up to date should be made. However, most of them are read in via the C namelist parameters so the values appearing here may not always be the C values used in the program s calculations. C DATA DVISL / 0.015 , 2.5 , 31.8 / DATA DVOSL / 0.015 , 4.0 , 31.8 / C DATA DVWR1 / 0.015 , 2.6 , 2.65 / DATA DVWR2 / 0.015 , 3.725, 2.65 / DATA NWHOLE / 8 / DATA NWPERP / 12 / DATA PITCH / 0.02 / DATA NSTRIP / 256 / C DATA DVOEL / 2.15 , 0.0854 , 2.40 / C DATA WDVROH / 0.57 / !CDR: 3mm ribs, current: 5.7mm DATA NHVROH / 12 / C DATA VISLR / 4.985 / ! puts center at 5.0cm DATA VOSLR / 7.485 / ! puts center at 7.5cm C DATA SV1PH /-120.0 / DATA NPH_SEGS / 6 / C DATA R1_VER_ENC / 4.83/ DATA R2_VER_ENC / 28.35 / C DATA DR_VER_ENC1 / 0.001 / DATA DR_VER_ENC2 / 0.64 / DATA DZ_VER_ENC / 37.2/ C DATA R_VER_STRUT / 1.22 / DATA DR_VER_STRUT/ 0.050/ C DATA DZ_VER_ENDPL / 0.100 / C DATA DZ_VER_PMB / 0.21 / DATA Z_VER_PMB / 35.15 / DATA R_VER_PMB / 25.0 / C DATA R1_VER_PAD / 5.0 / DATA R2_VER_PAD / 12.0 / C DATA MED_VER_SEN /105/ ! Silicon sensitive DATA MED_VER_INS /101/ ! Silicon insensitive DATA MED_VER_ROH /102/ ! Rohacell support structure DATA MED_VER_ENC1 / 106 / ! enclosure skin - Al DATA MED_VER_ENC2 / 102 / ! enclosure core - rohacell DATA MED_VER_STRUT/ 106 / ! enclosure strut- Al DATA MED_VER_ENDPL/ 106 / ! end-plate made of aluminum DATA MED_VER_PMB / 107 / ! MVD pad motherboard = G10 DATA MED_VER_HE / 19 / ! Helium=1, magnetic air=19 DATA MED_VER_MOPL / 106 / ! medium for barrel mounting plate C DATA R_VER_MOPL / 7.5 / !outer radius of mounting plate DATA Z_VER_MOPL / 32.1 / !position of vertex mounting plate DATA DZ_VER_MOPL / 0.054/ !half-thickness of barrel mounting plate DATA VER_EL_SPACE / 0.85 / ! spacing between MCM s DATA VER_TH_BUS_CABLE / 0.305 / ! thickness of bus cable (full, not half thicknes) DATA VER_W_BUS_CABLE / 4.0 / ! width of bus cable (full, not half width) DATA VER_PLNM_THWALL / 1.0 / ! thickness of plenum walls (full thickness) DATA R_VER_PLENA / 11.5 / ! distance from beamline to plenum s closest edge DATA ANG_VER_PLENA / 20.0 / ! tilt angle of plena (degrees) DATA VER_TH_CABL / 0.005 / ! thickness of cables from Si to MCM (cm) DATA MED_VER_BUS_CABLE/ 107 / ! tracking medium for "bus" cables DATA MED_VER_CABL / 108 / ! tracking medium for Si to MCM cables DATA MED_VER_MCM / 103 / ! tracking medium for MCMs DATA MED_VER_DUMMY_MCM/ 102 / ! tracking medium for dummy MCMs C C defines MVD configuration: C DATA N_CAGE_TYPE / 6*0, 4, 4, 4, 2, 2, 0, x 6*0, 4, 4, 3, 2, 2, 0/ C DATA N_CAGES / 24 / C DATA PAD_INSTALL_FLG / 0, 1 / !only install north pads C _________________________________________________________________ C THE EXECUTABLE STATEMENTS FOLLOW BELOW C _________________________________________________________________ C c Read the geometery file segment c OPEN(UNIT=15,FILE=CPAR_FILE,STATUS='OLD',ERR=997) READ(15,NML=VER_PAR,ERR=999) CLOSE(UNIT=15) C C Transfer color_ver to color_verv C COLOR_VERV = COLOR_VER C C These parameters for the Rohacell support are calculated from the C other geometry parameters. Do it here to make sure the C numbers get saved in the zebra bank. C DVROH(1) = TAND(30.)*(VISLR+2.*DVISL(1)) DVROH(2) = TAND(30.)*VOSLR DVROH(3) = DVOSL(3) DVROH(4) = (VOSLR-VISLR)/2. - DVISL(1) C C Bad things will happen if NPH_SEGS is greater than 6 (since each C occupies 60 degrees, they will start to be on top of each other). C Therefore, if NPH_SEGS is greater than 6, issue and error message C and set its value to 6. C IF ( NPH_SEGS.GT.6 ) THEN WRITE ( 6,995 ) NPH_SEGS 995 FORMAT ( ' VER_PARS: WARNING, requested number of MVD', x ' segments=',I10,/,/' is illegal, parameter ', x ' NPH_SEGS must be .LE. 6 --- changed to 6 ') NPH_SEGS = 6 END IF C C------------------------------------------------------------------ C C The vertex geometry parameters have been read, now C save them in a Zebra bank named 'VPRA' C c 'PARA' = bank name C '-F' = all the data in the bank is floating point C IOPARA = index of characteristic for data structure, to be C passed to MZBOOK without being changed. C CALL MZFORM ( 'PARA','-F',IOPARA ) C c BOOK 'VPRA' bank c IXDIV_FR = division in which bank in created c LFV_PARA = return address of the bank c LFV_PARA = return address of supporting link c JB=1 = means create top level bank c 'PARA' = bank name c NL=0 = No links c NS=0 = No supporting (down) links c VER_PARA_ND = # of data words c IOPARA = IO format word c NZERO=0 = means that whole bank is cleared c CALL MZBOOK( IXDIV_FR, LFV_PARA, LFV_PARA, 1, X 'PARA', 0, 0, VER_PARA_ND, IOPARA, 0) c c copy raw geometry parameters into 'VPRA' bank c QF(LFV_PARA + OFVA_DVISL) = DVISL(1) QF(LFV_PARA + OFVA_DVISL+1) = DVISL(2) QF(LFV_PARA + OFVA_DVISL+2) = DVISL(3) QF(LFV_PARA + OFVA_DVOSL) = DVOSL(1) QF(LFV_PARA + OFVA_DVOSL+1) = DVOSL(2) QF(LFV_PARA + OFVA_DVOSL+2) = DVOSL(3) QF(LFV_PARA + OFVA_DVWR1) = DVWR1(1) QF(LFV_PARA + OFVA_DVWR1+1) = DVWR1(2) QF(LFV_PARA + OFVA_DVWR1+2) = DVWR1(3) QF(LFV_PARA + OFVA_DVWR2) = DVWR2(1) QF(LFV_PARA + OFVA_DVWR2+1) = DVWR2(2) QF(LFV_PARA + OFVA_DVWR2+2) = DVWR2(3) QF(LFV_PARA + OFVA_NWHOLE) = FLOAT(NWHOLE) QF(LFV_PARA + OFVA_NWPERP) = FLOAT(NWPERP) QF(LFV_PARA + OFVA_PITCH) = PITCH QF(LFV_PARA + OFVA_NSTRIP) = FLOAT(NSTRIP) QF(LFV_PARA + OFVA_DVOEL) = DVOEL(1) QF(LFV_PARA + OFVA_DVOEL+1) = DVOEL(2) QF(LFV_PARA + OFVA_DVOEL+2) = DVOEL(3) QF(LFV_PARA + OFVA_DVROH) = DVROH(1) QF(LFV_PARA + OFVA_DVROH+1) = DVROH(2) QF(LFV_PARA + OFVA_DVROH+2) = DVROH(3) QF(LFV_PARA + OFVA_DVROH+3) = DVROH(4) QF(LFV_PARA + OFVA_WDVROH) = WDVROH QF(LFV_PARA + OFVA_NHVROH) = FLOAT(NHVROH) QF(LFV_PARA + OFVA_VISLR) = VISLR QF(LFV_PARA + OFVA_VOSLR) = VOSLR QF(LFV_PARA + OFVA_SV1PH) = SV1PH QF(LFV_PARA + OFVA_NPHSEG) = FLOAT(NPH_SEGS) QF(LFV_PARA + OFVA_R1_ENC) = R1_VER_ENC QF(LFV_PARA + OFVA_R2_ENC) = R2_VER_ENC QF(LFV_PARA + OFVA_DR_ENC1) = DR_VER_ENC1 QF(LFV_PARA + OFVA_DR_ENC2) = DR_VER_ENC2 QF(LFV_PARA + OFVA_DZ_ENC) = DZ_VER_ENC QF(LFV_PARA + OFVA_R_STRUT) = R_VER_STRUT QF(LFV_PARA + OFVA_DR_STRUT) = DR_VER_STRUT QF(LFV_PARA + OFVA_DZ_ENDPL) = DZ_VER_ENDPL QF(LFV_PARA + OFVA_DZ_PMB) = DZ_VER_PMB QF(LFV_PARA + OFVA_Z_PMB) = Z_VER_PMB QF(LFV_PARA + OFVA_R_PMB) = R_VER_PMB C QF(LFV_PARA + OFVA_MED_SEN) = MED_VER_SEN QF(LFV_PARA + OFVA_MED_INS) = MED_VER_INS QF(LFV_PARA + OFVA_MED_ROH) = MED_VER_ROH QF(LFV_PARA + OFVA_MED_MCM) = MED_VER_MCM QF(LFV_PARA + OFVA_MED_ENC1) = MED_VER_ENC1 QF(LFV_PARA + OFVA_MED_ENC2) = MED_VER_ENC2 QF(LFV_PARA + OFVA_MED_STRUT) = MED_VER_STRUT QF(LFV_PARA + OFVA_MED_ENDPL) = MED_VER_ENDPL QF(LFV_PARA + OFVA_MED_PMB) = MED_VER_PMB QF(LFV_PARA + OFVA_MED_HE) = MED_VER_HE C QF(LFV_PARA + OFVA_R1_PAD) = R1_VER_PAD QF(LFV_PARA + OFVA_R2_PAD) = R2_VER_PAD QF(LFV_PARA + OFVA_Z_PAD) = Z_VER_PMB - x (DZ_VER_PMB + DVISL(1)) C QF(LFV_PARA + OFVA_R_MOPL) = R_VER_MOPL QF(LFV_PARA + OFVA_MED_MOPL) = MED_VER_MOPL QF(LFV_PARA + OFVA_DZ_MOPL) = DZ_VER_MOPL QF(LFV_PARA + OFVA_Z_MOPL) = Z_VER_MOPL C QF(LFV_PARA + OFVA_Z_MVD) = Z_MVD_CENT QF(LFV_PARA + OFVA_EL_SPACE) = VER_EL_SPACE QF(LFV_PARA + OFVA_TH_BUS) = VER_TH_BUS_CABLE QF(LFV_PARA + OFVA_W_BUS) = VER_W_BUS_CABLE QF(LFV_PARA + OFVA_PLNM_THWALL)= VER_PLNM_THWALL QF(LFV_PARA + OFVA_R_PLENA) = R_VER_PLENA QF(LFV_PARA + OFVA_ANG_PLENA) = ANG_VER_PLENA QF(LFV_PARA + OFVA_TH_CABL) = VER_TH_CABL QF(LFV_PARA + OFVA_MED_BUS) = MED_VER_BUS_CABLE QF(LFV_PARA + OFVA_MED_CABL) = MED_VER_CABL QF(LFV_PARA + OFVA_MED_DUMMY) = MED_VER_DUMMY_MCM C QF(LFV_PARA + OFVA_N_CAGES) = N_CAGES DO I=1,N_CAGES QF(LFV_PARA + OFVA_CAGE_TYPE+I-1) = N_CAGE_TYPE(I) END DO C QF(LFV_PARA + OFVA_PAD_INSTALL_FLAG) = PAD_INSTALL_FLG(1) QF(LFV_PARA + OFVA_PAD_INSTALL_FLAG+1) = PAD_INSTALL_FLG(2) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C RETURN 997 CONTINUE WRITE(6,998) 998 FORMAT(/,3X,'Unable to open phnx.par') STOP ' Cannot find main geometry file' 999 CONTINUE WRITE(6,1000) 1000 FORMAT(/,3X,'Read error in ver_par segment of phnx.par'/,3X, 1 ' Namelist mismatch in ver_par segment of phnx.par ?',//,3X, 2 'The PHNX.PAR file will be re-read to pinpoint the erroneous', 3 ' line',/,3X,'****This will cause the program to crash.****',/) CLOSE(UNIT=15) OPEN(UNIT=15,FILE=CPAR_FILE,STATUS='OLD',ERR=997) READ(15,NML=VER_PAR) CLOSE(UNIT=15) STOP ' VER_PARS PISA stopped because of phnx.par file error.' END