*-- Author : Stephen J. Maxfield 18/06/92
SUBROUTINE FRPCHK
PARAMETER(TWOPI=6.2831853)
PARAMETER(PWED=0.13089969)
DIMENSION ITS(3)
*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/
*KEEP,H1EVDT.
COMMON /H1EVDT/ KEVENT,IDATA,MONTE,LCONF
INTEGER KEVENT,IDATA,LCONF
LOGICAL MONTE
*
* IDATA type of information (HEAD bank word 6) :
*
* 0 - real data H1
* 1 - MC data H1SIM
* 2 - real data CERN tests
* 3 - MC data ARCET
*
* MONTE = .TRUE. if IDATA=1
* KEVENT = event processed counter for H1REC
*
*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.
* Radial segment bank...
IFRSG = NLINK('FRSG',0)
IF(IFRSG .EQ. 0)RETURN
* Planar segment bank...
IFPSG = NLINK('FPSG',0)
IF(IFPSG .EQ. 0)RETURN
* Radial hit bank...
IFRLC = NLINK('FRLC',0)
IF(IFRLC .EQ. 0)RETURN
NRLC = IW(IFRLC+2)
IF(NRLC .EQ. 0) RETURN
* Locate FRG1 bank...
IFRG1 = NLINK('FRG1',0)
IF(IFRG1 .EQ. 0)RETURN
NRSEG = IW(IFRSG+2)
NPSEG = IW(IFPSG+2)
* Loop over the planar segments...
DO 3 JSEG = 1, NPSEG
IMODP= IBTAB(IFPSG,8,JSEG)
IMSK = IBTAB(IFPSG,9,JSEG)
IF(IMSK.EQ.0) THEN
XPSGI = RBTAB(IFPSG, 1,JSEG)
YPSGI = RBTAB(IFPSG, 2,JSEG)
ZPSGI = RBTAB(IFPSG, 3,JSEG)
XPSGO = RBTAB(IFPSG, 4,JSEG)
YPSGO = RBTAB(IFPSG, 5,JSEG)
ZPSGO = RBTAB(IFPSG, 6,JSEG)
DZG = (ZPSGO - ZPSGI)
XSLPG = (XPSGO - XPSGI) / DZG
YSLPG = (YPSGO - YPSGI) / DZG
* look for nearest radial segment...search in 'nearby' radials
* only.
IF(IMODP.EQ.0) THEN
ITS(1)=-1
ITS(2)= 0
ITS(3)= 1
ELSEIF(IMODP.EQ.1) THEN
ITS(1)=0
ITS(2)=1
ITS(3)=2
ELSEIF(IMODP.EQ.2) THEN
ITS(1)=1
ITS(2)=2
ITS(3)=0
ENDIF
* Now loop over the radial segments. Look for closest in Phi.
DO 1 K=1,3
KMIN = -1
PMIN = 100000.
DO 4 KSEG = 1, NRSEG
IMOD = IBTAB(IFRSG, 8,KSEG)
IF(IMOD.NE.ITS(K)) GOTO 4
XRSGI = RBTAB(IFRSG, 1,KSEG)
YRSGI = RBTAB(IFRSG, 2,KSEG)
ZRSGI = RBTAB(IFRSG, 3,KSEG)
XRSGO = RBTAB(IFRSG, 4,KSEG)
YRSGO = RBTAB(IFRSG, 5,KSEG)
ZRSGO = RBTAB(IFRSG, 6,KSEG)
ZTEST = 0.5*(ZRSGO + ZRSGI)
XTEST = 0.5*(XRSGO + XRSGI)
YTEST = 0.5*(YRSGO + YRSGI)
PTEST = ATAN2(YTEST,XTEST)
IF(PTEST.LT.0)PTEST=PTEST+TWOPI
* Planar prediction...
XG = XPSGI + (ZTEST-ZPSGI) * XSLPG
YG = YPSGI + (ZTEST-ZPSGI) * YSLPG
PG = ATAN2(YG,XG)
IF(PG.LT.0)PG=PG+TWOPI
DELP = ABS(PTEST-PG)
IF(DELP.GT.(TWOPI/2.0))DELP = TWOPI-DELP
IF(DELP.LT.PMIN) THEN
PMIN=DELP
KMIN=KSEG
ENDIF
4 CONTINUE
* Now look at the rad seg which was closest in Phi...
IF(KMIN.GT.0.AND.PMIN.LT.PWED) THEN
DO 5 KDP = 1, 12
KDS = IBTAB(IFRSG,10+KDP,KMIN)
KD = IABS(KDS)
IF(KD .GT. 0) THEN
ICLNUM = IBTAB(IFRLC, 1, KD)
DDD = RBTAB(IFRLC, 2, KD)
RADIUS = RBTAB(IFRLC, 4, KD)
ISGNW = IBTAB(IFRLC, 6, KD)
ISG = MOD(ISGNW, 2)
PHIW = RBTAB(IFRG1,2+3*ISG,ICLNUM+1)
STAGGR = RBTAB(IFRG1,3+3*ISG,ICLNUM+1)
ZZ = RBTAB(IFRG1,4+3*ISG,ICLNUM+1)
IF(KDS.GT.0) THEN
DRIFT = DDD - STAGGR
DRFSGN = 1.0
ELSE
DRIFT = -DDD - STAGGR
DRFSGN =-1.0
ENDIF
RR = RADIUS + FLOREN(RADIUS,ABS(DRIFT),DRFSGN)
RR = SQRT(DRIFT**2 + RR**2)
* Planar prediction...
XG = XPSGI + (ZZ-ZPSGI) * XSLPG
YG = YPSGI + (ZZ-ZPSGI) * YSLPG
RP = SQRT(XG**2 + YG**2)
* Predicted drift...
DPRED = YG*COS(PHIW) - XG*SIN(PHIW)
DELD = DRIFT - DPRED
DELR = RR - RP
CALL SHS(300,0,DELR)
CALL SHD(301,0,RP,DELR)
CALL SHD(302,0,RP,RR)
CALL SHS(310,0,DELD)
CALL SHD(311,0,DPRED,DRIFT)
IF(DPRED.LT.0.0) THEN
CALL SHS(316,0,DELD)
ELSE
CALL SHS(317,0,DELD)
ENDIF
* long projection...
IF(K.GT.1) THEN
CALL SHS(303,0,DELR)
CALL SHD(304,0,RP,DELR)
CALL SHD(305,0,RP,RR)
CALL SHS(312,0,DELD)
CALL SHD(313,0,DPRED,DRIFT)
ELSE
* short projection...
CALL SHS(306,0,DELR)
CALL SHD(307,0,RP,DELR)
CALL SHD(308,0,RP,RR)
CALL SHS(314,0,DELD)
CALL SHD(315,0,DPRED,DRIFT)
ENDIF
ENDIF
5 CONTINUE
ENDIF
1 CONTINUE
ENDIF
3 CONTINUE
RETURN
END
*
C 22/07/92 207221019 MEMBER NAME FPREZI (FTREC) M FVS