*			PROGRAM I.12			    *

*******************************************************************************
*                                 TRACKSUB1                                   *
* THIS IS THE MODIFICATION OF TRACKSUB5 AND SHOULD BE LINKED WITH TRAJ2PT.    *
*******************************************************************************
 

      SUBROUTINE VELOPROJ(V,VX,VY,VZ,THETA,PHI)

C PURPOSE : GIVEN THE VELOCITY, TO FIND THE COMPONENTS OF VELOCITY
C IN THE CARTESIAN COORDINATE SYSTEM I.E. TO FIND Vx,Vy,Vz

      REAL*8 PHI,PHI1,PI,RAD,THETA,THETA1,V,VX,VY,VZ

      PI = 4.0D0 * DATAN(1.0D0)
      RAD = PI/180.0D0
      THETA1 = THETA * RAD
      PHI1 = PHI * RAD
      VX = V * DSIN(THETA1) * DCOS(PHI1)
      VY = V * DSIN(THETA1) * DSIN(PHI1)
      VZ = V * DCOS(THETA1)
 

      RETURN
      END
   

C---------------------------------------------------------------------
C---------------------------------------------------------------------
      REAL*8 FUNCTION EVELO(EK)
   

C PURPOSE : TO FIND THE RATIO OF THE VELOCITY OF THE e TO THE VELOCITY
C OF LIGHT. I.E. TO COMPUTE V/C GIVEN THE INITIAL ENERGY OF THE ELECTRON 
C IN MEV.             2                    2
C FORMULA USED : (V/C) = 1 -   (REST MASS)
C                           ---------------- 2
C                          (K.E. + REST MASS)

      IMPLICIT NONE
      REAL*8 C,E1,EK,TEMP
      DATA C/2.998D0/,E1/0.511D0/
   

      TEMP = E1/(E1+EK)
      EVELO = C * DSQRT(1 - TEMP*TEMP)
  

      RETURN
      END
       

C---------------------------------------------------------------------
C----------------------------------------------------------------------
      SUBROUTINE GEOM
 

C PURPOSE: THIS SUBROUTINE OPENS THE FILES:
C  COOR*.DAT:IT CONTAINS THE COORDINATES OF ALL THE VERTICES OF ALL THE 
C            PLANE SURFACES THAT THE PARTICLE IS LIKELY TO HIT 
C  COEFF.DAT:IT CONTAINS THE CONSTANT COEFFICIENTS A,B,C,D OF EACH OF THE
C            PLANES THAT THE PARTILCE IS LIKELY TO HIT
C  AND IT INITIALISES THE ARRAYS:
C  CHAN:EACH ROW CORRESPONDS TO A PLANE SURFACE;
C       COL. 1:NO. OF VERTICES OF THAT PLANE POLYGON
C       COL. 2>>>COL. NVERT*3+1 :ALL THE COORDINATES OF THE VERTICES
C  COEFF:EACH ROW CORRESPONDS TO A PLANE POLYGON
C       COL. 1>>>COL. 4 :A,B,C,D

      IMPLICIT NONE
      CHARACTER*72 FNAME,FNAME1
      INTEGER HIT,I,I1,I2,J,K,MAXCOO,MAXSURF,NS,NV,NSURF,NVERT,NTY
      PARAMETER (MAXCOO=55,MAXSURF=55)
      REAL*8 A,B,C,D
      REAL*8 CHAN(MAXSURF,MAXCOO),COEFF(MAXSURF,4),TLN(2,3),VERT(10,3),
     & Y(6)
      COMMON /CHAN/CHAN,/TLN/TLN,/COEFF/COEFF,/NTY/NTY

      WRITE(6,*) 'ENTER THE NAME OF THE FILE OF COORDINATES'
      READ(5,10) FNAME
      OPEN (UNIT=1,STATUS='OLD',FILE=FNAME)  

      WRITE(6,*) 'ENTER THE NAME OF THE FILE OF COEFFICIENTS'
      READ(5,10) FNAME1
      OPEN (UNIT=2,STATUS='OLD',FILE=FNAME1)  

      READ (1,*)
2     READ(1,*,END=70) NTY
      READ(1,*) NVERT
      CHAN(NTY,1) = DFLOAT(NVERT)
      I1=2
3     READ(1,20,ERR=2) (CHAN(NTY,K),K=I1,I1+2)
      I1=K
      GO TO 3
70    CLOSE(1)

      I2=1
4     READ(2,30,END=80) NS,NV,(COEFF(I2,J),J=1,4)
      I2=I2+1
      GO TO 4
80    CLOSE(2)

D      DO I=1,NTY
D       WRITE(6,*) 'SURFACE NO.:',I
D       WRITE(6,*)'COORDINATES ARE:'
D       WRITE(6,*) (CHAN(I,J),J=2,IDINT(CHAN(I,1))*3+1)
D       WRITE(6,*) 'THE PLANE COEFFICIENTS ARE:'
D       WRITE(6,*) (COEFF(I,J),J=1,4)
D      END DO

10    FORMAT(A72)
20    FORMAT(3(X,F9.6))
30    FORMAT(1X,I3,1X,I3,4(1X,D13.6))

      RETURN
      END
C-------------------------------------------------------------------------
C-------------------------------------------------------------------------
      SUBROUTINE PASSOUTPUT

C PURPOSE:THIS PROGRAM OUTPUTS THE POLAR & THE AZIMUTHAL ANGLES 
C         OF THE ESCAPING PARTICLES ONTO A FILE.
C
C NPAS : TOTAL NO. OF PARTICLES THAT ESCAPE THE SENSOR ASSEMBLY
C PAS(I,J)  : 2-D ARRAY 
C        I  : NO. OF ESCAPING PARTICLE
C        J=1: POLAR ANGLE AT THE DETECTOR
C         =2: AZIMUTHAL ANGLE AT THE DETECTOR
C         =3: POLAR ANGLE AT THE APERTURE
C         =4: AZIMUTHAL ANGLE AT THE APERTURE
C         =5-10 :X,Y,Z,Vx,Vy,Vz OF THE ESCAPING PARTICLE

      IMPLICIT NONE   
      CHARACTER*72 FNAME1
      INTEGER I,J,NPAS,NTRAJ
      REAL*8 PI,RAD

      COMMON /FNAME1/FNAME1
      INCLUDE 'PASS.CMN'
   

      PI = 4.0D0*DATAN(1.0D0)
      RAD = 180.0D0/PI
    

      OPEN(UNIT=8,FILE=FNAME1,ACCESS='SEQUENTIAL',STATUS='OLD')
      WRITE(8,*) 'NPAS:',NPAS
      WRITE(8,*)
      WRITE(8,20)
      DO I=1,NPAS
       PAS(I,3) = PAS(I,3)*RAD
       PAS(I,4) = PAS(I,4)*RAD       
       WRITE(8,10) (PAS(I,J),J=1,10)
      END DO

 10   FORMAT(1X,4(F7.2,X),6(D15.8,X))
 20   FORMAT (1X,' THETA ',1X,'  PHI  ',1X,' OMEGA ',1X,'  PSI  ',
     & X,6X,'X(+02)',3X,X,6X,'Y(+02)',3X,X,6X,'Z(+02)',3X,X,4X,
     & 'VX(+10)',4X,X,4X,'VY(+10)',4X,X,4X,'VZ(+10)',4X)

      RETURN
      END
C----------------------------------------------------------------------------
C----------------------------------------------------------------------------
      REAL*8 FUNCTION FPHI(XT,YT)
C
      IMPLICIT NONE
      REAL*8 PI,TOL,XT,YT
      PARAMETER (TOL=0.1D-10)
D      PRINT *,'TOL: ',TOL
      PI=4.0D0*DATAN(1.0D0)

      IF (DABS(XT).LT.TOL .AND. YT.GT.0.0D0) THEN
         FPHI=PI/2.0D0
D         PRINT *,'I AM IN 1'
      ELSE
         IF (DABS(XT) .LT. TOL .AND. YT.LT.0.0D0) THEN
           FPHI=1.5D0*PI
D           PRINT *,'I AM IN 2'
         ELSE
           IF (XT.GT.0.D0.AND.YT.GE.0.0D0) THEN
             FPHI=DATAN(YT/XT)
D             PRINT *,'I AM IN 3'
            ELSE
              IF (XT.LT.0.0D0.AND.YT.GE.0.D0) THEN
                FPHI=PI-DATAN(YT/DABS(XT))
D                PRINT *,'I AM IN 4'
              ELSE
                IF (XT.LT.0.D0.AND.YT.LE.0.0D0) THEN
                  FPHI=PI+DATAN(YT/XT)
D                  PRINT *,'I AM IN 5'
                 ELSE
                     FPHI=2*PI-DATAN(DABS(YT)/XT)
D                     PRINT *,'I AM IN 6'
                 END IF
               END IF
            END IF
         END IF
      END IF
      RETURN
      END 
C------------------------------------------------------------------------
C------------------------------------------------------------------------

Return to the Table of Contents for Buckley's Thesis

Return to HISCALE List of Appendices

Return to Ulysses HISCALE Data Analysis Handbook Table of Contents