1843 lines
42 KiB
Fortran
1843 lines
42 KiB
Fortran
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE MASSTAB_SETZEN
|
|
C =========================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
|
|
common /pawc/ memory ! Der Arbeitsbereich fuer HBOOK
|
|
|
|
|
|
c Initialisierungen vornehmen:
|
|
|
|
c CALL HLIMIT(HB_memsize) ! Speichergroesse uebermitteln (nicht schon in MUTRACK?)
|
|
|
|
CALL HPLINT(0) ! init. HPLOT-package (without opening a
|
|
! graphics window)
|
|
c CALL IGZSET ('GZ') ! output to workstation and to ZEBRA
|
|
c 7-Aug-1996: herauskommentiert, da offensichtlich unnoetig oder sogar stoerend
|
|
|
|
c CALL IOPKS(6) ! init. graphic package (error mess. to screen)
|
|
c 7-Aug-1996: herauskommentiert, da HPLINT wohl IOPKS impliziert.
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IOPWK(1,11,1) ! open WS for 'CHAM_1'
|
|
CALL IOPWK(3,21,2) ! open WS for 'CHAM_2'
|
|
CALL IOPWK(4,31,3) ! open WS for 'HISTO'
|
|
CALL IOPWK(5,41,4) ! open WS for 'TEXT'
|
|
endif
|
|
|
|
|
|
c Farbtafeln fuer WS 1 'CHAM_1' setzen:
|
|
|
|
call iscr(1,0,1.,1.,1.)
|
|
call iscr(1,1,0.,0.,0.)
|
|
call iscr(1,2,1.,0.,0.)
|
|
call iscr(1,3,1.,0.5,0.)
|
|
call iscr(1,4,0.,1.,0.)
|
|
call iscr(1,5,0.,1.,1.)
|
|
call iscr(1,6,0.,0.,1.)
|
|
call iscr(1,7,1.,0.,1.)
|
|
|
|
|
|
c Farbtafeln fuer WS 2 'CHAM_2' setzen:
|
|
|
|
call iscr(2,0,1.,1.,1.)
|
|
call iscr(2,1,0.,0.,0.)
|
|
call iscr(2,2,1.,0.,0.)
|
|
call iscr(2,3,1.,0.5,0.)
|
|
call iscr(2,4,0.,1.,0.)
|
|
call iscr(2,5,0.,1.,1.)
|
|
call iscr(2,6,0.,0.,1.)
|
|
call iscr(2,7,1.,0.,1.)
|
|
|
|
|
|
c Masstaebe definieren:
|
|
|
|
c - Transformationsindex 1 fuer 'CHAM_1':
|
|
|
|
c CALL ISVP(5,0.,1.,0.,1.) ! viewport boundaries
|
|
c CALL ISWN(5,-rLNShield-10.,600.,-100.,100.) ! window boundaries
|
|
cc CALL ISWN(5,-rLNShield-50.,xSpiegel+200.,-70.,50.) ! window boundaries
|
|
cc CALL ISWN(5,-rLNShield-50.,xSpiegel+200.,-dy_Graph1-20.,dy_Graph1)
|
|
|
|
c - Transformationsindex 2 fuer 'CHAM_2':
|
|
|
|
c CALL ISVP(2,0.,1.,0.,1.) ! viewport boundaries
|
|
c CALL ISWN(2,-60.,xMCP2+200.,-70.,50.) ! window boundaries
|
|
cc CALL ISWN(2,-60.,xMCP2+200.,-dy_Graph2-20.,dy_Graph2)
|
|
|
|
c - Transformationsindex 3 fuer 'TEXT':
|
|
|
|
c CALL ISVP(3,0.,1.,0.,1.) ! viewport boundaries
|
|
c CALL ISWN(3,0.,100.,0.,100.) ! window boundaries
|
|
|
|
|
|
c alte Version:
|
|
|
|
CALL ISWN(2,-60.,xMCP2+200.,-70.,50.) ! MASSTAB SETZEN
|
|
c CALL ISWN(2,-60.,1300.,-70.,50.) ! MASSTAB SETZEN
|
|
CALL ISVP(2,0.,1.,0.,1.)
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_CHAMBER(schnitt_p)
|
|
C ==================================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC'
|
|
INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'
|
|
|
|
logical lense2
|
|
common /lense2/ lense2
|
|
|
|
real alfa_window
|
|
real dxTarget /10./
|
|
|
|
real x1,x2,ri,ro
|
|
real x(9),y(9)
|
|
|
|
integer SCHNITT_P, COLOR
|
|
real SCHNITT_X
|
|
logical VERTICAL
|
|
COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL
|
|
|
|
logical TriggerInBeam
|
|
COMMON /TRIGGERINBEAM/ TriggerInBeam
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
COMMON /pawc/ memory
|
|
|
|
real help
|
|
|
|
|
|
c===============================================================================
|
|
c 1. Kammerteil zeichnen:
|
|
c===============================================================================
|
|
|
|
c Picture waehlen:
|
|
|
|
CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture
|
|
c CALL ISELNT(5) ! Masstab '1' aktivieren
|
|
CALL ISELNT(2) ! Masstab '2' aktivieren
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Marker fuer Schnittebene plazieren:
|
|
|
|
call ISMK (23) ! Markertyp fuer Schnittebenenmarkierung waehlen
|
|
if (schnitt_p.eq.1) call IPM(1,SCHNITT_X,45.) ! 45: y-POS. DES MARKERS
|
|
|
|
|
|
c Zeichne Achsen:
|
|
|
|
c - x-ACHSE:
|
|
CALL IGAXIS (0.,xSpiegel+130.,-60.,-60.,0.,xSpiegel+130.,20,'O+')
|
|
|
|
c - y-ACHSE:
|
|
CALL IGAXIS (xSpiegel+130.,xSpiegel+130.,-60.,40.,-60.,40.,20,'O+')
|
|
|
|
|
|
if (.NOT.vertical) goto 4321
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c VERTIKALE DRAUFSICHT:
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Zeichne aus Boxen bestehende Elemente:
|
|
|
|
c Box um 1. Kammerteil:
|
|
|
|
CALL IGBOX(-rLNShield-20.,xSpiegel+256.,-70.,50.)
|
|
|
|
|
|
c Moderator:
|
|
|
|
CALL IGBOX(xTarget-dxTarget,xTarget,-dyTarget/2.,+dyTarget/2.)
|
|
|
|
|
|
c Linse 1:
|
|
|
|
ri = iRadiusCyl_L1 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1-LengthOuterCyl_L1
|
|
x2 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L1 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1
|
|
x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1
|
|
x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1+LengthOuterCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit durchgezogenen Linien:
|
|
|
|
CALL ISLWSC(4.) ! LINIENDICKE: moderat
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
|
|
c He-Schirm:
|
|
|
|
alfa_window = asind(.5*dyHeShield/rHeShield)
|
|
CALL IGARC (0.,0.,rHeShield,rHeShield+2.,alfa_window,360.-alfa_window)
|
|
|
|
|
|
c LN-Schirm:
|
|
|
|
alfa_window = asind(.5*dyLNShield/rLNShield)
|
|
CALL IGARC (0.,0.,rLNShield,rLNShield+2.,alfa_window,360.-alfa_window)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gepunkteten Linien:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c Beschleuniger:
|
|
|
|
c - 1. Gitter:
|
|
|
|
X(1)= xGrid1
|
|
Y(1)= dyGrid1/2.
|
|
X(2)= X(1)
|
|
Y(2)=-Y(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
c - 2. Gitter:
|
|
|
|
X(1)= xGrid2
|
|
Y(1)= dyGrid2/2.
|
|
X(2)= X(1)
|
|
Y(2)=-Y(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c Spiegel:
|
|
|
|
|
|
c - 1. Gitter:
|
|
|
|
help = DreharmLaenge + dSpiegel/2
|
|
|
|
x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c - Mittelebene:
|
|
|
|
help = DreharmLaenge
|
|
|
|
x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c - 2. Gitter:
|
|
|
|
help = DreharmLaenge - dSpiegel/2
|
|
|
|
x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
y(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
goto 4322
|
|
4321 continue
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c HORIZONTALE DRAUFSICHT:
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Zeichne aus Boxen bestehende Elemente:
|
|
|
|
c Box um 1. Kammerteil:
|
|
|
|
CALL IGBOX(-rLNShield-20.,xSpiegel+256.,-70.,50.)
|
|
|
|
|
|
c Moderator:
|
|
|
|
CALL IGBOX (xTarget-dxTarget,xTarget,-dzTarget/2.,+dzTarget/2.)
|
|
|
|
|
|
c Linse 1:
|
|
|
|
ri = iRadiusCyl_L1 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1-LengthOuterCyl_L1
|
|
x2 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1-DistanceCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L1 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L1-0.5*LengthInnerCyl_L1
|
|
x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L1 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1
|
|
x2 = xCenterOfLense_L1+0.5*LengthInnerCyl_L1+DistanceCyl_L1+LengthOuterCyl_L1
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit durchgezogenen Linien:
|
|
|
|
CALL ISLWSC(4.) ! LINIENDICKE: moderat
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
|
|
c He-Schirm:
|
|
|
|
alfa_window = asind(.5*dyHeShield/rHeShield)
|
|
x(1) = -rHeShield
|
|
x(2) = +rHeShield
|
|
x(3) = +rHeShield
|
|
x(4) = rHeShield*cosd(alfa_window)
|
|
x(5) = x(4)
|
|
x(6) = +rHeShield
|
|
x(7) = +rHeShield
|
|
x(8) = -rHeShield
|
|
x(9) = -rHeShield
|
|
|
|
y(1) = -1.3*dzHeShield/2.
|
|
y(2) = -1.3*dzHeShield/2.
|
|
y(3) = -dzHeShield/2.
|
|
y(4) = -dzHeShield/2.
|
|
y(5) = +dzHeShield/2.
|
|
y(6) = +dzHeShield/2.
|
|
y(7) = +1.3*dzHeShield/2.
|
|
y(8) = +1.3*dzHeShield/2.
|
|
y(9) = -1.3*dzHeShield/2.
|
|
|
|
call IPL(9,x,y)
|
|
|
|
|
|
c LN-Schirm:
|
|
|
|
alfa_window = asind(.5*dyLNShield/rLNShield)
|
|
x(1) = -rLNShield
|
|
x(2) = +rLNShield
|
|
x(3) = +rLNShield
|
|
x(4) = rLNShield*cosd(alfa_window)
|
|
x(5) = x(4)
|
|
x(6) = +rLNShield
|
|
x(7) = +rLNShield
|
|
x(8) = -rLNShield
|
|
x(9) = -rLNShield
|
|
|
|
y(1) = -1.3*dzLNShield/2.
|
|
y(2) = -1.3*dzLNShield/2.
|
|
y(3) = -dzLNShield/2.
|
|
y(4) = -dzLNShield/2.
|
|
y(5) = +dzLNShield/2.
|
|
y(6) = +dzLNShield/2.
|
|
y(7) = +1.3*dzLNShield/2.
|
|
y(8) = +1.3*dzLNShield/2.
|
|
y(9) = -1.3*dzLNShield/2.
|
|
|
|
call IPL(9,x,y)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gepunkteten Linien:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c Beschleuniger:
|
|
|
|
c - 1. Gitter:
|
|
|
|
X(1)= xGrid1
|
|
Y(1)= dzGrid1/2.
|
|
X(2)= X(1)
|
|
Y(2)=-Y(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
c - 2. Gitter:
|
|
|
|
X(1)= xGrid2
|
|
Y(1)= dzGrid2/2.
|
|
X(2)= X(1)
|
|
Y(2)=-Y(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c Spiegel:
|
|
|
|
y(1) = hSpiegel/2.
|
|
y(2) = -y(1)
|
|
|
|
c - 1. Gitter:
|
|
|
|
help = DreharmLaenge + dSpiegel/2
|
|
|
|
x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
cc - Mittelebene:
|
|
c
|
|
c help = DreharmLaenge
|
|
c
|
|
c x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
c x(2) = x(1)
|
|
c CALL IPL (2,X,Y)
|
|
c x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
c x(2) = x(1)
|
|
c CALL IPL (2,X,Y)
|
|
|
|
|
|
c - 2. Gitter:
|
|
|
|
help = DreharmLaenge - dSpiegel/2
|
|
|
|
x(1) = xSpiegel + bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
x(1) = xSpiegel - bSpiegel/2.*Cos_alfaSp - help*Sin_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Picture 'CHAM_1' auf WS 1 ausgeben:
|
|
|
|
4322 continue
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(1) ! aktiviere WS 1
|
|
CALL IZPICT('CHAM_1','D') ! display 'CHAM_1'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(1) ! deaktiviere WS 1
|
|
endif
|
|
|
|
|
|
c===============================================================================
|
|
c 2. Kammerteil zeichnen:
|
|
c===============================================================================
|
|
|
|
c Picture waehlen:
|
|
|
|
CALL IZPICT('CHAM_2','C') ! make 'CHAM_2' the currrent picture
|
|
CALL ISELNT(2) ! Masstab '2' aktivieren
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Marker fuer Schnittebene plazieren:
|
|
|
|
if (schnitt_p.eq.2) call IPM(1,SCHNITT_X,45.) ! 45: y-POS. DES MARKERS
|
|
|
|
|
|
c Zeichne Achsen:
|
|
|
|
c CALL IGAXIS (0.,1180.,-60.,-60.,0.,1180.,40,'O+') ! X-ACHSE
|
|
c CALL IGAXIS (1180.,1180.,-60.,40.,-60.,40.,20,'O+') ! Y-ACHSE
|
|
|
|
CALL IGAXIS (0.,xMCP2+80.,-60.,-60.,0.,xMCP2+80.,40,'O+') ! X-ACHSE
|
|
CALL IGAXIS (xMCP2+80.,xMCP2+80.,-60.,40.,-60.,40.,20,'O+') ! Y-ACHSE
|
|
|
|
|
|
if (.NOT.vertical) goto 4323
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c VERTIKALE DRAUFSICHT:
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Zeichne aus Boxen bestehende Elemente:
|
|
|
|
c Box um 2. Kammerteil:
|
|
|
|
CALL IGBOX(-60.,xMCP2+200.,-70.,50.)
|
|
c CALL IGBOX(-60.,1300.,-70.,50.)
|
|
|
|
|
|
c Linse 2:
|
|
|
|
if (lense2) then
|
|
|
|
ri = iRadiusCyl_L2 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2-LengthOuterCyl_L2
|
|
x2 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L2 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2
|
|
x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2
|
|
x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2+LengthOuterCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
endif
|
|
|
|
|
|
c Linse 3:
|
|
|
|
ri = iRadiusCyl_L3 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3-LengthOuterCyl_L3
|
|
x2 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L3 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3
|
|
x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3
|
|
x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3+LengthOuterCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit durchgezogenen Linien:
|
|
|
|
CALL ISLWSC(4.) ! LINIENDICKE: moderat
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
c Blende:
|
|
|
|
if (xBlende.GT.0) then
|
|
X(1)= xBlende
|
|
Y(1)= radius_Blende
|
|
X(2)= xBlende
|
|
Y(2)= 40
|
|
CALL IPL (2,X,Y)
|
|
Y(1)= -Y(1)
|
|
Y(2)= -Y(2)
|
|
CALL IPL (2,X,Y)
|
|
endif
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gepunkteten Linien:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c Spiegel:
|
|
|
|
c - 1. Gitter:
|
|
|
|
help = DreharmLaenge + dSpiegel/2
|
|
|
|
x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
c - Mittelebene:
|
|
|
|
help = DreharmLaenge
|
|
|
|
x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
c - 2. Gitter:
|
|
|
|
help = DreharmLaenge - dSpiegel/2
|
|
|
|
x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
y(1) = - bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
y(2) = + bSpiegel/2.*Cos_alfaSp + help*Sin_alfaSp
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gemischten Linientypen und -staerken:
|
|
|
|
|
|
c Triggerdetektor:
|
|
|
|
IF (TriggerInBeam) CALL PLOT_TD
|
|
|
|
|
|
c MCP2:
|
|
|
|
CALL ISLWSC(2.) ! LINIENDICKE: duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
c CALL ISFASI(152) ! select FILL AREA INTERIOR STYLE
|
|
c CALL ISFAIS(3) ! fill with FILL AREA INTERIOR STYLE
|
|
CALL IGBOX (xMCP2,xMCP2+10.,radius_MCP2active,-radius_MCP2active)
|
|
|
|
c CALL ISFASI(0) ! select FILL AREA INTERIOR STYLE
|
|
c CALL ISFAIS(0) ! do not fill
|
|
CALL IGBOX (xMCP2,xMCP2+10., radius_MCP2, radius_MCP2active)
|
|
CALL IGBOX (xMCP2,xMCP2+10.,-radius_MCP2,-radius_MCP2active)
|
|
|
|
|
|
goto 4324
|
|
4323 continue
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c HORIZONTALE DRAUFSICHT:
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
c Zeichne aus Boxen bestehende Elemente:
|
|
|
|
c Box um 2. Kammerteil:
|
|
|
|
CALL IGBOX(-60.,xMCP2+200.,-70.,50.)
|
|
c CALL IGBOX(-60.,1300.,-70.,50.)
|
|
|
|
|
|
c Linse 2:
|
|
|
|
if (lense2) then
|
|
|
|
ri = iRadiusCyl_L2 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2-LengthOuterCyl_L2
|
|
x2 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2-DistanceCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L2 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L2-0.5*LengthInnerCyl_L2
|
|
x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L2 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2
|
|
x2 = xCenterOfLense_L2+0.5*LengthInnerCyl_L2+DistanceCyl_L2+LengthOuterCyl_L2
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
endif
|
|
|
|
|
|
c Linse 3:
|
|
|
|
ri = iRadiusCyl_L3 ! Innenradius
|
|
|
|
c - 1. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3-LengthOuterCyl_L3
|
|
x2 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3-DistanceCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 2. Zylinder:
|
|
|
|
ro = oRadiusInnerCyl_L3 ! Aussenradius des inneren Zylinders
|
|
x1 = xCenterOfLense_L3-0.5*LengthInnerCyl_L3
|
|
x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
c - 3. Zylinder:
|
|
|
|
ro = oRadiusOuterCyl_L3 ! Aussenradius der auesseren Zylinder
|
|
x1 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3
|
|
x2 = xCenterOfLense_L3+0.5*LengthInnerCyl_L3+DistanceCyl_L3+LengthOuterCyl_L3
|
|
CALL IGBOX (x1,x2, ri, ro)
|
|
CALL IGBOX (x1,x2,-ri,-ro)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit durchgezogenen Linien:
|
|
|
|
CALL ISLWSC(4.) ! LINIENDICKE: moderat
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
c Blende:
|
|
|
|
if (xBlende.GT.0) then
|
|
X(1)= xBlende
|
|
Y(1)= radius_Blende
|
|
X(2)= xBlende
|
|
Y(2)= 40
|
|
CALL IPL (2,X,Y)
|
|
Y(1)= -Y(1)
|
|
Y(2)= -Y(2)
|
|
CALL IPL (2,X,Y)
|
|
endif
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gepunkteten Linien:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c Spiegel:
|
|
|
|
y(1) = hSpiegel/2.
|
|
y(2) = -y(1)
|
|
|
|
c - 1. Gitter:
|
|
|
|
help = DreharmLaenge + dSpiegel/2
|
|
|
|
x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
cc - Mittelebene:
|
|
c
|
|
c help = DreharmLaenge
|
|
c
|
|
c x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
c x(2) = x(1)
|
|
c CALL IPL (2,X,Y)
|
|
c x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
c x(2) = x(1)
|
|
c CALL IPL (2,X,Y)
|
|
|
|
c - 2. Gitter:
|
|
|
|
help = DreharmLaenge - dSpiegel/2
|
|
|
|
x(1) = + bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
x(1) = - bSpiegel/2.*Sin_alfaSp + help*Cos_alfaSp
|
|
x(2) = x(1)
|
|
CALL IPL (2,X,Y)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Zeichne Elemente mit gemischten Linientypen und -staerken:
|
|
|
|
|
|
c Triggerdetektor:
|
|
|
|
IF (TriggerInBeam) CALL PLOT_TD_HOR
|
|
|
|
|
|
c MCP2:
|
|
|
|
CALL ISLWSC(2.) ! LINIENDICKE: duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
c CALL ISFASI(152) ! select FILL AREA INTERIOR STYLE
|
|
c CALL ISFAIS(3) ! fill with FILL AREA INTERIOR STYLE
|
|
CALL IGBOX (xMCP2,xMCP2+10.,radius_MCP2active,-radius_MCP2active)
|
|
|
|
c CALL ISFASI(0) ! select FILL AREA INTERIOR STYLE
|
|
c CALL ISFAIS(0) ! do not fill
|
|
CALL IGBOX (xMCP2,xMCP2+10., radius_MCP2, radius_MCP2active)
|
|
CALL IGBOX (xMCP2,xMCP2+10.,-radius_MCP2,-radius_MCP2active)
|
|
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
c Picture 'CHAM_2' auf WS 3 ausgeben:
|
|
|
|
4324 continue
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(3) ! aktiviere WS 3
|
|
CALL IZPICT('CHAM_2','D') ! display 'CHAM_2'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(3) ! deaktiviere WS 3
|
|
endif
|
|
|
|
|
|
c Linientyp fuer die Trajektorien setzen:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_TD
|
|
C ==================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC'
|
|
|
|
logical gridInFrontOfFoil
|
|
common /foilGrid/ gridInFrontOfFoil
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
|
|
COMMON /pawc/ memory
|
|
|
|
real x(5),y(5),z(5)
|
|
COMMON /trans_koord/ x,y,z
|
|
|
|
real pi
|
|
parameter (pi = 3.1415927)
|
|
|
|
real DM3
|
|
real XTRS,XTRG1,XTRG2,XTRG3,XM3A,XM3E
|
|
real YTRF,YTRG1,YTRG2,YTRG3,YM3,ATRS,DTRS,LTRS
|
|
real P1X,P1Y,P2X,P2Y,P3X,P3Y,P4X,P4Y
|
|
|
|
|
|
c folgende x-Positionen sind relativ zur Triggerfolie:
|
|
|
|
xtrs = 52 ! x-Koordinate des Triggerspiegels
|
|
xtrg1 = 8 ! x-Koordinate des i. Gitters
|
|
xtrg2 = 101 ! dto
|
|
xtrg3 = 101+dx5 ! dto
|
|
xm3a = 31 ! Anfang des MCP3
|
|
xm3e = 73 ! Ende des MCP3
|
|
ytrf = 30 ! sym. y-Ausdehnung der Triggerfolie
|
|
ytrg1 = 30 ! sym. y-Ausdehnung des i. Gitters
|
|
ytrg2 = 30 ! dto
|
|
ytrg3 = 30 ! dto
|
|
ym3 = -53 ! Abstand des MCP3 von der optischen Achse
|
|
DM3 = 2 ! DICKE VOM MCP3
|
|
atrs = 135 ! (Grad)Drehwinkel des Triggerspiegels um die z-Achse
|
|
dtrs = 10 ! Abstand der Triggerspiegelebenen
|
|
ltrs = 80 ! Laenge des Triggerspiegels
|
|
|
|
c Folie:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = -SQRT(radiusQuad_Folie)
|
|
y(2) = +SQRT(radiusQuad_Folie)
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
CALL ISLWSC(2.) ! LINIENDICKE: duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = +SQRT(radiusQuad_Folie)
|
|
y(2) = YTRF
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = -YTRF
|
|
y(2) = -SQRT(radiusQuad_Folie)
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c Gitterebenen:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c - Massegitter vor Folie:
|
|
|
|
if (gridInFrontOfFoil) then
|
|
c if (dx5.NE.8) then
|
|
x(1) = - d_grid_folie
|
|
x(2) = - d_grid_folie
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
endif
|
|
|
|
|
|
c - forderes Gitter von VORNE:
|
|
|
|
x(1) = XTRG1
|
|
x(2) = XTRG1
|
|
y(1) = YTRG1
|
|
y(2) = -YTRG1
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c - hinteres Gitter von HINTEN:
|
|
|
|
x(1) = XTRG2
|
|
x(2) = XTRG2
|
|
y(1) = YTRG2
|
|
y(2) = -YTRG2
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c - geerdetes Gitter (GROUND):
|
|
|
|
x(1) = XTRG3
|
|
x(2) = XTRG3
|
|
y(1) = YTRG3
|
|
y(2) = -YTRG3
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c Spiegelgitter:
|
|
|
|
P2X = (DTRS/2)*COS((PI/2)-(ATRS/180)*PI)
|
|
P2Y = -(DTRS/2)*SIN((PI/2)-(ATRS/180)*PI)
|
|
P1X = -P2X
|
|
P1Y = -P2Y
|
|
P3X = (LTRS/2)*cos((ATRS/180)*PI)
|
|
P3Y = (LTRS/2)*sin((ATRS/180)*PI)
|
|
P4X = -P3X
|
|
P4Y = -P3Y
|
|
|
|
|
|
cc Spiegelmittelebene:
|
|
c
|
|
c x(1) = p3x+xTRs
|
|
c x(2) = p4x+xTRs
|
|
c y(1) = p3y
|
|
c y(2) = p4y
|
|
c
|
|
c CALL KOORD_TRANSFORMATION(2)
|
|
c CALL IPL(2,x,y)
|
|
|
|
|
|
c forderes Spiegelgitter:
|
|
|
|
X(1) = P3X+P1X+XTRS
|
|
X(2) = P4X+P1X+XTRS
|
|
Y(1) = P3Y+P1Y
|
|
Y(2) = P4Y+P1Y
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c hinteres Spiegelgitter:
|
|
|
|
X(1) = P3X+P2X+XTRS
|
|
X(2) = P4X+P2X+XTRS
|
|
Y(1) = P3Y+P2Y
|
|
Y(2) = P4Y+P2Y
|
|
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
CALL IPL(2,X,Y)
|
|
|
|
|
|
c MCP3:
|
|
|
|
CALL ISLWSC(3.) ! LINIENDICKE: moderat
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
x(1) = xM3A
|
|
x(2) = xM3E
|
|
x(3) = xM3E
|
|
x(4) = xM3A
|
|
x(5) = xM3A
|
|
y(1) = yM3
|
|
y(2) = yM3
|
|
y(3) = yM3-dM3
|
|
y(4) = yM3-dM3
|
|
y(5) = yM3
|
|
|
|
CALL KOORD_TRANSFORMATION(5)
|
|
CALL IPL(5,X,Y)
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_TD_HOR
|
|
C ======================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC'
|
|
|
|
logical gridInFrontOfFoil
|
|
common /foilGrid/ gridInFrontOfFoil
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
|
|
COMMON /pawc/ memory
|
|
|
|
real x(5),y(5),z(5)
|
|
COMMON /trans_koord/ x,y,z
|
|
|
|
real pi
|
|
parameter (pi = 3.1415927)
|
|
|
|
real DM3
|
|
real XTRS,XTRG1,XTRG2,XTRG3,XM3A,XM3E
|
|
real YTRF,YTRG1,YTRG2,YTRG3,YM3,ATRS,DTRS,LTRS
|
|
real P1X,P1Y,P2X,P2Y,P3X,P3Y,P4X,P4Y
|
|
real dz_half
|
|
|
|
real xx(2)
|
|
|
|
c folgende x-Positionen sind relativ zur Triggerfolie:
|
|
|
|
xtrs = 52 ! x-Koordinate des Triggerspiegels
|
|
xtrg1 = 8 ! x-Koordinate des i. Gitters
|
|
xtrg2 = 101 ! dto
|
|
xtrg3 = 101+dx5 ! dto
|
|
xm3a = 31 ! Anfang des MCP3
|
|
xm3e = 73 ! Ende des MCP3
|
|
ytrf = 30 ! sym. y-Ausdehnung der Triggerfolie
|
|
ytrg1 = 30 ! sym. y-Ausdehnung des i. Gitters
|
|
ytrg2 = 30 ! dto
|
|
ytrg3 = 30 ! dto
|
|
ym3 = -53 ! Abstand des MCP3 von der optischen Achse
|
|
DM3 = 2 ! DICKE VOM MCP3
|
|
atrs = 135 ! (Grad)Drehwinkel des Triggerspiegels um die z-Achse
|
|
dtrs = 10 ! Abstand der Triggerspiegelebenen
|
|
ltrs = 80 ! Laenge des Triggerspiegels
|
|
|
|
|
|
c die Hoehe des Triggerdetektors:
|
|
|
|
dz_half = 30
|
|
|
|
c 'Deckel' und 'Boden':
|
|
|
|
CALL ISLWSC(4.) ! LINIENDICKE: moderat
|
|
c CALL ISLWSC(2.) ! LINIENDICKE: duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
|
|
c - von 'Folie':
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
c - bis 'Ground':
|
|
x(3) = XTRG3
|
|
x(4) = XTRG3
|
|
y(3) = YTRG3
|
|
y(4) = -YTRG3
|
|
CALL KOORD_TRANSFORMATION(4)
|
|
|
|
xx(1) = x(1)
|
|
xx(2) = x(3)
|
|
z(1) = dz_half
|
|
z(2) = z(1)
|
|
CALL IPL(2,XX,Z)
|
|
z(1) = -z(1)
|
|
z(2) = -z(2)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
xx(1) = x(2)
|
|
xx(2) = x(4)
|
|
z(1) = dz_half
|
|
z(2) = z(1)
|
|
CALL IPL(2,XX,Z)
|
|
z(1) = -z(1)
|
|
z(2) = -z(2)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c Folie:
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
z(1) = -SQRT(radiusQuad_Folie)
|
|
z(2) = +SQRT(radiusQuad_Folie)
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
CALL ISLWSC(2.) ! LINIENDICKE: duenn
|
|
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
z(1) = +SQRT(radiusQuad_Folie)
|
|
z(2) = +dz_half
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
z(1) = -dz_half
|
|
z(2) = -SQRT(radiusQuad_Folie)
|
|
x(1) = 0.
|
|
x(2) = 0.
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c Gitterebenen:
|
|
|
|
z(1) = -dz_half
|
|
z(2) = +dz_half
|
|
|
|
CALL ISLWSC(1.) ! LINIENDICKE: sehr duenn
|
|
CALL ISLN(3) ! LINIENTYP: eng gepunktet
|
|
|
|
|
|
c - Massegitter vor Folie:
|
|
|
|
if (gridInFrontOfFoil) then
|
|
c if (dx5.NE.8) then
|
|
x(1) = - d_grid_folie
|
|
x(2) = - d_grid_folie
|
|
y(1) = YTRF
|
|
y(2) = -YTRF
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
endif
|
|
|
|
|
|
c - forderes Gitter von VORNE:
|
|
|
|
x(1) = XTRG1
|
|
x(2) = XTRG1
|
|
y(1) = YTRG1
|
|
y(2) = -YTRG1
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c - hinteres Gitter von HINTEN:
|
|
|
|
x(1) = XTRG2
|
|
x(2) = XTRG2
|
|
y(1) = YTRG2
|
|
y(2) = -YTRG2
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c - geerdetes Gitter (GROUND):
|
|
|
|
x(1) = XTRG3
|
|
x(2) = XTRG3
|
|
y(1) = YTRG3
|
|
y(2) = -YTRG3
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c Spiegelgitter:
|
|
|
|
P2X = (DTRS/2)*COS((PI/2)-(ATRS/180)*PI)
|
|
P2Y = -(DTRS/2)*SIN((PI/2)-(ATRS/180)*PI)
|
|
P1X = -P2X
|
|
P1Y = -P2Y
|
|
P3X = (LTRS/2)*cos((ATRS/180)*PI)
|
|
P3Y = (LTRS/2)*sin((ATRS/180)*PI)
|
|
P4X = -P3X
|
|
P4Y = -P3Y
|
|
|
|
|
|
cc Spiegelmittelebene:
|
|
c
|
|
c x(1) = p3x+xTRs
|
|
c x(2) = p4x+xTRs
|
|
c y(1) = p3y
|
|
c y(2) = p4y
|
|
c CALL KOORD_TRANSFORMATION(2)
|
|
c xx(1) = x(1)
|
|
c xx(2) = xx(1)
|
|
c CALL IPL(2,XX,Z)
|
|
c xx(1) = x(2)
|
|
c xx(2) = xx(1)
|
|
c CALL IPL(2,XX,Z)
|
|
|
|
|
|
c forderes Spiegelgitter:
|
|
|
|
X(1) = P3X+P1X+XTRS
|
|
X(2) = P4X+P1X+XTRS
|
|
Y(1) = P3Y+P1Y
|
|
Y(2) = P4Y+P1Y
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
c hinteres Spiegelgitter:
|
|
|
|
X(1) = P3X+P2X+XTRS
|
|
X(2) = P4X+P2X+XTRS
|
|
Y(1) = P3Y+P2Y
|
|
Y(2) = P4Y+P2Y
|
|
CALL KOORD_TRANSFORMATION(2)
|
|
xx(1) = x(1)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
xx(1) = x(2)
|
|
xx(2) = xx(1)
|
|
CALL IPL(2,XX,Z)
|
|
|
|
|
|
cc MCP3:
|
|
c
|
|
c CALL ISLWSC(3.) ! LINIENDICKE: moderat
|
|
c CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
c
|
|
c x(1) = xM3A
|
|
c x(2) = xM3E
|
|
c x(3) = xM3E
|
|
c x(4) = xM3A
|
|
c x(5) = xM3A
|
|
c y(1) = yM3
|
|
c y(2) = yM3
|
|
c y(3) = yM3-dM3
|
|
c y(4) = yM3-dM3
|
|
c y(5) = yM3
|
|
c CALL KOORD_TRANSFORMATION(5)
|
|
c
|
|
c z(1) = ...
|
|
c z(2) = ...
|
|
c z(3) = ...
|
|
c z(4) = ...
|
|
c z(5) = ...
|
|
c CALL IPL(5,X,Z)
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE KOORD_TRANSFORMATION(n)
|
|
C ==================================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:COM_WINKEL.INC'
|
|
INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'
|
|
INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC'
|
|
|
|
real x(5),y(5),z(5)
|
|
COMMON /trans_koord/ x,y,z
|
|
|
|
integer n ! Anzahl an zu transformierenden Koordinaten
|
|
integer i
|
|
logical help
|
|
|
|
do i = 1, n
|
|
if (alfaTD.NE.0) then
|
|
help = x(i)-d_Folie_Achse
|
|
x(i) = help*Cos_alfaTD - y(i)*Sin_alfaTD + xTD
|
|
y(i) = help*Sin_alfaTD + y(i)*Cos_alfaTD
|
|
else
|
|
x(i) = x(i) - d_Folie_Achse + xTD
|
|
endif
|
|
enddo
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE TEXT_PLOT
|
|
C ====================
|
|
|
|
IMPLICIT NONE
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
common /pawc/ memory
|
|
|
|
integer GraphTextZeilen, i
|
|
CHARACTER GraphText(15)*40
|
|
COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText
|
|
|
|
c integer font
|
|
c real height
|
|
|
|
c font = -8
|
|
c height = 2.
|
|
c write(*,'($,A)') 'TEXTFONT ?'
|
|
c read(*,*) font
|
|
c write(*,'($,A)') 'TEXT height ?'
|
|
c read(*,*) height
|
|
|
|
CALL IZPICT('TEXT','C') ! make 'TEXT' the currrent picture
|
|
|
|
c CALL ISELNT(3) ! Masstab '3' aktivieren
|
|
c CALL ISTXFP(font,1) ! 0: Display on screen like hardware characters
|
|
! 1: Display on screen like IGTEXT characters
|
|
c CALL ISCHH (height) ! select charcter height
|
|
c CALL ISTXAL(0,0) ! select allignment (links unten)
|
|
|
|
|
|
do i = 1, GraphTextZeilen
|
|
! Bei ITX sind X und Y in Worldcoord. anzugeben!
|
|
c CALL ITX(0.0,100.*(1-real(i)/real(GraphTextZeilen)),GRAPHTEXT(i))
|
|
! Auch bei IGTEXT sind X und Y in Worldcoord. anzugeben! -> ?
|
|
CALL IGTEXT(0.0,1.-real(i)/real(GraphTextZeilen),
|
|
+ GRAPHTEXT(i), 0.04,0.0,'L')
|
|
enddo
|
|
|
|
|
|
c Text auf Bildschirm geben:
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(5) ! aktiviere WS 5
|
|
CALL IZPICT('TEXT','D') ! display 'TEXT'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(5) ! deaktiviere WS 5
|
|
endif
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_HORIZONTAL
|
|
C ==========================
|
|
|
|
IMPLICIT NONE
|
|
|
|
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000)
|
|
INTEGER TRAJ_N
|
|
COMMON /GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
|
|
|
|
LOGICAL LOG_MARKER
|
|
COMMON /marker/ LOG_MARKER
|
|
|
|
integer COLOR
|
|
real SCHNITT_X
|
|
logical VERTICAL
|
|
COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter (HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
COMMON /pawc/ memory
|
|
|
|
REAL X(2),Y(2),MITTE
|
|
INTEGER S,INDEX
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture
|
|
c CALL ISELNT(5) ! Masstab '1' aktivieren
|
|
CALL ISELNT(2) ! Masstab '2' aktivieren
|
|
|
|
IF (COLOR .EQ. 1) THEN ! Farbkodierung fuer z-Koordinate
|
|
DO S=2,TRAJ_N
|
|
MITTE = (TRAJ_Z(S)+TRAJ_Z(S-1))/2
|
|
IF (MITTE.LT.-18) THEN
|
|
INDEX=1
|
|
ELSEIF (MITTE.LT.-12) THEN
|
|
INDEX=7
|
|
ELSEIF (MITTE.LT.-6) THEN
|
|
INDEX=6
|
|
ELSEIF (MITTE.LT.0) THEN
|
|
INDEX=5
|
|
ELSEIF (MITTE.LT.6) THEN
|
|
INDEX=4
|
|
ELSEIF (MITTE.LT.12) THEN
|
|
INDEX=3
|
|
ELSEIF (MITTE.LT.18) THEN
|
|
INDEX=2
|
|
ELSE
|
|
INDEX=1
|
|
ENDIF
|
|
CALL ISPLCI(INDEX)
|
|
|
|
X(1)=TRAJ_X(S-1)
|
|
X(2)=TRAJ_X(S)
|
|
Y(1)=TRAJ_Y(S-1)
|
|
Y(2)=TRAJ_Y(S)
|
|
CALL IPL(2,X,Y)
|
|
ENDDO
|
|
ELSEIF (vertical) then
|
|
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y)
|
|
ELSE
|
|
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Z)
|
|
ENDIF
|
|
|
|
if (log_marker) CALL PLOT_MARKER ! Marker entsprechend Destiny
|
|
! zeichnen
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(1) ! aktiviere WS 1
|
|
CALL IZPICT('CHAM_1','D') ! display 'CHAM_1'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(1) ! deaktiviere WS 1
|
|
endif
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_VERTIKAL
|
|
C ========================
|
|
|
|
IMPLICIT NONE
|
|
|
|
cMBc REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000),TRAJ_T(1000)
|
|
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000)
|
|
INTEGER TRAJ_N
|
|
cMBc COMMON /GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N,TRAJ_T
|
|
COMMON /GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
|
|
|
|
LOGICAL LOG_MARKER
|
|
COMMON /marker/ LOG_MARKER
|
|
|
|
integer COLOR
|
|
real SCHNITT_X
|
|
logical VERTICAL
|
|
COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter (HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
COMMON /pawc/ memory
|
|
|
|
REAL X(2),Y(2),MITTE
|
|
INTEGER i,INDEX
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
cMBc logical writeTraj2File
|
|
cMBc common /writeTraj2File/ writeTraj2File
|
|
cMBc INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
|
|
cMBc real x_intersectTD
|
|
cMBc common /x_intersectTD/ x_intersectTD ! nur voruebergehend!
|
|
cMBc real help
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
CALL IZPICT('CHAM_2','C') ! make 'CHAM_2' the currrent picture
|
|
CALL ISELNT(2) ! Masstab '2' aktivieren
|
|
|
|
IF (COLOR .EQ. 1) THEN ! Farbkodierung fuer z-Koordinate
|
|
DO i=2,TRAJ_N
|
|
MITTE = (TRAJ_Z(i)+TRAJ_Z(i-1))/2
|
|
IF (MITTE.LT.-18) THEN
|
|
INDEX=1
|
|
ELSEIF (MITTE.LT.-12) THEN
|
|
INDEX=7
|
|
ELSEIF (MITTE.LT.-6) THEN
|
|
INDEX=6
|
|
ELSEIF (MITTE.LT.0) THEN
|
|
INDEX=5
|
|
ELSEIF (MITTE.LT.6) THEN
|
|
INDEX=4
|
|
ELSEIF (MITTE.LT.12) THEN
|
|
INDEX=3
|
|
ELSEIF (MITTE.LT.18) THEN
|
|
INDEX=2
|
|
ELSE
|
|
INDEX=1
|
|
ENDIF
|
|
CALL ISPLCI(INDEX)
|
|
|
|
X(1)=TRAJ_X(i-1)
|
|
X(2)=TRAJ_X(i)
|
|
Y(1)=TRAJ_Y(i-1)
|
|
Y(2)=TRAJ_Y(i)
|
|
CALL IPL(2,X,Y)
|
|
ENDDO
|
|
ELSEIF (vertical) then
|
|
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y)
|
|
ELSE
|
|
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Z)
|
|
ENDIF
|
|
|
|
if (log_marker) CALL PLOT_MARKER ! Marker entsprechend Destiny
|
|
! zeichnen
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(3) ! aktiviere WS 3
|
|
CALL IZPICT('CHAM_2','D') ! display 'CHAM_2'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(3) ! deaktiviere WS 3
|
|
endif
|
|
|
|
cMBc if (writeTraj2File) then
|
|
cMBc OPEN (UNIT=90,FILE='OUT.TRAJ',DEFAULTFILE=OUTDIR,STATUS='NEW')
|
|
cMBc do i = 1, traj_n
|
|
cMBc if (TRAJ_X(i).GE.x_intersectTD) then
|
|
cMBc if (TRAJ_X(i).EQ.x_intersectTD) help=TRAJ_T(i)
|
|
cMBc write(90,*) TRAJ_T(i)-help,TRAJ_X(i)-x_intersectTD
|
|
cMBc endif
|
|
cMBc enddo
|
|
cMBc CLOSE (90)
|
|
cMBc endif
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE PLOT_MARKER
|
|
C ======================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
COMMON /pawc/ memory
|
|
|
|
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000)
|
|
INTEGER TRAJ_N
|
|
COMMON /GRAPHIX/ TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
|
|
|
|
integer markerTyp(smallest_code_nr:highest_code_Nr)
|
|
real markerScale(smallest_code_nr:highest_code_Nr)
|
|
|
|
DATA markerTyp(code_durchSpiegel ) / 20 / ! solid ball
|
|
DATA markerTyp(code_lostInTD ) / 31 / ! star x
|
|
DATA markerTyp(code_hitMCP2inactive) / 20 / ! solid ball
|
|
DATA markerTyp(code_ok ) / 27 / ! Raute
|
|
DATA markerTyp(code_decay ) / 28 / ! hollow cross
|
|
DATA markerTyp(code_vorbei ) / 24 / ! circle
|
|
DATA markerTyp(code_reflektiert ) / 26 / ! hollow triangle
|
|
DATA markerTyp(code_wand ) / 20 / ! solid ball
|
|
DATA markerTyp(code_lost ) / 29 / ! solid star *
|
|
DATA markerTyp(code_dtsmall ) / 30 / ! hollow star *
|
|
|
|
DATA markerScale(code_durchSpiegel ) / 1.0 / ! solid ball
|
|
DATA markerScale(code_lostInTD ) / 1.5 / ! star x
|
|
DATA markerScale(code_hitMCP2inactive) / 1.0 / ! solid ball
|
|
DATA markerScale(code_ok ) / 2. / ! point
|
|
DATA markerScale(code_decay ) / 1.5 / ! hollow cross
|
|
DATA markerScale(code_vorbei ) / 1.5 / ! circle
|
|
DATA markerScale(code_reflektiert ) / 1.5 / ! hollow triangle
|
|
DATA markerScale(code_wand ) / 1.0 / ! solid ball
|
|
DATA markerScale(code_lost ) / 2.0 / ! solid star *
|
|
DATA markerScale(code_dtsmall ) / 2.0 / ! hollow star *
|
|
|
|
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
integer MT
|
|
real MS
|
|
|
|
MT = markerTyp(destiny)
|
|
MS = markerScale(destiny)
|
|
|
|
CALL ISMKSC(MS) ! Markergroesse setzen
|
|
CALL ISMK(MT) ! Markertyp waehlen
|
|
CALL IPM(1,TRAJ_X(TRAJ_N),TRAJ_Y(TRAJ_N)) ! Marker plotten
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE SCHNITT
|
|
C ==================
|
|
|
|
IMPLICIT NONE
|
|
|
|
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000),Y,Z,FACTOR
|
|
INTEGER TRAJ_N,S
|
|
COMMON /GRAPHIX/ TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
|
|
|
|
integer COLOR
|
|
real SCHNITT_X
|
|
logical VERTICAL
|
|
COMMON /PICT/ COLOR,SCHNITT_X, VERTICAL
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
COMMON /pawc/ memory
|
|
|
|
DO S= 2, TRAJ_N
|
|
IF (TRAJ_X(S) .GE. SCHNITT_X) THEN
|
|
FACTOR = (SCHNITT_X-TRAJ_X(S-1))/(TRAJ_X(S)-TRAJ_X(S-1))
|
|
Y=TRAJ_Y(S-1) + (TRAJ_Y(S)-TRAJ_Y(S-1))*FACTOR
|
|
Y = -Y ! DAMIT MAN ANSICHT IN STRAHLRICHTUNG BEKOMMT
|
|
Z=TRAJ_Z(S-1) + (TRAJ_Z(S)-TRAJ_Z(S-1))*FACTOR
|
|
if (abs(y).LE.30 .AND. abs(z).LE.30) then
|
|
CALL HFILL (50,Y,Z,1.)
|
|
endif
|
|
RETURN
|
|
ENDIF
|
|
ENDDO
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE SCHNITT_PLOT
|
|
C =======================
|
|
|
|
IMPLICIT NONE
|
|
|
|
logical BATCH_MODE
|
|
COMMON /BATCH_MODE/ BATCH_MODE
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
|
|
common /pawc/ memory
|
|
|
|
CALL IZPICT('HISTO','C') ! make 'HISTO' the currrent picture
|
|
CALL HPLOT(50,'BOX',' ',1) ! plotte Histogramm 50 (Boxes)
|
|
c CALL HPLOT(50,'SCAT',' ',1) ! plotte Histogramm 50 (Scatterplot)
|
|
|
|
if (.NOT.batch_mode) then
|
|
CALL IACWK(4) ! aktiviere WS 4
|
|
CALL IZPICT('HISTO','D') ! display 'HISTO'
|
|
CALL IGTERM ! update open WS and return to
|
|
! alfanumeric mode
|
|
CALL IDAWK(4) ! deaktiviere WS 4
|
|
endif
|
|
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|
|
|
|
OPTIONS /EXTEND_SOURCE
|
|
|
|
SUBROUTINE MAKE_PS(FILENAME)
|
|
C ============================
|
|
|
|
IMPLICIT NONE
|
|
|
|
INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
|
|
|
|
real XSIZE /12./, YSIZE /6./
|
|
CHARACTER*100 PSZEILE
|
|
CHARACTER*(*) FILENAME
|
|
|
|
integer HB_memsize
|
|
parameter(HB_memsize=1000000)
|
|
real memory(HB_memsize)
|
|
|
|
common /pawc/ memory
|
|
|
|
|
|
c OPEN (30,FILE=FILENAME//'.PS',CARRIAGECONTROL='LIST',DEFAULTFILE=OUTDIR,
|
|
c + STATUS='UNKNOWN')
|
|
|
|
OPEN (30,FILE='MUPIC.TMP',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
|
|
+ STATUS='UNKNOWN')
|
|
|
|
|
|
c ZUSAMMENFUEGEN VON 'CHAM_1', 'HISTO' UND 'TEXT':
|
|
|
|
CALL IZPICT('CHAM_1','C') ! make 'CHAM_1' the currrent picture
|
|
CALL IZMERG('HISTO',0.6,0.0,0.4,' ') ! verbinde 'HISTO' mit 'CHAM_1'
|
|
CALL IZPICT('CHAM_1','C') ! vielleicht gar nicht noetig!
|
|
CALL IZMERG('TEXT',0.6,0.5,0.4,' ') ! verbinde 'TEXT' mit 'CHAM_1'
|
|
|
|
CALL IGMETA(-30,-4121) ! graphic output to metafile on lun 30 only,
|
|
! devide into two by one pictures
|
|
CALL IGRNG(XSIZE,YSIZE) ! open PS and define size
|
|
CALL IZPICT('CHAM_1','D') ! display 'CHAM_1'
|
|
CALL ICLRWK(2,0) ! clear WS 2
|
|
CALL IZPICT('CHAM_2','D') ! display 'CHAM_2'
|
|
CALL IGMETA(0,0) ! deactivate metafile
|
|
CALL ICLWK(2) ! close WS 2
|
|
|
|
|
|
c ANFUEGEN EINES ' ' AN DEN ANFANG JEDER PS-FILE-ZEILE:
|
|
|
|
REWIND (30)
|
|
OPEN (UNIT=31,FILE=FILENAME//'.PS',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
|
|
+ STATUS='NEW')
|
|
|
|
38 READ (30, '(A100)', END=37) PSZEILE
|
|
WRITE (31,'(1X,A100)') PSZEILE
|
|
GOTO 38
|
|
|
|
37 CLOSE (30,STATUS='DELETE')
|
|
CLOSE (31)
|
|
|
|
c CLOSE (30,STATUS='KEEP')
|
|
|
|
END
|
|
|
|
|
|
c===============================================================================
|