SUBROUTINE FTFHQQ
*-- Author : I.O. Skillicorn
      SUBROUTINE FTFHQQ(NPLA,IPA,SD,ZVV,C1,C2,C3,
     1            RPCOS,THET,PHZ,DRPCOS,DTHET,DPHZ,RZII,CH,IT)          
**: FTFHQQ 40000 IS. New linking code.                                                                        
**----------------------------------------------------------------------                                      
C     LEAST SQUARES FIT IN R-Z, PHI-Z                                                                         
C     FOR SINGLE LINE SEGMENT                                                                                 
C     AUTHOR   I.O.SKILLICORN                                                                                 
C     RECODED 13/6/93                                                                                         
*KEEP,FRDIMS.                                                                                                 
      PARAMETER (MAXHTS=200)                                            
      PARAMETER (NUMWPL=36)                                             
      PARAMETER (MAXTRK=200)                                            
      PARAMETER (MXTTRK=900)                                            
      PARAMETER (MAXTR3=200)                                            
      PARAMETER (MAXHPW=2)                                              
      PARAMETER (MAXDIG=2000)                                           
      PARAMETER (NUMRWR=1727)                                           
      PARAMETER (NUMPWR=1151)                                           
*KEEP,FH1WORK.                                                                                                
       COMMON/FGMIOS/                                                   
*    Planar geometry                                                                                          
     + ZPP(140),C(140),S(140),ITYPE(140),WZERO(140),WSPACE,             
*                                                                                                             
*    Radial geometry                                                                                          
     + ZP(36),PHW(36),WS(36)                                            
*                                                                                                             
       COMMON/H1WORK/                                                   
*    Radial data...                                                                                           
     + WW(MAXHTS,36),DRI(MAXHTS,36),RM(MAXHTS,36),                      
     + NDP(36),  NW(MAXHTS,36), DWS(MAXHTS,36),                         
*                                                                                                             
*    Planar Data                                                                                              
     + NDPW(NUMWPL),DW(MAXHTS,NUMWPL),                                  
     + DRIW(MAXHTS,NUMWPL),NDW(MAXHTS,NUMWPL),                          
     + WWP(MAXHTS,NUMWPL),                                              
     + IPHOLE(MAXHTS,NUMWPL),                                           
*                                                                                                             
*    Pointers into DIGI bank for IOS labelled hits                                                            
     +  IPFRRE(MAXHTS,36),IPFRPE(MAXHTS,36),NFRRE,NFRPE,                
     +  IRPIOS(MAXDIG,2), IPPIOS(MAXDIG,2),                             
*                                                                                                             
*    Track segment data                                                                                       
     + NTRAKS(3),IRPT(12,MAXTRK,3),SDRFT(12,MAXTRK,3),                  
*                                                                                                             
*    Fit data                                                                                                 
     + PCOSL(MAXTRK,3),PSINL(MAXTRK,3),PHZL(MAXTRK,3),                  
     + DPCOSL(MAXTRK,3),DPSINL(MAXTRK,3),                               
     + DPHZL(MAXTRK,3),CHSQ(MAXTRK,3),RZI(MAXTRK,3),                    
     + RPCOSG(MAXTRK),RPSING(MAXTRK),                                   
     + PHZG(MAXTRK),CC(3,MAXTRK),ZIG(MAXTRK),                           
     + IRADG(36,MAXTRK),PHIG(36,MAXTRK),                                
     + IG,SDRADG(36,MAXTRK),                                            
     + R1,Z1,RFIT(MAXTRK,3),                                            
     + CHG(MAXTRK),                                                     
     + PPA(MAXTRK,3),  ZZA(MAXTRK,3),                                   
     + GPA(MAXTRK,3),GZA(MAXTRK,3)                                      
*                                                                                                             
*                                                                                                             
*KEND.                                                                                                        
*                                                                                                             
*KEEP,FPTVTX.                                                                                                 
      COMMON/VERTVV/ZV ,XVV,YVV                                         
**the common/VERTEX/ becomes /VERTVV/ (in analogy to /VERTFF/) on the                                         
** 17/6/91, since it is in conflict with the VERTEX module (g.bernardi)                                       
** (note that all these common names should start by F in this deck...)                                       
*KEEP,FRWERR.                                                                                                 
      COMMON /WERR/ERRVL,ERRV,ERRP,ERRRX                                
*KEND.                                                                                                        
*                                                                                                             
      COMMON/FERROR/ERRDR(MAXHTS, 36), ERRRM(MAXHTS, 36),               
     +              ERPDR(MAXHTS, 36), IERRF(MAXHTS, 36),               
     +                                 IERPF(MAXHTS, 36)                
      DIMENSION XX(40),YY(40),WP(40)                                    
      DIMENSION IPA(36),SD(36),CB(36)                                   
      PI2=6.2831853                                                     
      II=0                                                              
      FF=0.                                                             
      RMN=0.                                                            
      DO 20 K=1,NPLA                                                    
C     J IS POINT NO.     K=PLANE NO.                                                                          
      J=IPA(K)                                                          
      IF(J.EQ.0)GOTO20                                                  
      IF(DRI(J,K).GT.900.)GOTO20                                        
      II=II+1                                                           
      YY(II)=RM(J,K)                                                    
      XX(II)=ZP(K)                                                      
      WP(II)=1./ERRRM(J,K)                                              
      RMN=RMN+YY(II)*WP(II)                                             
      FF=FF+WP(II)                                                      
C      PRINT1003,II,J,XX(II),YY(II),WP(II)                                                                    
 1003 FORMAT(' HELIX R',2I5,3F10.4)                                     
 20   CONTINUE                                                          
                                                                        
      CALL FTLFTW(XX,YY,WP,II,0,2,RZS,RZII,ET,DRZS,DRZI,COV)
      THET=RZS                                                          
      DTHET=DRZS                                                        
C     WEIGHTED MEAN R                                                                                         
      R1=RMN/FF                                                         
C                                                                                                             
C     CALCULATE PHI BASED ON FITTED R                                                                         
      II=0                                                              
      DO30 K=1,NPLA                                                     
C     J IS POINT NO.     K=PLANE NO.                                                                          
      J=IPA(K)                                                          
      IF(J.EQ.0)GOTO30                                                  
      IF(DRI(J,K).GT.900.)GOTO30                                        
      II=II+1                                                           
      XX(II)=ZP(K)                                                      
C     USE RESULTS OF STR LINE FIT IN R-Z                                                                      
      RR=RZS*ZP(K)+RZII                                                 
C     LAB PHI WITH FITTED R                                                                                   
C     TRY MEAN R INSTEAD OF RR  - R1                                                                          
      PHI=ATAN((DRI(J,K)*SD(K)+DWS(J,K))/R1)+WW(J,K)                    
      IF(PHI.LT.0.0)PHI=PHI+PI2                                         
      YY(II)=PHI                                                        
C     TAKE ERROR IN PHI PROPORTIONAL TO 1./RR                                                                 
      WP(II)=R1                                                         
C     PRINT1002,J,II,XX(II),YY(II),WP(II),RR                                                                  
 1002 FORMAT(' PHI   ',2I5,4F10.4)                                      
 30   CONTINUE                                                          
      IF(II.GE.2)THEN                                                   
      DO 32 JK=2,II                                                     
      DP=YY(JK)-YY(JK-1)                                                
      IF(DP.GT.0.0)THEN                                                 
      IF(ABS(DP).GT.ABS(DP-PI2))YY(JK)=YY(JK)-PI2                       
      ELSE                                                              
      IF(ABS(DP).GT.ABS(DP+PI2))YY(JK)=YY(JK)+PI2                       
      ENDIF                                                             
 32   CONTINUE                                                          
      ENDIF                                                             
C                                                                                                             
      CALL FTLFTW(XX,YY,WP,II,0,2,RPCOS,PHZ,EL,DRPCOS,DPHZ,COV)
C     RPCOS-SLOPE PHI-Z,PHZ-INTERCEPT  PHI AXIS                                                               
      CH=0.                                                             
C     ERROR IN RPCOS IS UNKNOWN DUE TO R-MEASUREMENT PROBLEMS                                                 
      DRPCOS=1.0                                                        
      DPHZ=1.0                                                          
      DTHET=1.0                                                         
      IF(RPCOS.EQ.0.0.AND.PHZ.EQ.0.0)THEN                               
      CH=2000.                                                          
      RETURN                                                            
      ENDIF                                                             
                                                                        
CDEB  PRINT5000,RPCOS,PHZ,DRPCOS,DPHZ                                                                         
 5000 FORMAT(' PHI-Z RPCOS,PHZ,EPC,EP ',4F10.5)                         
      RETURN                                                            
      END                                                               
*