*-- Author : Stephen J. Maxfield 06/03/91
SUBROUTINE FPLOCO
**: FPLOCO.......SM. Allow for near/far asymmetry. Extend FPLC bank,
**: FPLOCO.......SM. get stagger from FGAP.
**: FPLOCO.......SB. Correct for trigger in wrong bunch crossings.
**----------------------------------------------------------------------
**: FPLOCO 30907 RP. Farm changes.
**----------------------------------------------------------------------
**: FPLOCO 30907 SM. Add event T0 from CEVT0.
**: FPLOCO 30907 SM. Bug fix. Drop banks at begin for display.
**----------------------------------------------------------------------
**: FPLOCO 30207 GB. comment lines moved inside the routine
**: FPLOCO 30205 SM. Modifications fror Filter Farm. Add histogram.
**----------------------------------------------------------------------
*==================================================================
* Calculate LOCAL COORDINATES of digitisations in the Planar
* Drift Chambers from contents of FRPE bank and database.
* The drift distance is computed and corrected as described
* in the in-line comments below.
* The following effects are NOT corrected for here:
* * Geometrical displacements and distortions
* * Track angle effects
* However, the parameter DR, needed for the track angle correction,
* is obtained from the F0P8 bank and stored in COMMON FRLORA along
* with the tangent of the Lorentz angle for completeness.
* A temporary bank is created, FPLC containing the results.
* This bank is parallel to the FRPE bank. It is a named bank but
* is not put on the E-list:
*
*! BANKname BANKtype ! Comments
* TABLE FPLC ! Local coordinates and data for hits
* ! in Planar Drift Chambers.
* ! TEMPORARY. Parallel to FRPE bank.
*! ATTributes:
*! -----------
*!COL ATT-name FMT Min Max ! Comments
*!
* 1 ICLNUM I ! Drift cell number
* 2 DRIFT F ! Abs drift distance (cms)
* 3 ERRDRF F ! Error in drift distance (cms)
* 4 ISGNW I ! Bit 0 not used.
* ! Bit 1 not used.
* ! Bit 2 0=>O.K. 1=> dubius drift
* ! Bits3-6 not used.
* ! Bit 7 0=>O.K. 1=> bad timing
* ! don't use.
* 5 CHARGE ! Charge integral
*
*
* 6 DRIFTP ! Drift distance for +side tracks
* 7 DRIFTM ! Drift distance for -side tracks
*
*!
* END TABLE
* NOTES:
*
* The drift error is a parametrised function of distance.
* The error has been inflated where bit 2 is set.
*
* The drift distances are NOT signed.
*
* DRIFT is the drift distance to be used in conjunction with
* the EFFECTIVE stagger when it is not known which side of the
* wire plane the track went. There are then 2 possible space
* points given by:
* EFFECTIVE stagger + DRIFT
* and EFFECTIVE stagger - DRIFT
*
* DRIFTP and DRIFTM should be used when the drift sign is known:
* Geometric Stagger + DRIFTP
* or Geometric Stagger - DRIFTM
*
* >>>> Exception: If drift time comes out negative after
* subtraction of T0, then DRIFTs will be negative.
* They should however be used as described above.
*
*! BANKname BANKtype ! Comments
* TABLE FPHC ! Map showing number of hits in each
* ! Cell. Row number = Cell number + 1
* ! TEMPORARY.
*! ATTributes:
*! -----------
*!COL ATT-name FMT Min Max ! Comments
*!
* 1 NHITS I ! Number of hits in Drift cell
* 2 IFRPE I ! Pointer to 1st hit in FRPE/FPLC
*!
* END TABLE
*======================================================================
* bank number forvarious banks.
PARAMETER(NBN=0)
PARAMETER(NCFPLC=7)
PARAMETER(NCFPHC=2)
PARAMETER(NRFPHC=1152)
* Locators for stuff in F0P8 bank (overall constants)
PARAMETER(ITZER=1)
PARAMETER(IVDRF=4)
PARAMETER(ID0=5)
PARAMETER(ID1=6)
PARAMETER(ID2=7)
PARAMETER(IC0=8)
PARAMETER(IC1=9)
PARAMETER(IDR=10)
* Locators for stuff in F1PA bank (wire-by-wire constants)
PARAMETER(IT0=1)
* Locators for stuff in FCP1 bank (time-to-distance run dependent)
PARAMETER(IVEL=2)
PARAMETER(IXPT=10)
PARAMETER(IBETA=16)
PARAMETER(ISTAG=21)
PARAMETER(IDRMAX=22)
PARAMETER(ITBMIN=23)
* Locators for stuff in FCP2 bank (resolution function)
PARAMETER(IERRD0=2)
PARAMETER(IERRD1=3)
PARAMETER(IERRD2=4)
PARAMETER(IERRD3=5)
PARAMETER(IFUN=6)
* Parameter for scaling microns->cms.
PARAMETER(EMTOC=10000.)
*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,CNSTBF.
INTEGER LW(NBOSIW)
REAL SW(NBOSIW)
EQUIVALENCE (RW(1),IW(1),LW(1),SW(1))
*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,FRLORA.
REAL ATLORR, ATLORP, DTANGR, DTANGP
COMMON /FRLORA/ ATLORR, ATLORP, DTANGR, DTANGP
*KEEP,FDIFLG.
COMMON/LDIAG/IDIAG,IDIAG2,MAXPRT,IDOHIS,PMCUT
*KEEP,FWINDS.
* Work bank indices...
COMMON/FWINDS/ INFRRE, INFRPE, ILWPG1, ILWRG1
*KEND.
* Common for time-to-distance relation
COMMON/T2DISP/ VEL(24), XPT(18)
* Local arrays, variables.
DIMENSION PSTAGG(0:8)
* Local arrays, variables.
DIMENSION BAR(NCFPLC), IAR(NCFPLC)
EQUIVALENCE(BAR(1), IAR(1))
LOGICAL FIRST
*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))
*KEEP,FTFUNCT.
* Statement functions for RADIAL Chamber data access.
* Using Channel Number J
* Module, Wedge-pair and Z-plane numbers...
IRMOD(J) = J/288
IRWDP(J) = (J-IRMOD(J)*288)/12
IRZPL(J) = J-IRMOD(J)*288-IRWDP(J)*12
* Statement function for obtaining WEDGE numbers(0-47) of
* wires at plus and minus ends of Cell numbers
IRWPL(J) = (IRWDP(J)/2)*4 + (MOD(IRWDP(J),2))
IRWMI(J) = MOD(IRWPL(J) + 34,48)
* Statement function for obtaining IOS wire number (1-36)
IRIOSW(J) = IRMOD(J)*12 + IRZPL(J) + 1
* Statement functions for PLANAR Chamber data access.
* Using Channel Number J
* Module, orientation, W-cell and Z-plane numbers...
IPMOD(J) = J/384
IPORI(J) = (J-IPMOD(J)*384)/128
IPWCL(J) = (J-IPMOD(J)*384-IPORI(J)*128)/4
IPZPL(J) = (J-IPMOD(J)*384-IPORI(J)*128-IPWCL(J)*4)
* IPSMD in range 0:8 Planar module number.
IPSMD(J) = IPMOD(J)*3 + IPORI(J)
*
* IOS wire number (runs from 0 to 36)
IPIOSW(J) = IPSMD(J)*4 + IPZPL(J) + 1
* SB plane numbers (1-72) from cell number
IPSBW(J) = 24*IPMOD(J) + 4*IPORI(J) + IPZPL(J) + 1
IRSBW(J) = 24*IRMOD(J) + IRZPL(J) + 13
* Module, orientation, wire and (typical) cell number from plane
* number in the range 1-72 (planars, radials and combined)
IPMSB(J) = (J - 1)/24
IPOSB(J) = (J - 24*IPMSB(J) - 1)/4
IPZSB(J) = J - 24*IPMSB(J) - 4*IPOSB(J) - 1
IPCLSB(J) = 384*IPMSB(J) + 128*IPOSB(J) + IPZSB(J)
IRMSB(J) = (J - 1)/24
IRZSB(J) = J - 24*IRMSB(J) - 13
IRCLSB(J) = 288*IRMSB(J) + IRZSB(J)
IRADSB(J) = (J - 24*((J-1)/24) - 1)/12
ICELSB(J) = IRADSB(J)*IRCLSB(J) + (1 - IRADSB(J))*IPCLSB(J)
*KEND.
DATA FIRST/.TRUE./
DATA NEGRUN /-1/
IF(FIRST) THEN
FIRST = .FALSE.
IQFRPE = NAMIND('FRPE')
IQFTDC = NAMIND('FTDC')
IQF0P8 = NAMIND('F0P8')
IQF1PA = NAMIND('F1PA')
IQFCP1 = NAMIND('FCP1')
IQFCP2 = NAMIND('FCP2')
IQFGAP = NAMIND('FGAP')
CALL BKFMT('FPLC','2I,(I,2F,I,3F)')
CALL BKFMT('FPHC','2I,(2I)')
CALL BKFMT('FTT0','2I,(F,I)')
ENDIF
*
*
IF(BEGRUN .OR. NCCRUN .NE.NEGRUN) THEN
NEGRUN = NCCRUN
*
* Hit database to update overall (F0P8) and
* wire-by-wire (F1P8) constants.
*
CALL UGTBNK('F0P8',IND)
CALL UGTBNK('F1PA',IND)
CALL UGTBNK('FCP1',IND)
CALL UGTBNK('FCP2',IND)
CALL UGTBNK('FGAP',IND)
* Extract needed overall constants...
IND0P8 = IW(IQF0P8)
TZER = RBTAB(IND0P8,ITZER,1)
* Extract drift velocity parameters...
INDCP1 = IW(IQFCP1)
INDGAP = IW(IQFGAP)
* Geometric Stagger...
* Geometric Stagger...
NMODP = IW(INDGAP+3)
KIND = INDGAP + IW(INDGAP+1) + 1
DO 2 KMOD = 0, NMODP-1
PSTAGG(KMOD) = RW(KIND+5)
KIND = KIND + IW(KIND+1) + 1
* Write(6,*) 'Stagger:', KMOD, PSTAGG(KMOD)
2 CONTINUE
STAG = ABS(PSTAGG(0))
*Run validity number for check...
IVALR = IBTAB(INDCP1, 1, 1)
DO 10 KP = 1, 4
BETA = RBTAB(INDCP1, IBETA +KP, 1)
*> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near
VEL(KP) = RBTAB(INDCP1, IVEL +KP, 1)*(1.0- BETA)
VEL(KP+4) = RBTAB(INDCP1, IVEL+4+KP, 1)*(1.0- BETA)
VEL(KP+8) = RBTAB(INDCP1, IVEL +KP, 1)
VEL(KP+12) = RBTAB(INDCP1, IVEL+4+KP, 1)
VEL(KP+16) = RBTAB(INDCP1, IVEL +KP, 1)*(1.0+ BETA)
VEL(KP+20) = RBTAB(INDCP1, IVEL+4+KP, 1)*(1.0+ BETA)
10 CONTINUE
DO 12 KP = 1, 6
*> outer-far, inner-far, outer-symm, inner-symm, outer-near, inner-near
XPT(KP) = RBTAB(INDCP1, IXPT + KP, 1)+ STAG
XPT(KP+6) = RBTAB(INDCP1, IXPT + KP, 1)
XPT(KP+12)= RBTAB(INDCP1, IXPT + KP, 1)- STAG
12 CONTINUE
* for this run...
VDRFT = RBTAB(INDCP1, IVEL , 1)
* fiducial cuts...
DRMAX = RBTAB(INDCP1, IDRMAX, 1)
TBMIN = RBTAB(INDCP1, ITBMIN, 1)
* Extract resolution parameters...
INDCP2 = IW(IQFCP2)
ERRD0 = RBTAB(INDCP2, IERRD0, 1)
ERRD1 = RBTAB(INDCP2, IERRD1, 1)
ERRD2 = RBTAB(INDCP2, IERRD2, 1)
ERRD3 = RBTAB(INDCP2, IERRD3, 1)
IFUNNY = IBTAB(INDCP2, IFUN, 1)
* Correction parameter for track angle effect
DTANGP = RBTAB(IND0P8,IDR,1)
ENDIF
*---------------------------------------------------------
* Normal Event processing...
* Check if old FPHC and FPLC banks exist. If so drop them...
INDDUM = MLINK(IW,'FPHC',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FPHC')
ENDIF
INDDUM = MLINK(IW,'FPLC',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FPLC')
ENDIF
INDDUM = MLINK(IW,'FTT0',NBN)
IF(INDDUM.NE.0) THEN
CALL BDROP(IW,'FTT0')
ENDIF
* Create FPHC bank...
INDPHC = NBANK('FPHC',NBN,2+2*NRFPHC)
CALL VZERO(IW(INDPHC+1), 2+2*NRFPHC)
IW(INDPHC+1) = NCFPHC
IW(INDPHC+2) = NRFPHC
* Get Event Time zero.
TFTDC = 0.0
* CALL CEVT0(TFTDC, LTTYP)
* Apply correction for wrong bunch crossing
CALL T0GET (ITRGT0)
TZERO = TZER + TFTDC + 500.0*FLOAT(ITRGT0)
*
* Access FRPE bank...
IND = IW(IQFRPE)
IF(IND .EQ.0) THEN
* FRPE bank not found. No data. Make 'zero=length FPLC...
INDF = NBANK('FPLC',NBN,2)
IW(INDF+1) = NCFPLC
IW(INDF+2) = 0
INDF = NBANK('FTT0',NBN,2)
IW(INDF+1) = 2
IW(INDF+2) = 0
CALL BLIST(IW,'E+','FTT0')
RETURN
ENDIF
* Copy B16 format bank to work bank
INFRPE=0
CALL BKTOW(IW,'FRPE',NBN,IW,INFRPE,*999)
* error making w/bank
* Determine number of hits in FRPE bank
NFRPE = IW(INFRPE+2)
IF(NFRPE.LE.0) THEN
* There were no digis. Should have been no bank!
* Make 'zero=length FPLC...
INDF = NBANK('FPLC',NBN,2)
IW(INDF+1) = NCFPLC
IW(INDF+2) = 0
CALL WDROP(IW,INFRPE)
INDF = NBANK('FTT0',NBN,2)
IW(INDF+1) = 2
IW(INDF+2) = 0
CALL BLIST(IW,'E+','FTT0')
RETURN
ENDIF
IND1PA = IW(IQF1PA)
* Extract Digitisations in planar chambers:-
ICLOLD = -1
* Create banks
IFPLC = NBANK('FPLC',NBN,2+NCFPLC*NFRPE)
IF (IFPLC.LE.0) GOTO 997
IW(IFPLC+1) = NCFPLC
IW(IFPLC+2) = NFRPE
JFIRST = 0
JLAST = 0
TAVG = 0.
NTT = 0
DO 1 KDIG = 1, NFRPE
ICLNUM= IBTAB(INFRPE,1,KDIG)
IF(ICLNUM .LT. 0 .OR. ICLNUM .GT. 1151) THEN
GO TO 998
ENDIF
* Fix for swapped channels in '95 data
IF ((ICLNUM/128).EQ.5) THEN
IWCELL = MOD(ICLNUM,128)/4
IF (IWCELL.GE.20 .AND. IWCELL.LE.23) THEN
IF (JFIRST.LE.0) JFIRST = KDIG
JLAST = KDIG
ENDIF
ENDIF
* Fill FPHC bank...
IF(ICLNUM .NE. ICLOLD) THEN
IW(INDPHC+ICLNUM*2 + 3) = 1
IW(INDPHC+ICLNUM*2 + 4) = KDIG
ICLOLD = ICLNUM
ELSE
IW(INDPHC+ICLNUM*2 + 3) = IW(INDPHC+ICLNUM*2 + 3) + 1
ENDIF
* Drift time in ticks...
DTIME = FLOAT(IBTAB(INFRPE,2,KDIG))
CHARGE= FLOAT(IBTAB(INFRPE,3,KDIG))
IFLAG0= IBTAB(INFRPE,4,KDIG)
IFLAG1= IBTAB(INFRPE,5,KDIG)
IFLAG2= IBTAB(INFRPE,6,KDIG)
* Extract wire dependent constants for Channel ICLNUM...
T0 = RBTAB(IND1PA,IT0 ,ICLNUM+1)
*
* Compute drift distance...
*
* Subtract Tzeros.
TT = DTIME - (TZERO + T0)
*
* Fine correction for T0 difference on inner/outer wires - real data onl
*
IF(.NOT.MONTE) THEN
IF (MOD(ICLNUM,4).EQ.0 .OR. MOD(ICLNUM,4).EQ.3) THEN
TT = TT - 0.48*500./96.
ELSE
TT = TT + 0.48*500./96.
ENDIF
ENDIF
IF(TT.LT.TBMIN) THEN
IBADT = 1
ELSE
IBADT = 0
IF (TT.LT.5000.) THEN
TAVG = TAVG + TT
NTT = NTT + 1
ENDIF
ENDIF
* Apply time-to-distance function...
IF(.NOT.MONTE) THEN
DRIFT = FPLT2D(TT, 0.0, ICLNUM)
DRIFTN= FPLT2D(TT, 1.0, ICLNUM)
DRIFTF= FPLT2D(TT, -1.0, ICLNUM)
ELSE
* T-to-d for M/C...convert ticks to ns...
TNS = TT * 0.192
* ...and microns to cms (v in microns/ns)
DRIFT = TNS*VEL(1)*0.0001
* ...and no asymmetry
DRIFTN= DRIFT
DRIFTF= DRIFT
ENDIF
* Is the wire near or far for +ve, -ve drift?
* Get stagger of wire. Alternating sign but stagger of 1st
* wire not same in all orientations...
PSTG = PSTAGG(IPSMD(ICLNUM)) * ( (-1)**IPZPL(ICLNUM) )
IF(PSTG .GT. 0.0) THEN
* This means hits with +drift are near, -drift far...
DRIFTP = DRIFTN
DRIFTM = DRIFTF
ELSE
* Other way round...
DRIFTP = DRIFTF
DRIFTM = DRIFTN
ENDIF
* Histograms for monitoring... (factor 10 downscale)
IF (MOD(NEVENT,10).EQ.0) THEN
CALL SHS(109,0,DRIFT)
CALL SHS(612,0,TT)
ENDIF
IF (NFRPE.GE.2000) CALL SHS(616,0,TT)
* Determine errors. sig**2=e0**2 +d.e1**2 + e3**2.exp(-e4*d)
* Drift is in cms. Error is converted back to cms.
ISGNW = 0
IF(DRIFT .LT. DRMAX) THEN
ERRDRF = ERRD0**2 + DRIFT*ERRD1*ERRD1
+ + ERRD2*ERRD2*EXP(-ERRD3*DRIFT)
ERRDRF = SQRT(ERRDRF) / EMTOC
ELSE
ERRDRF = DRIFT-DRMAX
ISGNW = IOR(ISGNW,128)
ENDIF
IF(IFUNNY.NE.0) THEN
* only react to flags if 'new model' Qt's...
IF(IFLAG1 .NE.1) THEN
IF(IFLAG2 .GT. IFUNNY) THEN
* unpack rest of flags...
* DOS sum of this hit...
IDOS = IAND( IFLAG0,255)
* Dist to prev hit...
* ISPL = IAND( IFLAG1, 31)
ISPL = ISHFT(IFLAG0, -8)
ISPL = IAND( ISPL, 255)
* Relinearised pedestal level...
IPED = IAND( IFLAG1,255)
* DOS sum of previous hit.
* IDPR = IAND( IFLAG1, 31)
IDPR = ISHFT(IFLAG1, -8)
IDPR = IAND( IDPR, 255)
* Dist from beginning of cluster...
IDCS = IAND( IFLAG2,127)
* Num adjacent bins above DOS threshold (leading edge)...
LHIT = ISHFT(IFLAG2, -7)
LHIT = IAND( LHIT, 15)
* Number of previous hits in the cluster...
INDX = ISHFT(IFLAG2,-11)
INDX = IAND( INDX, 15)
* React to flags here.
ENDIF
ENDIF
ELSE
* Old format flag in Monte Carlo, extract number of hits...
IHITS =0
IHITS = ISHFT(IFLAG2,-12)
IHITS = IAND(IHITS,15)
IF(IHITS .GT. 1) THEN
ERRDRF = 2.0*ERRDRF
ENDIF
ENDIF
IF(IBADT .EQ. 1) THEN
ISGNW = IOR(ISGNW,128)
ENDIF
* Fill row in output bank
IAR(1) = ICLNUM
BAR(2) = DRIFT
BAR(3) = ERRDRF
IAR(4) = ISGNW
BAR(5) = CHARGE
BAR(6) = DRIFTP
BAR(7) = DRIFTM
C IFPLC = IADROW('FPLC',NBN,NCFPLC,BAR)
CALL UCOPY(BAR,IW(INDCR(IFPLC,1,KDIG)),NCFPLC)
1 CONTINUE
IF (NTT.GT.0) THEN
TAVG = TAVG/FLOAT(NTT)
ELSE
TAVG = -10000.
ENDIF
INFTT0 = NBANK('FTT0',0,4)
IF (INFTT0.GT.0) THEN
IW(INFTT0+1) = 2
IW(INFTT0+2) = 1
RW(INFTT0+3) = TAVG
IW(INFTT0+4) = NTT
ELSE
CALL ERRLOG(113,'S:FPLOCO: Cant create FTT0 bank')
ENDIF
CALL BLIST(IW,'E+','FTT0')
CALL SHS(650,0,TAVG)
IF (NTT.LE.500) THEN
CALL SHS(651,0,TAVG)
ELSEIF (NTT.LE.2000) THEN
CALL SHS(652,0,TAVG)
ELSE
CALL SHS(653,0,TAVG)
ENDIF
INCJCC = NLINK('CJCC',0)
IF (INCJCC.GT.0 .AND. IW(INCJCC+2).GT.0) THEN
CJCT0 = RBTAB(INCJCC,2,1)
CALL SHS(654,0,TAVG-CJCT0)
IF (NTT.LE.500) THEN
CALL SHS(655,0,TAVG-CJCT0)
ELSEIF (NTT.LE.2000) THEN
CALL SHS(656,0,TAVG-CJCT0)
CALL SHD(658,0,TAVG,CJCT0)
ELSE
CALL SHS(657,0,TAVG-CJCT0)
CALL SHD(659,0,TAVG,CJCT0)
ENDIF
ENDIF
C IFPLC = IADFIN('FPLC',NBN)
CALL WDROP(IW,INFRPE)
* Channels were swapped at least in '94 and '95, and probably through '9
IF (MONTE .OR. NCCRUN.LT.70000) RETURN
* Fix for swapped channels in '95 data
IF (JLAST.GT.0) CALL FPFIX(JFIRST,JLAST)
RETURN
998 CONTINUE
CALL ERRLOG(114,'S:FPLOCO: Illegal Channel number!!')
GOTO 996
997 CONTINUE
CALL ERRLOG(115,'S:FPLOCO: Cant create bank')
996 CONTINUE
* FPLC bank may be partially made. Finish it, drop it and
* make empty version...
C IFPLC = IADFIN('FPLC',NBN)
CALL BDROP(IW, 'FPLC')
INDF = NBANK('FPLC',NBN,2)
IW(INDF+1) = NCFPLC
IW(INDF+2) = 0
CALL WDROP(IW,INFRPE)
CALL BDROP(IW, 'FTT0')
INDF = NBANK('FTT0',NBN,2)
IW(INDF+1) = 2
IW(INDF+2) = 0
CALL BLIST(IW,'E+','FTT0')
RETURN
999 CONTINUE
CALL ERRLOG(105,'S:FPLOCO: Error in FRPE work bank creation')
CALL WDROP(IW,INFRPE)
RETURN
END
*