*-- Author : Stephen Burke 26/11/96 SUBROUTINE FFTRF(DZ,Z1,S1,S2,BZEND) ********************************************************************** * * * Transform track vector (S1) through DZ to (S2) in magnetic field. * * * * The field in kG must be supplied through call to GUFLD, and * * is assumed to satisfy |Bz| >> SQRT( Bx**2 + By**2 ) and * * |B2-B1| << |B1| * * ie that the field is constant and aligned with the +/- Z axis. * * A helix track model is used to compute S2. First order * * corrections are applied if necessary: * * * * IAPROX = 1 -> Straight line extrapolation (unused) * * IAPROX = 2 -> As 1 for x and y, but Delta phi varying * * IAPROX = 3 -> Helix model. Bz=constant, Bx = By = 0 (unused) * * IAPROX = 4 -> 1st order corrections assuming Bx and By are * * small but constant across DZ. * * IAPROX = 5 -> as 4 plus 1st order corrections for change * * in field along trajectory. * * * * INPUT; DZ = step length in cm (can be negative) * * Z1 = Z coordinate of starting point in cm * * S1 = (X,Y,q/P,Tan(Theta),Phi) = state vector at Z1 * * * * OUTPUT; S2 = state vector at Z1 + DZ * * BZEND = Bz at track end * * * ********************************************************************** IMPLICIT DOUBLE PRECISION (A-H,O-Z) REAL R(3),R2(3),B2(3),DB(3),BR(3),BZEND DIMENSION S1(5),S2(5) *KEEP,FKPIDP. DOUBLE PRECISION PI,TWOPI,PIBY2 PARAMETER (PI=3.141592653589793238) PARAMETER (TWOPI=PI*2.0D0,PIBY2=PI/2.0D0) *KEND. PARAMETER (BFACT=2.997886E-4) ********************************************************************** * * Thresholds for various approximations (*** UNOPTIMISED ***) * * Max z step over which field is assumed constant PARAMETER (DZMAX=1.0D1) * If DphiCALL GUFLD(R,BR) IF (ABS(BR(3)).LT.0.01) BR(3) = SIGN(0.01,BR(3)) ZR = Z1 ENDIF * Work out Delta phi DPHI = -DZSECT*BR(3)*BFACT*S1(3) S2(5) = S2(5) + DPHI * Choose the order of approximation IF (DABS(DZ).GT.DZMAX) THEN * Must consider change in field over DZ IAPROX = 5 ELSEIF (DABS(DZ*DPHI).GT.DXYMIN) THEN * Must take helix (x and y affected by dphi) IAPROX = 4 ELSE * Ignore change in phi for DX and DY S2(1) = S2(1) + DZ*CPHI1*S1(4) S2(2) = S2(2) + DZ*SPHI1*S1(4) GOTO 9100 ENDIF IF (DABS(DPHI).LT.DPHMAX) THEN * Small angle approximations for cos and sin (to order DPHI**2) DPHI2 = 0.5D0*DPHI CDPHI = 1.D0 - DPHI2*DPHI SPHI2 = SPHI1*CDPHI + CPHI1*DPHI CPHI2 = CPHI1*CDPHI - SPHI1*DPHI DXOTT = DZ*(CPHI1 - SPHI1*DPHI2) DYOTT = DZ*(SPHI1 + CPHI1*DPHI2) ELSE * Full expressions CPHI2 = DCOS(S2(5)) SPHI2 = DSIN(S2(5)) FAC = DZ/DPHI DXOTT = FAC*(SPHI2 - SPHI1) DYOTT = FAC*(CPHI1 - CPHI2) * Remember values PHIR = S2(5) CPHIR = CPHI2 SPHIR = SPHI2 ENDIF * Change in x and y S2(1) = S2(1) + DXOTT*S1(4) S2(2) = S2(2) + DYOTT*S1(4) * * Apply 1st order corrections assuming that Bx and By are * small but non-zero ........ (Bx,By,Bz) is still assumed * to be constant across DZ ...... * DPHIOB = DZSECT*S1(3)*BFACT CON1 = DPHIOB*DZ*0.5D0 CON2 = DPHIOB*OPTSQ IF (S1(4).NE.0.D0) THEN CON3 = DPHIOB/S1(4) ELSE * If theta = 0, phi is undefined, so CON3 can be set to any value CON3 = 0.D0 ENDIF S2(1) = S2(1) - CON1*BR(2) S2(2) = S2(2) + CON1*BR(1) S2(4) = S2(4) + CON2*(BR(1)*SPHI1 - BR(2)*CPHI1) S2(5) = S2(5) + CON3*(BR(1)*CPHI1 + BR(2)*SPHI1) * Are corrections for field variation required? IF (IAPROX.LT.5) GOTO 9000 * Get field at end point ... B2(1) = BR(1) B2(2) = BR(2) B2(3) = BR(3) R2(1) = S2(1) R2(2) = S2(2) R2(3) = Z1 + DZ ZR = Z1 + DZ CALL GUFLD(R2,BR) IF (ABS(BR(3)).LT.0.01) BR(3) = SIGN(0.01,BR(3)) DB(1) = 0.5*(BR(1) - B2(1)) DB(2) = 0.5*(BR(2) - B2(2)) DB(3) = 0.5*(BR(3) - B2(3)) * * DB is the mean difference from the assumed field along the trajectory, * assuming the field components vary linearly with Z over DZ. * ie B and dB/dZ are non-zero but d2B/dZ2 etc are assumed zero. * DBZTT = DB(3)*S1(4) S2(1) = S2(1) + CON1*(DBZTT*SPHI1 - DB(2)) S2(2) = S2(2) + CON1*(DB(1) - DBZTT*CPHI1) S2(4) = S2(4) + CON2*(DB(1)*SPHI1 - DB(2)*CPHI1) S2(5) = S2(5) + CON3*(DB(1)*CPHI1 + DB(2)*SPHI1) - DPHIOB*DB(3) 9000 CONTINUE IF (S2(4).LT.0.D0) THEN S2(4) = DABS(S2(4)) S2(5) = S2(5) + PI ENDIF 9100 CONTINUE IF (DABS(S2(5)).GT.TWOPI) S2(5)=DMOD(S2(5),TWOPI) IF (S2(5).LT.0.D0) S2(5) = S2(5) + TWOPI * Stop values getting too large (i.e. stop overflows) IF (ABS(S2(1)).GT.1.D4) S2(1) = SIGN(1.D4,S2(1)) IF (ABS(S2(2)).GT.1.D4) S2(2) = SIGN(1.D4,S2(2)) IF (S2(4).GT.1.D6) S2(4) = 1.D6 BZEND = BR(3) RETURN END