c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MASSTAB_SETZEN
c	=========================

	IMPLICIT NONE

	REAL*4		X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2
	INTEGER*4	RPAW(1000000)

	COMMON	/PAWC/	RPAW

	real scale
	COMMON /scaleFactor/ scale


c DIMENSIONEN DES TRANSPORTSYSTEMS IN 'WELTKOORDINATEN'	

	CALL HLIMIT(1000000)

	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

	CALL IOPWK(1,11,2)	! open WS for 'CHAMBER'
	CALL IOPWK(4,31,3)	! open WS for 'HISTO'
	CALL IOPWK(5,41,4)	! open WS for 'TEXT'

	X1WC_P2 = -50.*scale
	X2WC_P2 =  50.*scale
	Y1WC_P2 = -50.*scale
	Y2WC_P2 =  50.*scale

c MASSTAB SETZEN: (use normalization transformation index 2)

	! Define window in world coordinates:
	    CALL ISWN(2, X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2)	
	! Define window in normalized device coordinates:
	    CALL ISVP(2, 0.,1.,0.,1.)		

	END

c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE PLOT_CHAMBER
c	=======================

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_GEO.INC'
	real scale,help
	COMMON /scaleFactor/ scale

	REAL*4		X(14),Y(14)
	real		alfa_HeWindow	! halber Oeffnungswinkel des He-Fensters

	INTEGER*4	RPAW(1000000)
	COMMON	/PAWC/	RPAW

c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	CALL IZPICT ('CHAMBER','C')	  ! make 'CHAMBER' the currrent picture
	CALL ISELNT (2)			  ! select norm. transf. index 2

	help = scale * 50.
	CALL IGBOX(-help,help,-help,help) ! BOX UM 1. KAMMERTEIL

C HIER WIRD GEZEICHNET:

	! alle dy und dz geben die halbe Gesamtausdehnung an, dx die ganze!

c - He-Shield:

	alfa_HeWindow = asinD(dy_HeWindow/rHeShield)
	CALL IGARC (0.,0.,scale*rHeShield,scale*rHeShield,alfa_HeWindow,-alfa_HeWindow)

c - targethalter:

	x(1)  =  scale * xFoil
	x(2)  =  scale * xFoil
	x(3)  =  scale * xEnd_TgtHolder
	x(4)  =  scale * xEnd_TgtHolder
	x(5)  =  scale * (xFoil-1)
	x(6)  =  scale * (xFoil-1)
	x(7)  =  scale * (xFoil)
	x(8)  =  scale * (xFoil)
	x(9)  =  scale * (xFoil-1)
	x(10) =  scale * (xFoil-1)
	x(11) =  scale * xEnd_TgtHolder
	x(12) =  scale * xEnd_TgtHolder
	x(13) =  scale * xFoil
	x(14) =  scale * xFoil

	y(1)  =  scale * Dy_Foil
	y(2)  =  scale * innerDy1_TgtHolder
	y(3)  =  scale * innerDy2_TgtHolder
	y(4)  =  scale * outerDy_TgtHolder
	y(5)  =  scale * outerDy_TgtHolder
	y(6)  =  scale * Dy_Foil
	y(7)  =  scale * Dy_Foil
	y(8)  = -scale * Dy_Foil
	y(9)  = -scale * Dy_Foil
	y(10) = -scale * outerDy_TgtHolder
	y(11) = -scale * outerDy_TgtHolder
	y(12) = -scale * innerDy2_TgtHolder
	y(13) = -scale * innerDy1_TgtHolder
	y(14)= -scale * Dy_Foil

	CALL ISLWSC(2.)				!LINIENDICKE: dicker
	CALL IPL (14,X,Y)
	CALL ISLWSC(1.)				!LINIENDICKE: wieder duenn

c - moderatorflaeche:

	x(1) = scale * xFoil
	x(2) = scale * xFoil

	y(1) =  scale * Dy_Foil
	y(2) = -scale * Dy_Foil

c	CALL ISLN(3)				!LINIENTYP:   gepunktet
	CALL ISLWSC(3.)				!LINIENDICKE: dick
	CALL IPL(2,X,Y)
	CALL ISLWSC(1.)				!LINIENDICKE: duenn
c	CALL ISLN (1)				!LINIENTYP:   wieder durchgezogen

c - guardring:

	if (xStart_Guardring.LE.xEnd_Guardring) then
	    CALL IGBOX ( scale * xStart_Guardring,   scale * xEnd_Guardring,
     +			 scale * innerDy_Guardring,  scale * outerDy_Guardring)

	    CALL IGBOX ( scale * xStart_Guardring,   scale * xEnd_Guardring,
     +			-scale * innerDy_Guardring, -scale * outerDy_Guardring)
	endif

c - frame 1. grid:

	if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
	    CALL IGBOX ( scale * xStart_Gridframe1,   scale * xEnd_Gridframe1,
     +			 scale * innerDy_Gridframe1,  scale * outerDy_Gridframe1)

	    CALL IGBOX ( scale * xStart_Gridframe1,   scale * xEnd_Gridframe1,
     +			-scale * innerDy_Gridframe1, -scale * outerDy_Gridframe1)
	endif

c - frame 2. grid:

	if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
	    CALL IGBOX ( scale * xStart_Gridframe2,   scale * xEnd_Gridframe2,
     +			 scale * innerDy_Gridframe2,  scale * outerDy_Gridframe2)

	    CALL IGBOX ( scale * xStart_Gridframe2,   scale * xEnd_Gridframe2,
     +			-scale * innerDy_Gridframe2, -scale * outerDy_Gridframe2)
	endif


	CALL ISLN (3)				!LINIENTYP:   gepunktet
	CALL ISLWSC(1.)				!LINIENDICKE: duenn

c - 1. grid:

	if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
	    X(1) =  scale * xPosition_Grid1
	    X(2) =  scale * xPosition_Grid1
	    Y(1) =  scale * y_Pos_lastWire1
	    Y(2) = -scale * y_Pos_lastWire1
	    CALL IPL (2,X,Y)	
	endif

c - 2. grid:

	if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
	    X(1) =  scale * xPosition_Grid2
	    X(2) =  scale * xPosition_Grid2
	    Y(1) =  scale * y_Pos_lastWire2
	    Y(2) = -scale * y_Pos_lastWire2
	    CALL IPL (2,X,Y)	
	endif

c - Achsen:

	CALL ISLN(1)				! LINIENTYP: durchgezogen
	help = scale * 40.
	CALL IGAXIS (-help,help,-help,-help,-help,help,414,'O+')    ! X-ACHSE
	CALL IGAXIS (-help,-help,-help,help,-help,help,414,'O-')    ! Y-ACHSE


c Graphik auf Bildschirm geben:

	CALL IACWK(1)				!aktiviere WS 1
	CALL IZPICT('CHAMBER','D')		!display 'CHAMBER'
	CALL IGTERM				!update open WS and return to
						!   alfanumeric mode
	CALL IDAWK(1)				!desaktiviere WS 1

	END

c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE TEXT_PLOT
c	====================

	IMPLICIT NONE

	INTEGER*4   RPAW(1000000)
	COMMON	/PAWC/	RPAW

	integer	    GraphTextZeilen, i
	CHARACTER   GraphText(15)*30
	COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText

	CALL IZPICT('TEXT','C')
        do i = 1, GraphTextZeilen
            CALL IGTEXT(0.0,1.-real(i)/real(GraphTextZeilen),
     +		  GRAPHTEXT(i),	0.04,0.0,'L')
        enddo
	CALL IACWK(5)
	CALL IZPICT('TEXT','D')
	CALL IGTERM
	CALL IDAWK(5)

	END

c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE PLOT_TRAJECTORY
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
	INTEGER*4	RPAW(1000000)
	COMMON	/PAWC/	RPAW

	CALL IZPICT('CHAMBER','C')
	CALL ISELNT(2)
	CALL ISLN(1)

	CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y)
	CALL IACWK(1)
	CALL ISELNT(2)
	CALL IZPICT ('CHAMBER','D')
	CALL IGTERM
	CALL IDAWK(1)

	END

c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE SCHNITT_PLOT
c	=======================

	IMPLICIT NONE

	INTEGER*4  RPAW(1000000)

	COMMON	/PAWC/	RPAW 

	CALL IACWK (4)
	CALL IZPICT ('HISTO','C')
	CALL HPLOT(50,'BOX',' ',1)
C	CALL IZPICT('HISTO','D')
	CALL IGTERM
	CALL IDAWK (4)

	END

c===============================================================================

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MAKE_PS(FILENAME)
c	============================

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'

	REAL*4		XSIZE /12./, YSIZE /6./
	CHARACTER*100	PSZEILE
	CHARACTER*(*)	FILENAME

	INTEGER*4	RPAW(1000000)
	COMMON	/PAWC/	RPAW

        OPEN (30,FILE='PPIC.TMP',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
     +  STATUS='UNKNOWN')


c ZUSAMMENFUEGEN VON 'CHAMBER' UND 'TEXT':

        CALL IGMETA(-30,-4121)
        CALL IGRNG(XSIZE,YSIZE)
        CALL IZPICT('CHAMBER','D')
        CALL ICLRWK(2,0)
        CALL IZPICT('TEXT','D')
        CALL IGMETA(0,0)

        CALL ICLWK(2)


C ANFUEGEN EINES blanks AN DEN ANFANG JEDER PS-FILE-ZEILE:
c (kann dies nicht durch entsprechende option beim oeffnen des files
c direkt erreicht werden?)

	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) 

	END

c===============================================================================