
	OPTIONS /EXTEND_SOURCE

	SUBROUTINE READ_INFO_1
c	======================

        IMPLICIT NONE

	character*1 Nr
	parameter (Nr='1')

	INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
	INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
	INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'

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

	logical map_error
	COMMON /map_error/ map_error

c the grid characteristics (as read from the INFO-file):

	real	Dx,Dy,Dz
	real	x_iEQ1, ymax,zmax	! xmin wird in MAP_DEF_1 definiert

	namelist /grid_info/
     +	Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax

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

c Einlesen der Mappen-Informationen:

	open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO',
     +						  readonly,status='old')
	    read(lunREAD,nml=grid_info)
	close (lunREAD)


c eingelesene imax, jmax und kmax um 1 reduzieren, da in 'ACCEL' die Feldindizes
c ab 0 laufen, bei 'RELAX3D' jedoch ab 1:

	imax = imax-1
	jmax = jmax-1
	kmax = kmax-1


c Umrechnen der Koordinaten, wie sie von 'BESCHL-INIT' ('RELAX3D') verwendet
c werden (Ursprung in Targetfolienmitte) in System mit Ursprung auf der Kryo-Achse:

	xmin	= xmin	 + xFoil
	xmax	= xmax	 + xFoil


c xStartUeber definieren:

	xStartUeberUpp = xmax - .5*dx


C DER FOLGENDE ABSCHNITT WURDE HERAUSKOMMENTIERT, DA ES MITTLERWEILE VERSCHIEDEN
C GROSSE POTENTIALMAPPEN GIBT UND DIE MAPPENDIMENSIONEN DAHER SOWIESO VARIABEL
C GEHALTEN WERDEN MUESSEN. DIE VERWENDUNG VON PARAMETERN IST LEIDER NICHT
C MEHR MOEGLICH. ('LEIDER' WEGEN DER ERHOEHTEN RECHENZEIT):
C
Cc checken, ob die Characteristica der einzulesenden Mappe mit den Vorgaben des
Cc reservierten Speichers uebereinstimmen:
C
C	if (
C     +	    imax.NE.imax_ .OR. 
C     +	    jmax.NE.jmax_ .OR. kmax.NE.kmax_ .OR.
C     +	    Dx.NE.Dx_ .OR. Dy.NE.Dy_ .OR. Dz.NE.Dz_
Cc    +	    .OR. xmin.NE.xmin_
C     +				      ) then
C	    write(*,*) '-----------------------------------------------------------'
C	    if (.NOT.map_error) then
C		write(*,*) ' Feldgroessen der eingelesenen Mappe und des reservierten'
C		write(*,*) ' Speichers stimmen nicht ueberein:'
C		write(*,*)
C	    endif
C	    write(*,*) ' MAPPE '//Nr//':   '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE'
C	    write(*,*) ' Mappe:     imax ,jmax ,kmax   = ',imax ,jmax ,kmax
C	    write(*,*) '            Dx   ,Dy   ,Dz     = ',Dx   ,Dy   ,Dz  
C	    write(*,*) ' Speicher:  imax_,jmax_,kmax_  = ',imax_,jmax_,kmax_
C	    write(*,*) '            Dx_  ,Dy_  ,Dz_    = ',Dx_  ,Dy_  ,Dz_ 
C	    write(*,*)
C	    map_error = .true.
C	endif
C
C	if (map_error) RETURN	    ! kann auch in anderem 'READ_MAP_x' gesetzt worden sein


c checken, ob der reservierte Speicherplatz ausreicht:

	if ((imax+1)*(jmax+1)*(kmax+1).GT.maxmaxmem+1) then
	    write(*,*)
	    write(*,*) 'reservierter Speicher ist nicht ausreichend fuer Mappe',Nr
	    write(*,*)
	    write(*,*) '(imax+1)*(jmax+1)*(kmax+1) = ',(imax+1)*(jmax+1)*(kmax+1)
	    write(*,*) 'maxmaxmem + 1              = ',maxmaxmem + 1
	    write(*,*)
	    write(*,*) '=> ''maxmaxmem'' in accel$sourcedirectory:MAPMAP.INC angleichen'
	    write(*,*) '   und Programm mit ''LINKACV'' am DCL-Prompt neu kompilieren'
	    write(*,*) '   und linken.' 
	    write(*,*)
	    call exit
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE READ_MAP_1
c	=====================

        IMPLICIT NONE

	character*1 Nr
	parameter (Nr='1')

	INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
	INCLUDE 'accel$sourcedirectory:READ_MAP.INC'

	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE ADD_MAP_1
c	====================

        IMPLICIT NONE

	character*1 Nr
	parameter (Nr='1')

	INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
	INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'

	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_1(dt)
c	=============================================

        IMPLICIT NONE
	SAVE

	character*1 Nr
	parameter (Nr='1')

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_1.INC'

c fuer Fehlermeldungen:
d	integer	last_start_nr /0/, zaehler

	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
	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

	logical	reducedAccur		   ! reduzierte Genauigkeit im Bereich
	COMMON /reducedAccur/ reducedAccur ! des Folienrandes

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

	flag_dtSmall = .false.		  ! flag resetten
	found_lower_upp = .false.
	found_upper_upp = .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_1(x,EFeld0,*998)

c...............................................................................
10	continue    ! hier gehts wieder von vorne los, falls Zeitschritt dt
		    ! abgeaendert werden muss.

d	if (once_more) then
d	    write (lunLOG,*)' selber Integrationsschritt, neues dt: ',dt
d	else
d	    write (lunLOG,*)' >>>>>>>> dt = ',dt
d	    once_more = .true.
d	endif


	dt_half = dt / 2.


c mache ersten dt/2 - Schritt:

	call SINGLESTEP_RUNGE_KUTTA_1(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_1(x1,EFeld1,*999)


c mache zweiten dt/2 - Schritt:

	call SINGLESTEP_RUNGE_KUTTA_1(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_1(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):

c Zaehle die Schritte:

	steps = Steps + 1


c Fehlerbetrachtung:

c der groesste (absolute bzw. relative) Fehler im Ort soll kleiner als eps_x
c sein, der groesste Fehler in der Geschwindigkeit kleiner als eps_v:
c -> Bestimme den jeweils groessten Fehler der drei Komponenten des Ortes und
c    der Geschwindigkeit (dh. die groesste Differenz der Aederungen):

	maxErr_x = 0.
	maxErr_v = 0.

	do i = 1, 3
	    xDifferenz(i) = Dx1(i)-Dx2(i)
	    vDifferenz(i) = Dv1(i)-Dv2(i)
	    if (log_relativ.AND..NOT.reducedAccur) then
		if (Dx1(i).NE.0.) maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)/Dx1(i)))
		if (Dv1(i).NE.0.) maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)/Dv1(i)))
	    else
		maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)))
		maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)))
	    endif
	enddo

c - Skaliere den jeweils groessten relativen Fehler auf das jeweilige Epsilon:

	if (reducedAccur) then
	    maxErr_x = maxErr_x / 1e-6
	    maxErr_v = maxErr_v / 1e-6
	else
	    maxErr_x = maxErr_x / eps_x
	    maxErr_v = maxErr_v / eps_v
	endif

c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . 

c der groessere der beiden reskalierten Fehler bestimmt, ob der Integrations-
c schritt mit kleinerem Zeitintervall wiederholt werden muss, bzw. um welchen
c Faktor das Zeitintervall fuer den naechsten Schritt vergroessert werden kann:

c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dt bereits jetzt
c kleiner als dtsmall, so mache keinen neuen Versuch sondern akzeptiere als Not-
c loesung den bestehenden Naeherungswert. Setze dt in diesem Fall als Default
c fuer den kommenden Integrationsschritt auf dtsmall. Setze aber auch das flag
c 'flag_dtsmall', damit gezaehlt werden kann, wie oft dieses Prozedur fuer ein
c bestimmtes Teilchen angewendet werden muss. Ist dies zu oft der Fall, so brich
c diese Trajektorienberechnung ganz ab (-> destiny = code_dtsmall).
c (2. Teil erfolgt weiter unten)
c
c Es kam vor, dass ohne Ueberschreitung der Fehlertoleranz ein 'dtupper'
c und ein 'dtlower' gefunden wurde, beim Ertasten des Uebergabebereiches
c die Fehlergrenze bei mittleren dt-Werten dann aber ueberschritten wurde,
c wodurch dt immer wieder verkuerzt wurde, ohne dass der Uebergabebereich
c erreicht werden konnte. Letztlich bildete das ganze eine unendliche Schleife.
c Daher werden jetzt jedesmal, wenn die Fehlergrenze ueberschritten wird
c 'found_upper' und 'found_lower' resettet.

	maxErr = Max(maxErr_x,maxErr_v)

	if (maxErr.GT.1.) then
	    found_upper_upp = .false.
	    found_lower_upp = .false.
	    if (dt.LT.dtsmall) then	! Fehler immer noch zu gross, obwohl
		flag_dtsmall = .true.	!    dtsmall schon unterschritten ist
	    else
		!c  Bestimme kuerzeren Zeitschritt fuer neuen Versuch (vgl. Referenz):
		dt = safety * dt * (maxErr**pShrink)
		goto 10
	    endif
	endif


	x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15.


c Falls x(1) (== x_1) jetzt jenseits des Mappenendes liegen sollte, behalte
c dieses Faktum im Gedaechtnis und verkuerze den aktuell verwendeten Zeitschritt
c so lange um Faktor 0.5, bis x(1) innerhalb oder vor dem Uebergabebereich liegt.
c Liegt es dann davor, suche einen mittleren Zeitschritt, bei dem es innerhalb
c liegt.
c Hat das Teilchen danach (oder nachdem es direkt in den Uebergabebereich traf)
c positives v(1), so setze das Logical 'reachedEndOfMap' fuer die Berechnung
c des Schnittpunkts der Trajektorie mit dem Mappenende.
c (v(1)<0. ist entweder moeglich falls es bereits vor dem Mappenende reflektiert
c wurde oder gerade aus Mappe mit hoeherer Nummer kam).

	if (x_1.GT.xStartUeberUpp) then
	    if (.NOT.found_upper_upp) dt_save = dt
	    if (x_1.LE.xMax .AND. v(1).GT.0.) then
		reachedEndOfMap = .true.
	    elseif (x_1.GT.xMax) then
		dtupper = dt
		found_upper_upp = .true.
		if (.NOT.found_lower_upp) then
		    dt = min(0.5*dt,(xStartUeberUpp-x(1))/(x_1-x(1))*dt)
		else
		    dt = (dtlower+dtupper)/2.
		endif
		goto 10				    ! neue Berechnung
	    endif
	elseif (found_upper_upp) then
	    found_lower_upp = .true.
	    dtlower = dt
	    dt = (dtlower+dtupper)/2.
	    goto 10				    ! neue Berechnung      
	endif


c Nimm die Ergebnisse aus dem dt-Schritt und den beiden dt/2-Schritten und
c berechne damit den neuen Ort und die neue Geschwindigkeit mit Genauigkeit
c fuenfter Ordnung in dt:

	x(1) = x_1
	x(2) = x(2) + Dx1(2) + xDifferenz(2) / 15.
	x(3) = x(3) + Dx1(3) + xDifferenz(3) / 15.

	v(1) = v(1) + Dv1(1) + vDifferenz(1) / 15.
	v(2) = v(2) + Dv1(2) + vDifferenz(2) / 15.
	v(3) = v(3) + Dv1(3) + vDifferenz(3) / 15.


c alten Zeitschritt addieren:

	t = t + dt


c Falls Uebergabebereich erreicht wurde, berechne Schnittpunkt der Trajektorie
c mit x=xmax (Mappenende):

	if (reachedEndOfMap) goto 7766


c neuen Zeitschritt so gross wie sinnvoller weise moeglich machen:

3454	if (flag_dtSmall) then
	    if (n_dtsmall.LT.maxBelowDtSmall) then
		dt = dtSmall			  ! fuer naechsten RK-Schritt
		n_dtsmall = n_dtsmall + 1
	    else
		destiny = code_dtsmall		  ! gib Teilchen verloren
		RETURN
	    endif
	else
	    if (maxErr.GT.errCon) then
		dt = safety * dt * (maxErr**pGrow)	! vgl. Referenz
	    else
		dt = 4. * dt	! <- Vergroesserung des Zeitschritts max. um
	    endif		!    Faktor 4!
	    dt = min(dt,10000.)
	    ! pruefen, ob Maximallaenge fuer ersten Testschritt nicht ueberschritten ist:
	    if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
	endif

	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_1(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_1(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 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(*,*)'   start_nr = ',start_Nr
	    write(*,*)'   x = ',x
	    write(*,*)'   v = ',v
	    write(*,*)'   -> STOP' 
	    STOP
	endif

c - Fehler trat auf bei Berechnung des EFeldes am aktuellen Teilchenort oder
c   an einem Testort (in 1. Fall erfolgt Einstieg bei 998):

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 (t.EQ.0.) then			! -> kann manchmal vorkommen
		destiny = code_reflektiert
	    elseif (v(1).LE.0) then		! reflektiert -> kann vorkommen
		destiny = code_reflektiert
	    else	    ! in Vorwaertsbewegung -> darf nicht vorkommen!!
		write(*,*)
		write(*,*) 'Mappe '//Nr//':'
		write(*,*)
		write(*,*)'   Test-x liegt vor der Mappe!'
		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(*,*)'   Step                = ',Steps
		write(*,*)
		write(*,*)'   -> STOP'
		write(*,*)
		destiny = code_vor_Mappe
c		STOP
	    endif
	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_1(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_1(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_1(xTest,E2,*999)

	do i = 1, 3
	    xTest(i) = x0(i) + v2(i) * dt 
	    v3(i)    = v0(i) + E2(i) * help
	enddo
	call EFeld_1(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_1(x,E,*)
c       =========================

	IMPLICIT NONE

        INCLUDE 'accel$sourcedirectory:MAP_DEF_1.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===============================================================================
