*-- Author : Stephen J. Maxfield 17/02/92
SUBROUTINE FPSOUT
**: FPSOUT 30907 RP. Farm changes.
**----------------------------------------------------------------------
**: FPSOUT 30907 SM. Fix histogram handling.
*------------------------------------------------------------------*
* OUTPUT RESULTS OF PLANAR PATTERN RECOGNITION *
* *
*------------------------------------------------------------------*
* *
* OUTPUT: FPSG,0 Planar segments *
* ===== *
*------------------------------------------------------------------*
* FORMAT OF BANKS FROM FORWARD TRACK RECONSTRUCTION *
* *
* FPSG 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 PRCHI F Chisq prob of segment *
* 8 ISM I Supermodule number *
* 9 MASKSG I MASK *
* 10 INEXT I Pointer to next segment on track *
* 11 IDIG I ) Row numbers in FPRE bank(0if none) *
* ... ) SIGNED! *
* 22 ) *
* *
********************************************************************
*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---
*KEEP,FPLSEG.
C---
COMMON /FPLSEG / PW(12,MAXSEG,3) , PWC(12,MAXSEG,3) ,
1 PRCHI(MAXSEG,3) , NFSEG(3) ,
2 XYDXY(4,MAXSEG,3) , EXYDXY(4,4,MAXSEG,3) ,
3 ZSEG(2,MAXSEG,3) ,
4 ASEGIN(MAXSEG,3) , ISEGIN(5,MAXSEG,3) ,
5 MASKSG(MAXSEG,3) , IDGISG(12,MAXSEG,3)
C---
*KEEP,FPSTSG.
COMMON/FPSTSG/ NSTC(9),NFSSEG(3),NFTSEG(3)
C---
*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,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,FPH1WRK.
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)
LOGICAL DRMASK
COMMON /H1WORK/
C-- *KEEP,FPCSEG.
C---
3 TPNORM(3,9,MAXCLU), PCONST(9,MAXCLU) ,
4 SMLS(4,2,LIMSTO,3) ,
C---
C-- *KEEP,FPDIGI.
5 DRSTO(MSEGLM,4),NDRSTO(4),
6 IDIGST(4,MSEGLM),
7 SEGTAB(MSEGLM,MSEGLM),DRMASK(MSEGLM,4),
8 IDCELL(MSEGLM,4),
9 NSGTAB(MSEGLM),ASGTAB(MSEGLM),
A RESSTO(MSEGLM,4) ,
C---
C-- *KEEP,FPDGI.
B IDGIST(MSEGLM,4),IDGISM(4,9,MAXCLU)
C ,RCHI(MAXSEG,3) ,
C---
C-- *KEEP,FPSTID.
D IDRSTO(MSEGLM,4),IDYUV(4,9,MSEGLM),
E IDYUVS(12,MAXSEG,3),FREQ(MSEGLM+1) ,
C---
C-- *interface to real data
F NDPW(NUMWPL),DW(MAXHTS,NUMWPL),DWG(MAXHTS,NUMWPL),
G DRIWP(MAXHTS,NUMWPL),DRIWM(MAXHTS,NUMWPL),
G DRIW(MAXHTS,NUMWPL),IPHOLE(MAXHTS,NUMWPL),
H IPFRPE(MAXHTS,36), IPPIOS(MAXDIG,2)
C---.
*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(NCFPSG=22)
PARAMETER(NBNN=0)
* Local arrays...
DIMENSION BAR(NCFPSG), IAR(NCFPSG)
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('FPSG','2I,(7F,15I)')
ENDIF
* Make bank
NFPSG = NFSEG(1) + NFSEG(2) + NFSEG(3)
IFPSG = NBANK('FPSG',NBNN,2+NCFPSG*NFPSG)
IW(IFPSG+1) = NCFPSG
IW(IFPSG+2) = NFPSG
* Loop over supermodules...
NUMSEG=0
DO 1 ISM = 1,3
ISMOD = ISM -1
DO 2 IP = 1,NFSEG(ISM)
NUMSEG = NUMSEG + 1
* z at beginning and end of this segment
ZBG = ZSEG(1, IP, ISM)/ 10.
ZND = ZSEG(2, IP, ISM)/ 10.
* extrapolate x,y to ZMM. Converting from mm to cm!
BAR(1) = (XYDXY(1,IP,ISM)/10.) + ZBG * XYDXY(3,IP,ISM)
BAR(2) = (XYDXY(2,IP,ISM)/10.) + ZBG * XYDXY(4,IP,ISM)
BAR(3) = ZBG
BAR(4) = (XYDXY(1,IP,ISM)/10.) + ZND * XYDXY(3,IP,ISM)
BAR(5) = (XYDXY(2,IP,ISM)/10.) + ZND * XYDXY(4,IP,ISM)
BAR(6) = ZND
BAR(7) = PRCHI(IP,ISM)
IAR(8) = ISMOD
IF (IP.GT.(NFSEG(ISM)-NFTSEG(ISM))) THEN
IAR(9) = MASKSG(IP,ISM) + SIGN(2,MASKSG(IP,ISM))
ELSEIF (IP.GT.(NFSEG(ISM)-NFSSEG(ISM)-NFTSEG(ISM))) THEN
IAR(9) = MASKSG(IP,ISM) + SIGN(1,MASKSG(IP,ISM))
ELSE
IAR(9) = MASKSG(IP,ISM)
ENDIF
C--- NFSSEG(3) --- Number of secondary Segments formed.
C--- NFTSEG(3) --- Number of Tertiary segments formed.
IAR(10) = 0
* Write(6,'(5F10.3, 2I10)') (BAR(JJ), JJ=1,5), IAR(6), IAR(7)
IHITS = 0
DO 3 IWIR = 1, 12
* Get FRPE row numbers of hits in this segment...
KWIR = IWIR + ISMOD*12
IOSP = IDGISG(IWIR,IP,ISM)
ISP = ISIGN(1,IOSP)
JP = IABS(IOSP)
IF(JP.NE.0) THEN
IAR(10+IWIR) = ISP*IPFRPE(JP,KWIR)
IHITS = IHITS + 1
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(320, 0, FLOAT(IHITS))
CALL SHS(320+ISM, 0, FLOAT(IHITS))
ENDIF
CALL UCOPY(BAR,IW(INDCR(IFPSG,1,NUMSEG)),NCFPSG)
C IFPSG = IADROW('FPSG',NBNN,NCFPSG,BAR)
2 CONTINUE
1 CONTINUE
* Close banks...
C IF(NUMSEG.GT. 0) THEN
C IFPSG = IADFIN('FPSG',NBNN)
C ELSE
* make empty banks
C IFPSG = NBANK('FPSG',NBNN,2)
C IW(IFPSG+1) = NCFPSG
C IW(IFPSG+2) = 0
C ENDIF
CALL BLIST(IW,'R+','FPSG')
IF(IDOHIS.GE.2)CALL FPSGST
RETURN
END
*