*-- Author : Stephen Burke SUBROUTINE FFRCEL(XY,JFT,ICELL,IWEDGE,DRIFT) *-----------------------------------------Updates 13/03/92------- **: FFRCEL 30205.SB. Only call UGTBNK when run number changes *-----------------------------------------Updates 13/02/92------- **: FFRCEL 30205.SB. ERRLOG error numbers changed. *-----------------------------------------Updates 07/02/92------- **: FFRCEL 30205.SB. Remove unused FKMEAS sequence. *-----------------------------------------Updates 24/01/92------- **: FFRCEL 30205.SB. ERRLOG message format changed. *-----------------------------------------Updates---------------- ********************************************************************** * * * Calculate a radial cell number from a position * * * * Returns ICELL = -1 if JFT is invalid * * * ********************************************************************** DOUBLE PRECISION XY(2) DOUBLE PRECISION PHI,DPHI,PHIOFF DIMENSION FGAR(21) DIMENSION KWDP(0:47) SAVE FGAR,IRUN,KWDP *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,BOSMDL. C ------BOSMDL LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT, + LCCRUN,NCCRUN,NEVENT, + IHA,IBS,IDB,IDATEL,LUP,ISN,JSN SAVE /BOSMDL/ C ------ *KEEP,FKNPL. CHARACTER*5 CKDBG PARAMETER (CKDBG='FKDBG') PARAMETER (NPL=72) LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL &, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN &, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT * * Per-track values can go in H1WORK; note that LTRUE and LFIRST must * be set at least per event. * * This is about 36k words long; the remaining common blocks are * about 3.6k in total. Some of this could be in /H1WORK/, but the * blocks would have to be reorganised. * COMMON /H1WORK/ * /FKPROJ/ & SPRO(5,NPL),CPRO(5,5,NPL) * /FKFILT/ &, SFIL(5,NPL),CFIL(5,5,NPL) * /FKSMTH/ &, SSMT(5,NPL),CSMT(5,5,NPL) &, SSMTR(5,NPL),CSMTR(5,5,NPL) * /FKINT/ &, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL) &, QGAIN(5,5,NPL),IAPROX,LFIRST * /FKRSID/ &, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL) &, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL) &, CHIFIL(NPL),CHISMT(NPL) * /FKTRUE/ &, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE * /FKDBG/ &, LTRPL(NPL),LTRPLD(NPL) *KEEP,FFSTEE. PARAMETER (NFT=72) LOGICAL LRISV,LWMAP,LGRAPH,LTRUTH REAL DSX,DSY,DSQOP,DSTTH,DSPHI,PMCUT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX COMMON /FFSTEE/ DSX,DSY,DSQOP,DSTTH,DSPHI &, PMCUT,IDIAG,JPLRSV,LRISV,LWMAP(NFT),JPLMAX &, IRP(NPL),JPLFT(NPL),JFTPL(NFT) &, LUNGKS,IWKGKS,IDGKS,LUNHB,LUNGKM,IWKGKM,IDGKM &, LGRAPH,LTRUTH,IHFF,IHFK,ISRJCT,PCUT,CHPCUT &, QOPMAX,THEMAX,RFTMIN,RFTMAX,CEMAX *KEEP,FKPIDP. DOUBLE PRECISION PI,TWOPI,PIBY2 PARAMETER (PI=3.141592653589793238) PARAMETER (TWOPI=PI*2.0D0,PIBY2=PI/2.0D0) *KEND. * Wedge spacing in phi - NB number of wedges is hard-wired PARAMETER (DPHI=TWOPI/48.0D0) DATA IRUN/-999999/ * This should end up being read from a bank? DATA KWDP/ 0, 1, 8, 9, 2, 3,10,11, 4, 5,12,13, & 6, 7,14,15, 8, 9,16,17,10,11,18,19, & 12,13,20,21,14,15,22,23,16,17, 0, 1, & 18,19, 2, 3,20,21, 4, 5,22,23, 6, 7/ ********************************************************************** ICELL = -1 IF (IRUN.NE.NCCRUN) THEN * Get geometry bank CALL UGTBNK('FGAR',INFGAR) IF (INFGAR.LE.0) THEN CALL ERRLOG(371,'S:FFRCEL: Bank FGAR not found') RETURN ENDIF IRUN = NCCRUN CALL UCOPY(RW(INFGAR+1),FGAR,21) ENDIF * Check the plane number. NB phi offset is hard-wired IF (JFT.GE.13 .AND. JFT.LE.24) THEN KMOD = 0 PHIOFF = 0.D0 ELSEIF (JFT.GE.37 .AND. JFT.LE.48) THEN KMOD = 1 PHIOFF = DPHI/2.D0 ELSEIF (JFT.GE.61 .AND. JFT.LE.72) THEN KMOD = 2 PHIOFF = DPHI/3.D0 ELSE RETURN ENDIF * Wire number KWIRE = MOD(JFT-1,12) * Wedge number from phi PHI = DATAN2(XY(2),XY(1)) - PHIOFF IF (PHI.LT.0.0D0) PHI = PHI + TWOPI KWEDGE = PHI/DPHI * Allow for edge effects IF (KWEDGE.GT.47) KWEDGE = 0 * NB The format of FGAR is hard-coded here INDMOD = 10 + 4*KMOD PHI = FGAR(INDMOD+3) - DPHI/2.0D0 + KWEDGE*DPHI CPHI = DCOS(PHI) SPHI = DSIN(PHI) STAGG = FGAR(6) * (x,y) -> drift (NB check stagger!) WWIRE = STAGG*(-1)**KWIRE DRIFT = CPHI*XY(2) - SPHI*XY(1) - WWIRE * Wedge sign, and wedge -> wedge-pair IWEDGE = MOD(KWEDGE,4)/2 KWEDGE = KWDP(KWEDGE) * Cell number ICELL = 288*KMOD + 12*KWEDGE + KWIRE RETURN END *