musrsim/accel/com/MAKE_E0_LIST.FOR

168 lines
5.2 KiB
Fortran

options /extend_source
program MAKE_E0_LIST
c ====================
implicit none
c===============================================================================
c Dieses Fortran-Programm erstellt Files 'E0-Intervalls.input_', die durch
c Editieren (falls noetig) und Umbenennen in 'E0-Intervalls.input' (ohne
c '_' am Ende) als entsprechende Eingabefiles fuer ACCEL verwendet werden
c koennen. Der Inhalt dieser Datei umfasst die Definition von Startenergie-
c intervallen, fuer die ACCEL-Simulationen durchgefuehrt werden sollen.
c
c Hierbei geht es um die Bereitstellung der fuer die Anpassung der Austritts-
c energie der langsamen MYonen benoetigten Simulationen.
c
c Der untere Wert des ersten Startenergieintervalles, die Breite des ersten
c Intervalles, und die Zunahme der Intervallbreite von einem zum naechsten
c Intervall sowie die Anzahl der so zu erstellenden Intervalle werden zunaechst
c eingelesen und die entsprechenden Daten in das Ausgabefile geschrieben.
c
c Um weiter Intervalle mit anderen Intervallbreiten-Incrementen anhaengen zu
c koennen, wird dann wiederum die Breite des ersten hinzuzufuegenden Intervalles
c sowie das neue Increment und die Anzahl damit anzuhaengender Intervalle
c eingelesen. Das wiederholt sich dann so lange, bis eine negative Zahl
c eingegeben wird. Dann wird das File geschlossen und das Programm beendet.
c
c Das File wird in 'ACCEL$READdirectory' erstellt
c
c Anselm Hofer
c===============================================================================
integer lunOUT
parameter (lunOUT = 10)
integer E0 /0/ ,E0Binwidth /2/ ,BinwidthIncr /0/
integer E0_ ,E0Binwidth_ ,BinwidthIncr_
integer nBins /20/, nBins_, i, lun, indx /1/, indx_
character*10 answer
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Oeffnen des Files:
open (lunOUT,file='E0-Intervalls.input_',status='new',
+ defaultFile='ACCEL$READdirectory')
write(lunOUT,*) '*==============================================================================='
write(lunOUT,*) '* In dieser Datei koennen (aneinandergrenzende) E0-Intervalle fuer ACCEL'
write(lunOUT,*) '* vorgegeben werden! Die Intervalle laufen dabei von der Angabe der i. bis'
write(lunOUT,*) '* zur Angabe der i+1. Datenzeile. Die DATENzeilen 2 bis n-1 geben also'
write(lunOUT,*) '* jeweils das Ende des einen sowie gleichzeitig den Anfang des anderen'
write(lunOUT,*) '* Intervalls an.'
write(lunOUT,*) '*'
write(lunOUT,*) '* Die E0-Angaben erfolgen in keV-Einheiten!'
write(lunOUT,*) '*'
write(lunOUT,*) '* Beispiel:'
write(lunOUT,*) '* Die Datenzeilen'
write(lunOUT,*) '*'
write(lunOUT,*) '* 0.010'
write(lunOUT,*) '* 0.040'
write(lunOUT,*) '* 0.100'
write(lunOUT,*) '*'
write(lunOUT,*) '* geben zwei E0-Intervalle an: von 10 eV bis 40 eV und von 40 eV bis 100 eV.'
write(lunOUT,*) '*'
write(lunOUT,*) '* eine Zeile mit mindestens 5 aufeinanderfolgenden x (''xxxxx'') markiert ge-'
write(lunOUT,*) '* gebenenfalls das Ende der Datenzeilen. Nachfolgende Zeilen werden ignoriert.'
write(lunOUT,*) '*'
write(lunOUT,*) '* Der Inhalt dieser Datei wird mit ''E0InterFromFile = .true.'' in ACCEL.INPUT'
write(lunOUT,*) '* aktiviert.'
write(lunOUT,*) '*==============================================================================='
1000 format ($,x,A,:' (.LT.0 => finish) [',I4,'] > ')
1001 format ($,x,A,:' [',I4,'] > ')
write(*,*)
write(*,*) 'alle Eingaben in eV!'
write(*,*)
write(*,1001) ' lower E0 ',E0
read(*,'(A)') answer
if (answer.NE.' ') read(answer,*) E0
write(lunOUT,'(x,F8.3)') real(E0) / 1000.
c Einlesen und Ausgeben ...:
10 write(*,*)
write(*,1000) ' first E0-Binwidth ',E0Binwidth
read(*,'(A)') answer
if (answer.NE.' ') read(answer,*) E0Binwidth
if (E0Binwidth.LE.0) goto 100
write(*,1000) ' Binwidth-increment ',BinwidthIncr
read(*,'(A)') answer
if (answer.NE.' ') read(answer,*) BinwidthIncr
if (BinwidthIncr.LT.0) goto 100
write(*,1000) ' number of bins to add ', nBins
read(*,'(A)') answer
if (answer.NE.' ') read(answer,*) nBins
if (nBins.LE.0) goto 100
E0_ = E0
E0Binwidth_ = E0Binwidth
BinwidthIncr_ = BinwidthIncr
nBins_ = nBins
indx_ = indx
lun = 6
write(*,*)
write(*,*) ' so, next intervalls would be: (number, lowerE0, upperE0, binWidth)'
write(*,*)
write(*,2000) indx,E0, E0 + E0BinWidth,E0BinWidth
2000 format (x,I3,': ',I5,'-',I5, 4x,'(',I4,')')
50 do i = 1, nBins
indx = indx + 1
E0 = E0 + E0BinWidth
if (lun.EQ.6) then
if (i.NE.nBins) write(*,2000) indx,E0, E0+E0BinWidth+BinwidthIncr,E0BinWidth+BinwidthIncr
else
write(lun,'(x,F8.3)') real(E0) / 1000.
endif
E0BinWidth = E0BinWidth + BinwidthIncr
enddo
if (lun.EQ.6) then
write(*,*)
write(*,1001) ' add them to file ? > '
read(*,'(A)') answer
call str$upcase(answer,answer)
E0 = E0_
E0Binwidth = E0Binwidth_
BinwidthIncr = BinwidthIncr_
nBins = nBins_
indx = indx_
if (index(answer,'Y').NE.0 .OR. index(answer,'J').NE.0) then
lun = lunOUT
goto 50
else
write(*,*) '=> cancel'
endif
endif
goto 10
c Schliessen des Ausgabefiles:
100 close (lunOUT)
write(*,*)
write(*,*) ' -> created file ''accel$READdirectory:E0-Intervalls.input_'''
write(*,*)
END