*-- Author : Stephen J. Maxfield 10/09/92
SUBROUTINE FEFFIC
*
* Estimate radial segment finding efficiency
*
*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,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.
*
* Locate FRSX bank - one of these per pattern recognised track...
INDPSX = NLINK('FPSX',0)
IF(INDPSX .EQ. 0) RETURN
INDPSG = NLINK('FPSG',0)
IF(INDPSG .EQ. 0) RETURN
INDRSX = NLINK('FRSX',0)
IF(INDRSX .EQ. 0) RETURN
INDRSG = NLINK('FRSG',0)
IF(INDRSG .EQ. 0) RETURN
NTRK = IW(INDRSX+2)
NSEG = IW(INDPSG+2)
IF(NTRK .EQ. 0) RETURN
ICAND = 0
IFOUND= 0
N3MOD = 0
DO 1 J = 1, NTRK
* Row of first planar segment on track...
IPG1 = IBTAB(INDPSX,1,J)
IF(IPG1 .EQ. 0) THEN
GO TO 1
ENDIF
IF(IPG1 .GT. NSEG) THEN
Write(6,*) ' FEFFIC WARNING!!>> Bad segment pointer in FPSX'
RETURN
ENDIF
* Row of second segment on track...
IPG2 = IBTAB(INDPSG,10,IPG1)
IF(IPG2 .EQ. 0 .OR. IPG2.EQ. IPG1) THEN
GO TO 1
ENDIF
IF(IPG2 .GT. NSEG) THEN
Write(6,*) ' FEFFIC WARNING!!>> Bad segment pointer in FRSX'
RETURN
ENDIF
IPG3 = IBTAB(INDPSG,10,IPG2)
IF(IPG3 .EQ. IPG1) THEN
* Two-module track. Extract Track data...
* Write(6,*) ' FEFFIC >> Two-P seg track found'
ISM1 = IBTAB(INDPSG, 8,IPG1)
ISM2 = IBTAB(INDPSG, 8,IPG2)
* radial sandwich config...
IEXPEC = -1
IF( ISM1.EQ.0 .AND. ISM2 .EQ.1) THEN
IEXPEC=0
ELSEIF(ISM1.EQ.1 .AND. ISM2 .EQ.2) THEN
IEXPEC=1
ELSE
GO TO 1
ENDIF
ICAND = ICAND + 1
CALL SHS(2010,0,1.1)
* Look for appropriate radial segment...
* Row of first radial segment on track...
IRG1 = IBTAB(INDRSX,1,J)
IF(IRG1 .NE. 0) THEN
IRM1 = IBTAB(INDRSG, 8,IRG1)
IF(IRM1 .EQ. IEXPEC) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ELSE
* Row of second segment on track...
IRG2 = IBTAB(INDRSG,10,IRG1)
IF(IRG2 .NE. IRG1 .AND. IRG2.NE.0) THEN
IRM2 = IBTAB(INDRSG, 8,IRG2)
IF(IRM2 .EQ. IEXPEC) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ELSE
IRG3 = IBTAB(INDRSG, 8,IRG2)
IF(IRG3 .NE. IRG1 .AND. IRG3.NE.0) THEN
IRM3 = IBTAB(INDRSG, 8,IRG3)
IF(IRM3 .EQ. IEXPEC) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
* Three Module track. Nice...
ICAND = ICAND + 2
CALL SHS(2010,0,1.1)
CALL SHS(2010,0,1.1)
* Look for appropriate radial segments...
* Row of first radial segment on track...
IRG1 = IBTAB(INDRSX,1,J)
IF(IRG1 .NE. 0) THEN
IRM1 = IBTAB(INDRSG, 8,IRG1)
IF(IRM1 .EQ. 0 .OR. IRM1 .EQ. 1) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ELSE
* Row of second segment on track...
IRG2 = IBTAB(INDRSG,10,IRG1)
IF(IRG2 .NE. IRG1 .AND. IRG2.NE.0) THEN
IRM2 = IBTAB(INDRSG, 8,IRG2)
IF(IRM2 .EQ. 0 .OR. IRM2 .EQ. 1) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ELSE
IRG3 = IBTAB(INDRSG, 8,IRG2)
IF(IRG3 .NE. IRG1 .AND. IRG3.NE.0) THEN
IRM3 = IBTAB(INDRSG, 8,IRG3)
IF(IRM3 .EQ. 0 .OR. IRM3 .EQ. 1) THEN
IFOUND = IFOUND + 1
CALL SHS(2010,0,2.1)
GO TO 1
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
1 CONTINUE
*
IF(ICAND .GT. 0) THEN
EFF = FLOAT(IFOUND) / FLOAT(ICAND)
CALL SHS(2001,0,EFF)
ENDIF
RETURN
END
*