337 lines
7.9 KiB
Fortran
337 lines
7.9 KiB
Fortran
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===============================================================================
|