
	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT  NONE

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

	integer   l, k, iostat, par_
	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	PHYSICA_ZeilenVektor(15)

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

	if (.NOT.gotFileNr) then

c den Namen der Ausgabe-files definieren:

	    if (LogFile.OR.smallLogFile.OR.input_list) then
		open(lunREAD,file='ACCEL_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='ACCEL_NR.DAT',defaultfile=NrDir,
     +			      status='OLD',iostat=iostat)
		    if (iostat.NE.0) then
			write(*,*) ' ================================================'
			write(*,*) ' create file '//NrDir//':ACCEL_NR.DAT'
			write(*,*) ' ================================================'
			open(lunREAD,file='ACCEL_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 ''AC_nnnn'' des Programms'//
     +			  ' ACCEL (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:
c (letzteres nur, falls interaktiv gearbeitet wird).

	write(*,*) strich2

	k = 0
	l = 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
	    k = k + 1
	    if (zeile(1:10).EQ.'Projektile' .OR.
     +		zeile(1:5 ).EQ.'Start' .OR.
     +		index(zeile(1:3),'>').NE.0) then
		l = l + 1
		PHYSICA_ZeilenVektor(l+2) = k
	    endif
	endif
	goto 997

998	if (createPhysTab) then
	    PHYSICA_ZeilenVektor(1) = k	    ! Anzahl HeaderZeilen
	    PHYSICA_ZeilenVektor(2) = l	    ! Anzahl spezieller Headerzeilen
	endif

	if (.NOT.BATCH_MODE) then
	    write(*,1010)
	    accept 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='ACCEL_NR.DAT',defaultfile=NrDir,
     +                status='OLD',iostat=iostat)
	    if (iostat.NE.0) then
		write(*,*) ' ================================================'
		write(*,*) ' create file '//NrDir//'ACCEL_NR.DAT'
		write(*,*) ' ================================================'
		open(lunREAD,file='ACCEL_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 ''AC_nnnn'' des Programms'//
     +		  ' ACCEL (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 (smallLogFile.OR.createTabellen) call Make_VarNames

	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 Header file schliessen (und dabei loeschen):

	close(lunTMP)


c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c falls verlangt, die Gesamt-Tabelle 'filename.PHYSICA' oeffnen und das Feld
c PHYSICA_ZeilenVektor in die ersten Zeilen schreiben. Die Anzahlen der 
c unterschiedlichen Schleifenparameter und der verschiedenen Statistiken,
c die Gesamtzahl der Schleifen, und die Anzahl der Projektile je Schleife in
c Zeile 2.
c Anschliessend fuer jeden SchleifenParameter in der Reihenfolge der Schleifen-
c aufrufe die Nummer, die Anzahl der Werte, Minimalwert, Maximalwert und
c Schrittgroesse ausgeben:
c
c 1. Zeile: PHYSICA_ZeilenVektor
c 2. Zeile: par_Anzahl, stat_Anzahl, Schleifenzahl, StartsProSchleife
c 3. Zeile bis (par_Anzahl). Zeile: Reihenfolge(i), n_par(Reihenfolge(i)

	if (createPhysTab) then
	    open(lunPHYSICA,file=fileName//'.PHYSICA',defaultfile=outDir,
     +      carriagecontrol='LIST',status='NEW')

	    write(lunPHYSICA,999) (PHYSICA_ZeilenVektor(k), k=1,15)
999	format (15(x,I3,:))
	    write(lunPHYSICA,992) par_Anzahl,stat_Anzahl, 
     +	    SchleifenZahl,n_par(0)
992	format (15(x,I6,:))
	    do k=1,par_Anzahl
		par_ = reihenFolge(k)
		write(lunPHYSICA,1000) par_, n_par(par_),
     +		par(1,par_),par(2,par_),par(3,par_)  
	    enddo
	endif
1000	format (x,I2,2X,I4,2X,F,2x,F,2X,F)


	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

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

	integer i,k,par_,pos
	logical	flag /.false./

	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='SCRATCH',carriagecontrol ='NONE')


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'

c MappenfileName:
c ---------------

	write(lunTMP,'(A)') strich1
	write(lunTMP,'(A)') 'POTENTIALMAPPE: '//mappenName
	if (scaleFactor.NE.1.) then
	    write(lunTMP,'(A,x,F5.2)') 'SCALE FACTOR FOR ACCELLERATOR GEOMETRY: ',scaleFactor
	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))) then
		write(lunTMP,*)
	    endif
	    if (par_.EQ.UGuard .AND. .NOT.freeGuard) then
		! 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.ener .AND. random_E0 .AND.
     +		n_par(ener).LE.1 .AND. par(1,ener).EQ.0.) then
		! keine Ausgabe
	    elseif ((par_.EQ.BTD .OR. par_.EQ.BHelm) .AND. par(1,par_).EQ.0
     +		 .AND. par(2,par_).EQ.0 ) then
		! keine Ausgabe
	    elseif ((par_.EQ.yPos.OR.par_.EQ.zPos) .AND. random_pos .AND.
     +		n_par(ypos).LE.1 .AND. par(1,ypos).EQ.0. .AND.
     +		n_par(zpos).LE.1 .AND. par(1,zpos).EQ.0.) then
		! keine Ausgabe
	    elseif (par_.EQ.thetAng .AND. random_angle. AND.
     +		       n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. .AND.
     +		       n_par(phiAng).LE.1 .AND. par(1,phiAng).EQ.0. ) then
		! keine Ausgabe
	    elseif (par_.EQ.phiAng .AND. (
     +		       (random_angle .AND.
     +		       n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0. .AND.
     +		       n_par(phiAng).LE.1 .AND. par(1,phiAng).EQ.0.)
     +		  .OR. (.NOT.random_angle .AND.
     +		       n_par(thetAng).LE.1 .AND. par(1,thetAng).EQ.0.)
     +		  .OR. (.NOT.random_E0 .AND.
     +		       n_par(ener).LE.1 .AND. par(1,ener).EQ.0.)
     +					  )) then
		! keine Ausgabe
	    elseif ((par_.EQ.mass .OR. par_.EQ.charge) .AND. artList_defined) then
		! keine Ausgabe
	    else
		if (par_.EQ.mass) then
		    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)')

	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) nE0Inter,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
		if (adjustSigmaE0) then
		    zeile='Startenergie : adjusted sigma'
		else
		    write(zeile, 32) sigmaE0
32	format('Startenergie : gaussverteilt (sigma = ',F6.3,')')
		endif
	    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_winkel.EQ.1) 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 : 2. Gitter'
	else
	    write(lunTMP,'(A)') 'Startflaeche : Moderator'
	endif

	write(lunTMP,'(A)') strich2


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

	if (mu_flag) then
	    if (UseDecay) then
		write(lunTMP,'(A)') 'Myonenzerfall: JA '
	    else
		write(lunTMP,'(A)') 'Myonenzerfall: NEIN '
	    endif
	endif


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

	if (statsInSummary) then
	    zeile = 'Statistiken  :'
	    pos = 16
	    do k = 1, stat_Anzahl
		if (statInSummary(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 16
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    do i = 1, 9
			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 = 16
	    do k = 1, stat_Anzahl
		if (createTabelle(k)) then
		    if (pos.GE.72) then
			zeile(pos:pos) = ','
			write(lunTMP,'(A)') zeile
		        zeile = ' '
			pos = 16
		    elseif (pos.GT.14) then
			zeile(pos:pos) = ','
			pos = pos + 1
		    endif
		    zeile(pos:pos) = ','
		    pos = pos + 1
		    do i = 1, 9
			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

	if (createPhysTab) write(lunTMP,'(A)') 'PHYSICA-Tabelle erstellen'

c NTP:
c ----

	if (NTP_Misc) then
	    zeile = 'NTP extra    :'
	    pos = 16
	    if (NTP_start) then
		write(zeile(pos:pos+5),'(A)') 'start,'
		pos = pos + 7
	    endif
	    if (NTP_stop) then
		write(zeile(pos:pos+4),'(A)') 'stop,'
		pos = pos + 6
	    endif
	    if (NTP_40mm) then
		write(zeile(pos:pos+5),'(A)') '40mm,'
		pos = pos + 6
	    endif
	    zeile(pos-2:pos-2) = ' '
	    write(lunTMP,'(A)') zeile
	endif

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

	if (GRAPHICS) then
	    zeile = 'Graphikausgabe'
	    pos = 16
	    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

	    write(lunTMP,'(A,I3,'','',I5,A)') '- iMonitor = ',iMonitor,
     +	        graphics_Anzahl,' Trajektorien pro Schleife'
	endif


c	if (.NOT.GRAPHICS .OR. .NOT.???? .OR. .NOT....) then
	if (.NOT.GRAPHICS) then
	    zeile = '> NICHT ERZEUGT:'
	    pos = 18
	    if (.NOT.GRAPHICS)  then
	       write(zeile(pos:pos+7),'(A)')'GRAPHIK,'
	       pos = pos + 8
	    endif
c	    if (.NOT.????)  then
c	       write(zeile(pos:pos+7),'(A)')'????,'
c	       pos = pos + 5
c	    endif
	    pos = pos - 1
	    write(zeile(pos:pos+8),'(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')
	    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
        if (log_confine) write(lunTMP,'(A)') ' Schrittweitenbegrenzung'
c        if (log_confine) write(lunTMP,142) dl_max_KL,dl_max_FO,dl_max_WL,dl_max
c142     format(' Schrittweitenbegrenzung: KL,FO,WL,M2: ',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 ACCEL.INPUT:
c -------------------------------------------------

        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:2).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 'accel$sourcedirectory:COM_ACCEL.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 '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 Startparameter:
c ---------------

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

c	if (.NOT.random_pos) then
	    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
c	endif

c	if (.NOT.random_angle) then
	    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
c	endif


	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_ACCEL.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 '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 Startparameter:
c ---------------

c	if (.NOT.random_E0 .AND. n_par(ener).GT.1) then
	if (n_par(ener).GT.1) then
	    write(parValues(pos+2:pos+10),'(F9.2)') parWert(ener)
	    pos = pos+11
	endif

c	if (.NOT.random_pos) then
	    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
c	endif

c	if (.NOT.random_angle) then
	    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
c	endif


	END


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


	OPTIONS /EXTEND_SOURCE

	SUBROUTINE OUTPUT_NEW_LOOP
c	==========================

	IMPLICIT NONE

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

	integer k, par_, iostat

	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
		RETURN
	    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,T45,'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='AC_'//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='ACCEL.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
			write(lun(indx),1000) art_Name(artNr)
		    else
			write(lun(indx),1001) par_text(par_)(1:10),
     +						  parWert(par_)
		    endif
		endif
	    enddo
1	    continue
	endif
1000	format (X,' >>> Projektil :',7X,A)
1001	format (X,' >>> ',A,': ',F10.3)
1002    format (X,' >>> ',I3,'. E0-Intervall:   [',F8.3,',',F8.3,']')


	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'

	integer k,zeile,par_
	integer GraphTextZeilen /15/

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


	graphText(1) = filename
	zeile = 2

	if (.NOT.OneStartPerLoop) then
	    write(graphText(zeile),900) SchleifenNr,SchleifenZahl
	    zeile = zeile + 1
	endif
900	format('Schleife  ',I5,'   von ',I6)

	graphText(zeile) = 'MAPPE =  '//mappenName

	if (OneStartPerLoop) then
	    graphText(zeile+1) = 'Ein Start pro Schleife, daher'
	    graphText(zeile+2) = 'alle Kurven in einer Graphik.'
	    zeile = zeile + 3
	endif

	do k=1, par_anzahl
	    par_ = reihenfolge(k)
	    if (par_.EQ.mass.AND.artList_defined) then 
		! nothing
	    elseif (par_.EQ.charge .AND. artList_defined) then
		write(graphText(zeile),1000) art_Name(artNr)
c	    elseif (par_.EQ.ener.AND.random_E0) then
c		write(graphText(zeile),*) 'Energie=   random'
c	    elseif (par_.EQ.yPos.AND.random_pos) then
c		write(graphText(zeile),*) 'Position=  random'
c	    elseif (par_.EQ.zPos.AND.random_pos) then
c		! nothing
c	    elseif (par_.EQ.thetAng.AND.random_angle) then 
c		write(graphText(zeile),*) 'Winkel=    random'
c	    elseif (par_.EQ.phiAng.AND.random_angle) then 
c		! nothing
	    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_),' +ran'
 	    else
		write(graphText(zeile),1001) par_text(par_)(1:10),
     +					  parWert(par_)
	    endif
	    zeile = zeile+1
	    if (zeile.EQ.15) then
		write(graphText(zeile)(28:30),'(A3)') '...'
		RETURN 
	    endif
	enddo

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 'accel$sourcedirectory:COM_ACCEL.INC'

	integer  k

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


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

c gib die Zeile mit den aktuellen Werte 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
	    write(lunPHYSICA,'(X,I6)') SchleifenNr
	    do k = 1, stat_Anzahl
		write(lunPHYSICA,1002)statMem(6,k),statMem(7,k),statMem(4,k),
     +			      statMem(5,k),statMem(9,k)
	    enddo
	endif

1002	format(X,F15.3,X,F15.3,X,F15.3,X,F15.3,X,F15.3)


	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'

	integer startNr			  ! = absolute Startnummer

	if (OneStartPerLoop) then
	    startNr = Start_Nr
	else
	    startNr =  (SchleifenNr-1)*n_par(0) + Start_nr
	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
 

	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

	INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'

	real    proz	! fuer Umrechnungen in Prozent

	integer k	! Zaehlvariable
	integer summe	! fuer Summenbildungen
	integer code_,ZahlDestiny


1000	format (X,A,:,T49,I6,'  (=',F5.1,'%)')	    ! destiny (gesamt)
1001	format (T5,A, T49,I6,'  (=',F5.1,'%)')	    ! destiny (je Gebiet)


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 Statistik:
c --------------

	proz = 100./start_nr

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

	do code_ = code_ok, smallest_code_Nr, -1    ! code_ok == 1
	    if (code_.EQ.code_ok .OR. statDestiny(code_).NE.0) then
		write(lun(indx),*)
		write(lun(indx),1000) code_text(code_),
     +		statDestiny(code_),statDestiny(code_)*proz
	    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
			write(lun(indx),1001) Gebiet_Text(gebiet),
     +			ZahlDestiny,ZahlDestiny*proz
		    endif
		enddo
	    endif
	enddo

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


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

3	continue	! 'fuer alle Ausgabekanaele ...' 


	END


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


	OPTIONS /EXTEND_SOURCE

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

	IMPLICIT NONE

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

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

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

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

	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)

	indx = lunScreen
1 	continue

	if (dtsmall_counter.GT.0) then
	    write(indx,1002) dtsmall_counter,dtsmall_counter*prozent
	    write(indx,1003) n_dtsmall_Max
	    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 ',I6,' Unterschreitungen von',
     +    ' dtsmall resettet)')
1005	format(x,'wegen steps > maxStep wurden ',I5,
     +    ' Trajektorienberechnungen abgebrochen',T73,'(',F5.1,'%)')

	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:

c - Ausgabe der Geometrie und der Mappencharacteristika:

	if (LogFile.OR.smallLogFile) then
	    if (debug) then
		write(lunLog,'(A)') ' Die Gebietsnummern:'
		write(lunLog,*)
		do k = 1, Gebiete_Anzahl
		    write (lunLog,1001) k,Gebiet_Text(k) 
		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 das NTP-File schliessen:

	call HROUT(idNTP,iostat,' ')	! NTP in Datei schreiben
	call HREND('ACCEL')		! HBOOK-Datei schliessen
	close(lunNTP)			! zugehoerige Fortran-Datei schliessen


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

	if (BATCH_MODE) then
	    if (INPUT_LIST) then
		open(lunMessage,file='AC_'//inputListName//'MESSAGE',defaultfile='SYS$SCRATCH:',
     +          status='UNKNOWN',iostat=iostat)
	    else
		open(lunMessage,file='ACCEL.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 MAKE_INFOFILE
c	========================

	IMPLICIT  NONE

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

	character*30 outfile
	integer	    i,j

	character*7 label(par_Anzahl)
	DATA label /
     +	  'U_Tgt_ ','U_Gua_ ','U_G1_  ','B_TD_  ','B_Helm_','Masse_ ','Ladung_',
     +	  'E0_    ','y0_    ','z0_    ','theta0_','phi0_  ' /

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

	outfile = fileName

c Gegebenenfalls schreiben des Files mit den E0-Intervallen:

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


c open INFO file:

	open (lunINFO,file=outfile,defaultfile=outDir//':.INFO',status='NEW')


c output information:

 	write (lunINFO,*)'========================================'//
     +		     '========================================'
	write(lunINFO,*)' This file contains the input parameters used for '//filename
 	write (lunINFO,*)'========================================'//
     +		     '========================================'
 	write (lunINFO,*)' The following parameters are the ones relevant for further'
	write (lunINFO,*)' calculations by MUTRACK:'
	write (lunINFO,*)
        write (lunINFO,*) '$acVersion'
	write (lunINFO,2600) 'accelVersion',version
	write (lunINFO,*) '$END'
	write (lunINFO,*)
 	write (lunINFO,*) '$loop_params'
	do j = 1, par_Anzahl
	    if ((j.EQ.mass.OR.j.EQ.charge).AND.artList_defined) then
		! keine Ausgabe
	    elseif (j.EQ.UGuard.AND..NOT.freeGuard) then
		! keine Ausgabe
	    else
		write (lunINFO,*) '  ',label(j),' = ',(par(i,j),i=1,3)
	    endif
	enddo
	write (lunINFO,*) '$END'
 	write (lunINFO,*)
	write (lunINFO,*) '$additionals'
	write (lunINFO,2601) 'par_Anzahl_prevSim',par_Anzahl
	write (lunINFO,2610) 'reihenfolge_prevSim',reihenfolge
	write (lunINFO,2600) 'mappenNameACCEL',mappenName
2610	format(3x,A,T25,'= ',20(x,I2,:))
	if (artList_defined) write (lunINFO,2601) 'artenZahl_prevSim',n_par(charge)
        write (lunINFO,*) '$END'
 	write (lunINFO,*)
        write (lunINFO,*) '$parameter_liste'
 	write (lunINFO,*)
 	write (lunINFO,2601) 'Startflaeche',Startflaeche
	if (startFlaeche.EQ.-1) write(lunINFO,2602)'x0_',x0(1)
        write (lunINFO,*)
	if (artList_defined) then
      	    write (lunINFO,2600) 'artList_prevSim',artlist
	else
      	    write (lunINFO,*) 'artList_prevSim'
	endif
	write (lunINFO,2603) 'UseDecay_prevSim',UseDecay
 	write (lunINFO,*)
        write (lunINFO,2601) 'randomStarts_prevSim',n_par(0)
	if (random_E0) then
	    if (random_E0_equal) then
		write(lunINFO,2601)'random_energy',1
		if (E0InterFromFile) write (lunINFO,2603) 'E0InterFromFile',E0InterFromFile
		write(lunINFO,2602)'lowerE0',lowerE0
		write(lunINFO,2602)'upperE0',upperE0
	    elseif (random_E0_gauss) then
		write(lunINFO,2601)'random_energy',2
		write(lunINFO,2602)'sigmaE0',sigmaE0
	    endif
	else
	    write(lunINFO,2601)'random_energy',0
	endif
	if (random_pos) then
	    if (random_y0z0_equal) then
		write(lunINFO,2601)'random_position',1
		write(lunINFO,2602)'StartBreite',StartBreite
		write(lunINFO,2602)'StartHoehe',StartHoehe
	    elseif (random_r0_equal) then
		write(lunINFO,2601)'random_position',2
		write(lunINFO,2602)'StartRadius',StartRadius
	    elseif (random_y0z0_Gauss) then
		write(lunINFO,2601)'random_position',3
		write(lunINFO,2602)'StartBreite',StartBreite
		write(lunINFO,2602)'StartHoehe',StartHoehe
		write(lunINFO,2602)'sigmaPosition',sigmaPosition
	    elseif (random_r0_Gauss) then
		write(lunINFO,2601)'random_position',4
		write(lunINFO,2602)'StartRadius',StartRadius
		write(lunINFO,2602)'sigmaPosition',sigmaPosition
	    endif
	else
	    write(lunINFO,2601)'random_position',0
	endif
	if (random_angle) then
	    if (random_lambert) then
		write(lunINFO,2601)'random_winkel',1
		write(lunINFO,2602)'StartLambertOrd',StartLambertOrd
	    elseif (random_gauss) then
		write(lunINFO,2601)'random_winkel',2
		write(lunINFO,2602)'sigmaWinkel',sigmaWinkel
	    endif
	else
	    write(lunINFO,2601)'random_winkel',0
	endif
 	write (lunINFO,*)
        write (lunINFO,*) '$END'
 	write (lunINFO,*)
	write (lunINFO,*)'========================================'//
     +               '========================================'
	write (lunINFO,*) 'The geometry:'
	write (lunINFO,*) 'All x-positions are RELATIVE TO THE CRYOSTAT CENTER,'
	write (lunINFO,*) 'All Dy- and Dz-values are HALF OF THE TOTAL SIZE!'
	write (lunINFO,*)
	write (lunINFO,*) '$geometry'
	write (lunINFO,*)
	if (scaleFactor.NE.1.) then
	    write (lunINFO,2500) 'SCALEFACTOR        = ', scaleFactor
	    write (lunINFO,*) '    ! => All data in this file regarding the geometry has to be multiplied'
	    write (lunINFO,*) '    ! by that factor!'
	    write (lunINFO,*)
	endif
	write (lunINFO,2500) 'xFoil              = ', xFoil
	write (lunINFO,*)
	write (lunINFO,2500) 'xEnd_TgtHolder     = ', xEnd_TgtHolder
	write (lunINFO,2500) 'innerDy1_TgtHolder = ', innerDy1_TgtHolder
	write (lunINFO,2500) 'innerDy2_TgtHolder = ', innerDy2_TgtHolder
	write (lunINFO,2500) 'outerDy_TgtHolder  = ', outerDy_TgtHolder
	write (lunINFO,2500) 'innerDz1_TgtHolder = ', innerDz1_TgtHolder
	write (lunINFO,2500) 'innerDz2_TgtHolder = ', innerDz2_TgtHolder
	write (lunINFO,2500) 'outerDz_TgtHolder  = ', outerDz_TgtHolder
	write (lunINFO,2500) 'Dy_Foil            = ', Dy_Foil
	write (lunINFO,2500) 'Dz_Foil            = ', Dz_Foil
	write (lunINFO,*)
	write (lunINFO,2500) 'xStart_Guardring   = ', xStart_Guardring
	write (lunINFO,2500) 'xEnd_Guardring     = ', xEnd_Guardring
	write (lunINFO,2500) 'innerDy_Guardring  = ', innerDy_Guardring
	write (lunINFO,2500) 'outerDy_Guardring  = ', outerDy_Guardring
	write (lunINFO,2500) 'innerDz_Guardring  = ', innerDz_Guardring
	write (lunINFO,2500) 'outerDz_Guardring  = ', outerDz_Guardring
	write (lunINFO,*)
	write (lunINFO,2500) 'xPosition_Grid1    = ', xPosition_Grid1
	write (lunINFO,2500) 'distance_wires1    = ', distance_wires1
	write (lunINFO,2500) 'dWires1            = ', dWires1
	write (lunINFO,2500) 'y_Pos_lastWire1    = ', y_Pos_lastWire1
	write (lunINFO,*)
	write (lunINFO,2500) 'xStart_Balken      = ', xStart_Balken
	write (lunINFO,2500) 'xEnd_Balken        = ', xEnd_Balken
	write (lunINFO,2500) 'Dy_Balken          = ', Dy_Balken
	write (lunINFO,2500) 'innerDz_Balken     = ', innerDz_Balken
	write (lunINFO,2500) 'outerDz_Balken     = ', outerDz_Balken
	write (lunINFO,*)
	write (lunINFO,2500) 'xStart_Gridframe1  = ', xStart_Gridframe1
	write (lunINFO,2500) 'xEnd_Gridframe1    = ', xEnd_Gridframe1
	write (lunINFO,2500) 'innerDy_Gridframe1 = ', innerDy_Gridframe1
	write (lunINFO,2500) 'outerDy_Gridframe1 = ', outerDy_Gridframe1
	write (lunINFO,2500) 'innerDz_Gridframe1 = ', innerDz_Gridframe1
	write (lunINFO,2500) 'outerDz_Gridframe1 = ', outerDz_Gridframe1
	write (lunINFO,*)
	write (lunINFO,2500) 'xPosition_Grid2    = ', xPosition_Grid2
	write (lunINFO,2500) 'distance_wires2    = ', distance_wires2
	write (lunINFO,2500) 'dWires2            = ', dWires2
	write (lunINFO,2500) 'y_Pos_lastWire2    = ', y_Pos_lastWire2
	write (lunINFO,*)
	write (lunINFO,2500) 'xStart_Gridframe2  = ', xStart_Gridframe2
	write (lunINFO,2500) 'xEnd_Gridframe2    = ', xEnd_Gridframe2
	write (lunINFO,2500) 'innerDy_Gridframe2 = ', innerDy_Gridframe2
	write (lunINFO,2500) 'outerDy_Gridframe2 = ', outerDy_Gridframe2
	write (lunINFO,2500) 'innerDz_Gridframe2 = ', innerDz_Gridframe2
	write (lunINFO,2500) 'outerDz_Gridframe2 = ', outerDz_Gridframe2
	write (lunINFO,*)
	write (lunINFO,2500) 'rHeShield          = ',rHeShield
	write (lunINFO,*)
	write (lunINFO,*) '$END'
	write (lunINFO,*)
	if (E0InterFromFile) then
	    write (lunINFO,*)'========================================'//
     +			 '========================================'
	    write (lunINFO,*) 'Boundaries of E0-Intervalls:'
	    do i = 1, nE0Inter+1
		write (lunINFO,'(4x,F8.3)') E0Low(i)
	    enddo
	endif
	write (lunINFO,*)'========================================'//
     +               '========================================'
 	write (lunINFO,*)' These parameters are just for your information:'
 	write (lunINFO,*)
        write (lunINFO,2600)  'MAPPENNAME',mappenname
 	write (lunINFO,*)
        write (lunINFO,2604) 'eps_x',eps_x
        write (lunINFO,2604) 'eps_v',eps_v
        write (lunINFO,2603) 'log_relativ',log_relativ
        write (lunINFO,2601) 'maxStep',maxStep
        write (lunINFO,2602) 'dtsmall',dtsmall
        write (lunINFO,2601) 'maxBelowDtSmall',maxBelowDtSmall
 	write (lunINFO,*)
 	write (lunINFO,*)' These dimensions of the He window (total size) have been used for graphics'
 	write (lunINFO,*)' or ''NTP_40mm'' purposes. They are not affecting any further calculations'
 	write (lunINFO,*)' by MUTRACK.'
 	write (lunINFO,*)
 	write (lunINFO,2602) 'dy_HeWindow',2*dy_HeWindow
 	write (lunINFO,2602) 'dz_HeWindow',2*dz_HeWindow
 	write (lunINFO,*)
	write (lunINFO,*)'========================================'//
     +		     '========================================'

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,'= ',L10)		! fuer logical
2604	format(3x,A,T25,'= ',E12.6)		! fuer Exponentdarstellung


	write (lunINFO,*)
2500	format(T6,A,F8.3)


c close INFO file:

	close (lunINFO)


	END


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