|
version 1.2, 2003/12/19 13:37:28
|
version 1.3, 2004/01/20 16:02:58
|
|
|
|
| CHARACTER filename*(*) | CHARACTER filename*(*) |
| INTEGER maxorder | INTEGER maxorder |
| LOGICAL path | LOGICAL path |
| REAL p0 |
REAL*8 p0 |
| | |
| * -- load the HMS forward (cosy) map | * -- load the HMS forward (cosy) map |
| * | * |
|
|
|
| * l : exponent of the actual path length | * l : exponent of the actual path length |
| * d : exponent of the delta | * d : exponent of the delta |
| | |
| REAL fac,me |
REAL*8 fac,me |
| PARAMETER (fac = 0.9904599) |
PARAMETER (fac = 0.9904599d00) |
| PARAMETER (me = 0.00051099906) |
PARAMETER (me = 0.00051099906d00) |
| | |
| include 'trans_map.inc' | include 'trans_map.inc' |
| | |
|
|
|
| ENDDO | ENDDO |
| | |
| DO i=1,NLINES | DO i=1,NLINES |
| c1(i) = 0. |
c1(i) = 0.d00 |
| c2(i) = 0. |
c2(i) = 0.d00 |
| c3(i) = 0. |
c3(i) = 0.d00 |
| c4(i) = 0. |
c4(i) = 0.d00 |
| c5(i) = 0. |
c5(i) = 0.d00 |
| e1(i) = 0 | e1(i) = 0 |
| e2(i) = 0 | e2(i) = 0 |
| e3(i) = 0 | e3(i) = 0 |
|
|
|
| DO WHILE (eof .GE. 0) | DO WHILE (eof .GE. 0) |
| | |
| i = e1(num)+e2(num)+e3(num)+e4(num)+e5(num)+e6(num) | i = e1(num)+e2(num)+e3(num)+e4(num)+e5(num)+e6(num) |
| IF ((i .LE. maxorder) .AND. ((c1(num) .NE. 0.0) .OR. |
IF ((i .LE. maxorder) .AND. ((c1(num) .NE. 0.0d00) .OR. |
| > (c2(num) .NE. 0.0) .OR. (c3(num) .NE. 0.0) .OR. |
> (c2(num) .NE. 0.0) .OR. (c3(num) .NE. 0.0d00) .OR. |
| > (c4(num) .NE. 0.0) .OR. (c5(num) .NE. 0.0))) THEN |
> (c4(num) .NE. 0.0) .OR. (c5(num) .NE. 0.0d00))) THEN |
| IF (i .GT. order) order = i | IF (i .GT. order) order = i |
| IF (0 .EQ. first(m)) first(m) = num | IF (0 .EQ. first(m)) first(m) = num |
| last(m) = num | last(m) = num |
|
|
|
| | |
| SUBROUTINE hmsApplyCOSY (u,num) | SUBROUTINE hmsApplyCOSY (u,num) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6) |
REAL*8 u(6) |
| INTEGER num | INTEGER num |
| | |
| * -- apply a COSY matrix on the COSY vector u | * -- apply a COSY matrix on the COSY vector u |
|
|
|
| include 'trans_map.inc' | include 'trans_map.inc' |
| | |
| ! other variables | ! other variables |
| REAL a,uu1(0:10),uu2(0:10),uu3(0:10) |
REAL*8 a,uu1(0:10),uu2(0:10),uu3(0:10) |
| REAL uu4(0:10),uu5(0:10),uu6(0:10) |
REAL*8 uu4(0:10),uu5(0:10),uu6(0:10) |
| INTEGER i | INTEGER i |
| | |
| ! calculate the powers of the focal plane coordinates | ! calculate the powers of the focal plane coordinates |
| uu1(0) = 1. |
uu1(0) = 1.d00 |
| uu2(0) = 1. |
uu2(0) = 1.d00 |
| uu3(0) = 1. |
uu3(0) = 1.d00 |
| uu4(0) = 1. |
uu4(0) = 1.d00 |
| uu5(0) = 1. |
uu5(0) = 1.d00 |
| uu6(0) = 1. |
uu6(0) = 1.d00 |
| uu1(1) = u(1) | uu1(1) = u(1) |
| uu2(1) = u(2) | uu2(1) = u(2) |
| uu3(1) = u(3) | uu3(1) = u(3) |
|
|
|
| ENDDO | ENDDO |
| | |
| DO i=1,5 | DO i=1,5 |
| u(i) = 0. |
u(i) = 0.d00 |
| ENDDO | ENDDO |
| | |
| ! apply the cosy matrix | ! apply the cosy matrix |
|
|
|
| | |
| SUBROUTINE hmsForward (uT,zT,u,zz,lost) | SUBROUTINE hmsForward (uT,zT,u,zz,lost) |
| IMPLICIT none | IMPLICIT none |
| REAL uT(6),zT,u(6),zz |
REAL*8 uT(6),zT,u(6),zz |
| LOGICAL lost | LOGICAL lost |
| | |
| * -- make a single step transport calculation (without treating the acceptance) | * -- make a single step transport calculation (without treating the acceptance) |
|
|
|
| INTEGER i | INTEGER i |
| | |
| lost = .FALSE. | lost = .FALSE. |
| zz = 26.44743 |
zz = 26.44743d00 |
| | |
| ! copy the target coordinates to the u vector | ! copy the target coordinates to the u vector |
| DO i=1,6 | DO i=1,6 |
|
|
|
| | |
| LOGICAL FUNCTION hmsCheckDipole (u,zz,dz) | LOGICAL FUNCTION hmsCheckDipole (u,zz,dz) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz |
REAL*8 u(6),zz,dz |
| | |
| * -- check for the dipole aperture | * -- check for the dipole aperture |
| * | * |
|
|
|
| | |
| hmsCheckDipole = .TRUE. | hmsCheckDipole = .TRUE. |
| | |
| IF (ABS(u(1)).GT.0.27940.OR.ABS(u(3)).GT.0.18415) THEN |
IF (ABS(u(1)).GT.0.27940d00.OR.ABS(u(3)).GT.0.18415d00) THEN |
| IF (ABS(u(1)).GT.0.34290.OR.ABS(u(3)).GT.0.20320) RETURN |
IF (ABS(u(1)).GT.0.34290d00.OR.ABS(u(3)).GT.0.20320d00) RETURN |
| IF (ABS(u(1)).GT.0.27940.AND.ABS(u(3)).GT.0.12065) THEN |
IF (ABS(u(1)).GT.0.27940d00.AND.ABS(u(3)).GT.0.12065d00) THEN |
| IF (((ABS(u(1))-0.27940)**2 + |
IF (((ABS(u(1))-0.27940d00)**2 + |
| > (ABS(u(3))-0.12065)**2).GT.0.06350**2) RETURN |
> (ABS(u(3))-0.12065d00)**2).GT.(0.06350d00)**2) RETURN |
| ENDIF | ENDIF |
| IF (ABS(u(1)).GT.0.13970 .OR. |
IF (ABS(u(1)).GT.0.13970d00 .OR. |
| > (ABS(u(1))-10.1852*ABS(u(3))).GT.2.069633) RETURN |
> (ABS(u(1))-10.1852d00*ABS(u(3))).GT.2.069633d00) RETURN |
| ENDIF | ENDIF |
| | |
| hmsCheckDipole = .FALSE. | hmsCheckDipole = .FALSE. |
|
|
|
| | |
| LOGICAL FUNCTION hmsCheckQuad (u,zz,dz,r) | LOGICAL FUNCTION hmsCheckQuad (u,zz,dz,r) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz,r |
REAL*8 u(6),zz,dz,r |
| | |
| * -- check for the quadrupole aperture | * -- check for the quadrupole aperture |
| * | * |
|
|
|
| | |
| LOGICAL FUNCTION hmsDriftOcta (u,zz,dz,x,y,m,b) | LOGICAL FUNCTION hmsDriftOcta (u,zz,dz,x,y,m,b) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz,x,y,m,b |
REAL*8 u(6),zz,dz,x,y,m,b |
| | |
| * -- drift electron and check for the octagon | * -- drift electron and check for the octagon |
| * | * |
|
|
|
| | |
| LOGICAL FUNCTION hmsDriftTPlate (u,zz,dz,r,y) | LOGICAL FUNCTION hmsDriftTPlate (u,zz,dz,r,y) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz,r,y |
REAL*8 u(6),zz,dz,r,y |
| | |
| * -- drift electron and check for the dipole transition plate | * -- drift electron and check for the dipole transition plate |
| * | * |
|
|
|
| | |
| LOGICAL FUNCTION hmsDriftCirc (u,zz,dz,r) | LOGICAL FUNCTION hmsDriftCirc (u,zz,dz,r) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz,r |
REAL*8 u(6),zz,dz,r |
| | |
| * -- drift electron and check for circular aperture | * -- drift electron and check for circular aperture |
| * | * |
|
|
|
| | |
| LOGICAL FUNCTION hmsDriftRect (u,zz,dz,x0,x,y0,y) | LOGICAL FUNCTION hmsDriftRect (u,zz,dz,x0,x,y0,y) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(6),zz,dz,x0,x,y0,y |
REAL*8 u(6),zz,dz,x0,x,y0,y |
| | |
| * -- drift electron and check for rectangular aperture | * -- drift electron and check for rectangular aperture |
| * | * |
|
|
|
| | |
| SUBROUTINE hmsAccept (uT,zT,u,zz,lost) | SUBROUTINE hmsAccept (uT,zT,u,zz,lost) |
| IMPLICIT none | IMPLICIT none |
| REAL uT(6),zT,u(6),zz |
REAL*8 uT(6),zT,u(6),zz |
| LOGICAL lost | LOGICAL lost |
| | |
| * -- make a transport calculation to find the acceptance | * -- make a transport calculation to find the acceptance |
|
|
|
| LOGICAL hmsDriftCirc | LOGICAL hmsDriftCirc |
| LOGICAL hmsDriftRect | LOGICAL hmsDriftRect |
| | |
| REAL uS(6) |
REAL*8 uS(6) |
| INTEGER i | INTEGER i |
| | |
| lost = .TRUE. | lost = .TRUE. |
|
|
|
| ! ----------------------------------------------------------- sive slit | ! ----------------------------------------------------------- sive slit |
| ! drift to sieve slit: z=1.27636m, | ! drift to sieve slit: z=1.27636m, |
| ! octagon edge m=2.545977, b=0.13502640m | ! octagon edge m=2.545977, b=0.13502640m |
| IF (hmsDriftOcta(u,zz,1.27636-zT,0.0900176,0.0353568, |
IF (hmsDriftOcta(u,zz,1.27636d00,0.0900176d00,0.0353568d00, |
| > 2.5459770,0.1350264)) RETURN |
> 2.5459770d00,0.1350264d00)) RETURN |
| | |
| ! drift to back of sieve slit: z=1.33986m, dz=0.0635m | ! drift to back of sieve slit: z=1.33986m, dz=0.0635m |
| ! octagon edge m=2.546569, b=0.141655189 m | ! octagon edge m=2.546569, b=0.141655189 m |
| IF (hmsDriftOcta(u,zz,0.0635,0.0944368,0.0370839, |
IF (hmsDriftOcta(u,zz,0.0635d00,0.0944368d00,0.0370839d00, |
| > 2.546569,0.141655189)) RETURN |
> 2.546569d00,0.141655189d00)) RETURN |
| | |
| ! ------------------------------------------------------------------ Q1 | ! ------------------------------------------------------------------ Q1 |
| ! drift to mechanical entrance of Q1: z=1.4960m, dz=0.15614m | ! drift to mechanical entrance of Q1: z=1.4960m, dz=0.15614m |
| IF (hmsDriftCirc(u,zz,0.15614,0.202575)) RETURN |
IF (hmsDriftCirc(u,zz,0.15614d00,0.202575d00)) RETURN |
| | |
| ! drift to Q1 entrance EFB: z=1.775805635m, dz=0.279805635m | ! drift to Q1 entrance EFB: z=1.775805635m, dz=0.279805635m |
| u(1)=u(1)+u(2)*0.279805635 |
u(1)=u(1)+u(2)*0.279805635d00 |
| u(3)=u(3)+u(4)*0.279805635 |
u(3)=u(3)+u(4)*0.279805635d00 |
| | |
| ! and save values | ! and save values |
| DO i=1,6 | DO i=1,6 |
|
|
|
| | |
| ! transport through Q1 fringe fields: | ! transport through Q1 fringe fields: |
| CALL hmsApplyCOSY (u,1) | CALL hmsApplyCOSY (u,1) |
| IF (hmsCheckQuad(u,zz,0.279805635,0.202575)) RETURN |
IF (hmsCheckQuad(u,zz,0.279805635d00,0.202575d00)) RETURN |
| | |
| ! transport through Q1, 1/5 at a time: | ! transport through Q1, 1/5 at a time: |
| DO i=1,4 | DO i=1,4 |
| CALL hmsApplyCOSY (u,2) | CALL hmsApplyCOSY (u,2) |
| IF (hmsCheckQuad(u,zz,1.87838873/5.,0.202575)) RETURN |
IF (hmsCheckQuad(u,zz,1.87838873d00/5.d00,0.202575d00)) RETURN |
| ENDDO | ENDDO |
| | |
| ! restore values: | ! restore values: |
|
|
|
| | |
| ! transport to Q1 exit EFB: | ! transport to Q1 exit EFB: |
| CALL hmsApplyCOSY (u,3) | CALL hmsApplyCOSY (u,3) |
| IF (hmsCheckQuad(u,zz,1.87838873/5.,0.202575)) RETURN |
IF (hmsCheckQuad(u,zz,1.87838873d00/5.d00,0.202575d00)) RETURN |
| | |
| ! drift to Q1 mechanical exit: z=3.9340m, dz=0.279805635m | ! drift to Q1 mechanical exit: z=3.9340m, dz=0.279805635m |
| IF (hmsDriftCirc(u,zz,0.279805635,0.202575)) RETURN |
IF (hmsDriftCirc(u,zz,0.279805635d00,0.202575d00)) RETURN |
| | |
| ! ------------------------------------------------------------------ Q2 | ! ------------------------------------------------------------------ Q2 |
| ! drift to mechanical entrance of Q2: z=4.5610m, dz=0.6270m | ! drift to mechanical entrance of Q2: z=4.5610m, dz=0.6270m |
| IF (hmsDriftCirc(u,zz,0.6270,0.29840)) RETURN |
IF (hmsDriftCirc(u,zz,0.6270d00,0.29840d00)) RETURN |
| | |
| ! drift to Q2 entrance EFB: z=4.887021890m, dz=0.326021890m | ! drift to Q2 entrance EFB: z=4.887021890m, dz=0.326021890m |
| u(1)=u(1)+u(2)*0.326021890 |
u(1)=u(1)+u(2)*0.326021890d00 |
| u(3)=u(3)+u(4)*0.326021890 |
u(3)=u(3)+u(4)*0.326021890d00 |
| | |
| ! and save values | ! and save values |
| DO i=1,6 | DO i=1,6 |
|
|
|
| | |
| ! transport through Q2 fringe fields: | ! transport through Q2 fringe fields: |
| CALL hmsApplyCOSY (u,4) | CALL hmsApplyCOSY (u,4) |
| IF (hmsCheckQuad(u,zz,0.326021890,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,0.326021890d00,0.29840d00)) RETURN |
| | |
| ! transport through Q2, 1/5 at a time: | ! transport through Q2, 1/5 at a time: |
| DO i=1,4 | DO i=1,4 |
| CALL hmsApplyCOSY (u,5) | CALL hmsApplyCOSY (u,5) |
| IF (hmsCheckQuad(u,zz,2.15595622/5.,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,2.15595622d00/5.d00,0.29840d00)) RETURN |
| ENDDO | ENDDO |
| | |
| ! restore values: | ! restore values: |
|
|
|
| | |
| ! transport to Q2 exit EFB: | ! transport to Q2 exit EFB: |
| CALL hmsApplyCOSY (u,6) | CALL hmsApplyCOSY (u,6) |
| IF (hmsCheckQuad(u,zz,2.15595622/5.,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,2.15595622d00/5.d00,0.29840d00)) RETURN |
| | |
| ! drift to Q2 mechanical exit: z=7.3690m, dz=0.326021890m | ! drift to Q2 mechanical exit: z=7.3690m, dz=0.326021890m |
| IF (hmsDriftCirc(u,zz,0.326021890,0.29840)) RETURN |
IF (hmsDriftCirc(u,zz,0.326021890d00,0.29840d00)) RETURN |
| | |
| ! ------------------------------------------------------------------ Q3 | ! ------------------------------------------------------------------ Q3 |
| ! drift to mechanical entrance of Q3: z=7.6610m, dz=0.2920m | ! drift to mechanical entrance of Q3: z=7.6610m, dz=0.2920m |
| IF (hmsDriftCirc(u,zz,0.2920,0.29840)) RETURN |
IF (hmsDriftCirc(u,zz,0.2920d00,0.29840d00)) RETURN |
| | |
| ! drift to Q3 entrance EFB: z=7.990200290m, dz=0.329200290m | ! drift to Q3 entrance EFB: z=7.990200290m, dz=0.329200290m |
| u(1)=u(1)+u(2)*0.329200290 |
u(1)=u(1)+u(2)*0.329200290d00 |
| u(3)=u(3)+u(4)*0.329200290 |
u(3)=u(3)+u(4)*0.329200290d00 |
| | |
| ! save values | ! save values |
| DO i=1,6 | DO i=1,6 |
|
|
|
| | |
| ! transport through Q3 fringe fields: | ! transport through Q3 fringe fields: |
| CALL hmsApplyCOSY (u,7) | CALL hmsApplyCOSY (u,7) |
| IF (hmsCheckQuad(u,zz,0.329200290,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,0.329200290d00,0.29840d00)) RETURN |
| | |
| DO i=1,4 | DO i=1,4 |
| CALL hmsApplyCOSY (u,8) | CALL hmsApplyCOSY (u,8) |
| IF (hmsCheckQuad(u,zz,2.14959942/5.,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,2.14959942d00/5.d00,0.29840d00)) RETURN |
| ENDDO | ENDDO |
| | |
| ! and restore values: | ! and restore values: |
|
|
|
| | |
| ! transport to Q3 exit EFB: | ! transport to Q3 exit EFB: |
| CALL hmsApplyCOSY (u,9) | CALL hmsApplyCOSY (u,9) |
| IF (hmsCheckQuad(u,zz,2.14959942/5.,0.29840)) RETURN |
IF (hmsCheckQuad(u,zz,2.14959942d00/5.d00,0.29840d00)) RETURN |
| | |
| ! drift to Q3 mechanical exit: z=10.4690m, dz=0.329200290m | ! drift to Q3 mechanical exit: z=10.4690m, dz=0.329200290m |
| IF (hmsDriftCirc(u,zz,0.329200290,0.29840)) RETURN |
IF (hmsDriftCirc(u,zz,0.329200290d00,0.29840d00)) RETURN |
| | |
| ! -------------------------------------------------------------- Dipole | ! -------------------------------------------------------------- Dipole |
| ! drift to transition plate: z=11.058002m, dz=0.589002m | ! drift to transition plate: z=11.058002m, dz=0.589002m |
| IF (hmsDriftTPlate(u,zz,0.589002,0.30480,0.205232)) RETURN |
IF (hmsDriftTPlate(u,zz,0.589002d00,0.30480d00,0.205232d00)) RETURN |
| | |
| ! drift to opposite side of transition plate: z=11.092800m, dz=0.034798m | ! drift to opposite side of transition plate: z=11.092800m, dz=0.034798m |
| IF (hmsDriftTPlate(u,zz,0.034798,0.30480,0.205232)) RETURN |
IF (hmsDriftTPlate(u,zz,0.034798d00,0.30480d00,0.205232d00)) RETURN |
| IF (hmsCheckDipole(u,zz,0.)) RETURN |
IF (hmsCheckDipole(u,zz,0.d00)) RETURN |
| | |
| ! drift to D magnetic entrance: z=11.55m, dz=0.4572m | ! drift to D magnetic entrance: z=11.55m, dz=0.4572m |
| u(1)=u(1)+u(2)*0.4572 |
u(1)=u(1)+u(2)*0.4572d00 |
| u(3)=u(3)+u(4)*0.4572 |
u(3)=u(3)+u(4)*0.4572d00 |
| IF (hmsCheckDipole(u,zz,0.4572)) RETURN |
IF (hmsCheckDipole(u,zz,0.4572d00)) RETURN |
| | |
| ! save values: | ! save values: |
| DO i=1,6 | DO i=1,6 |
|
|
|
| | |
| ! transport through 1/5 D with rotated entrance face: | ! transport through 1/5 D with rotated entrance face: |
| CALL hmsApplyCOSY (u,10) | CALL hmsApplyCOSY (u,10) |
| IF (hmsCheckDipole(u,zz,5.26053145/5.)) RETURN |
IF (hmsCheckDipole(u,zz,5.26053145d00/5.d00)) RETURN |
| | |
| ! transport through 3/5 D with sector segments: | ! transport through 3/5 D with sector segments: |
| DO i=1,3 | DO i=1,3 |
| CALL hmsApplyCOSY (u,11) | CALL hmsApplyCOSY (u,11) |
| IF (hmsCheckDipole(u,zz,5.26053145/5.)) RETURN |
IF (hmsCheckDipole(u,zz,5.26053145d00/5.d00)) RETURN |
| ENDDO | ENDDO |
| | |
| ! restore values: | ! restore values: |
|
|
|
| | |
| ! transport through D (entrance to exit, fringe fields included): | ! transport through D (entrance to exit, fringe fields included): |
| CALL hmsApplyCOSY (u,13) | CALL hmsApplyCOSY (u,13) |
| IF (hmsCheckDipole(u,zz,5.26053145/5.)) RETURN |
IF (hmsCheckDipole(u,zz,5.26053145d00/5.d00)) RETURN |
| | |
| ! drift to transition plate: z=0.4572m, dz=0.4572m | ! drift to transition plate: z=0.4572m, dz=0.4572m |
| IF (hmsDriftTPlate(u,zz,0.457200,0.34290,0.205232)) RETURN |
IF (hmsDriftTPlate(u,zz,0.457200d00,0.34290d00,0.205232d00)) RETURN |
| IF (hmsCheckDipole(u,zz,0.)) RETURN |
IF (hmsCheckDipole(u,zz,0.d00)) RETURN |
| | |
| ! drift to opposite side of transition plate: z=0.491998m,dz=0.034798m | ! drift to opposite side of transition plate: z=0.491998m,dz=0.034798m |
| IF (hmsDriftTPlate(u,zz,0.034798,0.34290,0.205232)) RETURN |
IF (hmsDriftTPlate(u,zz,0.034798d00,0.34290d00,0.205232d00)) RETURN |
| | |
| ! drift to end of first piece of telescope: z=1.119378m, dz=0.62738m | ! drift to end of first piece of telescope: z=1.119378m, dz=0.62738m |
| IF (hmsDriftCirc(u,zz,0.62738,0.338450)) RETURN |
IF (hmsDriftCirc(u,zz,0.62738d00,0.338450d00)) RETURN |
| | |
| ! drift to end of second piece of telescope: z=4.086098m, dz=2.96672m | ! drift to end of second piece of telescope: z=4.086098m, dz=2.96672m |
| IF (hmsDriftCirc(u,zz,2.96672,0.384175)) RETURN |
IF (hmsDriftCirc(u,zz,2.96672d00,0.384175d00)) RETURN |
| | |
| ! drift to end of third piece of telescope: z=5.578398m, dz=1.4923m | ! drift to end of third piece of telescope: z=5.578398m, dz=1.4923m |
| IF (hmsDriftCirc(u,zz,1.49230,0.460375)) RETURN |
IF (hmsDriftCirc(u,zz,1.49230d00,0.460375d00)) RETURN |
| | |
| ! ----------------------------------------------------------------- hut | ! ----------------------------------------------------------------- hut |
| ! drift to focal plane. This is the reference point for detector positions. | ! drift to focal plane. This is the reference point for detector positions. |
| u(1)=u(1)+u(2)*0.671602 |
u(1)=u(1)+u(2)*0.671602d00 |
| u(3)=u(3)+u(4)*0.671602 |
u(3)=u(3)+u(4)*0.671602d00 |
| zz = zz + 0.671602 |
zz = zz + 0.671602d00 |
| DO i=1,6 | DO i=1,6 |
| uS(i)=u(i) | uS(i)=u(i) |
| ENDDO | ENDDO |
| | |
| ! drift to DC1 entrance: z=-0.51923-0.036=-0.55523m, dz=-0.55523m | ! drift to DC1 entrance: z=-0.51923-0.036=-0.55523m, dz=-0.55523m |
| IF(hmsDriftRect(u,zz,-0.55523,-0.01670,0.565,-0.00343,0.26))RETURN |
IF(hmsDriftRect(u,zz,-0.55523d00,-0.01670d00,0.565d00,-0.00343d00,0.26d00))RETURN |
| ! drift to DC1 exit: z=-0.51923+0.054=-0.46523m, dz=0.090m | ! drift to DC1 exit: z=-0.51923+0.054=-0.46523m, dz=0.090m |
| IF(hmsDriftRect(u,zz, 0.09000,-0.01670,0.565,-0.00343,0.26))RETURN |
IF(hmsDriftRect(u,zz, 0.09000d00,-0.01670d00,0.565d00,-0.00343d00,0.26d00))RETURN |
| ! drift to DC2 entrance: z=0.29299-0.036=0.25699m, dz=0.72222m | ! drift to DC2 entrance: z=0.29299-0.036=0.25699m, dz=0.72222m |
| IF(hmsDriftRect(u,zz, 0.72222,-0.02758,0.565,-0.01653,0.26))RETURN |
IF(hmsDriftRect(u,zz, 0.72222d00,-0.02758d00,0.565d00,-0.01653d00,0.26d00))RETURN |
| ! drift to DC2 exit: z=0.29299+0.054=0.34699m, dz=0.090m | ! drift to DC2 exit: z=0.29299+0.054=0.34699m, dz=0.090m |
| IF(hmsDriftRect(u,zz, 0.09000,-0.02758,0.565,-0.01653,0.26))RETURN |
IF(hmsDriftRect(u,zz, 0.09000d00,-0.02758d00,0.565d00,-0.01653d00,0.26d00))RETURN |
| | |
| ! drift to S1X: z=0.7783m, dz=0.43131m | ! drift to S1X: z=0.7783m, dz=0.43131m |
| IF (hmsDriftRect(u,zz,0.43131,0.015,0.6025,0.000,0.3775)) RETURN |
IF (hmsDriftRect(u,zz,0.43131d00,0.015d00,0.6025d00,0.000d00,0.3775d00)) RETURN |
| ! drift to S1Y: z=0.9752m, dz=0.1969m | ! drift to S1Y: z=0.9752m, dz=0.1969m |
| IF (hmsDriftRect(u,zz,0.19690,0.000,0.6025,0.001,0.3775)) RETURN |
IF (hmsDriftRect(u,zz,0.19690d00,0.000d00,0.6025d00,0.001d00,0.3775d00)) RETURN |
| ! skip CK - no survey information | ! skip CK - no survey information |
| ! drift to S2X: z=2.9882m, dz=2.013m | ! drift to S2X: z=2.9882m, dz=2.013m |
| IF (hmsDriftRect(u,zz,2.01300,0.004,0.6025,0.000,0.3775)) RETURN |
IF (hmsDriftRect(u,zz,2.01300d00,0.004d00,0.6025d00,0.000d00,0.3775d00)) RETURN |
| ! drift to S2Y: z=3.1851m, dz=0.1969m | ! drift to S2Y: z=3.1851m, dz=0.1969m |
| IF (hmsDriftRect(u,zz,0.19690,0.000,0.6025,0.013,0.3775)) RETURN |
IF (hmsDriftRect(u,zz,0.19690d00,0.000d00,0.6025d00,0.013d00,0.3775d00)) RETURN |
| | |
| ! drift to CAL: z=3.3869m, dz=0.2018m | ! drift to CAL: z=3.3869m, dz=0.2018m |
| IF (hmsDriftRect(u,zz,0.20180,-0.134,0.6000,0.000,0.3000)) RETURN |
IF (hmsDriftRect(u,zz,0.20180d00,-0.134d00,0.6000d00,0.000d00,0.3000d00)) RETURN |
| | |
| ! --------------------------------------------------------------- done | ! --------------------------------------------------------------- done |
| lost = .FALSE. | lost = .FALSE. |
|
|
|
| PARAMETER (NTERMS=1000) | PARAMETER (NTERMS=1000) |
| | |
| INTEGER e1(NTERMS),e2(NTERMS),e3(NTERMS),e4(NTERMS),num,order | INTEGER e1(NTERMS),e2(NTERMS),e3(NTERMS),e4(NTERMS),num,order |
| REAL c1(NTERMS),c2(NTERMS),c3(NTERMS),c4(NTERMS) |
REAL*8 c1(NTERMS),c2(NTERMS),c3(NTERMS),c4(NTERMS) |
| COMMON /hmsRecon/num,order,e1,e2,e3,e4,c1,c2,c3,c4 | COMMON /hmsRecon/num,order,e1,e2,e3,e4,c1,c2,c3,c4 |
| | |
| ! other variables | ! other variables |
|
|
|
| READ (line,20,IOSTAT=eof) | READ (line,20,IOSTAT=eof) |
| > c2(num), c3(num), c4(num), c1(num), | > c2(num), c3(num), c4(num), c1(num), |
| > e1(num), e2(num), e3(num), e4(num), e5 | > e1(num), e2(num), e3(num), e4(num), e5 |
| IF (((c1(num) .NE. 0.0) .OR. (c2(num) .NE. 0.0) .OR. |
IF (((c1(num) .NE. 0.0d00) .OR. (c2(num) .NE. 0.0d00) .OR. |
| > (c3(num) .NE. 0.0) .OR. (c4(num) .NE. 0.0)) .AND. |
> (c3(num) .NE. 0.0d00) .OR. (c4(num) .NE. 0.0d00)) .AND. |
| > (e5 .EQ. 0) .AND. (eof .EQ. 0)) THEN | > (e5 .EQ. 0) .AND. (eof .EQ. 0)) THEN |
| i = e1(num) + e2(num) + e3(num) + e4(num) | i = e1(num) + e2(num) + e3(num) + e4(num) |
| IF (i .GT. order) order = i | IF (i .GT. order) order = i |
|
|
|
| | |
| IMPLICIT NONE | IMPLICIT NONE |
| | |
| REAL uT(6), du(4) |
REAL*8 uT(6), du(4) |
| | |
| * -- calculates the focal plane correction for a given | * -- calculates the focal plane correction for a given |
| * set of target coordinates | * set of target coordinates |
|
|
|
| include 'trans_map.inc' | include 'trans_map.inc' |
| | |
| ! other variables | ! other variables |
| REAL a,uu1(0:10),uu2(0:10),uu3(0:10),uu4(0:10),uu6(0:10) |
REAL*8 a,uu1(0:10),uu2(0:10),uu3(0:10),uu4(0:10),uu6(0:10) |
| INTEGER i | INTEGER i |
| | |
| uu1(0) = 1. |
uu1(0) = 1.d00 |
| uu2(0) = 1. |
uu2(0) = 1.d00 |
| uu3(0) = 1. |
uu3(0) = 1.d00 |
| uu4(0) = 1. |
uu4(0) = 1.d00 |
| uu6(0) = 1. |
uu6(0) = 1.d00 |
| | |
| ! drift backwards to z=0 | ! drift backwards to z=0 |
| uu1(1)=uT(1)-uT(2)*uT(5) | uu1(1)=uT(1)-uT(2)*uT(5) |
|
|
|
| | |
| ! calculate the powers of the COSY coordinates | ! calculate the powers of the COSY coordinates |
| DO i=1,4 | DO i=1,4 |
| du(i) = 0. |
du(i) = 0.d00 |
| ENDDO | ENDDO |
| | |
| DO i=2,order | DO i=2,order |
|
|
|
| | |
| SUBROUTINE hmsReconInPlane (u,uT,ok) | SUBROUTINE hmsReconInPlane (u,uT,ok) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(4),uT(6) |
REAL*8 u(4),uT(6) |
| LOGICAL ok | LOGICAL ok |
| | |
| * -- performs the reconstruction of the target coordinates | * -- performs the reconstruction of the target coordinates |
|
|
|
| PARAMETER (NTERMS=1000) | PARAMETER (NTERMS=1000) |
| | |
| INTEGER e1(NTERMS),e2(NTERMS),e3(NTERMS),e4(NTERMS),num,order | INTEGER e1(NTERMS),e2(NTERMS),e3(NTERMS),e4(NTERMS),num,order |
| REAL c1(NTERMS),c2(NTERMS),c3(NTERMS),c4(NTERMS) |
REAL*8 c1(NTERMS),c2(NTERMS),c3(NTERMS),c4(NTERMS) |
| COMMON /hmsRecon/num,order,e1,e2,e3,e4,c1,c2,c3,c4 | COMMON /hmsRecon/num,order,e1,e2,e3,e4,c1,c2,c3,c4 |
| | |
| ! other variables | ! other variables |
| REAL a,uu1(0:10),uu2(0:10),uu3(0:10),uu4(0:10) |
REAL*8 a,uu1(0:10),uu2(0:10),uu3(0:10),uu4(0:10) |
| INTEGER i | INTEGER i |
| | |
| | |
| DO i=1,6 | DO i=1,6 |
| uT(i) = 0. |
uT(i) = 0.d00 |
| ENDDO | ENDDO |
| | |
| ! calculate the powers of the focal plane coordinates | ! calculate the powers of the focal plane coordinates |
| | |
| uu1(0) = 1. |
uu1(0) = 1.d00 |
| uu2(0) = 1. |
uu2(0) = 1.d00 |
| uu3(0) = 1. |
uu3(0) = 1.d00 |
| uu4(0) = 1. |
uu4(0) = 1.d00 |
| | |
| uu1(1) = u(1) | uu1(1) = u(1) |
| uu2(1) = u(2) | uu2(1) = u(2) |
| uu3(1) = u(3) | uu3(1) = u(3) |
| uu4(1) = u(4) | uu4(1) = u(4) |
| |
|
| DO i=2,order | DO i=2,order |
| uu1(i)=uu1(i-1)*uu1(1) | uu1(i)=uu1(i-1)*uu1(1) |
| uu2(i)=uu2(i-1)*uu2(1) | uu2(i)=uu2(i-1)*uu2(1) |
| uu3(i)=uu3(i-1)*uu3(1) | uu3(i)=uu3(i-1)*uu3(1) |
| uu4(i)=uu4(i-1)*uu4(1) | uu4(i)=uu4(i-1)*uu4(1) |
| ENDDO | ENDDO |
| |
|
| ! calculate the target coordinates | ! calculate the target coordinates |
| DO i = 1, num | DO i = 1, num |
| a = uu1(e1(i)) * uu2(e2(i)) * uu3(e3(i)) * uu4(e4(i)) | a = uu1(e1(i)) * uu2(e2(i)) * uu3(e3(i)) * uu4(e4(i)) |
|
|
|
| | |
| SUBROUTINE hmsReconOutOfPlane (u,x,uT,ok) | SUBROUTINE hmsReconOutOfPlane (u,x,uT,ok) |
| IMPLICIT NONE | IMPLICIT NONE |
| REAL u(4),x,uT(6) |
REAL*8 u(4),x,uT(6) |
| LOGICAL ok | LOGICAL ok |
| | |
| * -- performs the reconstruction of the target coordinates | * -- performs the reconstruction of the target coordinates |
|
|
|
| * - set to false when no reconstruction is found | * - set to false when no reconstruction is found |
| * momentum from p0) | * momentum from p0) |
| | |
| REAL eps |
REAL*8 eps |
| PARAMETER (eps = 0.0005) ! accuracy in delta |
PARAMETER (eps = 0.0005d00) ! accuracy in delta |
| | |
| REAL dd,du(4),u0(4) |
REAL*8 dd,du(4),u0(4) |
| INTEGER n | INTEGER n |
| | |
| | |
| |
|
| CALL hmsReconInPlane (u,uT,ok) ! first guess | CALL hmsReconInPlane (u,uT,ok) ! first guess |
| uT(1) = x | uT(1) = x |
| |
c |
| |
c |
| |
du(1) = 0.d00 |
| |
du(2) = 0.d00 |
| |
du(3) = 0.d00 |
| |
du(4) = 0.d00 |
| | |
| du(1) = 0. |
dd = 1.d00 |
| du(2) = 0. |
|
| du(3) = 0. |
|
| du(4) = 0. |
|
| |
|
| dd = 1. |
|
| n = 0 | n = 0 |
| |
|
| DO WHILE ((ABS(dd) .GT. eps) .AND. (n .LT. 10) .AND. ok) | DO WHILE ((ABS(dd) .GT. eps) .AND. (n .LT. 10) .AND. ok) |
| | |
| CALL hmsReconOffset (uT,du) | CALL hmsReconOffset (uT,du) |
|
|
|
| RETURN | RETURN |
| END | END |
| | |
| |
|
Return to
hms_track.f
CVS log
Up to [HallC] / pol_hms_single