*-- Author : Stephen Burke 12/12/95
SUBROUTINE FPFIX(JSTART,JSTOP)
**********************************************************************
* *
* Deal with two pairs of cells which were swapped over for the '95 *
* run by re-writing the FPLC and FPHC banks. *
* *
* In orientation 5 cell 20 is read out as cell 22, and cell 22 is *
* read out as 20. Cell 21 is read out as 23; the real 23 is lost. *
* *
**********************************************************************
COMMON /FPFIXX/ INWORK
*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,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,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.
**********************************************************************
* Channels were swapped in '95, probably '94, probably '96, ...
IF (MONTE .OR. NCCRUN.LT.70000) RETURN
INFPLC = NLINK('FPLC',0)
IF (INFPLC.LE.0) RETURN
NFPLC = IW(INFPLC+2)
J1 = MIN(MAX(1,JSTART),NFPLC)
J2 = MAX(MIN(NFPLC,JSTOP),1)
JFIRST = 0
JF20 = 0
JF21 = 0
JF22 = 0
JF23 = 0
JLAST = 0
JL20 = -1
JL21 = -1
JL22 = -1
JL23 = -1
DO 100 JFPLC=J1,J2
* Cell number = 4*32*3*ISM + 4*32*IORI + 4*IWCELL + IWIRE
ICELL = IBTAB(INFPLC,1,JFPLC)
IORI = ICELL/128
IF (IORI.NE.5) GOTO 100
IWCELL = MOD(ICELL,128)/4
IF (IWCELL.LT.20 .OR. IWCELL.GT.23) GOTO 100
IF (JFIRST.LE.0) JFIRST = JFPLC
IF (IWCELL.EQ.20 .AND. JF20.LE.0) JF20 = JFPLC
IF (IWCELL.EQ.21 .AND. JF21.LE.0) JF21 = JFPLC
IF (IWCELL.EQ.22 .AND. JF22.LE.0) JF22 = JFPLC
IF (IWCELL.EQ.23 .AND. JF23.LE.0) JF23 = JFPLC
JLAST = JFPLC
IF (IWCELL.EQ.20) JL20 = JFPLC
IF (IWCELL.EQ.21) JL21 = JFPLC
IF (IWCELL.EQ.22) JL22 = JFPLC
IF (IWCELL.EQ.23) JL23 = JFPLC
100 CONTINUE
IF (JLAST.LE.0) RETURN
NCFPLC = IW(INFPLC+1)
NCOPY = NCFPLC*(JLAST-JFIRST+1)
JPTR = INDCR(INFPLC,1,JFIRST)
INWORK = 0
CALL WBANK(IW,INWORK,NCOPY,*9000)
CALL UCOPY(IW(JPTR),IW(INWORK+1),NCOPY)
DO JFPLC=JF22,JL22
JOFF = NCFPLC*(JFPLC - JFIRST) + 1
CALL UCOPY(IW(INWORK+JOFF),IW(JPTR),NCFPLC)
IW(JPTR) = IW(JPTR) - 8
JPTR = JPTR + NCFPLC
END DO
DO JFPLC=JF23,JL23
JOFF = NCFPLC*(JFPLC - JFIRST) + 1
CALL UCOPY(IW(INWORK+JOFF),IW(JPTR),NCFPLC)
IW(JPTR) = IW(JPTR) - 8
JPTR = JPTR + NCFPLC
END DO
DO JFPLC=JF20,JL20
JOFF = NCFPLC*(JFPLC - JFIRST) + 1
CALL UCOPY(IW(INWORK+JOFF),IW(JPTR),NCFPLC)
IW(JPTR) = IW(JPTR) + 8
JPTR = JPTR + NCFPLC
END DO
DO JFPLC=JF21,JL21
JOFF = NCFPLC*(JFPLC - JFIRST) + 1
CALL UCOPY(IW(INWORK+JOFF),IW(JPTR),NCFPLC)
IW(JPTR) = IW(JPTR) + 8
JPTR = JPTR + NCFPLC
END DO
CALL WDROP(IW,INWORK)
INFPHC = NLINK('FPHC',0)
IF (INFPHC.LE.0) RETURN
CALL VZERO(IW(INDCR(INFPHC,1,721)),32)
ICLOLD = -1
DO JFPLC=JFIRST,JLAST
ICELL = IBTAB(INFPLC,1,JFPLC)
IF (ICELL.NE.ICLOLD) THEN
IW(INDCR(INFPHC,1,ICELL+1)) = 1
IW(INDCR(INFPHC,2,ICELL+1)) = JFPLC
ICLOLD = ICELL
ELSE
IW(INDCR(INFPHC,1,ICELL+1)) = IBTAB(INFPHC,1,ICELL+1) + 1
ENDIF
END DO
9000 CONTINUE
RETURN
END