*-- 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 *