OPTIONS /EXTEND_SOURCE SUBROUTINE READ_INFO_3 c ====================== IMPLICIT NONE character*1 Nr parameter (Nr='3') INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC' INCLUDE 'accel$sourcedirectory:READ_INFO.INC' END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE READ_MAP_3 c ===================== IMPLICIT NONE character*1 Nr parameter (Nr='3') INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC' INCLUDE 'accel$sourcedirectory:READ_MAP.INC' END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE ADD_MAP_3 c ==================== IMPLICIT NONE character*1 Nr parameter (Nr='3') INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC' INCLUDE 'accel$sourcedirectory:ADD_MAP.INC' END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_3(dt) c ============================================= IMPLICIT NONE SAVE character*1 Nr parameter (Nr='3') c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden c zuerst ausgefuehrt). c c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann. c c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter c Ordnung in dt zu erhalten. c c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im c fileheader von 'ACCEL.FOR') INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC' INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC' real help real dt_save integer i ! Zaehlvariable real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung real EFeld0(3), EFeld1(3) ! elektr. Felder real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration real xDifferenz(3), vDifferenz(3) real x_1 ! Hilfsvariable fuer testweises x(1) real a ! Beschleunigung real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung real errCon, safety ! fuer Schrittweitenkontrolle real pShrink, pGrow ! fuer Schrittweitenkontrolle PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz PARAMETER (pShrink = -.25, pGrow = -.2) ! errCon = (4./safety)**(1/pGrow) logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und ! der Fehler immer noch zu gross ist. logical found_lower_upp ! obere und untere Grenze fuer dt um logical found_upper_upp ! Uebergabebereich zu treffen logical found_lower_low ! obere und untere Grenze fuer dt um logical found_upper_low ! Uebergabebereich zu treffen real dtlower,dtupper integer returnCode_EFeld COMMON /returnCode_EFeld/ returnCode_EFeld ! 1: Testort hinter der Mappe ! 2: Testort neben der Mappe ! 3: Testort vor der Mappe c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - flag_dtSmall = .false. ! flag resetten found_lower_upp = .false. found_upper_upp = .false. found_lower_low = .false. found_upper_low = .false. if (dt.lt.dtsmall) dt = dtsmall c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss: call EFeld_3(x,EFeld0,*998) c............................................................................... 10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt ! abgeaendert werden muss. dt_half = dt / 2. c mache ersten dt/2 - Schritt: call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999) c berechne EFeld bei x1: x1(1) = x(1) + Dx1(1) x1(2) = x(2) + Dx1(2) x1(3) = x(3) + Dx1(3) v1(1) = v(1) + Dv1(1) v1(2) = v(2) + Dv1(2) v1(3) = v(3) + Dv1(3) call EFeld_3(x1,EFeld1,*999) c mache zweiten dt/2 - Schritt: call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999) c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1: Dx1(1) = Dx1(1) + Dx2(1) Dx1(2) = Dx1(2) + Dx2(2) Dx1(3) = Dx1(3) + Dx2(3) Dv1(1) = Dv1(1) + Dv2(1) Dv1(2) = Dv1(2) + Dv2(2) Dv1(3) = Dv1(3) + Dv2(3) c mache dt - Schritt: call SINGLESTEP_RUNGE_KUTTA_3(dt,EFeld0,x,v, Dx2,Dv2 ,*999) c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit- c schritt dt verkuerzt und bei Label 10 erneut begonnen): INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC' RETURN c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit c in positiver x-Richtung geht. c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen- c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes. c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem c Mappenende reflektiert werden koennte: 7766 continue call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort ! a == Beschleunigung bei x in x-Richtung a = EFeld0(1)*Beschl_Faktor ! help == Radiant in entsprechender 'Mitternachtsformel' help = v(1)*v(1) + 2.*a*(xmax-x(1)) if (help.LT.0) then ! noch vor Mappenende reflektiert reachedEndOfMap = .false. dt = dt_save ! dt restaurieren goto 3454 ! Festlegen des neuen dt, RETURN else ! dt == Zeit bis Mappenende if (a.NE.0) then dt = (sqrt(help) - v(1))/a else dt = (xmax-x(1))/v(1) endif if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt endif d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt d if (x1(1).NE.xmax) then d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax x1(1) = xmax d endif x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen EFeld0(2) = (EFeld0(2)+EFeld1(2))/2. EFeld0(3) = (EFeld0(3)+EFeld1(3))/2. ! wiederhole Berechnung mit mittlerem EFeld: ! a == Beschleunigung mit mittlerem EFeld in x-Richtung a = EFeld0(1)*Beschl_Faktor ! help == Radiant in entsprechender 'Mitternachtsformel' help = v(1)*v(1) + 2.*a*(xmax-x(1)) if (help.LT.0) then ! noch vor Mappenende reflektiert reachedEndOfMap = .false. dt = dt_save ! dt restaurieren goto 3454 ! Festlegen des neuen dt, RETURN else ! dt == Zeit bis Mappenende if (a.NE.0) then dt = (sqrt(help) - v(1))/a else dt = (xmax-x(1))/v(1) endif if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt endif ! Berechnen des neuen Ortes: d x(1) = x(1)+v(1)*dt+.5*a*dt*dt d if (x(1).NE.xmax) then d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax x(1) = xmax d endif x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt ! Berechnen der neuen Geschwindigkeit: v(1) = v(1)+a*dt v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt ! Berechnen der neuen Zeit: t = t + dt dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren RETURN c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit c in negativer x-Richtung geht. c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen- c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes. c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem c Mappenanfang reflektiert werden koennte: 7767 continue call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort ! a == Beschleunigung bei x in x-Richtung a = EFeld0(1)*Beschl_Faktor ! help == Radiant in entsprechender 'Mitternachtsformel' help = v(1)*v(1) + 2.*a*(xmin-x(1)) if (help.LT.0) then ! noch vor Mappenanfang reflektiert reachedEndOfMap = .false. dt = dt_save ! dt restaurieren goto 3454 ! Festlegen des neuen dt, RETURN else ! dt == Zeit bis Mappenanfang if (a.NE.0) then dt = (-sqrt(help) - v(1))/a else dt = (xmin-x(1))/v(1) endif if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt endif d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt d if (x1(1).NE.xmin) then d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin x1(1) = xmin d endif x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen EFeld0(2) = (EFeld0(2)+EFeld1(2))/2. EFeld0(3) = (EFeld0(3)+EFeld1(3))/2. ! wiederhole Berechnung mit mittlerem EFeld: ! a == Beschleunigung mit mittlerem EFeld in x-Richtung a = EFeld0(1)*Beschl_Faktor ! help == Radiant in entsprechender 'Mitternachtsformel' help = v(1)*v(1) + 2.*a*(xmin-x(1)) if (help.LT.0) then ! noch vor Mappenanfang reflektiert reachedEndOfMap = .false. dt = dt_save ! dt restaurieren goto 3454 ! Festlegen des neuen dt, RETURN else ! dt == Zeit bis Mappenanfang if (a.NE.0) then dt = (-sqrt(help) - v(1))/a else dt = (xmin-x(1))/v(1) endif if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt endif ! Berechnen des neuen Ortes: d x(1) = x(1)+v(1)*dt+.5*a*dt*dt d if (x(1).NE.xmin) then d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin x(1) = xmin d endif x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt ! Berechnen der neuen Geschwindigkeit: v(1) = v(1)+a*dt v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt ! Berechnen der neuen Zeit: t = t + dt dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren RETURN c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass c bei der Berechnung des Feldes eine Fehlersituation auftrat: c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT: 998 if (returnCode_EFeld.EQ.1) then write(*,*) 'Mappe '//Nr//':' write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!' write(*,*)' -> STOP' write(*,*) STOP endif c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass c bei der Berechnung des Feldes eine Fehlersituation auftrat: c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT: 999 if (returnCode_EFeld.EQ.1) then if (.NOT.found_upper_upp) dt_save = dt dtupper = dt found_upper_upp = .true. if (.NOT.found_lower_upp) then dt = 0.5*dt else dt = (dtlower+dtupper)/2. endif goto 10 elseif (returnCode_EFeld.EQ.2) then destiny = code_neben_Mappe elseif (returnCode_EFeld.EQ.3) then if (.NOT.found_upper_low) dt_save = dt dtupper = dt found_upper_low = .true. if (.NOT.found_lower_low) then dt = 0.5*dt else dt = (dtlower+dtupper)/2. endif goto 10 elseif (returnCode_EFeld.NE.0) then write(*,*) write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': ' write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld write(*,*) '-> STOP' write(*,*) STOP endif RETURN c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der c Trajektorie mit einer Mappenbegrenzung: 997 if (returnCode_EFeld.EQ.2) then destiny = code_neben_Mappe else write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': ' write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection' write(*,*) 'of trajectory and x equals xmax line.' write(*,*) write(*,*)' returnCode_EFeld = ',returnCode_EFeld write(*,*)' t = ',t write(*,*)' x0 = ',x0 write(*,*)' v0 = ',v0 write(*,*)' E0 = ',E0 write(*,*)' theta0 = ',theta0 write(*,*)' phi0 = ',phi0 write(*,*)' x = ',x write(*,*)' v = ',v write(*,*)' Teilchen-Nr = ',Start_Nr write(*,*) write(*,*) '-> STOP' write(*,*) STOP endif END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE SINGLESTEP_RUNGE_KUTTA_3(dt,E0,x0,v0, Dx,Dv, *) c ========================================================== IMPLICIT NONE c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen c Runge-Kutta-Integrationsschritt (4. Ordnung). c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der c NUMERICAL RECIPIES: 'Runge-Kutta Method'. c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_ c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher- c weise grosser Werte). real Beschl_Faktor COMMON /Beschl_Faktor/ Beschl_Faktor real E0(3), x0(3), v0(3) ! Eingangsgroessen real E1(3), E2(3), E3(3) ! E-Felder an Testorten real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6 real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6 real xTest(3) ! Test-Orte real Dx(3), Dv(3) ! Ergebnisspeicher integer i ! Zaehlvariable c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = dt_half = dt / 2. dt_sixth = dt / 6. help = Beschl_Faktor * dt help_half = help / 2. help_sixth = help / 6. do i = 1, 3 xTest(i) = x0(i) + v0(i) * dt_half v1(i) = v0(i) + E0(i) * help_half enddo call EFeld_3(xTest,E1,*999) do i = 1, 3 xTest(i) = x0(i) + v1(i) * dt_half v2(i) = v0(i) + E1(i) * help_half enddo call EFeld_3(xTest,E2,*999) do i = 1, 3 xTest(i) = x0(i) + v2(i) * dt v3(i) = v0(i) + E2(i) * help enddo call EFeld_3(xTest,E3,*999) do i = 1, 3 Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth enddo RETURN 999 RETURN 1 END c=============================================================================== OPTIONS /EXTEND_SOURCE SUBROUTINE EFeld_3(x,E,*) c ========================= IMPLICIT NONE INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC' INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC' c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Rechne in Gittereinheiten um: real_i = (x(1)-xmin) / Dx_ real_j = abs(x(2)) / Dy_ real_k = abs(x(3)) / Dz_ c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - c Mache die Tests und berechne die Feldstaerke: INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC' END c===============================================================================