Added to repository.

mutrack/com/MAKE_CODENUMMERN-LIST.FOR

@@ -0,0 +1,70 @@
+
+	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	    	
+
+