musrsim/mutrack/com/MAKE_CODENUMMERN-LIST.FOR

71 lines
1.9 KiB
Fortran

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