*-- Author : S.Burke
SUBROUTINE FKITOE(Z,SINT,CINT,EXT)
*-----------------------------------------Updates 21/09/92-------
**: FKITOE.......SB. Cope better (?) with zero field.
*-----------------------------------------Updates 07/09/93-------
**: FKITOE 40000 SB. Only print field warning in production run.
*-----------------------------------------Updates 15/04/94-------
**: FKITOE 40313.GR. only 10 printouts if zero field
*-----------------------------------------Updates----------------
**********************************************************************
* *
* Convert an `internal' vector and covariance to an `external' *
* state vector. *
* *
* External: 1/r, phi, theta, x, y, z, IPTYPE, covariance *
* Internal: x, y, q/p, tan(theta), phi *
* *
* The `external' covariance is packed with COVCP. *
* *
**********************************************************************
*KEEP,FKPIDP.
DOUBLE PRECISION PI,TWOPI,PIBY2
PARAMETER (PI=3.141592653589793238)
PARAMETER (TWOPI=PI*2.0D0,PIBY2=PI/2.0D0)
*KEND.
PARAMETER (BCONV=-0.0002998)
DOUBLE PRECISION Z,SINT(5),CINT(5,5),COS2TH,DIFF3,DIFF4
DIMENSION EXT(16),R(3),B(3),COV(15)
DATA NPRMF/0/
**********************************************************************
* Get the field
R(1) = SINT(1)
R(2) = SINT(2)
R(3) = Z
CALL GUFLD(R,B)
* Trap zero field problems
IF (ABS(B(3)).LT.1.0E-2) B(3) = SIGN(1.0E-2,B(3))
IF (ABS(B(3)).LT.5. .OR. ABS(B(3)).GT.15.) THEN
CALL ERRLOG(334,'S:FKITOE: Bad magnetic field')
CALL H1ENVI(JS,JP,NP)
IF (JS.NE.0.AND.NPRMF.LT.10)THEN
WRITE(6,*) '*** Magnetic field is ',B(3),' ***'
NPRMF=NPRMF+1
ENDIF
ENDIF
* Transform the state vector
IF (ABS(SINT(4)).GT.1.0D-6) THEN
EXT(1) = SINT(3)*BCONV*B(3)*DSQRT(1.D0/SINT(4)**2 + 1.D0)
ELSE
EXT(1) = SINT(3)*BCONV*B(3)*1.0E6
ENDIF
EXT(2) = SINT(5)
IF (EXT(2).GT.PI) EXT(2) = EXT(2) - TWOPI
EXT(3) = DATAN(SINT(4))
EXT(4) = SINT(1)
EXT(5) = SINT(2)
EXT(6) = Z
IPTYPE = 2
CALL UCOPY(IPTYPE,EXT(7),1)
* Differential coefficients
COS2TH = 1.D0/(1.D0 + SINT(4)**2)
IF (ABS(SINT(3)).GT.1.0D-10) THEN
DIFF3 = EXT(1)/SINT(3)
ELSEIF (ABS(SINT(4)).GT.1.0D-6) THEN
DIFF3 = BCONV*B(3)*DSQRT(1.D0/SINT(4)**2 + 1.D0)
ELSE
DIFF3 = BCONV*B(3)*1.0E6
ENDIF
IF (ABS(SINT(4)).GT.1.0D-6) THEN
DIFF4 = -EXT(1)*COS2TH/SINT(4)
ELSE
DIFF4 = -EXT(1)*COS2TH*1.0E6
ENDIF
* Transform the covariance ...
COV(1) = CINT(3,3)*DIFF3**2 + 2.D0*CINT(4,3)*DIFF3*DIFF4
& + CINT(4,4)*DIFF4**2
COV(2) = CINT(5,3)*DIFF3 + CINT(5,4)*DIFF4
COV(3) = CINT(5,5)
COV(4) = (CINT(4,3)*DIFF3 + CINT(4,4)*DIFF4)*COS2TH
COV(5) = CINT(5,4)*COS2TH
COV(6) = CINT(4,4)*COS2TH**2
COV(7) = CINT(3,1)*DIFF3 + CINT(4,1)*DIFF4
COV(8) = CINT(5,1)
COV(9) = CINT(4,1)*COS2TH
COV(10) = CINT(1,1)
COV(11) = CINT(3,2)*DIFF3 + CINT(4,2)*DIFF4
COV(12) = CINT(5,2)
COV(13) = CINT(4,2)*COS2TH
COV(14) = CINT(2,1)
COV(15) = CINT(2,2)
* ... and pack
CALL COVCP(5,COV,EXT(8),-2)
RETURN
END
*