
	OPTIONS /EXTEND_SOURCE

	SUBROUTINE INITIALIZE_OUTPUT
c	============================

	IMPLICIT  NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'

	integer   i, l, k, iostat, zaehler /0/, par_
	logical	  flag /.false./
	integer   fileNr
	integer   fileNrReal /0/, fileNrTest /9900/ ! laufende Nummern der
					            !     Ausgabe-files

	character antwort*5,zeile*80

	character*80 varNames,loopZeile,parValues
	COMMON /zeilen/ varNames,loopZeile,parValues

	character*80 strichU,strich1,strich2
	parameter(strichU = '________________________________________'//
     +			    '________________________________________',
     +		  strich1 = '----------------------------------------'//
     +			    '----------------------------------------',
     +		  strich2 = '========================================'//
     +			    '========================================')

	integer    DimZeilenVek
	parameter (DimZeilenVek  = 15)
	integer	   PHYSICA_ZeilenVektor(DimZeilenVek)

	integer	   NumHeaderLines,NumMarkedLines,lineNrArtList

	integer	   statDefsPerRec
	parameter (statDefsPerRec = Int((4*LwPerRec)/(LengthStatName+4)) )


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

c falls Bildschirmausgabe verlangt ist, erstmal etwas Abstand schaffen:

	write(*,*)
	if (n_outWhere.GE.2) then
	    do k = 1, 5
		write(*,*)
	    enddo
	endif

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

	if (.NOT.gotFileNr) then

c den Namen der Ausgabe-files definieren:

	    if (LogFile.OR.smallLogFile.OR.input_list) then
		open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir,
     +			  status='OLD',iostat=iostat)
		if (iostat.EQ.0) then
		    read(lunREAD,*) fileNrReal,fileNrTest! die aktuelle Dateinummer einlesen
		    close(lunREAD)
		endif
		if (TestRun) then
		    fileNr = fileNrTest + 1
		    if (fileNr.EQ.10000) fileNr = 9900
		else
		    fileNr = fileNrReal + 1
		endif
		write(filename(4:7),'(I4)')fileNr
		if (fileNr.LE.999) write (filename(4:4),'(A1)') '0'
		if (fileNr.LE. 99) write (filename(5:5),'(A1)') '0'
		if (fileNr.LE.  9) write (filename(6:6),'(A1)') '0'

		if (input_list) then
		    ! Ausgabe der (negativen) fileNr in die 'inputListe':
		    open(lunRead,file=inputListName//'.INPUT',status='old',iostat=iostat,
     +					  defaultfile=readDir)
		    if (iostat.NE.0) then
			write(*,*) ' Kann '''//inputListName//'.INPUT'' nicht oeffnen'
			write(*,*)
			call exit
		    endif
		    do k = 1,ListLength
			read(lunRead,*)
		    enddo
		    read(lunRead,*) k	! Nummer des aktuell bearbeitete files
		    write(lunRead,*) -fileNr
		    close(lunRead)

		    if (TestRun) then		!
			fileNrTest = fileNrTest+k	! reserviere k Nummern fuer die
		    else				! k noch ausstehenden Eingabe-
			fileNrReal = fileNrReal+k	! files der input_liste!
		    endif
		    open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir,
     +			      status='OLD',iostat=iostat)
		    if (iostat.NE.0) then
			write(*,*) ' ================================================'
			write(*,*) ' create file '//NrDir//':MUTRACK_NR.DAT'
			write(*,*) ' ================================================'
			open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir,
     +				  status='NEW')
		    endif
		    write(lunREAD,*) fileNrReal,fileNrTest
		    write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'//
     +			  ' vergebene Nummer ''nnnn'' fuer die'
		    write(lunREAD,*) 'Ausgabedateien ''MU_nnnn'' des Programms'//
     +			  ' MUTRACK (separat fuer RealRuns'
		    write(lunREAD,*) 'und TestRuns).'
		    close(lunREAD)

		endif

	    else
		fileName = ' '
	    endif

	endif

c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Header zusammen stellen:

	call Make_HeaderFile

c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Header auf Schirm ausgeben und abfragen, ob Einstellungen in Ordnung sind:

	write(*,*) strich2

	NumHeaderLines = 0
	NumMarkedLines = 0
	rewind(lunTMP)
997	read (lunTMP,'(A)',END=998) zeile
	write (*,'(x,A)') zeile

	! gleich noch pruefen, welche Zeilen vom PHYSICA-Macro 'MULOG.PCM'   
	! eingelesen werden sollen:

	if (createPhysTab) then

	    NumHeaderLines = NumHeaderLines + 1	    ! zaehle mit, wie viele
						    ! Headerzeilen es gibt

	    if (zeile(1:10).EQ.'Projektile' .AND. artList_defined) then
		LineNrArtList = NumHeaderLines
	    endif

	    if (.NOT.flag) then
		if (index(zeile,'eps_x').NE.0) then
		    flag = .true.	! damit nicht zufaellig Kommentarzeilen 
					! ausgewaehlt werden
		elseif (zeile(1:10).EQ.'Projektile'
     +		 .OR. index(zeile,'Trigger').NE.0
     +		 .OR. zeile(1:13).EQ.'neutral Fract'
     +		 .OR. zeile(1:5 ).EQ.'Start'
c     +		 .OR. zeile(1:16).EQ.'- Energieverlust'
c     +		 .OR. zeile(1:13).EQ.'- Foliendicke'
     +		 .OR. (zeile(1:2).EQ.'- '.AND.index(zeile,'iMonitor').EQ.0
     +	.AND. index(zeile,'Schnitt').EQ.0 .AND. index(zeile,'- - - -').EQ.0 )
     +		 .OR. index(zeile,'Draht').NE.0
     +		 .OR. index(zeile,'zerfall').NE.0
     +		 .OR. index(zeile,'EALER').NE.0
     +							      ) then
		    if (NumMarkedLines.LT.DimZeilenVek) then
			NumMarkedLines = NumMarkedLines + 1
			PHYSICA_ZeilenVektor(NumMarkedLines) = NumHeaderLines
		    else
			zaehler = zaehler + 1
		    endif

		endif
	    endif
	endif
	goto 997

998	if (zaehler.NE.0) then
	    write(*,*)'DIMENSION VON ''PHYSICA_ZEILENVEKTOR'' IST ZU GERING'
	    write(*,'(x,I1,A)') zaehler,' Zeilen konnten nicht aufgenommen werden'
	endif

	if (.NOT.BATCH_MODE) then
	    write(*,1010)
	    read(*,1011) antwort
1010	    format(T27,'ok?  (<n,a,c> = ABBRUCH) -> ',$)
1011	    format(A5)  ! bis zu vier Leerzeichen vor Buchstaben werden akzeptiert

	    k = 0
1	    k = k+1
	    if (antwort(k:k).eq.' ' .AND. k.LE.4) then
		goto 1
	    elseif (antwort(k:k).eq.'n' .or. antwort(k:k).eq.'N' .or.
     +		    antwort(k:k).eq.'a' .or. antwort(k:k).eq.'A' .or.
     +		    antwort(k:k).eq.'c' .or. antwort(k:k).eq.'C' ) then
		close(lunTMP)
		write(*,'(A)') strich2
		write(*,*)
		STOP
	    endif
	    if (OneLoop) write(*,'(A)') strich2
	endif

	if ((LogFile.OR.smallLogFile) .AND. .NOT.input_list) then
	    if (TestRun) then
		fileNrTest = fileNr
	    else
		fileNrReal = fileNr
	    endif
	    open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir,
     +		      status='OLD',iostat=iostat)
	    if (iostat.NE.0) then
		write(*,*) ' ================================================'
		write(*,*) ' create file '//NrDir//'MUTRACK_NR.DAT'
		write(*,*) ' ================================================'
		open(lunREAD,file='MUTRACK_NR.DAT',defaultfile=NrDir,
     +			  status='NEW')
	    endif
	    write(lunREAD,*) fileNrReal,fileNrTest
	    write(lunREAD,*) 'Diese Datei enthaelt die zuletzt'//
     +		  ' vergebene Nummer ''nnnn'' fuer die'
	    write(lunREAD,*) 'Ausgabedateien ''MU_nnnn'' des Programms'//
     +		  ' MUTRACK (separat fuer RealRuns'
	    write(lunREAD,*) 'und TestRuns).'
	    close(lunREAD)
	endif

c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c falls gewuenscht: Ausgabe-Datei .LOG oeffnen und Header schreiben:

        if (smallLogFile.OR.createTabellen) call Make_VarNames

	if (LogFile .OR. smallLogFile) then
	    open(lun(1),file=filename//'.LOG',
     +	      defaultfile=outDir,
     +	      status='NEW',carriagecontrol='LIST')

	    rewind(lunTMP)
995	    read (lunTMP,'(A)',END=996) zeile
	    write (lun(1),'(A)') zeile
	    goto 995

996	    if (smallLogFile) then
		write(lun(1),*)
		write(lun(1),'(A)') varNames
		write(lun(1),'(A)') strich1
	    endif
	endif


c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c die Ausgabe-files fuer die Tabellen initialisieren:

	if (createTabellen) then
	    do l= 1, stat_Anzahl
		if (createTabelle(l)) then
		    open(lunPHYSICA+l,file=filename//TabExt(l),
     +			  defaultfile=outDir,
     +			  carriagecontrol='LIST',status='NEW')
		    write(lunPHYSICA+l,*)
		    write(lunPHYSICA+l,*)
		    write(lunPHYSICA+l,'(T35,A)') statName(l)
		    write(lunPHYSICA+l,*)
		    write(lunPHYSICA+l,*)
		    write(lunPHYSICA+l,'(A)') strich2

		    rewind(lunTMP)
993		    read (lunTMP,'(A)',END=994) zeile
		    write (lunPHYSICA+l,'(A)') zeile
		    goto 993

994		    write(lunPHYSICA+l,*)
		    write(lunPHYSICA+l,'(A)') varNames
		    write(lunPHYSICA+l,'(A)') '_Nr_________mean____'//
     +	'Varianz_____________von_______bis___________Anzahl______%___'
		    write(lunPHYSICA+l,*)
		endif
	    enddo
	endif


c das temporaere Header file schliessen:

	close(lunTMP)


c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Ausgabefile 'MU_nnnn.PHYSICA' oeffnen und initialisieren:
c ---------------------------------------------------------
c
c Struktur des Headers:
c
c 1. Record: 'VERSION'//VersionsNummer
c
c 2. Record: par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY,StartsProSchleife,
c	     CodeMasse,CodeLadung,LineNrArtList, numHeaderLines,NumMarkedLines,
c	     lengthParName,lengthStatName
c
c Anschliessend eine Auflistung der Nummern derjenigen Zeilen aus dem Header
c von 'MU_nnnn.LOG', welche innerhalb von PHYSICA mittels 'MUPARG' und 'MUPART'
c ausgegeben werden sollen ('PHYSICA_Zeilenvektor'). Die Zeilennummern werden
c hintereinander in ein Record geschrieben. Ist dieses voll, so wird das
c naechste Record begonnen.
c
c Es folgt eine Auflistung der in die Simulation eingehenden Schleifenparameter.
c Jeder Parameter erhaelt ein eigenes Record. In dieses wird die Nummer des
c Parameters, die Anzahl der angenommenen Werte, der Minimalwert, der Maximal-
c wert, die sich daraus ergebende Schrittweite und die Benennung des Parameters
c ausgegeben.
c
c Naechster Punkt ist eine Liste der in das .PHYSICA file aufgenommenen Statisti-
c ken (jeweils Codenummer und Benennung). Es werden jeweils so viele Statistik-
c beschreibungen in ein Record geschrieben wie ganzzahlig hineinpassen.
c
c Zum Schluss folgt die Auflistung der in dem .PHYSICA file enthaltenen 'whats'
c (Auswahl aus 'mean', 'variance', 'minimum', 'maximum' und 'percent'). Hier
c werden nur die jeweiligen Codenummern hintereinander in ein Record geschrie-
c ben.
c
c Die sich hiermit ergebende Gesamtlaenge des Headers summiert sich zu
c
c NrOfInfoLines = 1					     ! <- Version
c		+ 1					     ! <- allg. Groessen
c    		+ int((NumMarkedLines-1)/LwPerRec) + 1	     ! <- 'Zeilenvektor'
c      		+ par_Anzahl				     ! <- Parameter
c      		+ int((stat_Anzahl-1)/statDefsPerRec) + 1    ! <- Statisiken
c      		+ 1					     ! <- 'WhatList'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

	if (createPhysTab) then

	    open(lunPHYSICA,file=fileName//'.PHYSICA',defaultfile=outDir,
     +	    form='unformatted',recordtype='fixed',recl=LwPerRec,status='NEW')

	    write(lunPHYSICA) 'VERSION',version

	    ! Berechne Anzahl der in die Simulation eingehenden Parameter:
	    par_Anzahl_used = 0
	    do i = 1, par_Anzahl
		par_ = reihenfolge(i)
		if (n_par(par_).NE.0) then
		    par_Anzahl_used = par_Anzahl_used + 1
		    parList(par_Anzahl_used) = par_
		endif
	    enddo

	    ! Berechne Anzahl der in das Physica-file ausgegebenen Statistiken:
	    statAnzahlPHY = 0
	    do k = 1, stat_Anzahl
		if (statInPHYSICA(k)) then
		    statAnzahlPHY = statAnzahlPHY + 1
		    statList(statAnzahlPHY) = k
		endif
	    enddo

	    ! Berechne Anzahl der verlangten statistischen Groessen:
	    whatAnzahlPHY = 0
	    do k = 1, what_Anzahl
		if (whatInPHYSICA(k)) then
		    whatAnzahlPHY = whatAnzahlPHY + 1
		    whatList(whatAnzahlPHY) = k
		endif
	    enddo

	    write(lunPHYSICA) par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY,
     +		     n_par(0), mass,charge,LineNrArtList,
     +		     numHeaderLines,NumMarkedLines, lengthParName,lengthStatName

	    ! Schreibe Liste der 'markierten' Zeilen:
	    k = 0
	    do while (k.LT.NumMarkedLines)
		l = min(NumMarkedLines,k+LwPerRec)
		write(lunPHYSICA) (PHYSICA_ZeilenVektor(i), i=k+1,l)
		k = k + LwPerRec
	    enddo

	    ! Schreibe Liste der in die Simulation eingehenden Parameter:
	    do k=1,par_Anzahl_used
		par_ = parList(k)
		write(lunPHYSICA) par_, n_par(par_),
     +		par(1,par_),par(2,par_),par(3,par_),par_text(par_)(1:LengthParName)
	    enddo

	    ! Schreibe Liste der verlangten Statistiken:
	    k = 0
	    do while (k.LT.statAnzahlPHY)
		l = min(StatAnzahlPHY,k+statDefsPerRec)
		write(lunPHYSICA) (statList(i),statName(statList(i)), i=k+1,l)
		k = k + statDefsPerRec
	    enddo

	    ! Schreibe Liste der verlangten statistischen Groessen:
	    write(lunPHYSICA) (whatList(i), i=1,whatAnzahlPHY)

	endif


c Schreiben des .GEO-files:

	if (write_geo) call write_geo_file


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MAKE_HeaderFile
c	==========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'
	INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC'

	integer i,k,par_,pos
	logical	flag

	character datum*9,uhrzeit*8,helpChar*1

        character*40 inputName
        COMMON /inputName/ inputName

	character*80 zeile,strichU,strich1,strich2
	parameter(strichU = '________________________________________'//
     +			    '________________________________________',
     +		  strich1 = '----------------------------------------'//
     +			    '----------------------------------------',
     +		  strich2 = '========================================'//
     +			    '========================================')


c Oeffnen des files zur Zwischenspeicherung der Headerzeilen:

	open (lunTMP,File='HEADER.TMP',form='FORMATTED',defaultfile=TMPDir,
     +	      status='NEW',carriagecontrol ='NONE')
c     +	      status='UNKNOWN',carriagecontrol ='NONE')
c "STATUS='UNKNOWN'" entfernt, um Absturz bei gleichzeitigem Zugriff mehrere
c MUTRACK-Programme auszuschliessen
c     +	      status='SCRATCH',carriagecontrol ='NONE')
c "STATUS='SCRATCH'" entfernt, damit .MESSAGE-Datei von "SUB_LIST.COM" die
c Nummer des zuletzt abgearbeiteten INPUT-Files gelesen werden kann.
   

c I.: allgemeine Settings:
c ------------------------

	call date(datum)
	call time(uhrzeit)

	write(lunTMP,11) filename,version,datum,uhrzeit
11	format(A,T19,'> VERSION 'A' <',T48,'begonnen am ',A,' um ',A)


c Einheiten:
c ----------

	write(lunTMP,'(A)') 'UNITS: Spannung:kV, Winkel:deg, '//
     +	  'Masse:keV/c**2, Ladung:e, Energie:keV, Laenge:mm'
	write(lunTMP,'(A)') '       Zeiten:ns, Geschwindigkeiten:mm/ns'


c Einlesefile fuer Kammmergeometrie:
c ----------------------------------

	write(lunTMP,'(A)') strich1
	write(lunTMP,'(A,A)') 'Geometriefile: ',geo_fileName
	if (xBlende.NE.-1) then
	    write(lunTMP,'(A,F6.1,A,F4.1,A)') 'Blende bei ',xBlende,' (Radius ',
     +						  radius_Blende,' mm)'
	endif


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

	if (random_E0) par_text(ener)(8:10) = '(*)'
	if (random_pos) then
	    par_text(yPos)(8:10) = '(*)'
	    par_text(zPos)(8:10) = '(*)'
	endif
	if (random_angle) then
	    par_text(thetAng)(8:10) = '(*)'
	    par_text(phiAng)(8:10) = '(*)'
	endif

	write(lunTMP,'(A)') strich1

	do par_ = 1, par_Anzahl

	    if (par_.EQ.ener.AND.(ener_offset.OR.pos_offset.OR.angle_offset
     +	             .OR..NOT.(random_E0.AND.random_pos.AND.random_angle)) .OR.
     +	        par_.EQ.alfTgt.AND.
     +		  ( n_par(alfTgt.NE.0).OR.n_par(alfSp.NE.0).OR.n_par(alfTD.NE.0) ) .OR.
     +	        par_.EQ.Thickn.AND.n_par(Thickn).GT.1			   .OR.
     +		par_.EQ.BHelm.AND.(n_par(BHelm).NE.0.OR.n_par(BTD).NE.0  ) ) then
		write(lunTMP,*)
	    endif

	    if (n_par(par_).EQ.0) then
		! unbenutzte Parameter  => keine Ausgabe
	    elseif (par_.EQ.ener .AND. E0InterFromFile) then
		if (n_par(ener).EQ.1) then
		    write(lunTMP,120) par_text(par_),n_par(par_)
		else
		    write(lunTMP,120) par_text(par_),n_par(par_),n_par(par_)
		endif
	    elseif (par_.EQ.Eloss.AND.n_par(Eloss).EQ.1) then
		! genau ein Eloss-Wert  => Ausgabe mit TD-Daten => hier keine Ausgabe
	    elseif (par_.EQ.Thickn.AND.n_par(Thickn).EQ.1) then
		! genau ein Thickn-Wert => Ausgabe mit TD-Daten => hier keine Ausgabe
	    elseif (par_.EQ.charge .AND. artList_defined) then
		! keine Ausgabe
	    else

		if (par_.EQ.UFolie .OR. par_.EQ.UMCP2 .OR. par_.EQ.mass) then
		    ! falls eine dieser Groessen ins Logfile kommt: Leerzeile voraus
		    write(lunTMP,*)
		endif

		if (n_par(par_).EQ.1) then
		    write(zeile,101) par_text(par_),par(1,par_)
		elseif (n_par(par_).EQ.2) then
		    write(zeile,102) par_text(par_),par(1,par_),
     +		      par(2,par_),n_par(par_)
		else
		    write(zeile,103) par_text(par_),par(1,par_),
     +		      par(2,par_),par(3,par_),n_par(par_)
		endif
		write(lunTMP,'(A)') zeile

	    endif
	enddo

101	format(A,2X,F11.3)
102	format(A,' (',F11.3,',',F11.3,')',16X,'(',I5,' Werte)')
103	format(A,' (',F11.3,',',F11.3,',',F11.3,')',T65,'(',I5,
     +' Werte)')
120	format(A,I8,' E0-Intervall',:,'e',T65,'(',I5,' Bereiche)')


c 'ArtList' und neutrale Anteile nach Foliendurchgang:
c ----------------------------------------------------

	if (artList_defined) then
	    write(lunTMP,*)
	    if (n_par(charge).EQ.1.) then
		write(zeile,90) artList
	    else
		write(zeile,90) artList,INT(n_par(charge))
	    endif
	    write(lunTMP,'(A)') Zeile
	endif
90	format('Projektile   :  ',A,:,T65,'(',I5,' Werte)')

	if (log_neutralize) then
	    write(lunTMP,91) (neutral_fract(k),k=1,n_par(charge))
	endif
91	format('neutral Fract:  ',10(:,F5.1,x))

	write(lunTMP,'(A)') strich1


c Zufallsstarts, Schleifen- und Gesamtzahl:
c -----------------------------------------

	write(zeile,104) SchleifenZahl,GesamtZahl
104	format(T30,'Schleifen: ',I5,T53,'=>  total:',T66,I8,
     +	       ' Starts')	
	if (random_E0.OR.random_pos.OR.random_angle) then
	    write(zeile(1:22),105)n_par(0)
	else
	    write(zeile(1:19),'(A)') 'keine Zufallsstarts'
	endif
105	format('Zufallsstarts: ',I7)

	write(lunTMP,'(A)') zeile


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

c - Energie:

	if (random_E0) then

	    if (random_E0_equal) then
		if (E0InterFromFile) then
		    write(zeile, 30) n_par(ener),lowerE0,upperE0
		else
		    write(zeile, 31) lowerE0,upperE0
		endif
30	format('Startenergie : ',I3,' gleichverteilte Bereiche zwischen ',F6.3,' und ',F6.3)
31	format('Startenergie : gleichverteilt zwischen ',F6.3,' und ',F6.3)

	    elseif (random_E0_Gauss) then
		write(zeile, 32) sigmaE0
32	format('Startenergie : gaussverteilt (sigma = ',F6.3,')')

	    endif
	    if (ener_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70)
	    write(lunTMP,'(A)') Zeile
	endif

c - Winkel:

	if (random_angle) then

	    if (random_lambert) then
		write(zeile, 51) StartLambertOrd
51	format('Startwinkel  : lambertverteilt (Ordnung: ',F6.2,')')

            elseif (random_gauss) then
                write(zeile, 52) SigmaWinkel
52      format('Startwinkel  : gaussverteilt (sigma = ',F5.3')')

 	    endif
	    if (angle_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70)
	    write(lunTMP,'(A)') Zeile
	endif

c - Position:

	if (random_pos) then

	    if (random_y0z0_equal) then
		write(zeile, 41) StartBreite,StartHoehe
41	format('Startposition: gleichverteilt auf Viereck mit '
     +	       'dy*dz = ',F5.2,'*',F5.2)

	    elseif (random_r0_equal) then
		write(zeile, 42) StartRadius
42	format('Startposition: gleichverteilt auf Kreis mit '
     +	       'r = ',F5.2)

	    elseif (random_y0z0_Gauss) then
		write(zeile, 43) sigmaPosition,StartBreite,StartHoehe
43	format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ',
     +	       'Viereck mit dy*dz = ',F5.2,'*',F5.2)

	    elseif (random_r0_Gauss) then
		write(zeile, 44) sigmaPosition,StartRadius
44	format('Startposition: gaussverteilt (sigma = 'F5.2,') auf ',
     +	       'Kreis mit r = ',F5.2)

	    endif
	    if (pos_offset) zeile = zeile(1:14)//' OFFSET + '//zeile(16:70)
	    write(lunTMP,'(A)') Zeile
	endif


c Startflaeche:
c -------------

	if (Startflaeche.EQ.-1) then
	    write(zeile,53) Gebiet_Text(Gebiet0)
53	format('Startflaeche : Gebiet = ''',A)
	    pos = 80
	    do while (zeile(pos:pos).NE.':')
		pos = pos - 1
	    enddo
	    write(zeile(pos:pos+14),54) x0(1)
54	format(''', x0 = ',F7.2)
	    write(lunTMP,'(A)') zeile
	elseif (Startflaeche.EQ.1) then
	    write(lunTMP,'(A)') 'Startflaeche : 1. Gitter'
	elseif (Startflaeche.EQ.2) then
	   write(lunTMP,'(A)') 'Startflaeche : TD-Folie (Startwinkel '//       
     +	    'im Kammersystem)'
	elseif (Startflaeche.EQ.3) then
	   write(lunTMP,'(A)') 'Startflaeche : TD-Folie (Startwinkel '//
     +	    'im Triggersystem)'
	else
	    write(lunTMP,'(A)') 'Startflaeche : Moderator'
	endif

	write(lunTMP,'(A)') strich2


c reale und ideale Feldberechnungen:
c ----------------------------------

	if (Use_ACCEL) then
	    i = index(fileName_ACCEL,' ')
	    k = index(accelVersion,' ')
	    if (k.EQ.0) k=9
	    zeile = 'REALER Beschleuniger ('//fileName_ACCEL(1:i-1)//
     + ', ACCEL-Version '//accelVersion(1:k-1)//'), '
	    pos = 40+i+k
	elseif (Gebiet0.LE.upToHeShield) then
	    zeile = 'IDEALER Beschleuniger, '
	    pos = 24
	else
	    pos = 1
	endif


	if (idealMirror) then
	    zeile(pos:pos+14) = 'IDEALER Spiegel'
	    pos = pos + 15
	else
	    zeile(pos:pos+13) = 'REALER Spiegel'
	    pos = pos + 14
	endif

	write(lunTMP,'(A)') zeile

	
	if (Use_ACCEL .AND. mappenNameACCEL.NE.' ') then
	    write(lunTMP,'(A)') 'ACCEL-MAPPE: '//mappenNameAccel
	endif


c 'foilfile':
c -----------

	if (Use_MUTRACK) then
	    i = index(fileName_MUTRACK,' ')
	    k = index(MUTRACKVersion,' ')
	    if (k.EQ.0) k=9
	    zeile = 'Foilfile: '//fileName_MUTRACK(1:i-1)//
     + ' (MUTRACK-Version '//MUTRACKVersion(1:k-1)//')'
	    write(lunTMP,'(A)') zeile
	endif

	if (Use_ACCEL .AND. scaleFactor.NE.1) then
	    write(lunTMP,'(A,F5.2,A)') 'Beschleunigergeometrie durch Skalierung mit Faktor ',scaleFactor,' erhalten'
	endif

c Programmsteuerung:
c ------------------

	if (createFoilFile) then
	    if (gridInFrontOfFoil) then
		write(zeile,111) '(GITTER VOR TRIGGERFOLIE)'
	    else
		write(zeile,111) '(kein Gitter vor Triggerfolie)'
	    endif
	    write(lunTMP,'(A)') zeile
111	format('''FoilFile'' erstellen ',A)
	elseif (upToTDFoilOnly) then
	    write(lunTMP,'(A)') 'Integration NUR BIS TD-FOLIE'
	endif

	if (TestOnWireHit) then
	    zeile = 'Drahttreffer: JA, '
	    pos = 19
	else
	    zeile = 'Drahttreffer: NEIN, '
	    pos = 21
	endif

	if (mu_flag) then
	    if (UseDecay) then
		write(zeile(pos:pos+17),'(A)') 'Myonenzerfall: JA '
		if (.NOT.UseDecay_prevSim) then
		    if (Use_ACCEL  ) write(zeile(pos+18:pos+33),'(A)') '(ACCEL war OHNE)'
		    if (Use_MUTRACK) write(zeile(pos+18:pos+38),'(A)') '(''FoilFile'' war OHNE)'
		endif
	    else
		write(zeile(pos:pos+19),'(A)') 'Myonenzerfall: NEIN '
		if (UseDecay_prevSim) then
		    if (Use_ACCEL  ) write(zeile(pos+20:pos+34),'(A)') '(ACCEL war MIT)'
		    if (Use_MUTRACK) write(zeile(pos+20:pos+39),'(A)') '(''FoilFile'' war MIT)'
		endif
	    endif
	else
	    zeile(pos-2:pos-2) = ' '
	endif

	write(lunTMP,'(A)') zeile

c Triggerdetektor:
c ----------------

	if (.NOT.createFoilFile) then			    ! 1: if ~~~~~~~~~~~~

	if (TriggerInBeam .AND. .NOT.createFoilFile) then
	    if (generate_FE) then
		if (gridInFrontOfFoil) then
		    write(zeile,110) '(GITTER VOR TRIGGERFOLIE, mit FE-Starts, '
		    pos = 63
		else
		    write(zeile,110) '(kein Gitter vor Folie, mit FE-Starts, '
		    pos = 61
		endif
	    else
		if (gridInFrontOfFoil) then
		    write(zeile,110) '(GITTER VOR TRIGGERFOLIE, keine FE-Starts, '
		    pos = 65
		else
		    write(zeile,110) '(kein Gitter vor Folie, keine FE-Starts, '
		    pos = 63
		endif
	    endif
110	format('Trigger im Strahlweg ',A)
	    write(zeile(pos:pos+10),'(A6,F4.1,A)') 'dx5 = ',dx5,')'
	    write(lunTMP,'(A)') zeile
	    if (.NOT.upToTDFoilOnly) then
		if (TestOnWireHit) write(lunTMP,76) 100*TransTDFoil
76	format('- Stuetzgittertransmission: ',F6.2'%')
		if (n_par(Thickn).EQ.1) then
		    write(lunTMP,70) par(1,Thickn)
		endif
70	format('- Foliendicke : ',F6.3,' ug/cm**2')
		! Energieverlust in Folie:
		if (log_E_Verlust) then
		    if (log_E_Verlust_defined) then
			if (n_par(Eloss).EQ.1) then
			    if (log_E_Straggling_sigma) then
				write(zeile, 71) par(1,eloss),sigmaE
			    elseif (log_E_Straggling_equal) then
				write(zeile, 72) par(1,eloss),lowerE,upperE
			    elseif (log_E_Straggling_Lindhard) then
				write(zeile, 73) par(1,eloss),'; Aufstr. gaussf. nach Lindh./Scharff'
			    elseif (log_E_Straggling_Yang) then
				write(zeile, 73) par(1,eloss),'; Aufstr. gaussf. nach Yang'
			    else
				write(zeile, 73) par(1,eloss),' (keine Energieaufstreuung)'
			    endif
			else
			    if (log_E_Straggling_sigma) then
				write(zeile, 81) 'gemaess Schleife',sigmaE
			    elseif (log_E_Straggling_equal) then
				write(zeile, 82) 'gemaess Schleife',lowerE,upperE
			    elseif (log_E_Straggling_Lindhard) then
				write(zeile, 83) 'gemaess Schleife','; Aufstr. gaussf. nach Lindh./Scharff'
			    elseif (log_E_Straggling_Yang) then
				write(zeile, 83) 'gemaess Schleife','; Aufstr. gaussf. nach Yang'
			    else
				write(zeile, 83) 'gemaess Schleife',' (keine Energieaufstreuung)'
			    endif
			endif
			write(lunTMP,'(A)') Zeile
		    elseif (log_E_Verlust_ICRU) then
			if (log_E_Straggling_sigma) then
			    write(zeile, 81) 'gemaess ICRU',sigmaE
			elseif (log_E_Straggling_equal) then
			    write(zeile, 82) 'gemaess ICRU',lowerE,upperE
			elseif (log_E_Straggling_Lindhard) then
			    write(zeile, 83) 'gemaess ICRU','; Aufstr. gaussf. nach Lindh./Scharff'
			elseif (log_E_Straggling_Yang) then
			    write(zeile, 83) 'gemaess ICRU','; Aufstr. gaussf. nach Yang'
			else
			    write(zeile, 83) 'gemaess ICRU',' (keine Energieaufstreuung)'
			endif
			if (calculate_each) write(zeile(70:79),'(A10)') '(jedesmal)' 
			write(lunTMP,'(A)') Zeile
			if (graphitData) then
			    write(lunTMP,'(A)') '  (stopping power data for graphit)'
			    ! THIS ONE WAS EXCLUSIVELY USED IN THE BEGINNING
			else
			    write(lunTMP,'(A)') '  (stopping power data for amorphous carbon)'
			endif
		    endif

		endif

71	format('- Energieverlust: ',F6.3,:'; sigma = ',F6.3)    
72	format('- Energieverlust: ',F6.3,:' + gleichvert. aus ['F6.3','F6.3']')
73	format('- Energieverlust: ',F6.3,:A)
81	format('- Energieverlust: ',A,:'; sigma = ',F6.3)
82	format('- Energieverlust: ',A,:' + gleichvert. aus ['F6.3','F6.3']')
83	format('- Energieverlust: ',A,:A)

		! Aufstreuung in Folie:
		if (log_aufstreu) then
		    if (log_aufstreu_fixed) then
			write(zeile, 75) sigmaAufstreu
			write(lunTMP,'(A)') Zeile
		    elseif (log_Meyer_Gauss) then
			write(lunTMP,'(A)') '- Winkelaufstreuung: gemaess Meyer-Formel mit Gauss-Fkt'
		    elseif (log_Meyer_F_Function) then
			write(lunTMP,'(A)') '- Winkelaufstreuung: gemaess Meyer-Formel mit F-Funktion'
		    endif
		endif
75	format('- Winkelaufstreuung: sigma = ',F6.2)    


	    if (.NOT.(log_E_Verlust.AND.log_aufstreu.AND.log_neutralize)) then
		zeile = '- NICHT:'
		pos = 10
		if (.NOT.log_E_Verlust) then
		   write(zeile(pos:pos+14),'(A)') 'ENERGIEVERLUST,'
		   pos = pos + 15
		endif
		if (.NOT.log_aufstreu) then
		   write(zeile(pos:pos+17),'(A)') 'WINKELAUFSTREUUNG,'
		   pos = pos + 18
		endif
		if (.NOT.log_neutralize) then
		   write(zeile(pos:pos+15),'(A)') 'NEUTRALISIERUNG,'
		   pos = pos + 16
		endif
		pos = pos - 1
		write(zeile(pos:pos),'(A)')' '
		write(lunTMP,'(A)') zeile
	    endif
	endif

	else
	    write(lunTMP,'(A)') 'Trigger aus Strahlweg'
	endif

	endif  ! if (.NOT.createFoilFile) ....		    ! 1: endif ~~~~~~~~~


c Statistiken fuer das Summary:
c -----------------------------

	if (statsInSummary) then
	    zeile = 'Statistiken:'
	    pos = 14
	    do k = 1, stat_Anzahl
		if (statInSummary(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 14
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    do i = 1, LengthStatName 
			helpChar = statName(k)(i:i)
			if (helpChar.NE.' ' .AND. pos.LE.80) then
			    zeile(pos:pos) = helpChar
			    pos = pos+1
			endif
		    enddo
		endif
	    enddo
	    write(lunTMP,'(A)') zeile
	endif


c zu erzeugende Tabellen:
c -----------------------

	if (createTabellen) then
	    zeile = 'Tabellen:'
	    pos = 14
	    do k = 1, stat_Anzahl
		if (createTabelle(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 14
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    do i = 1, LengthStatName 
			helpChar = statName(k)(i:i)
			if (helpChar.NE.' ' .AND. pos.LE.80) then
			    zeile(pos:pos) = helpChar
			    pos = pos+1
			endif
		    enddo
		endif
	    enddo
	    zeile(13:13) = ' '
	    write(lunTMP,'(A)') zeile
	endif


c Statistiken fuer das PHYSICA file:
c ----------------------------------

c	if (createPhysTab) write(lunTMP,'(A)') 'PHYSICA-Tabelle erstellen'
	if (createPhysTab) then
	    zeile = 'PHYSICA-TAB:'
	    pos = 14
	    do k = 1, stat_Anzahl
		if (statInPHYSICA(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 14
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    do i = 1, LengthStatName
			helpChar = statName(k)(i:i)
			if (helpChar.NE.' ' .AND. pos.LE.80) then
			    zeile(pos:pos) = helpChar
			    pos = pos+1
			endif
		    enddo
		endif
	    enddo
	    write(lunTMP,'(A)') zeile

	    zeile = '''what''     :'
	    pos = 14
	    do k = 1, what_Anzahl
		if (whatInPHYSICA(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 14
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    do i = 1, LengthWhatName 
			helpChar = whatName(k)(i:i)
			if (helpChar.NE.' ' .AND. pos.LE.80) then
			    zeile(pos:pos) = helpChar
			    pos = pos+1
			endif
		    enddo
		endif
	    enddo
	    write(lunTMP,'(A)') zeile
	endif


c Im NTupel enthaltene Groessen:
c ------------------------------

	if (createNTP) then
	    zeile = 'NTP erzeugen ('
	    pos = 15
	    if (NTP_S1xM2) then
		write(zeile(pos:pos+5),'(A)') 'S1xM2,'
		pos = pos + 7
	    endif
	    if (NTP_times) then
		write(zeile(pos:pos+5),'(A)') 'times,'
		pos = pos + 7
	    endif
	    if (NTP_FoM2Only) then
		write(zeile(pos:pos+4),'(A)') 'FoM2,'
		pos = pos + 6
	    endif
	    if (NTP_charge) then
		write(zeile(pos:pos+6),'(A)') 'charge,'
		pos = pos + 8
	    endif
	    if (NTP_start) then
		write(zeile(pos:pos+5),'(A)') 'start,'
		pos = pos + 7
	    endif
	    if (NTP_lifetime) then
		write(zeile(pos:pos+8),'(A)') 'lifetime,'
		pos = pos + 10
	    endif
	    if (NTP_40mm) then
		write(zeile(pos:pos+4),'(A)') '40mm,'
		pos = pos + 6
	    endif
	    if (NTP_stop) then
		write(zeile(pos:pos+4),'(A)') 'stop,'
		pos = pos + 6
	    endif
	    if (NTP_Folie) then
		write(zeile(pos:pos+5),'(A)') 'folie,'
		pos = pos + 7
	    endif
	    if (NTP_steps) then
		write(zeile(pos:pos+5),'(A)') 'steps,'
		pos = pos + 7
	    endif
	    zeile(pos-2:pos-2) = ')'
	    write(lunTMP,'(A)') zeile

	    if (Fo_triggered) then
		write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch TD-Folien-Treffer)'
	    elseif (xM2_triggered) then
		write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch Erreichen der MCP2-Ebene)'
	    elseif (M2_triggered) then
		write(lunTMP,'(A)') ' (NTupeleintrag getriggert durch MCP2-Treffer)'
	    else
		write(lunTMP,'(A)') ' (alle Events in NTupel aufnehmen)'
	    endif
	endif

	if (smearS1Fo) write(lunTMP,'(A,F5.2)') 'S1Fo gefaltet mit sigma = ',sigmaS1Fo


c Graphikausgabe:
c ---------------

	if (GRAPHICS) then
	    if (generate_FE) then
		if (plot_FE) then
		   zeile = 'Graphikausgabe incl. FE-Trajektorien'
		   pos = 38
		else
		   zeile = 'Graphikausgabe ohne FE-Trajektorien'
		   pos = 37
		endif
	    else
		zeile = 'Graphikausgabe'
		pos = 16
	    endif
	    if (n_postSkript.EQ.0) then
	       write(zeile(pos:pos+18),'(A)')'(keine Postskripts)'
	    elseif (n_postSkript.EQ.1) then
	       write(zeile(pos:pos+24),'(A)')'(Postskripts auf Anfrage)'
	    elseif (n_postSkript.EQ.2) then
	       write(zeile(pos:pos+17),'(A)')'(alle Postskripts)'
	    endif
	    write(lunTMP,'(A)') zeile
	    if (vertical) then
		write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor,
     +		  graphics_Anzahl,' Trajektorien pro Schleife, vertical view'
	    else
		write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor,
     +		  graphics_Anzahl,' Trajektorien pro Schleife, horizontal view'
	    endif
	    write(zeile,121) schnitt_x, schnitt_p
121	format('- Schnittebene bei x = ',F6.1,' im ',I1,
     +						  '. Kammerteil')
	    write(lunTMP,'(A)') zeile
	endif

	if (write_geo) write(lunTMP,'(A)') '.GEO-file erstellen'

	if (.NOT.(createPhysTab.AND.createNTP.AND.GRAPHICS.AND.write_geo)) then
	    zeile = '> NICHT ERZEUGT:'
	    pos = 18
	    if (.NOT.createPhysTab) then
	       write(zeile(pos:pos+15),'(A)') 'PHYSICA-TABELLE,'
	       pos = pos + 16
	    endif
	    if (.NOT.createNTP) then
	       write(zeile(pos:pos+6),'(A)')'NTUPEL,'
	       pos = pos + 7
	    endif
	    if (.NOT.GRAPHICS)  then
	       write(zeile(pos:pos+7),'(A)')'GRAPHIK,'
	       pos = pos + 8
	    endif
	    if (.NOT.write_geo) then
	       write(zeile(pos:pos+8),'(A)')'GEO-FILE,'
	       pos = pos + 9
	    endif
	    pos = pos - 1
	    write(zeile(pos:pos),'(A)')' '
	    write(lunTMP,'(A)') zeile
	endif


c Debug:
c-------

	if (DEBUG) then
	    write(zeile,132) Debug_Anzahl
132	format('DEBUG-INFORMATIONEN IM LOG-file:',I3,
     +	' Projektile je Schleife')
	    if (DEBUG_FE) write(zeile(59:68),'(A10)') ', incl. FE'
	    write(lunTMP,'(A)') zeile
	    if (.NOT.graphics) then
		write(lunTMP,'(A,I3)') '- iMonitor = ',iMonitor
	    endif
	endif


c Fehlerbetrachtung:
c ------------------

	write(zeile,141) eps_x,eps_v,dtsmall,maxStep
141	format('eps_x,eps_v = ',E8.3,',',E8.3,T42,', dtsmall = ',F8.6,
     +  ', maxstep = ',I6)
	if (log_relativ) then
	    write(zeile(33:41),'(A9)') '(relativ)'
	else
	    write(zeile(33:41),'(A9)') '(absolut)'
	endif
	write(lunTMP,'(A)') zeile
        write(lunTMP,'(A,I5)') 'maxBelowDtSmall = ',maxBelowDtSmall
d	if (log_confine) then
d	    if (lense2) then
d		write(lunTMP,142) ' Schrittweitenbegrenzung: L1,L2andFO,L3,M2: ',
d    +		      dl_max_L1,dl_max_L2andFo,dl_max_L3,dl_max_M2
d	    else
d		write(lunTMP,142) ' Schrittweitenbegrenzung: L1,FO,L3,M2: ',
d    +		      dl_max_L1,dl_max_Fo,dl_max_L3,dl_max_M2
d	    endif
d	endif
d142	format(x,A,4(F6.3,:,', '))


c Logfile:
c --------

	if (.NOT.Logfile) then
	    if (smallLogFile) then
		write(lunTMP,'(A)') 'KLEINES LOGFILE'
	    else
		write(lunTMP,'(T30,A)') '>>> KEIN LOGFILE <<<'
	    endif
	endif

	write(lunTMP,'(A)') strich2


c Kommentarzeilen aus der Eingabedatei MUTRACK.INPUT:
c ---------------------------------------------------

c da das PHYSICA file erst spaeter geoeffnet wird kann die entsprechende unit
c hier temporaer fuer den Anschluss der Eingabedatei verwendet werden

        open(lunPHYSICA,file=inputName,defaultfile=readDir//':.INPUT',
     +  status='OLD',readonly)
	flag = .false.
554	read(lunPHYSICA,'(A)') zeile
	do while (INDEX(zeile,'$loop_params').EQ.0 .AND.
     +		  INDEX(zeile,'$parameter_liste').EQ.0)
	    if (zeile(1:1).EQ.'@') then
		write(lunTMP,'(A)') zeile
		flag = .true.
	    endif
	    goto 554
	enddo

	close(lunPHYSICA)

	if (flag) write(lunTMP,'(A)') strich2

	if (TestRun) then
	    write(lunTMP,'(A)') '########################  >>>>> '//
     +	      'T E S T - R U N <<<<<  ########################'
	    write(lunTMP,'(A)') strich2
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MAKE_VARNAMES
c	========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	integer pos

	character*80 varNames,loopZeile,parValues /' '/
	COMMON /zeilen/ varNames,loopZeile,parValues

c die Zeile 'varNames' mit den Namen derjenigen Schleifen-Parameter
c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie
c sie auch als Schleifen abgearbeitet werden):

	varNames = ' '
	pos = 1

c Foliendicke:
c ------------

	if (n_par(Thickn).GT.1) then
	    varNames(pos:pos+10) = '  Thickness'
	    pos = pos+11
	endif

c MCP2:
c -----

	if (n_par(UMCP2).GT.1) then
	    varNames(pos:pos+10) = '    U(MCP2)'
	    pos = pos+11
	endif

c Drehwinkel:
c -----------

	if (n_par(alfTgt).GT.1) then
	    varNames(pos:pos+8)  = 'alfa(Tgt)'
	    pos = pos+9
	endif
	if (n_par(alfSp).GT.1) then
	    varNames(pos:pos+8)  = ' alfa(Sp)'
	    pos = pos+9
	endif
	if (n_par(alfTD).GT.1) then
	    varNames(pos:pos+8)  = ' alfa(TD)'
	    pos = pos+9
	endif

c 'artList' bzw. Masse und Ladung:
c --------------------------------

	if (artList_defined) then
	    if (n_par(charge).GT.1) then		    ! mehr als eine
		varNames(1:6) = ' Art  '		    ! Art spezifiziert
		pos = 7
	    endif
	else
	    if (n_par(mass).GT.1) then
		varNames(pos:pos+12) = '        Masse'
		pos = pos+13
	    endif
	    if (n_par(charge).GT.1) then
		varNames(pos:pos+3) = '   Q'
		pos = pos+4
	    endif
	endif

c Triggerdetektor:
c ----------------

	if (n_par(UFolie).GT.1) then
	    varNames(pos:pos+10) = '   U(Folie)'
	    pos = pos+11
	endif
	if (n_par(UVorne).GT.1) then
	    varNames(pos:pos+10) = '   U(Vorne)'
	    pos = pos+11
	endif
	if (n_par(UHinten).GT.1) then
	    varNames(pos:pos+10) = '  U(Hinten)'
	    pos = pos+11
	endif
	if (n_par(UMCP3).GT.1) then
	    varNames(pos:pos+10) = '    U(MCP3)'
	    pos = pos+11
	endif

c Transportsystem:
c ----------------

	if (n_par(UTgt).GT.1) then
	    varNames(pos:pos+10) = '  U(Target)'
	    pos = pos+11
	endif
	if (n_par(UGua).GT.1) then
	    varNames(pos:pos+10) = '   U(Guard)'
	    pos = pos+11
	endif
	if (n_par(UG1).GT.1) then
	    varNames(pos:pos+10) = '  U(Gitter)'
	    pos = pos+11
	endif
	if (n_par(UL1).GT.1) then
	    varNames(pos:pos+10) = '      U(L1)'
	    pos = pos+11
	endif
	if (n_par(USp).GT.1) then
	    varNames(pos:pos+10) = ' U(Spiegel)'
	    pos = pos+11
	endif
	if (n_par(UL2).GT.1) then
	    varNames(pos:pos+10) = '      U(L2)'
	    pos = pos+11
	endif
	if (n_par(UL3).GT.1) then
	    varNames(pos:pos+10) = '      U(L3)'
	    pos = pos+11
	endif

c Magnetfelder:
c -------------

	if (n_par(BHelm).GT.1) then
	    varNames(pos:pos+10) = '    B(Helm)'
	    pos = pos+11
	endif
	if (n_par(BTD).GT.1) then
	    varNames(pos:pos+10) = '      B(TD)'
	    pos = pos+11
	endif

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

	if (n_par(ener).GT.1) then
	    varNames(pos:pos+10) = '    Energie'
	    pos = pos+11
	endif

	if (n_par(yPos).GT.1) then
	    varNames(pos:pos+8) = '       y0'
	    pos = pos+9
	endif
	if (n_par(zPos).GT.1) then
	    varNames(pos:pos+8) = '       z0'
	    pos = pos+9
	endif

	if (n_par(thetAng).GT.1) then
	    varNames(pos:pos+8) = '     phi0'
	    pos = pos+9
	endif
	if (n_par(phiAng).GT.1) then
	    varNames(pos:pos+8) = '   theta0'
	    pos = pos+9
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MAKE_ParValues
c	=========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	integer pos

	character*80 varNames,loopZeile,parValues /' '/
	COMMON /zeilen/ varNames,loopZeile,parValues

c die Zeile 'varValues' mit den aktuellen Werten derjenigen Schleifen-Parameter
c zusammenstellen, die mehr als einen Wert annehmen (in der Reihenfolge, wie
c sie auch als Schleifen abgearbeitet werden):

	parValues = ' '
	pos = 1

c Foliendicke:
c ------------

	if (n_par(Thickn).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(Thickn)
	    pos = pos+11
	endif

c MCP2:
c -----

	if (n_par(UMCP2).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UMCP2)
	    pos = pos+11
	endif

c Drehwinkel:
c -----------

	if (n_par(alfTgt).GT.1) then
	    write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfTgt)
	    pos = pos+9
	endif
	if (n_par(alfSp).GT.1) then
	    write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfSp)
	    pos = pos+9
	endif
	if (n_par(alfTD).GT.1) then
	    write(parValues(pos+3:pos+8),'(F6.1)') parWert(alfTD)
	    pos = pos+9
	endif

c 'artList' bzw. Masse und Ladung:
c --------------------------------

	if (artList_defined) then
	    if (n_par(charge).GT.1) then
		write(parValues(2:5),'(A4)') art_Name(artNr)
		pos = 7
	    endif
	else
	    if (n_par(mass).GT.1) then
		write(parValues(pos+1:pos+12),'(F12.2)') parWert(6)
		pos = pos+13
	    endif
	    if (n_par(charge).GT.1) then
		write(parValues(pos+2:pos+3),'(SP,I2)') INT(parWert(5))
		pos = pos+4
	    endif
	endif


c Triggerdetektor:
c ----------------

	if (n_par(UFolie).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UFolie)
	    pos = pos+11
	endif
	if (n_par(UVorne).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UVorne)
	    pos = pos+11
	endif
	if (n_par(UHinten).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UHinten)
	    pos = pos+11
	endif
	if (n_par(UMCP3).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UMCP3)
	    pos = pos+11
	endif

c Transportsystem:
c ----------------

	if (n_par(UTgt).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UTgt)
	    pos = pos+11
	endif
	if (n_par(UGua).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UGua)
	    pos = pos+11
	endif
	if (n_par(UG1).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UG1)
	    pos = pos+11
	endif
	if (n_par(UL1).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL1)
	    pos = pos+11
	endif
	if (n_par(USp).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(USp)
	    pos = pos+11
	endif
	if (n_par(UL2).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL2)
	    pos = pos+11
	endif
	if (n_par(UL3).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(UL3)
	    pos = pos+11
	endif

c Magnetfelder:
c -------------

	if (n_par(BHelm).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(BHelm)
	    pos = pos+11
	endif
	if (n_par(BTD).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(BTD)
	    pos = pos+11
	endif

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

	if (n_par(ener).GT.1) then
	    write(parValues(pos+1:pos+10),'(F10.3)') parWert(ener)
	    pos = pos+11
	endif

	if (n_par(yPos).GT.1) then
	    write(parValues(pos+2:pos+8),'(F7.2)') parWert(yPos)
	    pos = pos+9
	endif
	if (n_par(zPos).GT.1) then
	    write(parValues(pos+2:pos+8),'(F7.2)') parWert(zPos)
	    pos = pos+9
	endif

	if (n_par(thetAng).GT.1) then
	    write(parValues(pos+3:pos+8),'(F6.1)') parWert(ThetAng)
	    pos = pos+9
	endif
	if (n_par(phiAng).GT.1) then
	    write(parValues(pos+3:pos+8),'(F6.1)') parWert(phiAng)
	    pos = pos+9
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE OUTPUT_NEW_LOOP(q_)
c	==============================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'

	integer k, par_, iostat
	real	q_	    ! gegebenenfalls Nr der Ladungsschleife, benoetigt
			    ! fuer Ausgabe der neutralen Anteile nach TD-Folie

	character*80 varNames,loopZeile,parValues /' '/
	COMMON /zeilen/ varNames,loopZeile,parValues

	character datum*9,uhrzeit*8


	if (SchleifenNr.EQ.1) then 
	    write(*,'(A)')'==========================='//
     +	  '====================================================='
	    if (OneStartPerLoop) then
		do indx = indx1, indx2
c		    if (Gesamtzahl.GT.1) then
			write(lun(indx),*) 'Nur ein Start pro '//
     +			 'Schleife => Summary geht ueber alle Schleifen'
c		    else    
c			write(lun(indx),*) 'Nur ein Start => kein '
c    +			  'Summary'
c		    endif
		enddo
		goto 10
	    endif
	endif


c die Zeile mit der Schleifennummer und dem Startnummernbereich der
c Schleife erstellen: (n_par(0) = #(StartsProSchleife))

	write(loopZeile(1:80),999)SchleifenNr,SchleifenZahl,
     +		      (SchleifenNr-1)*n_par(0)+1,SchleifenNr*n_par(0)
999	format ('  >>> Schleife  :',2X,I4,' von ',I4,T43,'Start-Nr:  ',
     +	      I8,' bis ',I8)


c falls Run im BATCH_MODE laeuft: gib 'loopZeile' in die Datei 'filename.MESSAG
c aus, damit man sich jederzeit informieren kann, an welcher Stelle der Run ge-
c rade steht:

	if (BATCH_MODE) then
	    if (INPUT_LIST) then
		open(lunMessage,file='MU_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:',
     +			  status='UNKNOWN',iostat=iostat)
		read (lunMessage,*,iostat=iostat) ! Nr. der Input-Datei in INPUT_LIST.INPUT
	    else
		open(lunMessage,file='MUTRACK.MESSAGE',defaultfile='SYS$SCRATCH:',
     +			  status='UNKNOWN',iostat=iostat)
	    endif
	    read (lunMessage,*,iostat=iostat) ! Startzeitpunkt
	    read (lunMessage,*,iostat=iostat) ! Name der Input-Datei in INPUT_LIST.INPUT
	    write(lunMessage,*,iostat=iostat) filename
	    write(lunMessage,*,iostat=iostat) loopZeile
	    call date(datum)
	    call time(uhrzeit)
	    write(lunMessage,*,iostat=iostat) ' started on '//datum//' at '//uhrzeit
	    close(lunMessage,iostat=iostat)
	endif


c die aktuellen Einstellungen der variablen Parameter in 'parValues' schreiben:

	if (smallLogfile.OR.createTabellen) call Make_parValues


c falls nur die Minimalversion der .LOG-Datei erstellt werden soll, schreibe
c die entsprechenden Zeilen in die Datei:

	if (smallLogFile) then
	    write(lun(1),'(A)') loopZeile 
	    write(lun(1),'(A)') parValues
	    write(lun(1),*)
	endif


c gib die aktuellen Einstellungen der variablen Parameter (parWert) aus:
c (hier Zeile fuer Zeile)

	if (n_outWhere.NE.0) then
	    do 1, indx = indx1, indx2
	    write(lun(indx),'(A)')loopZeile
	    do k=1, par_anzahl
		par_ = reihenfolge(k)
		if (par_.EQ.ener .AND. e0InterFromFile) then
		    write(lun(indx),1002) nint(parWert(ener)),lowerE0,upperE0
		elseif (n_par(par_).GT.1) then 
		    if (par_.EQ.charge .AND. artList_defined) then
			if (log_neutralize) then
			    write(lun(indx),1000) art_Name(artNr),
     +							  neutral_fract(q_)
			else
			    write(lun(indx),1000) art_Name(artNr)
			endif
		    else
			write(lun(indx),1001) par_text(par_)(1:10),
     +						  parWert(par_)
		    endif
		endif
	    enddo
1	    continue
	endif
1000	format (X,' >>> Projektil :',7X,A,:' (neutr. fract. = 'F5.1'%)')
1001	format (X,' >>> ',A,': ',F10.3)
1002    format (X,' >>> ',I3,'. E0-Intervall:   [',F8.3,',',F8.3,']')


c gib gegebenenfalls den gemaess ICRU Tabelle berechneten mittleren Energie-
c verlust in der Triggerfolie aus:

10   	if (log_E_Verlust_ICRU .AND. .NOT.calculate_each) then
	    do indx = indx1, indx2
		write(lun(indx),1001) 'Eloss-ICRU',mean_E_Verlust
	    enddo
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE GRAPHICS_TEXT
c	==========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	integer k,zeile,par_
        integer GraphTextZeilen /15/

        character graphText(15)*40  /15*' '/
        COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText

	if (OneStartPerLoop) then
	    graphText(2) = filename
	    graphText(4) = 'Ein Start pro Schleife, daher'
	    graphText(5) = 'alle Kurven in einer Graphik.'
	    graphText(7) = 'Settings entsprechend Logfile.'
	else
	    graphText(1) = filename
	    if (OneLoop) then
		graphText(3) = 'Nur eine Schleife  ->  keine'
		graphText(4) = 'veraenderlichen Parameter'
	    else
		write(graphText(2),900) SchleifenNr,SchleifenZahl
900	format('Schleife  ',I5,'   von ',I6)
		zeile = 3
		do k=1, par_anzahl

		    par_ = reihenfolge(k)
		    if (n_par(par_).GT.1) then 
			if (zeile.EQ.15) then
			    write(graphText(zeile)(28:30),'(A3)') '...'
			    RETURN 
			endif
			if (par_.EQ.charge .AND. artList_defined) then
			    write(graphText(zeile),1000) art_Name(artNr)
			elseif (
     +			  ((par_.EQ.ener).AND.random_E0) .OR.
     +			  ((par_.EQ.yPos.OR.par_.EQ.zPos).AND.random_pos) .OR.
     +			  ((par_.EQ.phiAng.OR.par_.EQ.thetAng).AND.random_angle) )then
			    write(graphText(zeile),1001) par_text(par_)(1:10),
     +						      parWert(par_),' + random'
			else
			    write(graphText(zeile),1001) par_text(par_)(1:10),
     +						      parWert(par_)
			endif
			zeile = zeile+1
		    endif
		enddo
	    endif
	endif

1000	format (X,' Projektil = ',7X,A)
1001	format (X,' ',A,' = ',F10.3,:A)


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE OUTPUT_TABELLEN
c	==========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	integer  i,k, bufferPos /0/ ,indcs

	real	buffer(LwPerRec)
	integer what2indx(5) /6,7,4,5,9/

	! mean    = statMem(6,k)
	! Varianz = statMem(7,k)
	! min     = statMem(4,k)
	! max     = statMem(5,k)
	! prozent = statMem(9,k)

	character*80 varNames,loopZeile,parValues
	COMMON /zeilen/ varNames,loopZeile,parValues

	SAVE bufferPos

c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c I. Die speziellen Tabellen:

c gib die Zeile mit den aktuellen Werten der veraenderlichen Parameter und die
c Statistiken aus:

	if (createTabellen) then
	    do k = 1, stat_Anzahl
		if (createTabelle(k)) then
		    write(lunPHYSICA+k,'(A)') parValues
		    write(lunPHYSICA+k,1000) SchleifenNr,
     +			  statMem(6,k),statMem(7,k),statMem(4,k),
     +			  statMem(5,k),int(statMem(8,k)),statMem(9,k)
		    write(lunPHYSICA+k,'(A)')'_________________________'//
     +       '_______________________________________________________'
		endif
	    enddo
	endif
1000	format(X,I4,4X,F9.2,2X,F7.2,9X,F9.2,X,F9.2,10X,I6,2X,F6.1)
c 	         ^Nr   ^mean   ^sigma  ^von    ^bis    ^anzahl ^%


c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c II. Die PHYSICA - Tabelle: mean, Varianz, min, max, prozent

	if (createPhysTab) then
	    do k = 1, StatAnzahlPHY
		do i = 1, whatAnzahlPHY
		    indcs = what2indx(whatList(i))
		    bufferPos = bufferPos + 1
		    buffer(bufferPos) = statMem(indcs,statList(k))
		    if (bufferPos.EQ.LwPerRec) then
			write(lunPHYSICA) buffer
			bufferPos = 0
		    endif
		enddo
	    enddo

	    if (.NOT.notLastLoop) then
		write(lunPHYSICA) (buffer(k), k=1,bufferPos)
		close (lunPHYSICA)
	    endif
	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE OUTPUT_NEW_PARTICLE
c	==============================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	integer startNr			  ! = absolute Startnummer

	if (OneStartPerLoop) then
	    startNr = Start_Nr(1)
	else
	    startNr =  (SchleifenNr-1)*n_par(0) + Start_nr(1)
	endif

	write(lunLOG,*)
	write(lunLOG,'(A,I8)') 'Teilchen Nr. ',startNr
	if (random_E0) then
	    write(lunLOG,'(A,F)')'Startenergie       : ',parWert(ener)
	endif
	if (random_angle) then
	    write(lunLOG,'(A,F)')'Startwinkel (theta): ',parWert(thetAng)
	    write(lunLOG,'(A,F)')'Startwinkel (phi)  : ',parWert(phiAng)
	endif
	if (random_pos) then
	    write(lunLOG,'(A,F)')'Startposition (y)  : ',parWert(yPos)
	    write(lunLOG,'(A,F)')'Startposition (z)  : ',parWert(zPos)
	endif
 
	write(lunLOG,1001) 'STEP','GEBIET','T','X','Y','Z','Vx',
     +	      'Vy','Vz','E'

1001	format (T2,A,T7,A,T17,A,T25,A,T32,A,T39,A,T47,A,T54,A,
     +  T61,A,T71,A)


	END


C===============================================================================


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE SUMMARY
c	==================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'

	real    proz	! fuer Umrechnungen in Prozent

	integer k	! Zaehlvariable
	integer offset	!
	integer nr	! die Nummer eines Scalers oder Pfostens
	integer summe	! fuer Summenbildungen
	integer code_,ZahlDestiny

	character GebietText*15

	character PfostenText(3)*26
     +	  /   'direkt:',
     +	      'nach Reflexion an HINTEN:',
     +	      'nach Reflexion an MCP3:'	  /

	logical output_TD_code(11) / 11*.false. /
	COMMON /TD_CODE/ output_TD_code

	integer nNeutral,nCharged
	common /nNeutral/ nNeutral,nCharged

1000	format (X,A,:,T47,I8,'  (=',F5.1,'%)')	    ! destiny (gesamt)
1001	format (T5,A, T47,I8,'  (=',F5.1,'%)')	    ! destiny (je Gebiet)
1002	format (T10,A,T47,I8,'  (=',F5.1,'%)')	    ! Pfosten: direkt oder nach Refl.?
1003	format (T10,A1,I3,': ',T17,I5,'  (=',F5.1,'%)') ! 'P' und 'M'


c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c fuer alle Ausgabekanaele:

	do 3, indx = indx1, indx2

	if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then

	write(lun(indx),'(A)')'- - - - - - - - - - - - - - - - - - '//
     +		         '- - - - - - - - - - - - - - - - - - - - - -'


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

c die Projektil-Statistik:
c ------------------------

	proz = 100./start_nr(1)

c - Ausgabe der Teilchenschicksale mit Code-Nummern <= 0:

	do code_ = code_ok, smallest_code_Nr, -1
	    if (code_.EQ.code_ok .OR. statDestiny(code_).NE.0) then
		write(lun(indx),*)
		if (code_.EQ.code_ok .AND. (createFoilFile.OR.upToTDFoilOnly)) then
		    write(lun(indx),1000) 'TD-Folie getroffen:',
     +		    statDestiny(code_ok),statDestiny(code_ok)*proz
		else
		    write(lun(indx),1000) code_text(code_),
     +		    statDestiny(code_),statDestiny(code_)*proz
		endif
		if (code_.EQ.code_lostInTD) then
		    do nr = 1, 14
			if (statTD(1,nr).NE.0) then
			    write(lun(indx),1003) 'M',100+nr,
     +			    statTD(1,nr),statTD(1,nr)*proz
			    output_TD_code(nr) = .true.
			endif
		    enddo
		endif
	    endif
	enddo


c - Ausgabe der Teilchenschicksale mit Code-Nummern > 0:

	do code_ = 1, highest_code_Nr

	    !c Teste, ob spezielles Teilchenschicksal ueberhaupt auftrat:
	    summe = 0
	    do Gebiet = 1, Gebiete_Anzahl
		summe = summe + statDestiny((Gebiet-1)*highest_code_Nr + code_)
	    enddo

	    ! falls ja, gib aus, wie oft Schicksal insgesamt erlitten wurde,
	    ! und wie oft es in den einzelnen Gebieten erlitten wurde:
	    if (summe.GT.0) then
		write(lun(indx),*)
		write(lun(indx),1000) code_text(code_),summe,
     +		real(summe)*proz
		do Gebiet = 1, Gebiete_Anzahl
		    ZahlDestiny = statDestiny((Gebiet-1)*highest_code_Nr+code_)
		    if (ZahlDestiny.NE.0) then
			if (code_.EQ.code_vorbei) then
			    if (Gebiet.EQ.upToL1Map) then
				GebietText = 'Linse 1:'
			    elseif (Gebiet.EQ.upToEnSp) then
				GebietText = 'Spiegel:'
			    elseif (Gebiet.EQ.upToL2andFoMap) then
				GebietText = 'Linse 2:'
			    elseif (Gebiet.EQ.upToEnTD) then
				GebietText = 'Triggerfolie:'
			    elseif (Gebiet.EQ.upToL3Map) then
				GebietText = 'Linse 3:'
			    elseif (Gebiet.EQ.upToMCP2) then
				GebietText = 'MCP2:'
			    endif
			    write(lun(indx),1001) GebietText,
     +			    ZahlDestiny,ZahlDestiny*proz
			else
			!
	!---------------! (brauche mehr Platz)
	!
	if (log_out_pfosten(1).AND.
     +		      code_.EQ.code_wand.AND.Gebiet.EQ.upToExTD) then
	    ! getroffene Pfosten ausgeben:
	    write(lun(indx),1001) Gebiet_Text(gebiet)	! 'im Trigger-Detektor'

	    if (statTD(1,16).NE.0) write(lun(indx),1002)
     +	      'MCP3',statTD(1,16),statTD(1,16)*proz

	    do k= 1, 3     		! k=1: direkt getroffen 
		offset= (k-1)*25	! k=2: nach Refl. an HINTEN
		summe = 0		! k=3: nach Refl. an MCP3
		do nr = offset+1, offset+25
		    summe = summe + pfostenHit(nr,1)
		enddo
		if (summe.GT.0) then
		    write(lun(indx),1002)PfostenText(k),summe,summe*proz
		    do nr = offset+1, offset+25
			if (pfostenHit(nr,1).NE.0) then
			    write(lun(indx),1003) 'P',nr-offset,
     +		            pfostenHit(nr,1),pfostenHit(nr,1)*proz
			endif
		    enddo
		endif
	    enddo
	else
	    write(lun(indx),1001) Gebiet_Text(gebiet),
     +	    ZahlDestiny,ZahlDestiny*proz
	endif
	!
	!---------------!
			!
			endif
		    endif
		enddo
	    endif
	enddo


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

c Die Folienelektronen-Statistik:
c -------------------------------

	if (log_out_FE .AND. start_nr(2).GT.0) then
	    write(lun(indx),*)                    

	    proz = 100./start_nr(2)

	    if (start_nr(2).EQ.0) then
		write(lun(indx),'(A)')'KEINE FOLIENELEKTRONEN GESTARTET'
		goto 2
	    endif

	    write(lun(indx),1005) start_nr(2)
1005	format(' *FOLIENELEKTRONEN (100%=',I5,'):')
	    write(lun(indx),1000) 'MCP3 erreicht:',statTD(2,16),
     +	    statTD(2,16)*proz
	    if (statTD(2,17).NE.0) then
		write(lun(indx),1000) 'auf Gitterstaebe:',statTD(2,17),
     +		statTD(2,17)*proz
	    endif
	    if (statTD(2,18).NE.0) then
		write(lun(indx),1000) 'in MCP3 nicht nachgew.:',statTD(2,18),
     +		statTD(2,18)*proz
	    endif

c - abgebrochenen Trajektorien:
	    summe = 0
	    do nr = 1, 14
		summe = summe + statTD(2,nr)
	    enddo

	    if (summe.NE.0) then
		write(lun(indx),1000) 'Berechnung abgebrochen:',
     +		summe, summe*proz
		do nr = 1, 14
		    if (statTD(2,nr).NE.0) then
			write(lun(indx),1003) 'M',100+nr,statTD(2,nr),
     +				  statTD(2,nr)*proz
			output_TD_code(nr) = .true.
		    endif
		enddo
	    endif


c - getroffene Pfosten und GROUND-Treffer:

	    ! irgendwelche Pfosten getroffen?
	    summe = 0
	    do nr = 1,75
		summe = summe + pfostenHit(nr,2)
	    enddo
	    if (summe.GT.0) then
		if (.NOT.log_out_pfosten(2)) then
		    write(lun(indx),1000) 'aufgeschlagen:',summe,
     +		    summe*proz
		else
		    write(lun(indx),1000) 'aufgeschlagen:'
		    do k= 1, 3			    ! k=1: direkt getroffen 
			offset= (k-1)*25	    ! k=2: nach Refl. an HINTEN
			summe = 0		    ! k=3: nach Refl. an MCP3
			do nr = offset+1, offset+25
			    summe = summe + pfostenHit(nr,2)
			enddo
			if (summe.GT.0) then
			    write(lun(indx),1002)PfostenText(k),summe,
     +			    summe*proz
			    do nr= offset+1, offset+25
				if (pfostenHit(nr,2).NE.0) then
				    write(lun(indx),1003) 'P',nr-offset,
     +				  pfostenHit(nr,2),pfostenHit(nr,2)*proz
				endif
			    enddo
			endif
		    enddo
		endif
	    endif
	    if (statTD(2,15).NE.0) write(lun(indx),1000)
     +	      'auf Ground getroffen:',statTD(2,15),statTD(2,15)*proz
	endif

	endif	  ! if (.NOT.(lun(indx).EQ.lunLog .AND. smallLogFile)) then ...


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

c Ergebnis-Spiegel ausgeben:
c --------------------------

2	if (statsInSummary) then
	    write(lun(indx),*)
	    write(lun(indx),'(A)') '- - - - - - - - mean - - Varianz'//
     +		  '- - - - - von - - - bis - - - - - Anzahl - - % -'

	    do k = 1, stat_Anzahl
		if (statInSummary(k)) then
		    if (statMem(8,k).NE.0) then
			write(lun(indx),1006) statName(k),statMem(6,k),
     +			statMem(7,k),statMem(4,k),statMem(5,k),
     +			int(statMem(8,k)),statMem(9,k)
		    else
			write(lun(indx),'(x,A9,'':'',T25,A)')
     +		  statName(k),'   - - - - - keine Eintraege - - - - -'
		    endif
		endif
	    enddo
	endif


1006	format (x,A9,':',T14,F9.2,T26,F7.2,T39,F9.2,T49,F9.2,:,T66,I7,
     +T75,F6.1)
c     ^%   		 ^mean	  ^sigma   ^von	    ^bis       ^anzahl
c
c sigma(N)   = sqrt(   (  S(x^2)-((S(x))^2)/n  )/n    )
c sigma(N-1) = sqrt(   (  S(x^2)-((S(x))^2)/n  )/(n-1)  )

	    if (log_neutralize) then
		write(lun(indx),*) 'neutraler Anteil nach TD-Folie [%]: ',100.*real(nNeutral)/real(nNeutral+nCharged)
	    endif

	    write(lun(indx),'(A)') '=================================='//
     +'=============================================='

3	continue	! 'fuer alle Ausgabekanaele ...' 


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE TERMINATE_OUTPUT
c	===========================

	IMPLICIT NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'

	integer	    k, iostat
	character   datum*9,uhrzeit*8
	character   zeile*80
	real	    prozent

	logical output_TD_code(11), flag /.false./
	COMMON /TD_CODE/ output_TD_code

	character text(11)*70 /	
     +  'Startposition auf Folientraeger'
     + ,' '
     + ,'Start in negative x-Richtung'
     + ,'Teilchen zwischen FOLIE und VORNE reflektiert'
     + ,'v_x=0 und U(FOLIE,VORNE)=0 -> Teilchen steht'
     + ,'Teilchen zwischen HINTEN und GROUND reflektiert'
     + ,'Reflektion bei MCP3 und bei HINTEN'
     + ,'Teilchen zurueck auf Gitter V1'
     + ,'Reflektion bei HINTEN und bei MCP3'
     + ,'Teilchen zwischen VORNE und MCP3 reflektiert mit v_x <=0'
     + ,'Teilchen bleibt stehen' /

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

c	if (createFoilFile) close (lunFOIL)


c das NTP-File schliessen:

	if (createNTP.OR.createFoilFile) then
	    call HCDIR('//MUwrite',' ')
	    call HROUT(NTP_write,iostat,' ')	! NTP in Datei schreiben
	    call HREND('MUwrite')	! HBOOK-Datei schliessen
	    close(lunNTP)		! zugehoerige Fortran-Datei schliessen
	endif


	prozent = 100./real(start_Nr(1)+(SchleifenNr-1)*n_par(0))

	do k = 1 , 11
	    if (output_TD_code(k)) flag = .true.
	enddo

	indx = lunScreen
1 	continue

	if (flag) then
	    write(indx,*)'TD-Meldungen:'
	    do k = 1 , 11
		if (output_TD_code(k)) then
		    write(indx,1000) k+100,text(k)
		endif
	    enddo
	endif
1000	format(T5,'M',I3,': ',A)

	if (dtsmall_counter.GT.0) then
	    write(indx,1002) dtsmall_counter,dtsmall_counter*prozent
	    write(indx,1003) n_dtsmall_Max
	    write(indx,*)
	endif
	if (LostInTD_counter.NE.0) then
	    write(indx,1004) lostInTD_counter,lostInTD_counter*prozent
	    write(indx,*)
	endif
	if (Lost_counter.NE.0) then
	    write(indx,1005) Lost_counter,Lost_counter*prozent
	    write(indx,*)
	endif
1002	format(x,'Bei ',I5,' Trajektorienberechnungen wurde ',
     +	  'dtsmall unterschritten',T73,'(',F5.1,'%)')
1003	format(x,'(Im Maximalfall wurden ',I3,' Unterschreitungen von',
     +    ' dtsmall resettet)')
1004	format(x,'Im TD wurden ',I7,' Trajektorienberechnungen ',
     +	  'abgebrochen',T73,'(',F5.1,'%)')
1005	format(x,'wegen steps > maxStep wurden ',I5,
     +	  ' Trajektorienberechnungen abgebrochen',T73,'(',F5.1,'%)')

	call date(datum)
	call time(uhrzeit)
	if (notLastLoop) then
	    write(zeile,2000) datum, Uhrzeit, fileName
	else
	    write(zeile,2001) datum, Uhrzeit, fileName
	endif
2000	format('Simulation  ABGEBROCHEN  am ',A9,' um ',A8,T73,A7)
2001	format('Simulation beendet am ',A9,' um ',A8,T73,A7)
	write(indx,*) zeile
	if (notLastLoop) write(indx,*)'            ***********'
	write(indx,'(A)')'====================================='//    
     +			 '==========================================='

	if ((logFile.OR.smallLogFile) .AND. indx.NE.lunLOG) then
	    indx = lunLog
	    goto 1
	endif


c das Summary-File und die Tabellen-Files schliessen:

	if (LogFile.OR.smallLogFile) then
	    if (debug) then
		write(lunLog,'(A)') ' Die Gebietskodierung:'
		write(lunLog,*)
		do k = 1, Gebiete_Anzahl
		    indx = index(Gebiet_Text(k),':')
		    write (lunLog,1001) k,Gebiet_Text(k)(1:indx-1)
		enddo
		write(lunLog,'(A)')'=============================='//
     +	           '=================================================='
	    endif
	    close (lunLog)
	endif
1001	format(T4,I3,': ',A)

	do k = 1, Stat_Anzahl
	    if (createTabelle(k)) close (lunPHYSICA+k)
	enddo


c falls Run im BATCH_MODE laeuft: loesche das '.MESSAGE' file:

	if (BATCH_MODE) then
	    if (INPUT_LIST) then
		open(lunMessage,file='MU_'//inputListName//'.MESSAGE',defaultfile='SYS$SCRATCH:',
     +		status='UNKNOWN',iostat=iostat)
	    else
		open(lunMessage,file='MUTRACK.MESSAGE',defaultfile='SYS$SCRATCH:',
     +          status='UNKNOWN',iostat=iostat)
	    endif
c "STATUS='DELETE'" entfernt, damit .MESSAGE-Datei von "SUB_LIST.COM" die Nummer
c des zuletzt abgearbeiteten INPUT-Files gelesen werden kann.
c	    close(lunMessage,status='DELETE',iostat=iostat)
	    close(lunMessage,iostat=iostat)
	endif


c zum Abschluss zwei Leerzeilen auf den Bildschirm geben:

	write(*,*)
	write(*,*)


	END


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

	OPTIONS /EXTEND_SOURCE

	SUBROUTINE WRITE_GEO_FILE
c	=========================

	IMPLICIT  NONE

	INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
	INCLUDE 'mutrack$sourcedirectory:GEO_TRIGGER.INC'

	real	x_intersectTD ! Schnittpunkt der x-Achse mit der Folienebene
			      ! bzw im Fall von 'GridInFrontOfFoil' mit dem
			      ! Gitter vor der Triggerfolie
	real	x_intersectTDMap
	common /x_intersectTD/  x_intersectTD,x_intersectTDMap

	real help,trans,totTrans

	open (lunTMP,File=fileName//'.GEO',status='NEW',defaultfile=outDir)
c     +	      ,carriagecontrol ='NONE')

	write(lunTMP,*)
	write(lunTMP,*) fileName//geo_fileName
	write(lunTMP,*)
	write(lunTMP,*) 'Zugrundeliegende Kammergeometrie'
	write(lunTMP,*) '================================'
	write(lunTMP,*)  
	write(lunTMP,*) 'Im ersten Kammerteil (vom Moderator bis zum Spiegel) wird ''x'' relativ'
	write(lunTMP,*) 'zur Kryoachse gemessen, im zweiten Kammerteil (vom Spiegel bis zum MCP2)'
	write(lunTMP,*) 'relativ zur Spiegelaufhaengung (Zentrum des Doppelkreuzes).'
	write(lunTMP,*)  
	write(lunTMP,*) 'Alle Laengenangaben in mm, jeweils volle Breiten und Hoehen.'
	write(lunTMP,*)
	write(lunTMP,*)
	write(lunTMP,*) 'Vakuumrohr:'
	write(lunTMP,*) '-----------'
	write(lunTMP,1000) 'radius_Rohr',radius_Rohr
	write(lunTMP,*)
	write(lunTMP,*) 'Beschleuniger:'
	write(lunTMP,*) '--------------'
	if (Use_ACCEL) then
 	    write(lunTMP,1001) 'verwendete Simulationsdatei',fileName_ACCEL
	endif
	write(lunTMP,1000) 'x-Position der Moderatorfolie',xtarget
	write(lunTMP,1000) 'Breite der Moderatorfolie',dytarget
	write(lunTMP,1000) 'Hoehe der Moderatorfolie',dztarget
	write(lunTMP,1000) 'x-Position des 1. Gitters',xgrid1
	write(lunTMP,1000) 'Position relativ zum Moderator',xgrid1-xTarget
	write(lunTMP,1000) 'Breite des 1. Gitters',dygrid1
	write(lunTMP,1000) 'Hoehe des 1. Gitters',dzgrid1
	if (TestOnWireHit.OR.Use_ACCEL) then
	    write(lunTMP,1000) 'Drahtdurchmesser',dWires_G1
	    write(lunTMP,1000) 'Drahtabstand',dist_Wires_G1
	    trans = 1.-dWires_G1/dist_Wires_G1
	    write(lunTMP,1000) '=> Transmission (Gitter 1)',trans
	    totTrans = trans
	endif
	write(lunTMP,1000) 'x-Position des 2. Gitters',xgrid2
	write(lunTMP,1000) 'Position relativ zum Moderator',xgrid2-xTarget
	write(lunTMP,1000) 'Breite des 2. Gitters',dygrid2
	write(lunTMP,1000) 'Hoehe des 2. Gitters',dzgrid2
	if (TestOnWireHit.OR.Use_ACCEL) then
	    write(lunTMP,1000) 'Drahtdurchmesser',dWires_G2
	    write(lunTMP,1000) 'Drahtabstand',dist_Wires_G2
	    trans = 1.-dWires_G2/dist_Wires_G2
	    write(lunTMP,1000) '=> Transmission (Gitter 2)',trans
	    totTrans = totTrans * trans
	endif
	write(lunTMP,*)
	write(lunTMP,*) 'He-Schild:'
	write(lunTMP,*) '----------'
	write(lunTMP,1000) 'Radius des He-Schildes',rHeShield
	write(lunTMP,1000) 'Breite des Fensters',dyHeShield
	write(lunTMP,1000) 'Hoehe des Fensters',dzHeShield
	write(lunTMP,*)
	write(lunTMP,*) 'LN-Schild:'
	write(lunTMP,*) '----------'
	write(lunTMP,1000) 'Radius des LN-Schildes',rLNShield
	write(lunTMP,1000) 'Breite des Fensters',dyLNShield
	write(lunTMP,1000) 'Hoehe des Fensters',dzLNShield
	write(lunTMP,*)
	write(lunTMP,*) 'Linse 1:'
	write(lunTMP,*) '--------'
	write(lunTMP,1001) 'MappenName',MappenName_L1
	write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L1
	help = xCenterOfLense_L1-LengthOuterCyl_L1-DistanceCyl_L1-0.5*LengthInnerCyl_L1
	write(lunTMP,1000) 'Anfang der Linse',help
	write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L1
	help = xCenterOfLense_L1+LengthOuterCyl_L1+DistanceCyl_L1+0.5*LengthInnerCyl_L1
	write(lunTMP,1000) 'Ende der Linse',help
	write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L1
	write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L1
	write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L1
	write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L1
	write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L1
        write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L1
        write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L1
 	write(lunTMP,*)
	write(lunTMP,*) 'Spiegel:'
	write(lunTMP,*) '--------'
	write(lunTMP,1000) 'Spiegelaufhaengung',xSpiegel
	if (.NOT.idealMirror) write(lunTMP,1001) 'MappenName',MappenName_Sp
	write(lunTMP,1000) 'Laenge des Dreharmes',DreharmLaenge
	write(lunTMP,1000) 'Spiegelbreite',BSpiegel
	write(lunTMP,1000) 'Spiegelhoehe',hSpiegel
	write(lunTMP,1000) 'Spiegeltiefe',DSpiegel
	if (TestOnWireHit) then
	    write(lunTMP,1000) 'Drahtdurchmesser',dWires_Sp
	    write(lunTMP,1000) 'Drahtabstand',dist_Wires_Sp
	    trans = max(0.,1.-SQRT(2.)*dWires_Sp/dist_Wires_Sp)
	    ! max() wird benoetigt, da wegen Schraegstellung des Gitters
	    ! die Projektionen der Gitterstaebe ueberlappen koennen
	    trans = trans * trans	! Gitter wird zweimal durchquert
	    write(lunTMP,1000) '=> Spiegel-Transmission (2 Gitter)',trans
	    totTrans = totTrans * trans
	endif
	write(lunTMP,*)
	if (lense2) then
	    write(lunTMP,*) 'Linse 2:'
	    write(lunTMP,*) '--------'
	    write(lunTMP,1001) 'MappenName',MappenName_L2andFo
	    write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L2andFo
	    help = xCenterOfLense_L2-LengthOuterCyl_L2-DistanceCyl_L2-0.5*LengthInnerCyl_L2
	    write(lunTMP,1000) 'Anfang der Linse',help
	    write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L2
	    help = xCenterOfLense_L2+LengthOuterCyl_L2+DistanceCyl_L2+0.5*LengthInnerCyl_L2
	    write(lunTMP,1000) 'Ende der Linse',help
	    write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L2andFo
	    write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L2
	    write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L2
	    write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L2
	    write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L2
      	    write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L2
      	    write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L2
 	    write(lunTMP,*)
	endif
	if (TriggerInBeam) then
	    write(lunTMP,*) 'Trigger-Detektor (Werte fuer alpha(TD) = 0)'
	    write(lunTMP,*) '-------------------------------------------'
	    if (lense2) then
		write(lunTMP,1001) 'mappenName','siehe Linse 2'
		write(lunTMP,1001) 'Beginn der Potentialmappe','siehe Linse 2'
	    elseif (.NOT.gridInFrontOfFoil) then
		write(lunTMP,1001) 'mappenName',mappenName_Fo
		write(lunTMP,1000) 'Laenge der Mappe',mappenLaenge_Fo
		write(lunTMP,1000) 'Beginn der Potentialmappe',xTD-d_Folie_Achse-mappenLaenge_Fo
		write(lunTMP,1000) '''x_intersectTDMap''',x_intersectTDMap
		write(lunTMP,1000) '''x_intersectTD''',x_intersectTD
	    endif
	    write(lunTMP,1000) 'x-Position der Triggerfolie',xTD-d_Folie_Achse
	    write(lunTMP,1000) 'x-Position der Aufhaengung',xTD
	    write(lunTMP,1000) 'x-Position von ''Ground''',xTD+dx3/2+dx4+dx5
	    if (TestOnWireHit) then
		help = 1
		write(lunTMP,1000) 'Fo: Transmission',TransTDFoil
		write(lunTMP,1000) 'V1: Drahtdurchmesser',dWires_V1
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_V1
		trans = 1.-dWires_V1/dist_Wires_V1
		write(lunTMP,1000) '    => Transmission ',trans
		help = help * trans
		write(lunTMP,1000) 'V2: Drahtdurchmesser',dWires_V2
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_V2
		trans = max(0.,1.-SQRT(2.)*dWires_V2/dist_Wires_V2)
		! max() wird benoetigt, da wegen Schraegstellung des Gitters
		! die Projektionen der Gitterstaebe ueberlappen koennen
		write(lunTMP,1000) '    => Transmission ',trans
		help = help * trans
		write(lunTMP,1000) 'V3: Drahtdurchmesser',dWires_V3
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_V3
		trans = 1.-dWires_V3/dist_Wires_V3
		write(lunTMP,1000) '    => Transmission ',trans
		! V3-Transmission geht nicht m+-Transmission ein!
		write(lunTMP,1000) 'H1: Drahtdurchmesser',dWires_H1
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_H1
		trans = max(0.,1.-SQRT(2.)*dWires_H1/dist_Wires_H1)
		! max() wird benoetigt, da wegen Schraegstellung des Gitters
		! die Projektionen der Gitterstaebe ueberlappen koennen
		write(lunTMP,1000) '    => Transmission ',trans
		help = help * trans
		write(lunTMP,1000) 'H2: Drahtdurchmesser',dWires_H2
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_H2
		trans = 1.-dWires_H2/dist_Wires_H2
		write(lunTMP,1000) '    => Transmission ',trans
		help = help * trans
		write(lunTMP,1000) 'G:  Drahtdurchmesser',dWires_G
		write(lunTMP,1000) '    Drahtabstand    ',dist_Wires_G
		trans = 1.-dWires_G/dist_Wires_G
		write(lunTMP,1000) '    => Transmission ',trans
		help = help * trans
		write(lunTMP,*)
		write(lunTMP,1000) 'totale TD-Transm. excl. Folie',help
		write(lunTMP,1000) 'totale TD-Transm. incl. Folie',help*TransTDFoil
		write(lunTMP,*)
		totTrans = totTrans * help * transTDFoil
		if (generate_FE) write(lunTMP,1000) 'MCP3-Effizienz',efficiencyM3
	    endif
	    write(lunTMP,*)
	endif
	write(lunTMP,*) 'Linse 3:'
	write(lunTMP,*) '------------'
	write(lunTMP,1001) 'MappenName',MappenName_L3
	write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_L3
	help = xCenterOfLense_L3-LengthOuterCyl_L3-DistanceCyl_L3-0.5*LengthInnerCyl_L3
	write(lunTMP,1000) 'Anfang der Linse',help
	write(lunTMP,1000) 'Mitte der Linse',xCenterOfLense_L3
	help = xCenterOfLense_L3+LengthOuterCyl_L3+DistanceCyl_L3+0.5*LengthInnerCyl_L3
	write(lunTMP,1000) 'Ende der Linse',help
	write(lunTMP,1000) 'Ende der Potentialmappe',xLeaveMap_L3
	write(lunTMP,1000) 'Laenge der auesseren Zylinder',LengthOuterCyl_L3
	write(lunTMP,1000) 'Laenge des inneren Zylinders',LengthInnerCyl_L3
	write(lunTMP,1000) 'Abstand der Zylinder',DistanceCyl_L3
	write(lunTMP,1000) 'Innenradius der Zylinder',iRadiusCyl_L3
        write(lunTMP,1000) 'Aussenradius der auesseren Zylinder',oRadiusOuterCyl_L3
        write(lunTMP,1000) 'Aussenradius des inneren Zylinders',oRadiusInnerCyl_L3
	write(lunTMP,*)
	write(lunTMP,*) 'MCP2:'
	write(lunTMP,*) '-----'
	write(lunTMP,1001) 'MappenName',MappenName_M2
	write(lunTMP,1000) 'Beginn der Potentialmappe',xEnterMap_M2
	if (xBlende.GT.0.) then
	    write(lunTMP,1000) 'x-Position der Blende',xBlende
	    write(lunTMP,1000) 'Radius der Blende',radius_Blende
	endif
	write(lunTMP,1000) 'x-Position des MCP2',xMCP2
	write(lunTMP,1000) 'Radius des MCP2',radius_MCP2
	write(lunTMP,1000) 'Radius der aktiven Flaeche',radius_MCP2active
	write(lunTMP,*)
	if (TestOnWireHit) then
	    write(lunTMP,*)
	    write(lunTMP,1000) 'PRODUKT ALLER GITTERTRANSMISSIONEN',totTrans
	    if (TriggerInBeam) then
		write(lunTMP,'(4x,A,F5.1,A)') '(bei Transmission des TD-Folien-Stuetzgitters von ',100*TransTDFoil,'%)'
	    endif
	    write(lunTMP,*)
	endif
	close(lunTMP)

1000	format(4x,A,T40,'= ',F8.3)
1001	format(4x,A,T40,': ',A)

	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE MAKE_INFOFILE
c	========================

	IMPLICIT  NONE

	INCLUDE 'mutrack$sourcedirectory:COM_MUTRACK.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_DIRS.INC'
	INCLUDE 'mutrack$sourcedirectory:COM_KAMMER.INC'

	integer	    i,j

	integer	  pos_Anzahl
	parameter (pos_Anzahl = 20)

	integer	  pos(pos_Anzahl) /UTgt,UGua,UG1, UL1,USp,UL2,
     +				   UFolie, BHelm,BTD,
     +				   alfTgt,alfSp,alfTD, mass,charge,
     +				   ener,yPos,zPos,thetAng,phiAng,DeltaL1 /

	character*8 label(pos_Anzahl)
	DATA label /
     +	      'U_Tgt_  ','U_Gua_  ','U_G1_   ','U_L1_   ','U_Sp_   ','U_L2_   ',
     +	      'U_Folie_','B_Helm_ ','B_TD_   ',
     +	      'alfaTgt_','alfaSp_ ','alfaTD_ ','Masse_  ','Ladung_ ',
     +	      'E0_     ','y0_     ','z0_     ','theta0_ ','phi0_   ','DeltaL1_'/

	integer par_,nr
	integer help_reihenfolge(pos_Anzahl)

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

c Gegebenenfalls schreiben des Files mit den E0-Intervallen:

	if (E0InterFromFile) then
	    open (lunFOIL,file=fileName,defaultfile=outDir//':.E0',status='NEW')
	    do i = 1, n_par(ener)
		write (lunFOIL,1000) 100+i,nint(1000.*E0Low(i)),nint(1000.*E0Low(i+1))
	    enddo
	    close (lunFOIL)
	endif
1000    format(x,I4,8x,I5,5x,I5,8x,I7)


c fill 'help_reihenfolge':
c falls 'reihenfolge(i)' auch in 'pos' enthalten ist, uebernehme es in
c 'help_reihenfolge':

	nr = 0
	do i = 1, par_Anzahl
	    par_ = reihenfolge(i)
	    do j = 1, pos_Anzahl
		if (par_.EQ.pos(j)) then
		    nr = nr + 1
		    help_reihenfolge(nr) = par_
		endif
	    enddo
	enddo
	if (Nr.NE.pos_Anzahl) then
	    write(*,*)' error xxx'
	    call exit
	endif


c open INFO file:

	open (lunFOIL,file=fileName,defaultfile=outDir//':.INFO',status='NEW')


c output information:

 	write (lunFOIL,*)'========================================'//
     +		     '========================================'
	write(lunFOIL,*)' This file contains the input parameters used for '//filename
 	write (lunFOIL,*)'========================================'//
     +		     '========================================'
 	write (lunFOIL,*)' The following parameters are the ones relevant for further'
	write (lunFOIL,*)' calculations by MUTRACK:'
	write (lunFOIL,*)
	write (lunFOIL,*) '$muVersion'
	write (lunFOIL,2600) 'mutrackVersion',Version
	if (AccelVersion.NE.' ') write (lunFOIL,2600) 'accelVersion',accelVersion
	write (lunFOIL,*) '$END'
	write (lunFOIL,*)
        write (lunFOIL,*) '$loop_params'
	do j = 1, pos_Anzahl
	    par_ = pos(j)
	    if ((par_.EQ.mass.OR.par_.EQ.charge).AND.artList_defined) then
		! keine Ausgabe
	    elseif (par_.EQ.UGua. AND. .NOT.guard) then
		! keine Ausgabe
	    elseif ((par_.EQ.BHelm .OR. par_.EQ.BTD) .AND.
     +		       par(1,par_).EQ.0. .AND. n_par(par_).LE.1) then
		! keine Ausgabe
	    elseif (par_.EQ.UL2 .AND. .NOT.lense2)  then
		! keine Ausgabe
	    else
		if (n_par(par_).LE.1) then
		    write (lunFOIL,*) '  ',label(j),' = ',par(1,par_)
		elseif (n_par(par_).EQ.2) then
		    write (lunFOIL,*) '  ',label(j),' = ',(par(i,par_),i=1,2)
		else
		    write (lunFOIL,*) '  ',label(j),' = ',(par(i,par_),i=1,3)
		endif
	    endif
	enddo
        write (lunFOIL,*) '$END'
 	write (lunFOIL,*)
	write (lunFOIL,*) '$additionals'
	write (lunFOIL,2601) 'par_Anzahl_prevSim',pos_Anzahl
	write (lunFOIL,2610) 'reihenFolge_prevSim',help_reihenfolge
	if (USE_ACCEL) write (lunFOIL,2600) 'mappenNameACCEL',mappenNameACCEL
2610	format(3x,A,T25,'= ',30(x,I2,:))
	if (artList_defined) write (lunFOIL,2601) 'artenZahl_prevSim',n_par(charge)
        write (lunFOIL,*) '$END'
 	write (lunFOIL,*)
        write (lunFOIL,*) '$parameter_liste'
 	write (lunFOIL,*)
 	write (lunFOIL,2601) 'Startflaeche',Startflaeche
	if (startFlaeche.EQ.-1) then
	    write(lunFOIL,2602)'x0_',x0(1)
c	    write(lunFOIL,2601)'Kammerteil',Kammerteil
	endif
 	write (lunFOIL,*)
	if (artList_defined) then
      	    write (lunFOIL,2600) 'artList_prevSim',artlist
	else
      	    write (lunFOIL,*) 'artList_prevSim'
	endif
	write (lunFOIL,2603) 'UseDecay_prevSim',UseDecay
 	write (lunFOIL,*)
        write (lunFOIL,2601) 'randomStarts_prevSim',n_par(0)
	if (random_E0) then
	    if (random_E0_equal) then
		write(lunFOIL,2601)'random_energy',1
		if (E0InterFromFile) write (lunFOIL,2603) 'E0InterFromFile',E0InterFromFile
		write(lunFOIL,2602)'lowerE0',lowerE0
		write(lunFOIL,2602)'upperE0',upperE0
	    elseif (random_E0_gauss) then
		write(lunFOIL,2601)'random_energy',2
		write(lunFOIL,2602)'sigmaE0',sigmaE0
	    endif
	else
	    write(lunFOIL,2601)'random_energy',0
	endif
	if (random_pos) then
	    if (random_y0z0_equal) then
		write(lunFOIL,2601)'random_position',1
		write(lunFOIL,2602)'StartBreite',StartBreite
		write(lunFOIL,2602)'StartHoehe',StartHoehe
	    elseif (random_r0_equal) then
		write(lunFOIL,2601)'random_position',2
		write(lunFOIL,2602)'StartRadius',StartRadius
	    elseif (random_y0z0_Gauss) then
		write(lunFOIL,2601)'random_position',3
		write(lunFOIL,2602)'StartBreite',StartBreite
		write(lunFOIL,2602)'StartHoehe',StartHoehe
		write(lunFOIL,2602)'sigmaPosition',sigmaPosition
	    elseif (random_r0_Gauss) then
		write(lunFOIL,2601)'random_position',4
		write(lunFOIL,2602)'StartRadius',StartRadius
		write(lunFOIL,2602)'sigmaPosition',sigmaPosition
	    endif
	else
	    write(lunFOIL,2601)'random_position',0
	endif
	if (random_angle) then
	    if (random_lambert) then
		write(lunFOIL,2601)'random_winkel',1
		write(lunFOIL,2602)'StartLambertOrd',StartLambertOrd
	    elseif (random_gauss) then
		write(lunFOIL,2601)'random_winkel',2
		write(lunFOIL,2602)'sigmaWinkel',sigmaWinkel
	    endif
	else
	    write(lunFOIL,2601)'random_winkel',0
	endif

        write (lunFOIL,*)
	write (lunFOIL,2603) 'TriggerInBeam',TriggerInBeam
	write (lunFOIL,2603) 'GridInFrontOfFoil',GridInFrontOfFoil
	write (lunFOIL,2603) 'TestOnWireHit',TestOnWireHit
	if (Use_ACCEL) then
 	    write (lunFOIL,2601) 'previousSimulation',1
      	    write (lunFOIL,2600) 'fileName_ACCEL',fileName_ACCEL
	endif
	write (lunFOIL,2603) 'idealMirror',idealMirror
 	write (lunFOIL,*)
	if (alfaTgtVertically) then
	    write (lunFOIL,2603) 'alfaTgtVertically',alfaTgtVertically
 	    write (lunFOIL,*)
	endif

        write (lunFOIL,*) '$END'

 	write (lunFOIL,*)
	write (lunFOIL,*)'========================================'//
     +               '========================================'
 	write (lunFOIL,*)
	write (lunFOIL,*) '$kammer_geo'
	write (lunFOIL,*)
	write (lunFOIL,2602) 'radius_Rohr       ', radius_Rohr
	write (lunFOIL,2602) 'xtarget           ', xtarget
	write (lunFOIL,2602) 'dytarget          ', dytarget
	write (lunFOIL,2602) 'dztarget          ', dztarget
	write (lunFOIL,2602) 'xgrid1            ', xgrid1
	write (lunFOIL,2602) 'dygrid1           ', dygrid1
	write (lunFOIL,2602) 'dzgrid1           ', dzgrid1
	if (TestOnWireHit.OR.Use_ACCEL) then
	    write (lunFOIL,2602) 'dist_wires_G1     ', dist_wires_G1
	    write (lunFOIL,2602) 'dWires_G1         ', dWires_G1
	endif
	write (lunFOIL,2602) 'xgrid2            ', xgrid2
	write (lunFOIL,2602) 'dygrid2           ', dygrid2
	write (lunFOIL,2602) 'dzgrid2           ', dzgrid2
	if (TestOnWireHit.OR.Use_ACCEL) then
	    write (lunFOIL,2602) 'dist_wires_G2     ', dist_wires_G2
	    write (lunFOIL,2602) 'dWires_G2         ', dWires_G2
	endif
	write (lunFOIL,2602) 'rHeShield         ', rHeShield
	write (lunFOIL,2602) 'dyHeShield        ', dyHeShield
	write (lunFOIL,2602) 'dzHeShield        ', dzHeShield
	write (lunFOIL,2602) 'rLNShield         ', rLNShield
	write (lunFOIL,2602) 'dyLNShield        ', dyLNShield
	write (lunFOIL,2602) 'dzLNShield        ', dzLNShield
	write (lunFOIL,2602) 'xCenterOfLense_L1 ', xCenterOfLense_L1
	write (lunFOIL,2600) 'MappenName_L1     ', MappenName_L1
	write (lunFOIL,2602) 'xSpiegel          ', xSpiegel
	if (.NOT.idealMirror) 	write (lunFOIL,2600) 'MappenName_Sp     ', MappenName_Sp
	write (lunFOIL,2602) 'DreharmLaenge     ', DreharmLaenge
	write (lunFOIL,2602) 'BSpiegel          ', BSpiegel
	write (lunFOIL,2602) 'hSpiegel          ', hSpiegel
	    write (lunFOIL,2602) 'DSpiegel          ', DSpiegel
	if (TestOnWireHit) then
	    write (lunFOIL,2602) 'dist_wires_Sp     ', dist_wires_Sp
	    write (lunFOIL,2602) 'dWires_Sp         ', dWires_Sp
	endif
	if (lense2) then
	    write (lunFOIL,2602) 'xCenterOfLense_L2 ', xCenterOfLense_L2
	    write (lunFOIL,2602) 'xTD               ', xTD
	    write (lunFOIL,2600) 'MappenName_L2andFo', MappenName_L2andFo
	else
	    write (lunFOIL,2602) 'xTD               ', xTD
	    write (lunFOIL,2600) 'mappenName_Fo     ', mappenName_Fo
	endif
 	write (lunFOIL,*)
        write (lunFOIL,*) '$END'
 	write (lunFOIL,*)
	write (lunFOIL,*)'========================================'//
     +               '========================================'
	if (E0InterFromFile) then
	    write (lunFOIL,*) 'Boundaries of E0-Intervalls:'
	    do i = 1, n_par(ener)+1
		write (lunFOIL,'(4x,F8.3)') E0Low(i)
	    enddo
	    write (lunFOIL,*)'========================================'//
     +                   '========================================'
	endif


2600	format(3x,A,T25,'=   ':'''',A,'''')	! fuer character
2601	format(3x,A,T25,'= ',4x,I8)		! fuer integer
2602	format(3x,A,T25,'= ',F12.6)		! fuer real
2603	format(3x,A,T25,'= ',L12)		! fuer logical
2604	format(3x,A,T25,'= ',E12.6)		! fuer Exponentdarstellung


c close INFO file:

	close (lunFOIL)


	END


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