*-- Author : Stephen J. Maxfield 30/03/92
SUBROUTINE FRSOUT
**: FRSOUT 30907 RP. Farm changes.
**----------------------------------------------------------------------
**: FRSOUT 30907 SM. Fix histogram handling.
**: FRSOUT 30907 SM. New routine for monitoring.
**----------------------------------------------------------------------
*------------------------------------------------------------------*
* OUTPUT RESULTS OF RADIAL PATTERN RECOGNITION *
* *
*------------------------------------------------------------------*
* *
* OUTPUT: FRSG,0 radial segments *
* ===== *
*------------------------------------------------------------------*
* FORMAT OF BANKS FROM FORWARD TRACK RECONSTRUCTION *
* *
* FRSG TABLE FMT = (7F,15I) *
* ==== *
* *
* 1 X F x ) *
* 2 Y F y ) at beginning of sm *
* 3 Z F z ) *
* 4 X F x ) *
* 5 Y F y ) at end of sm *
* 6 Z F z ) *
* *
* 7 CHSQ F Chisq of segment *
* 8 ISM I Supermodule number *
* 9 - I Not used *
* 10 INEXT I Pointer to next segment on track *
* 11 IDIG I ) Row numbers in FRRE bank(0if none) *
* ... ) SIGNED! *
* 22 ) *
* *
********************************************************************
*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)
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEND.
COMMON/FWBIND/IWFRUX,IWFPUX,IWFPUR
* Bank formatting data...
PARAMETER(NCFRSG=22)
PARAMETER(NBNN=0)
* Local arrays...
DIMENSION BAR(NCFRSG), IAR(NCFRSG)
EQUIVALENCE(BAR(1), IAR(1))
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))
*KEND.
*------------------------BEGIN ROUTINE-------------------------------
IF(FIRST) THEN
FIRST = .FALSE.
* Format output banks...
CALL BKFMT('FRSG','2I,(7F,15I)')
ENDIF
* Loop over supermodules...
NUMSEG=0
DO 1 ISM = 1,3
ISMOD = ISM -1
* Loop over segments...
DO 2 IP = 1,NTRAKS(ISM)
IF (CHSQ(IP,ISM).GT.1000.) GOTO 2
NUMSEG = NUMSEG + 1
* Get FRRE row numbers of hits in this segment...
* First and last wire planes...
IFPNT = 0
ILPNT = 0
IHITS = 0
DO 3 IWIR = 1, 12
KWIR = IWIR + ISMOD*12
IOSP = IRPT(IWIR,IP,ISM)
ISP = SDRFT(IWIR,IP,ISM)
IF(IOSP.NE.0) THEN
IHITS = IHITS + 1
ILPNT = KWIR
IF(IFPNT.EQ.0)IFPNT = KWIR
IAR(10+IWIR) = ISP*IPFRRE(IOSP,KWIR)
ELSE
IAR(10+IWIR) = 0
ENDIF
* Write(6,'(3I10)') IOSP, ISP, IAR(10+IWIR)
3 CONTINUE
IF (MOD(NEVENT,10).EQ.0) THEN
CALL SHS(200, 0, FLOAT(IHITS))
CALL SHS(200+ISM, 0, FLOAT(IHITS))
ENDIF
* z at beginning and end of this segment...
ZBG = ZP(IFPNT)
ZND = ZP(ILPNT)
* convert R-z Phi-z to x,y at beginning and end...
PHIBEG = PHZL(IP,ISM) + ZBG*PCOSL(IP,ISM)
RBEG = RZI (IP,ISM) + ZBG*PSINL(IP,ISM)
PHIEND = PHZL(IP,ISM) + ZND*PCOSL(IP,ISM)
REND = RZI (IP,ISM) + ZND*PSINL(IP,ISM)
BAR(1) = RBEG*COS(PHIBEG)
BAR(2) = RBEG*SIN(PHIBEG)
BAR(3) = ZBG
BAR(4) = REND*COS(PHIEND)
BAR(5) = REND*SIN(PHIEND)
BAR(6) = ZND
BAR(7) = CHSQ(IP,ISM)
IAR(8) = ISMOD
IAR(9) = 0
IAR(10) = 0
* Write(6,'(5F10.3, 2I10)') (BAR(JJ), JJ=1,5), IAR(6), IAR(7)
IFRSG = IADROW('FRSG',NBNN,NCFRSG,BAR)
2 CONTINUE
1 CONTINUE
* Close banks...
IF(NUMSEG.GT. 0) THEN
IFRSG = IADFIN('FRSG',NBNN)
ELSE
* make empty banks
IFRSG = NBANK('FRSG',NBNN,2)
IW(IFRSG+1) = NCFRSG
IW(IFRSG+2) = 0
ENDIF
CALL BLIST(IW,'R+','FRSG')
IF(IDOHIS .GE. 2)CALL FRSGST
IF(IDOHIS .GE. 2)CALL FRPCHK
RETURN
END
*