*-- Author : Stephen Burke 07/05/92
SUBROUTINE FVTRUE(INFTKR)
*-----------------------------------------Updates 02/06/92-------
**: FVTRUE.......SB. Change loop indices to please farm.
*-----------------------------------------Updates 06/05/92-------
**: FVTRUE.......SB. New deck to mark tracks as primary/secondary.
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Find true track numbers and write primary/secondary flag into *
* word 7 of FTKR row. *
* *
**********************************************************************
LOGICAL FVXPRM
CHARACTER*4 BANK
*KEEP,FVWBI.
* Work bank indices
PARAMETER (NFVWBI=2)
COMMON /FVWBI/ INFTPR,INFVWK
*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.
**********************************************************************
INSTR = NLINK('STR ',0)
INSVX = NLINK('SVX ',0)
IF (INSTR.LE.0 .OR. INSVX.LE.0) RETURN
BANK = 'FTPR'
IF (NLINK(BANK,0).LE.0) GOTO 1000
CALL BKTOW(IW,BANK,0,IW,INFTPR,*1000)
*
* Loop over forward tracks
*
ILOOP = IW(INFTKR+2) - 1
DO 100 JFT=1,ILOOP,2
* Find true track
JPR = IBTAB(INFTKR,21,JFT)
JDIGP = IBTAB(INFTPR,4,JPR)
JDIGR = IBTAB(INFTPR,2,JPR)
CALL UTSTR(JDIGP,JDIGR,0,0,0,JMAX,NHIT,NPOSS)
IF (JMAX.LE.0) THEN
CALL ERRLOG(561,'S:FVTRUE: Funny FT digi list')
ELSE
* Overwrite IPTYPE (must be 2)
IF (FVXPRM(INSVX,INSTR,JMAX)) THEN
IW(INDCR(INFTKR,7,JFT)) = 0
ELSE
IW(INDCR(INFTKR,7,JFT)) = 1
ENDIF
ENDIF
100 CONTINUE
9000 CONTINUE
* Must make sure work banks are dropped!!!
CALL WDROP(IW,INFTPR)
RETURN
1000 CALL ERRLOG(562,'S:FVTRUE: Bank '//BANK//' not found')
GOTO 9000
END
*