Add layer index to stop distribution output. Fixed compiler errors.

This commit is contained in:
prokscha 2009-11-17 08:35:57 +00:00
parent 0d5e333fca
commit 6c36e69cd1

View File

@ -5,69 +5,69 @@ CC DURCHGANG VON SCHWEREN TEILCHEN DURCH MATERIE
CC
CC REV.: ELOSS2 ANSTELLE VON RGEFIN EINBAUT.
CC REV.: UND DOPPELTGENAUE RGE-E-TABELLEN
CC REV.: Einführung eines Parametersr den Befehl 'BUILD_TAB', mit dem die
CC REV.: Einf<EFBFBD>hrung eines Parameters f<>r den Befehl 'BUILD_TAB', mit dem die
CC Variable "PREC" und damit die relative Genauigkeit der Interpolation
CC beim Erstellen der Reichweite-Energie-Tabelle bestimmt werden kann.
CC Damit lassen sich zum Programmabbruch führende Fehler in der Routine
CC Damit lassen sich zum Programmabbruch f<EFBFBD>hrende Fehler in der Routine
CC SPLIN3 vermeiden, die zuvor bei gewissen Materialien wie z. B. reinem
CC Aluminium auftraten. Zusätzlich gibt es hier und in UPLIBK.FOR einige
CC weitere kleine Änderungen. KT 10-JAN-95
CC REV.: Eine und damit vielleicht bereits die alleinige Ursache für Programm-
CC abstürze, die besonders bei hohen Teilchenzahlen auftraten, ist gefun-
CC Aluminium auftraten. Zus<EFBFBD>tzlich gibt es hier und in UPLIBK.FOR einige
CC weitere kleine <EFBFBD>nderungen. KT 10-JAN-95
CC REV.: Eine und damit vielleicht bereits die alleinige Ursache f<EFBFBD>r Programm-
CC abst<EFBFBD>rze, die besonders bei hohen Teilchenzahlen auftraten, ist gefun-
CC den und beseitigt. Die Energie-Reichweite-Tabelle wird von einem kubi-
CC schen Spline-Polynom angenähert, das sich aufgrund von Rundungsfehlern
CC unter Umständen numerisch nicht korrekt lösen läßt. In der Funktion
CC schen Spline-Polynom angen<EFBFBD>hert, das sich aufgrund von Rundungsfehlern
CC unter Umst<EFBFBD>nden numerisch nicht korrekt l<EFBFBD>sen l<><6C>t. In der Funktion
CC ELOSS2 in UPLIBK.FOR wurde bislang in diesem Fall kommentarlos eine
CC Stop-Anweisung ausgeführt. Jetzt wird das betreffende Teilchen aus der
CC Stop-Anweisung ausgef<EFBFBD>hrt. Jetzt wird das betreffende Teilchen aus der
CC weiteren Rechnung genommen und dies in einem Hinweis in der Standard-
CC Ausgabedatei vermerkt. Bei der anzunehmenden Rate von einem bis zwei
CC Teilchen pro 100,000 wird dies den Aussagewert der Rechnungen nicht
CC einschränken. In der Funktion ELOSS2 wurde ferner die Genauigkeit der
CC einschr<EFBFBD>nken. In der Funktion ELOSS2 wurde ferner die Genauigkeit der
CC Konstanten 4*PI/3 und 2*PI/3 von 8 auf 16 Stellen verbessert, wodurch
CC eine Reihe von Fehlberechnungen bereits vermieden wurde. Allen weiter-
CC en Stop-Anweisungen, die zu einem ähnlich unerklärten Programmende
CC führten, wurde die Ausgabe eines Hinweises über die Ursachen des Ab-
CC bruchs und deren mögliche Behebung vorangestellt.
CC en Stop-Anweisungen, die zu einem <EFBFBD>hnlich unerkl<EFBFBD>rten Programmende
CC f<EFBFBD>hrten, wurde die Ausgabe eines Hinweises <EFBFBD>ber die Ursachen des Ab-
CC bruchs und deren m<EFBFBD>gliche Behebung vorangestellt.
CC In der Standard-Ausgabedatei werden jetzt Datum und Uhrzeit vom Start
CC und Ende des Programms sowie die Dauer der Rechnung festgehalten.
CC KT 30-JAN-95
CC REV.: Der Fehler in der Zeitausgabe bei einer Rechnung über Mitternacht ist
CC REV.: Der Fehler in der Zeitausgabe bei einer Rechnung <EFBFBD>ber Mitternacht ist
CC korrigiert. Vier neue Eingabedatei-Befehle sind implementiert.
CC Die beiden Befehle IMPULS und WINKEL haben eine analoge Struktur. Sie
CC bewirken die Ausgabe der Impulsbeträge [MeV/c] bzw. des Streuwinkels
CC bewirken die Ausgabe der Impulsbetr<EFBFBD>ge [MeV/c] bzw. des Streuwinkels
CC zur Z-Achse [rad] der Teilchen in die durch den Parameter festgelegte
CC Unit vor bzw. hinter einem Bauteil, das durch die Position des Befehls
CC in der Eingabedatei festgelegt ist. In den Vektor IMPOUT bzw. THEOUT
CC mit jeweils der Länge 201 wird an die Position der Nummer des nachfol-
CC mit jeweils der L<EFBFBD>nge 201 wird an die Position der Nummer des nachfol-
CC genden Bauteiles die Nummer der Ausgabe-Unit geschrieben. In der Rou-
CC tine COMPUT erfolgt später genau dann eine Ausgabe, wenn der zu dem
CC nachfolgenden Bauteil gehörende Wert des Vektors von Null verschieden
CC ist. Um bei Verwendung des Befehls SKIP keine unerwünschte Ausgabe zu
CC tine COMPUT erfolgt sp<EFBFBD>ter genau dann eine Ausgabe, wenn der zu dem
CC nachfolgenden Bauteil geh<EFBFBD>rende Wert des Vektors von Null verschieden
CC ist. Um bei Verwendung des Befehls SKIP keine unerw<EFBFBD>nschte Ausgabe zu
CC erhalten, sollten 'IMPULS' und 'WINKEL' vor 'GEOMETRY' stehen.
CC Auch der Befehl STOPPED hat die Nummer der Ausgabe-Unit als Parameter
CC mit demselben Prinzip. Er bewirkt die Ausgabe der Stoppverteilung in
CC dem zuletzt definierten Bauteil in Form einer Datei, die soviele Werte
CC enthält wie das Bauteil in Einzellagen aufgeteilt ist.
CC Mit dem Befehl FOCUS läßt sich schließlich der Strahl der einkommenden
CC enth<EFBFBD>lt wie das Bauteil in Einzellagen aufgeteilt ist.
CC Mit dem Befehl FOCUS l<EFBFBD><EFBFBD>t sich schlie<EFBFBD>lich der Strahl der einkommenden
CC Teilchen fokussieren. Der erste Parameter gibt die Z-Position [cm] der
CC x=0 Fokusgeraden an, der zweite die Z-Position der y=0 Fokusgeraden,
CC die, keine Ablenkung durch Streuung vorausgesetzt, alle Teilchenbahnen
CC schneiden. Erlaubt sind Eingaben von -1000 bis +1000; ein negativer
CC Wert bewirkt eine Defokussierung, Null beläßt den Strahl parallel.
CC Wert bewirkt eine Defokussierung, Null bel<EFBFBD><EFBFBD>t den Strahl parallel.
CC KT 16-FEB-95
CC REV.: Implementierung eines neuen Eingabedatei-Befehls zue Ausgabe der X,Y-
CC Koordinaten ('WHERE_XY'). Die Bearbeitung erfolgt völlig analog zu
CC den Befehlen IMPULS und WINKEL. Ferner die endgültige Lösung des
CC Koordinaten ('WHERE_XY'). Die Bearbeitung erfolgt v<EFBFBD>llig analog zu
CC den Befehlen IMPULS und WINKEL. Ferner die endg<EFBFBD>ltige L<>sung des
CC Mitternacht-Problems. KT 21-FEB-95
CC REV.: Änderung der Zuweisungen von Ein- und Ausgabeunits, um den Code auch
CC für AXP-Rechner verwenden zu können. KT 5-MAR-95
CC REV.: <EFBFBD>nderung der Zuweisungen von Ein- und Ausgabeunits, um den Code auch
CC f<EFBFBD>r AXP-Rechner verwenden zu k<EFBFBD>nnen. KT 5-MAR-95
CC REV.: Implementierung eines homogenen Magnetfeldes parallel zu Z, Befehl
CC MAGNETIC. Parameter: 1. Z-Koordinate des Anfangs, 2. Stärke in Gauß,
CC MAGNETIC. Parameter: 1. Z-Koordinate des Anfangs, 2. St<EFBFBD>rke in Gau<EFBFBD>,
CC wobei das Vorzeichen die Richtung in Bezug auf Z angibt. Ein neuer
CC Befehl für die X,Y-Ausgabe, der nicht nur die Teilchen erfaßt, die
CC Befehl f<EFBFBD>r die X,Y-Ausgabe, der nicht nur die Teilchen erfa<EFBFBD>t, die
CC das Bauteil treffen: ALL_XY.
CC
CC Alle Änderungen sind mit "c-kt" kommentiert.
CC Alle <EFBFBD>nderungen sind mit "c-kt" kommentiert.
cc
cc
cc
@ -133,20 +133,20 @@ C ----------------------------------------------------------------------
CHARACTER*10 CMD, CMDTAB(33), GEOTYP(2), OUTTYP(7), BEAMTY(3)
CHARACTER*20 COMENT
c-kt Uhrzeit, Datum und Systemzeit bei Programmbeginn und -ende sowie
c-kt die Zählvariable für die aus der Rechnung genommenen Teilchen
c-kt die Z<EFBFBD>hlvariable f<EFBFBD>r die aus der Rechnung genommenen Teilchen
CHARACTER*8 startzeit, endezeit
CHARACTER*9 startdatum, endedatum
REAL*4 startsec, dauer
INTEGER*4 h, m, s, fehler
c-kt Ende
c-kt Variablen für MAGNETIC: Beginn und Stärke des Magnetfeldes [cm], [Gauss]
c-kt Variablen f<EFBFBD>r MAGNETIC: Beginn und St<EFBFBD>rke des Magnetfeldes [cm], [Gauss]
REAL*4 MSTART, MGAUSS
REAL*8 RGDATA
INTEGER*4 SEEDS
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY und ALL_XY:
INTEGER*2 IMPOUT, THEOUT, STPOUT, XYOUT, XYALL, LUNINIT
c-kt Deklaration neuer Bezeichner für Ein- und Ausgabeunit: SYSOUT, SYSIN
c-kt Deklaration neuer Bezeichner f<EFBFBD>r Ein- und Ausgabeunit: SYSOUT, SYSIN
INTEGER*2 SYSOUT, SYSIN
LOGICAL TEST, RULER, LAYON, LAYGEO, BEAMP,
1 BEAMXY, SEEDOK, MASSOK, TABOK, SCATTR, STRAGG,
@ -168,14 +168,14 @@ c-kt Deklaration neuer Bezeichner f
9 / BEAM / PMEAN, PFWHM, PLOW, PHIGH, XFWHM, YFWHM,
1 RMAX,
2 IBTYP, XBEAM, YBEAM, PSIGMA, RMAX2
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
3 , XFOCUS, YFOCUS
c-kt Beginn und Stärke des Magnetfeldes
c-kt Beginn und St<EFBFBD>rke des Magnetfeldes
4 , MSTART, MGAUSS
COMMON
1 / KINEMA / ID, XX, YY, ZZ,
2 PX, PY, PZ, PTOTAL,
c-kt Einführen der Variable TTHETA für den Tangens des Streuwinkels:
c-kt Einf<EFBFBD>hren der Variable TTHETA f<EFBFBD>r den Tangens des Streuwinkels:
3 THETA, PHI, STHETA, CTHETA, TTHETA,
4 SPHI, CPHI,
5 TTOTAL, TLAST,
@ -185,13 +185,13 @@ c-kt Einf
9 / COMPON / NZCOMP(20), ACOMP(20), NATOM(20), NELEM, NELEMC
1 / SEEDCO / SEEDS (6)
COMMON
c-kt Deklaration neuer Bezeichner für Ein- und Ausgabeunit: SYSOUT, SYSIN
c-kt Deklaration neuer Bezeichner f<EFBFBD>r Ein- und Ausgabeunit: SYSOUT, SYSIN
1 / STATUS / SYSOUT, SYSIN, TEST
3 / INPUT / WPARM(6)
c-kt Zählvariable r die aus der Rechnung genommenen Teilchen:
c-kt Z<EFBFBD>hlvariable f<EFBFBD>r die aus der Rechnung genommenen Teilchen:
COMMON
1 / COUNT / fehler
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY und ALL_XY:
COMMON
1 / SGLOUT / IMPOUT(201), THEOUT(201), STPOUT(200), XYOUT(201),
@ -252,10 +252,10 @@ c-kt den Zeitpunkt des Programmbeginns festhalten
CALL DATE(startdatum)
CALL TIME(startzeit)
startsec = SECNDS(0.0)
c-kt Initialisieren des Zählers für die aus der Rechnung genommenen Teilchen
c-kt Initialisieren des Z<EFBFBD>hlers f<>r die aus der Rechnung genommenen Teilchen
fehler = 0
c-kt Ende
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
XFOCUS = 0.0
YFOCUS = 0.0
c-kt Ende
@ -286,10 +286,10 @@ c-kt Ende
IOTYPE(I) = 1
NLIMIT(I) = 0
NLUNIT(I) = 6
c-kt Integer-Array für die Unit-Nummern zu dem Befehl STOPPED:
c-kt Integer-Array f<EFBFBD>r die Unit-Nummern zu dem Befehl STOPPED:
STPOUT(I) = 0
10 CONTINUE
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt WHERE_XY und ALL_XY
DO 11 I=1,201
IMPOUT(I) = 0
@ -562,7 +562,7 @@ C ----------------------------------------------------------------------
IF ( LAYON .AND. .NOT. TABOK .AND. ( NELEMC .EQ. NELEM )
1 .AND. MASSOK )
1THEN
c-kt Beginn der Änderung zur Parameterübergabe
c-kt Beginn der <EFBFBD>nderung zur Parameter<EFBFBD>bergabe
PREC = ABS( WPARM(1) )
IF ( PREC .EQ. 0.0 ) THEN
PREC = 1.0E-04
@ -601,15 +601,15 @@ c-kt Fortsetzung eines Hinweises, der von DGETAB bei IFLAG=5 gegeben wird:
ELSE IF ( IFLAG .EQ. 1 ) THEN
c-kt Hilfe bei der Fehlersuche:
WRITE (SYSOUT,5556)
5556 FORMAT(' Zu wenig Einträge in der '//
5556 FORMAT(' Zu wenig Eintraege in der '//
1 'Energie-Reichweite-Tabelle.'
2 /' Wahrscheinlich muß entweder für diese Schicht mit dem '//
3 'Befehl'
4 /'''BUILD_TAB'' ein Parameter kleiner 1.E-4 übergeben '//
2 /' Wahrscheinlich muss entweder fuer diese Schicht mit dem '//
3 ,'Befehl',
4 /'''BUILD_TAB'' ein Parameter kleiner 1.E-4 uebergeben '//
5 'oder der '
6 /' 3. Parameter von ''PARTICLE'' vergrößert werden.')
6 /' 3. Parameter von ''PARTICLE'' vergroessert werden.')
ELSE
c-kt für die anderen Fälle habe ich keine Informationen bereit:
c-kt f<EFBFBD>r die anderen F<>lle habe ich keine Informationen bereit:
WRITE (SYSOUT,5557) IFLAG
5557 FORMAT(' ROUTINE ''DGETAB'' mit Fehler ',I1,' verlassen.')
ENDIF
@ -752,9 +752,9 @@ c-kt Teilchen:
c-kt Ende
c-kt Schließen der Standard-Ausgabedatei
c-kt Schlie<EFBFBD>en der Standard-Ausgabedatei
c CLOSE(SYSOUT)
c-kt Schließen der Standard-Eingabedatei
c-kt Schlie<EFBFBD>en der Standard-Eingabedatei
c CLOSE(SYSIN)
GOTO 9999
@ -978,7 +978,7 @@ C ----------------------------------------------------------------------
c-kt Anfang
c ----------------------------------------------------------------------
c "IMPULS" AUSGABEANWEISUNG FÜR DEN AKTUELLEN IMPULS
c "IMPULS" AUSGABEANWEISUNG F<EFBFBD>R DEN AKTUELLEN IMPULS
c ----------------------------------------------------------------------
2400 IF ( .NOT. SKIP ) THEN
IMPOUT(NLAY+1) = IFIX ( WPARM(1) + 0.5 )
@ -987,7 +987,7 @@ c ----------------------------------------------------------------------
GOTO 50
c ----------------------------------------------------------------------
c "WINKEL" AUSGABEANWEISUNG FÜR DEN AKTUELLEN STREUWINKEL
c "WINKEL" AUSGABEANWEISUNG F<EFBFBD>R DEN AKTUELLEN STREUWINKEL
c ----------------------------------------------------------------------
2500 IF ( .NOT. SKIP ) THEN
THEOUT(NLAY+1) = IFIX ( WPARM(1) + 0.5 )
@ -996,7 +996,7 @@ c ----------------------------------------------------------------------
GOTO 50
c ----------------------------------------------------------------------
c "STOPPED" AUSGABEANWEISUNG FÜR DIE STOPPVERTEILUNG IN DER SCHICHT
c "STOPPED" AUSGABEANWEISUNG F<EFBFBD>R DIE STOPPVERTEILUNG IN DER SCHICHT
c ----------------------------------------------------------------------
2600 IF ( .NOT. SKIP ) THEN
STPOUT(NGRP) = IFIX ( WPARM(1) + 0.5 )
@ -1005,7 +1005,7 @@ c ----------------------------------------------------------------------
GOTO 50
c ----------------------------------------------------------------------
c "FOCUS" ANGABEN ÜBER DIE FOKUSSIERUNG DES EINGANGSSTRAHLS
c "FOCUS" ANGABEN <EFBFBD>BER DIE FOKUSSIERUNG DES EINGANGSSTRAHLS
c ----------------------------------------------------------------------
2700 XFOCUS = WPARM(1)
YFOCUS = WPARM(2)
@ -1014,7 +1014,7 @@ c ----------------------------------------------------------------------
GOTO 50
c ----------------------------------------------------------------------
c "WHERE_XY" AUSGABEANWEISUNG FÜR DIE X-Y-KOORDINATEN VOR DER SCHICHT
c "WHERE_XY" AUSGABEANWEISUNG F<EFBFBD>R DIE X-Y-KOORDINATEN VOR DER SCHICHT
c ----------------------------------------------------------------------
2800 IF ( .NOT. SKIP ) THEN
XYOUT(NLAY+1) = IFIX ( WPARM(1) + 0.5 )
@ -1028,12 +1028,12 @@ c ----------------------------------------------------------------------
2900 MSTART = WPARM(1)
MGAUSS = WPARM(2)
CALL TBOUND ('R4','START B-FELD / CM ',MSTART, 0., 120., 'IN ')
CALL TBOUND ('R4','STÄRKE B-FELD / GAUSS ',
CALL TBOUND ('R4','ST<EFBFBD>RKE B-FELD / GAUSS ',
1 MGAUSS, -1.0E+05, 1.0E+05, 'IN ')
GOTO 50
c ----------------------------------------------------------------------
c "ALL_XY" AUSGABEANWEISUNG FÜR DIE X-Y-KOORDINATEN VOR DER SCHICHT
c "ALL_XY" AUSGABEANWEISUNG F<EFBFBD>R DIE X-Y-KOORDINATEN VOR DER SCHICHT
c ----------------------------------------------------------------------
3000 IF ( .NOT. SKIP ) THEN
XYALL(NLAY+1) = IFIX ( WPARM(1) + 0.5 )
@ -1084,22 +1084,22 @@ c SUBROUTINE COMPUT (NMAX,NSVMAX,IZL,FORM)
SUBROUTINE COMPUT (NMAX,NSVMAX,FORM) ! IZL removed
CHARACTER*1 ICHAR, BACKSC, STOPPD
CHARACTER*20 COMENT
c-kt Hilfsvariable für die Berechnung der Fokussierung
c-kt Hilfsvariable f<EFBFBD>r die Berechnung der Fokussierung
REAL*4 xxf, yyf, temp
c-kt Variablen für MAGNETIC: Beginn und Stärke des Magnetfeldes [cm], [Gauss]
c-kt Variablen f<EFBFBD>r MAGNETIC: Beginn und St<EFBFBD>rke des Magnetfeldes [cm], [Gauss]
REAL*4 MSTART, MGAUSS
c-kt Hilfsvariable für die Berechnung der Bahn im Magnetfeld:
c-kt Hilfsvariable f<EFBFBD>r die Berechnung der Bahn im Magnetfeld:
REAL*4 PXPY, radius, MZDIST, TMFLUG, omega, rotats, PHIXY,
1 XHELIX, YHELIX, PHIHELIXA, PHIHELIXB, PHIHMP,
2 DELTA, DIFA, DIFB, MAXRAD
REAL*8 RGDATA, D1, D2, D3
INTEGER*4 SEEDS
c-kt Zählvariable r die aus der Rechnung genommenen Teilchen:
c-kt Z<EFBFBD>hlvariable f<EFBFBD>r die aus der Rechnung genommenen Teilchen:
INTEGER*4 fehler
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY und ALL_XY:
INTEGER*2 IMPOUT, THEOUT, STPOUT, XYOUT, XYALL, LUNINIT
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
INTEGER*2 SYSOUT, SYSIN
INTEGER*4 TEST
LOGICAL SCATTR, STRAGG, STRAG2, FORM
@ -1119,13 +1119,13 @@ c-kt Deklaration eines neuen Bezeichners f
9 / BEAM / PMEAN, PFWHM, PLOW, PHIGH, XFWHM, YFWHM,
1 RMAX,
2 IBTYP, XBEAM, YBEAM, PSIGMA, RMAX2
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
3 , XFOCUS, YFOCUS
c-kt Beginn und Stärke des Magnetfeldes
c-kt Beginn und St<EFBFBD>rke des Magnetfeldes
4 , MSTART, MGAUSS
9 / KINEMA / ID, X, Y, Z,
1 PX, PY, PZ, PTOTAL,
c-kt Einführen der Variable TTHETA für den Tangens des Streuwinkels:
c-kt Einf<EFBFBD>hren der Variable TTHETA f<EFBFBD>r den Tangens des Streuwinkels:
2 THETA, PHI, STHETA, CTHETA, TTHETA,
3 SPHI, CPHI,
4 TTOTAL, TLAST,
@ -1139,14 +1139,14 @@ c-kt Einf
4 / SEEDCO / SEEDS (6)
5 / INFOCO / NPARTI, NTHROU, NSTOP(200), NSTRVO(200),
6 NSTRIN(200), NRUECK(200), NSTRGE(200), NMLRE(200)
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
COMMON
1 / STATUS / SYSOUT, SYSIN, TEST
c 1 / STATUS / SYSOUT
c-kt Zählvariable r die aus der Rechnung genommenen Teilchen:
c-kt Z<EFBFBD>hlvariable f<EFBFBD>r die aus der Rechnung genommenen Teilchen:
COMMON
1 / COUNT / fehler
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY, ALL_XY und INIT_OUT:
COMMON
1 / SGLOUT / IMPOUT(201), THEOUT(201), STPOUT(200), XYOUT(201),
@ -1199,7 +1199,7 @@ c enddo
STRAG2 = .TRUE.
ELSE
STRAG2 = .FALSE.
c-kt IRELST ist nur für die Ausgabe mit I3 in 'OUTPUT' definiert;
c-kt IRELST ist nur f<EFBFBD>r die Ausgabe mit I3 in 'OUTPUT' definiert;
c-kt es scheint mir sinnvoller, dort RELSTR direkt mit (E10.4) auszugeben.
c-kt IRELST = IFIX( RELSTR * 1000. )
ENDIF
@ -1224,13 +1224,13 @@ C MERKE ANFANGSENERGIE UND -REICHW.
RBEGIN = DRANGE ( EBEGIN, RGDATA(1,ILAYS(NFIRST)),
1 ILAYE(NFIRST) )
c-kt Wenn 'DRANGE' einen negativen Wert übergibt, hatte ein Teilchen einen
c-kt höheren Wert r die kinetische Energie als der größte tabellierte
c-kt Wenn 'DRANGE' einen negativen Wert <EFBFBD>bergibt, hatte ein Teilchen einen
c-kt h<EFBFBD>heren Wert f<EFBFBD>r die kinetische Energie als der gr<EFBFBD><EFBFBD>te tabellierte
c-kt Energiewert:
IF (RBEGIN .LT. 0.0) THEN
WRITE (SYSOUT,181) NSV
181 FORMAT(' ',T5,'Startnummer des Teilchens',T50,I22,/T5,
1 'Der 3. Parameter des Befehls PARTICLE muß vergrößert '//
1 'Der 3. Parameter des Befehls PARTICLE muss vergroessert '//
2 'werden.')
STOP 12
ENDIF
@ -1239,14 +1239,14 @@ c-kt Ende
IF ( STRAG2) THEN
RELSTR = STRAG1( PTOTAL, BMASS )
c-kt IRELST ist nur für die Ausgabe mit I3 in 'OUTPUT' definiert;
c-kt IRELST ist nur f<EFBFBD>r die Ausgabe mit I3 in 'OUTPUT' definiert;
c-kt es scheint mir sinnvoller, dort RELSTR direkt mit (E10.4) auszugeben.
c-kt IRELST = IFIX( RELSTR * 1000. )
ENDIF
ENDIF
c-kt Wenn mindestens eine FOCUS-Konstante ungleich Null ist, fokussiere
c-kt den Strahl, sonst setze die üblichen Anfangswerte
c-kt den Strahl, sonst setze die <EFBFBD>blichen Anfangswerte
IF ( XFOCUS .NE. 0.0 .OR. YFOCUS .NE. 0.0 ) THEN
IF ( XFOCUS .NE. 0.0 ) THEN
xxf = X / XFOCUS
@ -1311,7 +1311,7 @@ C TRACK THROUGH LAYERS AND HOLES
C ----------------------------------------------------------------------
DO 200 IL=1,NLAY
IF ( ILAYS(IL) .LT. 0 ) GOTO 200
c-kt (zur Erklärung dieser Zeile: ILAYS ist genau dann negativ, wenn die
c-kt (zur Erkl<EFBFBD>rung dieser Zeile: ILAYS ist genau dann negativ, wenn die
c-kt betreffende Schicht mit SKIP aus der Rechnung genommen wurde.)
c-kt Gegebenenfalls Speichern des Impulsbetrages oder des Streuwinkels
@ -1339,7 +1339,7 @@ c-kt Die Magnetfeldlinien zeigen bei positivem MGAUSS in Strahlrichtung, bei
c-kt negativem entgegen der Strahlrichtung. Demnach ist die Bahn der mu+ eine
c-kt links- bzw. rechtsdrehende Helix.
c-kt Phi wird von der positiven X-Achse aus nach links und rechts positiv bzw.
c-kt negativ gezählt. Falls zwischen PHI und PHINEU die negative X-Achse über-
c-kt negativ gez<EFBFBD>hlt. Falls zwischen PHI und PHINEU die negative X-Achse <EFBFBD>ber-
c-kt quert wurde, fand ein Vorzeichenwechsel statt.
c-kt Wenn das Magnetfeld erst nach dem vorigen Bauteil begonnen hat, dann be-
@ -1354,7 +1354,7 @@ c-kt Gyrationsradius im Magnetfeld [cm]:
PXPY = SQRT( PX**2 + PY**2 )
radius = PXPY * 3335.668 / ABS( MGAUSS )
c-kt Im Magnetfeld zurückgelegte Strecke [cm]:
c-kt Im Magnetfeld zur<EFBFBD>ckgelegte Strecke [cm]:
MZDIST = ZKOO(IL) - AMAX1( Z, MSTART )
c-kt Flugzeit im Magnetfeld [s]:
@ -1390,8 +1390,8 @@ c-kt Richtungswinkel von der Helixmittelachse zu X,Y
IF ( PHIHELIXA .GT. 3.1415927 )
1 PHIHELIXA = PHIHELIXA - 6.2831853
c-kt Bei ZKOO(IL) angekommen beträgt der Winkel vom Helixmittelpunkt zum
c-kt Ort des Teilchens PHIHELIXB (Vollständige Rotationen sind belanglos):
c-kt Bei ZKOO(IL) angekommen betr<EFBFBD>gt der Winkel vom Helixmittelpunkt zum
c-kt Ort des Teilchens PHIHELIXB (Vollst<EFBFBD>ndige Rotationen sind belanglos):
PHIHELIXB = PHIHELIXA + SIGN( 1.0, MGAUSS ) *
1 AMOD( rotats, 1.0 ) * 6.28318531
IF ( PHIHELIXB .GT. 3.1415927 )
@ -1428,7 +1428,7 @@ c-kt Ende der Berechnung des Magnetfeldes.
c-kt =====================================
ELSE
c-kt Variable für TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
c-kt Variable f<EFBFBD>r TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
XYPROJ = TTHETA * ZDIST
X = CPHI * XYPROJ + X
Y = SPHI * XYPROJ + Y
@ -1441,7 +1441,7 @@ C BERECHNE FLUGZEIT
TLAST = ZDIST / (BETAZ * VLIGHT)
TTOTAL = TTOTAL + TLAST
ENDIF ! Dieses ENDIF gehört zu der Z-Distanz<0.01cm-Abfrage
ENDIF ! Dieses ENDIF geh<EFBFBD>rt zu der Z-Distanz<0.01cm-Abfrage
ELOSS = 0.0
@ -1470,17 +1470,17 @@ C RECHTECK
230 CONTINUE
c-kt Wenn die Rechnung mit einem Magnetfeld durchgeführt wird, muß der
c-kt Versatz in der X,Y-Ebene durch die Helixbahn berücksichtigt werden.
c-kt Wenn die Rechnung mit einem Magnetfeld durchgef<EFBFBD>hrt wird, mu<EFBFBD> der
c-kt Versatz in der X,Y-Ebene durch die Helixbahn ber<EFBFBD>cksichtigt werden.
IF ( ( ABS(MGAUSS) .GT. 0.0 ) .AND.
1 ( ZKOO(IL) .GT. MSTART ) .AND.
2 ( ZDIST .GT. 0.01 ) ) THEN
c-kt Hat das Teilchen auf der Helixbahn das Strahlrohr berührt?
c-kt Hat das Teilchen auf der Helixbahn das Strahlrohr ber<EFBFBD>hrt?
c-kt ==========================================================
c-kt Berechnung des Winkels von der X,Y=0-Achse zur Helixmittelachse. Die
c-kt Helixbahn hat in diesem Winkel den größten Abstand zur X,Y=0-Achse
c-kt Helixbahn hat in diesem Winkel den gr<EFBFBD><EFBFBD>ten Abstand zur X,Y=0-Achse
IF ( YHELIX .NE. 0.0 .OR. XHELIX .NE. 0.0) THEN
PHIHMP = ATAN2( YHELIX, XHELIX )
c-kt Sollte die Helixmittelachse wirklich auf X,Y=0 liegen, ist auch der
@ -1490,32 +1490,32 @@ c-kt Radius der Teilchenbahn konstant.
ENDIF
c-kt Welcher der beim Flug des Teilchens auf dem Segment der Helixbahn
c-kt überstrichenen Winkel kommt PHIHMP am nächsten und bezeichnet somit
c-kt <EFBFBD>berstrichenen Winkel kommt PHIHMP am n<EFBFBD>chsten und bezeichnet somit
c-kt den am weitesten von der X,Y=0-Achse entfernten Punkt?
c-kt Berechnung der Differenz DELTA dieses Winkels zu PHIHMP
c-kt 1. Es gab mindestens eine vollständige Umdrehung
c-kt 1. Es gab mindestens eine vollst<EFBFBD>ndige Umdrehung
IF ( rotats .GE. 1.0 ) THEN
DELTA = 0.0
c-kt 2. Es gab keine vollständige Umdrehung
c-kt 2. Es gab keine vollst<EFBFBD>ndige Umdrehung
ELSE
c-kt a) Kein Vorzeichenwechsel zwischen PHIHELIXA und PHIHELIXB
IF ( SIGN(1.0,MGAUSS)*PHIHELIXB .GT.
1 SIGN(1.0,MGAUSS)*PHIHELIXA ) THEN
c-kt In dem durchflogenen Helixsegment wurde PHIHMP überstrichen
c-kt In dem durchflogenen Helixsegment wurde PHIHMP <EFBFBD>berstrichen
IF ( SIGN(1.0,MGAUSS)*PHIHELIXB .GE.
1 SIGN(1.0,MGAUSS)*PHIHMP .AND.
2 SIGN(1.0,MGAUSS)*PHIHMP .GE.
3 SIGN(1.0,MGAUSS)*PHIHELIXA ) THEN
DELTA = 0.0
c-kt PHIHMP wurde nicht überstrichen
c-kt PHIHMP wurde nicht <EFBFBD>berstrichen
ELSE
c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP näher?
c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP n<EFBFBD>her?
DIFA = ABS( PHIHELIXA - PHIHMP )
IF ( DIFA .GT. 3.14159265 )
1 DIFA = 6.28318531 - DIFA
@ -1528,22 +1528,22 @@ c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP n
DELTA = DIFB
ENDIF
ENDIF ! PHIHMP überstrichen?
ENDIF ! PHIHMP <EFBFBD>berstrichen?
c-kt b) Vorzeichenwechsel zwischen PHIHELIXA und PHIHELIXB
ELSE
c-kt In dem durchflogenen Helixsegment wurde PHIHMP überstrichen
c-kt In dem durchflogenen Helixsegment wurde PHIHMP <EFBFBD>berstrichen
IF ( SIGN(1.0,MGAUSS)*PHIHMP .GE.
1 SIGN(1.0,MGAUSS)*PHIHELIXA .OR.
2 SIGN(1.0,MGAUSS)*PHIHMP .LE.
3 SIGN(1.0,MGAUSS)*PHIHELIXB ) THEN
DELTA = 0.0
c-kt PHIHMP wurde nicht überstrichen
c-kt PHIHMP wurde nicht <EFBFBD>berstrichen
ELSE
c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP näher?
c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP n<EFBFBD>her?
DIFA = ABS( PHIHELIXA - PHIHMP )
IF ( DIFA .GT. 3.14159265 )
1 DIFA = 6.28318531 - DIFA
@ -1556,14 +1556,14 @@ c-kt Welcher der beiden Winkel PHIHELIXA und PHIHELIXB ist PHIHMP n
DELTA = DIFB
ENDIF
ENDIF ! PHIHMP überstrichen?
ENDIF ! PHIHMP <EFBFBD>berstrichen?
ENDIF ! Vorzeichenwechsel von PHIHELIXA auf PHIHELIXB?
ENDIF ! Anzahl Rotationen > 1 ?
c-kt Auswertung: wenn der maximal erreichte Abstand von der X,Y=0-Achse den
c-kt Innenradius des Strahlrohres übersteigt, denn zähle das Teilchen als
c-kt Innenradius des Strahlrohres <EFBFBD>bersteigt, denn z<>hle das Teilchen als
c-kt herausgestreut.
IF ( Z .LT. 140.0 ) THEN
MAXRAD = 40.768225
@ -1625,7 +1625,7 @@ c
C SCHICHT ODER LOCH ?
250 IF ( ILAYS(IL) .EQ. 0 ) THEN
c-kt Variable für TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
c-kt Variable f<EFBFBD>r TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
XYPROJ = TTHETA * THICK(IL)
X = CPHI * XYPROJ + X
Y = SPHI * XYPROJ + Y
@ -1648,7 +1648,7 @@ C ENDENERGIE DES TEILCHENS
ELOSS = ELOSS2 ( EKIN, CRANGE, RGDATA(1,ILAYS(IL)),
1 ILAYE(IL) )
c-kt Wenn ELOSS2 einen negativen Wert übergibt ist einer von drei möglichen
c-kt Wenn ELOSS2 einen negativen Wert <EFBFBD>bergibt ist einer von drei m<EFBFBD>glichen
c-kt Fehlern aufgetreten, die hier unterschieden werden:
IF ( ELOSS .LT. 0.0 ) THEN
@ -1657,10 +1657,10 @@ c-kt Fehlern aufgetreten, die hier unterschieden werden:
251 FORMAT(' ',T5,'Startnummer des Teilchens',T50,I22)
IF ( ELOSS .LT. -2.5 ) THEN
c-kt Durch Rundungsfehler wurde keine korrekte Lösung des kubischen
c-kt Durch Rundungsfehler wurde keine korrekte L<EFBFBD>sung des kubischen
c-kt Spline-Polynoms gefunden:
fehler = fehler + 1
c-kt zu welcher Gruppe gehört die Schicht?
c-kt zu welcher Gruppe geh<EFBFBD>rt die Schicht?
DO 252 LGRP=1,NGRP
IF ( IL .LE. IGRPE(LGRP) ) GOTO 253
252 CONTINUE
@ -1673,19 +1673,19 @@ c-kt zu welcher Gruppe geh
GOTO 100
ELSEIF ( ELOSS .LT. -1.5 ) THEN
c-kt Ein Teilchen hatte einen kleineren Wert für die verbleibende Reichweite
c-kt Ein Teilchen hatte einen kleineren Wert f<EFBFBD>r die verbleibende Reichweite
c-kt als der kleinste tabellierte Reichweiten-Wert:
WRITE (SYSOUT,255)
255 FORMAT(' ',T5,'Der 2. Parameter des Befehls PARTICLE '//
1 ' muß verkleinert werden.')
1 ' mu<EFBFBD> verkleinert werden.')
STOP 11
ELSE
c-kt Ein Teilchen hatte einen höheren Wertr die kinetische Energie
c-kt als der größte tabellierte Energiewert:
c-kt Ein Teilchen hatte einen h<EFBFBD>heren Wert f<>r die kinetische Energie
c-kt als der gr<EFBFBD><EFBFBD>te tabellierte Energiewert:
WRITE (SYSOUT,256)
256 FORMAT(' ',T5,'Der 3. Parameter des Befehls PARTICLE '//
1 ' muß vergrößert werden.')
1 ' mu<EFBFBD> vergr<EFBFBD><EFBFBD>ert werden.')
STOP 12
ENDIF
@ -1718,7 +1718,7 @@ C BERECHNE STRAGGLING
ENDIF
C AUSTRITTSKOORD. OHNE STREUUNG
c-kt Variable für TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
c-kt Variable f<EFBFBD>r TAN(THETA) an die Stelle von STHETA/CTHETA gesetzt:
XYPROJ = TTHETA * THICK(IL)
XAUS = CPHI * XYPROJ + X
YAUS = SPHI * XYPROJ + Y
@ -1780,7 +1780,7 @@ C TRANSFORMIERE INS LABORSYSTEM
PY = PXEI*SPHI*CTHETA + PYEI*CPHI + PZEI*SPHI*STHETA
PZ = -PXEI*STHETA + PZEI *CTHETA
c-kt PTOTAL = SQRT(PX*PX + PY*PY + PZ*PZ) !ADDED 22.1.87 HJM, KAW!!!
c-kt Geändert zu höherer Genauigkeit bei der späteren Winkelberechnung
c-kt Ge<EFBFBD>ndert zu h<EFBFBD>herer Genauigkeit bei der sp<EFBFBD>teren Winkelberechnung
temp = PX*PX + PY*PY + PZ*PZ
PTOTAL = SQRT( temp )
IF ( PZ .LE. 0.0 ) GOTO 370
@ -1792,9 +1792,9 @@ C BERECHNE NEUE RICHTUNGSWINKEL
c-lz 6-dec-91 changed the following sentence to avoid any negative sqrt
c-lz original STHETA = SQRT( 1.0 - CTHETA*CTHETA )
c-kt STHETA = SQRT(amax1(0.0,(1.0 - CTHETA*CTHETA )))
c-kt Geändert zu höherer Genauigkeit bei der Berechnung:
c-kt Ge<EFBFBD>ndert zu h<EFBFBD>herer Genauigkeit bei der Berechnung:
STHETA = SQRT( ( PX*PX + PY*PY ) / temp )
c-kt Berechnung der neu eingeführten Variable für TAN(THETA):
c-kt Berechnung der neu eingef<EFBFBD>hrten Variable f<EFBFBD>r TAN(THETA):
TTHETA = SQRT( ( PX*PX + PY*PY ) / (PZ*PZ) )
THETA = ASIN( STHETA )
@ -1917,14 +1917,14 @@ C ----------------------------------------------------------------------
2 / BEAM / PMEAN, PFWHM, PLOW, PHIGH, XFWHM, YFWHM,
3 RMAX,
4 IBTYP, XBEAM, YBEAM, PSIGMA, RMAX2
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
5 , XFOCUS, YFOCUS
c-kt Beginn und Stärke des Magnetfeldes
c-kt Beginn und St<EFBFBD>rke des Magnetfeldes
6 , MSTART, MGAUSS
COMMON
1 / KINEMA / ID, X, Y, Z,
2 PX, PY, PZ, PTOTAL,
c-kt Einführen der Variable TTHETA für den Tangens des Streuwinkels:
c-kt Einf<EFBFBD>hren der Variable TTHETA f<EFBFBD>r den Tangens des Streuwinkels:
3 THETA, PHI, STHETA, CTHETA, TTHETA,
4 SPHI, CPHI,
5 TTOTAL, TLAST, ELOSS
@ -1976,10 +1976,10 @@ C ----------------------------------------------------------------------
CHARACTER*20 COMENT,COMT
REAL*8 RGDATA
INTEGER*4 SEEDS, TEST
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY und ALL_XY:
INTEGER*2 IMPOUT, THEOUT, STPOUT, XYOUT, XYALL, LUNINIT
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
INTEGER*2 SYSOUT, SYSIN
COMMON
1 / OUTPUT / NLIMIT(200), NCOUNT(200), IOTYPE(200),
@ -1999,17 +1999,17 @@ c-kt Deklaration eines neuen Bezeichners f
9 / BEAM / PMEAN, PFWHM, PLOW, PHIGH, XFWHM, YFWHM,
1 RMAX,
2 IBTYP, XBEAM, YBEAM, PSIGMA, RMAX2
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
3 , XFOCUS, YFOCUS
c-kt Beginn und Stärke des Magnetfeldes
c-kt Beginn und St<EFBFBD>rke des Magnetfeldes
4 , MSTART, MGAUSS
3 / SEEDCO / SEEDS(6)
c-kt Integer-Arrays für die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt Integer-Arrays f<EFBFBD>r die Unit-Nummern zu den Befehlen IMPULS, WINKEL,
c-kt STOPPED, WHERE_XY und ALL_XY:
COMMON
1 / SGLOUT / IMPOUT(201), THEOUT(201), STPOUT(200), XYOUT(201),
2 XYALL(201), LUNINIT
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
COMMON
1 / STATUS / SYSOUT, SYSIN, TEST
@ -2096,8 +2096,8 @@ C ----------------------------------------------------------------------
c-kt Ausgabe der Stop-Daten des Targets: aufeinanderfolgend in jeder
c-kt Zeile die Anzahl der in der Lage gestoppten Teilchen
IF ( STPOUT(LGRP) .NE. 0 ) THEN
WRITE (STPOUT(LGRP),1909) NSTOP(I)
1909 FORMAT(' ',I6)
WRITE (STPOUT(LGRP),1909) I, NSTOP(I)
1909 FORMAT(' ',I3, ' ',I6)
ENDIF
c-kt Ende
@ -2154,9 +2154,9 @@ C ----------------------------------------------------------------------
9 / BEAM / PMEAN, PFWHM, PLOW, PHIGH, XFWHM, YFWHM,
1 RMAX,
2 IBTYP, XBEAM, YBEAM, PSIGMA, RMAX2
c-kt Z-Komponente von X- und Y-Strahlfoci für den Befehl FOCUS
c-kt Z-Komponente von X- und Y-Strahlfoci f<EFBFBD>r den Befehl FOCUS
3 , XFOCUS, YFOCUS
c-kt Beginn und Stärke des Magnetfeldes
c-kt Beginn und St<EFBFBD>rke des Magnetfeldes
4 , MSTART, MGAUSS
C ----------------------------------------------------------------------
@ -2213,11 +2213,11 @@ C ----------------------------------------------------------------------
CHARACTER*10 TEXT
REAL*4 VAR, LEFT, RIGHT
INTEGER*4 IVAR, ILEFT, IRIGHT, TEST
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
INTEGER*2 SYSOUT, SYSIN
REAL*4 RVAR, RLEFT, RRIGHT
EQUIVALENCE ( RVAR,IVAR ), ( RLEFT,ILEFT ), ( RRIGHT,IRIGHT )
c-kt Deklaration eines neuen Bezeichners für die Ausgabeunit: SYSOUT
c-kt Deklaration eines neuen Bezeichners f<EFBFBD>r die Ausgabeunit: SYSOUT
COMMON
1 / STATUS / SYSOUT, SYSIN, TEST