*-- Author : STEPHEN J. MAXFIELD 05/04/91 SUBROUTINE FRCART(IROW,XXP,YYP,XXM,YYM,ZZ,IBAD) **: FRCART 40000 SM. New definition of dead wire flag. **---------------------------------------------------------------------- * * * PURPOSE: Compute X,Y,Z of a digitisation. * * * INPUT : IROW Row number in FRRE or FRLC bank * * * OUTPUT : XXP,YYP x, y of hit assuming positive sign for drift * : XXM,YYM x, y of hit assuming negative sign for drift * : ZZ z of hit * : IBAD 0 if digi O.K. 1 if digi 'unreliable' * * NOTE : The routine uses 'local' coordinates (drift and radius) * taken from the FRLC bank. If this temporary bank does not * exist, it is created. The local coordinate data is * combined with corrected geometrical data taken from * the bank FRG1. Again if FRG1 doesn't exist, it is created. * *KEEP,BCS. INTEGER NHROW,NHCOL,NHLEN PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2) INTEGER NBOSIW PARAMETER (NBOSIW=1000000) INTEGER IW(NBOSIW) REAL RW(NBOSIW) COMMON /BCS/ IW EQUIVALENCE (RW(1),IW(1)) SAVE /BCS/ *KEND. PARAMETER(NBN=0) * Locators for FRG1 bank PARAMETER(IPDEAD=1) PARAMETER(IPRPHP=2) PARAMETER(IPRSTP=3) PARAMETER(IPRPHM=5) PARAMETER(IPRSTM=6) * Locators for FRLC bank PARAMETER(IPRCLN=1) PARAMETER(IPRDRF=2) PARAMETER(IPRRAD=4) PARAMETER(IPRSGW=6) LOGICAL FIRST DATA FIRST/.TRUE./ *KEEP,STFUNCT. * index of element before row number IROW INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1) * index of L'th element of row number IROW INDCR(IND,L,IROW)=INDR(IND,IROW) + L * L'th integer element of the IROW'th row of bank with index IND IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW)) * L'th real element of the IROW'th row of bank with index IND RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW)) *KEEP,FTFUNCT. * Statement functions for RADIAL Chamber data access. * Using Channel Number J * Module, Wedge-pair and Z-plane numbers... IRMOD(J) = J/288 IRWDP(J) = (J-IRMOD(J)*288)/12 IRZPL(J) = J-IRMOD(J)*288-IRWDP(J)*12 * Statement function for obtaining WEDGE numbers(0-47) of * wires at plus and minus ends of Cell numbers IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2)) IRWMI(J) = MOD(IRWPL(J) + 34,48) * Statement function for obtaining IOS wire number (1-36) IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1 * Statement functions for PLANAR Chamber data access. * Using Channel Number J * Module, orientation, W-cell and Z-plane numbers... IPMOD(J) = J/384 IPORI(J) = (J-IPMOD(J)*384)/128 IPWCL(J) = (J-IPMOD(J)*384-IPORI(J)*128)/4 IPZPL(J) = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4) * IPSMD in range 0:8 Planar module number. IPSMD(J) = IPMOD(J)*3 + IPORI(J) * * IOS wire number (runs from 0 to 36) IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1 * SB plane numbers (1-72) from cell number IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1 IRSBW(J) = 24*IRMOD(J) + IRZPL(J) + 13 * Module, orientation, wire and (typical) cell number from plane * number in the range 1-72 (planars, radials and combined) IPMSB(J) = (J - 1)/24 IPOSB(J) = (J - 24*IPMSB(J) - 1)/4 IPZSB(J) = J - 24*IPMSB(J) - 4*IPOSB(J) - 1 IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J) IRMSB(J) = (J - 1)/24 IRZSB(J) = J - 24*IRMSB(J) - 13 IRCLSB(J) = 288*IRMSB(J) + IRZSB(J) IRADSB(J) = (J - 24*((J-1)/24) - 1)/12 ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J) *KEND. *---------------------------------------------------------------------- * Initialisations on first call... IF(FIRST) THEN FIRST = .FALSE. IQFRLC = NAMIND('FRLC') IQFRG1 = NAMIND('FRG1') ENDIF *----------------------------------------------------------- IBAD = 1 IFRG1 = IW(IQFRG1) IF(IFRG1.EQ.0) THEN * Create FRLC bank... CALL FTCORG IFRG1 = IW(IQFRG1) IF(IFRG1.EQ.0) THEN WRITE(6,'('' FRCART : failure to create FRG1 bank'')') CALL H1STOP ENDIF ENDIF IFRLC = IW(IQFRLC) IF(IFRLC.EQ.0) THEN * Create FRLC bank... CALL FRLOCO IFRLC = IW(IQFRLC) IF(IFRLC.EQ.0) THEN WRITE(6,'('' FRCART : failure to create FRLC bank'')') CALL H1STOP ENDIF ENDIF NFRLC = IW(IFRLC+2) IF(NFRLC.LE.0) THEN * No data. Shouldn't happen if IROW valid. CALL ERRLOG(116,'S:FRCART : IROW not meaningful!') RETURN ENDIF IF(IROW.LT.0 .OR. IROW .GT. NFRLC) THEN CALL ERRLOG(117,'S:FRCART : IROW out of range!') RETURN ENDIF * Normal processing starts here... ICLNUM= IBTAB(IFRLC,IPRCLN,IROW) IDEAD = IBTAB(IFRG1,IPDEAD,ICLNUM+1) IF(IDEAD .NE. 1) THEN IBAD = 0 DRIFT = RBTAB(IFRLC,IPRDRF,IROW) RADIUS= RBTAB(IFRLC,IPRRAD,IROW) ISGNW = MOD(IBTAB(IFRLC,IPRSGW,IROW),2) * Phi, Stagger and Z of wire PHI = RBTAB(IFRG1,2+3*ISGNW,ICLNUM+1) STAGGR = RBTAB(IFRG1,3+3*ISGNW,ICLNUM+1) ZZ = RBTAB(IFRG1,4+3*ISGNW,ICLNUM+1) DSIGN = 1. DDD = DRIFT*DSIGN + STAGGR RR = RADIUS + FLOREN(RADIUS,ABS(DDD),DSIGN) XXP = RR*COS(PHI) - DDD*SIN(PHI) YYP = RR*SIN(PHI) + DDD*COS(PHI) DSIGN = -1. DDD = DRIFT*DSIGN + STAGGR RR = RADIUS + FLOREN(RADIUS,ABS(DDD),DSIGN) XXM = RR*COS(PHI) - DDD*SIN(PHI) YYM = RR*SIN(PHI) + DDD*COS(PHI) ELSE XXP = 0.0 YYP = 0.0 XXM = 0.0 YYM = 0.0 ZZ = 0.0 ENDIF * Done RETURN END *