C Program to print out coords of wires for specified cells/layers. common/cells/ncellstot(10) c cell count for prototype II INTEGER NCELLS(10)/ 6,7,8,9,11,12,13,14,15,16/! for hex2 c cell count for one quadrant c INTEGER NCELLS(10)/ 24,28,32,36,44,48,52,56,60,64/ c add one cell per layer so outer sense wires fall on both boundaries c INTEGER NCELLS(10)/ 25,29,33,37,45,49,53,57,61,65/ c cell count for entire chamber data ncellstot / 96,112,128,144,176,192,208,224,240,256/ pi = 4.*atan(1.) c write header for AutoLISP program on unit 2 c also, turn off screen echo of AutoLISP commands write (2,10) 10 format ('(defun HEX2 ()' / '(setvar "cmdecho" 0)' ) c SUBROUTINE HEX2(IPRT,Zlen,rmin,rmax,istereo, stereoang, c . ifr,NCELLS,LYR1,LYR2,PHIAXIS,EDGE,FLIP,ioff) C Generates wire coordinates for 10 superlayers of hex2 cells in AUVAUVAUVA c geometry. C IPRT Print flag 0 for no printout, 1 for printout C zlen Length of chamber in meters c rmin minimum radius at which wires are centered c rmax maximum radius at which wires are centered C ISTEREO 1 - all AU superlayer gaps ~ 2*saggap, stereo angles vary c 2 - all stereo angles the same, AU superlayers gaps vary c stereoang = average desired stereo angle, in radians c (not used if ISTEREO = 1) C ifr = 1 for front, = -1 for rear C NCELLS Number of cells per layer C LYR1 Beginning layer number (0 to 40, 0 includes wall layer) C LYR2 Ending layer number (1 to 41, 41 includes wall layer) C If negative, then last enclosing layer is a hex2b zipper. C PHIAXIS Central phi angle at each layer (rad) C EDGE Specifies how cell edges are trimmed (i.e. +-phi edge) C 0 - Trimmed symmetrically, with N,N-1,N,... cells/layer C 1 - Trimmed with equal cells/layer, N cells/layer C 2 - Trimmed with field wires on +phi edge only. C (allows meshing of cells over the 360 degree cut) C FLIP 0 - View is from +Z direction C 1 - " " " -Z " C Also, if FLIP is 1 and IFR is negative C then the holes for the rods supporting the electronics C are added. C IOFF 0(1) - Don't (do) offset the cells in the stereo layers C C A. Boyarski 95/4/3 Original hex2. C " 96/2/20 Zippers: hex2b in 1 and 40, hex2 elsewhere. C " 96/2/28 Fix bug for zippers for edge=1 or 2. C " 96/3/1 Force cells to line up on back end plate. c K. McDonald 96/4/20 Pattern same on front and rear endplates, c now taken as flat; add option to set stereo angles C iprt = 1 zlen = 2.764 rmin = 0.253 rmax = 0.790 stereoang = 0.07 stereoang = 0.08 c plot prototype II pattern for layers 1 - 16 call HEX2(IPRT, zlen, rmin, rmax, 1, stereoang, . 1, NCELLS, 1, 16, pi/2., 2, 0, 0) c plot one quadrant, centered on 45 deg., with no stereo offsets c call HEX2(IPRT, zlen, rmin, rmax, 1, stereoang, c . -1, NCELLS, 1, 40, pi/4., 0, 0, 0) c write AutoLISP trailer write (2,20) 20 format ( ')' ) END SUBROUTINE WOUT(IPRT,TYPE,R,A,D,V,*,Z,stereo) CHARACTER*(*) TYPE REAL R,A,D,V,Z,stereo C C WOUT is called from HEX4 at every wire coord. C IPRT is the print flag with which HEX4 was called. C TYPE is 'F' for field, 'S' for sense, 'P' for potential - wires c 'R' for standoffs C R is radius of point (meters) C A is the polar angle (radians) C D is diameter of wire (meters) C V is voltage on wire. C * is an alternate return to quit further generation by HEX4. C Z is the Z coord of the wire C STEREO is the stereo angle of the wire in mrad C INTEGER N/0/ SAVE N ! dummy statement to suppress the compilation warning that z is not used zz = z c IF(N.EQ.0.AND.IPRT.NE.0) WRITE(*,1) IF(N.EQ.0.AND.IPRT.NE.0) WRITE(1,1) 1 FORMAT(/,' TYPE NW R PHI ', > ' X Y D V STEREO') c IF(N.GE.10000) THEN cc WRITE(6,110) 10000 c WRITE(1,110) 10000 c 110 FORMAT(/,' TOO MANY WIRES, ONLY FIRST',I5,' KEPT') c RETURN 1 ! Alternate return to quit HEX4. c ENDIF N = N + 1 IF(IPRT.NE.0) . WRITE(1,40) TYPE,N,R,A,R*COS(A),R*SIN(A),D,V,stereo 40 FORMAT(5X,A,I6,3P,F9.3,0P,F11.6,3P,2F9.3,6P,F9.1,0P,F9.0, . 0p,f9.0) c if (n .gt. 10) return 99 continue c write AutoLISP file on unit 2 c convert center and radius to mm x = R*cos(A)*1000. y = R*sin(A)*1000. c radius = D*500. c make radius bigger for now so I can see the circles c radius = radius*50. c replace wire radius with feedthrough hole radius if (D. eq. .00002) then c sense wires radius = 2.25 elseif (d .eq. .0032) then c standoffs radius = 1.6 else c field wires radius = 1.25 endif write(2,100) x, y, radius 100 format ( . ' (command "circle" (list ',f8.3,' ',f8.3') ',f8.3,')' . ) RETURN END SUBROUTINE HEX2(IPRT,Zlen,rmin,rmax,istereo, stereoang, . ifr,NCELLS,LYR1,LYR2,PHIAXIS,EDGE,FLIP,ioff) c SUBROUTINE HEX2(IPRT,ZVIEW,ZORG,NCELLS,LYR1,LYR2,PHIAXIS, c > EDGE,FLIP) INTEGER IPRT, NCELLS(10), LYR1, LYR2, EDGE, FLIP C Generates wire coordinates for 10 superlayers of hex2 cells in AUVAUVAUVA c geometry. C IPRT Print flag 0 for no printout, 1 for printout C zlen Length of chamber in meters c rmin minimum radius at which wires are centered c rmax maximum radius at which wires are centered C ISTEREO 1 - all AU superlayer gaps ~ 2*saggap, stereo angles vary, c stereo offset in cells set by hand c 2 - all stereo angles the same, AU superlayers gaps vary c stereoang = average desired stereo angle, in radians c (not used if ISTEREO = 1) C ifr = 1 for front, = -1 for rear C NCELLS Number of cells per layer C LYR1 Beginning layer number (0 to 40, 0 includes wall layer) C LYR2 Ending layer number (1 to 41, 41 includes wall layer) C If negative, then last enclosing layer is a hex2b zipper. C PHIAXIS Central phi angle at each layer (rad) C EDGE Specifies how cell edges are trimmed (i.e. +-phi edge) C 0 - Trimmed symmetrically, with N,N-1,N,... cells/layer C 1 - Trimmed with equal cells/layer, N cells/layer C 2 - Trimmed with field wires on +phi edge only. C (allows meshing of cells over the 360 degree cut) C FLIP 0 - View is from +Z direction C 1 - " " " -Z " C Also, if FLIP is 1 and IFR is negative C then the holes for the rods supporting the electronics C are added. C IOFF 0(1) - Don't (do) offset the cells in the stereo layers C C A. Boyarski 95/4/3 Original hex2. C " 96/2/20 Zippers: hex2b in 1 and 40, hex2 elsewhere. C " 96/2/28 Fix bug for zippers for edge=1 or 2. C " 96/3/1 Force cells to line up on back end plate. c K. McDonald 96/4/20 Pattern same on front and rear endplates, c now taken as flat; C REAL STEREO(10) / 0. ,1., -1., 0., 1., -1., 0., 1., -1., 0. / REAL PHIAXIS ! sag = sag of stereo wires at an AU boundary real sag(10) / 10*0.0 / ! phioff = aximuthal offset angle of stereo superlayers real phioff(10) / 10*0.0 / c izipgap = 1 for superlayers that must be preceded by a zipper gap integer izipgap(10) / 0, 0, 1, 1, 0, 1, 1, 0, 1, 1 / c isaggap = 1 for superlayers that must be preceded by a sag gap integer isaggap(10) / 0, 1, 0, 0, 1, 0, 0, 1, 0, 0 / c noff = number of cells offset between wires on the 2 endplates integer noff(10) / 10*0/ c moff = number of cells offset in case istereo = 1 integer moff(10) / 0, 7, 8, 0, 9, 10, 0, 10, 11, 0 / C Offsets that minimize Q-forces on sense wires (from C. Hearty) Real*4 drs(40)/ x .0000, .0001, -.0005, .0006, x .0003, .0003, -.0006, .0008, x .0000, .0003, -.0005, .0007, x .0000, .0003, -.0006, .0007, x .0005, .0003, -.0004, .0000, x .0004, .0003, -.0005, .0001, x .0004, .0003, -.0006, .0004, x .0003, .0003, -.0006, .0004, x .0001, .0003, -.0005, .0005, x -.0001, .0004, .0000, .0000/ character type(10) / 'A', 'U', 'V', 'A', 'U', 'V', 'A', 'U', 'V', . 'A' / LOGICAL ODDLAY LOGICAL lzip ! last zipper layer is hex2b style. LOGICAL SYMMETRIC ! TRUE for symmetric cell at +-phi (n,n-1,n,n-1). common/cells/ncellstot(10) pi = 4.*atan(1.) twopi = 2.*pi radian = 180./pi zhalf = 0.5*zlen ! z coord of desired endplate. Origin at center of chamber zv = ifr*zhalf C The following 4 parameters are for fine cell adjustments. ZipExtent =0.75/6.0 ! Fractional cell extention into zip region. zipgap = 0.005 ! gap between zipper layers, except at an AU boundary ! saggap = gap between neighboring stereo and axial ! wires at center of chamber. if (istereo .eq. 1) then saggap = 0.0058 ! if ISTEREO = 1, then total gap on endplate between ! A & U layers will be 2*saggap, and the stereo angle ! determined from this. else ! istereo = 2 saggap = 0.002 ! 2, an iterative calculation is used; endif ! istereo pmove = 0.00050 ! Move potential wire away from C wires (radially) c General cell parameters NS = 4 ! number of layers per supercell DS = .000020 ! diameter of sense wires VS = 2020. ! voltage on sense wires NF = 4 ! number of field wires between sense wires DF = .000080 ! diameter of field wires VF = 0.0 ! voltage on field wires DF1 = .000080 ! diameter of clearing wire VF1 = 350. ! voltage on clearing wire NPOT = 3 ! number of potential wires btween sense wires ! (really 2, plus 1 for the standoff Rod) DPOT = .000120 ! diameter of potential wires VPOT = 0. ! voltage on potential wires. c HPOT = 2.00 ! (Height) factor for distance between pot wires c UVGAP= .00050 ! gap between U and V layers. C LAY1 = MAX(1,abs(LYR1)) LAY2 = MIN(40,abs(LYR2)) c first iteration to estimate the wire sags at the AU boundaries do isuplay = 1,10 if (stereo(isuplay) .ne. 0.0) then if (istereo .eq. 1) then ! sag = saggap at center of chamber c sag(isuplay) = saggap + 0.002 sag(isuplay) = saggap else ! istereo = 2, use stereoang to determine sag r = rmin + (isuplay-1)*(rmax - rmin)/10. phi2 = asin(zhalf*tan(stereoang)/r) sag(isuplay) = r*(1. - cos(phi2)) endif ! istereo endif ! stereo enddo ! isuplay c 2nd iteration to determine phi offsets, and the sags ! calculate layer thickness using the 3 AU sags just found dsuper = (rmax - rmin - 6.*zipgap - 3.*saggap - . sag(2) - sag(5) - sag(8))/(10. + 2.*zipextent) rlo = rmin c print 1, rlo, dsuper 1 format (' rlo ',f6.4,'dsuper ',f6.4) do isuplay = 1, 10 ! delphi = phi between wires in this superlayer delphi = twopi/ncellstot(isuplay) ! add zipextent at first superlayer if (isuplay .eq. 1) rlo = rlo + zipextent*dsuper/4. c print 2, rlo 2 format (' rlo ',f6.4) ! add gaps at beginning of superlayer rlo = rlo + izipgap(isuplay)*zipgap + . isaggap(isuplay)*(saggap + sag(isuplay)) c print 2, rlo ! go to center of the superlayer r = rlo + dsuper/2. if (stereo(isuplay) .ne. 0.0) then ! if STEREO = 1, set nominal stereo angle equal to that which produces ! a sag of sag(isuplay) if (istereo .eq. 1) . stereoang = atan(sqrt(2.*r*sag(isuplay) - saggap**2)/zhalf) print 9, isuplay, stereoang 9 format (' superlayer ',i3,' stereo angle ',f7.4) ! calculate phi between wires on the 2 endplates needed to produce ! the nominal stereo angle phi = 2.*asin(zhalf*tan(stereoang)/r) ! offset wires by an integer number (noff) of wire spacings in phi ! to keep pattern the same on both endplates. Choose noff to be ! the largest integer less than phi/delphi + 0.5 noff(isuplay) = int(phi/delphi + 0.5) ! if istereo = 1, force the offsets if (istereo .eq. 1) noff(isuplay) = moff(isuplay) ! azimuthal offset angle for stereo layers on each endplate phioff(isuplay) = delphi*noff(isuplay)/2. ! calculate the sag for the innermost wires of the U superlayers if (stereo(isuplay) .ne. 0.0) . sag(isuplay) = rlo*(1. - cos(phioff(isuplay))) endif ! stereo ! average stereo angle of this superlayer, in mrad tv = 1000.*atan(r*sin(phioff(isuplay))/zhalf) print 10, isuplay, rlo, delphi, noff(isuplay), . phioff(isuplay), sag(isuplay), tv write (3,10) isuplay, rlo, delphi, noff(isuplay), . phioff(isuplay), sag(isuplay), tv 10 format (i3,' r ',f5.3,' delphi ',f6.4, . ' noff ',i2,' phioff ',f6.4,' sag ',f6.4,' stereo ',f5.0) rlo = rlo + dsuper enddo ! isuplay c 3rd and main iteration to aly down the full wire pattern ! calculate layer thickness using the 3 AU sags just found dr = (rmax - rmin - 6.*zipgap - 3.*saggap - sag(2) - sag(5) - . sag(8))/(40. + 2.*zipextent) RLAYR = DR*NS RLO = rmin ! radius of the inner zipper layer of a superlayer NL = 1 ! counter for layer number SYMMETRIC = EDGE.EQ.0 I1 = 0 IF(EDGE.GE.2) I1 = 1 C C C LOOP OVER superlayers, and layers within c must start with layer 1, even if lay1 > 1 c print 3, rlo, dr 3 format (' rlo ',f6.4,' dr ',f6.4) DO ISUPLAY=1,10 ! Add space for zipper layer, sag gap and sag RLO = RLO + izipgap(isuplay)*zipgap + . isaggap(isuplay)*(saggap + sag(isuplay)) c print 2, rlo ! recalculate the sag for the innermost wires of the U superlayers if (stereo(isuplay) .ne. 0.0) . sag(isuplay) = rlo*(1. - cos(phioff(isuplay))) print 20, isuplay, rlo, sag(isuplay) 20 format (i3,' r ',f6.4,' sag ',f6.4) NPHI = NCELLS(ISUPLAY) - 1 ! number of cells to be generated ! Cell phi-width comes from number of cells/layer delphi = twopi/ncellstot(isuplay) ! add phi offset if called for, in opposite senses on the two endplates PHI0 = PHIAXIS - NPHI/2.0*DELPHI + . ioff*phioff(isuplay)*stereo(isuplay)*ifr ! reverse pattern if flip is nonzero if (flip .ne. 0) then DELPHI = -DELPHI ! flip the view about the y axis rather than about the x axis phi0 = pi - phi0 endif ! Put up enclosing (zipper) field wires at inner layer IF(NL.GE.LAY1.AND.NL.LE.LAY2) THEN rv = RLO ! zv = ifr*zhalf ! tv = stereo angle of this wire, in mrad tv = 1000.*atan(rv*sin(phioff(isuplay))/zhalf) DO I=1,NPHI+1 phiv0 = PHI0 +(I-1)*DELPHI if(NL.eq.1) then ! hex2b zipper phiv = phiv0 - DELPHI/3. CALL WOUT(IPRT,'C',rv,phiv,DF,.450*VS,*100,zv,tv) phiv = phiv0 CALL WOUT(IPRT,'F',rv,phiv,DPOT,VF,*100,zv,tv) phiv = phiv0 + DELPHI/3. CALL WOUT(IPRT,'C',rv,phiv,DF,.450*VS,*100,zv,tv) else ! hex2 zipper phiv = phiv0 - DELPHI/4 CALL WOUT(IPRT,'C',rv,phiv,DF,VF1,*100,zv,tv) phiv = phiv0 + DELPHI/4 CALL WOUT(IPRT,'C',rv,phiv,DF,VF1,*100,zv,tv) ENDIF ENDDO ENDIF if(NL.eq.1) RLO = RLO + ZipExtent*DR ! loop over layers within a superlayer DO LAY=1,NS ! Coords on the end cone for this sense wire ! add Chris Hearty's correction, drs rvsw = RLO + (LAY-0.5)*DR + drs(4*(isuplay-1)+lay) zvsw = zv tvsw = 1000.*atan(rvsw*sin(phioff(isuplay))/zhalf) sagl = rvsw*(1. - cos(phioff(isuplay))) print 30, nl, ncellstot(isuplay), rvsw, tvsw, sagl 30 format (' layer ',i2,' cells ',i3,' r ',f6.4, . ' stereo ',f6.1,' sag ',f6.4) if (iprt .eq. 1) write(3,40) nl, type(isuplay), . ncellstot(isuplay), noff(isuplay), rvsw, tvsw, sagl 40 format (i3,' & ',A1,' & ',i3,' & ',i2,' & ',f6.4,' & ', . f6.1,' & ',f6.4,' \s') ODDLAY = MOD(LAY,2).NE.0 KPHI = NPHI PHI0L = PHI0 IF(.NOT.ODDLAY) THEN PHI0L = PHI0L + DELPHI/2.0 IF(SYMMETRIC) KPHI = KPHI - 1 ENDIF ! put up all sense and potential wires in this layer DO I=I1,KPHI+1 phivsw = PHI0L+(I-1)*DELPHI ! sense wires IF(I.NE.0.AND.NL.GE.LAY1.AND.NL.LE.LAY2) THEN CALL WOUT(IPRT,'S',rvsw,phivsw,DS,VS,*100,ZVSW,TVSW) ENDIF ! potential wires DO IPOT=1,NPOT IF(NL.GE.LAY1.AND.NL.LE.LAY2) THEN rvpot = RLO + (LAY-0.5)*DR + FLOAT(IPOT-2)/NPOT*DR ! Adjust clearance between P and C wires by amount pmove if(lay.eq. 1.and.ipot.eq.1 ) rvpot = rvpot + pmove if(lay.eq.ns.and.ipot.eq.npot) rvpot = rvpot - pmove if(lay.eq. 1.and.ipot.eq.2) rvpot = rvpot + pmove/2. if(lay.eq.ns.and.ipot.eq.2) rvpot = rvpot - pmove/2. zvpot = zv tvpot = 1000.*atan(rvpot*sin(phioff(isuplay))/zhalf) phivpot = PHI0L +(I-1)*DELPHI + delphi/2.0 if(ipot.ne.2) then ! it's a true field wire CALL WOUT(IPRT,'F',rvpot,phivpot,DPOT,VPOT, > *100,ZVPOT,TVPOT) else ! it's a standoff rod if(flip .eq. 1 .and. ifr .eq. -1) > CALL WOUT(IPRT,'R',rvpot,phivpot,0.0032,0.0, > *100,ZVPOT,TVPOT) endif ! ipot ENDIF ! nl ENDDO ! ipot ENDDO ! i ! Put up zipper wires in this layer IF(NL.GE.LAY1.AND.NL.LE.LAY2 .and.LAY.eq.NS) THEN ! Coords on the end cone for this field wire rv = RLO + LAY*DR lzip = NL.eq.40.or.(NL.eq.LAY2.and.LYR2.lt.0) if (lzip) rv = rv + ZipExtent*DR tv = 1000.*atan(rv*sin(phioff(isuplay))/zhalf) print 999, rv 999 format (' r outer ',f7.4) DO I=1,KPHI+1 phiv0 = PHI0L +(I-1)*DELPHI if(lzip) then ! hex2b zipper phiv = phiv0 - DELPHI/3. CALL WOUT(IPRT,'C',rv,phiv,DF,.450*VS,*100,zv,tv) phiv = phiv0 CALL WOUT(IPRT,'F',rv,phiv,DPOT,VF,*100,zv,tv) phiv = phiv0 + DELPHI/3. CALL WOUT(IPRT,'C',rv,phiv,DF,.450*VS,*100,zv,tv) else ! hex2 zipper phiv = phiv0 - DELPHI/4 CALL WOUT(IPRT,'C',rv,phiv,DF,VF1,*100,zv,tv) phiv = phiv0 + DELPHI/4 CALL WOUT(IPRT,'C',rv,phiv,DF,VF1,*100,zv,tv) ENDIF ! lzip ENDDO ! kphi ENDIF ! nl NL = NL + 1 ENDDO ! lay RLO = RLO + NS*DR ENDDO ! isuplay C Add inner wall, if requested (LYR1=0) if(LYR1.LE.0) then rwall1 = 0.236 ! change to desired radius for inner clearing wires NPHI = NCELLS(1)*4 + 4 DELPHI = twopi/(18.*5.)/4. PHI0 = PHIAXIS - (NPHI+1)/2.0*DELPHI do I=0,NPHI phi = PHI0 + I*DELPHI CALL WOUT(IPRT,'W',RWALL1,phi,DPOT, 0.0,*100,0.0,0.0) enddo endif C Add outer wall, if requested (LYR2=41) if(LYR2.GE.41) then rwall2 = 0.806 ! change to desired radius for outer clearing wires NPHI = NCELLS(10)*4 + 4 DELPHI = twopi/(18.*14.)/4. PHI0 = PHIAXIS - (NPHI+1)/2.0*DELPHI do I=0,NPHI phi = PHI0 + I*DELPHI CALL WOUT(IPRT,'W',RWALL2,phi,DPOT,0.0,*100,0.0,0.0) enddo endif RETURN C 100 RETURN ! WOUT says stop END