LMU/musrsim
LMU/musrsim
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
prokscha 2009-11-17 08:35:57 +00:00
parent 0d5e333fca
commit 6c36e69cd1
1 changed files with 128 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

256
mcv3k/src/mcv3k.f
View File

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