*-- Author : Stephen J. Maxfield 28/02/93
SUBROUTINE FSINGR
**: FSINGR 30907 RP. Farm changes.
**----------------------------------------------------------------------
*
* Keep single radial segments...
*
*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,FRDIMS.
PARAMETER (MAXHTS=200)
PARAMETER (NUMWPL=36)
PARAMETER (MAXTRK=200)
PARAMETER (MXTTRK=900)
PARAMETER (MAXTR3=200)
PARAMETER (MAXHPW=2)
PARAMETER (MAXDIG=2000)
PARAMETER (NUMRWR=1727)
PARAMETER (NUMPWR=1151)
*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,FH1WORK.
COMMON/FGMIOS/
* Planar geometry
+ ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,
*
* Radial geometry
+ ZP(36),PHW(36),WS(36)
*
COMMON/H1WORK/
* Radial data...
+ WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),
+ NDP(36), NW(MAXHTS,36), DWS(MAXHTS,36),
*
* Planar Data
+ NDPW(NUMWPL),DW(MAXHTS,NUMWPL),
+ DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),
+ WWP(MAXHTS,NUMWPL),
+ IPHOLE(MAXHTS,NUMWPL),
*
* Pointers into DIGI bank for IOS labelled hits
+ IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,
+ IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),
*
* Track segment data
+ NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),
*
* Fit data
+ PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),
+ DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),
+ DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),
+ RPCOSG(MAXTRK),RPSING(MAXTRK),
+ PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),
+ IRADG(36,MAXTRK),PHIG(36,MAXTRK),
+ IG,SDRADG(36,MAXTRK),
+ R1,Z1,RFIT(MAXTRK,3),
+ CHG(MAXTRK),
+ PPA(MAXTRK,3), ZZA(MAXTRK,3),
+ GPA(MAXTRK,3),GZA(MAXTRK,3)
*
*
*KEEP,FRH3FT.
* Common for RETRAC results (SJM)
COMMON/FRH3FT/ IRN(36,MAXTRK),SDN(36,MAXTRK),
+ IRP(36,MAXTRK),SDP(36,MAXTRK),
+ IG2,IGTTRK(MAXTRK),
+ CHISQ(MAXTRK),NUMDF(MAXTRK),
+ FITX(MAXTRK),FITY(MAXTRK),FITZ(MAXTRK),
+ FITTH(MAXTRK),FITPH(MAXTRK),
+ FITCU(MAXTRK),FTCOV(15,MAXTRK)
*KEND.
* Radial reject , unused , radial verified by planar
COMMON/FTRFLG/ IBRR(MAXTRK),IBPP(100),IVRR(MAXTRK)
* Common for radials associated with planar tracks
COMMON/FTRRBK/IRR(36,MAXTRK),SRR(36,MAXTRK),LRR(3,MAXTRK)
COMMON/FTPPBK/NPP,IPP(36,100),CHPP(100),LP(3,100)
* Common for segment numbers...
*KEEP,FPPRAM.
C
C--- MAXSEG is maximum number of segments per supermodule
C--- MAXCON is maximum number of amibiguous segments associatable with
C--- one segment
C--- LIMSTO is maximum number of 2 cluster planes intersections to be
C--- stored per supermodule
C--- MSEGLM is maximum number of clusters that can be found before
C--- connectivity considered
C--- MAXCLU is maximum number of clusters that can be found after
C--- forming non-connected set MUST BE 50 IF RUN WITH OLD RCW
C--- (cluster = 3/4 digits found in a straight line in one
C--- 4-wire orientation)
C
PARAMETER (MAXSEG = 200)
PARAMETER (MAXCON = 100)
PARAMETER (LIMSTO = 5000)
PARAMETER (MSEGLM = 150)
PARAMETER (MAXCLU = 50)
C---
*KEND.
COMMON /FPSEG1/ ISGG(3,MAXTRK)
COMMON /FPSEG2/ ISGP(3,MAXTRK),IUZP(MAXSEG,3),IUZR(MAXTRK,3)
COMMON /FPSEG3/ ISGR(3,MAXSEG)
COMMON /FLINK3/ LNK3(MAXTRK,3)
DIMENSION IRGONE(MAXTRK,3)
* Find used segments...
CALL VZERO(IRGONE,3*MAXTRK)
DO 1 ISM = 1, 3
* Radial segments from Rad-based tracks...
DO 2 KTRK = 1, IG
K = LNK3(KTRK,ISM)
IF(K .NE. 0)IRGONE(K, ISM) = 1
2 CONTINUE
* Radial segments on planar-based tracks...
DO 3 KTRK = 1, NPP
K = LRR(ISM, KTRK)
IF(K .NE. 0)IRGONE(K, ISM) = 1
3 CONTINUE
1 CONTINUE
* Now pick up the unused segments
DO 10 ISM = 1, 3
DO 11 KSEG = 1, NTRAKS(ISM)
IF(IRGONE(KSEG, ISM) .EQ. 0) THEN
IF(IUZR(KSEG,ISM) .EQ. 0) THEN
IF(CHSQ(KSEG, ISM) .le. 1000.) Then
* New segment. Add to Radial list.
IF(IG .LT. MAXTRK) THEN
IG = IG + 1
CALL SHS(711,0,6.01)
* Zero hit arrays...
DO 13 KWIR = 1, 36
IRN(KWIR,IG) = 0
IRP(KWIR,IG) = 0
13 CONTINUE
* Fill hits...
DO 12 KWIR = 1,12
IRN(KWIR+(ISM-1)*12,IG) = IRPT (KWIR,KSEG,ISM)
SDN(KWIR+(ISM-1)*12,IG) = SDRFT(KWIR,KSEG,ISM)
12 CONTINUE
* Copy the track parameters from module-based list.
RPCOSG(IG) = PCOSL(KSEG,ISM)
RPSING(IG) = PSINL(KSEG,ISM)
PHZG(IG) = PHZL (KSEG,ISM)
RPCOSG(IG) = PCOSL(KSEG,ISM)
ZIG(IG) = RZI (KSEG,ISM)
* Fill segment pointer, flags etc...
LNK3(IG,ISM) = KSEG
* verify everything for now...
IVRR(IG) = 1
IGTTRK(IG) = 0
ENDIF
ENDIF
ENDIF
ENDIF
11 CONTINUE
10 CONTINUE
RETURN
END
*