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