C ============================================================ SUBROUTINE VER_PLEN ( COLOR_VER, N_CAGES, N_CAGE_TYPE, x XYZ_CAGE, ORIENTATION ) C ============================================================ IMPLICIT NONE C C Description:- C ============= C This subroutine defines the geometry for the cooling plena C around the MVD barrel electronics (MCMs), the MCMs themselves, C and the power/comm boards. C C Author:- C ======== C JPSullivan C C Creation Date: 01-Feb-1996 C =========================== C C Revisions:- C =========== C Date Name Description C ---- ---- ---------------------------------------- C 9-Jan-98 JPS 1) added dummy MCMs C 2) all "bus cables" aka "power/communications C cables" are now the same size. This means C that volume VBU2 is now the same as VBU1, C previously it was smaller. C 3) corrected positioning of plenum, it was C too close to the beam line before because C I used RADIUS = R_VER_PLENA + VSIZ_PLENA(2) C where RADIUS = R_VER_PLENA + VSIZ_PLENA(1) C was intended. This did not make much difference C until the sizes were changed in this update. C 14-Sep-00 JPS Major revisions. Changed names related to the C power/comm board from "bus cable" to "power/ C comm board". Install only power/comm boards and C MCMs which are actually present. Added calling C arguements N_CAGES, N_CAGE_TYPE, XYZ_CAGE, C ORIENTATION. Changed names of plenum volumes C from VPLM to VPLE and VPLW (east and west sides). C C Arguments:- C =========== INTEGER COLOR_VER !Color of MVD in Geant pictures INTEGER N_CAGES !total number of cages to be positioned INTEGER N_CAGE_TYPE(*) !0-6 = # Si detectors on cage REAL XYZ_CAGE(3,*) !xyz positions of the cages INTEGER ORIENTATION(*) !0=null rotation, 1=rotated C C Implicit inputs, outputs, side effects:- C ======================================== C C Called by: VER C Calls : GSVOLU, GSATT, GSPOS, GSROTM C Side effects: Numerous changes to Geant's GEOM banks. C The tracking media must have been defined prior to calling this C routine (this is done in VERMATDEF) and the geometry constants C related to the MVD must have been inserted into the Zebra bank C this is done by subroutine VER_PARS). C C Global Specifications:- C ======================= C include 'g77trigdef.inc' INCLUDE 'gugeom.inc' INCLUDE 'gcunit.inc' C INCLUDE 'fstore.inc' INCLUDE 'sublink.inc' INCLUDE 'fpvlink.inc' C C External Specifications:- C ========================= C None C C Local Specifications:- C ====================== C C--> Define dimensions of silicon strip ladders: C REAL DVOSL(3) ! Box with X, Y, Z C C--> Define dimensions of silicon plates for the electronics: C REAL DVOEL(3) ! Box with X, Y, Z C C--> dimensions of the plena containing the electronics (MCM s) C and of the walls of the plena C REAL VSIZ_PLENA(3) !size of the VPLE and VPLW volumes REAL VSIZ_YWALL(3) !size of "y walls" of plenum REAL VSIZ_XWALL(3) !size of "x walls" of plenum REAL VER_PLNM_THWALL !thickness of plenum walls (cm) INTEGER NMCM !counter of N VMCM volumes defined INTEGER NDUM !number of dummy MCMs defined C C-------------------------------------------------------------------------- C INTEGER MED_VER_HE ! helium is default fill material INTEGER MED_VER_ROH ! rohacell for plenum INTEGER MED_VER_PC_BOARD ! usually kapton+copper INTEGER MED_VER_MCM ! MCM s INTEGER MED_VER_DUMMY_MCM ! dummy MCM s C C======================================================================== C INTEGER IVOLU ! Error flag returned by GSVOLU INTEGER I ! Loop index INTEGER J ! Loop index INTEGER K ! loop index INTEGER NMED ! Medium number C C temporary variables used in setting positions: C REAL RADIUS ! Perpendicular distance to beam axis REAL X,Y,Z ! Positioning coordinates REAL ANGLE ! Angle for rotation matrix C REAL R_VER_PLENA !distance from beamline to (closest C side of) the plenum REAL ANG_VER_PLENA !tilt angle of the plenum C REAL VER_EL_SPACE !spacing between adjacent MCM s REAL VER_TH_PC_BOARD !thickness of power/comm board REAL VER_W_PC_BOARD !width of power/comm board REAL VSIZ_PC_BOARD(3) !size of power/comm board REAL VPOS_PC_BOARD(3) !position of power/comm board C INTEGER NPC_POS PARAMETER (NPC_POS=6) ! max Power/comm boards per side INTEGER PC_PRESENT(NPC_POS,2,2) !2nd index is East/West, !third index in North/South INTEGER IEAST_WEST INTEGER INORTH_SOUTH REAL YMCM(NPC_POS,2) !"y" positions of MCMs (and C !power comm boards) in plenum C INTEGER NPC(2) !used to count power comm boards !as they are positioned in plena CHARACTER*4 NAME_PC !volume name for power comm board CHARACTER*4 NAME_PLEN(2) !volume name or E/W plenum C C------------------------------------------------------------------------- C DATA NAME_PC / 'VPCO' / DATA NAME_PLEN / 'VPLE', 'VPLW' / C C------------------------------------------------------------------------- C C Executable Statements:- C ======================= C C Extract the relevant material codes from the Zebra bank C MED_VER_HE = NINT(QF(LFV_PARA + OFVA_MED_HE) ) MED_VER_PC_BOARD = NINT(QF(LFV_PARA + OFVA_MED_BUS)) MED_VER_ROH = NINT(QF(LFV_PARA + OFVA_MED_ROH)) MED_VER_MCM = NINT(QF(LFV_PARA + OFVA_MED_MCM)) MED_VER_DUMMY_MCM = NINT(QF(LFV_PARA + OFVA_MED_DUMMY)) C C Extract other geometry variables from the Zebra bank, in some cases all C three elements of an array are filled when only one of them is used, but C this will not slow things down much and will make changes in the code easier. C DVOSL(1) = QF(LFV_PARA + OFVA_DVOSL) DVOSL(2) = QF(LFV_PARA + OFVA_DVOSL+1) DVOSL(3) = QF(LFV_PARA + OFVA_DVOSL+2) C DVOEL(1) = QF(LFV_PARA + OFVA_DVOEL) DVOEL(2) = QF(LFV_PARA + OFVA_DVOEL+1) DVOEL(3) = QF(LFV_PARA + OFVA_DVOEL+2) C VER_EL_SPACE = QF(LFV_PARA + OFVA_EL_SPACE) VER_TH_PC_BOARD = QF(LFV_PARA + OFVA_TH_BUS) VER_W_PC_BOARD = QF(LFV_PARA + OFVA_W_BUS) VER_PLNM_THWALL = QF(LFV_PARA + OFVA_PLNM_THWALL) R_VER_PLENA = QF(LFV_PARA + OFVA_R_PLENA) ANG_VER_PLENA = QF(LFV_PARA + OFVA_ANG_PLENA) C C Search through the input array which give the configuration of C the detector. These are used to set up counters (PC_PRESENT) C which show which power comm boards are really present in C this configuration. C DO I=1, NPC_POS PC_PRESENT(I,1,1) = 0 ! make sure these counters start at zero PC_PRESENT(I,2,1) = 0 PC_PRESENT(I,1,2) = 0 PC_PRESENT(I,2,2) = 0 END DO C C The first index of PC_PRESENT counts in the funny order we add C detectors to a C-cage, first comes ineer bottom, second is C outer bottom, third is inner middle, then inner top, outer C middle, and last is outer top. C DO I=1,N_CAGES IF ( ORIENTATION(I).NE.0 ) THEN IEAST_WEST = 1 ! east ELSE IEAST_WEST = 2 ! west END IF IF ( XYZ_CAGE(3,I).LT.0 ) THEN INORTH_SOUTH = 1 !south ELSE INORTH_SOUTH = 2 !north END IF IF ( N_CAGE_TYPE(I).GT.0 ) THEN DO J=1,N_CAGE_TYPE(I) PC_PRESENT(J,IEAST_WEST,INORTH_SOUTH) = x PC_PRESENT(J,IEAST_WEST,INORTH_SOUTH) + 1 END DO END IF END DO C C setup an array (using the same strange indexing as above) C which defines the "y" (roughly x in the phenix coordinate C system) position in the plenum for each MCM or power/comm C board. C IEAST_WEST = 2 YMCM(1,IEAST_WEST) = -0.5*VER_EL_SPACE YMCM(2,IEAST_WEST) = 0.5*VER_EL_SPACE YMCM(3,IEAST_WEST) = -1.5*VER_EL_SPACE YMCM(4,IEAST_WEST) = -2.5*VER_EL_SPACE YMCM(5,IEAST_WEST) = 1.5*VER_EL_SPACE YMCM(6,IEAST_WEST) = 2.5*VER_EL_SPACE DO J=1,6 YMCM(J,1) = -YMCM(J,2) ! East is mirror image of west END DO C C=========================================================================== C C--> Define volumes for the plena containing the MCMs and power/ C comm boards. The volumes 'VPLE' and 'VPLW' are defined to be larger C than the actual plenum in order to contain both the actual plenum C (defined by its walls VXWL and VYWL) and the power/comm boards C which come out of the bottom of the plenum (volumes VPCE and VPCW). C VSIZ_PLENA(1) = DVOEL(1) + VER_PLNM_THWALL + VER_W_PC_BOARD/2. VSIZ_PLENA(2) = 3.*VER_EL_SPACE + VER_PLNM_THWALL VSIZ_PLENA(3) = DVOSL(3) C NMED = MED_VER_HE C DO I=1,2 CALL GSVOLU( NAME_PLEN(I), 'BOX ', NMED, VSIZ_PLENA, 3, IVOLU ) CALL GSATT( NAME_PLEN(I), 'SEEN', 1 ) CALL GSATT( NAME_PLEN(I), 'COLO', COLOR_VER ) END DO C C Next, define the walls of the plena C VSIZ_XWALL(1) = VER_PLNM_THWALL/2.0 VSIZ_XWALL(2) = VSIZ_PLENA(2) VSIZ_XWALL(3) = VSIZ_PLENA(3) C NMED = MED_VER_ROH C CALL GSVOLU( 'VXWL', 'BOX ', NMED, VSIZ_XWALL, 3, IVOLU ) CALL GSATT( 'VXWL', 'SEEN', 1 ) CALL GSATT( 'VXWL', 'COLO', COLOR_VER ) C VSIZ_YWALL(1) = DVOEL(1) VSIZ_YWALL(2) = VER_PLNM_THWALL/2.0 VSIZ_YWALL(3) = VSIZ_PLENA(3) C NMED = MED_VER_ROH C CALL GSVOLU( 'VYWL', 'BOX ', NMED, VSIZ_YWALL, 3, IVOLU ) CALL GSATT( 'VYWL', 'SEEN', 1 ) CALL GSATT( 'VYWL', 'COLO', COLOR_VER ) C C position the wall of the plenum: C DO J=1,2 DO I=1,2 IF ( I.EQ.1 ) THEN X = VSIZ_PLENA(1) - VSIZ_XWALL(1) ELSE X = X - (2.*VSIZ_XWALL(1) + 2.*DVOEL(1)) END IF Y = 0. Z = 0. CALL GSPOS ('VXWL',I,NAME_PLEN(J),X,Y,Z,IROTNULL,'ONLY' ) END DO END DO C DO J=1,2 DO I=1,2 X = VSIZ_PLENA(1) - (2.*VSIZ_XWALL(1) + DVOEL(1)) IF ( I.EQ.1 ) THEN Y = VSIZ_PLENA(2) - VSIZ_YWALL(2) ELSE Y = -Y END IF Z = 0. CALL GSPOS ('VYWL',I,NAME_PLEN(J),X,Y,Z,IROTNULL,'ONLY' ) END DO END DO C C--> Define volume for the MCMs C NMED = MED_VER_MCM ! Alumina is now default substrate for electronics C CALL GSVOLU( 'VMCM', 'BOX ', NMED, DVOEL, 3, IVOLU ) CALL GSATT ( 'VMCM', 'SEEN', 1 ) CALL GSATT ( 'VMCM', 'COLO', COLOR_VER ) C C These volumes are the same size as the MCMs but made of a different material. C They are for the "Dummy MCMs", which are in the plena because the cooling air C does not flow smoothly through the plenum without these dummy MCMs to channel C the air. C NMED = MED_VER_DUMMY_MCM !typically, this is Aluminum CALL GSVOLU( 'VDUM', 'BOX ', NMED, DVOEL, 3, IVOLU ) CALL GSATT ( 'VDUM', 'SEEN', 1 ) CALL GSATT ( 'VDUM', 'COLO', COLOR_VER ) C C Define volumes for the power comm boards. C NMED = MED_VER_PC_BOARD ! Power comm boards VSIZ_PC_BOARD(1) = VER_W_PC_BOARD/2. VSIZ_PC_BOARD(2) = VER_TH_PC_BOARD/2. VSIZ_PC_BOARD(3) = VSIZ_PLENA(3)/2. ! each p/c board is half ! the length of the barrel C CALL GSVOLU( NAME_PC, 'BOX ', NMED, VSIZ_PC_BOARD, 3, IVOLU ) CALL GSATT ( NAME_PC, 'SEEN', 1 ) CALL GSATT ( NAME_PC, 'COLO', COLOR_VER ) C C--> Positioning MCMs: C X = VSIZ_PLENA(1) - (2.*VSIZ_XWALL(1) + DVOEL(1)) NMCM = 0 NDUM = 0 C DO I = 1, N_CAGES Z = XYZ_CAGE(3,I) IF ( I.LE.12 ) THEN IEAST_WEST = 2 ELSE IEAST_WEST = 1 END IF C DO J=1,6 !loop over max possible MCMs per C-cage C Y = YMCM(J,IEAST_WEST) C IF ( J.LE.N_CAGE_TYPE(I) ) THEN C C install a real MCM C NMCM = NMCM + 1 CALL GSPOS('VMCM',NMCM,NAME_PLEN(IEAST_WEST), x X,Y,Z,IROTNULL,'ONLY') ELSE C C Come here for sections without a real MCM. In these cases, C there are "dummy MCMs" installed in order to control the C flow of cooling air through the plenum C NDUM = NDUM + 1 CALL GSPOS('VDUM',NDUM,NAME_PLEN(IEAST_WEST), x X,Y,Z,IROTNULL,'ONLY') END IF END DO ENDDO C C positioning power/comm boards C VPOS_PC_BOARD(1) = -VSIZ_PLENA(1) + VSIZ_PC_BOARD(1) NPC(1) = 0 NPC(2) = 0 C DO INORTH_SOUTH=1,2 IF ( INORTH_SOUTH.EQ.1 ) THEN VPOS_PC_BOARD(3) = -VSIZ_PC_BOARD(3) ELSE VPOS_PC_BOARD(3) = VSIZ_PC_BOARD(3) END IF DO IEAST_WEST = 1,2 DO J=1,NPC_POS VPOS_PC_BOARD(2) = YMCM(J,IEAST_WEST) ! doesn't depend on North/South IF ( PC_PRESENT(J,IEAST_WEST,INORTH_SOUTH).NE.0 ) THEN C C Position one P/C board C NPC(IEAST_WEST) = NPC(IEAST_WEST) + 1 CALL GSPOS(NAME_PC,NPC(IEAST_WEST), x NAME_PLEN(IEAST_WEST),VPOS_PC_BOARD(1), x VPOS_PC_BOARD(2), VPOS_PC_BOARD(3), x IROTNULL,'ONLY') END IF END DO END DO END DO C C Everything has been placed inside the plena, now position two plena. C RADIUS = R_VER_PLENA + VSIZ_PLENA(1) C DO I = 1,2 C ANGLE = ANG_VER_PLENA IF ( I.EQ.1 ) THEN X = RADIUS * SIND(ANGLE) Y = -RADIUS * COSD(ANGLE) IROT = IROT + 1 CALL GSROTM(IROT,90.0,90.+ANGLE,90.0,180.+ANGLE,0.0,0.0) ELSE X = - X IROT = IROT + 1 CALL GSROTM(IROT,90.0,90.-ANGLE,90.0,180.-ANGLE,0.0,0.0 ) END IF C WRITE ( LOUT,* ) ' MVD plenum I=',I,' X=',X,' Y=',Y C CALL GSPOS ( NAME_PLEN(I), 1, 'VERT', X,Y,0.0, IROT,'ONLY' ) C END DO C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C RETURN END