OPTIONS /EXTEND_SOURCE

	PROGRAM WRITE_CODE_NUMBERS
c	==========================

c dieses Programm erstellt (nach neuem Kompilieren und Linken) eine jeweils
c aktuelle Liste der verwendeten Codenummern fuer die Gebiete und Teilchen-
c schicksale des Programmes 'MUTRACK' oder 'ACCEL':

	INCLUDE 'MAKE_CODENUMMERN_INCFILE1'

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

	INCLUDE 'MAKE_CODENUMMERN_INCFILE2'

	open(20,file='CODENUMMERN.LIST',defaultfile='MAKE_CODENUMMERN_OUTDIR',
     +	      status='NEW',carriagecontrol='LIST')

	call date(datum)
	call time(uhrzeit)

	write(20,*)'==============================================================================='
	write(20,10) datum,uhrzeit
10	format('  Erstellt am ',A,' um ',A,' durch ''MAKE_CODENUMMERN-LIST.FOR''')
	write(20,*)
	write(20,*)
	write(20,*) ' ========================================================='
	write(20,*) ' Die Code-Nummern fuer die verschiedenen Gebiete: ''Gebiet'''
	write(20,*) ' ========================================================='
	write(20,*)

	write(20,12) 0, 'auf Moderatorfolie'
	do i = 1, Gebiete_Anzahl
	    indx = index(Gebiet_text(i),':')
	    if (indx.NE.0) then
		write(20,11) i, Gebiet_text(i)(1:indx-1)
	    else
		write(20,11) i, Gebiet_text(i)
	    endif
	enddo
11	format(3x,i3,':'6x,A)
12	format(2x'(',i3,':'6x,A,')')

	write(20,*)
	write(20,*)
	write(20,*) ' =========================================================='
	write(20,*) ' Die Code-Nummern der moeglichen Teilchenschicksale: ''dest'''
	write(20,*) ' =========================================================='
	write(20,*)

	do i = smallest_code_Nr, highest_code_Nr
	    indx = index(code_text(i),':')
	    if (indx.NE.0) then
		write(20,11) i, code_text(i)(1:indx-1)
	    else
		write(20,11) i, code_text(i)
	    endif
	enddo

	write(20,*)
	write(20,*)'==============================================================================='

	close(20)


	END