
	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===============================================================================
