c 462  -------------------------------------------------------------------------------
c Konstanten und Variable fuer Berechnung der Winkelaufstreuung in Triggerfolie
c mittels Meyer-Formel (L.Meyer, phys.stat.sol. (b) 44, 253 (1971)):

	real g1, g2	     ! Tabellierte Funktionen der Referenz
	real effRedThick     ! effektive reduzierte Dicke ('tau' der Referenz)


c - Parameter:

	real Z1, Z2	    ! die atomaren Nummern von Projektil und Target
	real a0		    ! Bohrscher Radius in cm
	real screeningPar   ! Screeningparameter 'a' in cm fuer Teilchen der
			    ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6)
			    ! bei Streichung von Z1 (vgl. Referenz, S. 268)

	real r0Meyer	    ! r0(C) berechnet aus dem screeningParameter 'a'
			    ! und dem ebenfalls bei Meyer angegebenem
			    ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben)
	real eSquare	    ! elektrische Ladung zum Quadrat in keV*cm
	real HWHM2sigma	    ! Umrechnungsfaktor von (halber!) Halbwertsbreite
			    ! nach Sigma der Gaussfunktion

	real Na		    ! die Avogadrokonstante
	real mMolC	    ! molare Masse von C in ug
	real Pi		    ! die Kreiszahl

	parameter (Z1 = 1,  Z2 = 6,  a0 = 5.29E-9,  ScreeningPar = 2.5764E-9)
	parameter (r0Meyer = 9.909E-9,  eSquare = 1.44E-10,  HWHM2sigma = 1./1.17741)
	parameter (Na = 6.022e23,  mMolC = 12.011e6,  Pi = 3.141592654)


c - Bei der Berechnung von Sigma auftretende Vorfaktoren.
c   (Meyer_faktor 1 wird benoetigt fuer Berechnung der reduzierten Dicke aus der
c   'ug/cm2'-Angabe der Foliendicke. Meyer_faktor2 und Meyer_faktor3 werden
c   direkt fuer die Berechnung von sigma aus den beiden tabellierten Funktionen
c   g1 und g2 verwendet):

	real Meyer_Faktor1, Meyer_Faktor2, Meyer_Faktor3

	parameter (Meyer_faktor1 = Pi*screeningPar*screeningPar * Na/mMolC)
						!  Na/mMolC = 1/m(C-Atom)
	parameter (Meyer_faktor2 = (2*Z1*Z2 * eSquare)/ScreeningPar * 180./Pi
     +							      * HWHM2sigma)
	parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer))


c-------------------------------------------------------------------------------
c Kommentar zur Berechnung der Winkelaufstreuung nach Meyer:
c
c Als Bedingung fuer die Gueltigkeit der Rechnung wird verlangt, dass
c
c (1) die Anzahl n der Stoesse >> 20*(a/r0)^(4/3) sein muss. Fuer Protonen auf
c     Graphit ist laut Referenz a/r0 gleich 0.26 (mit Dichte von 3.5 g/ccm habe
c     ich einen Wert von 0.29 abgeschaetzt). Fuer Myonen hat man den selben
c     Wert zu nehmen. Damit ergibt sich die Forderung, dass n >> 3.5 sein muss.
c
c (2) unabhaengig von (1) n >> 5 sein muss, was (1) also mit einschliesst.
c
c Mit  n = Pi*r0*r0*Teilchen/Flaeche  ergibt sich fuer eine Foliendicke von
c 3 ug/cm^2 als Abschaetzung fuer n ein Wert von 37. (r0 ueber r0 = 0.5 N^(1/3)
c und 3.5 g/ccm zu 8.9e-9 cm abgeschaetzt). D.h., dass die Bedingungen in
c unserem Fall gut erfuellt sind.
c In dem Paper wird eine Formel fuer Halbwertsbreiten angegeben. Ich habe nicht
c kontrolliert, in wie weit die Form der Verteilung tatsaechlich einer Gauss-
c verteilung entspricht. Zumindest im Bereich der Vorwaertsstreuung sollte
c die in diesem Programm verwendete Gaussverteilung aber eine sehr gute
c Naeherung abgeben. Abweichungen bei groesseren Winkeln koennten jedoch u. U.
c die absolute Streuintensitaet in Vorwaertsrichtung verfaelschen.





c (...)


c 1071 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Falls 'fromScratch':
c   Die in den ab hier beginnenden Startparameter-Schleifen gesetzten Werte
c   werden gegebenenfalls weiter unten durch zufallsverteilte Offsets modi-
c   fiziert. (-> 'Zufallschleife': 'do 100 randomloop_ = 1, n_par(0))
c Andernfalls:
c   Wurden waehrend ACCEL oder 'foilfile' fuer die Startparameter Zufalls-
c   verteilungen verwendet, so werden die entsprechenden Groessen aus dem
c   betreffenden NTupel eingelesen.
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

c Startparameter:
c ---------------

	do 200 E0_ = par(1,ener),par(2,ener),par(3,ener)	      ! E0
	    if (.NOT.random_E0) then
		E0 = E0_
		v0_Betrag = sqrt(E0/Energie_Faktor)
	    endif

	    if (E0InterFromFile) then
		lowerE0 = E0Low(nInt(E0_))
		upperE0 = E0Low(nint(E0_+1))
	    endif


c falls Energieverlustberechnung aus ICRU-Tabelle verlangt ist und mittlerer
c Energieverlust nicht fuer jedes Teilchen extra berechnet werden soll (sinnvoll
c wenn alle Teilchen gleiche Startenergie haben oder Streuung der Startenergien
c klein ist, so dass die Streuung des mittleren Energieverlustes vernachlaessigt
c werden kann):

	if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then
	    if (random_E0_equal) then
		Ekin = E0_ + (upperE0+lowerE0)/2.
	    else
		Ekin = E0_
	    endif
	    if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then
		Ekin = Ekin + q*(U_Tgt - U_F)
	    elseif (Gebiet0.EQ.upToGrid2) then
		Ekin = Ekin + q*(U_G1 - U_F)
	    endif
	    call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,mean_E_Verlust)
	endif

	if (log_Meyer_F_Function) then
	    if (random_E0_equal) then
		Ekin = E0_ + (upperE0+lowerE0)/2.
	    else
		Ekin = E0_
	    endif
	    if (Gebiet0.EQ.target .OR. Gebiet0.EQ.upToGrid1) then
		Ekin = Ekin + q*(U_Tgt - U_F)
	    elseif (Gebiet0.EQ.upToGrid2) then
		Ekin = Ekin + q*(U_G1 - U_F)
	    endif
	    effRedThick = Meyer_Faktor1 * Thickness
	    call Get_F_Function_Meyer(effRedThick,Ekin)
	endif

	do 200 theta0_ = par(1,thetAng),par(2,thetAng),par(3,thetAng) ! theta0
	    if (.NOT.random_angle) then
		theta0 = theta0_
		Cos_theta0 = cosd(theta0)
		Sin_theta0 = sind(theta0)
	    endif
	do 200 phi0_  = par(1,phiAng),par(2,phiAng),par(3,phiAng)  ! phi0
	    if (.NOT.random_angle) then
		phi0 = phi0_
		Cos_phi0 = cosd(phi0)
		Sin_phi0 = sind(phi0)
	    endif

	do 200 y0_ = par(1,yPos),par(2,yPos),par(3,yPos)	      ! y0
	    if (.NOT.random_pos) then
		x0(2) = y0_
	    endif

	do 200 z0_ = par(1,zPos),par(2,zPos),par(3,zPos)	      ! z0
	    if (.NOT.random_pos) then
		x0(3) = z0_
	    endif

c die folgenden parWert(n) werden u.U. in der 'Zufallsschleife' weiter unten 
c abgeaendert. Hier werden sie in jedem Fall fuer Tabellenausgaben, Debug-
c angelegenheiten u.s.w. erst einmal mit den aktuellen Werten der
c entsprechenden Schleifen gefuellt:

	parWert(ener)    = E0_
	parWert(thetAng) = theta0_
	parWert(phiAng)  = phi0_
	parWert(yPos)    = y0_
	parWert(zPos)    = z0_


c falls fruehere Simulation fortgefuehrt wird:
c Berechne diejenige Eventnummer in NTP_read, ab welcher die relevanten
c Simulationsparameter von ACCEL bzw. des 'FoilFiles' mit den gegenwaertigen
c MUTRACK-(Schleifen)-Parametern uebereinstimmen:

	if (.NOT.fromScratch) eventNr = firstEventNr()






c (...)





c 3106
c Einsprunglabel fuer Starts auf der Triggerfolie mit Startwinkelangaben
c im Kammersystem => transformiere Geschwindigkeitsvektor in das Triggersystem:

111	if (alfaTD.NE.0) then
	    help1=  v(1) ! zur Zwischenspeicherung
	    v(1) =  help1*Cos_alfaTD + v(2)*Sin_alfaTD
	    v(2) = -help1*Sin_alfaTD + v(2)*Cos_alfaTD
	endif


c - pruefe, ob das Projektil die Folie trifft:

112     radiusQuad = x(2)*x(2) + x(3)*x(3)
        If (radiusQuad.GT.radiusQuad_Folie) then
	    ! zurueckrechnen in das Kammersystem:
	    if (alfaTD.NE.0) then
		help1= x(1)
		x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - 
     +				  x(2)*Sin_alfaTD + xTD
		x(2) = (help1-d_Folie_Achse)*Sin_alfaTD +
     +				  x(2)*Cos_alfaTD
		help1= v(1)
		v(1) =  help1*Cos_alfaTD - v(2)*Sin_alfaTD
		v(2) =  help1*Sin_alfaTD + v(2)*Cos_alfaTD
	    else
		x(1) =  x(1) + xTD - d_Folie_Achse
	    endif

	    destiny = code_vorbei
	    goto 555
	endif


c So verlangt, schreibe die aktuellen Trajektoriengroessen in das 'FoilFile':
c (hier ist sichergestellt, dass die Folie getroffen worden ist, Wechsel-
c wirkungen mit der Folie wurden aber noch nicht beruecksichtigt).
c HIER WERDEN 'X' UND 'V' IM TRIGGERSYSTEM ABGESPEICHERT!

	if (createFoilFile) then
	    ! falls die Flugzeit bis zur Triggerfolie verschmiert in das
	    ! NTupel aufgenommen werden soll:
	    if (smearS1Fo) then
		call Gauss_Verteilung(sigmaS1Fo,help4)
		S1FoOnly = t + help4
	    endif
	    if (NTP_stop) then
		Ekin=(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))*Energie_Faktor
	    endif
	    call HFNT(NTP_write)
	    NTPalreadyWritten = .true.
	endif


c - Zeitpunkt bei Erreichen der Folie sichern:

113	S1Fo = t
	if (createNTP.AND.Fo_triggered) fill_NTP = .true.
	if (statNeeded(Nr_S1Fo)) call fill_statMem(S1Fo,Nr_S1Fo)



c - Speichern der Koordinaten fuer die Statistiken:

	if (statNeeded(Nr_y_Fo)) then
	    call fill_statMem( x(2),Nr_y_Fo)
	endif
	if (statNeeded(Nr_z_Fo)) then
	    call fill_statMem( x(3),Nr_z_Fo)
	endif
	if (statNeeded(Nr_r_Fo)) then 
	    radius = SQRT(x(2)*x(2) + x(3)*x(3))
	    call fill_statMem(radius,Nr_r_Fo)
	endif


c - speichere Auftreffort des Projektils fuer die Berechnung der Folienelektronen:

	if (generate_FE) then
	    x0FE(1) = x(1)
	    x0FE(2) = x(2)
	    x0FE(3) = x(3)
	endif


c - falls nur bis zur Folie gerechnet werden soll, beende hier die Integration:

	if (upToTDFoilOnly) then
	    ! zurueckrechnen in das Kammersystem:
	    if (alfaTD.NE.0) then
		help1= x(1)
		x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - 
     +				  x(2)*Sin_alfaTD + xTD
		x(2) = (help1-d_Folie_Achse)*Sin_alfaTD +
     +				  x(2)*Cos_alfaTD
		help1= v(1)
		v(1) =  help1*Cos_alfaTD - v(2)*Sin_alfaTD
		v(2) =  help1*Sin_alfaTD + v(2)*Cos_alfaTD
	    else
		x(1) =  x(1) + xTD - d_Folie_Achse
	    endif
	    if (generate_FE) Gebiet = UpToExTD
	    goto 555
	endif


c - pruefe, ob das Projektil auf das Stuetzgitter aufschlaegt:

	if (testOnWireHit .AND. ran(seed).GT.TransTDFoil) then
	    destiny = code_Stuetzgitter
	    ! zurueckrechnen in das Kammersystem:
	    if (alfaTD.NE.0) then
		help1= x(1)
		x(1) = (help1-d_Folie_Achse)*Cos_alfaTD - 
     +				  x(2)*Sin_alfaTD + xTD
		x(2) = (help1-d_Folie_Achse)*Sin_alfaTD +
     +				  x(2)*Cos_alfaTD
		help1= v(1)
		v(1) =  help1*Cos_alfaTD - v(2)*Sin_alfaTD
		v(2) =  help1*Sin_alfaTD + v(2)*Cos_alfaTD
	    else
		x(1) =  x(1) + xTD - d_Folie_Achse
	    endif
	    goto 555
	endif


c - Energieverlust und Winkelaufstreuung:

	if (log_E_Verlust .OR. log_Aufstreu) then
	    if (Debug_) then
		Steps = Steps + 1
		call Output_Debug
	    endif
	    v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3)
	    v_Betrag = SQRT(v_square)
	    Ekin = v_square * Energie_Faktor
	endif

c -- Energieverlust (vorerst nur Gaussverteilt):

	if (log_E_Verlust_defined.OR.log_Meyer_Gauss) then
	    ! Berechne Bahnwinkel relativ zur Folienebene fuer effektive Folien-
	    ! dicke:
	    alfa = atand(SQRT(v(2)*v(2)+v(3)*v(3))/v(1))
	endif

	if (log_E_Verlust) then
	    if (calculate_each) then
		call CALC_ELOSS_ICRU(Ekin,q,m,Thickness,E_Verlust)
	    else
		E_Verlust = mean_E_Verlust
	    endif
	    if (log_E_Verlust_defined) E_Verlust = E_Verlust / cosd(alfa)
	    if (debug_) write (lunLOG,*) ' mittlerer Energieverlust: ',E_Verlust

	    ! Now we have the mean energy loss. We still have to modify it
	    ! according to the distribution of energy losses, i.e.
	    ! E_Verlust  ->  E_Verlust + delta_E_Verlust:

	    delta_E_Verlust = 0.
	    if (log_E_Straggling_sigma) then
400		call Gauss_Verteilung(sigmaE,delta_E_Verlust)
		if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust
		if (E_Verlust+delta_E_Verlust.LT.0.) goto 400
	    elseif (log_E_Straggling_equal) then
410		delta_E_Verlust = lowerE + (upperE - lowerE)*ran(seed)
		if (E_Verlust+delta_E_Verlust.LT.0) goto 410
	    elseif (log_E_Straggling_Lindhard) then
		! Streuung in Abhaengigkeit von mittlerer Energie in Folie:
		call E_Straggling_Lindhard(Ekin-0.5*E_Verlust,m,sigmaE)
420		call Gauss_Verteilung(sigmaE,delta_E_Verlust)
		if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust
		if (E_Verlust+delta_E_Verlust.LT.0.) goto 420
	    elseif (log_E_Straggling_Yang) then
		! Streuung in Abhaengigkeit von mittlerer Energie in Folie!
		call E_Straggling_Yang(Ekin-0.5*E_Verlust,m,sigmaE)
430		call Gauss_Verteilung(sigmaE,delta_E_Verlust)
		if (debug_) write (lunLOG,*) ' sigmaE,delta_E_Verlust: ',sigmaE,delta_E_Verlust
		if (E_Verlust+delta_E_Verlust.LT.0.) goto 430
	    endif

	    if (E_Verlust+delta_E_Verlust.GE.Ekin) then
		destiny = code_stopped_in_foil
		goto 555
	    endif
	    E_Verlust = E_Verlust + delta_E_Verlust

	    ! help1 == Reduzierungsfaktor fuer Geschw.Betrag
	    help1 = sqrt( (Ekin - E_Verlust)/Ekin )
	    v(1) = help1 * v(1)
	    v(2) = help1 * v(2)
	    v(3) = help1 * v(3)
	    v_Betrag = help1 * v_Betrag
	    if (debug_) write (lunLOG,*) ' Energieverlust: ',E_Verlust
	endif

c -- Winkelaufstreuung (vorerst nur Gaussverteilt):

	if (log_aufstreu) then
	    if (log_Meyer_F_Function) then
		call throwMeyerAngle(thetaAufstreu)
	    else
		if (log_Meyer_Gauss) then
		    if (log_E_Verlust) Ekin = Ekin - .5 * E_Verlust	    ! mittlere Energie
		    effRedThick = Meyer_Faktor1 * Thickness / cosd(alfa)
		    call g_Functions(g1,g2,effRedThick)
		    sigmaAufstreu = Meyer_Faktor2 / Ekin * (g1 + Meyer_Faktor3*g2)
		    if (debug_) then
			write (lunLOG,*) ' effekt. red. Dicke: ',effRedThick
			write (lunLOG,*) ' Sigma(Streuwinkel): ',sigmaAufstreu
		    endif
		endif

		call Gauss_Verteilung_theta(sigmaAufstreu,thetaAufstreu)
	    endif

	    st0 = sind(thetaAufstreu)
	    ct0 = cosd(thetaAufstreu)
	    phiAufstreu = 360.*ran(seed)

	    v_xy  = SQRT(v(1)*v(1) + v(2)*v(2))	    ! v_xy  stets groesser 0
						    ! wegen v(1)>0

	    help1 = v(1)
	    help2 = v(2)
	    help3 = v_Betrag*st0*cosd(phiAufstreu)/v_xy
	    help4 = st0*sind(phiAufstreu)

	    v(1) = ct0*help1 - help3*help2 - help4*help1*v(3)/v_xy
	    v(2) = ct0*help2 + help3*help1 - help4*help2*v(3)/v_xy
	    v(3) = ct0*v(3)                + help4*v_xy
	    if (debug_) write (lunLOG,*) ' Aufstreuung: theta, phi =',
     +				  thetaAufstreu,phiAufstreu
	endif

	if (Debug_ .AND. (log_E_Verlust .OR. log_Aufstreu)) then
	    call Output_Debug
	endif


c - Neutralisierung in der Folie?

	if (log_neutralize) then
	    if (neutral_fract(q_).EQ.-1.0) then
		v_square = v(1)*v(1) + v(2)*v(2) + v(3)*v(3)
		Ekin = v_square * Energie_Faktor
		call chargeStateYields(Ekin,m,YieldPlus,YieldNeutral)
		YieldNeutral = 100. * YieldNeutral
	    else
		YieldNeutral = neutral_fract(q_)
	    endif
	    if (100.*ran(seed).LE.YieldNeutral) then
		q = 0.
		qInt = 0
		if (debug_) then
		    write (lunLOG,*) ' Teilchen wurde neutralisiert'
		endif
		nNeutral = nNeutral + 1
	    else
		nCharged = nCharged + 1
	    endif
	endif

c:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::


c (...)
c4300
c===============================================================================


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE G_Functions(G1,G2,tau)
c	=================================

c Diese Routine gibt in Abhaengigkeit von der reduzierten Dicke 'tau'
c Funktionswerte fuer g1 und g2 zurueck. g1 und g2 sind dabei die von
c Meyer angegebenen tabellierten Funktionen fuer die Berechnung von Halbwerts-
c breiten von Streuwinkelverteilungen. (L.Meyer, phys.stat.sol. (b) 44, 253
c (1971))

	IMPLICIT NONE

	real tau,g1,g2
	real tau_(26),g1_(26),g2_(26)
	real help

	integer i

	DATA tau_ /0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0,
     +	         2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 9.0,
     +			     10.0, 12.0, 14.0, 16.0, 18.0, 20.0 /

	DATA g1_  /0.050,0.115,0.183,0.245,0.305,0.363,0.419,0.473,0.525,0.575,
     +	         0.689,0.799,0.905,1.010,1.100,1.190,1.370,1.540,1.700,1.850,
     +			     1.990,2.270,2.540,2.800,3.050,3.290 /
	DATA g2_  / 0.00,1.25,0.91,0.79,0.73,0.69,0.65,0.63,0.61,0.59,
     +	          0.56,0.53,0.50,0.47,0.45,0.43,0.40,0.37,0.34,0.32,
     +			      0.30,0.26,0.22,0.18,0.15,0.13 /

	if (tau.LT.tau_(1)) then
	    write(*,*)
	    write(*,*)'SUBROUTINE G_Functions:'
	    write(*,*)'  Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:'
	    write(*,*)'  aktuelles tau ist kleiner als kleinster Tabellenwert:'
	    write(*,*)'  tau     = ',tau
	    write(*,*)'  tau_(1) = ',tau_(1)
	    write(*,*)
	    STOP
	endif

	i = 1

10	i = i + 1
	if (i.EQ.27) then
	    write(*,*)
	    write(*,*)'SUBROUTINE G_Functions:'
	    write(*,*)'  Fehler bei Berechnung der g-Funktionen fuer Winkelaufstreuung:'
	    write(*,*)'  aktuelles tau ist groesser als groesster Tabellenwert:'
	    write(*,*)'  tau      = ',tau
	    write(*,*)'  tau_(26) = ',tau_(26)
	    write(*,*)
	    STOP
	elseif (tau.gt.tau_(i)) then
	    goto 10
	endif


c lineare Interpolation zwischen Tabellenwerten:

	help = (tau-tau_(i-1))/(tau_(i)-tau_(i-1))

	g1 = g1_(i-1) + help*(g1_(i)-g1_(i-1))
	g2 = g2_(i-1) + help*(g2_(i)-g2_(i-1))


	END


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

	options /extend_source

	subroutine Get_F_Function_Meyer(tau,Ekin)
c	=========================================

	implicit none

	real tau
	real Ekin

	real thetaSchlange,thetaSchlangeMax
	real theta,thetaMax,thetaStep
	real f1,f2,F


c------------------------------------
c - Parameter:

	real Z1, Z2	    ! die atomaren Nummern von Projektil und Target
c	real a0		    ! Bohrscher Radius in cm
	real screeningPar   ! Screeningparameter 'a' in cm fuer Teilchen der
			    ! Kernladungszahl Z1=1 in Kohlenstoff (Z2 = 6)
			    ! bei Streichung von Z1 (vgl. Referenz, S. 268)

	real r0Meyer	    ! r0(C) berechnet aus dem screeningParameter 'a'
			    ! und dem ebenfalls bei Meyer angegebenem
			    ! Verhaeltnis a/r0=0.26 (vgl. Referenz, S. 263 oben)
	real eSquare	    ! elektrische Ladung zum Quadrat in keV*cm

	real Pi		    ! die Kreiszahl

c	parameter (a0 = 5.29E-9)
	parameter (Z1 = 1,  Z2 = 6,  ScreeningPar = 2.5764E-9)
	parameter (r0Meyer = 9.909E-9,  eSquare = 1.44E-10)
	parameter (Pi = 3.141592654)

	real Meyer_Faktor3
	real Meyer_Faktor4
	real zzz	    ! 'Hilfsparameter'
	real Meyer_Faktor5

	parameter (Meyer_faktor3 = (screeningPar/r0Meyer) * (screeningPar/r0Meyer))
	parameter (Meyer_faktor4 = screeningPar / (2.*Z1*Z2*eSquare)  * Pi/180.)
	parameter (zzz = screeningPar / (2.*Z1*Z2*eSquare))
	parameter (Meyer_faktor5 = zzz*zzz / (8*Pi*Pi))

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

	integer nBin,nBinMax
	parameter (nBinMax=201)
	real value(0:nBinMax)  /0.,nBinMax*0./
	real area(nBinMax)     /   nBinMax*0./
	real integ(0:nBinMax)  /0.,nBinMax*0./
	common /MeyerTable/ value,area,integ,thetaStep,nBin

	integer i
	real rhelp

        integer   HB_memsize
        parameter(HB_memsize=500000)
        real      memory(HB_memsize)
        COMMON /PAWC/ memory


c nur noch fuer Testzwecke:

	real fValues(203)
	real fValuesFolded(203)

	integer idh
	parameter (idh = 50)

	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
	character filename*20           ! Name der Ausgabe-Dateien
	COMMON /filename/ filename

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

c Festlegen des maximalen Theta-Wertes sowie der Schrittweite:

	if (tau.LT.0.2) then
	    write(*,*) 'Subroutine ''Get_F_Function_Meyer'':'
	    write(*,*) 'Effektive Dicke ist kleiner als 0.2 => kann ich nicht ... => STOP'
	    call exit
	elseif (tau.LE.2.) then
	    ! => Tabelle A
	    thetaSchlangeMax = 4.0
	elseif (tau.LE.8.) then
	    ! => Tabelle B
	    thetaSchlangeMax = 7.0
	elseif (tau.LE.20.) then
	    ! => Tabelle C
	    thetaSchlangeMax = 20.0
	else
	    write(*,*) 'Subroutine ''Get_F_Function_Meyer'':'
	    write(*,*) 'Effektive Dicke ist groesser als 20 => kann ich nicht ... => STOP'
	    call exit
	endif

	thetaMax = thetaSchlangeMax / Meyer_Faktor4 / Ekin
	if (thetaMax.GT.50) then
	    thetaStep = .5
	elseif (thetaMax.GT.25) then
	    thetaStep = .25
	elseif (thetaMax.GT.12.5) then
	    thetaStep = .125
	else
	    thetaStep = .0625
	endif


c Tabelle der F-Werte erstellen:

	nBin = 0
	do theta = thetaStep, thetaMax, thetaStep

	    ! Berechne aus theta das 'reduzierte' thetaSchlange (dabei gleich
	    ! noch von degree bei theta in Radiant bei thetaSchlange umrechnen):

	    thetaSchlange = Meyer_faktor4 * Ekin * theta 

	    ! Auslesen der Tabellenwerte fuer die f-Funktionen:

	    call F_Functions_Meyer(tau,thetaSchlange,f1,f2)
	    if (thetaSchlange.EQ.-1) then
		! wir sind jenseits von thetaSchlangeMax
		goto 10
	    endif

	    ! Berechnen der Streuintensitaet:
	    F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2)

	    nBin = nBin + 1
	    if (nBin.GT.nBinMax) then
		write(*,*) 'nBin > nBinMax  =>  EXIT'
		call exit
	    endif
	    value(nBin) = sind(theta)*F

	    fValues(nBin+1) = F			     ! fuer Testzwecke
	    fValuesFolded(nBin+1) = sind(theta)*F    ! fuer Testzwecke

	enddo


c Berechnen der Flaecheninhalte der einzelnen Kanaele sowie der Integrale:

10	do i = 1, nBin
	    area(i)  = (value(i)+value(i-1))/2. * thetaStep
	    integ(i) = integ(i-1) + area(i)
	enddo


c Normiere totale Flaeche auf 1:

	rHelp = integ(nBin)
	do i = 1, nBin
	    value(i) = value(i) / rHelp
	    area(i)  = area(i)  / rHelp
	    integ(i) = integ(i) / rHelp
	enddo


c vorerst noch: gib Tabelle in Datei und Histogrammfile aus:

	! Berechne die Werte fuer theta=0:

	call F_Functions_Meyer(tau,0.,f1,f2)
	F = Meyer_faktor5 * Ekin*Ekin * (f1 - Meyer_faktor3*f2)
	fValues(1)       = F
	fValuesFolded(1) = 0.

	! Gib die Werte in das Tabellenfile aus:

c	theta = 0.
c	open (10,file=outDir//':'//filename//'.TAB',status='NEW')
c	do i = 1, nBin+1
c	    write(10,*) theta, fValues(i), fValuesFolded(i)
c	    theta = theta + thetaStep
c	enddo	
c	close (10)


	! Buchen und Fuellen der Histogramme:

	call HBOOK1(idh,'F',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.)
	call HPAK(idh,fValues)
	call HRPUT(idh,outDir//':'//filename//'.RZ','N')
	call HDELET(idh)

	call HBOOK1(idh+1,'F*sin([q])',nBin+1,-0.5*thetaStep,(real(nBin)+0.5)*thetaStep,0.)
	call HPAK(idh+1,fValuesFolded)
	call HRPUT(idh+1,outDir//':'//filename//'.RZ','U')
	call HDELET(idh+1)


	END


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

	options /extend_source

	subroutine throwMeyerAngle (theta)
c	==================================

	implicit none

	real lowerbound,y1,y2,f,root,radiant,fraction
	integer bin,nBin
	integer nBinMax
	parameter (nBinMax=201)

	real theta,thetaStep
	real value(0:nBinMax)  /0.,nBinMax*0./
	real area(nBinMax)     /   nBinMax*0./
	real integ(0:nBinMax)  /0.,nBinMax*0./
	common /MeyerTable/ value,area,integ,thetaStep,nBin

	real rhelp

	real random
	integer seed
	common /seed/ seed


c bin: Nummer des Bins, innerhalb dessen das Integral den Wert von 
c random erreicht oder ueberschreitet:

	random = ran(seed)

	bin = 1
	do while (random.GT.integ(bin))
	    bin = bin + 1
	    if (bin.GT.nBin) then
		write(*,*) 'error 1'
		call exit
	    endif
	enddo

	fraction = (random-integ(bin-1)) / (integ(bin)-integ(bin-1))
	y1 = value(bin-1)
	y2 = value(bin)
	f = thetaStep / (y2-y1)
	rHelp = y1*f

	radiant = rHelp*rHelp + fraction*thetaStep*(y1+y2)*f
	root = SQRT(radiant)
	lowerBound = real(bin-1)*thetaStep
	if (f.GT.0) then
	    theta = lowerBound - rHelp + root
	else
	    theta = lowerBound - rHelp - root
	endif


	END


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

	options /extend_source

	subroutine F_Functions_Meyer(tau,thetaSchlange,f1,f2)
c	=====================================================

	implicit none

c Diese Routine gibt in Abhaengigkeit von 'thetaSchlange' und 'tau'
c Funktionswerte fuer f1 und f2 zurueck. f1 und f2 entsprechen dabei den
c bei Meyer angegebenen Funktion gleichen Namens. Die in dieser Routine
c verwendeten Tabellen sind eben dieser Referenz entnommen:
c L.Meyer, phys.stat.sol. (b) 44, 253 (1971)

	real tau,thetaSchlange
	real f1, f2, f1_(2), f2_(2)

	integer column_,column,row

	integer iColumn
	real	weightCol, weightRow

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

c die Tabellendaten der Referenz (Tabellen 2 und 3):

	integer nColumn
	parameter (nColumn = 25)
	real tau_(nColumn) /
     +	  0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0,
     +    3.5, 4.0, 4.5, 5.0, 6.0, 7.0, 8.0, 10., 12., 14., 16., 18., 20. /

	integer nRowA
	parameter (nRowA = 25)
	real thetaSchlangeA(nRowA) /
     +	  .00, .05, .10, .15, .20, .25, .30, .35, .40, .45, .50, .60,
     +    .70, .80, .90, 1.0, 1.2, 1.4, 1.6, 1.8, 2.0, 2.5, 3.0, 3.5, 4.0 /

	integer nRowB
	parameter (nRowB = 24)
	real thetaSchlangeB(nRowB) /
     +    0.0, 0.2, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.4, 1.5, 1.6, 1.8,
     +    2.0, 2.2, 2.4, 2.6, 2.8, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0, 7.0	  /

	integer nRowC
	parameter (nRowC = 24)
	real thetaSchlangeC(nRowC) /
     +    0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0, 6.0,
     +    7.0, 8.0, 9.0, 10., 11., 12., 13., 14., 15., 16., 18., 20.	  /


	real f1_A(9,nRowA) 
     + /1.69E+2,4.55E+1,2.11E+1,1.25E+1,8.48E+0,6.21E+0,4.80E+0,3.86E+0,3.20E+0,
     +  9.82E+1,3.72E+1,1.97E+1,1.20E+1,8.27E+0,6.11E+0,4.74E+0,3.83E+0,3.17E+0,
     +  3.96E+1,2.58E+1,1.65E+1,1.09E+1,7.73E+0,5.82E+0,4.58E+0,3.72E+0,3.10E+0,
     +  1.76E+1,1.58E+1,1.27E+1,9.26E+0,6.93E+0,5.38E+0,4.31E+0,3.55E+0,2.99E+0,
     +  8.62E+0,1.01E+1,9.45E+0,7.58E+0,6.02E+0,4.85E+0,3.98E+0,3.33E+0,2.84E+0,
     +  4.65E+0,6.55E+0,6.91E+0,6.06E+0,5.11E+0,4.28E+0,3.62E+0,3.08E+0,2.66E+0,
     +  2.74E+0,4.45E+0,5.03E+0,4.78E+0,4.27E+0,3.72E+0,3.23E+0,2.82E+0,2.47E+0,
     +  1.77E+0,3.02E+0,3.71E+0,3.76E+0,3.53E+0,3.20E+0,2.86E+0,2.55E+0,2.27E+0,
     +  1.22E+0,2.19E+0,2.78E+0,2.96E+0,2.91E+0,2.73E+0,2.51E+0,2.28E+0,2.07E+0,
     +  8.82E-1,1.59E+0,2.12E+0,2.35E+0,2.39E+0,2.32E+0,2.19E+0,2.03E+0,1.87E+0,
     +  6.55E-1,1.20E+0,1.64E+0,1.88E+0,1.97E+0,1.96E+0,1.90E+0,1.79E+0,1.68E+0,
     +  3.80E-1,7.15E-1,1.01E+0,1.22E+0,1.35E+0,1.40E+0,1.41E+0,1.39E+0,1.34E+0,
     +  2.26E-1,4.45E-1,6.44E-1,8.08E-1,9.28E-1,1.01E+0,1.05E+0,1.06E+0,1.05E+0,
     +  1.39E-1,2.80E-1,4.21E-1,5.45E-1,6.46E-1,7.22E-1,7.75E-1,8.07E-1,8.21E-1,
     +  8.22E-2,1.76E-1,2.78E-1,3.71E-1,4.53E-1,5.21E-1,5.74E-1,6.12E-1,6.37E-1,
     +  5.04E-2,1.11E-1,1.86E-1,2.57E-1,3.22E-1,3.79E-1,4.27E-1,4.65E-1,4.94E-1,
     +  2.51E-2,5.60E-2,9.24E-2,1.31E-1,1.69E-1,2.02E-1,2.40E-1,2.71E-1,2.97E-1,
     +  1.52E-2,3.20E-2,5.08E-2,7.23E-2,9.51E-2,1.18E-1,1.41E-1,1.63E-1,1.83E-1,
     +  1.03E-2,2.05E-2,3.22E-2,4.55E-2,6.01E-2,7.53E-2,9.02E-2,1.05E-1,1.19E-1,
     +  8.80E-3,1.48E-2,2.25E-2,3.13E-2,4.01E-2,5.03E-2,6.01E-2,7.01E-2,8.01E-2,
     +  6.10E-3,1.15E-2,1.71E-2,2.28E-2,2.89E-2,3.52E-2,4.18E-2,4.86E-2,5.55E-2,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,1.71E-2,1.98E-2,2.28E-2,2.58E-2,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,8.90E-3,1.02E-2,1.16E-2,1.31E-2,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,4.90E-3,5.70E-3,6.40E-3,7.20E-3,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,2.90E-3,3.40E-3,3.90E-3,4.30E-3/

	real f1_B(9,nRowB)
     + /2.71E+0,1.92E+0,1.46E+0,1.16E+0,9.52E-1,8.03E-1,6.90E-1,5.32E-1,4.28E-1,
     +  2.45E+0,1.79E+0,1.39E+0,1.12E+0,9.23E-1,7.82E-1,6.75E-1,5.23E-1,4.23E-1,
     +  1.87E+0,1.48E+0,1.20E+0,9.96E-1,8.42E-1,7.24E-1,6.32E-1,4.98E-1,4.07E-1,
     +  1.56E+0,1.30E+0,1.09E+0,9.19E-1,7.89E-1,6.86E-1,6.03E-1,4.80E-1,3.95E-1,
     +  1.28E+0,1.11E+0,9.62E-1,8.33E-1,7.27E-1,6.40E-1,5.69E-1,4.59E-1,3.81E-1,
     +  8.23E-1,7.90E-1,7.29E-1,6.64E-1,6.01E-1,5.44E-1,4.94E-1,4.12E-1,3.49E-1,
     +  5.14E-1,5.36E-1,5.29E-1,5.07E-1,4.78E-1,4.47E-1,4.16E-1,3.60E-1,3.13E-1,
     +  3.19E-1,3.58E-1,3.76E-1,3.78E-1,3.70E-1,3.57E-1,3.45E-1,3.08E-1,2.76E-1,
     +  2.02E-1,2.40E-1,2.64E-1,2.77E-1,2.82E-1,2.80E-1,2.65E-1,2.59E-1,2.39E-1,
     +  1.67E-1,1.96E-1,2.20E-1,2.36E-1,2.44E-1,2.47E-1,2.45E-1,2.35E-1,2.21E-1,
     +  1.33E-1,1.61E-1,1.85E-1,2.02E-1,2.12E-1,2.18E-1,2.18E-1,2.14E-1,2.03E-1,
     +  8.99E-2,1.12E-1,1.32E-1,1.48E-1,1.59E-1,1.67E-1,1.68E-1,1.75E-1,1.72E-1,
     +  6.24E-2,7.94E-2,9.50E-2,1.09E-1,1.20E-1,1.29E-1,1.35E-1,1.42E-1,1.43E-1,
     +  4.55E-2,5.74E-2,6.98E-2,8.11E-2,9.09E-2,9.92E-2,1.06E-1,1.15E-1,1.19E-1,
     +  3.35E-2,4.22E-2,5.19E-2,6.11E-2,6.95E-2,7.69E-2,8.33E-2,9.28E-2,9.85E-2,
     +  2.50E-2,3.16E-2,3.92E-2,4.66E-2,5.35E-2,6.00E-2,6.57E-2,7.49E-2,8.13E-2,
     +  1.90E-2,2.40E-2,2.99E-2,3.58E-2,4.16E-2,4.70E-2,5.20E-2,6.05E-2,6.70E-2,
     +  1.47E-2,1.86E-2,2.32E-2,2.79E-2,3.25E-2,3.70E-2,4.12E-2,4.89E-2,5.51E-2,
     +  8.10E-3,1.04E-2,1.30E-2,1.57E-2,1.84E-2,2.12E-2,2.40E-2,2.93E-2,3.42E-2,
     +  4.80E-3,6.20E-3,7.70E-3,9.30E-3,1.09E-2,1.26E-2,1.44E-2,1.79E-2,2.14E-2,
     +  2.80E-3,3.80E-3,4.70E-3,5.70E-3,6.70E-3,7.50E-3,8.90E-3,1.13E-2,1.36E-2,
     +  1.70E-3,2.30E-3,2.90E-3,3.60E-3,4.20E-3,4.90E-3,5.60E-3,7.20E-3,8.80E-3,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,2.00E-3,2.80E-3,3.50E-3,
     +  0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,0.00   ,8.80E-4,1.20E-3,1.60E-3/

	real f1_C(7,nRowC)
     + /3.65E-1,2.62E-1,2.05E-1,1.67E-1,1.41E-1,1.21E-1,1.05E-1,
     +  3.33E-1,2.50E-1,1.95E-1,1.61E-1,1.36E-1,1.18E-1,1.03E-1,
     +  2.75E-1,2.18E-1,1.76E-1,1.48E-1,1.27E-1,1.11E-1,9.80E-2,
     +  2.04E-1,1.75E-1,1.50E-1,1.29E-1,1.13E-1,1.01E-1,9.00E-2,
     +  1.41E-1,1.31E-1,1.19E-1,1.08E-1,9.71E-2,8.88E-2,8.01E-2,
     +  9.32E-2,9.42E-2,9.10E-2,8.75E-2,8.00E-2,7.44E-2,6.91E-2,
     +  5.98E-2,6.52E-2,6.72E-2,6.62E-2,6.40E-2,6.12E-2,5.82E-2,
     +  3.83E-2,4.45E-2,4.80E-2,4.96E-2,4.98E-2,4.90E-2,4.77E-2,
     +  2.46E-2,3.01E-2,3.40E-2,3.65E-2,3.79E-2,3.84E-2,3.83E-2,
     +  1.59E-2,2.03E-2,2.39E-2,2.66E-2,2.85E-2,2.97E-2,3.04E-2,
     +  1.04E-2,1.37E-2,1.66E-2,1.92E-2,2.12E-2,2.27E-2,2.37E-2,
     +  4.39E-3,6.26E-3,8.26E-3,9.96E-3,1.15E-2,1.29E-2,1.41E-2,
     +  2.06E-3,3.02E-3,4.24E-3,5.28E-3,6.32E-3,7.32E-3,8.26E-3,
     +  1.21E-3,1.69E-3,2.24E-3,2.85E-3,3.50E-3,4.16E-3,4.82E-3,
     +  8.50E-4,1.10E-3,1.38E-3,1.65E-3,2.03E-3,2.45E-3,2.88E-3,
     +  5.90E-4,7.40E-4,8.50E-4,9.90E-4,1.23E-3,1.49E-3,1.71E-3,
     +  3.90E-4,4.60E-4,5.20E-4,6.30E-4,7.65E-4,9.65E-4,1.12E-3,
     +  2.40E-4,2.70E-4,3.10E-4,3.98E-4,4.97E-4,6.03E-4,7.18E-4,
     +  1.50E-4,1.70E-4,2.15E-4,2.70E-4,3.35E-4,4.35E-4,5.00E-4,
     +  1.00E-4,1.20E-4,1.46E-4,1.90E-4,2.40E-4,2.88E-4,3.43E-4,
     +  0.00   ,0.00   ,1.04E-4,1.41E-4,1.80E-4,2.10E-4,2.50E-4,
     +  0.00   ,0.00   ,8.20E-5,1.06E-4,1.38E-4,1.58E-4,1.85E-4,
     +  0.00   ,0.00   ,5.40E-5,7.00E-5,8.60E-5,1.03E-4,1.20E-4,
     +  0.00   ,0.00   ,4.20E-5,5.40E-5,6.50E-5,7.70E-5,8.80E-5/

	real f2_A(9,nRowA)
     + / 3.52E+3, 3.27E+2, 9.08E+1, 3.85E+1, 2.00E+1, 1.18E+1, 7.55E+0, 5.16E+0, 3.71E+0,
     +   2.58E+2, 1.63E+2, 7.30E+1, 3.42E+1, 1.85E+1, 1.11E+1, 7.18E+0, 4.96E+0, 3.59E+0,
     +  -1.12E+2, 4.84E+0, 3.56E+1, 2.34E+1, 1.45E+1, 9.33E+0, 6.37E+0, 4.51E+0, 3.32E+0,
     +  -5.60E+1,-1.12E+1, 9.87E+0, 1.24E+1, 9.59E+0, 7.01E+0, 5.16E+0, 3.83E+0, 2.91E+0,
     +  -2.13E+1,-1.22E+1,-2.23E+0, 3.88E+0, 5.15E+0, 4.65E+0, 3.87E+0, 3.12E+0, 2.45E+0,
     +  -8.25E+0,-9.58E+0,-5.59E+0,-1.40E+0, 1.76E+0, 2.71E+0, 2.71E+0, 2.35E+0, 1.95E+0,
     +  -3.22E+0,-6.12E+0,-5.28E+0,-2.87E+0,-1.92E-1, 1.32E+0, 1.69E+0, 1.74E+0, 1.48E+0,
     +  -1.11E+0,-3.40E+0,-4.12E+0,-3.08E+0,-6.30E-1, 3.60E-1, 9.20E-1, 1.03E+0, 1.04E+0,
     +  -2.27E-1,-2.00E+0,-2.93E+0,-2.69E+0,-1.48E+0,-3.14E-1, 2.69E-1, 5.28E-1, 6.09E-1,
     +   1.54E-1,-1.09E+0,-2.10E+0,-2.15E+0,-1.47E+0,-6.77E-1,-1.80E-1, 1.08E-1, 2.70E-1,
     +   3.28E-1,-6.30E-1,-1.50E+0,-1.68E+0,-1.34E+0,-8.43E-1,-4.60E-1,-1.85E-1,-4.67E-3,
     +   3.32E-1,-2.06E-1,-7.32E-1,-9.90E-1,-9.42E-1,-8.20E-1,-6.06E-1,-4.51E-1,-3.01E-1,
     +   2.72E-1,-3.34E-2,-3.49E-1,-5.65E-1,-6.03E-1,-5.79E-1,-5.05E-1,-4.31E-1,-3.45E-1,
     +   2.02E-1, 2.80E-2,-1.54E-1,-3.00E-1,-3.59E-1,-3.76E-1,-4.60E-1,-3.40E-1,-3.08E-1,
     +   1.38E-1, 4.84E-2,-5.56E-2,-1.44E-1,-2.04E-1,-2.39E-1,-2.54E-1,-2.49E-1,-2.48E-1,
     +   9.47E-2, 4.86E-2,-1.08E-2,-6.44E-2,-1.02E-1,-1.34E-1,-1.62E-1,-1.79E-1,-1.87E-1,
     +   5.33E-2, 3.71E-2, 1.85E-2, 1.63E-3,-1.69E-2,-3.69E-2,-5.66E-2,-7.78E-2,-9.33E-2,
     +   3.38E-2, 2.40E-2, 1.62E-2, 9.90E-3, 3.76E-3,-4.93E-3,-1.66E-2,-3.05E-2,-4.22E-2,
     +   2.12E-2, 1.56E-2, 1.05E-2, 7.80E-3, 7.92E-3, 6.30E-3, 3.20E-4,-8.50E-3,-1.66E-2,
     +   1.40E-2, 9.20E-3, 5.30E-3, 4.70E-3, 6.31E-3, 8.40E-3, 5.30E-3, 8.80E-4,-3.30E-3,
     +   9.20E-3, 4.70E-3, 1.70E-3, 2.60E-3, 4.49E-3, 6.60E-3, 6.00E-3, 4.70E-3, 2.80E-3,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   /

	real f2_B(9,nRowB)
     + / 2.75E+0, 1.94E+0, 9.13E-1, 6.06E-1, 4.26E-1, 3.14E-1, 2.40E-1, 1.51E-1, 1.03E-1,
     +   1.94E+0, 1.16E+0, 7.56E-1, 5.26E-1, 3.81E-1, 2.87E-1, 2.23E-1, 1.43E-1, 9.78E-2,
     +   5.85E-1, 5.04E-1, 4.10E-1, 3.30E-1, 2.69E-1, 2.17E-1, 1.78E-1, 1.22E-1, 8.71E-2,
     +   7.83E-2, 2.00E-1, 2.35E-1, 2.19E-1, 1.97E-1, 1.73E-1, 1.48E-1, 1.08E-1, 7.93E-2,
     +  -1.82E-1, 1.56E-2, 1.04E-1, 1.36E-1, 1.38E-1, 1.31E-1, 1.19E-1, 9.46E-2, 7.19E-2,
     +  -2.71E-1,-1.66E-1,-7.29E-2,-4.74E-3, 3.60E-2, 5.50E-2, 6.28E-2, 5.98E-2, 5.09E-2,
     +  -1.87E-1,-1.58E-1,-1.09E-1,-5.80E-2,-2.03E-2, 2.48E-3, 1.99E-2, 3.36E-2, 3.27E-2,
     +  -1.01E-1,-1.05E-1,-8.95E-2,-6.63E-2,-3.93E-2,-2.38E-2,-9.22E-3, 8.47E-3, 1.52E-2,
     +  -5.19E-2,-6.47E-2,-6.51E-2,-5.62E-2,-4.51E-2,-3.49E-2,-2.45E-2,-8.19E-3, 2.05E-3,
     +  -3.68E-2,-4.89E-2,-5.36E-2,-5.06E-2,-4.27E-2,-3.65E-2,-2.80E-2,-1.33E-2,-3.47E-3,
     +  -2.33E-2,-3.69E-2,-4.41E-2,-4.38E-2,-3.97E-2,-3.50E-2,-2.88E-2,-1.60E-2,-6.68E-3,
     +  -8.76E-3,-2.07E-2,-2.90E-2,-3.17E-2,-3.09E-2,-2.92E-2,-2.63E-2,-1.79E-2,-1.03E-2,
     +  -1.20E-3,-1.11E-2,-1.90E-2,-2.20E-2,-2.32E-2,-2.24E-2,-2.10E-2,-1.66E-2,-1.11E-2,
     +   1.72E-3,-4.82E-3,-1.02E-2,-1.42E-2,-1.65E-2,-1.66E-2,-1.60E-2,-1.39E-2,-1.09E-2,
     +   2.68E-3,-1.18E-3,-5.19E-3,-8.30E-5,-1.01E-2,-1.14E-2,-1.16E-2,-1.16E-2,-9.99E-3,
     +   2.81E-3, 8.21E-4,-1.96E-3,-3.99E-3,-5.89E-3,-7.13E-3,-8.15E-3,-9.05E-3,-8.60E-3,
     +   2.61E-3, 1.35E-3,-2.99E-4,-1.79E-3,-3.12E-3,-4.44E-3,-5.61E-3,-7.01E-3,-7.27E-3,
     +   2.06E-3, 1.45E-3, 4.64E-4,-5.97E-4,-1.71E-3,-2.79E-3,-3.84E-3,-5.29E-3,-5.90E-3,
     +   1.07E-3, 9.39E-4, 8.22E-4, 3.58E-4,-1.15E-4,-6.60E-4,-1.18E-3,-2.15E-3,-2.88E-3,
     +   4.97E-4, 5.46E-4, 6.15E-4, 5.56E-4, 3.14E-4, 9.80E-5,-1.30E-4,-5.98E-4,-1.07E-4,
     +   1.85E-4, 3.11E-4, 4.25E-4, 4.08E-4, 3.63E-4, 3.04E-4, 2.24E-4, 2.80E-5,-2.10E-4,
     +   4.80E-5, 1.48E-4, 2.44E-4, 2.80E-4, 3.01E-4, 3.11E-4, 3.13E-4, 2.40E-4, 1.10E-4,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 1.39E-4, 1.80E-4, 1.80E-4,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 4.38E-5, 7.30E-5, 8.40E-5/

	real f2_C(7,nRowC)
     + / 7.36E-2, 4.21E-2, 2.69E-2, 1.83E-2, 1.34E-2, 1.01E-2, 7.88E-3,
     +   5.79E-2, 3.61E-2, 2.34E-2, 1.64E-2, 1.21E-2, 9.26E-3, 7.28E-3,
     +   2.94E-2, 2.17E-2, 1.60E-2, 1.23E-2, 9.49E-3, 7.45E-3, 5.95E-3,
     +   2.30E-3, 7.07E-3, 7.76E-3, 7.02E-3, 6.13E-3, 5.17E-3, 4.34E-3,
     +  -7.50E-3,-2.00E-3, 9.93E-4, 2.36E-3, 2.82E-3, 2.86E-3, 2.72E-3,
     +  -8.27E-3,-5.37E-3,-2.58E-3,-7.96E-4, 3.75E-4, 9.71E-4, 1.28E-3,
     +  -5.79E-3,-5.12E-3,-3.86E-3,-2.46E-3,-1.20E-3,-3.74E-4, 1.74E-4,
     +  -3.26E-3,-3.43E-3,-3.26E-3,-2.68E-3,-1.84E-3,-1.12E-3,-4.54E-4,
     +  -1.46E-3,-1.49E-3,-2.20E-3,-2.18E-3,-1.85E-3,-1.40E-3,-8.15E-4,
     +  -4.29E-4,-9.44E-4,-1.29E-3,-1.50E-3,-1.51E-3,-1.36E-3,-9.57E-4,
     +  -3.30E-5,-3.66E-4,-6.78E-4,-9.38E-4,-1.09E-3,-1.09E-3,-9.56E-4,
     +   1.50E-4, 3.10E-5,-1.38E-4,-3.06E-4,-4.67E-4,-5.48E-4,-6.08E-4,
     +   1.00E-4, 8.50E-5, 2.30E-5,-6.60E-5,-1.58E-4,-2.40E-4,-3.05E-4,
     +   5.40E-5, 6.50E-5, 4.90E-5, 1.20E-5,-3.60E-5,-8.90E-5,-1.31E-4,
     +   2.90E-5, 4.30E-5, 4.40E-5, 2.90E-5, 5.10E-6,-2.20E-5,-4.80E-5,
     +   1.40E-5, 2.40E-5, 2.80E-5, 2.60E-5, 1.90E-5, 7.50E-6,-1.10E-5,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   ,
     +   0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   , 0.00   /


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

c Bestimme, welche Reihen der Tabellen fuer Interpolation benoetigt werden:

	if (tau.LT.tau_(1)) then
	    write(*,*) 'tau is less than the lowest tabulated value:'
	    write(*,*) 'tau = ',tau
	    write(*,*) 'minimum = ',tau_(1)
	    call exit
	elseif (tau.GT.tau_(nColumn)) then
	    write(*,*) 'tau is greater than the highest tabulated value:'
	    write(*,*) 'tau = ',tau
	    write(*,*) 'maximum = ',tau_(nColumn)
	    call exit
	endif

	column_ = 2
	do while (tau.GT.tau_(column_))
	    column_ = column_ + 1
	enddo
	! Das Gewicht der Reihe zu groesserem Tau:
	weightCol = (tau-tau_(column_-1)) / (tau_(column_)-tau_(column_-1))


c Besorge fuer gegebenes 'thetaSchlange' die interpolierten f1- und f2 -Werte
c der beiden relevanten Reihen:
c iColumn = 1 => Reihe mit hoeherem Index
c iColumn = 2 => Reihe mit kleinerem Index


	iColumn = 1


5	continue

	if (column_.LE.9) then	     ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
				     ! Werte aus 1. Tabelle: 0.2 <= tau <= 1.8

	    column = column_

	    if (thetaSchlange.LT.thetaSchlangeA(1)) then
		write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:'
		write(*,*) 'thetaSchlange = ',thetaSchlange
		write(*,*) 'minimum       = ',thetaSchlangeA(1)
		call exit
	    elseif (thetaSchlange.GT.thetaSchlangeA(nRowA)) then
c		write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:'
c		write(*,*) 'thetaSchlange = ',thetaSchlange
c		write(*,*) 'maximum = ',thetaSchlangeA(nRowA)
c		call exit
		thetaSchlange = -1.
		RETURN
	    endif

	    row = 2
	    do while (thetaSchlange.GT.thetaSchlangeA(row))
		row = row + 1
	    enddo
	    ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange:
	    weightRow = (thetaSchlange-thetaSchlangeA(row-1)) /
     +				(thetaSchlangeA(row)-thetaSchlangeA(row-1))

	    f1_(iColumn) = (1.-weightRow) * f1_A(column,row-1) +
     +			       weightRow  * f1_A(column,row)
	    f2_(iColumn) = (1.-weightRow) * f2_A(column,row-1) +
     +			       weightRow  * f2_A(column,row)


	elseif (column_.LE.18) then  ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
				     ! Werte aus 2. Tabelle: 2.0 <= tau <= 7.0

	    column = column_ - 9

	    if (thetaSchlange.LT.thetaSchlangeB(1)) then
		write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:'
		write(*,*) 'thetaSchlange = ',thetaSchlange
		write(*,*) 'minimum       = ',thetaSchlangeB(1)
		call exit
	    elseif (thetaSchlange.GT.thetaSchlangeB(nRowB)) then
c		write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:'
c		write(*,*) 'thetaSchlange = ',thetaSchlange
c		write(*,*) 'maximum = ',thetaSchlangeB(nRowB)
c		call exit
		thetaSchlange = -1.
		RETURN
	    endif

	    row = 2
	    do while (thetaSchlange.GT.thetaSchlangeB(row))
		row = row + 1
	    enddo
	    ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange:
	    weightRow = (thetaSchlange-thetaSchlangeB(row-1)) /
     +				(thetaSchlangeB(row)-thetaSchlangeB(row-1))

	    f1_(iColumn) = (1.-weightRow) * f1_B(column,row-1) +
     +			       weightRow  * f1_B(column,row)
	    f2_(iColumn) = (1.-weightRow) * f2_B(column,row-1) +
     +			       weightRow  * f2_B(column,row)


	else			     ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
				     ! Werte aus 3. Tabelle: 8.0 <= tau <= 20.

	    column = column_ - 18

	    if (thetaSchlange.LT.thetaSchlangeC(1)) then
		write(*,*) 'thetaSchlange is less than the lowest tabulated value in table 1:'
		write(*,*) 'thetaSchlange = ',thetaSchlange
		write(*,*) 'minimum       = ',thetaSchlangeC(1)
		call exit
	    elseif (thetaSchlange.GT.thetaSchlangeC(nRowC)) then
c		write(*,*) 'thetaSchlange is greater than the highest tabulated value in table 1:'
c		write(*,*) 'thetaSchlange = ',thetaSchlange
c		write(*,*) 'maximum = ',thetaSchlangeC(nRowC)
c		call exit
		thetaSchlange = -1.
		RETURN
	    endif

	    row = 2
	    do while (thetaSchlange.GT.thetaSchlangeC(row))
		row = row + 1
	    enddo
	    ! Gewicht des Tabellenwertes zu groesseren ThetaSchlange:
	    weightRow = (thetaSchlange-thetaSchlangeC(row-1)) /
     +				(thetaSchlangeC(row)-thetaSchlangeC(row-1))

	    f1_(iColumn) = (1.-weightRow) * f1_C(column,row-1) +
     +			       weightRow  * f1_C(column,row)
	    f2_(iColumn) = (1.-weightRow) * f2_C(column,row-1) +
     +			       weightRow  * f2_C(column,row)


	endif				    ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


	if (iColumn.EQ.1) then
	    column_ = column_ - 1
	    iColumn = 2
	    goto 5
	endif

	f1 = weightCol*f1_(1) + (1.-weightCol)*f1_(2)
	f2 = weightCol*f2_(1) + (1.-weightCol)*f2_(2)


	END


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

