Added to repository.

This commit is contained in:
prokscha 2005-03-22 10:33:08 +00:00
parent d1a54adc4a
commit bad53d7f6c
125 changed files with 42837 additions and 0 deletions

8
accel/com/ACCEL.COM Normal file
View File

@ -0,0 +1,8 @@
$! in case a privious submitted batchjob didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:ACCEL.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:ACCEL.MESSAGE.* /NOCON
$! run accel$EXEdirectory:ACCEL
$ ACCEL
$! in case ACCEL didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:ACCEL.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:ACCEL.MESSAGE.* /NOCON

View File

@ -0,0 +1,33 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
$! ARBEIT MIT ACCEL (ALS BATCH UND INTERAKTIV)
$!******************************************************************************
$ node = "PSW264"
$
$ define /trans=con accelSRC$directory "UD1:[simula.accel.]"
$ define accel$COMdirectory "accelSRC$directory:[com]"
$ define accel$MAPPENdirectory "UD1:[simula.mappen.accel]", -
"UD1:[simula.mappen.testmappen]", -
"UD2:[simula.mappen]"
$ define accel$EXEdirectory "accelSRC$directory:[exe]"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ ACCEL :== "RUN accel$EXEdirectory:ACCEL_''archi'.EXE"
$ ACDIR :== "dir accel$OUTdirectory:AC*.*.*
$ ACLIST :== "dir accel$OUTdirectory:AC*.LOG.
$ LSEAC :== "LSE accel$READdirectory:accel.input"
$ LSEACNR :== "LSE accel$NRdirectory:accel_nr.dat
$ ACSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS ACCEL AC CEL"
$ WRITEACLOG :== "@ accel$COMdirectory:WRITELOG.COM"
$ MAKEACCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM ACCEL _AC MAKE
$ ACCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM ACCEL _AC TYPE
$ ACCOPY :== "@ mutrack$COMdirectory:COPY.COM ACCEL AC"
$ MAKE_E0LIST :== "RUN accel$COMdirectory:MAKE_E0_LIST.EXE"
$!------------------------------------------------------------------------------
$ SUBAC*CEL :== -
"SUBMIT/NOTIFY/NOPRINT/NAME=ACCEL/LOG_FILE=accel$OUTdirectory accel$COMdirectory:ACCEL"
$ SUBACLIST*BATCH :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_BATCH"
$ SUBACLISTF*AST :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_FAST"
$ SUBACLISTS*LOW :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_SLOW"
$ SUBACLISTD*EAD :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_DEAD"
$!==============================================================================

11
accel/com/ACCEL_INIT.COM Normal file
View File

@ -0,0 +1,11 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
$! ARBEIT MIT ACCEL (ALS BATCH UND INTERAKTIV)
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
$!******************************************************************************
$ define accel$directory "UD1:[simula.accel.calc]"
$ define accel$READdirectory "accel$directory"
$ define accel$OUTdirectory "accel$directory"
$ define accel$NrDirectory "accel$directory"
$ accalc :== "SET DEF accel$directory"
$!==============================================================================

View File

@ -0,0 +1,19 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT LOGICALS UND SYMBOLS FUER DIE PROGRAMMIER-
$! ARBEIT, DAS KOMPILIEREN UND LINKEN VON ACCEL (INTERAKTIV)
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
$!******************************************************************************
$ define accel$OBJdirectory "accelSRC$directory:[EXE]"
$ OLDAC :== "define accel$SOURCEdirectory UD1:[SIMULA.ACCEL.OLD_SOURCE]"
$ NEWAC :== "define accel$SOURCEdirectory UD1:[SIMULA.ACCEL.SOURCE]"
$ NEWAC
$!------------------------------------------------------------------------------
$ ACCOM :== "SET DEF UD1:[SIMULA.ACCEL.COM]"
$ ACSOURCE :== "SET DEF accel$SOURCEdirectory"
$ ACMAP :== "SET DEF accel$MAPPENdirectory"
$ FORAC :== "@mutrack$COMdirectory:compile.com ACCEL _AC "
$ LINKAC :== "@accel$COMdirectory:linkac.com"
$ LINKACV :== "@accel$COMdirectory:linkacv.com"
$ LINKACD :== "@accel$COMdirectory:linkacd.com"
$ LINKACVD :== "@accel$COMdirectory:linkacvd.com"
$!==============================================================================

View File

@ -0,0 +1,6 @@
DEFINE VERB MakeWriteLogOut
IMAGE "accel$COMdirectory:MAKEWRITELOGOUT"
PARAMETER P1
LABEL = RUNNUMBER
VALUE (REQUIRED)
PROMPT = "vierstellige Runnummer"

1
accel/com/GETAC.COM Normal file
View File

@ -0,0 +1 @@
copy /log PSICLU::USR_SCROOT:[AHOFER]AC_'P1'.*. accel$OUTdirectory:*.*.

1
accel/com/GETACG.COM Normal file
View File

@ -0,0 +1 @@
copy /log PSICLU::USR_SCROOT:[GLUECKLER]AC_'P1'.*. accel$OUTdirectory:*.*.

31
accel/com/LINKAC.COM Normal file
View File

@ -0,0 +1,31 @@
$ set noverify
$ set noon
$!==============================================================================
$ prog= "accel"
$ ext = "_AC"
$!==============================================================================
$ sourceDir = "''prog'$SOURCEdirectory"
$ objectDir = "''prog'$OBJdirectory"
$ executeDir = "''prog'$EXEdirectory"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ ext = "''ext'_''archi'"
$ set verify
$!==============================================================================
$ link -
'objectDir':ACCEL'ext', -
'objectDir':SUB_ARTLIST'ext', -
'objectDir':SUB_INTEGR_1'ext', -
'objectDir':SUB_INTEGR_2'ext', -
'objectDir':SUB_INTEGR_3'ext', -
'objectDir':SUB_INTEGR_4'ext', -
'objectDir':SUB_INTEGR_5'ext', -
'objectDir':SUB_INTEGR_6'ext', -
'objectDir':SUB_INPUT'ext', -
'objectDir':SUB_PICTURE'ext', -
'objectDir':SUB_OUTPUT'ext',-
'cernlibs' /exe='executeDir':ACCEL_'archi'
$ purge 'executeDir':*.EXE
$ set on
$ set noverify
$!==============================================================================

16
accel/com/LINKACD.COM Normal file
View File

@ -0,0 +1,16 @@
$ set verify
$ link -
accel$directory:[exe]ACCEL, -
accel$directory:[exe]SUB_ARTLIST, -
accel$directory:[exe]SUB_INTEGR_1, -
accel$directory:[exe]SUB_INTEGR_2, -
accel$directory:[exe]SUB_INTEGR_3, -
accel$directory:[exe]SUB_INTEGR_4, -
accel$directory:[exe]SUB_INTEGR_5, -
accel$directory:[exe]SUB_INTEGR_6, -
accel$directory:[exe]SUB_INPUT, -
accel$directory:[exe]SUB_PICTURE, -
accel$directory:[exe]SUB_OUTPUT,-
'cernlibs' /debug /exe=accel$directory:[exe]accel
$ purge /log accel$directory:[exe]
$ set noverify

76
accel/com/LINKACV.COM Normal file
View File

@ -0,0 +1,76 @@
$ set noverify
$!==============================================================================
$! Author: Anselm Hofer
$!
$! Commandoprozedur fuer das Compilieren und Linken des kompletten ACCEL-
$! Quelltextes. Aufzurufen mittels '$ LINKACV'. ('V' steht fuer 'Vollstaendig').
$!==============================================================================
$ set noon
$!==============================================================================
$ prog= "accel"
$ ext = "_AC"
$!==============================================================================
$ sourceDir = "''prog'$SOURCEdirectory"
$ objectDir = "''prog'$OBJdirectory"
$ executeDir = "''prog'$EXEdirectory"
$!==============================================================================
$ options = "/fast /nolist"
$! options = "/fast /nolist /warn=nogeneral"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ ext = "''ext'_''archi'"
$ if archi .EQS. "VAX" then options = ""
$ if P1 .NES. "" then options = "''options' ''P1'"
$
$ file = "ACCEL"
$ CALL compile
$ file = "SUB_ARTLIST
$ CALL compile
$ file = "SUB_INTEGR_1
$ CALL compile
$ file = "SUB_INTEGR_2
$ CALL compile
$ file = "SUB_INTEGR_3
$ CALL compile
$ file = "SUB_INTEGR_4
$ CALL compile
$ file = "SUB_INTEGR_5
$ CALL compile
$ file = "SUB_INTEGR_6
$ CALL compile
$ file = "SUB_INPUT
$ CALL compile
$ file = "SUB_PICTURE
$ CALL compile
$ file = "SUB_OUTPUT
$ CALL compile
$!==============================================================================
$ set verify
$ purge 'objectDir':*.OBJ
$ link -
'objectDir':ACCEL'ext', -
'objectDir':SUB_ARTLIST'ext', -
'objectDir':SUB_INTEGR_1'ext', -
'objectDir':SUB_INTEGR_2'ext', -
'objectDir':SUB_INTEGR_3'ext', -
'objectDir':SUB_INTEGR_4'ext', -
'objectDir':SUB_INTEGR_5'ext', -
'objectDir':SUB_INTEGR_6'ext', -
'objectDir':SUB_INPUT'ext', -
'objectDir':SUB_PICTURE'ext', -
'objectDir':SUB_OUTPUT'ext',-
'cernlibs' /exe='executeDir':ACCEL_'archi'
$ purge 'executeDir':*.EXE
$ set on
$ set noverify
$ EXIT
$
$!==============================================================================
$
$ COMPILE: SUBROUTINE
$ comp = "fortran ''sourceDir':''file' ''options' /object=''objectDir':''file'''ext'"
$ write sys$output "=============================================================================="
$ write sys$output "''COMP'"
$ comp
$ ENDSUBROUTINE
$!==============================================================================

38
accel/com/LINKACVD.COM Normal file
View File

@ -0,0 +1,38 @@
$ set verify
$ fortran accel$SOURCEdirectory:accel /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_ARTLIST /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_INPUT /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_PICTURE /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ fortran accel$SOURCEdirectory:SUB_OUTPUT /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe]
$ link -
accel$directory:[exe]accel, -
accel$directory:[exe]SUB_ARTLIST, -
accel$directory:[exe]SUB_INTEGR_1, -
accel$directory:[exe]SUB_INTEGR_2, -
accel$directory:[exe]SUB_INTEGR_3, -
accel$directory:[exe]SUB_INTEGR_4, -
accel$directory:[exe]SUB_INTEGR_5, -
accel$directory:[exe]SUB_INTEGR_6, -
accel$directory:[exe]SUB_INPUT, -
accel$directory:[exe]SUB_PICTURE, -
accel$directory:[exe]SUB_OUTPUT,-
'cernlibs' /debug /exe=accel$directory:[exe]accel
$ purge /log accel$directory:[exe]
$ set noverify

38
accel/com/LINKACVDL.COM Normal file
View File

@ -0,0 +1,38 @@
$ set verify
$ fortran accel$SOURCEdirectory:accel /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_ARTLIST /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INPUT /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_PICTURE /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_OUTPUT /warn=nogen -
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
$ link -
accel$directory:[exe]accel, -
accel$directory:[exe]SUB_ARTLIST, -
accel$directory:[exe]SUB_INTEGR_1, -
accel$directory:[exe]SUB_INTEGR_2, -
accel$directory:[exe]SUB_INTEGR_3, -
accel$directory:[exe]SUB_INTEGR_4, -
accel$directory:[exe]SUB_INTEGR_5, -
accel$directory:[exe]SUB_INTEGR_6, -
accel$directory:[exe]SUB_INPUT, -
accel$directory:[exe]SUB_PICTURE, -
accel$directory:[exe]SUB_OUTPUT,-
'cernlibs' /debug /exe=accel$directory:[exe]accel
$ purge /log accel$directory:[exe]
$ set noverify

47
accel/com/LINKACVL.COM Normal file
View File

@ -0,0 +1,47 @@
$ set verify
$ fortran accel$SOURCEdirectory:ACCEL -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_ARTLIST -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$! fortran accel$SOURCEdirectory:SUB_INTEGR_7 -
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
$! fortran accel$SOURCEdirectory:SUB_INTEGR_8 -
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
$! fortran accel$SOURCEdirectory:SUB_INTEGR_9 -
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_INPUT -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_ACPIC -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ fortran accel$SOURCEdirectory:SUB_OUTPUT -
/warn=nogeneral /object=accel$directory:[exe] /d_line
$ link -
accel$directory:[exe]ACCEL, -
accel$directory:[exe]SUB_ARTLIST, -
accel$directory:[exe]SUB_INTEGR_1, -
accel$directory:[exe]SUB_INTEGR_2, -
accel$directory:[exe]SUB_INTEGR_3, -
accel$directory:[exe]SUB_INTEGR_4, -
accel$directory:[exe]SUB_INTEGR_5, -
accel$directory:[exe]SUB_INTEGR_6, -
$! accel$directory:[exe]SUB_INTEGR_7, -
$! accel$directory:[exe]SUB_INTEGR_8, -
$! accel$directory:[exe]SUB_INTEGR_9, -
accel$directory:[exe]SUB_INPUT, -
accel$directory:[exe]SUB_ACPIC, -
accel$directory:[exe]SUB_OUTPUT,-
'cernlibs' /exe=accel$directory:[exe]ACCEL
$ purge /log accel$directory:[exe]
$ set noverify

10
accel/com/LINKPS_MAP.COM Normal file
View File

@ -0,0 +1,10 @@
$ fortran p-source$directory:[source]SUB_INTEGR -
/warn=nogeneral /object=p-source$directory:[exe]
$ link -
p-source$directory:[exe]P-SOURCE, -
p-source$directory:[exe]SUB_ARTLIST, -
p-source$directory:[exe]SUB_INTEGR, -
p-source$directory:[exe]SUB_INPUT, -
p-source$directory:[exe]SUB_PPIC, -
p-source$directory:[exe]SUB_OUTPUT,-
'cernlibs' /exe=p-source$directory:[exe]p-source

View File

@ -0,0 +1,98 @@
OPTIONS /EXTEND_SOURCE
c PROGRAM WRITELOG
c ================
c===============================================================================
c Dieses Programm uebernimmt aus der Command Zeile eine Runnummer und
c uebertraegt den Header des zugehoerigen Logfiles in WRITELOG_nnnn.OUT.
c gleich wieder loescht.
c===============================================================================
IMPLICIT NONE
c Deklarationen fuer das Einlesen der Runnummer von der Commandline:
external cli$get_value
integer cli$get_value
integer status
character*4 runNumber
integer length
c sonstige Deklarationen:
character*80 zeile
integer i,iostat,marke
logical flag
c-------------------------------------------------------------------------------
c Lies Runnummer aus Commandline:
status = cli$get_value('runNumber',runNumber,length)
if (.NOT.status) call lib$signal(%val(status))
call str$trim(runNumber,runNumber,length)
c Oeffne zugehoeriges LOGfile:
open (20,file='accel$OUTdirectory:AC_'//runNumber//'.LOG',status='OLD',
+ readonly,iostat=iostat)
if (iostat.NE.0) then
write(*,*)
write(*,*)'can''t find accel$OUTdirectory:AC_'//runNumber//'.LOG'
write(*,*)'-> STOP'
write(*,*)
STOP
endif
c Oeffne WRITELOG_nnnn.OUT:
open (21,file='accel$OUTdirectory:WRITELOG_'//runNumber//'.OUT',
+ status='NEW')
c Uebertrage die Headerzeilen:
c do i = 1, 130
c read(20,'(A)',end=20) zeile
c write(21,'(xA)') zeile
c enddo
c write(21,*)
c write(21,*)' >>>>>>>>>> AUSDRUCK HIER ABGEBROCHEN >>>>>>>>>>'
c - Teste, ob LOGfile mehr als 140 Zeilen hat. Falls ja, drucke nur den
c Haeder. Andernfalls drucke das ganze Logfile
flag = .false.
marke = -10
do i = 1, 141
read(20,'(A)',end=10) zeile
if (index(Zeile,'>>>>> T E S T - R U N <<<<<').NE.0) marke = i
enddo
flag = .true. ! -> nur Headerzeilen schreiben
10 rewind (20)
do i = 1, 140
read(20,'(A)',end=20) zeile
if (flag .AND. index(Zeile,'>>> Schleife :').NE.0) goto 20
if (i.NE.marke .AND. i.NE.marke+1) then
write(21,'(xA)') zeile
endif
enddo
c Schliesse die Files:
20 close (20)
close (21)
END

167
accel/com/MAKE_E0_LIST.FOR Normal file
View File

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

49
accel/com/WRITELOG.COM Normal file
View File

@ -0,0 +1,49 @@
$! KOMMANDOPROZEDUR FUER DEN AUSDRUCK DER HEADERZEILEN VON 'AC_nnnn.LOG'-Dateien
$! =============================================================================
$!
$ SET NOON
$ SET NOVERIFY
$ SAY := WRITE SYS$OUTPUT
$ SET COMMAND accel$COMdirectory:DEF_MAKEWRITELOGOUT.CLD
$ ! FILE MIT HEADERZEILEN ERSTELLEN LASSEN:
$ IF P1 .EQS. ""
$ THEN
$ SAY "%WRITELOG: error: NO RUN NUMBER GIVEN IN COMMANDLINE"
$ EXIT
$ ENDIF
$ IF P1 .EQS. "?"
$ THEN
$ SAY " "
$ SAY " WRITEACLOG runNr [destinaton]"
$ SAY " "
$ SAY " destination not specified -> output to screen"
$ SAY " "
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (have to be given in upper case!)"
$ SAY " "
$ EXIT
$ ENDIF
$ IF (P2.NES."PSW04" .AND. P2.NES."PSW23" .AND. P2.NES."PRL" .AND. P2.NES."PRL2" .AND. P2.NES."")
$ THEN
$ SAY " "
$ SAY " ""''P2'"" is not an accepted destination!"
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (UPPER CASE ONLY!)"
$ SAY " "
$ EXIT
$ ENDIF
$!
$ MAKEWRITELOGOUT "''P1'"
$ OUTFILENAME = "accel$OUTdirectory:WRITELOG_" + "''P1'" + ".OUT;"
$ say "''outfilename'"
$ IF P2 .EQS. ""
$ THEN
$ TY 'OUTFILENAME'
$ DELETE /NOCON 'OUTFILENAME'
$ WRITE SYS$OUTPUT "================================================================================"
$ EXIT
$ ENDIF
$ IF (P2.EQS."PRL" .OR. P2.EQS."PRL2")
$ THEN
$ PRL2 'OUTFILENAME' /del
$ EXIT
$ ENDIF
$ VPP 'OUTFILENAME' /delete /dev=printer /form=listq /dest= "''P2'"

2377
accel/src/ACCEL.FOR Normal file

File diff suppressed because it is too large Load Diff

118
accel/src/ADD_MAP.INC Normal file
View File

@ -0,0 +1,118 @@
c===============================================================================
c ADD_MAP.INC
c===============================================================================
c Dieser Includefile erledigt fuer die Subroutinen 'ADD_MAP_Nr' das Einlesen
c der '_Tgt_Nr'-, der '_Gi1_Nr'- sowie gegebenenfalls der '_Gua_Nr'- Mappen
c und das Aufaddieren entsprechend den aktuellen Spannungen.
INCLUDE 'accel$sourcedirectory:COM_HVs.INC'
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
real read_memory(0:100)
COMMON /read_memory/ read_memory ! COMMON nur, damit nicht jede
! Mappe extra Speicher belegt.
integer i,j,k, ihelp, iostat
c Einlesen der '_Tgt_nr'-Potentialmappe:
if (mappenName.EQ.'RUN9') then
open (lunRead,file='RUN6_NEW_Tgt_'//Nr,
+ defaultfile=mappenDir//':.MAPPE',status='old',
+ form='unformatted',recl=imax+1,readonly)
c + form='unformatted',recl=imax,readonly)
else
open (lunRead,file=mappenName//'_Tgt_'//Nr,
+ defaultfile=mappenDir//':.MAPPE',status='old',
+ form='unformatted',recl=imax+1,readonly)
c + form='unformatted',recl=imax,readonly)
endif
write(*,*) 'constructing map '//Nr//' ...'
do k = 0, kmax
do j = 0, jmax
c read(lunREAD,iostat=iostat) (map(i,j,k),i=0,imax)
ihelp = (k*(jmax+1)+j)*(imax+1)
read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax)
if (iostat.NE.0) then
write(*,*)
write(*,999) i,j,k,iostat
STOP
endif
enddo
enddo
close(lunREAD)
999 format(x/'error reading grid point (i,j,k) = ('i4','i4','
+ i4')'/'iostat = 'i4/)
c Angleichen der Potentialmappe an UTgt:
ihelp = 0
do k=0, kmax
do j=0, jmax
do i=0, imax
c map(i,j,k) = UTgt*abs(map(i,j,k))
map(ihelp) = UTgt*abs(map(ihelp))
ihelp = ihelp + 1
enddo
enddo
enddo
c Einlesen und Addieren der '_Gua_nr'-Potentialmappe (mit 'UGua' multipliziert):
if (freeGuard) then
open (lunRead,file=mappenName//'_Gua_'//Nr,
+ defaultfile=mappenDir//':.MAPPE',status='old',
+ form='unformatted',recl=imax+1,readonly)
c + form='unformatted',recl=imax,readonly)
ihelp = 0
do k = 0, kmax
do j = 0, jmax
read(lunRead,iostat=iostat) (read_memory(i),i=0,imax)
if (iostat.NE.0) then
write(*,*)
write(*,999) i,j,k,iostat
STOP
endif
do i=0, imax
map(ihelp) = map(ihelp) + UGua*abs(read_memory(i))
ihelp = ihelp + 1
enddo
enddo
enddo
close(lunREAD)
endif
c Einlesen und Addieren der '_Gi1_nr'-Potentialmappe (mit 'UG1' multipliziert):
open (lunRead,file=mappenName//'_Gi1_'//Nr,
+ defaultfile=mappenDir//':.MAPPE',status='old',
+ form='unformatted',recl=imax+1,readonly)
c + form='unformatted',recl=imax,readonly)
ihelp = 0
do k = 0, kmax
do j = 0, jmax
read(lunRead,iostat=iostat) (read_memory(i),i=0,imax)
if (iostat.NE.0) then
write(*,*)
write(*,999) i,j,k,iostat
STOP
endif
do i=0, imax
c map(i,j,k) = map(i,j,k) + UG1*abs(read_memory(i))
map(ihelp) = map(ihelp) + UG1*abs(read_memory(i))
ihelp = ihelp + 1
enddo
enddo
enddo
close(lunREAD)
RETURN

View File

@ -0,0 +1,38 @@
c===============================================================================
c CALC_3D-FIELD_1
c===============================================================================
c Dieses Include-file wird in Unterprogramme 'EFELD_mappenname(x,E)' fuer die
c Berechnung von elektrischen Feldstaerken aus dreidimensionalen Potential-
c mappen eingebunden.
c Zusaetzlich zu diesem Includefile wird das Includefile 'CALC_3D-FIELD_2.INC'
c benoetigt.
real real_i,real_j,real_k ! x,y,z im Mappensystem in Gittereinheiten
integer stuetzstelle_i(2) ! naechste Stuetzstellen in x-,
integer stuetzstelle_j(2) ! y- und
integer stuetzstelle_k(2) ! z- Richtung
real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle
real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!)
real Abstand_k,Abstand_k_Betrag
integer i,j,k, n,m, ihelp
real x(3),E(3) ! Ort und Feldstaerke
real E_(2),E__(2) ! Hilfsspeicher fuer Feldberechnung
c Falls Testort ausserhalb der Mappe liegt oder Anode getroffen hat:
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
! 101: .... getroffene Elektroden

195
accel/src/CALC_FIELD_2.INC Normal file
View File

@ -0,0 +1,195 @@
c===============================================================================
c CALC_3D-FIELD_2
c===============================================================================
c Dieses Include-file wird in Unterprogramme 'EFELD_mappenname(x,E)' fuer die
c Berechnung von elektrischen Feldstaerken aus dreidimensionalen Potential-
c mappen eingebunden.
c Zusaetzlich zu diesem Includefile wird das Includefile 'CALC_3D-FIELD_1.INC'
c benoetigt.
c...............................................................................
c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt:
if (real_j.GT.jmax .OR. real_k.GT.kmax) then
returnCode_EFeld = 2
RETURN 1
elseif (real_i.GT.imax) then
if (real_i.LT.real(imax)+1.e-5) then
real_i = real(imax)
else
returnCode_EFeld = 1
RETURN 1
endif
elseif (real_i.LT.0.) then
if (real_i.GE.-.1e-4) then
real_i = 0.
else
c write(*,*)'x = ',x
c write(*,*)'real_i = ',real_i
c write(*,*)'xmin,xmax = ',xmin,xmax
c write(*,*)'dx_ = ',dx_
returnCode_EFeld = 3
RETURN 1
endif
endif
c Bestimme naechstgelegene Stuetzstellen (stuetzstelle_q(n)) und die
c Komponenten des Abstands-Gittervektors zur allernaechsten Stuetzstelle
c (Abstand_q) sowie deren Betraege:
stuetzstelle_i(1) = nint(real_i)
Abstand_i = real_i - stuetzstelle_i(1) ! Abstand zur naeheren Stuetzstelle
Abstand_i_Betrag = abs(Abstand_i)
if (Abstand_i.gt.0.) then
stuetzstelle_i(2) = stuetzstelle_i(1) + 1
elseif (Abstand_i.lt.0.) then
stuetzstelle_i(2) = stuetzstelle_i(1) - 1
else
stuetzstelle_i(2) = stuetzstelle_i(1)
endif
stuetzstelle_j(1) = nint(real_j)
Abstand_j = real_j - stuetzstelle_j(1)
Abstand_j_Betrag = abs(Abstand_j)
if (Abstand_j.gt.0.) then
stuetzstelle_j(2) = stuetzstelle_j(1) + 1
elseif (Abstand_j.lt.0.) then
stuetzstelle_j(2) = stuetzstelle_j(1) - 1
else
stuetzstelle_j(2) = stuetzstelle_j(1)
endif
stuetzstelle_k(1) = nint(real_k)
Abstand_k = real_k - stuetzstelle_k(1)
Abstand_k_Betrag = abs(Abstand_k)
if (Abstand_k.gt.0.) then
stuetzstelle_k(2) = stuetzstelle_k(1) + 1
elseif (Abstand_k.lt.0.) then
stuetzstelle_k(2) = stuetzstelle_k(1) - 1
else
stuetzstelle_k(2) = stuetzstelle_k(1)
endif
c...............................................................................
c Berechnen des elektrischen Feldes:
c ----------------------------------
c
c In dieser Version wird nicht mehr vorausgesetzt, dass das Potential auf den
c Mappenraendern Null ist!
c Bei der Berechnung der Feldstaerke ist angenommen, dass die xy-Ebene (k==0)
c und die xz-Ebene (j==0) Symmetrieebenen sind:
c
c map(i,-j,k) == map(i,j,k).
c map(i,j,-k) == map(i,j,k).
c
c Entlang j=0 ist also E(2)=0, entlang k=0 ist E(3)=0.
c
c (In der vorliegenden Version ist map(i,j,k) durch
c map( k*(jmax+1)*(imax+1) + j*(imax+1) + i) =
c map( (k*(jmax+1) + j)*(imax+1) + i)
c zu ersetzen!)
c (i,j,k laufen von 0 weg, ebenso wie die Indizierung von 'map')
c...............................................................................
c Berechne in den beiden naechstgelegenen k-Ebenen die x-Komponente der Feld-
c staerke. Danach berechne tatsaechlichen Wert aus linearer Interpolation. Um
c die Feldstaerken in den einzelnen k-Ebenen zu bekommen, interpoliere jeweils
c linear zwischen den Werten auf den beiden naechstgelegenen j-Ketten der
c jeweiligen k-Ebene:
i = stuetzstelle_i(1)
do m = 1, 2
k = stuetzstelle_k(m)
do n = 1, 2
j = stuetzstelle_j(n)
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
if (i.EQ.imax) then
c E__(n) = map(imax-1,j,k) - map(imax,j,k)
E__(n) = map(ihelp-1) - map(ihelp )
elseif (i.GT.0) then
c E__(n) = (-0.5+Abstand_i)*(map(i,j,k)-map(i-1,j,k))
c + + ( 0.5+Abstand_i)*(map(i,j,k)-map(i+1,j,k))
E__(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1))
+ + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1))
else
c E__(n) = map(0,j,k) - map(1,j,k)
E__(n) = map(ihelp) - map(ihelp+1)
endif
enddo
E_(m) = E__(1) + Abstand_j_Betrag*(E__(2)-E__(1))
enddo
E(1) = E_(1) + Abstand_k_Betrag*(E_(2)-E_(1))
E(1) = E(1) / Dx_ ! Reskalierung entsprechend x-Gitterkonstanten
c Berechne die y-Komponente der Feldstaerke:
j = stuetzstelle_j(1)
do m = 1, 2
k = stuetzstelle_k(m)
do n = 1, 2
i = stuetzstelle_i(n)
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
if (j.EQ.jmax) then
c E__(n) = map(i,jmax-1,k) - map(i,jmax,k)
E__(n) = map(ihelp-(imax+1)) - map(ihelp)
elseif (j.GT.0) then
c E__(n) = (-0.5+Abstand_j)*(map(i,j,k)-map(i,j-1,k))
c + + ( 0.5+Abstand_j)*(map(i,j,k)-map(i,j+1,k))
E__(n) = (-0.5+Abstand_j)*(map(ihelp)-map(ihelp-(imax+1)))
+ + ( 0.5+Abstand_j)*(map(ihelp)-map(ihelp+(imax+1)))
else ! j=0 -> map(i,j-1,k) = map(i,j+1,k) == map(i,1,k)
c E__(n) = 2.0*Abstand_j*(map(i,0,k)-map(i,1,k))
E__(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1)))
endif
enddo
E_(m) = E__(1) + Abstand_i_Betrag*(E__(2)-E__(1))
enddo
E(2) = E_(1) + Abstand_k_Betrag*(E_(2)-E_(1))
E(2) = E(2) / Dy_ ! Reskalierung entsprechend y-Gitterkonstanten
if (x(2).LT.0) E(2) = -E(2)
c Berechne die z-Komponente der Feldstaerke:
k = stuetzstelle_k(1)
do m = 1, 2
j = stuetzstelle_j(m)
do n = 1, 2
i = stuetzstelle_i(n)
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
if (k.EQ.kmax) then
c E__(n)= map(i,j,kmax-1) - map(i,j,kmax)
E__(n) = map(ihelp-(jmax+1)*(imax+1)) - map(ihelp)
elseif (k.GT.0) then
c E__(n) = (-0.5+Abstand_k)*(map(i,j,k)-map(i,j,k-1))
c + + ( 0.5+Abstand_k)*(map(i,j,k)-map(i,j,k+1))
E__(n) = (-0.5+Abstand_k)*(map(ihelp)-map(ihelp-(jmax+1)*(imax+1)))
+ + ( 0.5+Abstand_k)*(map(ihelp)-map(ihelp+(jmax+1)*(imax+1)))
else ! k=0 -> map(i,j,k-1) = map(i,j,k+1) == map(i,j,1)
c E__(n) = 2.0*Abstand_k*(map(i,j,0)-map(i,j,1))
E__(n) = 2.0*Abstand_k*(map(ihelp)-map(ihelp+(jmax+1)*(imax+1)))
endif
enddo
E_(m) = E__(1) + Abstand_i_Betrag*(E__(2)-E__(1))
enddo
E(3) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1))
E(3) = E(3) / Dz_ ! Reskalierung entsprechend z-Gitterkonstanten
if (x(3).LT.0) E(3) = -E(3)
cd write(18,*)'x,E = ',x,E
RETURN

View File

@ -0,0 +1,32 @@
===============================================================================
Erstellt am 17-JAN-99 um 17:52:07 durch 'MAKE_CODENUMMERN-LIST.FOR'
=========================================================
Die Code-Nummern fuer die verschiedenen Gebiete: 'Gebiet'
=========================================================
( 0: auf Moderatorfolie)
1: in 1. Beschl.Stufe
2: in 2. Beschl.Stufe
3: bis He-Schild
4: bis LN-Schild
==========================================================
Die Code-Nummern der moeglichen Teilchenschicksale: 'dest'
==========================================================
-5: Testort vor Potentialmappe
-4: Potentialmappe verlassen
-3: auf Gitter 2 aufgeschlagen
-2: auf Gitter 1 aufgeschlagen
-1: Targethalter getroffen
0: bis jetzt alles ok
1: zerfallen
2: reflektiert
3: aufgeschlagen
4: verloren (steps>maxsteps)
5: zu oft dt < dtSmall
===============================================================================

521
accel/src/COM_ACCEL.INC Normal file
View File

@ -0,0 +1,521 @@
c===============================================================================
c COM_ACCEL.INC
c===============================================================================
c
c===============================================================================
c I. Konstanten
c===============================================================================
c-------------------------------------------------------------------------------
c Die Versionsnummer
c-------------------------------------------------------------------------------
character*(*) version
parameter ( version = '2.0.0' )
c 1.2.1: Variablen 'dy_TgtHolder','dz_TgtHolder' durch 'outerDy_TgtHolder' und
c 'outerDz_TgtHolder' ersetzt. Variablen 'innerDij_TgtHolder' (i=y,z;
c j=1,2) neu eingefuehrt (fuer Targetgeometrie bei Run10).
c Die neuen Schleifenparmeter B_TD und B_Helm fuer die Magnetfelder von
c TD-Spule und Progen-Helmholtzspule neu eingefuehrt, jedoch noch keine
c Berechnungen implementiert.
c 1.2.2: 26-jan-1998: AH: implementation of 'adjustSigmaE0'
c 1.2.3: 02-feb-1998: AH: implementation of 'E0InterFromFile'
c 2.0.0: 22-jan-1998: AH: as Verwion 1.2.3. Renamed to 2.0.0 to flag that
c this is the last version maintained by A.H.
c-------------------------------------------------------------------------------
c Die Ausgabekanaele
c-------------------------------------------------------------------------------
integer lunREAD, lunScreen, lunLOG, lunNTP, lunPHYSICA, lunTMP
integer lunMESSAGE
integer lunINFO,lunStart,lunDecay,lunZwi1,lunZwi2
parameter ( lunScreen = 6 )
parameter ( lunTMP = 16 )
parameter ( lunREAD = 17 )
parameter ( lunLOG = 18 )
parameter ( lunNTP = 19 )
parameter ( lunPHYSICA = 20 )
parameter ( lunMESSAGE = 14 )
parameter ( lunINFO = 40 )
parameter ( lunStart = 41 )
parameter ( lunDecay = 42 )
parameter ( lunZwi1 = 43 )
parameter ( lunZwi2 = 44 )
c Die Tabellenfiles werden entsprechend ihrer Nummer den Ausgabeeinheiten
c (lunPHYSICA + 1) bis (lunPHYSICA + stat_Anzahl) zugeordnet.
c die id des Ausgabe-NTupels:
integer idNTP
parameter (idNTP = 5)
c-------------------------------------------------------------------------------
c Zuteilung der GebietsNummern k (0 <= k <= Gebiete_Anzahl)
c zu den Gebieten
c
c (Zuteilung muss mit Definition bei 'MUTRACK' uebereinstimmen (ansonsten waere
c in MUTRACK eine Uebersetzung notwendig)
c-------------------------------------------------------------------------------
integer target,upToGrid1,upToGrid2,upToHeShield,upToLNShield
c GEBIET 'k'
parameter ( target = 0 ) ! <- zaehlt nicht fuer 'Gebiete_Anzahl'!
parameter ( upToGrid1 = 1 )
parameter ( upToGrid2 = 2 )
parameter ( upToHeShield= 3 )
parameter ( upToLNShield= 4 )
integer Gebiete_Anzahl
parameter ( Gebiete_Anzahl=4 ) ! <- Startpkt 'Target' zaehlt nicht !!
character Gebiet_Text(Gebiete_Anzahl)*40
COMMON Gebiet_Text
c-------------------------------------------------------------------------------
c Zuteilungen der Schleifenparameter zu den Feldelemenkten k
c (1 <= k <= par_Anzahl) von par(i,k), n_par(k), parWert(k), par_text(k)
c-------------------------------------------------------------------------------
integer UTarget,UGuard, UGi1, BTD,BHelm, mass,charge,
+ ener,yPos,zPos,thetAng,phiAng
c PARAMETER 'k'
parameter ( UTarget = 1 )
parameter ( UGuard = 2 )
parameter ( UGi1 = 3 )
parameter ( BTD = 4 )
parameter ( BHelm = 5 )
parameter ( mass = 6 )
parameter ( charge = 7 )
parameter ( ener = 8 )
parameter ( yPos = 9 )
parameter ( zPos = 10 )
parameter ( thetAng = 11 )
parameter ( phiAng = 12 )
integer par_Anzahl
parameter ( par_Anzahl=12) ! <- 'Zufalls-Schleife' zu k=0 zaehlt nicht!
c-------------------------------------------------------------------------------
c Code-Nummern fuer das Schicksal des Teilchens
c-------------------------------------------------------------------------------
integer code_vor_Mappe,code_neben_Mappe
integer code_hit_grid2,code_hit_grid1,code_hit_TgtHolder
integer code_ok
integer smallest_code_Nr
integer code_decay,code_reflektiert,
+ code_wand,code_lost,code_dtsmall
c SCHICKSAL 'code'
parameter ( smallest_code_Nr = -5 )
parameter ( code_vor_Mappe = -5 )
parameter ( code_neben_Mappe = -4 )
parameter ( code_hit_grid2 = -3 )
parameter ( code_hit_grid1 = -2 )
parameter ( code_hit_TgtHolder = -1 )
parameter ( code_ok = 0 )
parameter ( code_decay = 1 )
parameter ( code_reflektiert = 2 )
parameter ( code_wand = 3 )
parameter ( code_lost = 4 )
parameter ( code_dtsmall = 5 )
integer highest_code_Nr
parameter ( highest_code_Nr = 5 )
character code_Text(smallest_code_Nr:highest_code_Nr)*27
COMMON code_text
c-------------------------------------------------------------------------------
c Zuteilung der Statistiken zu den Feldelementen k ( 1<= k <= stat_Anzahl)
c von statInMemory(k),createTabelle(k),statNeeded(k),statMem(i,k)
c-------------------------------------------------------------------------------
integer Nr_S1M2
c STATISTIK 'k'
parameter ( Nr_S1M2 = 1 )
integer Stat_Anzahl
parameter (Stat_Anzahl = 1)
c===============================================================================
c II. Variablen in Commonbloecken
c===============================================================================
c-------------------------------------------------------------------------------
c die Gebietsnummer
c-------------------------------------------------------------------------------
integer Gebiet0 ! GebietsNummer beim Start
integer Gebiet ! aktuelle GebietsNummer
integer StartFlaeche
COMMON Gebiet0, StartFlaeche
c-------------------------------------------------------------------------------
c zufallsverteilte Startparameter
c-------------------------------------------------------------------------------
c Energie:
logical random_E0 ! Zufallsverteilung fuer Startenergie?
integer random_energy ! welche Verteilung fuer Startenergie?
logical random_E0_equal ! gleichverteilte Startenergie
real lowerE0,upperE0 ! Grenzen fuer Zufallsverteilung
logical random_E0_gauss ! gaussverteilte Startenergie
real sigmaE0 ! Breite der Gaussverteilung
logical adjustSigmaE0 /.false./
logical e0InterFromFile /.FALSE./
real E0Low(101)
integer nE0Inter
c Position:
logical random_pos ! Zufallsverteilung fuer Startposition?
integer random_position ! welche Verteilung fuer Startposition?
logical random_y0z0_equal ! gleichverteilt auf Viereckflaeche
logical random_r0_equal ! gleichverteilt auf Kreisflaeche
logical random_y0z0_Gauss ! Gauss-verteilt auf Viereckflaeche
logical random_r0_Gauss ! Gauss-verteilt auf Kreisflaeche
real StartBreite,StartHoehe,StartRadius, sigmaPosition
c Winkel:
logical random_angle ! Zufallsverteilung fuer Startwinkel?
integer random_winkel ! welche Verteilung fuer Startwinkel?
logical random_lambert ! Lambert-Verteilung
logical random_gauss ! Gauss-Verteilung
real StartLambertOrd
real SigmaWinkel ! Breite der Gaussverteilung
logical ener_offset,pos_offset,angle_offset ! Falls Zufallsverteilung
! mit durch Startparameter vorgegebenen
! Offsets
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON random_E0,random_energy,random_E0_equal,lowerE0,upperE0
COMMON random_E0_gauss,sigmaE0,adjustSigmaE0
COMMON random_pos,random_position,random_y0z0_equal,
+ random_r0_equal,random_y0z0_Gauss,random_r0_Gauss,
+ StartBreite,StartHoehe,StartRadius,sigmaPosition
COMMON e0InterFromFile,nE0Inter,E0Low
COMMON random_angle,random_winkel,random_lambert,random_gauss
COMMON StartLambertOrd,sigmaWinkel
COMMON ener_offset,pos_offset,angle_offset
c-------------------------------------------------------------------------------
c Schleifen-Parameter
c-------------------------------------------------------------------------------
c (par(n,0) wird fuer die 'Zufallsschleife' verwendet)
real par(3,0:par_Anzahl) ! min, max und step der ParameterSchleifen
integer n_par(0:par_Anzahl) ! die Anzahl unterschiedl. Werte je Schleife
real parWert(par_Anzahl) ! der aktuelle Wert der Schleifenvariablen
character par_text(par_Anzahl)*22 ! Beschreibung jeder Variablen fuer Ausgabezwecke
integer reihenFolge(par_Anzahl) ! Enthaelt die Reihenfolge der
! Abarbeitung der Schleifenparameter
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON par, parWert, n_par, par_text, reihenfolge
c-------------------------------------------------------------------------------
c die Teilchenarten (artList)
c-------------------------------------------------------------------------------
integer Arten_Zahl ! Anzahl der bekannten Arten
parameter (Arten_Zahl = 36)
character*4 art_Name(Arten_Zahl) ! Bezeichnungen der bekannten Arten
real art_Masse(Arten_Zahl) ! Massen der bekannten Arten
real art_Ladung(Arten_Zahl) ! Ladungen der bekannten Arten
character artList*50 ! Liste zu startender Teilchen
logical artList_defined ! wurde 'artList' gesetzt?
logical mu_flag ! signalisiert, ob Myon-Teilchen erkannt wurde
integer artenMax ! Maximalzahl in 'artList'
parameter (artenMax = 9) ! akzeptierter Arten
integer art_Nr(artenMax) ! die in artList enthaltenen Arten
integer artNr ! die Nummer der aktuellen Art
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON art_Name,art_Masse,art_Ladung
COMMON artList,artList_defined,mu_flag
COMMON art_Nr,artNr
c-------------------------------------------------------------------------------
c Programmsteuerung
c-------------------------------------------------------------------------------
real scaleFactor ! Skalierungsfaktor fuer die Beschleuniger-
! geometrie
logical UseDecay ! MYONEN-Zerfall beruecksichtigen?
logical UseDecay_ ! MYONEN-Zerfall beruecksichtigen und Art ist myon?
logical DEBUG ! DEBUG-Ausgabe?
integer DEBUG_Anzahl ! fuer wieviele Starts je Schleife sollen
! (so ueberhaupt) DEBUG-Informationen ausgegeben
! werden? (in COMMON /output/)
logical DEBUG_ ! DEBUG .AND. startNr.LE.DEBUG_Anzahl
logical notLastLoop ! aktuelle Schleife ist nicht letzte Schleife
logical BATCH_MODE ! -> keine Graphikausgabe auf Schirm; keine
! Ausgabe der Prozentzahl schon gerechneter
! Trajektorien
logical INPUT_LIST ! spezielle Version eines Batch-Runs
integer ListLength !
logical gotFileNr !
character inputListName*20
logical HVs_from_map ! sollen die Mappen-intrinsischen HVs verwendet werden?
! (bei Mappen, die fuer feste HVs gerechnet wurden)
logical TestRun ! 'true' -> RunNummern zwischen 9900 und 9999
logical log_confine ! Begrenze Schrittweite in Integrationsgebieten
! -> 'dl_max_...'
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON /scaleFactor/ scaleFactor
COMMON UseDecay,UseDecay_
COMMON DEBUG,DEBUG_
COMMON notLastLoop
COMMON BATCH_MODE,INPUT_LIST,ListLength,gotFileNr,inputListName
COMMON HVs_from_map,TestRun,log_confine
c-------------------------------------------------------------------------------
c Graphikausgabe
c-------------------------------------------------------------------------------
logical graphics ! graphische Ausgabe?
integer graphics_Anzahl ! fuer wieviele Starts je Schleife?
logical graphics_ ! GRAPHICS .AND. startNr.LE.GRAPHICS_Anzahl
integer n_postSkript ! PostSkript-files erstellen?
integer iMonitor ! Abtastfrequenz fuer Graphik und Debug (jeder
! wievielte Schritt wird ausgegeben)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON graphics,graphics_Anzahl,graphics_
COMMON n_postSkript, iMonitor
c-------------------------------------------------------------------------------
c FileName
c-------------------------------------------------------------------------------
character filename*20 ! Name der Ausgabe-Dateien
character mappenName*25 ! Namenskern der Potentialmappen
integer nameLength ! reale Laenge von 'mappenName'
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON filename
COMMON /mappenName/ mappenName, NameLength
c-------------------------------------------------------------------------------
c Vorgaben fuer das Summary (.LOG-file)
c-------------------------------------------------------------------------------
integer n_outWhere ! LogFile auf welche Ausgabekanaele geben?
logical LogFile ! Logfile erstellen?
logical smallLogFile ! minimalversion des Logfiles erstellen?
logical statsInSummary ! Statistiken in das Summary?
logical statInSummary(Stat_Anzahl) ! welche Statistiken in das Summary?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON n_outWhere
COMMON LogFile,smallLogFile
COMMON statsInSummary,statInSummary
c-------------------------------------------------------------------------------
c WELCHE FILES sollen erzeugt werden?
c-------------------------------------------------------------------------------
logical createPhysTab ! PAW-Gesamt-Tabelle (.PAW) erzeugen?
logical NTP_Misc ! SchleifenNr,StartNr,Mappe,Steps ins NTupel?
logical NTP_start ! Die Startgroessen ...?
logical NTP_stop ! Die Stopgroessen ...?
logical NTP_40mm ! Die auf x = 40 mm extrapolierte Ort ...?
logical createTabellen ! Tabellen-files erzeugen?
logical createTabelle(Stat_Anzahl) ! welche Tabellen-files erzeugen?
character statName(stat_Anzahl)*9 ! Tabellenfile-Ueberschriften
character TabExt(stat_Anzahl)*9 ! Extensions der Tabellenfiles
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON createPhysTab
COMMON NTP_Misc,NTP_start,NTP_stop,NTP_40mm
COMMON createTabellen,createTabelle,statName,TabExt
c-------------------------------------------------------------------------------
c Fehlerkontrolle
c-------------------------------------------------------------------------------
real eps_x ! Fehlertoleranz bei Ortsberechnung
real eps_v ! Fehlertoleranz bei Geschw.Berechnung
logical log_relativ ! relative Fehlerbetrachtung?
integer maxStep ! maximale Anzahl an Integrationsschritten
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON eps_x,eps_v,log_relativ
COMMON maxStep
c-------------------------------------------------------------------------------
c haeufig benutzte Faktoren
c-------------------------------------------------------------------------------
real Energie_Faktor ! Faktor bei Berechn. der Energie aus der Geschw.
real Beschl_Faktor ! Faktor bei Berechn. der Beschleunigung im EFeld
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON Energie_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
c-------------------------------------------------------------------------------
c Programmablauf
c-------------------------------------------------------------------------------
real x0(3),v0(3),E0 ! Startort, -geschwindigkeit und -energie
real lifetime ! individuelle Myon-Lebensdauer [ns]
real theta0 ! 3D-Startwinkel gegen x_Achse
real phi0 ! azimuthaler Startwinkel (y-Achse:0, z-Achse:90)
real x(3),t,v(3) ! Ort, Zeit, Geschwindigkeit
integer destiny ! die Codezahl fuer das Schicksal des Teilchens
integer lastMap ! die Nummer der letzten Potentialmappe fuer
! individuelle Teilchen
integer start_nr ! Startnummer des Teilchen (je Schleife)
integer GesamtZahl ! Gesamtzahl der Teilchen (ueber alle Schleifen)
integer SchleifenZahl ! Anzahl durchzufuehrender Schleifen
integer SchleifenNr ! Nummer der aktuellen Schleife
integer Steps ! Nummer des Integrationssteps (je Teilchen)
integer seed ! fuer Zufallsgenerator
real dtsmall ! kleinster Zeitschritt fuer Integrationen
integer maxBelowDtSmall ! max. tolerierte Anzahl an Unterschreitungen von
! dtsmall
integer n_dtSmall ! wie oft hat einzelnes Teilchen dtSmall unterschritten
integer n_dtsmall_Max ! groesste aufgetretene Anzahl an Unterschreitungen
! (ueber alle Schleifen)
integer dtsmall_counter ! wieviele Teilchen haben dtsmall unterschritten
integer Lost_counter ! wieviele Teilchen wurden wegen steps>maxSteps
! verlorengegebe
logical OneLoop ! genau eine Schleife
logical OneStartPerLoop ! Zufallsschleife macht genau einen Durchlauf
logical reachedEndOfMap, backOneMap
logical log_percent
logical freeGuard ! Spannung am Guardring separat?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Die benannten Common-Bloecke sind teilweise fuer die NTupelausgabe noetig!
c COMMON /STARTPARAMETER/ x0,v0,E0,theta0,phi0
COMMON /x0/ x0
COMMON /v0/ v0
COMMON /E0/ E0
COMMON /angle0/ theta0,phi0
COMMON /lifeTime/ lifetime
COMMON /TRAJEKTORIE/ t,x,v
COMMON /basics/ SchleifenNr,start_Nr,lastMap,steps
COMMON /gebiet/ gebiet,destiny
COMMON GesamtZahl,SchleifenZahl
COMMON dtsmall, maxBelowDtSmall, n_dtsmall, n_dtsmall_Max, dtsmall_counter
COMMON Lost_counter
COMMON OneLoop, OneStartPerLoop
COMMON /seed/ seed ! COMMON /seed/ ist auch in manchen Subroutinen
! explizit gesetzt! -> wird benoetigt!
COMMON reachedEndOfMap,backOneMap
COMMON log_percent
COMMON freeGuard
c-------------------------------------------------------------------------------
c Statistik
c-------------------------------------------------------------------------------
real Koord_NTP(8,0:Gebiete_Anzahl) ! Koordinatenspeicher fuer NTP-Ausgabe
integer statDestiny(smallest_code_Nr:Gebiete_Anzahl*highest_code_Nr)
! Statistik der Teilchenschicksale
real statMem(9,stat_Anzahl) ! Statistiken von Flugzeiten ext.
logical statNeeded(stat_Anzahl) ! welche Statistiken muessen fuer die
! geforderten Informationen gefuehrt werden?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON /KOORD_NTP/ Koord_NTP
COMMON statDestiny
COMMON statMem,statNeeded
c-------------------------------------------------------------------------------
c Datenausgabe
c-------------------------------------------------------------------------------
integer lun(2), indx
integer indx1, indx2
COMMON /OUTPUT/ lun, indx1,indx2,indx, DEBUG_Anzahl

9
accel/src/COM_BS.INC Normal file
View File

@ -0,0 +1,9 @@
c===============================================================================
c COM_Bs.INC
c===============================================================================
c the magnetic fields:
real B_TD, B_Helm
COMMON /BFields/ B_TD, B_Helm

15
accel/src/COM_DIRS.INC Normal file
View File

@ -0,0 +1,15 @@
c-------------------------------------------------------------------------------
c COM_DIRS.INC
c-------------------------------------------------------------------------------
c Die verwendeten Directories:
character*40 MappenDir,readDir,outDir,NrDir,TMPDir
parameter (MappenDir='accel$MAPPENDirectory' )
parameter (readDir ='accel$READdirectory' )
parameter (outDir ='accel$OUTdirectory' )
parameter (NrDir ='accel$NrDirectory' )
parameter (TMPDir ='SYS$SCRATCH' )

86
accel/src/COM_GEO.INC Normal file
View File

@ -0,0 +1,86 @@
c===============================================================================
c COM_GEO.INC
c===============================================================================
c the geometry:
c all Dy_... and Dz_... values are half of the total extension.
c When read in, all x-positions are relative to the moderator foil but they
c are immediately converted to be relative to the center of the cryostat.
c - moderator:
real xFoil
real Dy_Foil, Dz_Foil
real xEnd_TgtHolder
real outerDy_TgtHolder /-1.E10/, outerDz_TgtHolder /-1.E10/
real innerDy1_TgtHolder /-1.E10/, innerDy2_TgtHolder /-1.E10/
real innerDz1_TgtHolder /-1.E10/, innerDz2_TgtHolder /-1.E10/
c - guardring:
real xStart_Guardring, xEnd_Guardring
real innerDy_Guardring, outerDy_Guardring
real innerDz_Guardring, outerDz_Guardring
c - first grid:
real xPosition_Grid1, distance_wires1, y_Pos_firstWire1 /0./,y_Pos_lastWire1
real dWires1, rWires1, rQuadWires1
real xStart_Gridframe1, xEnd_Gridframe1
real innerDy_Gridframe1, outerDy_Gridframe1
real innerDz_Gridframe1, outerDz_Gridframe1
real xStart_Balken, xEnd_Balken
real Dy_Balken
real innerDz_Balken, outerDz_Balken
c - second grid:
real xPosition_Grid2, distance_wires2, y_Pos_firstWire2 /0./,y_Pos_lastWire2
real dWires2, rWires2, rQuadWires2
real xStart_Gridframe2, xEnd_Gridframe2
real innerDy_Gridframe2, outerDy_Gridframe2
real innerDz_Gridframe2, outerDz_Gridframe2
c - He-shield:
real xHeShield ! xHeShield = - xFoil (-> relative Positionen)
real rHeShield ! Radius
real dy_HeWindow
real dz_HeWindow
c x coordinates of beginnings and ends of the individual maps:
real xStartMap1,xStartMap2,xStartMap3,xStartMap4,xStartMap5,xStartMap6
real xEndMap1, xEndMap2, xEndMap3, xEndMap4, xEndMap5, xEndMap6
c the common blocks:
c (the common blocks /map_%/ are actually bigger. But only the first two
c variables are necessary here)
COMMON /map_1/ xStartMap1,xEndMap1
COMMON /map_2/ xStartMap2,xEndMap2
COMMON /map_3/ xStartMap3,xEndMap3
COMMON /map_4/ xStartMap4,xEndMap4
COMMON /map_5/ xStartMap5,xEndMap5
COMMON /map_6/ xStartMap6,xEndMap6
COMMON /xFoil/ xFoil
COMMON /MAP_AND_TGT/
+ Dy_Foil,Dz_Foil,
+ xEnd_TgtHolder,outerDy_TgtHolder,outerDz_TgtHolder,
+ innerDy1_TgtHolder,innerDy2_TgtHolder,innerDz1_TgtHolder,innerDz2_TgtHolder,
+ xStart_Guardring,xEnd_Guardring,innerDy_Guardring,outerDy_Guardring,
+ innerDz_Guardring,outerDz_Guardring,
+ xPosition_Grid1,distance_wires1,dWires1,rQuadWires1,rWires1,
+ y_Pos_firstWire1,y_Pos_lastWire1,
+ xStart_Balken,xEnd_Balken,Dy_Balken,
+ innerDz_Balken,outerDz_Balken,
+ xStart_Gridframe1,xEnd_Gridframe1,innerDy_Gridframe1,outerDy_Gridframe1,
+ innerDz_Gridframe1,outerDz_Gridframe1,
+ xPosition_Grid2,distance_wires2,dWires2,rQuadWires2,rWires2,
+ y_Pos_firstWire2,y_Pos_lastWire2,
+ xStart_Gridframe2,xEnd_Gridframe2,innerDy_Gridframe2,outerDy_Gridframe2,
+ innerDz_Gridframe2,outerDz_Gridframe2,
+ xHeShield,rHeShield,dy_HeWindow,dz_HeWindow

10
accel/src/COM_HVS.INC Normal file
View File

@ -0,0 +1,10 @@
c===============================================================================
c COM_HVs.INC
c===============================================================================
c the voltages:
real zero, UTgt, UGua, UGrid1, UG1, UG2
COMMON /voltages/ zero, UTgt, UGua, UGrid1, UG1, UG2

276
accel/src/INITIALIZE.INC Normal file
View File

@ -0,0 +1,276 @@
c===============================================================================
c INITIALIZE.INC
c===============================================================================
c die Spezifizierungen der Schleifen-Parameter (character*22):
par_text(UTarget) = 'U(Target) [kV] : '
par_text(UGuard ) = 'U(Guard) [kV] : '
par_text(UGi1 ) = 'U(Gitter1)[kV] : '
par_text(BTD ) = 'B(TD) [Gauss] : '
par_text(BHelm ) = 'B(Helmh.) [Gauss] : '
par_text(mass ) = 'Masse [keV/c**2]: '
par_text(charge ) = 'Ladung [e] : '
par_text(ener ) = 'Energie [keV] : '
par_text(yPos ) = 'y0 [mm] : '
par_text(zPos ) = 'z0 [mm] : '
par_text(thetAng) = 'theta0 [degree] : '
par_text(phiAng ) = 'phi0 [degree] : '
c die Gebiets-Bezeichnungen (character*40):
Gebiet_Text(upToGrid1) = 'in 1. Beschl.Stufe:'
Gebiet_Text(upToGrid2) = 'in 2. Beschl.Stufe:'
Gebiet_Text(upToHeShield) = 'bis He-Schild:'
Gebiet_Text(upToLNShield) = 'bis LN-Schild:'
c die Bezeichnungen fuer die moeglichen Teilchenschicksale (character*26):
code_text(code_vor_Mappe ) = 'Testort vor Potentialmappe: '
code_text(code_neben_Mappe ) = 'Potentialmappe verlassen: '
code_text(code_hit_grid2 ) = 'auf Gitter 2 aufgeschlagen: '
code_text(code_hit_grid1 ) = 'auf Gitter 1 aufgeschlagen: '
code_text(code_hit_TgtHolder ) = 'Targethalter getroffen: '
code_text(code_OK ) = 'bis jetzt alles ok: '
code_text(code_decay ) = 'zerfallen: '
code_text(code_reflektiert ) = 'reflektiert: '
code_text(code_wand ) = 'aufgeschlagen: '
code_text(code_lost ) = 'verloren (steps>maxsteps): '
code_text(code_dtsmall ) = 'zu oft dt < dtSmall: '
c die Ueberschriften der Tabellen-files (character*9):
statName(Nr_S1M2) = 'S1M2 '
c die Extensions der Tabellen-files (character*9):
TabExt(Nr_S1M2) = '._S1M2 '
c die Reihenfolge, in welcher die Schleifen der 'Schleifenparameter' par(i,k)
c im Hauptprogramm abgearbeitet werden:
DATA reihenfolge /
+ UTarget,UGuard,UGi1, BHelm,BTD, mass,charge,
+ ener,thetAng,phiAng,yPos,zPos /
c====== Initialisierungen fuer die benutzerdefinierbaren Parameter ============
c Das Startgebiet 'Gebiet0' wird indirekt im SUB 'READ_INPUTFILE' via eine der
c lokalen Variablen 'Startflaeche' oder 'x0_' initialisiert.
c - - - - - - - - - - zufallsverteilte Startparameter - - - - - - - - - - - - -
c Energie:
DATA random_E0 /.false./
DATA random_energy / 0 /
DATA random_E0_equal /.false./
DATA lowerE0 / 0.000 /
DATA upperE0 / 0.010 /
DATA random_E0_gauss /.false./
DATA sigmaE0 / 0.010 /
c Position:
DATA random_pos /.false./
DATA random_position / 0 /
DATA sigmaPosition / 15. /
DATA random_y0z0_equal /.false./
DATA random_r0_equal /.false./
DATA random_y0z0_Gauss /.false./
DATA random_r0_Gauss /.false./
DATA StartBreite / -1. /
DATA StartHoehe / -1. /
DATA StartRadius / -1. /
c Winkel:
DATA random_angle /.false./
DATA random_winkel / 0 /
DATA random_lambert /.false./
DATA random_gauss /.false./
DATA StartLambertOrd / 1. /
DATA sigmaWinkel / 1. /
DATA ener_offset / .true. /
DATA pos_offset / .true. /
DATA angle_offset / .true. /
c - - - - - - - - - - Schleifen-Parameter - - - - - - - - - - - - - - - - - - -
! Das Schleifenparameterfeld 'par(i,k)' (1 <= k <= par_Anzahl)
! wird indirekt im SUB 'read_inputFile' ueber die dortigen lokalen
! Variablen '_parameter' initialisiert. (siehe dort).
! Hier wird nur die 'Zufallsschleife' par(i,0) initialisiert.
DATA par(1,0) / 1. /
DATA par(2,0) / 1. /
DATA par(3,0) / 1. /
c - - - - - - - - - - Projektile- - - - - - - - - - - - - - - - - - - - - - - -
DATA art_Name / 'm+ ', 'm- ', ! character*4
+ 'Mu ', 'Mu- ',
+ 'e+ ', 'e- ',
+ 'H+ ', 'H ', 'H- ',
+ 'H2+ ', 'H2 ', 'H2- ',
+ 'alfa',
+ 'A11+', 'A12+', 'A21+', 'A31+', 'A32+',
+ 'N11+', 'N21+',
+ 'K11+', 'K12+',
+ 'H2O1', 'H2O2', 'H2O3', 'H2O4', 'H2O5',
+ 'Hyd1', 'Hyd2', 'Hyd3', 'Hyd4', 'Hyd5',
+ 'Hyd6', 'Hyd7', 'Hyd8', 'Hyd9'
+ /
c folgende Werte wurden aus bzw. mittels 'HANDBOOK OF CHEMESTRY AND PHYSICS,
c 74th edition' und 'PHYSICAL REVIEW D, 50, S.1173-1826 (August 1994)' bestimmt:
DATA art_Masse / 105658., 105658.,
+ 106169., 106680.,
+ 510.9991, 510.9991,
+ 938272.3, 938783.3, 939294.3,
+ 1877055.6, 1877566.6, 1878077.6,
+ 3727380.2,
+ 37.96238E6,37.22371E6,74.44896E6,111.673689E6,111.673178E6,
+ 13.043273 ,26.087057,
+ 78.16258E6,78.162070E6,
+ 16.77623E6,33.55297E6,50.32971E6,67.10644E6,83.88318E6,
+ 17.71501E6,34.49175E6,51.26849E6,68.04523E6,84.82197E6,
+ 101.59870E6,118.37544E6,135.15218E6,151.92892E6
+ /
DATA art_Ladung / +1., -1.,
+ 0., -1.,
+ +1., -1.,
+ +1., 0., -1.,
+ +1., 0., -1.,
+ +2.,
+ +1., +2., +1., +1., +2.,
+ +1., +1.,
+ +1., +2.,
+ +1., +1., +1., +1., +1.,
+ +1., +1., +1., +1., +1.,
+ +1., +1., +1., +1.
+ /
DATA artList / ' ' /
DATA artList_defined /.false./
c - - - - - - - - - - Programmsteuerung - - - - - - - - - - - - - - - - - - - -
DATA scaleFactor / 1. /
DATA UseDecay / .false. /
DATA DEBUG / .false. /
DATA HVs_from_map / .false. /
DATA TestRun / .false. /
DATA log_confine / .false. /
DATA maxBelowDtSmall / 50 /
c - - - - - - - - - - Graphikausgabe- - - - - - - - - - - - - - - - - - - - - -
DATA GRAPHICS / .false. /
DATA GRAPHICS_Anzahl / 25 /
DATA n_postSkript / 1 /
DATA imonitor / 2 /
c - - - - - - - - - - FileName- - - - - - - - - - - - - - - - - - - - - - - - -
DATA filename / 'AC_' /
c - - - - - - - - - - Vorgaben fuer das Summary - - - - - - - - - - - - - - - -
DATA n_outWhere / 2 /
DATA LogFile / .false. /
DATA smallLogFile / .false. /
DATA statsInSummary / .false. /
! 'statInSummary' wird indirekt im SUB 'read_inputFile' ueber die
! lokalen Variablen 'SUM_*' initialisiert (alle auf .false.)
c - - - - - - - - WELCHE FILES sollen erzeugt werden? (ausser .SUM)- - - - - -
DATA createTabellen / .false. /
! 'createTabelle' wird indirekt im SUB 'read_inputFile' ueber die
! lokalen Variablen 'TAB_*' initialisiert (alle auf .false.)
DATA createPhysTab / .false. /
DATA NTP_Misc / .false. /
DATA NTP_start / .false. /
DATA NTP_stop / .false. /
DATA NTP_40mm / .false. /
c - - - - - - - - - - Fehlerkontrolle - - - - - - - - - - - - - - - - - - - - -
DATA eps_x / 1.e-5 /
DATA eps_v / 1.e-5 /
DATA log_relativ / .false. /
DATA maxStep / 6000 /
DATA dtsmall / .001 /
c - - - - - - - - - - Programmablauf- - - - - - - - - - - - - - - - - - - - - -
DATA n_dtsmall / 0 /
DATA n_dtsmall_Max / 0 /
DATA dtsmall_counter / 0 /
DATA Lost_counter / 0 /
DATA Startflaeche / 0 /
DATA SchleifenNr / 0 /
c Ausgabekanaele (fuer die 'do indx = indx1, indx2 ....' Anweisungen):
DATA lun / lunLOG, lunScreen /
DATA OneLoop / .false. /
DATA OneStartPerLoop / .false. /
c fuer Random-Generator: 'seed' soll gross und ungerade sein. ->
c nimm den Sinus von secnds, und mache daraus durch Multiplikation mit ent-
c sprechender 10er-Potenz eine 8stellige Integer-Zahl. Sollte seed dann
c gerade sein, mache es ungerade:
help1= abs(sin(secnds(0.))) ! abs(), da sonst log10(sec) zu Fehler fuehrt
seed = int(help1* 10.**(8-int(log10(help1)) ) )
if ((seed/2)*2.EQ.seed) seed=seed-1 ! z.B. seed=3 -> seed/2=1, wegen Integer

14
accel/src/MAPMAP.INC Normal file
View File

@ -0,0 +1,14 @@
c===============================================================================
c MAPMAP.INC
c===============================================================================
c Dieser Includefile stellt den Speicherplatz fuer die Potentialmappen bereit.
c Die einzelnen Mappen werden nacheinander fuer die jeweiligen Integrations-
c abschnitte eingelesen.
integer maxmaxmem
parameter (maxmaxmem = 4e6)
real map(0:maxmaxmem)
COMMON /map/ map

43
accel/src/MAP_DEF_1.INC Normal file
View File

@ -0,0 +1,43 @@
c===============================================================================
c MAP_DEF_1.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 1
c des Programms 'ACCEL' niedergelegt:
c Position der Folie relativ zur Kryoachse:
real xFoil
common /xFoil/ xFoil
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer imax_,jmax_,kmax_
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
c parameter ( imax_= 68, jmax_= 136, kmax_= 34)
real xmin,xmax
integer imax,jmax,kmax
common /map_1/ xmin,xmax, imax,jmax,kmax
c der Beginn des Uebergabebereichs zur naechsten Mappe:
real xStartUeberUpp
common /map_1/ xStartUeberUpp
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .1)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

43
accel/src/MAP_DEF_2.INC Normal file
View File

@ -0,0 +1,43 @@
c===============================================================================
c MAP_DEF_2.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 2
c des Programms 'ACCEL' niedergelegt:
c Position der Folie relativ zur Kryoachse:
real xFoil
common /xFoil/ xFoil
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer imax_,jmax_,kmax_
parameter ( Dx_ = .025, Dy_ = .025, Dz_ = .500)
c parameter ( imax_= 80, jmax_= 680, kmax_= 34)
real xmin,xmax
integer imax,jmax,kmax
common /map_2/ xmin,xmax, imax,jmax,kmax
c der Beginn des Uebergabebereichs zur naechsten Mappe:
real xStartUeberUpp,xStartUeberLow
common /map_2/ xStartUeberUpp,xStartUeberLow
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .05)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

43
accel/src/MAP_DEF_3.INC Normal file
View File

@ -0,0 +1,43 @@
c===============================================================================
c MAP_DEF_3.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 3
c des Programms 'ACCEL' niedergelegt:
c Position der Folie relativ zur Kryoachse:
real xFoil
common /xFoil/ xFoil
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer imax_,jmax_,kmax_
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
c parameter ( imax_= 60, jmax_= 160, kmax_= 40)
real xmin,xmax
integer imax,jmax,kmax
common /map_3/ xmin,xmax, imax,jmax,kmax
c der Beginn des Uebergabebereichs zur naechsten Mappe:
real xStartUeberUpp,xStartUeberLow
common /map_3/ xStartUeberUpp,xStartUeberLow
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .2)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

43
accel/src/MAP_DEF_4.INC Normal file
View File

@ -0,0 +1,43 @@
c===============================================================================
c MAP_DEF_4.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 4
c des Programms 'ACCEL' niedergelegt:
c Position der Folie relativ zur Kryoachse:
real xFoil
common /xFoil/ xFoil
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer imax_,jmax_,kmax_
parameter ( Dx_ = .050, Dy_ = .050, Dz_ = .500)
c parameter ( imax_= 80, jmax_= 440, kmax_= 44)
real xmin,xmax
integer imax,jmax,kmax
common /map_4/ xmin,xmax, imax,jmax,kmax
c der Beginn des Uebergabebereichs zur naechsten Mappe:
real xStartUeberUpp,xStartUeberLow
common /map_4/ xStartUeberUpp,xStartUeberLow
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .1)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

43
accel/src/MAP_DEF_5.INC Normal file
View File

@ -0,0 +1,43 @@
c===============================================================================
c MAP_DEF_5.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 5
c des Programms 'ACCEL' niedergelegt:
c Position der Folie relativ zur Kryoachse:
real xFoil
common /xFoil/ xFoil
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer imax_,jmax_,kmax_
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
c parameter ( imax_= 24, jmax_= 184, kmax_= 46)
real xmin,xmax
integer imax,jmax,kmax
common /map_5/ xmin,xmax, imax,jmax,kmax
c der Beginn des Uebergabebereichs zur naechsten Mappe:
real xStartUeberUpp,xStartUeberLow
common /map_5/ xStartUeberUpp,xStartUeberLow
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .2)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

31
accel/src/MAP_DEF_6.INC Normal file
View File

@ -0,0 +1,31 @@
c===============================================================================
c MAP_DEF_6.INC
c===============================================================================
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 6
c des Programms 'ACCEL' niedergelegt:
c the grid characteristics:
real Dx_,Dy_,Dz_
c integer jmax_,kmax_
parameter ( Dx_ = .250, Dy_ = .250, Dz_ = 1.00)
c parameter ( jmax_= 100, kmax_= 25)
real xmin,xmax
integer imax,jmax,kmax
common /map_6_/ xmin,xmax, imax,jmax,kmax
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
real dl_max
parameter (dl_max = .5)
c the map:
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'

113
accel/src/READ_INFO.INC Normal file
View File

@ -0,0 +1,113 @@
c===============================================================================
c READ_INFO.INC
c===============================================================================
c Dieser Includefile erledigt fuer die Subroutinen 'READ_INFO_x' das Einlesen
c und Ueberpruefen der Mappencharakteristika und der Uebergangsbereiche. Da
c die Mappen 1 und 6 leichte Spezialbehandlung erfordern steht in den
c zugehoerigen Dateien der entsprechende Code direkt, anstatt ueber diesen
c Includefile eingebunden zu werden. Aenderungen an diesem Code muessen
c daher im Regelfall auch in den Dateien 'SUB_integr_1.FOR' und
c 'SUB_integr_6.FOR' explizit durchgefuehrt werden!
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
integer ihelp
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
logical map_error
COMMON /map_error/ map_error
c the grid characteristics (as read from the INFO-file):
real Dx,Dy,Dz
real x_iEQ1, ymax,zmax ! xmax wird in MAP_DEF_n.INC deklariert
namelist /grid_info/
+ Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Einlesen der Mappen-Informationen:
open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO',
+ readonly,status='old')
read(lunREAD,nml=grid_info)
close (lunREAD)
c eingelesene imax, jmax und kmax um 1 reduzieren, da in 'ACCEL' die Feldindizes
c ab 0 laufen, bei 'RELAX3D' jedoch ab 1:
imax = imax-1
jmax = jmax-1
kmax = kmax-1
c Umrechnen der Koordinaten, wie sie von 'BESCHL-INIT' ('RELAX3D') verwendet
c werden (Ursprung in Targetfolienmitte) in System mit Ursprung auf der Kryo-Achse:
xmin = xmin + xFoil
xmax = xmax + xFoil
C DER FOLGENDE ABSCHNITT WURDE HERAUSKOMMENTIERT, DA ES MITTLERWEILE VERSCHIEDEN
C GROSSE POTENTIALMAPPEN GIBT UND DIE MAPPENDIMENSIONEN DAHER SOWIESO VARIABEL
C GEHALTEN WERDEN MUESSEN. DIE VERWENDUNG VON PARAMETERN IST LEIDER NICHT
C MEHR MOEGLICH. ('LEIDER' WEGEN DER ERHOEHTEN RECHENZEIT):
C
Cc checken, ob die Charakteristika der einzulesenden Mappe mit den Vorgaben der
Cc Integrationsroutinen uebereinstimmen:
C
C if (
C + imax.NE.imax_ .OR.
C + jmax.NE.jmax_ .OR. kmax.NE.kmax_ .OR.
C + Dx.NE.Dx_ .OR. Dy.NE.Dy_ .OR. Dz.NE.Dz_
Cc + .OR. xmin.NE.xmin_
C + ) then
C write(*,*) '-----------------------------------------------------------'
C if (.NOT.map_error) then
C write(*,*) ' Feldgroessen der eingelesenen Mappe und des reservierten'
C write(*,*) ' Speichers stimmen nicht ueberein:'
C write(*,*)
C endif
C write(*,*) ' MAPPE '//Nr//': '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE'
C write(*,*) ' Mappe: imax ,jmax ,kmax = ',imax ,jmax ,kmax
C write(*,*) ' Dx ,Dy ,Dz = ',Dx ,Dy ,Dz
C write(*,*) ' Speicher: imax_,jmax_,kmax_ = ',imax_,jmax_,kmax_
C write(*,*) ' Dx_ ,Dy_ ,Dz_ = ',Dx_ ,Dy_ ,Dz_
C write(*,*)
C map_error = .true.
C endif
C
C if (map_error) RETURN ! kann auch in anderem 'READ_MAP_x' gesetzt worden sein
c checken, ob der reservierte Speicherplatz ausreicht:
iHelp = maxmaxmem+1
if ((imax+1)*(jmax+1)*(kmax+1).GT.iHelp) then
write(*,*)
write(*,*) 'reservierter Speicher ist nicht ausreichend fuer Mappe',Nr
write(*,*)
write(*,*) '(imax+1)*(jmax+1)*(kmax+1) = ',(imax+1)*(jmax+1)*(kmax+1)
write(*,*) 'maxmaxmem + 1 = ',maxmaxmem + 1
write(*,*)
write(*,*) '=> ''maxmaxmem'' in accel$sourcedirectory:MAPMAP.INC angleichen'
write(*,*) ' und Programm mit ''LINKACV'' am DCL-Prompt neu kompilieren'
write(*,*) ' und linken.'
write(*,*)
call exit
endif
c xStartUeber definieren:
xStartUeberUpp = xmax - .5*dx
xStartUeberLow = xmin + .5*dx
RETURN

58
accel/src/READ_MAP.INC Normal file
View File

@ -0,0 +1,58 @@
c===============================================================================
c READ_MAP.INC
c===============================================================================
c Dieser Includefile erledigt fuer die Subroutinen 'READ_MAP_x' das Einlesen
c der Potentialmappe und falls notwendig die Fehlerausgabe.
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
integer i,j,k, ihelp, iostat
c Einlesen der Potentialmappe:
open (lunRead,file=mappenName//'_'//Nr,
+ defaultfile=mappenDir//':.MAPPE',status='old',
+ form='unformatted',recl=imax+1,readonly)
c + form='unformatted',recl=imax,readonly)
write(*,*) 'reading '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE ...'
do k = 0, kmax
do j = 0, jmax
c read(lunREAD,iostat=iostat) (map(i,j,k),i=0,imax)
ihelp = (k*(jmax+1)+j)*(imax+1)
read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax)
if (iostat.NE.0) then
write(*,*)
write(*,999) i,j,k,iostat
STOP
endif
enddo
enddo
close(lunREAD)
999 format(x/'error reading grid point (i,j,k) = ('i4','i4','
+ i4')'/'iostat = 'i4/)
c da die Anodenbereiche bei RELAX3D negativ kodiert sind, nimm die
c Absolutbetraege:
ihelp = 0
do k=0, kmax
do j=0, jmax
do i=0, imax
c map(i,j,k) = abs(map(i,j,k))
map(ihelp) = abs(map(ihelp))
ihelp = ihelp + 1
enddo
enddo
enddo
RETURN

192
accel/src/RUNGE_KUTTA.INC Normal file
View File

@ -0,0 +1,192 @@
c===============================================================================
c RUNGE_KUTTA.INC
c===============================================================================
c Dieses Includefile erledigt fuer die Subroutinen 'INTEGRATIONSSTEP_RUNGE_KUTTA'
c die Fehlerbetrachtung, das Ertasten des Uebergabebereiches zur naechsten Mappe,
c die damit verbundenen Variationen des Zeitschrittes dt sowie die letztendliche
c Festlegung des neuen Ortes, der neuen Geschwindigkeit und der neuen Zeit.
c Zaehle die Schritte:
steps = steps + 1
c Fehlerbetrachtung:
c Fehlerbetrachtung:
c der groesste (absolute bzw. relative) Fehler im Ort soll kleiner als eps_x
c sein, der groesste Fehler in der Geschwindigkeit kleiner als eps_v:
c -> Bestimme den jeweils groessten Fehler der drei Komponenten des Ortes und
c der Geschwindigkeit (dh. die groesste Differenz der Aederungen):
maxErr_x = 0.
maxErr_v = 0.
do i = 1, 3
xDifferenz(i) = Dx1(i)-Dx2(i)
vDifferenz(i) = Dv1(i)-Dv2(i)
if (log_relativ) then
if (Dx1(i).NE.0.) maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)/Dx1(i)))
if (Dv1(i).NE.0.) maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)/Dv1(i)))
else
maxErr_x = Max( maxErr_x, Abs( xDifferenz(i) ) )
maxErr_v = Max( maxErr_v, Abs( vDifferenz(i) ) )
endif
enddo
c - Skaliere den jeweils groessten relativen Fehler auf das jeweilige Epsilon:
maxErr_x = maxErr_x / eps_x
maxErr_v = maxErr_v / eps_v
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c der groessere der beiden reskalierten Fehler bestimmt, ob der Integrations-
c schritt mit kleinerem Zeitintervall wiederholt werden muss, bzw. um welchen
c Faktor das Zeitintervall fuer den naechsten Schritt vergroessert werden kann:
c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dt bereits jetzt
c kleiner als dtsmall, so mache keinen neuen Versuch sondern akzeptiere als Not-
c loesung den bestehenden Naeherungswert. Setze dt in diesem Fall als Default
c fuer den kommenden Integrationsschritt auf dtsmall. Setze aber auch das flag
c 'flag_dtsmall', damit gezaehlt werden kann, wie oft dieses Prozedur fuer ein
c bestimmtes Teilchen angewendet werden muss. Ist dies zu oft der Fall, so brich
c diese Trajektorienberechnung ganz ab (-> destiny = code_dtsmall).
c (2. Teil erfolgt weiter unten)
c
c Es kam vor, dass ohne Ueberschreitung der Fehlertoleranz ein 'dtupper'
c und ein 'dtlower' gefunden wurde, beim Ertasten des Uebergabebereiches
c die Fehlergrenze bei mittleren dt-Werten dann aber ueberschritten wurde,
c wodurch dt immer wieder verkuerzt wurde, ohne dass der Uebergabebereich
c erreicht werden konnte. Letztlich bildete das ganze eine unendliche Schleife.
c Daher werden jetzt jedesmal, wenn die Fehlergrenze ueberschritten wird
c 'found_upper' und 'found_lower' resettet.
maxErr = Max(maxErr_x,maxErr_v)
if (maxErr.GT.1.) then
found_upper_upp = .false.
found_lower_upp = .false.
found_upper_low = .false.
found_lower_low = .false.
if (dt.LT.dtsmall) then ! Fehler immer noch zu gross, obwohl
flag_dtsmall = .true. ! dtsmall schon unterschritten ist
else
!c Bestimme kuerzeren Zeitschritt fuer neuen Versuch (vgl. Referenz):
dt = safety * dt * (maxErr**pShrink)
goto 10
endif
endif
x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15.
c Falls x(1) (== x_1) jetzt jenseits des Mappenendes liegen sollte, behalte
c dieses Faktum im Gedaechtnis und verkuerze den aktuell verwendeten Zeitschritt
c so lange um Faktor 0.5, bis x(1) innerhalb oder vor dem Uebergabebereich liegt.
c Liegt es dann davor, suche einen mittleren Zeitschritt, bei dem es innerhalb
c liegt.
c Hat das Teilchen danach (oder nachdem es direkt in den Uebergabebereich traf)
c positives v(1), so setze das Logical 'reachedEndOfMap' fuer die Berechnung
c des Schnittpunkts der Trajektorie mit dem Mappenende.
c (v(1)<0. ist entweder moeglich falls es bereits vor dem Mappenende reflektiert
c wurde oder gerade aus Mappe mit hoeherer Nummer kam).
if (x_1.GT.xStartUeberUpp) then
if (.NOT.found_upper_upp) dt_save = dt
if (x_1.LE.xMax .AND. v(1).GT.0.) then
reachedEndOfMap = .true.
elseif (x_1.GT.xMax) then
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = min(0.5*dt,(xStartUeberUpp-x(1))/(x_1-x(1))*dt)
else
dt = (dtlower+dtupper)/2.
endif
goto 10 ! neue Berechnung
endif
elseif (found_upper_upp) then
found_lower_upp = .true.
dtlower = dt
dt = (dtlower+dtupper)/2.
goto 10 ! neue Berechnung
endif
c entsprechende Behandlung wie oben fuer den Fall, dass x(1) (== x_1) jetzt im
c Bereich des Mappenanfangs liegt:
if (x_1.LT.xStartUeberLow) then
if (.NOT.found_upper_low) dt_save = dt
if (x_1.GE.xMin .AND. v(1).LT.0) then
backOneMap = .true.
elseif (x_1.LT.xmin) then
found_upper_low = .true.
dtupper = dt
if (.NOT.found_lower_low) then
dt = min(0.5*dt,(xStartUeberLow-x(1))/(x_1-x(1))*dt)
else
dt = (dtlower+dtupper)/2.
endif
goto 10 ! neue Berechnung
endif
elseif (found_upper_low) then
found_lower_low = .true.
dtlower = dt
dt = (dtlower+dtupper)/2.
goto 10 ! neue Berechnung
endif
c Nimm die Ergebnisse aus dem dt-Schritt und den beiden dt/2-Schritten und
c berechne damit den neuen Ort und die neue Geschwindigkeit mit Genauigkeit
c fuenfter Ordnung in dt:
x(1) = x_1
x(2) = x(2) + Dx1(2) + xDifferenz(2) / 15.
x(3) = x(3) + Dx1(3) + xDifferenz(3) / 15.
v(1) = v(1) + Dv1(1) + vDifferenz(1) / 15.
v(2) = v(2) + Dv1(2) + vDifferenz(2) / 15.
v(3) = v(3) + Dv1(3) + vDifferenz(3) / 15.
c alten Zeitschritt addieren:
t = t + dt
c Falls ein Uebergabebereich erreicht wurde, berechne Schnittpunkt der
c Trajektorie mit x=xmax (Mappenende) bzw. mit x=xmin (Mappenanfang):
if (reachedEndOfMap) goto 7766
if (backOneMap) goto 7767
c neuen Zeitschritt so gross wie sinnvoller weise moeglich machen:
3454 if (flag_dtSmall) then
if (n_dtsmall.LT.maxBelowDtSmall) then
dt = dtSmall ! fuer naechsten RK-Schritt
n_dtsmall = n_dtsmall + 1
else
destiny = code_dtsmall ! gib Teilchen verloren
RETURN
endif
else
if (maxErr.GT.errCon) then
dt = safety * dt * (maxErr**pGrow) ! vgl. Referenz
else
dt = 4. * dt ! <- Vergroesserung des Zeitschritts max. um
endif ! Faktor 4!
! pruefen, ob Maximallaenge fuer ersten Testschritt nicht ueberschritten ist:
if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
endif

191
accel/src/SUB_ARTLIST.FOR Normal file
View File

@ -0,0 +1,191 @@
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Die Routinen dieser Datei werden in das Programm 'ACCEL' eingebunden und
c dort von der Routine 'READ_INPUTFILE' aufgerufen.
c
c Aufgabe dieser Routinen ist es, aus der Variablen 'ArtList' (so ihr in der
c INPUT-Datei ein Wert zugewiesen wurde) die zu verwendenden Projektilarten zu
c extrahieren und die zugehoerigen Code-Nummern in das Feld 'art_Nr'
c einzutragen. Dieses wird dann im Hauptprogramm dazu benutzt, den Massen-
c und den Ladungsspeicher entsprechend den zu den Teilchen gehoerigen Werten
c zu belegen. Wurden in 'artList' keine Teilchenarten spezifiziert, so werden
c fuer die Einstellungen der Massen- und der Ladungsschleife im Hauptprogramm
c die Vorgaben fuer '_Masse' bzw. '_Ladung' aus dem INPUT-file verwendet.
c
c Die Subroutine EXAMINE_ARTLIST kopiert zunaechst buchstabenweise die Variable
c 'ArtList' in die Variable 'helpTxt', wobei saemtliche blanks entfernt werden.
c Anschliessend wird 'artList' geloescht. (Die Artenbezeichnungen werden spaeter
c formatiert wieder in 'artList' zurueckgeschrieben).
c Als naechstes werden aus 'HelpTxt' die Artenbezeichnungen einzeln in den
c Speicher 'testName' uebernommen und geprueft, ob die jeweilige Art erkannt
c wird. Ist die Artenbezeichnung laenger als vier Buchstaben, so erfolgt
c Programmabbruch mit Fehlermeldung (Routine ART_FEHLER). Das selbe passiert
c falls die Artenbezeichnung nicht erkannt wird.
c
c Wurde die Art erkannt, und befindet sie sich nicht schon in der Liste, so
c wird ihre Codezahl in das Feld 'art_Nr' uebernommen und wieder in die
c Variable 'ArtList' zurueckgeschrieben, wobei die Arten durch Komma und
c darauffolgendes blank getrennt werden.
c
c Wurden in 'artList' letztlich gueltige Artenbezeichnungen gefunden, so wird
c das logical 'artList_defined' auf .true. gesetzt und die Parameter fuer die
c Massen- und die Ladungs-Schleifen so eingestellt, dass erstere genau einen
c (Leer-) Durchlauf macht, letztere dagegen fuer jede gefundene Projektilart
c einen Durchgang vollfuehrt, in dem dann jeweils die zugehoerigen Ladungs- UND
c Massenwerte entsprechend den Inhalten der Speicher art_Ladung(artNr) und
c art_Masse(artNr) eingestellt werden.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
OPTIONS /EXTEND_SOURCE
SUBROUTINE EXAMINE_ARTLIST
c ==========================
implicit none
integer k,k1 ! Zaehlvariablen
integer length ! Laenge von helpTxt
integer pos ! Position in helpTxt
integer komma ! Position eines Kommas in helpTxt
integer nummer ! Nummer der naechsten erkannten Art
integer posL ! Position in ArtList
character helpChar*1, helpTxt*60, testName*4
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Es wurden noch keine Teilchen mit Myonen gefunden:
mu_flag = .false.
c 'artList' in 'helpText' uebernehmen, dabei alle Blanks entfernen. Taucht ein
c '!' auf, so ignoriere den Rest.
helpTxt = ' '
length = 0
do pos = 1, len(artList)
helpChar = artlist(pos:pos)
if (helpChar.EQ.'!') goto 1
if (helpChar.NE.' ') then
length = length+1
helpTxt(length:length) = helpChar
endif
enddo
c write(*,*) 'artList = ',artList
c write(*,*) 'helpTxt = ',helpTxt
1 artList = ' '
c die Arten nacheinander in testName uebernehmen, und pruefen, ob sie erkannt
c werden:
nummer = 1
pos = 1
posL = 1
komma = 0
do while (komma.LT.length+1)
komma = INDEX(helpTxt,',') ! Position des ersten Kommas
if (komma.EQ.0) komma = length+1 ! falls kein ',' mehr, nimm Rest
c write(*,*) 'pos = ',pos
c write(*,*) 'komma = ',komma
if (komma-pos.GT.4) then ! ArtName hat max. 4 Lettern
call art_Fehler (helpTxt(pos:komma-1))
STOP
elseif (komma.NE.pos) then ! sonst: 2 Kommas hintereinander
testName = helpTxt(pos:komma-1)
c write(*,*) 'testName= ',testName
!c Pruefen, ob die Art bekannt ist. Wenn ja, pruefe, ob die Art
!c nicht schon in der Liste ist. Falls Nein, gib die Nummer der
!c entsprechenden Art in Art_Nr(nummer) und haenge den ArtNamen
!c gefolgt von Komma und Leerzeichen an artList an:
do k = 1, arten_zahl ! arten_Zahl = Anzahl bekannter Teilchenarten
if (testName.EQ.art_Name(k)) then ! Teilchenart erkannt
if (nummer.GT.1) then
do k1 = 1, nummer-1 ! Test, ob Art schon in Liste
if (Art_Nr(k1).EQ.k) goto 2 ! ueberspringen,
enddo ! => next, please!
endif
art_Nr(nummer) = k
if (k.LE.4) mu_flag = .true.
artList(posL:posL+komma-pos+1) =
+ helpTxt(pos:komma-1)//', '
posL = posL + komma-pos+2 ! Position fuer naechste Art
nummer = nummer + 1 ! definieren
if (nummer.GT.artenMax) goto 3 ! nicht mehr als artenMax Arten
goto 2 ! next, please
endif
enddo
!c Art wurde nicht erkannt -> Fehlermeldung und Abbruch:
call art_Fehler(testName)
STOP
endif
2 if (komma.LT.length+1) helpTxt(komma:komma) = '#' ! , durch # ersetzen
pos = komma+1 ! und dann von vorne
enddo
3 artList(posL-2:posL-2)=' ' ! letztes Komma entfernen
c Wenn wir hier landen, wurden Teilchen in 'artList' gefunden und erkannt!
artList_defined = .true.
c Falls 'artList' kein Myonen-Teilchen enthaelt, braucht auch der Myonzerfall
c nicht beruecksichtigt zu werden:
if (.NOT.mu_flag) UseDecay = .false.
c Die Massen- und die Ladungsschleife einstellen:
par(1,mass) = 1. ! Masse-Schleife macht genau einen Durchgang
par(2,mass) = 1.
par(3,mass) = 1.
par(1,charge) = 1. ! Ladungsschleife macht fuer jede
par(2,charge) = nummer-1 ! Projektilart einen Durchgang
par(3,charge) = 1.
END
C===============================================================================
SUBROUTINE ART_FEHLER(artText)
c ==============================
character artText*(*)
write (*,*)
write (*,1) ' >>>>> Art ''',artText,''' ist unbekannt'
write (*,1) ' >>>>> Gueltig Artenbezeichnungen sind:'
write (*,1) ' >>>>> e+, e-, m+, m-, Mu, Mu-, H+, H, H-, '//
+ 'H2+, H2, H2-, alfa'
write (*,1) ' >>>>> (das Einlesen erfolgt CASE SENSITIVE!)'
write (*,*)
1 format(T10,A)
END
c===============================================================================

1020
accel/src/SUB_INPUT.FOR Normal file

File diff suppressed because it is too large Load Diff

743
accel/src/SUB_INTEGR_1.FOR Normal file
View File

@ -0,0 +1,743 @@
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_INFO_1
c ======================
IMPLICIT NONE
character*1 Nr
parameter (Nr='1')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
logical map_error
COMMON /map_error/ map_error
c the grid characteristics (as read from the INFO-file):
real Dx,Dy,Dz
real x_iEQ1, ymax,zmax ! xmin wird in MAP_DEF_1 definiert
namelist /grid_info/
+ Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Einlesen der Mappen-Informationen:
open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO',
+ readonly,status='old')
read(lunREAD,nml=grid_info)
close (lunREAD)
c eingelesene imax, jmax und kmax um 1 reduzieren, da in 'ACCEL' die Feldindizes
c ab 0 laufen, bei 'RELAX3D' jedoch ab 1:
imax = imax-1
jmax = jmax-1
kmax = kmax-1
c Umrechnen der Koordinaten, wie sie von 'BESCHL-INIT' ('RELAX3D') verwendet
c werden (Ursprung in Targetfolienmitte) in System mit Ursprung auf der Kryo-Achse:
xmin = xmin + xFoil
xmax = xmax + xFoil
c xStartUeber definieren:
xStartUeberUpp = xmax - .5*dx
C DER FOLGENDE ABSCHNITT WURDE HERAUSKOMMENTIERT, DA ES MITTLERWEILE VERSCHIEDEN
C GROSSE POTENTIALMAPPEN GIBT UND DIE MAPPENDIMENSIONEN DAHER SOWIESO VARIABEL
C GEHALTEN WERDEN MUESSEN. DIE VERWENDUNG VON PARAMETERN IST LEIDER NICHT
C MEHR MOEGLICH. ('LEIDER' WEGEN DER ERHOEHTEN RECHENZEIT):
C
Cc checken, ob die Characteristica der einzulesenden Mappe mit den Vorgaben des
Cc reservierten Speichers uebereinstimmen:
C
C if (
C + imax.NE.imax_ .OR.
C + jmax.NE.jmax_ .OR. kmax.NE.kmax_ .OR.
C + Dx.NE.Dx_ .OR. Dy.NE.Dy_ .OR. Dz.NE.Dz_
Cc + .OR. xmin.NE.xmin_
C + ) then
C write(*,*) '-----------------------------------------------------------'
C if (.NOT.map_error) then
C write(*,*) ' Feldgroessen der eingelesenen Mappe und des reservierten'
C write(*,*) ' Speichers stimmen nicht ueberein:'
C write(*,*)
C endif
C write(*,*) ' MAPPE '//Nr//': '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE'
C write(*,*) ' Mappe: imax ,jmax ,kmax = ',imax ,jmax ,kmax
C write(*,*) ' Dx ,Dy ,Dz = ',Dx ,Dy ,Dz
C write(*,*) ' Speicher: imax_,jmax_,kmax_ = ',imax_,jmax_,kmax_
C write(*,*) ' Dx_ ,Dy_ ,Dz_ = ',Dx_ ,Dy_ ,Dz_
C write(*,*)
C map_error = .true.
C endif
C
C if (map_error) RETURN ! kann auch in anderem 'READ_MAP_x' gesetzt worden sein
c checken, ob der reservierte Speicherplatz ausreicht:
if ((imax+1)*(jmax+1)*(kmax+1).GT.maxmaxmem+1) then
write(*,*)
write(*,*) 'reservierter Speicher ist nicht ausreichend fuer Mappe',Nr
write(*,*)
write(*,*) '(imax+1)*(jmax+1)*(kmax+1) = ',(imax+1)*(jmax+1)*(kmax+1)
write(*,*) 'maxmaxmem + 1 = ',maxmaxmem + 1
write(*,*)
write(*,*) '=> ''maxmaxmem'' in accel$sourcedirectory:MAPMAP.INC angleichen'
write(*,*) ' und Programm mit ''LINKACV'' am DCL-Prompt neu kompilieren'
write(*,*) ' und linken.'
write(*,*)
call exit
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_MAP_1
c =====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='1')
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE ADD_MAP_1
c ====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='1')
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_1(dt)
c =============================================
IMPLICIT NONE
SAVE
character*1 Nr
parameter (Nr='1')
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
c zuerst ausgefuehrt).
c
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
c
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
c Ordnung in dt zu erhalten.
c
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
c fileheader von 'ACCEL.FOR')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
c fuer Fehlermeldungen:
d integer last_start_nr /0/, zaehler
real help
real dt_save
integer i ! Zaehlvariable
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
real EFeld0(3), EFeld1(3) ! elektr. Felder
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
real xDifferenz(3), vDifferenz(3)
real x_1 ! Hilfsvariable fuer testweises x(1)
real a ! Beschleunigung
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
real errCon, safety ! fuer Schrittweitenkontrolle
real pShrink, pGrow ! fuer Schrittweitenkontrolle
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
PARAMETER (pShrink = -.25, pGrow = -.2)
! errCon = (4./safety)**(1/pGrow)
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
! der Fehler immer noch zu gross ist.
logical found_lower_upp ! obere und untere Grenze fuer dt um
logical found_upper_upp ! Uebergabebereich zu treffen
real dtlower,dtupper
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
logical reducedAccur ! reduzierte Genauigkeit im Bereich
COMMON /reducedAccur/ reducedAccur ! des Folienrandes
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
flag_dtSmall = .false. ! flag resetten
found_lower_upp = .false.
found_upper_upp = .false.
if (dt.lt.dtsmall) dt = dtsmall
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
call EFeld_1(x,EFeld0,*998)
c...............................................................................
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
! abgeaendert werden muss.
d if (once_more) then
d write (lunLOG,*)' selber Integrationsschritt, neues dt: ',dt
d else
d write (lunLOG,*)' >>>>>>>> dt = ',dt
d once_more = .true.
d endif
dt_half = dt / 2.
c mache ersten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_1(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
c berechne EFeld bei x1:
x1(1) = x(1) + Dx1(1)
x1(2) = x(2) + Dx1(2)
x1(3) = x(3) + Dx1(3)
v1(1) = v(1) + Dv1(1)
v1(2) = v(2) + Dv1(2)
v1(3) = v(3) + Dv1(3)
call EFeld_1(x1,EFeld1,*999)
c mache zweiten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_1(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
Dx1(1) = Dx1(1) + Dx2(1)
Dx1(2) = Dx1(2) + Dx2(2)
Dx1(3) = Dx1(3) + Dx2(3)
Dv1(1) = Dv1(1) + Dv2(1)
Dv1(2) = Dv1(2) + Dv2(2)
Dv1(3) = Dv1(3) + Dv2(3)
c mache dt - Schritt:
call SINGLESTEP_RUNGE_KUTTA_1(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
c Zaehle die Schritte:
steps = Steps + 1
c Fehlerbetrachtung:
c der groesste (absolute bzw. relative) Fehler im Ort soll kleiner als eps_x
c sein, der groesste Fehler in der Geschwindigkeit kleiner als eps_v:
c -> Bestimme den jeweils groessten Fehler der drei Komponenten des Ortes und
c der Geschwindigkeit (dh. die groesste Differenz der Aederungen):
maxErr_x = 0.
maxErr_v = 0.
do i = 1, 3
xDifferenz(i) = Dx1(i)-Dx2(i)
vDifferenz(i) = Dv1(i)-Dv2(i)
if (log_relativ.AND..NOT.reducedAccur) then
if (Dx1(i).NE.0.) maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)/Dx1(i)))
if (Dv1(i).NE.0.) maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)/Dv1(i)))
else
maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)))
maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)))
endif
enddo
c - Skaliere den jeweils groessten relativen Fehler auf das jeweilige Epsilon:
if (reducedAccur) then
maxErr_x = maxErr_x / 1e-6
maxErr_v = maxErr_v / 1e-6
else
maxErr_x = maxErr_x / eps_x
maxErr_v = maxErr_v / eps_v
endif
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c der groessere der beiden reskalierten Fehler bestimmt, ob der Integrations-
c schritt mit kleinerem Zeitintervall wiederholt werden muss, bzw. um welchen
c Faktor das Zeitintervall fuer den naechsten Schritt vergroessert werden kann:
c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dt bereits jetzt
c kleiner als dtsmall, so mache keinen neuen Versuch sondern akzeptiere als Not-
c loesung den bestehenden Naeherungswert. Setze dt in diesem Fall als Default
c fuer den kommenden Integrationsschritt auf dtsmall. Setze aber auch das flag
c 'flag_dtsmall', damit gezaehlt werden kann, wie oft dieses Prozedur fuer ein
c bestimmtes Teilchen angewendet werden muss. Ist dies zu oft der Fall, so brich
c diese Trajektorienberechnung ganz ab (-> destiny = code_dtsmall).
c (2. Teil erfolgt weiter unten)
c
c Es kam vor, dass ohne Ueberschreitung der Fehlertoleranz ein 'dtupper'
c und ein 'dtlower' gefunden wurde, beim Ertasten des Uebergabebereiches
c die Fehlergrenze bei mittleren dt-Werten dann aber ueberschritten wurde,
c wodurch dt immer wieder verkuerzt wurde, ohne dass der Uebergabebereich
c erreicht werden konnte. Letztlich bildete das ganze eine unendliche Schleife.
c Daher werden jetzt jedesmal, wenn die Fehlergrenze ueberschritten wird
c 'found_upper' und 'found_lower' resettet.
maxErr = Max(maxErr_x,maxErr_v)
if (maxErr.GT.1.) then
found_upper_upp = .false.
found_lower_upp = .false.
if (dt.LT.dtsmall) then ! Fehler immer noch zu gross, obwohl
flag_dtsmall = .true. ! dtsmall schon unterschritten ist
else
!c Bestimme kuerzeren Zeitschritt fuer neuen Versuch (vgl. Referenz):
dt = safety * dt * (maxErr**pShrink)
goto 10
endif
endif
x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15.
c Falls x(1) (== x_1) jetzt jenseits des Mappenendes liegen sollte, behalte
c dieses Faktum im Gedaechtnis und verkuerze den aktuell verwendeten Zeitschritt
c so lange um Faktor 0.5, bis x(1) innerhalb oder vor dem Uebergabebereich liegt.
c Liegt es dann davor, suche einen mittleren Zeitschritt, bei dem es innerhalb
c liegt.
c Hat das Teilchen danach (oder nachdem es direkt in den Uebergabebereich traf)
c positives v(1), so setze das Logical 'reachedEndOfMap' fuer die Berechnung
c des Schnittpunkts der Trajektorie mit dem Mappenende.
c (v(1)<0. ist entweder moeglich falls es bereits vor dem Mappenende reflektiert
c wurde oder gerade aus Mappe mit hoeherer Nummer kam).
if (x_1.GT.xStartUeberUpp) then
if (.NOT.found_upper_upp) dt_save = dt
if (x_1.LE.xMax .AND. v(1).GT.0.) then
reachedEndOfMap = .true.
elseif (x_1.GT.xMax) then
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = min(0.5*dt,(xStartUeberUpp-x(1))/(x_1-x(1))*dt)
else
dt = (dtlower+dtupper)/2.
endif
goto 10 ! neue Berechnung
endif
elseif (found_upper_upp) then
found_lower_upp = .true.
dtlower = dt
dt = (dtlower+dtupper)/2.
goto 10 ! neue Berechnung
endif
c Nimm die Ergebnisse aus dem dt-Schritt und den beiden dt/2-Schritten und
c berechne damit den neuen Ort und die neue Geschwindigkeit mit Genauigkeit
c fuenfter Ordnung in dt:
x(1) = x_1
x(2) = x(2) + Dx1(2) + xDifferenz(2) / 15.
x(3) = x(3) + Dx1(3) + xDifferenz(3) / 15.
v(1) = v(1) + Dv1(1) + vDifferenz(1) / 15.
v(2) = v(2) + Dv1(2) + vDifferenz(2) / 15.
v(3) = v(3) + Dv1(3) + vDifferenz(3) / 15.
c alten Zeitschritt addieren:
t = t + dt
c Falls Uebergabebereich erreicht wurde, berechne Schnittpunkt der Trajektorie
c mit x=xmax (Mappenende):
if (reachedEndOfMap) goto 7766
c neuen Zeitschritt so gross wie sinnvoller weise moeglich machen:
3454 if (flag_dtSmall) then
if (n_dtsmall.LT.maxBelowDtSmall) then
dt = dtSmall ! fuer naechsten RK-Schritt
n_dtsmall = n_dtsmall + 1
else
destiny = code_dtsmall ! gib Teilchen verloren
RETURN
endif
else
if (maxErr.GT.errCon) then
dt = safety * dt * (maxErr**pGrow) ! vgl. Referenz
else
dt = 4. * dt ! <- Vergroesserung des Zeitschritts max. um
endif ! Faktor 4!
dt = min(dt,10000.)
! pruefen, ob Maximallaenge fuer ersten Testschritt nicht ueberschritten ist:
if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
endif
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
c in positiver x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenende reflektiert werden koennte:
7766 continue
call EFeld_1(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmax) then
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
x1(1) = xmax
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_1(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmax) then
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
x(1) = xmax
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
998 if (returnCode_EFeld.EQ.1) then
write(*,*) 'Mappe '//Nr//':'
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
write(*,*)' start_nr = ',start_Nr
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' -> STOP'
STOP
endif
c - Fehler trat auf bei Berechnung des EFeldes am aktuellen Teilchenort oder
c an einem Testort (in 1. Fall erfolgt Einstieg bei 998):
999 if (returnCode_EFeld.EQ.1) then
if (.NOT.found_upper_upp) dt_save = dt
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
elseif (returnCode_EFeld.EQ.3) then
if (t.EQ.0.) then ! -> kann manchmal vorkommen
destiny = code_reflektiert
elseif (v(1).LE.0) then ! reflektiert -> kann vorkommen
destiny = code_reflektiert
else ! in Vorwaertsbewegung -> darf nicht vorkommen!!
write(*,*)
write(*,*) 'Mappe '//Nr//':'
write(*,*)
write(*,*)' Test-x liegt vor der Mappe!'
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)' Step = ',Steps
write(*,*)
write(*,*)' -> STOP'
write(*,*)
destiny = code_vor_Mappe
c STOP
endif
elseif (returnCode_EFeld.NE.0) then
write(*,*)
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
write(*,*) '-> STOP'
write(*,*)
STOP
endif
RETURN
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
c Trajektorie mit einer Mappenbegrenzung:
997 if (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
else
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
write(*,*) 'of trajectory and x equals xmax line.'
write(*,*)
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)
write(*,*) '-> STOP'
write(*,*)
STOP
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_1(dt,E0,x0,v0, Dx,Dv, *)
c ==========================================================
IMPLICIT NONE
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
c Runge-Kutta-Integrationsschritt (4. Ordnung).
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
c weise grosser Werte).
real Beschl_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
real E0(3), x0(3), v0(3) ! Eingangsgroessen
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
real xTest(3) ! Test-Orte
real Dx(3), Dv(3) ! Ergebnisspeicher
integer i ! Zaehlvariable
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
dt_half = dt / 2.
dt_sixth = dt / 6.
help = Beschl_Faktor * dt
help_half = help / 2.
help_sixth = help / 6.
do i = 1, 3
xTest(i) = x0(i) + v0(i) * dt_half
v1(i) = v0(i) + E0(i) * help_half
enddo
call EFeld_1(xTest,E1,*999)
do i = 1, 3
xTest(i) = x0(i) + v1(i) * dt_half
v2(i) = v0(i) + E1(i) * help_half
enddo
call EFeld_1(xTest,E2,*999)
do i = 1, 3
xTest(i) = x0(i) + v2(i) * dt
v3(i) = v0(i) + E2(i) * help
enddo
call EFeld_1(xTest,E3,*999)
do i = 1, 3
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
enddo
RETURN
999 RETURN 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE EFeld_1(x,E,*)
c =========================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Rechne in Gittereinheiten um:
real_i = (x(1)-xmin) / Dx_
real_j = abs(x(2)) / Dy_
real_k = abs(x(3)) / Dz_
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Mache die Tests und berechne die Feldstaerke:
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
END
c===============================================================================

551
accel/src/SUB_INTEGR_2.FOR Normal file
View File

@ -0,0 +1,551 @@
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_INFO_2
c ======================
IMPLICIT NONE
character*1 Nr
parameter (Nr='2')
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_MAP_2
c =====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='2')
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE ADD_MAP_2
c ====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='2')
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_2(dt)
c =============================================
IMPLICIT NONE
SAVE
character*1 Nr
parameter (Nr='2')
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
c zuerst ausgefuehrt).
c
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
c
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
c Ordnung in dt zu erhalten.
c
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
c fileheader von 'ACCEL.FOR')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
real help
real dt_save
integer i ! Zaehlvariable
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
real EFeld0(3), EFeld1(3) ! elektr. Felder
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
real xDifferenz(3), vDifferenz(3)
real x_1 ! Hilfsvariable fuer testweises x(1)
real a ! Beschleunigung
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
real errCon, safety ! fuer Schrittweitenkontrolle
real pShrink, pGrow ! fuer Schrittweitenkontrolle
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
PARAMETER (pShrink = -.25, pGrow = -.2)
! errCon = (4./safety)**(1/pGrow)
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
! der Fehler immer noch zu gross ist.
logical found_lower_upp ! obere und untere Grenze fuer dt um
logical found_upper_upp ! Uebergabebereich zu treffen
logical found_lower_low ! obere und untere Grenze fuer dt um
logical found_upper_low ! Uebergabebereich zu treffen
real dtlower,dtupper
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
flag_dtSmall = .false. ! flag resetten
found_lower_upp = .false.
found_upper_upp = .false.
found_lower_low = .false.
found_upper_low = .false.
if (dt.lt.dtsmall) dt = dtsmall
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
call EFeld_2(x,EFeld0,*998)
c...............................................................................
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
! abgeaendert werden muss.
dt_half = dt / 2.
c mache ersten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_2(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
c berechne EFeld bei x1:
x1(1) = x(1) + Dx1(1)
x1(2) = x(2) + Dx1(2)
x1(3) = x(3) + Dx1(3)
v1(1) = v(1) + Dv1(1)
v1(2) = v(2) + Dv1(2)
v1(3) = v(3) + Dv1(3)
call EFeld_2(x1,EFeld1,*999)
c mache zweiten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_2(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
Dx1(1) = Dx1(1) + Dx2(1)
Dx1(2) = Dx1(2) + Dx2(2)
Dx1(3) = Dx1(3) + Dx2(3)
Dv1(1) = Dv1(1) + Dv2(1)
Dv1(2) = Dv1(2) + Dv2(2)
Dv1(3) = Dv1(3) + Dv2(3)
c mache dt - Schritt:
call SINGLESTEP_RUNGE_KUTTA_2(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
c in positiver x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenende reflektiert werden koennte:
7766 continue
call EFeld_2(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmax) then
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
x1(1) = xmax
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_2(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmax) then
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
x(1) = xmax
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
c in negativer x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenanfang reflektiert werden koennte:
7767 continue
call EFeld_2(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmin) then
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
x1(1) = xmin
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_2(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmin) then
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
x(1) = xmin
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
998 if (returnCode_EFeld.EQ.1) then
write(*,*) 'Mappe '//Nr//':'
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
write(*,*)' -> STOP'
write(*,*)
STOP
endif
c - Fehler trat auf bei Berechnung des EFeldes am aktuellen Teilchenort oder
c an einem Testort (in 1. Fall erfolgt Einstieg bei 998):
999 if (returnCode_EFeld.EQ.1) then
if (.NOT.found_upper_upp) dt_save = dt
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
elseif (returnCode_EFeld.EQ.3) then
if (.NOT.found_upper_low) dt_save = dt
dtupper = dt
found_upper_low = .true.
if (.NOT.found_lower_low) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.NE.0) then
write(*,*)
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
write(*,*) '-> STOP'
write(*,*)
STOP
endif
RETURN
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
c Trajektorie mit einer Mappenbegrenzung:
997 if (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
else
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
write(*,*) 'of trajectory and x equals xmax or xmin line.'
write(*,*)
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)
write(*,*) '-> STOP'
write(*,*)
STOP
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_2(dt,E0,x0,v0, Dx,Dv, *)
c ==========================================================
IMPLICIT NONE
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
c Runge-Kutta-Integrationsschritt (4. Ordnung).
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
c weise grosser Werte).
real Beschl_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
real E0(3), x0(3), v0(3) ! Eingangsgroessen
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
real xTest(3) ! Test-Orte
real Dx(3), Dv(3) ! Ergebnisspeicher
integer i ! Zaehlvariable
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
dt_half = dt / 2.
dt_sixth = dt / 6.
help = Beschl_Faktor * dt
help_half = help / 2.
help_sixth = help / 6.
do i = 1, 3
xTest(i) = x0(i) + v0(i) * dt_half
v1(i) = v0(i) + E0(i) * help_half
enddo
call EFeld_2(xTest,E1,*999)
do i = 1, 3
xTest(i) = x0(i) + v1(i) * dt_half
v2(i) = v0(i) + E1(i) * help_half
enddo
call EFeld_2(xTest,E2,*999)
do i = 1, 3
xTest(i) = x0(i) + v2(i) * dt
v3(i) = v0(i) + E2(i) * help
enddo
call EFeld_2(xTest,E3,*999)
do i = 1, 3
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
enddo
RETURN
999 RETURN 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE EFeld_2(x,E,*)
c =========================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Rechne in Gittereinheiten um:
real_i = (x(1)-xmin) / Dx_
real_j = abs(x(2)) / Dy_
real_k = abs(x(3)) / Dz_
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Mache die Tests und berechne die Feldstaerke:
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
END
c===============================================================================

553
accel/src/SUB_INTEGR_3.FOR Normal file
View File

@ -0,0 +1,553 @@
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_INFO_3
c ======================
IMPLICIT NONE
character*1 Nr
parameter (Nr='3')
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_MAP_3
c =====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='3')
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE ADD_MAP_3
c ====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='3')
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_3(dt)
c =============================================
IMPLICIT NONE
SAVE
character*1 Nr
parameter (Nr='3')
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
c zuerst ausgefuehrt).
c
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
c
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
c Ordnung in dt zu erhalten.
c
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
c fileheader von 'ACCEL.FOR')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
real help
real dt_save
integer i ! Zaehlvariable
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
real EFeld0(3), EFeld1(3) ! elektr. Felder
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
real xDifferenz(3), vDifferenz(3)
real x_1 ! Hilfsvariable fuer testweises x(1)
real a ! Beschleunigung
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
real errCon, safety ! fuer Schrittweitenkontrolle
real pShrink, pGrow ! fuer Schrittweitenkontrolle
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
PARAMETER (pShrink = -.25, pGrow = -.2)
! errCon = (4./safety)**(1/pGrow)
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
! der Fehler immer noch zu gross ist.
logical found_lower_upp ! obere und untere Grenze fuer dt um
logical found_upper_upp ! Uebergabebereich zu treffen
logical found_lower_low ! obere und untere Grenze fuer dt um
logical found_upper_low ! Uebergabebereich zu treffen
real dtlower,dtupper
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
flag_dtSmall = .false. ! flag resetten
found_lower_upp = .false.
found_upper_upp = .false.
found_lower_low = .false.
found_upper_low = .false.
if (dt.lt.dtsmall) dt = dtsmall
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
call EFeld_3(x,EFeld0,*998)
c...............................................................................
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
! abgeaendert werden muss.
dt_half = dt / 2.
c mache ersten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
c berechne EFeld bei x1:
x1(1) = x(1) + Dx1(1)
x1(2) = x(2) + Dx1(2)
x1(3) = x(3) + Dx1(3)
v1(1) = v(1) + Dv1(1)
v1(2) = v(2) + Dv1(2)
v1(3) = v(3) + Dv1(3)
call EFeld_3(x1,EFeld1,*999)
c mache zweiten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
Dx1(1) = Dx1(1) + Dx2(1)
Dx1(2) = Dx1(2) + Dx2(2)
Dx1(3) = Dx1(3) + Dx2(3)
Dv1(1) = Dv1(1) + Dv2(1)
Dv1(2) = Dv1(2) + Dv2(2)
Dv1(3) = Dv1(3) + Dv2(3)
c mache dt - Schritt:
call SINGLESTEP_RUNGE_KUTTA_3(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
c in positiver x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenende reflektiert werden koennte:
7766 continue
call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmax) then
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
x1(1) = xmax
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmax) then
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
x(1) = xmax
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
c in negativer x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenanfang reflektiert werden koennte:
7767 continue
call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmin) then
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
x1(1) = xmin
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmin) then
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
x(1) = xmin
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
998 if (returnCode_EFeld.EQ.1) then
write(*,*) 'Mappe '//Nr//':'
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
write(*,*)' -> STOP'
write(*,*)
STOP
endif
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
999 if (returnCode_EFeld.EQ.1) then
if (.NOT.found_upper_upp) dt_save = dt
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
elseif (returnCode_EFeld.EQ.3) then
if (.NOT.found_upper_low) dt_save = dt
dtupper = dt
found_upper_low = .true.
if (.NOT.found_lower_low) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.NE.0) then
write(*,*)
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
write(*,*) '-> STOP'
write(*,*)
STOP
endif
RETURN
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
c Trajektorie mit einer Mappenbegrenzung:
997 if (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
else
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
write(*,*) 'of trajectory and x equals xmax line.'
write(*,*)
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)
write(*,*) '-> STOP'
write(*,*)
STOP
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_3(dt,E0,x0,v0, Dx,Dv, *)
c ==========================================================
IMPLICIT NONE
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
c Runge-Kutta-Integrationsschritt (4. Ordnung).
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
c weise grosser Werte).
real Beschl_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
real E0(3), x0(3), v0(3) ! Eingangsgroessen
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
real xTest(3) ! Test-Orte
real Dx(3), Dv(3) ! Ergebnisspeicher
integer i ! Zaehlvariable
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
dt_half = dt / 2.
dt_sixth = dt / 6.
help = Beschl_Faktor * dt
help_half = help / 2.
help_sixth = help / 6.
do i = 1, 3
xTest(i) = x0(i) + v0(i) * dt_half
v1(i) = v0(i) + E0(i) * help_half
enddo
call EFeld_3(xTest,E1,*999)
do i = 1, 3
xTest(i) = x0(i) + v1(i) * dt_half
v2(i) = v0(i) + E1(i) * help_half
enddo
call EFeld_3(xTest,E2,*999)
do i = 1, 3
xTest(i) = x0(i) + v2(i) * dt
v3(i) = v0(i) + E2(i) * help
enddo
call EFeld_3(xTest,E3,*999)
do i = 1, 3
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
enddo
RETURN
999 RETURN 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE EFeld_3(x,E,*)
c =========================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Rechne in Gittereinheiten um:
real_i = (x(1)-xmin) / Dx_
real_j = abs(x(2)) / Dy_
real_k = abs(x(3)) / Dz_
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Mache die Tests und berechne die Feldstaerke:
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
END
c===============================================================================

553
accel/src/SUB_INTEGR_4.FOR Normal file
View File

@ -0,0 +1,553 @@
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_INFO_4
c ======================
IMPLICIT NONE
character*1 Nr
parameter (Nr='4')
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_MAP_4
c =====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='4')
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE ADD_MAP_4
c ====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='4')
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_4(dt)
c =============================================
IMPLICIT NONE
SAVE
character*1 Nr
parameter (Nr='4')
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
c zuerst ausgefuehrt).
c
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
c
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
c Ordnung in dt zu erhalten.
c
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
c fileheader von 'ACCEL.FOR')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
real help
real dt_save
integer i ! Zaehlvariable
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
real EFeld0(3), EFeld1(3) ! elektr. Felder
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
real xDifferenz(3), vDifferenz(3)
real x_1 ! Hilfsvariable fuer testweises x(1)
real a ! Beschleunigung
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
real errCon, safety ! fuer Schrittweitenkontrolle
real pShrink, pGrow ! fuer Schrittweitenkontrolle
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
PARAMETER (pShrink = -.25, pGrow = -.2)
! errCon = (4./safety)**(1/pGrow)
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
! der Fehler immer noch zu gross ist.
logical found_lower_upp ! obere und untere Grenze fuer dt um
logical found_upper_upp ! Uebergabebereich zu treffen
logical found_lower_low ! obere und untere Grenze fuer dt um
logical found_upper_low ! Uebergabebereich zu treffen
real dtlower,dtupper
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
flag_dtSmall = .false. ! flag resetten
found_lower_upp = .false.
found_upper_upp = .false.
found_lower_low = .false.
found_upper_low = .false.
if (dt.lt.dtsmall) dt = dtsmall
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
call EFeld_4(x,EFeld0,*998)
c...............................................................................
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
! abgeaendert werden muss.
dt_half = dt / 2.
c mache ersten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_4(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
c berechne EFeld bei x1:
x1(1) = x(1) + Dx1(1)
x1(2) = x(2) + Dx1(2)
x1(3) = x(3) + Dx1(3)
v1(1) = v(1) + Dv1(1)
v1(2) = v(2) + Dv1(2)
v1(3) = v(3) + Dv1(3)
call EFeld_4(x1,EFeld1,*999)
c mache zweiten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_4(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
Dx1(1) = Dx1(1) + Dx2(1)
Dx1(2) = Dx1(2) + Dx2(2)
Dx1(3) = Dx1(3) + Dx2(3)
Dv1(1) = Dv1(1) + Dv2(1)
Dv1(2) = Dv1(2) + Dv2(2)
Dv1(3) = Dv1(3) + Dv2(3)
c mache dt - Schritt:
call SINGLESTEP_RUNGE_KUTTA_4(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
c in positiver x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenende reflektiert werden koennte:
7766 continue
call EFeld_4(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmax) then
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
x1(1) = xmax
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_4(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmax) then
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
x(1) = xmax
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
c in negativer x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenanfang reflektiert werden koennte:
7767 continue
call EFeld_4(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmin) then
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
x1(1) = xmin
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_4(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmin) then
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
x(1) = xmin
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
998 if (returnCode_EFeld.EQ.1) then
write(*,*) 'Mappe '//Nr//':'
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
write(*,*)' -> STOP'
write(*,*)
STOP
endif
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
999 if (returnCode_EFeld.EQ.1) then
if (.NOT.found_upper_upp) dt_save = dt
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
elseif (returnCode_EFeld.EQ.3) then
if (.NOT.found_upper_low) dt_save = dt
dtupper = dt
found_upper_low = .true.
if (.NOT.found_lower_low) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.NE.0) then
write(*,*)
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
write(*,*) '-> STOP'
write(*,*)
STOP
endif
RETURN
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
c Trajektorie mit einer Mappenbegrenzung:
997 if (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
else
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
write(*,*) 'of trajectory and x equals xmax line.'
write(*,*)
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)
write(*,*) '-> STOP'
write(*,*)
STOP
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_4(dt,E0,x0,v0, Dx,Dv, *)
c ==========================================================
IMPLICIT NONE
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
c Runge-Kutta-Integrationsschritt (4. Ordnung).
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
c weise grosser Werte).
real Beschl_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
real E0(3), x0(3), v0(3) ! Eingangsgroessen
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
real xTest(3) ! Test-Orte
real Dx(3), Dv(3) ! Ergebnisspeicher
integer i ! Zaehlvariable
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
dt_half = dt / 2.
dt_sixth = dt / 6.
help = Beschl_Faktor * dt
help_half = help / 2.
help_sixth = help / 6.
do i = 1, 3
xTest(i) = x0(i) + v0(i) * dt_half
v1(i) = v0(i) + E0(i) * help_half
enddo
call EFeld_4(xTest,E1,*999)
do i = 1, 3
xTest(i) = x0(i) + v1(i) * dt_half
v2(i) = v0(i) + E1(i) * help_half
enddo
call EFeld_4(xTest,E2,*999)
do i = 1, 3
xTest(i) = x0(i) + v2(i) * dt
v3(i) = v0(i) + E2(i) * help
enddo
call EFeld_4(xTest,E3,*999)
do i = 1, 3
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
enddo
RETURN
999 RETURN 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE EFeld_4(x,E,*)
c =========================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Rechne in Gittereinheiten um:
real_i = (x(1)-xmin) / Dx_
real_j = abs(x(2)) / Dy_
real_k = abs(x(3)) / Dz_
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Mache die Tests und berechne die Feldstaerke:
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
END
c===============================================================================

553
accel/src/SUB_INTEGR_5.FOR Normal file
View File

@ -0,0 +1,553 @@
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_INFO_5
c ======================
IMPLICIT NONE
character*1 Nr
parameter (Nr='5')
INCLUDE 'accel$SOURCEdirectory:MAP_DEF_5.INC'
INCLUDE 'accel$SOURCEdirectory:READ_INFO.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE READ_MAP_5
c =====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='5')
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE ADD_MAP_5
c ====================
IMPLICIT NONE
character*1 Nr
parameter (Nr='5')
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_5(dt)
c =============================================
IMPLICIT NONE
SAVE
character*1 Nr
parameter (Nr='5')
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
c zuerst ausgefuehrt).
c
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
c
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
c Ordnung in dt zu erhalten.
c
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
c fileheader von 'ACCEL.FOR')
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
real help
real dt_save
integer i ! Zaehlvariable
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
real EFeld0(3), EFeld1(3) ! elektr. Felder
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
real xDifferenz(3), vDifferenz(3)
real x_1 ! Hilfsvariable fuer testweises x(1)
real a ! Beschleunigung
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
real errCon, safety ! fuer Schrittweitenkontrolle
real pShrink, pGrow ! fuer Schrittweitenkontrolle
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
PARAMETER (pShrink = -.25, pGrow = -.2)
! errCon = (4./safety)**(1/pGrow)
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
! der Fehler immer noch zu gross ist.
logical found_lower_upp ! obere und untere Grenze fuer dt um
logical found_upper_upp ! Uebergabebereich zu treffen
logical found_lower_low ! obere und untere Grenze fuer dt um
logical found_upper_low ! Uebergabebereich zu treffen
real dtlower,dtupper
integer returnCode_EFeld
COMMON /returnCode_EFeld/ returnCode_EFeld
! 1: Testort hinter der Mappe
! 2: Testort neben der Mappe
! 3: Testort vor der Mappe
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
flag_dtSmall = .false. ! flag resetten
found_lower_upp = .false.
found_upper_upp = .false.
found_lower_low = .false.
found_upper_low = .false.
if (dt.lt.dtsmall) dt = dtsmall
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
call EFeld_5(x,EFeld0,*998)
c...............................................................................
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
! abgeaendert werden muss.
dt_half = dt / 2.
c mache ersten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_5(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
c berechne EFeld bei x1:
x1(1) = x(1) + Dx1(1)
x1(2) = x(2) + Dx1(2)
x1(3) = x(3) + Dx1(3)
v1(1) = v(1) + Dv1(1)
v1(2) = v(2) + Dv1(2)
v1(3) = v(3) + Dv1(3)
call EFeld_5(x1,EFeld1,*999)
c mache zweiten dt/2 - Schritt:
call SINGLESTEP_RUNGE_KUTTA_5(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
Dx1(1) = Dx1(1) + Dx2(1)
Dx1(2) = Dx1(2) + Dx2(2)
Dx1(3) = Dx1(3) + Dx2(3)
Dv1(1) = Dv1(1) + Dv2(1)
Dv1(2) = Dv1(2) + Dv2(2)
Dv1(3) = Dv1(3) + Dv2(3)
c mache dt - Schritt:
call SINGLESTEP_RUNGE_KUTTA_5(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
c in positiver x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenende reflektiert werden koennte:
7766 continue
call EFeld_5(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmax) then
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
x1(1) = xmax
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_5(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmax-x(1))
if (help.LT.0) then ! noch vor Mappenende reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenende
if (a.NE.0) then
dt = (sqrt(help) - v(1))/a
else
dt = (xmax-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmax) then
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
x(1) = xmax
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
c in negativer x-Richtung geht.
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
c Mappenanfang reflektiert werden koennte:
7767 continue
call EFeld_5(x,EFeld0,*997) ! Efeld am aktuellen Ort
! a == Beschleunigung bei x in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
endif
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x1(1).NE.xmin) then
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
x1(1) = xmin
d endif
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
call EFeld_5(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
! wiederhole Berechnung mit mittlerem EFeld:
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
a = EFeld0(1)*Beschl_Faktor
! help == Radiant in entsprechender 'Mitternachtsformel'
help = v(1)*v(1) + 2.*a*(xmin-x(1))
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
reachedEndOfMap = .false.
dt = dt_save ! dt restaurieren
goto 3454 ! Festlegen des neuen dt, RETURN
else
! dt == Zeit bis Mappenanfang
if (a.NE.0) then
dt = (-sqrt(help) - v(1))/a
else
dt = (xmin-x(1))/v(1)
endif
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
endif
! Berechnen des neuen Ortes:
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
d if (x(1).NE.xmin) then
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
x(1) = xmin
d endif
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
! Berechnen der neuen Geschwindigkeit:
v(1) = v(1)+a*dt
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
! Berechnen der neuen Zeit:
t = t + dt
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
RETURN
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
998 if (returnCode_EFeld.EQ.1) then
write(*,*) 'Mappe '//Nr//':'
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
write(*,*)' -> STOP'
write(*,*)
STOP
endif
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
999 if (returnCode_EFeld.EQ.1) then
if (.NOT.found_upper_upp) dt_save = dt
dtupper = dt
found_upper_upp = .true.
if (.NOT.found_lower_upp) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
elseif (returnCode_EFeld.EQ.3) then
if (.NOT.found_upper_low) dt_save = dt
dtupper = dt
found_upper_low = .true.
if (.NOT.found_lower_low) then
dt = 0.5*dt
else
dt = (dtlower+dtupper)/2.
endif
goto 10
elseif (returnCode_EFeld.NE.0) then
write(*,*)
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
write(*,*) '-> STOP'
write(*,*)
STOP
endif
RETURN
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
c Trajektorie mit einer Mappenbegrenzung:
997 if (returnCode_EFeld.EQ.2) then
destiny = code_neben_Mappe
else
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
write(*,*) 'of trajectory and x equals xmax line.'
write(*,*)
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
write(*,*)' t = ',t
write(*,*)' x0 = ',x0
write(*,*)' v0 = ',v0
write(*,*)' E0 = ',E0
write(*,*)' theta0 = ',theta0
write(*,*)' phi0 = ',phi0
write(*,*)' x = ',x
write(*,*)' v = ',v
write(*,*)' Teilchen-Nr = ',Start_Nr
write(*,*)
write(*,*) '-> STOP'
write(*,*)
STOP
endif
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_5(dt,E0,x0,v0, Dx,Dv, *)
c ==========================================================
IMPLICIT NONE
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
c Runge-Kutta-Integrationsschritt (4. Ordnung).
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
c weise grosser Werte).
real Beschl_Faktor
COMMON /Beschl_Faktor/ Beschl_Faktor
real E0(3), x0(3), v0(3) ! Eingangsgroessen
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
real xTest(3) ! Test-Orte
real Dx(3), Dv(3) ! Ergebnisspeicher
integer i ! Zaehlvariable
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
dt_half = dt / 2.
dt_sixth = dt / 6.
help = Beschl_Faktor * dt
help_half = help / 2.
help_sixth = help / 6.
do i = 1, 3
xTest(i) = x0(i) + v0(i) * dt_half
v1(i) = v0(i) + E0(i) * help_half
enddo
call EFeld_5(xTest,E1,*999)
do i = 1, 3
xTest(i) = x0(i) + v1(i) * dt_half
v2(i) = v0(i) + E1(i) * help_half
enddo
call EFeld_5(xTest,E2,*999)
do i = 1, 3
xTest(i) = x0(i) + v2(i) * dt
v3(i) = v0(i) + E2(i) * help
enddo
call EFeld_5(xTest,E3,*999)
do i = 1, 3
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
enddo
RETURN
999 RETURN 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE EFeld_5(x,E,*)
c =========================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Rechne in Gittereinheiten um:
real_i = (x(1)-xmin) / Dx_
real_j = abs(x(2)) / Dy_
real_k = abs(x(3)) / Dz_
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Mache die Tests und berechne die Feldstaerke:
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
END
c===============================================================================

1007
accel/src/SUB_INTEGR_6.FOR Normal file

File diff suppressed because it is too large Load Diff

1705
accel/src/SUB_OUTPUT.FOR Normal file

File diff suppressed because it is too large Load Diff

336
accel/src/SUB_PICTURE.FOR Normal file
View File

@ -0,0 +1,336 @@
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE MASSTAB_SETZEN
c =========================
IMPLICIT NONE
REAL*4 X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
real scale
COMMON /scaleFactor/ scale
c DIMENSIONEN DES TRANSPORTSYSTEMS IN 'WELTKOORDINATEN'
CALL HLIMIT(1000000)
CALL HPLINT(0) ! init. HPLOT-package (without opening a
! graphics window)
c CALL IGZSET ('GZ') ! output to workstation and to ZEBRA
c 7-Aug-1996: herauskommentiert, da offensichtlich unnoetig oder sogar stoerend
c CALL IOPKS(6) ! init. graphic package (error mess. to screen)
c 7-Aug-1996: herauskommentiert, da HPLINT wohl IOPKS impliziert
CALL IOPWK(1,11,2) ! open WS for 'CHAMBER'
CALL IOPWK(4,31,3) ! open WS for 'HISTO'
CALL IOPWK(5,41,4) ! open WS for 'TEXT'
X1WC_P2 = -50.*scale
X2WC_P2 = 50.*scale
Y1WC_P2 = -50.*scale
Y2WC_P2 = 50.*scale
c MASSTAB SETZEN: (use normalization transformation index 2)
! Define window in world coordinates:
CALL ISWN(2, X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2)
! Define window in normalized device coordinates:
CALL ISVP(2, 0.,1.,0.,1.)
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE PLOT_CHAMBER
c =======================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:COM_GEO.INC'
real scale,help
COMMON /scaleFactor/ scale
REAL*4 X(14),Y(14)
real alfa_HeWindow ! halber Oeffnungswinkel des He-Fensters
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
CALL IZPICT ('CHAMBER','C') ! make 'CHAMBER' the currrent picture
CALL ISELNT (2) ! select norm. transf. index 2
help = scale * 50.
CALL IGBOX(-help,help,-help,help) ! BOX UM 1. KAMMERTEIL
C HIER WIRD GEZEICHNET:
! alle dy und dz geben die halbe Gesamtausdehnung an, dx die ganze!
c - He-Shield:
alfa_HeWindow = asinD(dy_HeWindow/rHeShield)
CALL IGARC (0.,0.,scale*rHeShield,scale*rHeShield,alfa_HeWindow,-alfa_HeWindow)
c - targethalter:
x(1) = scale * xFoil
x(2) = scale * xFoil
x(3) = scale * xEnd_TgtHolder
x(4) = scale * xEnd_TgtHolder
x(5) = scale * (xFoil-1)
x(6) = scale * (xFoil-1)
x(7) = scale * (xFoil)
x(8) = scale * (xFoil)
x(9) = scale * (xFoil-1)
x(10) = scale * (xFoil-1)
x(11) = scale * xEnd_TgtHolder
x(12) = scale * xEnd_TgtHolder
x(13) = scale * xFoil
x(14) = scale * xFoil
y(1) = scale * Dy_Foil
y(2) = scale * innerDy1_TgtHolder
y(3) = scale * innerDy2_TgtHolder
y(4) = scale * outerDy_TgtHolder
y(5) = scale * outerDy_TgtHolder
y(6) = scale * Dy_Foil
y(7) = scale * Dy_Foil
y(8) = -scale * Dy_Foil
y(9) = -scale * Dy_Foil
y(10) = -scale * outerDy_TgtHolder
y(11) = -scale * outerDy_TgtHolder
y(12) = -scale * innerDy2_TgtHolder
y(13) = -scale * innerDy1_TgtHolder
y(14)= -scale * Dy_Foil
CALL ISLWSC(2.) !LINIENDICKE: dicker
CALL IPL (14,X,Y)
CALL ISLWSC(1.) !LINIENDICKE: wieder duenn
c - moderatorflaeche:
x(1) = scale * xFoil
x(2) = scale * xFoil
y(1) = scale * Dy_Foil
y(2) = -scale * Dy_Foil
c CALL ISLN(3) !LINIENTYP: gepunktet
CALL ISLWSC(3.) !LINIENDICKE: dick
CALL IPL(2,X,Y)
CALL ISLWSC(1.) !LINIENDICKE: duenn
c CALL ISLN (1) !LINIENTYP: wieder durchgezogen
c - guardring:
if (xStart_Guardring.LE.xEnd_Guardring) then
CALL IGBOX ( scale * xStart_Guardring, scale * xEnd_Guardring,
+ scale * innerDy_Guardring, scale * outerDy_Guardring)
CALL IGBOX ( scale * xStart_Guardring, scale * xEnd_Guardring,
+ -scale * innerDy_Guardring, -scale * outerDy_Guardring)
endif
c - frame 1. grid:
if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
CALL IGBOX ( scale * xStart_Gridframe1, scale * xEnd_Gridframe1,
+ scale * innerDy_Gridframe1, scale * outerDy_Gridframe1)
CALL IGBOX ( scale * xStart_Gridframe1, scale * xEnd_Gridframe1,
+ -scale * innerDy_Gridframe1, -scale * outerDy_Gridframe1)
endif
c - frame 2. grid:
if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
CALL IGBOX ( scale * xStart_Gridframe2, scale * xEnd_Gridframe2,
+ scale * innerDy_Gridframe2, scale * outerDy_Gridframe2)
CALL IGBOX ( scale * xStart_Gridframe2, scale * xEnd_Gridframe2,
+ -scale * innerDy_Gridframe2, -scale * outerDy_Gridframe2)
endif
CALL ISLN (3) !LINIENTYP: gepunktet
CALL ISLWSC(1.) !LINIENDICKE: duenn
c - 1. grid:
if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
X(1) = scale * xPosition_Grid1
X(2) = scale * xPosition_Grid1
Y(1) = scale * y_Pos_lastWire1
Y(2) = -scale * y_Pos_lastWire1
CALL IPL (2,X,Y)
endif
c - 2. grid:
if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
X(1) = scale * xPosition_Grid2
X(2) = scale * xPosition_Grid2
Y(1) = scale * y_Pos_lastWire2
Y(2) = -scale * y_Pos_lastWire2
CALL IPL (2,X,Y)
endif
c - Achsen:
CALL ISLN(1) ! LINIENTYP: durchgezogen
help = scale * 40.
CALL IGAXIS (-help,help,-help,-help,-help,help,414,'O+') ! X-ACHSE
CALL IGAXIS (-help,-help,-help,help,-help,help,414,'O-') ! Y-ACHSE
c Graphik auf Bildschirm geben:
CALL IACWK(1) !aktiviere WS 1
CALL IZPICT('CHAMBER','D') !display 'CHAMBER'
CALL IGTERM !update open WS and return to
! alfanumeric mode
CALL IDAWK(1) !desaktiviere WS 1
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE TEXT_PLOT
c ====================
IMPLICIT NONE
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
integer GraphTextZeilen, i
CHARACTER GraphText(15)*30
COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText
CALL IZPICT('TEXT','C')
do i = 1, GraphTextZeilen
CALL IGTEXT(0.0,1.-real(i)/real(GraphTextZeilen),
+ GRAPHTEXT(i), 0.04,0.0,'L')
enddo
CALL IACWK(5)
CALL IZPICT('TEXT','D')
CALL IGTERM
CALL IDAWK(5)
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE PLOT_TRAJECTORY
c ==========================
IMPLICIT NONE
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000)
INTEGER TRAJ_N
COMMON/GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
CALL IZPICT('CHAMBER','C')
CALL ISELNT(2)
CALL ISLN(1)
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y)
CALL IACWK(1)
CALL ISELNT(2)
CALL IZPICT ('CHAMBER','D')
CALL IGTERM
CALL IDAWK(1)
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE SCHNITT_PLOT
c =======================
IMPLICIT NONE
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
CALL IACWK (4)
CALL IZPICT ('HISTO','C')
CALL HPLOT(50,'BOX',' ',1)
C CALL IZPICT('HISTO','D')
CALL IGTERM
CALL IDAWK (4)
END
c===============================================================================
OPTIONS /EXTEND_SOURCE
SUBROUTINE MAKE_PS(FILENAME)
c ============================
IMPLICIT NONE
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
REAL*4 XSIZE /12./, YSIZE /6./
CHARACTER*100 PSZEILE
CHARACTER*(*) FILENAME
INTEGER*4 RPAW(1000000)
COMMON /PAWC/ RPAW
OPEN (30,FILE='PPIC.TMP',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
+ STATUS='UNKNOWN')
c ZUSAMMENFUEGEN VON 'CHAMBER' UND 'TEXT':
CALL IGMETA(-30,-4121)
CALL IGRNG(XSIZE,YSIZE)
CALL IZPICT('CHAMBER','D')
CALL ICLRWK(2,0)
CALL IZPICT('TEXT','D')
CALL IGMETA(0,0)
CALL ICLWK(2)
C ANFUEGEN EINES blanks AN DEN ANFANG JEDER PS-FILE-ZEILE:
c (kann dies nicht durch entsprechende option beim oeffnen des files
c direkt erreicht werden?)
REWIND (30)
OPEN (UNIT=31,FILE=FILENAME//'.PS',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
+ STATUS='NEW')
38 READ (30, '(A100)', END=37) PSZEILE
WRITE (31,'(1X,A100)') PSZEILE
GOTO 38
37 CLOSE (30,STATUS='DELETE')
CLOSE (31)
END
c===============================================================================

28
mutrack/com/COMPILE.COM Normal file
View File

@ -0,0 +1,28 @@
$ set noverify
$!==============================================================================
$! Author: Anselm Hofer
$!
$! Commandoprozedur fuer das Compilieren einzelner MUTRACK oder ACCEL-Sourcecode
$! Dateien. Aufzurufen mittels '$ FORMU dateiName' bzw. '$ FORAC dateiName':
$!==============================================================================
$ progr = P1 ! = 'MUTRACK' oder 'ACCEL'
$ ext = P2 ! = '_MU' oder '_AC'
$ file = P3 ! = Name der .FOR-Datei (ohne Extension)
$!==============================================================================
$ file = file - ".FOR"
$ options = "/fast"
$!options = "/align=all"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ if archi .EQS. "VAX" then options = ""
$ if P4 .NES. "" then options = "''options' ''P4'"
$ ext = "''ext'_''archi'"
$
$ sourceFile = "''progr'$SOURCEdirectory:''file'"
$ objectFile = "''progr'$OBJdirectory:''file'''ext'"
$ listFile = "''progr'$OBJdirectory:''file'''ext'.lis"
$!==============================================================================
$ set verify
$ fortran/extend 'sourceFile' /object='objectFile' 'options'
$ set noverify
$! /list='listFile'

82
mutrack/com/COPY.COM Normal file
View File

@ -0,0 +1,82 @@
$ set noverify
$!==============================================================================
$! Author: Anselm Hofer
$!
$! Diese Commandoprozedur erlaubt es, die ACCEL- oder MUTRACK-Files
$! "AC_nnn1.'P3'" bis "AC_nnn2.'P3'" (bzw. "MU_nnn1.'P3'" bis "MU_nnn2.'P3'"
$! mit nnn1 = 'P4' und nnn2 = 'P5' auf neue Files zu kopieren, deren
$! fortlaufende Nummer um jeweils 'P6' erhoeht ist.
$!
$! Aufzurufen ueber '$ ACCOPY von bis offset' bzw. '$ MUCOPY von bis offset'
$!==============================================================================
$ if P6.EQS.""
$ then
$ say = "write sys$output "
$ say "==============================================================================="
$ say "ACCOPY extension firstNumber lastNumber offset"
$ say "MUCOPY extension firstNumber lastNumber offset"
$ say "==============================================================================="
$ exit
$ endif
$ progr = P1 ! = 'MUTRACK' oder 'ACCEL'
$ Kuerzel = P2 ! = 'MU_' oder 'AC_'
$
$ extension = P3
$ Firstindx = P4
$ Lastindx = P5
$ IndxOffset = P6
$!------------------------------------------------------------------------------
$
$ write sys$output " "
$ oldIndx = firstIndx
$
$ next:
$ newIndx = 0 + oldIndx + indxOffset ! '0 + ' notwendig, damit als Dezimal-
$ ! zahl interpretiert
$! -----------------------------------------------------------------------------
$ if oldIndx.LT.10
$ then
$ oldFile = "''progr'$outDirectory:''kuerzel'_000''oldIndx'.''extension'."
$ goto label1
$ endif
$ if oldIndx.LT.100
$ then
$ oldFile = "''progr'$outDirectory:''kuerzel'_00''oldIndx'.''extension'."
$ goto label1
$ endif
$ if oldIndx.LT.1000
$ then
$ oldFile = "''progr'$outDirectory:''kuerzel'_0''oldIndx'.''extension'."
$ goto label1
$ endif
$ oldFile = "''progr'$outDirectory:''kuerzel'_''oldIndx'.''extension'."
$! -----------------------------------------------------------------------------
$ label1:
$ if newIndx.LT.10
$ then
$ newFile = "''progr'$outDirectory:''kuerzel'_000''newIndx'.''extension'."
$ goto label2
$ endif
$ if newIndx.LT.100
$ then
$ newFile = "''progr'$outDirectory:''kuerzel'_00''newIndx'.''extension'."
$ goto label2
$ endif
$ if newIndx.LT.1000
$ then
$ newFile = "''progr'$outDirectory:''kuerzel'_0''newIndx'.''extension'."
$ goto label2
$ endif
$ newFile = "''progr'$outDirectory:''kuerzel'_''newIndx'.''extension'."
$! -----------------------------------------------------------------------------
$ label2:
$ cop /log 'oldFile' 'newFile'
$
$ if oldIndx.LT.LastIndx
$ then
$ oldIndx = oldIndx + 1
$ goto next
$ endif
$
$ write sys$output " "
$

3
mutrack/com/FORMUT.COM Normal file
View File

@ -0,0 +1,3 @@
$ set ver
$ fortran 'P1' /obj=mutrack$OBJdirectory:T-'P1'
$ set nover

1
mutrack/com/GETMU.COM Normal file
View File

@ -0,0 +1 @@
copy /log PSICLU::USR_SCROOT:[AHOFER]MU_'P1'.*. mutrack$OUTdirectory:*.*.

1
mutrack/com/GETMUG.COM Normal file
View File

@ -0,0 +1 @@
copy /log PSICLB::DSA999:[SCR142.GLUECKLER]MU_'p1'.*. mutrack$OUTdirectory:*.*.

1
mutrack/com/GETMUM.COM Normal file
View File

@ -0,0 +1 @@
copy /log PSICLB::DSA999:[SCR142.MHEUBERGER]MU_'P1'.*. mutrack$OUTdirectory:*.*.

View File

@ -0,0 +1,11 @@
$! fuer Tests mit zusaetlicher Linse 'NL':
$!==============================================================================
$ DEFINE mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.TEST2]
$ FORMUT :== "@mutrack$COMdirectory:formut.com"
$ LINKMUT :== "@mutrack$COMdirectory:linkmut.com"
$ LINKMUTV :== "@mutrack$COMdirectory:linkmutv.com"
$ MU*TRACK :== "RUN mutrack$EXEdirectory:T-MUTRACK.EXE"
$ SUBTMU :== -
"SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:T-MUTRACK.COM"
$ LSEMUT :== "LSE mutrack$READdirectory:mutrackT.input"
$!==============================================================================

33
mutrack/com/LINKMU.COM Normal file
View File

@ -0,0 +1,33 @@
$ set noverify
$ set noon
$!==============================================================================
$ prog= "mutrack"
$ ext = "_MU"
$!==============================================================================
$ sourceDir = "''prog'$SOURCEdirectory"
$ objectDir = "''prog'$OBJdirectory"
$ executeDir = "''prog'$EXEdirectory"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ ext = "''ext'_''archi'"
$ set verify
$!==============================================================================
$ link -
'objectDir':MUTRACK'ext', -
'objectDir':SUB_ARTLIST'ext', -
'objectDir':SUB_INTEGR_L1'ext', -
'objectDir':SUB_INTEGR_SP'ext', -
'objectDir':SUB_INTEGR_L2andFo'ext', -
'objectDir':SUB_INTEGR_FO'ext', -
'objectDir':SUB_INTEGR_L3'ext', -
'objectDir':SUB_INTEGR_M2'ext', -
'objectDir':SUB_INPUT'ext', -
'objectDir':SUB_PICTURE'ext', -
'objectDir':SUB_OUTPUT'ext',-
'objectDir':SUB_TRIGGER'ext', -
'objectDir':SUB_ELOSS'ext', -
'cernlibs' /exe='executeDir':MUTRACK_'archi'
$ purge 'executeDir':*.EXE
$ set on
$ set noverify
$!==============================================================================

16
mutrack/com/LINKMUD.COM Normal file
View File

@ -0,0 +1,16 @@
$ set verify
$ link -
mutrack$directory:[exe]MUTRACK, -
mutrack$directory:[exe]SUB_ARTLIST, -
mutrack$directory:[exe]SUB_INTEGR_KL, -
mutrack$directory:[exe]SUB_INTEGR_Sp, -
mutrack$directory:[exe]SUB_INTEGR_FO, -
mutrack$directory:[exe]SUB_INTEGR_WL, -
mutrack$directory:[exe]SUB_INTEGR_M2, -
mutrack$directory:[exe]SUB_INPUT, -
mutrack$directory:[exe]SUB_PICTURE, -
mutrack$directory:[exe]SUB_OUTPUT,-
mutrack$directory:[exe]SUB_TRIGGER, -
'cernlibs' /debug /exe=mutrack$directory:[exe]MUTRACK
$ purge mutrack$directory:[exe]
$ set noverify

18
mutrack/com/LINKMUT.COM Normal file
View File

@ -0,0 +1,18 @@
$ set verify
$ link -
mutrack$directory:[exe]T-MUTRACK, -
mutrack$directory:[exe]T-SUB_ARTLIST, -
mutrack$directory:[exe]T-SUB_INTEGR_KL, -
mutrack$directory:[exe]T-SUB_INTEGR_Sp, -
mutrack$directory:[exe]T-SUB_INTEGR_NL, -
mutrack$directory:[exe]T-SUB_INTEGR_FO, -
mutrack$directory:[exe]T-SUB_INTEGR_WL, -
mutrack$directory:[exe]T-SUB_INTEGR_M2, -
mutrack$directory:[exe]T-SUB_INPUT, -
mutrack$directory:[exe]T-SUB_PICTURE, -
mutrack$directory:[exe]T-SUB_OUTPUT,-
mutrack$directory:[exe]T-SUB_TRIGGER, -
mutrack$directory:[exe]T-SUB_ELOSS, -
'cernlibs' /exe=mutrack$directory:[exe]T-MUTRACK
$ purge mutrack$directory:[exe]
$ set noverify

46
mutrack/com/LINKMUTV.COM Normal file
View File

@ -0,0 +1,46 @@
$ set verify
$ set noon
$ fortran mutrack$SOURCEdirectory:MUTRACK -
/object=mutrack$EXEdirectory:T-MUTRACK
$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST -
/object=mutrack$EXEdirectory:T-SUB_ARTLIST
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_KL
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_SP
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_NL -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_NL
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_FO
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_WL
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 -
/object=mutrack$EXEdirectory:T-SUB_INTEGR_M2
$ fortran mutrack$SOURCEdirectory:SUB_INPUT -
/object=mutrack$EXEdirectory:T-SUB_INPUT
$ fortran mutrack$SOURCEdirectory:SUB_PICTURE -
/object=mutrack$EXEdirectory:T-SUB_PICTURE
$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT -
/object=mutrack$EXEdirectory:T-SUB_OUTPUT
$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER -
/object=mutrack$EXEdirectory:T-SUB_TRIGGER
$ fortran mutrack$SOURCEdirectory:SUB_ELOSS -
/object=mutrack$EXEdirectory:T-SUB_ELOSS
$ link -
mutrack$EXEdirectory:T-MUTRACK, -
mutrack$EXEdirectory:T-SUB_ARTLIST, -
mutrack$EXEdirectory:T-SUB_INTEGR_KL, -
mutrack$EXEdirectory:T-SUB_INTEGR_SP, -
mutrack$EXEdirectory:T-SUB_INTEGR_NL, -
mutrack$EXEdirectory:T-SUB_INTEGR_FO, -
mutrack$EXEdirectory:T-SUB_INTEGR_WL, -
mutrack$EXEdirectory:T-SUB_INTEGR_M2, -
mutrack$EXEdirectory:T-SUB_INPUT, -
mutrack$EXEdirectory:T-SUB_PICTURE, -
mutrack$EXEdirectory:T-SUB_OUTPUT,-
mutrack$EXEdirectory:T-SUB_TRIGGER, -
mutrack$EXEdirectory:T-SUB_ELOSS, -
'cernlibs' /exe=mutrack$EXEdirectory:T-MUTRACK
$ purge mutrack$EXEdirectory
$ set on
$ set noverify

82
mutrack/com/LINKMUV.COM Normal file
View File

@ -0,0 +1,82 @@
$ set noverify
$!==============================================================================
$! Author: Anselm Hofer
$!
$! Commandoprozedur fuer das Compilieren und Linken des kompletten MUTRACK-
$! Quelltextes. Aufzurufen mittels '$ LINKMUV'. ('V' steht fuer 'Vollstaendig').
$!==============================================================================
$ set noon
$!==============================================================================
$ prog= "mutrack"
$ ext = "_MU"
$!==============================================================================
$ sourceDir = "''prog'$SOURCEdirectory"
$ objectDir = "''prog'$OBJdirectory"
$ executeDir = "''prog'$EXEdirectory"
$!==============================================================================
$ options = "/fast /nolist"
$! options = "/fast /nolist /warn=nogeneral"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ ext = "''ext'_''archi'"
$ if archi .EQS. "VAX" then options = ""
$ if P1 .NES. "" then options = "''options' ''P1'"
$
$ file = "MUTRACK"
$ CALL compile
$ file = "SUB_ARTLIST
$ CALL compile
$ file = "SUB_INTEGR_L1
$ CALL compile
$ file = "SUB_INTEGR_SP
$ CALL compile
$ file = "SUB_INTEGR_L2andFo
$ CALL compile
$ file = "SUB_INTEGR_FO
$ CALL compile
$ file = "SUB_INTEGR_L3
$ CALL compile
$ file = "SUB_INTEGR_M2
$ CALL compile
$ file = "SUB_INPUT
$ CALL compile
$ file = "SUB_PICTURE
$ CALL compile
$ file = "SUB_OUTPUT
$ CALL compile
$ file = "SUB_TRIGGER
$ CALL compile
$ file = "SUB_ELOSS"
$ CALL compile
$!==============================================================================
$ set verify
$ purge 'objectDir':*.OBJ
$ link -
'objectDir':MUTRACK'ext', -
'objectDir':SUB_ARTLIST'ext', -
'objectDir':SUB_INTEGR_L1'ext', -
'objectDir':SUB_INTEGR_SP'ext', -
'objectDir':SUB_INTEGR_L2andFo'ext', -
'objectDir':SUB_INTEGR_FO'ext', -
'objectDir':SUB_INTEGR_L3'ext', -
'objectDir':SUB_INTEGR_M2'ext', -
'objectDir':SUB_INPUT'ext', -
'objectDir':SUB_PICTURE'ext', -
'objectDir':SUB_OUTPUT'ext',-
'objectDir':SUB_TRIGGER'ext', -
'objectDir':SUB_ELOSS'ext', -
'cernlibs' /exe='executeDir':MUTRACK_'archi'
$ purge 'executeDir':*.EXE
$ set on
$ set noverify
$ EXIT
$
$!==============================================================================
$
$ COMPILE: SUBROUTINE
$ comp = "fortran ''sourceDir':''file' ''options' /object=''objectDir':''file'''ext'"
$ write sys$output "=============================================================================="
$ write sys$output "''COMP'"
$ comp
$ ENDSUBROUTINE
$!==============================================================================

38
mutrack/com/LINKMUVD.COM Normal file
View File

@ -0,0 +1,38 @@
$ set verify
$ fortran mutrack$SOURCEdirectory:MUTRACK /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INPUT /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_PICTURE /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER /warn=nogen -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ link -
mutrack$EXEdirectory:MUTRACK, -
mutrack$EXEdirectory:SUB_ARTLIST, -
mutrack$EXEdirectory:SUB_INTEGR_KL, -
mutrack$EXEdirectory:SUB_INTEGR_SP, -
mutrack$EXEdirectory:SUB_INTEGR_FO, -
mutrack$EXEdirectory:SUB_INTEGR_WL, -
mutrack$EXEdirectory:SUB_INTEGR_M2, -
mutrack$EXEdirectory:SUB_INPUT, -
mutrack$EXEdirectory:SUB_PICTURE, -
mutrack$EXEdirectory:SUB_OUTPUT,-
mutrack$EXEdirectory:SUB_TRIGGER, -
'cernlibs' /debug /exe=mutrack$EXEdirectory:MUTRACK
$ purge mutrack$EXEdirectory
$ set noverify

53
mutrack/com/LINKMUVVD.COM Normal file
View File

@ -0,0 +1,53 @@
$ set verify
$ fortran mutrack$SOURCEdirectory:MUTRACK -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_ARTLIST -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_KL -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_SP -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_FO -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_WL -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INTEGR_M2 -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_INPUT -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_PICTURE -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_OUTPUT -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_TRIGGER -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ fortran mutrack$SOURCEdirectory:SUB_ELOSS -
/warn=(noali,decl,gen,inline,trun,uncall,unini,unused,usa,vaxeln) -
/check /list /debug /noopt /object=mutrack$EXEdirectory
$ link -
mutrack$EXEdirectory:MUTRACK, -
mutrack$EXEdirectory:SUB_ARTLIST, -
mutrack$EXEdirectory:SUB_INTEGR_KL, -
mutrack$EXEdirectory:SUB_INTEGR_SP, -
mutrack$EXEdirectory:SUB_INTEGR_FO, -
mutrack$EXEdirectory:SUB_INTEGR_WL, -
mutrack$EXEdirectory:SUB_INTEGR_M2, -
mutrack$EXEdirectory:SUB_INPUT, -
mutrack$EXEdirectory:SUB_PICTURE, -
mutrack$EXEdirectory:SUB_OUTPUT,-
mutrack$EXEdirectory:SUB_TRIGGER, -
mutrack$EXEdirectory:SUB_ELOSS, -
'cernlibs' /debug /exe=mutrack$EXEdirectory:MUTRACK
$ purge mutrack$EXEdirectory
$ set noverify

View File

@ -0,0 +1,99 @@
OPTIONS /EXTEND_SOURCE
c PROGRAM WRITELOG
c ================
c===============================================================================
c Dieses Programm uebernimmt aus der Command Zeile eine Runnummer und
c uebertraegt den Header des zugehoerigen Logfiles in WRITELOG_nnnn.OUT.
c (Arbeitet mit 'WRITELOG.COM' zusammen beim ausdrucken von Fileheadern)
c===============================================================================
IMPLICIT NONE
c Deklarationen fuer das Einlesen der Runnummer von der Commandline:
external cli$get_value
integer cli$get_value
integer status
character*4 runNumber
integer length
c sonstige Deklarationen:
character*80 zeile
integer i, iostat, marke
logical flag
c-------------------------------------------------------------------------------
c Lies Runnummer aus Commandline:
status = cli$get_value('runNumber',runNumber,length)
if (.NOT.status) call lib$signal(%val(status))
call str$trim(runNumber,runNumber,length)
c Oeffne zugehoeriges LOGfile:
open (20,file='mutrack$OUTdirectory:MU_'//runNumber//'.LOG',status='OLD',
+ readonly,iostat=iostat)
if (iostat.NE.0) then
write(*,*)
write(*,*)'can''t find mutrack$OUTdirectory:MU_'//runNumber//'.LOG'
write(*,*)'-> STOP'
write(*,*)
STOP
endif
c Oeffne WRITELOG_nnnn.OUT:
open (21,file='mutrack$OUTdirectory:WRITELOG_'//runNumber//'.OUT',
+ status='NEW')
c Uebertrage die Headerzeilen:
c do i = 1, 130
c read(20,'(A)',end=20) zeile
c write(21,'(xA)') zeile
c enddo
c write(21,*)
c write(21,*)' >>>>>>>>>> AUSDRUCK HIER ABGEBROCHEN >>>>>>>>>>'
c - Teste, ob LOGfile mehr als 140 Zeilen hat. Falls ja, drucke nur den
c Haeder. Andernfalls drucke das ganze Logfile
flag = .false.
marke = -10
do i = 1, 141
read(20,'(A)',end=10) zeile
if (index(Zeile,'>>>>> T E S T - R U N <<<<<').NE.0) marke = i
enddo
flag = .true. ! -> nur Headerzeilen schreiben
10 rewind(20)
do i = 1, 140
read(20,'(A)',end=20) zeile
if (flag .AND. index(Zeile,'>>> Schleife :').NE.0) goto 20
if (i.NE.marke .AND. i.NE.marke+1) then
write(21,'(xA)') zeile
endif
enddo
c Schliesse die Files:
20 close (20)
close (21)
END

View File

@ -0,0 +1,62 @@
$ set noverify
$!==============================================================================
$! Author: Anselm Hofer
$!
$! Commandoprozedur fuer das Erstellen von Dateien 'CODENUMMERN.LIST', welche
$! die von ACCEL bzw. MUTRACK verwendeten Code-Nummern fuer Integrationsgebiet
$! und Teilchenchicksal erstellen. Diese Dateien werden nach den Directories
$! ACCEL$SOURCEdirectory bzw. MUTRACK$SOURCEdirectory kopiert und koennen von
$! VMS-Ebene oder von PAW aus mittels 'ACCODE' bzw. 'MUCODE' ausgegeben werden.
$!
$! Der Aufruf dieser Prozedur fuer das Erstellen der Dateien geschieht ueber
$! MAKEACCODE / MAKEMUCODE.
$!==============================================================================
$ progr = P1 ! = 'MUTRACK' oder 'ACCEL'
$ ext = P2 ! = '_MU' oder '_AC'
$ flag = P3 ! = 'MAKE' oder 'TYPE'
$!==============================================================================
$ sourceFile = "mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.FOR."
$ objectFile = "''progr'$COMdirectory:MAKE''ext'_CODENUMMERN-LIST.OBJ"
$ exeFile = "''progr'$COMdirectory:MAKE''ext'_CODENUMMERN-LIST.EXE"
$ listFile = "''progr'$SOURCEdirectory:CODENUMMERN.LIST"
$!==============================================================================
$ if p3.EQS."MAKE" then goto make
$ if p3.EQS."TYPE" then goto type
$ if p3.EQS." " then write sys$output "missing parameter P3 (""MAKE"" or ""TYPE"")"
$ write sys$output "unknown parameter P3: ''P3'"
$!==============================================================================
$ MAKE:
$! Compilieren und Linken des Programms fuer den Ausdruck der Liste (muss
$! jedesmal neu gemacht werden, damit die Liste wirklich die aktuellen Code-
$! Nummern enthaelt):
$!
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ if archi .EQS. "VAX" then options = " "
$ if archi .EQS. "Alpha" then options = " /ali=all"
$
$ define MAKE_CODENUMMERN_INCFILE1 "''progr'$SOURCEdirectory:COM_''progr'.INC"
$ define MAKE_CODENUMMERN_INCFILE2 "''progr'$SOURCEdirectory:INITIALIZE.INC"
$ set verify
$ fortran 'sourceFile' /object='objectFile' 'options'
$ link 'objectFile' /exe='exeFile'
$ set noverify
$
$ del 'objectFile'.* /nocon
$ pu 'exeFile'
$ deassign MAKE_CODENUMMERN_INCFILE1
$ deassign MAKE_CODENUMMERN_INCFILE2
$
$! Erstellen der Liste durch Aufruf des Programms:
$ tmp == F$TRNLNM("''progr'$SOURCEdirectory")
$ define MAKE_CODENUMMERN_OUTDIR "''TMP'"
$ run 'exeFile'
$ deassign MAKE_CODENUMMERN_OUTDIR
$ purge 'listFile'
$
$ EXIT
$!==============================================================================
$ TYPE:
$! Ausgabe der Liste:
$ TYPE 'listFile'
$ EXIT
$!==============================================================================

View File

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

8
mutrack/com/MUTRACK.COM Normal file
View File

@ -0,0 +1,8 @@
$! in case a privious submitted batchjob didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON
$! run mutrack$EXEdirectory:MUTRACK.EXE
$ MUTRACK
$! in case MUTRACK didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON

View File

@ -0,0 +1,36 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
$! ARBEIT MIT MUTRACK (ALS BATCH UND INTERAKTIV)
$!******************************************************************************
$ node = "PSW264"
$
$ define /trans=con mutrackSRC$directory "UD1:[SIMULA.MUTRACK.]
$ define mutrack$COMdirectory "mutrackSRC$directory:[com]"
$ define mutrack$MAPPENdirectory "UD1:[simula.mappen.mutrack]","UD1:[simula.mappen.testmappen]"
$ define mutrack$AHdirectory "accel$OUTdirectory"
$ define mutrack$GEOdirectory "mutrackSRC$directory:[geo_files]"
$ define mutrack$EXEdirectory "mutrackSRC$directory:[exe]"
$ define mutrack$RDdirectory "mutrackSRC$directory:[RD-kumac]"
$!------------------------------------------------------------------------------
$ define mutrack$PHYSICASRCdirectory "UD0:[simula.physica_source.mutrack]"
$!==============================================================================
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
$ MU*TRACK :== "RUN mutrack$EXEdirectory:MUTRACK_''archi'.EXE"
$ MUDIR :== "dir mutrack$OUTdirectory:MU*.*.*
$ MULIST :== "dir mutrack$OUTdirectory:MU*.LOG.
$ LSEMU :== "LSE mutrack$READdirectory:MUTRACK.INPUT"
$ LSEMUNR :== "LSE mutrack$NRdirectory:mutrack_nr.dat
$ MUGEO :== "SET DEF UD1:[SIMULA.MUTRACK.GEO_FILES]"
$ MUSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS MUTRACK MU TRACK"
$ WRITEMULOG :== "@ mutrack$COMdirectory:WRITELOG.COM"
$ MAKEMUCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM MUTRACK _MU MAKE
$ MUCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM MUTRACK _MU TYPE
$ MUCOPY :== "@ mutrack$COMdirectory:COPY.COM MUTRACK MU"
$!------------------------------------------------------------------------------
$ SUBMU*TRACK :== -
"SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:MUTRACK.COM
$ SUBMULIST*BATCH :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_BATCH"
$ SUBMULISTF*AST :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_FAST"
$ SUBMULISTS*LOW :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_SLOW"
$ SUBMULISTD*EAD :== "@ mutrack$COMdirectory:SUB_LIST MU MUTRACK ''node'_DEAD"
$!==============================================================================

View File

@ -0,0 +1,12 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
$! ARBEIT MIT MUTRACK (ALS BATCH UND INTERAKTIV)
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
$!******************************************************************************
$ define mutrack$directory "UD1:[simula.mutrack.calc]"
$ define mutrack$READdirectory "mutrack$directory"
$ define mutrack$OUTdirectory "mutrack$directory"
$ define mutrack$NrDirectory "mutrack$directory"
$ MUCALC :== "SET DEF mutrack$directory"
$ MUPH*YS :== "SET DEF UD1:[simula.mutrack.physica]"
$!==============================================================================

View File

@ -0,0 +1,28 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT SYMBOLS FUER DIE INTERAKTIVE ARBEIT MIT
$! MUTRACK
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
$!******************************************************************************
$ LSEMU :== "LSE mutrack$READdirectory:mutrack.input
$ MUCALC :== "SET DEF UD1:[SIMULA.MUTRACK.CALC]"
$ MUPH*YS :== "SET DEF UD0:[SIMULA.PHYSICA_SOURCE.MUTRACK]"
$ MUSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS.COM MUTRACK MU TRACK"
$ MUGEO :== "SET DEF UD0:[SIMULA.MUTRACK.GEO_FILES]"
$ WRITEMULOG :== "@ mutrack$COMdirectory:WRITELOG.COM"
$!------------------------------------------------------------------------------
$ SUBMU*TRACK :== -
"SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory mutrack$COMdirectory:MUTRACK.COM"
$ SUBMULIST :== "@ mutrack$COMdirectory:SUB_LIST.COM MU MUTRACK"
$!==============================================================================
$! OBSOLETE:
$ SUBMULIST1 :== -
"SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST1/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST1.COM"
$ SUBMULIST2 :== -
"SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST2/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST2.COM"
$ SUBMULIST3 :== -
"SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST3/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST3.COM"
$ SUBMULIST4 :== -
"SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST4/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST4.COM"
$ SUBMULIST5 :== -
"SUBMIT/NOTIFY/NOPRINT/QUEUE=PSW264_SLOW/NAME=MU_LIST5/LOG_FILE=mutrack$OUTdirectory mutrack$READdirectory:LIST5.COM"
$!==============================================================================

View File

@ -0,0 +1,22 @@
$!******************************************************************************
$! DIESE KOMMANDOPROZEDUR DEFINIERT LOGICALS UND SYMBOLS FUER DIE PROGRAMMIER-
$! ARBEIT, DAS KOMPILIEREN UND LINKEN VON MUTRACK (INTERAKTIV)
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
$!******************************************************************************
$ define mutrack$OBJdirectory "mutrackSRC$directory:[EXE]"
$ OLDMU :== "define mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.OLD_SOURCE]"
$ NEWMU :== "define mutrack$SOURCEdirectory UD1:[SIMULA.MUTRACK.SOURCE]"
$ NEWMU
$
$ SETMUTEST :== "SET DEF UD1:[SIMULA.MUTRACK.NEWTEST]"
$ MUPHYSRC :== "SET DEF UD0:[simula.physica_source.mutrack]"
$!------------------------------------------------------------------------------
$ MUCOM :== "SET DEF UD1:[SIMULA.MUTRACK.COM]"
$ MUSOURCE :== "SET DEF mutrack$SOURCEdirectory"
$ MUMAP :== "SET DEF mutrack$MAPPENdirectory"
$ FORMU :== "@mutrack$COMdirectory:compile.com MUTRACK _MU "
$ LINKMU :== "@mutrack$COMdirectory:linkmu.com"
$ LINKMUV :== "@mutrack$COMdirectory:linkmuv.com"
$ LINKMUD :== "@mutrack$COMdirectory:linkmud.com"
$ LINKMUVD :== "@mutrack$COMdirectory:linkmuvd.com"
$!==============================================================================

View File

@ -0,0 +1,85 @@
$ SET NOVERIFY
$! P1 = 'PROGR' = PROGRAMMNAME = "MUTRACK" bzw. "ACCEL"
$! P2 = KUERZEL = "MU" bzw. "AC"
$! P3 = OBTIONALER TEIL DES PROGRAMMAUFRUFES = "TRACK" bzw. "CEL"
$!==============================================================================
$! LAEUFT 'PROGR' ALS BATCHJOB, SO WIRD (BEI MEHR ALS EINER SCHLEIFE)
$! DER AKTUELLE NAME DER AUSGABEDATEIEN SOWIE DIE NUMMER DER GERADE
$! ABGEARBEITETEN SCHLEIFE IN EINER DATEI "''PROGR'.MESSAGE" ABGELEGT.
$! MIT DER VORLIEGENDEN KOMMANDOPROZEDUR WIRD DIESE INFORMATION AUS
$! DER .MESSAGE-DATEI AUSGELESEN UND AUF DEN BILDSCHIRM GEGEBEN.
$! AH, 12-JUN-1996
$!==============================================================================
$ SET NOVERIFY
$ SET ON
$ SAY := WRITE SYS$OUTPUT
$ SHOW TIME
$
$ MAXLISTINDX = 20
$
$ FLAG = 0
$ NOTLASTTIME = 1
$ listIndx = 1
$ ON ERROR THEN GOTO READERROR
$
$ LOOP:
$ messageName = "SYS$SCRATCH:''P2'_LIST''listIndx'.MESSAGE"
$
$ FILEOPEN:
$ OPEN/READ/SHARE=WRITE/ERROR=next messagefile 'messageName'
$ flag = 1
$ SAY "================================================================================"
$ IF NOTLASTTIME THEN READ messagefile NUMMER
$ READ messagefile TIME1
$ READ messagefile INPUTNAME
$ READ messagefile FILENAME
$ READ messagefile LOOPINFO
$ READ messagefile TIME2
$ CLOSE messagefile
$ IF NOTLASTTIME
$ THEN
$ SAY "JOB SUBMITTED WITH ""SUB''P2'LIST ''listIndx'"":"
$ ELSE
$ SAY "JOB SUBMITTED WITH ""SUB''P2'*''P3'"":"
$ ENDIF
$ SAY " NAME OF INPUT FILE : ''INPUTNAME'"
$ IF NOTLASTTIME
$ THEN
$ SAY " (''NUMMER'. file in input_file list,''TIME1')"
$ ELSE
$ SAY " (''TIME1')"
$ ENDIF
$ SAY " NAME OF OUTPUT FILES: ''FILENAME'"
$ LOOPINFO = LOOPINFO-" "
$ SAY " ''LOOPINFO'"
$ SAY " (''TIME2')"
$ GOTO next
$ !
$ READERROR:
$ SAY "reading ''messageName'"
$ CLOSE messagefile
$ !
$ NEXT:
$ IF listIndx.LE.maxListIndx
$ THEN
$ listIndx = listIndx + 1
$ IF listIndx.LE.maxListIndx
$ THEN
$ GOTO LOOP
$ ELSE
$ messageName = "SYS$SCRATCH:''P1'.MESSAGE
$ NOTLASTTIME = 0
$ GOTO FILEOPEN
$ ENDIF
$ ELSE
$ IF FLAG.EQ.0
$ THEN
$ SAY " THERE ARE NO APPROPRIATE ''P2'*.MESSAGE-FILES IN SYS$SCRATCH"
$ ELSE
$ SAY "================================================================================"
$ SAY " ( -> SYS$SCRATCH:''P2'*.MESSAGE )"
$ ENDIF
$ ENDIF
$ !
$ SAY "================================================================================"
$ EXIT

View File

@ -0,0 +1,52 @@
options /extend_source
program READ_EVENTNRS
c =====================
implicit none
c-------------------------------------------------------------------------------
c Programm, welches aus dem output eines
c
c $ SEARCH mutrack$outDirectory:MU_nnnn.LOG "MCP2 getroffen" /OUT=SEARCHLIST.TMP
c
c die je Schleife bei einem cut auf MCP2-Treffer in ein NTupel gefuellte
c Anzahl simulierter Events bestimmt.
c-------------------------------------------------------------------------------
INTEGER LOOP,NEVENT,IEVENT
CHARACTER*80 ZEILE
c-------------------------------------------------------------------------------
loop = 0
nEvent = 0
iEvent = 1
open (10,file='SEARCHLIST.TMP',status='old',readonly)
open (11,file='EVENTNRS.TMP',status='unknown')
10 read(10,'(A)',err=999,end=100) ZEILE
read(zeile(48:54),*,err=1000) nEvent
loop = loop + 1
c WRITE(*,*) loop,nEvent,iEvent
write(11,*) loop,nEvent,iEvent
iEvent = iEvent+nEvent
goto 10
100 close(10)
close(11)
call exit
999 write(*,*) 'can''t read from SEARCHLIST.TMP'
write(*,*) 'loop,nEvent,iEvent = ',loop,nEvent,iEvent
call exit
1000 write(*,*)
write(*,*) zeile
write(*,*) zeile(48:54)
end

82
mutrack/com/SUB_LIST.COM Normal file
View File

@ -0,0 +1,82 @@
$!==============================================================================
$! KOMMANDOPROZEDUR FUER DAS SUBMITTEN VON 'INPUTFILE-LISTEN' VON MUTRACK UND
$! ACCEL MITTELS 'SUBMULISTn' BZW. 'SUBACLISTn'.
$!==============================================================================
$! 1. LOESCHE GEGEBENENFALLS DAS .MESSAGE FILE
$! 2. IN DER SCHLEIFE: VERSUCHE DAS .MESSAGE-FILE ZU OEFFNEN
$! 3. GELINGT DIES NICHT, SO WURDE DIE KOMMANDOPROZEDUR GERADE ERST GESTARTET.
$! EIN PROGRAMMDURCHLAUF WIRD DANN AUF JEDEN FALL PORBIERT.
$! 4. LIES BEI NEUEM VERSUCH ERST DIE NUMMER DES ZULETZT ABGEARBEITETEN INPUT-
$! FILES. IST DIESE = 1, SO LOESCHE DAS .MESSAGE FILE UND BEENDE PROZEDUR
$!==============================================================================
$! P1 = KUERZEL DES PROGRAMMES = "MU" bzw. "AC"
$! P2 = PROGRAMMAUFRUF = "MUTRACK" bzw. "ACCEL"
$! P3 = QUEUE
$! P4 = NUMMER DER INPUTLISTE (WAHRSCHEINLICH AUF 1-9 EINGESCHRAENKT)
$! P5 = QUEUE-ENTRY, AUF DEN SYNCHRONISIERT WERDEN SOLL
$!==============================================================================
$! Definition der Filenamen:
$ INPUTLISTNAME = "LIST''P4'"
$ COMFILENAME = "SYS$SCRATCH:'P1'_LIST'P4'.COM"
$ MESSFILENAME = "SYS$SCRATCH:''P1'_LIST''P4'.MESSAGE"
$!
$! Oeffnen des files fuer die zu submittende Kommandoprozedur:
$ FILE = F$SEARCH("''COMFILENAME'")
$ IF FILE .NES. "" THEN DELETE 'COMFILENAME'.* /NOCON
$ OPEN /WRITE comfile 'COMFILENAME'
$ OUT := WRITE COMFILE
$!
$! Erstellen der zu submittenden Kommandoprozedur:
$ OUT "$! DIESE KOMMANDOPROZEDUR WURDE DURCH 'SUB_LIST.COM' ERSTELLT UND WIRD
$ OUT "$! NUR TEMPORAER BENOETIGT, BIS DER DURCH ""$ SUB''P1'LIST ''P4'"" GESTARTETE
$ OUT "$! BATCHJOB ABGEARBEITET IST. BEI NORMALEM ENDE DES BATCHJOBS WIRD DIESES
$ OUT "$! FILE ZUM SCHLUSS GELOESCHT!"
$ OUT "$!=============================================================================
$ OUT "$ SET NOON
$ OUT "$!
$ IF P5 .NES. ""
$ THEN
$ OUT "$ SYNCHRONIZE /ENTRY = ''P5'
$ OUT "$!
$ ENDIF
$ OUT "$ DEFINE/NOLOG INPUTLISTNAME ''INPUTLISTNAME'"
$ OUT "$! in case a privious submitted batchjob didn't end properly:
$ OUT "$ FILE = F$SEARCH(""''MESSFILENAME'"")
$ OUT "$ IF FILE .NES. """" THEN DELETE ''MESSFILENAME'.* /NOCON
$ OUT "$!
$ OUT "$ FIRSTTIME = ""TRUE""
$ OUT "$ LOOP_START:
$ OUT "$ OPEN /SHARE /READ /ERROR=OPEN_ERROR messagefile ''MESSFILENAME'
$ OUT "$ READ messagefile FILENR
$ OUT "$ CLOSE messagefile
$ OUT "$ IF (FILENR.EQ.1) THEN GOTO FINISH
$ OUT "$!
$ OUT "$ PROG_CALL:
$ OUT "$ ''P2'
$ OUT "$ GOTO LOOP_START
$ OUT "$!
$ OUT "$ FINISH:
$ OUT "$ FILE = F$SEARCH(""''MESSFILENAME'"")
$ OUT "$ IF FILE .NES. """" THEN DELETE ''MESSFILENAME'.* /NOCON
$ OUT "$ WRITE SYS$OUTPUT ""''P1'_LIST''P4' FINISHED PROPERLY""
$ OUT "$ EXIT
$ OUT "$!
$ OUT "$!------------------------------------------------------------------------------
$ OUT "$ OPEN_ERROR:
$ OUT "$ IF (FIRSTTIME.EQS.""TRUE"")
$ OUT "$ THEN
$ OUT "$ FIRSTTIME = ""FALSE""
$ OUT "$ GOTO PROG_CALL
$ OUT "$ ELSE
$ OUT "$! in spite of the program has already been run there is no .MESSAGE file
$ OUT "$! => all input files have already been done => exit
$ OUT "$ GOTO FINISH
$ OUT "$ ENDIF
$ OUT "$!------------------------------------------------------------------------------
$ CLOSE COMFILE
$!
$! Submitten der Kommandoprozedur:
$ SUBMIT/DELETE/NOTIFY/NOPRINT/QUEUE='P3'/NAME='P1'LIST'P4' -
/LOG_FILE='P2'$OUTdirectory 'COMFILENAME'
$!
$ EXIT

View File

@ -0,0 +1,3 @@
$ IF P1.NES."" THEN SYNCHRONIZE /ENTRY = ''P1'
$ SUBMIT/NOTIFY/NOPRINT/NAME=MUTRACK/LOG_FILE=mutrack$OUTdirectory -
mutrack$COMdirectory:MUTRACK.COM"

View File

@ -0,0 +1,7 @@
$! in case a privious submitted batchjob didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON
$ run mutrack$EXEdirectory:T-MUTRACK.EXE
$! in case MUTRACK didn't end properly:
$ FILE = F$SEARCH("SYS$SCRATCH:MUTRACK.MESSAGE")
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:MUTRACK.MESSAGE.* /NOCON

49
mutrack/com/WRITELOG.COM Normal file
View File

@ -0,0 +1,49 @@
$! KOMMANDOPROZEDUR FUER DEN AUSDRUCK DER HEADERZEILEN VON 'MU_nnnn.LOG'-Dateien
$! =============================================================================
$!
$ SET NOON
$ SET NOVERIFY
$ SAY := WRITE SYS$OUTPUT
$ SET COMMAND mutrack$COMdirectory:DEF_MAKEWRITELOGOUT.CLD
$ ! FILE MIT HEADERZEILEN ERSTELLEN LASSEN:
$ IF P1 .EQS. ""
$ THEN
$ SAY "%WRITELOG: error: NO RUN NUMBER GIVEN IN COMMANDLINE"
$ EXIT
$ ENDIF
$ IF P1 .EQS. "?"
$ THEN
$ SAY " "
$ SAY " WRITEMULOG runNr [destinaton]"
$ SAY " "
$ SAY " destination not specified -> output to screen"
$ SAY " "
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (have to be given in upper case!)"
$ SAY " "
$ EXIT
$ ENDIF
$ IF (P2.NES."PSW04" .AND. P2.NES."PSW23" .AND. P2.NES."PRL" .AND. P2.NES."PRL2" .AND. P2.NES."")
$ THEN
$ SAY " "
$ SAY " ""''P2'"" is not an accepted destination!"
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (UPPER CASE ONLY!)"
$ SAY " "
$ EXIT
$ ENDIF
$!
$ MAKEWRITELOGOUT "''P1'"
$ OUTFILENAME = "MUTRACK$OUTdirectory:WRITELOG_" + "''P1'" + ".OUT;"
$ say "''outfilename'"
$ IF P2 .EQS. ""
$ THEN
$ TY 'OUTFILENAME'
$ DELETE /NOCON 'OUTFILENAME'
$ WRITE SYS$OUTPUT "================================================================================"
$ EXIT
$ ENDIF
$ IF (P2.EQS."PRL" .OR. P2.EQS."PRL2")
$ THEN
$ PRL2 'OUTFILENAME' /del
$ EXIT
$ ENDIF
$ VPP 'OUTFILENAME' /delete /dev=printer /form=listq /dest= "''P2'"

View File

@ -0,0 +1,144 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
! mit Schleussenkammer
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 2.0 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 11.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 48.0 ! Breite
dzgrid1 = 48.0 ! Hoehe
dist_wires_G1 = 1.0 ! Drahtabstand
dWires_G1 = 0.025 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 48.0 ! Breite
dzgrid2 = 48.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.025 ! Drahtdurchmesser
! He-Schild:
rHeShield = 47.25 ! Radius
dyHeShield = 45.0 ! Breite des Fensters
dzHeShield = 45.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 52.75 ! Radius
dyLNShield = 45.0 ! Breite des Fensters
dzLNShield = 45.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 2:
xCenterOfLense_L2 = 322 ! Position der Linsenmitte (1/2 Stutzten)
MappenName_L2andFo= 'L2andFo' ! Name der Potentialmappe
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 545.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
xCenterOfLense_L3 = 913.0 ! Linsenmitte (913.0alt)
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
! mit Schleussenkammer 161.0 (1328.35 alt)
xMCP2 = 1489.35 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe
$END
c===============================================================================
die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm):
============================================================================
$trigger_grids
dist_Wires_V1 = 1.500
dWires_V1 = 0.025
dist_Wires_V2 = 1.500
dWires_V2 = 0.025
dist_Wires_V3 = 1.500
dWires_V3 = 0.025
dist_Wires_H1 = 1.500
dWires_H1 = 0.025
dist_Wires_H2 = 1.500
dWires_H2 = 0.025
dist_Wires_G = 1.500
dWires_G = 0.025
$END

View File

@ -0,0 +1,194 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
! mit Schleussenkammer
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 2.0 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 12.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 48.0 ! Breite
dzgrid1 = 48.0 ! Hoehe
dist_wires_G1 = 1.0 ! Drahtabstand
dWires_G1 = 0.025 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 22.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 48.0 ! Breite
dzgrid2 = 48.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.025 ! Drahtdurchmesser
! He-Schild:
rHeShield = 47.25 ! Radius
dyHeShield = 40.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 52.75 ! Radius
dyLNShield = 40.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 2:
xCenterOfLense_L2 = 267.0 ! Position der Linsenmitte der neuen L2
! Elektroden 50.0 (0V) 60.0 (HV) 100.0 (0V)
! Elektrodenabstaende 12.0
MappenName_L2andFo= 'L2andFo' ! es existiert keine Potentialmappe
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 586.0 ! Aufhaengung des TDs == Mitte
! Abstand bis auf Folie 534.0
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3
xCenterOfLense_L3 = 1111.0 ! Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! alter MCP2:
xMCP2 = 1688.0 ! Position MCP
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe
! neuer MCP2:
xMCP2 = 1698.0 ! Position MCP
radius_MCP2active = 23.0 ????? ! Radius der aktiven Flaeche
! es existiert keine Mappe
!
! fuer nachfolgende Teile existieren keine Feldmappen
!
! Ringanode ungesplittet
! vordere Position bei 1623.0
! HV Elektrode
! vorderer Durchmesser: 66.8
! hinterer Durchmesser: 116.0
! gerade Laenge : 90.0
! Neigungswinkel : 16 grad
! 0V Elektrode
! Abstand zu HV Elektrode: 12.0
! Durchmesser : 116.0
! Laenge : 116.0
! Probenplatte Kryostat:
! nachfolgende Masse beziehen sich auf die Montage des Saphirs mit D = 6.0mm
! wird der Saphir nicht verwendet, muessen die Positionen entsprechend korrigiert
! werden
! 1696.0
! Probenoberflaeche je nach Probendicke bei 1694.0 bis 1696.0
! Durchmesser Probenplatte: 70.0 mm
! Befestigungsring Probe : 1694 bis 1692 (hat eine Dicke von 2.0, Abstand haengt
! von Probendicke ab)
! Oeffnungsdurchmesser : 40.0 oder 45.0 mm
! Aussendurchmesser : 70.0 mm
! Guardringe
! Innendurchmesser : 58.0 mm
! Aussendurchmesser : 70.0 mm
! Dicke : 3.0 mm
! Abstand Guard1 zu
! Probenbefestigungsring : 13.0 mm !oder zu Probenplatte bei s-RG Messungen
! Abstand Guard2 zu
! Probenbefestigungsring : 29.0 mm
! Abstand Erdungsgitter Kuehlschild
! zu Probenbefestigungsring : 48.0 mm !Anstand von Probenplatte aus gemessen
! Anstand Erdungsgitter Kuehlschild - Guardringen bzw. Probenoberflaechen haengt von
! Probendicke ab.
! Position Kuehlplatte (0V) : 1706.0
! Durchmesser : 70.0 mm
! Position Kuehlfinger : 1711.0
! Durchmesser : 55.0 mm
$END
c===============================================================================
die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm):
============================================================================
$trigger_grids
dist_Wires_V1 = 1.500
dWires_V1 = 0.025
dist_Wires_V2 = 1.500
dWires_V2 = 0.025
dist_Wires_V3 = 1.500
dWires_V3 = 0.025
dist_Wires_H1 = 1.500
dWires_H1 = 0.025
dist_Wires_H2 = 1.500
dWires_H2 = 0.025
dist_Wires_G = 1.500
dWires_G = 0.025
$END

View File

@ -0,0 +1,202 @@
c===============================================================================
c GEO_KAMMER.INPUT
c
c nov-dec 1999 EM+HG NOT FINAL: modified to analyse ELOSS data of run12
c xcenterODLense_L2 use old value 322. instead of new 267.
c xTD use old value 545. instead of 586.
c otherwise mutrack has run time error
c potential map of L2 still for old (run10) dimensions
c ring anode not included
c
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
! mit Schleussenkammer
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 2.0 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 12.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 48.0 ! Breite
dzgrid1 = 48.0 ! Hoehe
dist_wires_G1 = 1.0 ! Drahtabstand
dWires_G1 = 0.025 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 22.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 48.0 ! Breite
dzgrid2 = 48.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.025 ! Drahtdurchmesser
! He-Schild:
rHeShield = 47.25 ! Radius
dyHeShield = 40.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 52.75 ! Radius
dyLNShield = 40.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 2:
xCenterOfLense_L2 = 322. ! should be 267.0 ! Position der Linsenmitte der neuen L2
! Elektroden 50.0 (0V) 60.0 (HV) 100.0 (0V)
! Elektrodenabstaende 12.0
MappenName_L2andFo= 'L2andFo' ! es existiert keine Potentialmappe
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 545. ! should be 586.0 ! Aufhaengung des TDs == Mitte
! Abstand bis auf Folie 534.0
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3
xCenterOfLense_L3 = 1111.0 ! Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! alter MCP2:
xMCP2 = 1688.0 ! Position MCP
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe
! neuer MCP2:
xMCP2 = 1698.0 ! Position MCP
radius_MCP2active = 23.0 ????? ! Radius der aktiven Flaeche
! es existiert keine Mappe
!
! fuer nachfolgende Teile existieren keine Feldmappen
!
! Ringanode ungesplittet
! vordere Position bei 1623.0
! HV Elektrode
! vorderer Durchmesser: 66.8
! hinterer Durchmesser: 116.0
! gerade Laenge : 90.0
! Neigungswinkel : 16 grad
! 0V Elektrode
! Abstand zu HV Elektrode: 12.0
! Durchmesser : 116.0
! Laenge : 116.0
! Probenplatte Kryostat:
! nachfolgende Masse beziehen sich auf die Montage des Saphirs mit D = 6.0mm
! wird der Saphir nicht verwendet, muessen die Positionen entsprechend korrigiert
! werden
! 1696.0
! Probenoberflaeche je nach Probendicke bei 1694.0 bis 1696.0
! Durchmesser Probenplatte: 70.0 mm
! Befestigungsring Probe : 1694 bis 1692 (hat eine Dicke von 2.0, Abstand haengt
! von Probendicke ab)
! Oeffnungsdurchmesser : 40.0 oder 45.0 mm
! Aussendurchmesser : 70.0 mm
! Guardringe
! Innendurchmesser : 58.0 mm
! Aussendurchmesser : 70.0 mm
! Dicke : 3.0 mm
! Abstand Guard1 zu
! Probenbefestigungsring : 13.0 mm !oder zu Probenplatte bei s-RG Messungen
! Abstand Guard2 zu
! Probenbefestigungsring : 29.0 mm
! Abstand Erdungsgitter Kuehlschild
! zu Probenbefestigungsring : 48.0 mm !Anstand von Probenplatte aus gemessen
! Anstand Erdungsgitter Kuehlschild - Guardringen bzw. Probenoberflaechen haengt von
! Probendicke ab.
! Position Kuehlplatte (0V) : 1706.0
! Durchmesser : 70.0 mm
! Position Kuehlfinger : 1711.0
! Durchmesser : 55.0 mm
$END
c===============================================================================
die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm):
============================================================================
$trigger_grids
dist_Wires_V1 = 1.500
dWires_V1 = 0.025
dist_Wires_V2 = 1.500
dWires_V2 = 0.025
dist_Wires_V3 = 1.500
dWires_V3 = 0.025
dist_Wires_H1 = 1.500
dWires_H1 = 0.025
dist_Wires_H2 = 1.500
dWires_H2 = 0.025
dist_Wires_G = 1.500
dWires_G = 0.025
$END

View File

@ -0,0 +1,109 @@
c===============================================================================
c GEO_KAMMER_run2.INPUT
c
c vgl.: LB. 2, S. 78 - 80 (mittlerer Arm entfernt)
c LB. 6, S. 113
c LB. EM A2, S. 39 - 41
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = -6.5 ! Position RELATIV ZUM KRYO
dytarget = 24.0 ! Breite
dztarget = 16.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius vom Schild
dyHeShield = 28.0 ! Breite
dzHeShield = 20.0 ! Hoehe
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 28.0 ! Breite
dzLNShield = 20.0 ! Hoehe
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 477.0 ! Position
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 0.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.0 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 3:
xCenterOfLense_L3 = 225.0 ! Position der Linsenmitte
MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe
! MCP2:
xMCP2 = 524.0 ! Position
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_run2' ! Name der Potentialmappe
$END
c===============================================================================
=> Gesamtlaenge zwischen Target und MCP2 front: 6.5 + 477 + 524 = 1007.5
c===============================================================================

View File

@ -0,0 +1,109 @@
c===============================================================================
c GEO_KAMMER_RUN3-4.INPUT
c
c EM: 22.2.96 Abstaende fuer Runs 3 und 4
c (kein TriggerDetektor, Tgt-Dimensionen = 24 x 16 mm^2)
c Abstaende aus LB EM A2/p45. Siehe auch LB8/p203,LB9/p3
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = -6.5 ! Position RELATIV ZUM KRYO
dytarget = 24.0 ! Breite
dztarget = 16.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius vom Schild
dyHeShield = 28.0 ! Breite
dzHeShield = 20.0 ! Hoehe
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 28.0 ! Breite
dzLNShield = 20.0 ! Hoehe
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 477.0 ! Position
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 0.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.0 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 3:
xCenterOfLense_L3 = 384.0 ! Position der Linsenmitte
MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe
! MCP2:
xMCP2 = 772.35 ! Position
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'M2_1' ! Name der Potentialmappe
$END
c===============================================================================
=> Gesamtlaenge zwischen Target und MCP2 front: 6.5 + 477 + 772.35 = 1255.85
c===============================================================================

View File

@ -0,0 +1,115 @@
c===============================================================================
c GEO_KAMMER_run6-8.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 477.0 ! Position
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 0.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.0 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor:
xTD = 372.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3:
xCenterOfLense_L3 = 714.0 ! Position der Linsenmitte
MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe
! MCP2:
xMCP2 = 1102.35 ! Position
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'M2_1' ! Name der Potentialmappe
$END
c===============================================================================
=> Gesamtlaenge zwischen Target und MCP2 front: -3.5 + 477 + 1102.35 = 1575.85
c===============================================================================

View File

@ -0,0 +1,118 @@
c===============================================================================
c GEO_KAMMER_run7_LONG.INPUT
c===============================================================================
Dieses File enthaelt die Kammergeometrie waehrend run 7 mit Rohrverlaengerung
zur Messung des Energieverlustes der Myonen in der TD-Folie
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 477.0 ! Position
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 0.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.0 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor:
xTD = 372.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3:
xCenterOfLense_L3 = 714.0 ! Position der Linsenmitte
MappenName_L3 = 'L3_1mm_mesh' ! Name der Potentialmappe
! MCP2:
xMCP2 = 1537.35 ! Position
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'M2_1' ! Name der Potentialmappe
$END
c===============================================================================
=> Gesamtlaenge zwischen Target und MCP2 front: -3.5 + 477 + 1537.35 = 2010.85
c===============================================================================

View File

@ -0,0 +1,113 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 545.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
xMCP2 = 1328.35 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe
$END
c===============================================================================

View File

@ -0,0 +1,113 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 545.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
xMCP2 = 1328.35 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe
$END
c===============================================================================

View File

@ -0,0 +1,139 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der-
! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung
! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu
! erhalten mussten die Flugstrecken FUER MYONEN zwischen Target und Trigger-
! detektor um 7.5 mm sowie zwischen Target und MCP2 um 4.9 mm gegenueber den
! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen
! Triggerdetektor und MCP2 wurde also um 2.6 mm verkuerzt.
!
! Die entsprechenden Flugstreckenaenderungen FUER PROTONEN betragen 6.0 mm
! fuer M3S1 und 4.8 mm fuer M2S1 (=> -1.2 mm fuer M3M2).
!
! Diese Datei enthaelt die resultierenden Werte fuer die Myonen:
! Eingefuegt wurden:
!
! +2.5 mm zwischen Tgt und L1
! +2.5 mm zwischen L1 und Spiegel
! +2.5 mm zwischen Spiegel und TD
! -1.3 mm zwischen TD und L3 -2.3
! -1.3 mm zwischen L3 und MCP2 -0.3
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
xCenterOfLense_L1 = 252.5 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
! xSpiegel = 499.0 ! Position (=477.0 + 22.0)
xSpiegel = 504.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
! xTD = 545.0 ! Aufhaengung des TDs == Mitte
xTD = 547.5 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte
! xCenterOfLense_L3 = 914.2 ! Position der Linsenmitte
xCenterOfLense_L3 = 913.2 ! Position der Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
! xMCP2 = 1328.35 ! Position (incl. Reduzier-
xMCP2 = 1328.25 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe
$END
c===============================================================================

View File

@ -0,0 +1,148 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der-
! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung
! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu
! erhalten mussten die Flugstrecken FUER PROTONEN zwischen Target und Trigger-
! detektor um 6.0 mm sowie zwischen Target und MCP2 um 4.8 mm gegenueber den
! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen
! Triggerdetektor und MCP2 wurde also um 1.2 mm verkuerzt.
!
! Die entsprechenden Flugstreckenaenderungen FUER MYONEN betragen 7.5 mm
! fuer M3S1 und 4.9 mm fuer M2S1 (=> -2.6 mm fuer M3M2).
!
! Diese Datei enthaelt die resultierenden Werte fuer die Protonen:
! Eingefuegt wurden:
!
! +2.0 mm zwischen Tgt und L1
! +2.0 mm zwischen L1 und Spiegel
! +2.0 mm zwischen Spiegel und TD
! -0.6 mm zwischen TD und L3 -2.3
! -0.6 mm zwischen L3 und MCP2 -0.3
! Wegen Meldung
! "Potentialmappen von Linse 3 und MCP2 ueberlappen!
! Dies ist in der aktuellen Implementierung des Programmes
! nicht vorgesehen!"
! musste die L3-Mappe anschliessend um 3 mm zum TD hin verschoben werden, um
! den Ueberlapp wieder zu aufzuheben!
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
xCenterOfLense_L1 = 252.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
! xSpiegel = 499.0 ! Position (=477.0 + 22.0)
xSpiegel = 503.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
! xTD = 545.0 ! Aufhaengung des TDs == Mitte
xTD = 547.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte
! xCenterOfLense_L3 = 914.4 ! Position der Linsenmitte
xCenterOfLense_L3 = 914.1 ! Position der Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
! xMCP2 = 1328.35 ! Position (incl. Reduzier-
! xMCP2 = 1328.15 ! Position (incl. Reduzier-
xMCP2 = 1329.15 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe
$END
c===============================================================================

View File

@ -0,0 +1,138 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
!
!==============================================================================
! Der Zeitnullpunkt fuer M2S1 ab Run 1097 wurde auf 1803.3 festgelegt, der-
! jenige fuer M3S1 auf 1788.1. Um bei diesen Werten optimale Uebereinstimmung
! zwischen simulierten und experimentellen Peakpositionen in M3S1 und M2S1 zu
! erhalten mussten die Flugstrecken FUER PROTONEN zwischen Target und Trigger-
! detektor um 6.0 mm sowie zwischen Target und MCP2 um 4.8 mm gegenueber den
! urspruenglich verwendeten Werten verlaengert werden. Die Flugstrecke zwischen
! Triggerdetektor und MCP2 wurde also um 1.2 mm verkuerzt.
!
! Die entsprechenden Flugstreckenaenderungen FUER MYONEN betragen 7.5 mm
! fuer M3S1 und 4.9 mm fuer M2S1 (=> -2.6 mm fuer M3M2).
!
! Diese Datei enthaelt die resultierenden Werte fuer die Protonen:
! Eingefuegt wurden:
!
! +2.0 mm zwischen Tgt und L1
! +2.0 mm zwischen L1 und Spiegel
! +2.0 mm zwischen Spiegel und TD
! -1.1 mm zwischen TD und L3 -2.3
! -1.1 mm zwischen L3 und MCP2 -0.3
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 3.5 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 9.5 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 32.0 ! Breite
dzgrid1 = 32.0 ! Hoehe
dist_wires_G1 = 0.5 ! Drahtabstand
dWires_G1 = 0.050 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 42.0 ! Breite
dzgrid2 = 42.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.050 ! Drahtdurchmesser
! He-Schild:
rHeShield = 38.5 ! Radius
dyHeShield = 36.0 ! Breite des Fensters
dzHeShield = 36.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 45.5 ! Radius
dyLNShield = 36.0 ! Breite des Fensters
dzLNShield = 36.0 ! Hoehe des Fensters
! Linse 1:
! xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
xCenterOfLense_L1 = 252.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
! xSpiegel = 499.0 ! Position (=477.0 + 22.0)
xSpiegel = 503.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
! xTD = 545.0 ! Aufhaengung des TDs == Mitte
xTD = 547.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
! xCenterOfLense_L3 = 913.0 ! Position der Linsenmitte
xCenterOfLense_L3 = 913.9 ! Position der Linsenmitte
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
! xMCP2 = 1328.35 ! Position (incl. Reduzier-
xMCP2 = 1328.15 ! Position (incl. Reduzier-
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 20.0 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP2_RUN9_NEW' ! Name der Potentialmappe
$END
c===============================================================================

View File

@ -0,0 +1,144 @@
c===============================================================================
c GEO_KAMMER.INPUT
c===============================================================================
$kammer_geo
!==============================================================================
! 'HORIZONTALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum der Moderationskammer (=Kryoachse)
! gemessen! (bis auf xgrid1 und xgrid2, die relativ zur Rueckseite
! der Moderatorfolie, also 'xTarget' gemessen werden)
! mit Schleussenkammer
!==============================================================================
! Vakuumrohr:
radius_Rohr = 75.
! Target:
xtarget = 2.0 ! Position RELATIV ZUM KRYO
dytarget = 30.0 ! Breite
dztarget = 30.0 ! Hoehe
! erstes Beschleunigungsgitter:
xgrid1 = 11.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid1 = 48.0 ! Breite
dzgrid1 = 48.0 ! Hoehe
dist_wires_G1 = 1.0 ! Drahtabstand
dWires_G1 = 0.025 ! Drahtdurchmesser
! zweites Beschleunigungsgitter:
xgrid2 = 20.0 ! -> ! Position RELATIV ZUM MODERATOR
dygrid2 = 48.0 ! Breite
dzgrid2 = 48.0 ! Hoehe
dist_wires_G2 = 1.0 ! Drahtabstand
dWires_G2 = 0.025 ! Drahtdurchmesser
! He-Schild:
rHeShield = 47.25 ! Radius
dyHeShield = 45.0 ! Breite des Fensters
dzHeShield = 45.0 ! Hoehe des Fensters
! LN-Schild:
rLNShield = 52.75 ! Radius
dyLNShield = 45.0 ! Breite des Fensters
dzLNShield = 45.0 ! Hoehe des Fensters
! Linse 1:
xCenterOfLense_L1 = 250.0 ! Position der Linsenmitte
MappenName_L1 = 'L1_1mm_mesh' ! Name der Potentialmappe
! Spiegel:
xSpiegel = 499.0 ! Position (=477.0 + 22.0)
MappenName_Sp = 'mirror' ! Name der Potentialmappe
DreharmLaenge = 11.0 ! horizont. Abstand zwischen
! Aufhaengung und Spiegelmitte
BSpiegel = 114.0 ! Breite
hSpiegel = 100.0 ! Hoehe
DSpiegel = 22.5 ! Tiefe
dist_wires_Sp = 1.0 ! Drahtabstand
dWires_Sp = 0.050 ! Drahtdurchmesser
!==============================================================================
! 'VERTIKALER' KAMMERTEIL
!
! hier wird x relativ zum Zentrum des Doppelkreuzes der Spiegel-
! aufhaengung gemessen!
!==============================================================================
! Linse 2:
xCenterOfLense_L2 = 322 ! Position der Linsenmitte (1/2 Stutzten)
MappenName_L2andFo= 'L2andFo' ! Name der Potentialmappe
! TriggerDetektor: alt: 372.0 Stutzen:+150 alte TK: 250 neue TK: 296
xTD = 545.0 ! Aufhaengung des TDs == Mitte
mappenName_Fo = 'FO_1' ! des Doppelkreuzes
! Linse 3: alt: 714 Stutzen: 150 neue TK:296 neue 1/2Linse:220
! xCenterOfLense_L3 = 714.0 mm MIT eingebautem Triggerdetektor, 384.0 OHNE.
xCenterOfLense_L3 = 913.0 ! Linsenmitte (913.0alt)
MappenName_L3 = 'LENSE-3' ! Name der Potentialmappe
! MCP2:alt 1102.35, Abstand zu Flansch: 170.85
! xMCP2 war MIT eingebautem Triggerdetektor bei 1102.35, OHNE bei 772.35 mm.
! mit Schleussenkammer 161.0 (1328.35 alt)
xMCP2 = 1506 ! Probenposition im Kryo
! ! flansch mit Dicke 24.5 mm)
radius_MCP2active = 22.5 ! Radius der aktiven Flaeche
MappenName_M2 = 'MCP_RUN9' ! Name der Potentialmappe
$END
c===============================================================================
die Drahtabstaende und -durchmesser der Gitter des Triggerdetektors (in mm):
============================================================================
$trigger_grids
dist_Wires_V1 = 1.500
dWires_V1 = 0.025
dist_Wires_V2 = 1.500
dWires_V2 = 0.025
dist_Wires_V3 = 1.500
dWires_V3 = 0.025
dist_Wires_H1 = 1.500
dWires_H1 = 0.025
dist_Wires_H2 = 1.500
dWires_H2 = 0.025
dist_Wires_G = 1.500
dWires_G = 0.025
$END

View File

@ -0,0 +1,52 @@
===============================================================================
Erstellt am 17-JAN-99 um 17:51:38 durch 'MAKE_CODENUMMERN-LIST.FOR'
=========================================================
Die Code-Nummern fuer die verschiedenen Gebiete: 'Gebiet'
=========================================================
( 0: auf Moderatorfolie)
1: in 1. Beschl.Stufe
2: in 2. Beschl.Stufe
3: bis He-Schild
4: bis LN-Schild
5: vor Linse-1-Mappe
6: in Linse-1-Mappe
7: bis Spiegel
8: im Spiegel
9: bis Koordinatenwechsel
10: vor Linse-2-Mappe
11: in Linse-2-Mappe
12: bis TriggerDetektor
13: im TriggerDetektor
14: vor Linse-3-Mappe
15: in Linse-3-Mappe
16: zwischen Linse-3-Mappe und MCP2-Mappe
17: vor MCP2
==========================================================
Die Code-Nummern der moeglichen Teilchenschicksale: 'dest'
==========================================================
-10: in Triggerfolie gestoppt
-9: Targethalter getroffen
-8: ACCEL
-7: ACCEL
-6: auf Rand des MCP2
-5: auf Blende des MCP2
-4: von MCP3 nicht registriert
-3: im TD abgebrochen
-2: Folienstuetzgitter getr.
-1: Spiegel durchquert
0: MCP2 getroffen
1: zerfallen
2: Element verfehlt
3: reflektiert
4: auf Gitter getroffen
5: aufgeschlagen
6: verloren (steps>maxsteps)
7: Zeitschritt kleiner dtSmall
===============================================================================

16
mutrack/src/COM_DIRS.INC Normal file
View File

@ -0,0 +1,16 @@
c-------------------------------------------------------------------------------
c Die verwendeten Directories
c-------------------------------------------------------------------------------
character*(*) MappenDir,TP_Dir,ACCEL_Dir,readDir,outDir,NrDir
character*(*) TMPDIR,geoDIR
parameter (MappenDir = 'mutrack$mappenDirectory' )
parameter (TP_Dir = 'mutrack$TPdirectory' )
parameter (ACCEL_Dir = 'mutrack$AHdirectory' )
parameter (readDir = 'mutrack$READdirectory' )
parameter (geoDir = 'mutrack$GEOdirectory' )
parameter (outDir = 'mutrack$OUTdirectory' )
parameter (NrDir = 'mutrack$NrDirectory' )
parameter (TMPDir = 'SYS$SCRATCH' )

224
mutrack/src/COM_KAMMER.INC Normal file
View File

@ -0,0 +1,224 @@
c===============================================================================
c COM_KAMMER.INC
c===============================================================================
c Veraenderungen in diesem File sind nur mit angemessener Vorsicht vorzunehmen!
c Die Groessen, die sich auf Bereiche beziehen, in denen mittels Potentialmappen
c integriert wird (und die in anderen COMMON-Bloecken als dem 'blank'-Block
c stehen) werden in den include files 'MAP_DEF_xx.INC' nochmals mit anderen
c Bezeichnungen definiert (ohne die Extensionen '_L1','_L2','_L3','_FO' und '_M2').
c Auch sind die dort definierten COMMON-Bloecke umfassender als die hier
c angegebenen Teilbereiche. Daher muessen Aenderungen in dem vorliegenden File
c im Regelfall von entsprechenden Aenderungen in diesen Files begleitet werden!
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Vakuumrohr:
real radius_Rohr ! Radius
c Target:
real xtarget ! Position
real dytarget ! Breite
real dztarget ! Hoehe
c erstes Beschleunigungsgitter:
real xgrid1 ! Position
real dygrid1 ! Breite
real dzgrid1 ! Hoehe
real dWires_G1 ! Drahtdurchmesser
real dist_Wires_G1 ! Drahtabstand
c zweites Beschleunigungsgitter:
real xgrid2 ! Position
real dygrid2 ! Breite
real dzgrid2 ! Hoehe
real dWires_G2 ! Drahtdurchmesser
real dist_Wires_G2 ! Drahtabstand
c He-Schild:
real rHeShield ! Radius
real dyHeShield ! Breite
real dzHeShield ! Hoehe
c LN-Schild:
real rLNShield ! Radius
real dyLNShield ! Breite
real dzLNShield ! Hoehe
c Linse 1:
real Beschl_Faktor_L1
COMMON /Beschl_Faktor_L1/ Beschl_Faktor_L1
character*40 MappenName_L1 /' '/
real dl_max_L1
COMMON /integration_L1/ MappenName_L1,dl_max_L1
real xCenterOfLense_L1
real xEnterMap_L1
real xLeaveMap_L1
COMMON /integration_L1/ xCenterOfLense_L1,xEnterMap_L1,xLeaveMap_L1
real DistanceCyl_L1
real iRadiusCyl_L1
real LengthOuterCyl_L1
real oRadiusOuterCyl_L1
real LengthInnerCyl_L1
real oRadiusInnerCyl_L1
real RadiusVacTube_L1
COMMON /integration_L1/ DistanceCyl_L1,iRadiusCyl_L1
COMMON /integration_L1/ LengthOuterCyl_L1,oRadiusOuterCyl_L1
COMMON /integration_L1/ LengthInnerCyl_L1,oRadiusInnerCyl_L1
COMMON /integration_L1/ RadiusVacTube_L1
c Spiegel:
real Beschl_Faktor_Sp
COMMON /Beschl_Faktor_Sp/ Beschl_Faktor_Sp
character*40 MappenName_Sp /' '/
real dl_max_Sp
COMMON /integration_Sp/ MappenName_Sp,dl_max_Sp
real xSpGrid1,xSpGrid2 ! Gitterpositionen innerhalb der Mappe [mm]
real DSpiegel ! Abstand der Spiegelgitter
real dWires_Sp ! Drahtdurchmesser
real dist_Wires_Sp ! Drahtabstand
COMMON /integration_Sp/ xSpGrid1,xSpGrid2,DSpiegel,
* dWires_Sp,dist_Wires_Sp
real xmin_Sp_1,xmax_Sp_1
real xmin_Sp_2,xmax_Sp_2
real xmin_Sp_3,xmax_Sp_3
COMMON /integration_SP_1/ xmin_Sp_1,xmax_Sp_1
COMMON /integration_SP_2/ xmin_Sp_2,xmax_Sp_2
COMMON /integration_SP_3/ xmin_Sp_3,xmax_Sp_3
real xSpiegel ! Position
real DreharmLaenge ! horizontaler Abstand zwischen Spielgel-
! aufhaengung und Spiegelmittelpkt.
real BSpiegel ! Breite
real hSpiegel ! Hoehe
c Linse 2:
character*40 MappenName_L2andFo /' '/
real dl_max_L2andFo
COMMON /integration_L2andFo/ MappenName_L2andFo,dl_max_L2andFo
real xCenterOfLense_L2,xEndLense_L2
real xEnterMap_L2andFo
real xLeaveMap_L2andFo
COMMON /integration_L2andFo/ xCenterOfLense_L2,xEndLense_L2,
+ xEnterMap_L2andFo,xLeaveMap_L2andFo
real DistanceCyl_L2
real iRadiusCyl_L2
real LengthOuterCyl_L2
real oRadiusOuterCyl_L2
real LengthInnerCyl_L2
real oRadiusInnerCyl_L2
real RadiusVacTube_L2
COMMON /integration_L2andFo/ DistanceCyl_L2,iRadiusCyl_L2
COMMON /integration_L2andFo/ LengthOuterCyl_L2,oRadiusOuterCyl_L2
COMMON /integration_L2andFo/ LengthInnerCyl_L2,oRadiusInnerCyl_L2
COMMON /integration_L2andFo/ RadiusVacTube_L2
c Triggerdetektor:
real Beschl_Faktor_Fo
COMMON /Beschl_Faktor_Fo/ Beschl_Faktor_Fo
character*40 MappenName_Fo /' '/
real dl_max_Fo
real MappenLaenge_Fo
real xEnterMap_Fo
COMMON /integration_Fo/ MappenName_Fo,dl_max_Fo
COMMON /integration_Fo/ MappenLaenge_Fo,xEnterMap_Fo
real xTD,TransTDFoil
c Linse 3:
real Beschl_Faktor_L3
COMMON /Beschl_Faktor_L3/ Beschl_Faktor_L3
character*40 MappenName_L3 /' '/
real dl_max_L3
COMMON /integration_L3/ MappenName_L3,dl_max_L3
real xCenterOfLense_L3
real xEnterMap_L3
real xLeaveMap_L3
COMMON /integration_L3/ xCenterOfLense_L3,xEnterMap_L3,xLeaveMap_L3
real DistanceCyl_L3
real iRadiusCyl_L3
real LengthOuterCyl_L3
real oRadiusOuterCyl_L3
real LengthInnerCyl_L3
real oRadiusInnerCyl_L3
real RadiusVacTube_L3
COMMON /integration_L3/ DistanceCyl_L3,iRadiusCyl_L3
COMMON /integration_L3/ LengthOuterCyl_L3,oRadiusOuterCyl_L3
COMMON /integration_L3/ LengthInnerCyl_L3,oRadiusInnerCyl_L3
COMMON /integration_L3/ RadiusVacTube_L3
c MCP2:
real Beschl_Faktor_M2
COMMON /Beschl_Faktor_M2/ Beschl_Faktor_M2
character*40 MappenName_M2 /' '/
real dl_max_M2
COMMON /integration_M2/ MappenName_M2,dl_max_M2
real xMCP2
real xEnterMap_M2
real radius_MCP2 ! Radius des MCP2
COMMON /integration_M2/ xMCP2,xEnterMap_M2,radius_MCP2
real radius_MCP2active ! Radius der aktiven Flaeche des MCP2
real xBlende ! Position der Blende
real radius_Blende ! Radius der Blende
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
COMMON /KAMMER_GEO/
+ radius_Rohr,
+ xtarget,dytarget,dztarget,
+ xgrid1,dygrid1,dzgrid1,dWires_G1,dist_Wires_G1,
+ xgrid2,dygrid2,dzgrid2,dWires_G2,dist_Wires_G2,
+ rHeShield,dyHeShield,dzHeShield,
+ rLNShield,dyLNShield,dzLNShield,
+ xSpiegel,DreharmLaenge,BSpiegel,hSpiegel,
+ xTD,TransTDFoil,
+ radius_MCP2active,
+ xBlende,radius_Blende
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

23
mutrack/src/COM_LUNS.INC Normal file
View File

@ -0,0 +1,23 @@
c===============================================================================
c COM_LUNS.INC
c===============================================================================
c Dieses file legt die von 'MUTRACK' benutzten logischen Einheiten fuer Ein- und
c Ausgabe fest:
integer lunREAD, lunScreen, lunLOG, lunNTP, luNPHYSICA
integer lunTMP, lunFOIL, lunMESSAGE
parameter ( lunREAD = 17 )
parameter ( lunScreen = 6 )
parameter ( lunLOG = 18 )
parameter ( lunNTP = 19 )
parameter ( lunPHYSICA = 20 )
parameter ( lunTMP = 16 )
parameter ( lunFOIL = 15 )
parameter ( lunMESSAGE = 14 )
c Die Tabellenfiles werden entsprechend ihrer Nummer den Ausgabeeinheiten
c (lunPHYSICA + 1) bis (lunPHYSICA + stat_Anzahl) zugeeordnet.

768
mutrack/src/COM_MUTRACK.INC Normal file
View File

@ -0,0 +1,768 @@
c===============================================================================
c COM_MUTRACK.INC
c===============================================================================
c
c Dieses Includefile enthaelt die Deklarationen der meisten Variablen, die
c innerhalb des Programms Mutrack von mehr als einer Routine benoetigt werden
c und daher einem Commonblock zugeordnet sein muessen. Fuer diese Variablen
c wird der unbenannte ('blank') Commonblock verwendet. Dieses file wird in
c fast alle Subroutinen eingebunden (abgesehen von denen, die in der Datei
c SUB_TD.FOR zusammengefasst sind und sich auf die Trajektorienberechnung im
c Bereich des TriggerDetektors beschraenken).
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c===============================================================================
c I. Konstanten
c===============================================================================
c-------------------------------------------------------------------------------
c Die Versionsnummern
c-------------------------------------------------------------------------------
character*8 version ! Versionsnummer von MUTRACK
parameter ( version = '2.0.1' )
c===============================================================================
character*8 accelVersion /' '/ ! Versionsnummer von ACCEL
integer accelVersionIndx
character*25 mappenNameACCEL
character*8 mutrackVersion /' '/ ! Versionsnummer von 'FoilFile'
integer mutrackVersionIndx
COMMON accelVersion,accelVersionIndx,mutrackVersion,mutrackVersionIndx
COMMON mappenNameACCEL
c===============================================================================
c Ver. 1.4.1: mit richtiger Formel fuer SigmaAufstreu:
c (ausgehend von 'theta1/2 = HWHM' anstatt wie zuvor '.. = FWHM')
c
c Ver. 1.5.1: - Implementierung der neuen Linse 'L2' zwischen Spiegel und TD.
c - Alle Programmstellen in Zusammenhang mit Simulationsfiles
c von TP wurden entfernt. In der Praxis wurde die Moeglichkeit
c nie genutzt und erschwerte bei der Programmpflege die Programmier-
c arbeit. In der Folge wurde auch das logical 'USE_AH' ueber-
c fluessig. Die diesbezgl. Steuerung erfolgt jetzt nur noch
c ueber 'fromScratch', 'use_ACCEL' und 'use_MUTRACK'.
c - Umbenennung einiger Variabler. Speziell wurde die Extension
c '_AH' von Variablen in Zusammenhang mit ACCEL und 'foilfile'
c durch '_prevSim' (fuer PREVious SIMulation) ersetzt.
c - Vorbereitung der Implementierung der Magnetfelder durch Ein-
c fuehren der entsprechenden Schleifenparameter etc. Bis jetzt aber
c ohne jegliche Magnetfeldspezifische Kalkulationen.
c Ver. 1.5.2: - neues Logical 'alfaTgtVertically'
c Ver. 1.5.3: - Fehlerbereinigung: Ab Version 1.5.1 wurden bei Fortfuehrung von
c Foilfiles, welche selbst aus ACCEL-files erzeugt worden sind
c die Trajektoriendaten statt aus dem Foilfile aus dem ACCEL-file
c eingelesen. Auch wurde die Gebietskodierung nicht aktualiesiert
c Ver. 1.5.4: - 27-jan-1997 (AH): 'sigmaS1Fo' und 'smearS1Fo' implementiert
c Ver. 1.5.5: - 02-feb-1997 (AH): implementation of 'E0InterFromFile'
c Ver. 1.5.6: - praktisch gleich Ver. 1.5.5
c Ver. 2.0.0: - mit f-Funktion von Meyer als bessere Winkelaufstreuungs-
c verteilungsfunktion gegenueber bisher verwendeter Gauss-
c foermiger Winkelaufstreuung.
c - Wahlmoeglichkeit zwischen ICRU-Energieverlustdaten fuer
c Graphit (bisher ausschliesslich verwendet) und amorphen
c Kohlenstoff (mit etwas kleinerem mittleren Energieverlust)
c implementiert. (-> logical 'graphitData'). (Es werden wie
c zuvor stets die totalen Stoppingpowerdaten, also elektronisch
c + nuklear, verwendet).
c - Routinen fuer Berechnung der Breite der Energieaufstreuung in
c der Triggerfolie nach Lindhard/Scharff (theoret.) sowie nach
c Yang (semiempirisch) implementiert. Die Routinen beruhen auf
c den (sehr kurzen) Programmen, mit welchen ich die Kurven
c fuer die Diss erstellt habe. Jedoch habe ich nicht mehr aus-
c getestet, ob ich bei der Abaenderung fuer Mutrack alles richtig
c gemacht habe ...
c - Version 2.0.0 ist die letzte von mir erstellte Version.
c Ich hoffe, alles ist mittlerweile einigermassen fehlerfrei und
c ausreichend verstaendlich, so dass die Nachwelt sich bei
c anfaelligen Aenderungen nicht ueber Gebuehr echauffieren muss...
c Gruss, Anselm Hofer ...
c
c - Version 2.0.1: nTuple output contains now position
c information of muons at TD foil as well as
c the position of FE when hitting MCP3
c TP, 18-Oct-2000
c
c===============================================================================
c-------------------------------------------------------------------------------
c Zuteilung der GebietsNummern k (0 <= k <= Gebiete_Anzahl)
c zu den Gebieten
c-------------------------------------------------------------------------------
integer target,upToGrid1,upToGrid2,upToHeShield,
+ upToLNShield,upToL1Map,upToExL1,upToEnSp,upToExSp,
+ upToChKoord,upToL2andFoMap,upToExL2,upToEnTD,upToExTD,
+ upToL3Map,upToExL3,upToM2Map,upToMCP2
c GEBIET 'k'
parameter ( target = 0 ) ! <- zaehlt nicht fuer 'Gebiete_Anzahl'!
parameter ( upToGrid1 = 1 )
parameter ( upToGrid2 = 2 )
parameter ( upToHeShield = 3 )
parameter ( upToLNShield = 4 )
parameter ( upToL1Map = 5 )
parameter ( upToExL1 = 6 )
parameter ( upToEnSp = 7 )
parameter ( upToExSp = 8 )
parameter ( upToChKoord = 9 )
parameter ( upToL2andFoMap = 10 )
parameter ( upToExL2 = 11 )
parameter ( upToEnTD = 12 )
parameter ( upToExTD = 13 )
parameter ( upToL3Map = 14 )
parameter ( upToExL3 = 15 )
parameter ( upToM2Map = 16 )
parameter ( upToMCP2 = 17 )
integer Gebiete_Anzahl
parameter ( Gebiete_Anzahl=17) ! <- Startpkt 'Target' zaehlt nicht !!
character Gebiet_Text(Gebiete_Anzahl)*40
COMMON Gebiet_Text
c-------------------------------------------------------------------------------
c Zuteilungen der Schleifenparameter zu den Feldelemenkten k
c (1 <= k <= par_Anzahl) von par(i,k), n_par(k), parWert(k), par_text(k)
c-------------------------------------------------------------------------------
integer UTgt,UGua,UG1,UL1,USp,UL2,UL3, UFolie,UVorne,UHinten,UMCP3,
+ UMCP2, BTD,BHelm, alfTgt,alfSp,alfTD, mass,charge,
+ ener,yPos,zPos,thetAng,phiAng,Thickn,Eloss,DeltaL1,DeltaL2
parameter ( UTgt = 1 )
parameter ( UGua = 2 )
parameter ( UG1 = 3 )
parameter ( UL1 = 4 )
parameter ( USp = 5 )
parameter ( UL2 = 6 )
parameter ( UL3 = 7 )
parameter ( UFolie = 8 )
parameter ( UVorne = 9 )
parameter ( UHinten = 10 )
parameter ( UMCP3 = 11 )
parameter ( UMCP2 = 12 )
parameter ( BTD = 13 )
parameter ( BHelm = 14 )
parameter ( alfTgt = 15 )
parameter ( alfSp = 16 )
parameter ( alfTD = 17 )
parameter ( mass = 18 )
parameter ( charge = 19 )
parameter ( ener = 20 )
parameter ( yPos = 21 )
parameter ( zPos = 22 )
parameter ( thetAng = 23 )
parameter ( phiAng = 24 )
parameter ( Thickn = 25 )
parameter ( Eloss = 26 )
parameter ( DeltaL1 = 27 )
parameter ( DeltaL2 = 28 )
integer par_Anzahl
parameter ( par_Anzahl=28) ! <- 'Zufalls-Schleife' zu k=0 zaehlt nicht!
c-------------------------------------------------------------------------------
c Code-Nummern fuer das Schicksal des Teilchens
c-------------------------------------------------------------------------------
integer smallest_code_Nr
integer highest_code_Nr
integer code_stopped_in_foil
integer code_durchSpiegel,code_Stuetzgitter,code_lostInTD,code_NotRegInM3
integer code_hitBlende,code_hitMCP2inactive
integer code_frontOfMapAc,code_leftMapAc,code_hit_TgtHolder
integer code_ok
integer code_decay,code_vorbei,code_reflektiert,
+ code_wand,code_grid,code_lost,code_dtsmall
c SCHICKSAL 'code'
parameter ( smallest_code_Nr =-10 )
parameter ( code_ok = 0 )
parameter ( code_durchSpiegel = -1 )
parameter ( code_Stuetzgitter = -2 )
parameter ( code_lostInTD = -3 )
parameter ( code_NotRegInM3 = -4 )
parameter ( code_hitBlende = -5 )
parameter ( code_hitMCP2inactive= -6 )
parameter ( code_frontOfMapAc = -7 )
parameter ( code_leftMapAc = -8 )
parameter ( code_hit_TgtHolder = -9 )
parameter ( code_stopped_in_foil=-10 )
parameter ( code_decay = 1 )
parameter ( code_vorbei = 2 )
parameter ( code_reflektiert = 3 )
parameter ( code_grid = 4 )
parameter ( code_wand = 5 )
parameter ( code_lost = 6 )
parameter ( code_dtsmall = 7 )
parameter ( highest_code_Nr = 7 )
character code_Text(smallest_code_Nr:highest_code_Nr)*27
COMMON code_text
c-------------------------------------------------------------------------------
c Zuteilung der Statistiken zu den Feldelementen k ( 1<= k <= stat_Anzahl)
c von statInMemory(k),createTabelle(k),statNeeded(k),statMem(i,k)
c-------------------------------------------------------------------------------
integer Nr_S1xM2,Nr_S1M2,Nr_S1Fo,Nr_FoM2,Nr_S1M3,Nr_M3M2,Nr_t_FE,
+ Nr_y_Fo,Nr_z_Fo,Nr_r_Fo,Nr_y_M2,Nr_z_M2,Nr_r_M2,Nr_y_xM2,
+ Nr_z_xM2,Nr_r_xM2
c STATISTIK 'k'
parameter ( Nr_S1xM2 = 1 )
parameter ( Nr_S1M2 = 2 )
parameter ( Nr_S1Fo = 3 )
parameter ( Nr_FoM2 = 4 )
parameter ( Nr_S1M3 = 5 )
parameter ( Nr_M3M2 = 6 )
parameter ( Nr_t_FE = 7 )
parameter ( Nr_y_Fo = 8 )
parameter ( Nr_z_Fo = 9 )
parameter ( Nr_r_Fo = 10 )
parameter ( Nr_y_M2 = 11 )
parameter ( Nr_z_M2 = 12 )
parameter ( Nr_r_M2 = 13 )
parameter ( Nr_y_xM2 = 14 )
parameter ( Nr_z_xM2 = 15 )
parameter ( Nr_r_xM2 = 16 )
integer Stat_Anzahl
parameter (Stat_Anzahl = 16)
! Kurznamen der Statistiken
integer LengthStatName
parameter (LengthStatName = 8) ! hier muss zwei mal die gleich
character statName(stat_Anzahl)*8 ! Zahl stehen
integer What_Anzahl
parameter (What_Anzahl = 5)
! Kurznamen der statistischen Groessen:
integer LengthWhatName
parameter (LengthWhatName = 8) ! hier muss zwei mal die gleiche
character whatName(what_Anzahl)*8 ! Zahl stehen!
c===============================================================================
c II. Variablen in Commonbloecken
c===============================================================================
c-------------------------------------------------------------------------------
c die Gebietsnummer
c-------------------------------------------------------------------------------
integer Gebiet0 ! GebietsNummer beim Start
integer Gebiet ! aktuelle GebietsNummer
integer StartFlaeche
COMMON Gebiet0, StartFlaeche
c-------------------------------------------------------------------------------
c zufallsverteilte Startparameter
c-------------------------------------------------------------------------------
c Energie:
logical random_E0 ! Zufallsverteilung fuer Startenergie?
logical random_E0_equal ! gleichverteilte Startenergie
real lowerE0,upperE0 ! Grenzen fuer Zufallsverteilung
logical random_E0_gauss ! gaussverteilte Startenergie
real sigmaE0 ! Breite der Gaussverteilung
logical e0InterFromFile /.FALSE./
real E0Low(101)
c Position:
logical random_pos ! Zufallsverteilung fuer Startposition?
logical random_y0z0_equal ! gleichverteilt auf Viereckflaeche
logical random_r0_equal ! gleichverteilt auf Kreisflaeche
logical random_y0z0_Gauss ! Gauss-verteilt auf Viereckflaeche
logical random_r0_Gauss ! Gauss-verteilt auf Kreisflaeche
real StartBreite,StartHoehe,StartRadius, sigmaPosition
c Winkel:
logical random_angle ! Zufallsverteilung fuer Startwinkel?
logical random_lambert ! Lambert-Verteilung
logical random_gauss ! Gauss-Verteilung
real StartLambertOrd
real SigmaWinkel ! Breite der Gaussverteilung
logical ener_offset,pos_offset,angle_offset
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON random_E0,random_E0_equal,lowerE0,upperE0
COMMON random_E0_gauss,sigmaE0
COMMON e0InterFromFile,E0Low
COMMON random_pos,random_y0z0_equal,
+ random_r0_equal,random_y0z0_Gauss,random_r0_Gauss,
+ StartBreite,StartHoehe,StartRadius,sigmaPosition
COMMON random_angle,random_lambert,random_gauss
COMMON StartLambertOrd,sigmaWinkel
COMMON ener_offset,pos_offset,angle_offset
c-------------------------------------------------------------------------------
c Schleifen-Parameter
c-------------------------------------------------------------------------------
c (par(n,0) wird fuer die 'Zufallsschleife' verwendet)
real par(3,0:par_Anzahl) ! min, max und step der ParameterSchleifen
integer n_par(0:par_Anzahl) ! die Anzahl unterschiedl. Werte je Schleife
real parWert(par_Anzahl) ! der aktuelle Wert der Schleifenvariablen
character par_text(par_Anzahl)*22 ! Beschreibung jeder Variablen fuer Ausgabezwecke
integer reihenFolge(par_Anzahl) ! Enthaelt die Reihenfolge der
! Abarbeitung der Schleifenparameter
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON par, parWert, n_par, par_text, reihenfolge
c-------------------------------------------------------------------------------
c die Teilchenarten (artList)
c-------------------------------------------------------------------------------
integer Arten_Zahl ! Anzahl der bekannten Arten
parameter (Arten_Zahl = 36)
character*4 art_Name(Arten_Zahl) ! Bezeichnungen der bekannten Arten
real art_Masse(Arten_Zahl) ! Massen der bekannten Arten
real art_Ladung(Arten_Zahl) ! Ladungen der bekannten Arten
character artList*50 ! TeilchenArten-Liste
character artList_prevSim*50 ! TeilchenArten-Liste bei ACCEL
! und 'useFoilFile'
logical artList_defined ! wurde Teilchenart spezifiziert?
logical mu_flag ! signalisiert, ob Myon-Teilchen erkannt wurde
integer artenMax ! Maximalzahl in artList
parameter (artenMax = 9) ! akzeptierter Arten
integer art_Nr(artenMax) ! die in artList enthaltenen Arten
integer artNr ! die Nummer der aktuellen Art
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON art_Name,art_Masse,art_Ladung
COMMON artList,artList_prevSim,artList_defined,mu_flag
COMMON art_Nr,artNr
c-------------------------------------------------------------------------------
c Trigger-Detektor
c-------------------------------------------------------------------------------
logical TriggerInBeam ! TriggerDetektor im Strahlweg?
real Thickness ! Foliendicke
logical log_aufstreu ! WinkelAufstreuung in Folie beruecksichtigen?
logical log_aufstreu_fixed ! Breite der Winkelverteilung fest vorgegeben
real sigmaAufstreu ! Sigma des Gaussverteilten Aufstreuwinkels
logical log_Meyer_Gauss ! Meyer-Formel mit Gaussfkt
logical log_Meyer_F_Function ! Meyer mit F-Funktion (genauer!)
logical log_E_Verlust ! Energieverlust in TD-Folie beruecksichtigen?
logical log_E_Verlust_defined ! mittlerer Energieverlust vorgegeben?
logical log_E_Verlust_ICRU ! mittlerer E-Verlust gemaess ICRU?
logical log_E_Straggling_sigma ! Gausfoermige Energieverschmierung?
logical log_E_Straggling_equal ! Gleichmaessige Energieverschmierung?
logical log_E_Straggling_Lindhard ! Gaussfoermig nach Lindhard/Scharff
logical log_E_Straggling_Yang ! Gaussfoermig nach Yang
logical calculate_each ! bei ICRU: fuer jedes Teilchen neu?
real mean_E_Verlust ! bei '_defined': mittlerer E-Verlust
real sigmaE ! Breite der Verteilung der Verlustfunktion
real lowerE ! untere Grenze bei '_equal'
real upperE ! obere Grenze bei '_equal'
logical graphitData
logical log_neutralize
real neutral_fract(artenMax) ! Prozentzahl der zu neutralisiserenden Teilchen
logical generate_FE ! FolienElektronen generieren?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON /TRIGGERINBEAM/ TriggerInBeam
COMMON Thickness
COMMON log_aufstreu,log_aufstreu_fixed,sigmaAufstreu
COMMON log_Meyer_Gauss, log_Meyer_F_Function
COMMON log_E_Verlust,log_E_Verlust_defined,log_E_Verlust_ICRU,
+ log_E_Straggling_sigma,log_E_Straggling_equal,log_E_Straggling_Lindhard,
+ log_E_Straggling_Yang,mean_E_Verlust,calculate_each,
+ sigmaE,lowerE,upperE
common /elossDataType/ graphitData
COMMON log_neutralize,neutral_fract
COMMON generate_FE
c-------------------------------------------------------------------------------
c Programmsteuerung
c-------------------------------------------------------------------------------
logical alfaTgtVertically ! vertikale Variation des Targetwinkels
real scaleFactor ! Skalierungsfaktor fuer die Kammergeometrie
logical UseDecay ! MYONEN-Zerfall beruecksichtigen?
logical UseDecay_ ! MYONEN-Zerfall beruecksichtigen und Art ist myon?
logical UseDecay_prevSim! MYONEN-Zerfall bei ACCEL-Rechnung beruecksichtigt?
logical DEBUG ! DEBUG-Version?
logical DEBUG_ ! DEBUG .AND. startNr.LE.DEBUG_Anzahl
logical DEBUG_FE ! FE in DEBUG-Info?
logical log_alpha0_KS ! Startwinkel im Kammer-System gegeben?
logical notLastLoop
logical BATCH_MODE ! -> keine Graphikausgabe; keine Ausgabe der
! Prozentzahl schon gerechneter Trajektorien
logical INPUT_LIST ! spezielle Version eines Batch-Runs
integer ListLength !
logical gotFileNr !
character inputListName*20
logical TestRun ! falls true, RunNummern zwischen 9900 und 9999
logical log_confine ! Begrenze Schrittweite in Integrationsgebieten
! -> 'dl_max_...'
logical TestOnWireHit ! Pruefen, ob Gitterstaebe getroffen werden
logical idealMirror ! Spiegel als ideal rechnen?
logical upToTDFoilOnly ! Integration nur bis zum Erreichen der TD-Folie
logical createFoilFile ! File mit Trajektoriendaten bei Erreichen der
! TD-Folie erstellen, das dann analog zu
! den ACCEL-files eingelesen werden kann.
logical lense2 ! Linse 2 zw. Spiegel und TD vorhanden ?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON alfaTgtVertically
COMMON scaleFactor
COMMON UseDecay,UseDecay_,UseDecay_prevSim
COMMON DEBUG,DEBUG_,DEBUG_FE
COMMON log_alpha0_KS,notLastLoop
COMMON /BATCH_MODE/ BATCH_MODE
COMMON INPUT_LIST,ListLength,gotFileNr,inputListName
COMMON TestRun,log_confine,idealMirror
COMMON /TestOnWireHit/ TestOnWireHit
COMMON upToTDFoilOnly, createFoilFile
COMMON /lense2/ lense2
c-------------------------------------------------------------------------------
c Graphikausgabe
c-------------------------------------------------------------------------------
logical graphics ! graphisch Ausgabe?
integer graphics_Anzahl ! fuer wieviele Starts je Schleife?
logical graphics_ ! GRAPHICS .AND. startNr.LE.GRAPHICS_Anzahl
logical plot_FE ! Trajektorien der Folienelektronen plotten?
integer n_postSkript ! PostSkript-files erstellen?
integer iMonitor ! Abtastfrequenz fuer Graphik
integer color ! 0=schwarzweiss, 1=farbig
integer schnitt_p ! Kammerteil fuer die Schnittebene der Graphik
real schnitt_x ! x-Koordinate der Schnittebenen
logical vertical ! Blick auf die Kammer von oben?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON graphics,graphics_Anzahl,graphics_
COMMON plot_FE, n_postSkript, iMonitor,schnitt_p
COMMON /PICT/ color, schnitt_x, vertical
c-------------------------------------------------------------------------------
c FileNamen
c-------------------------------------------------------------------------------
character geo_fileName*60 ! Name des Files mit der Kammergeometrie
character filename*20 ! Name der Ausgabe-Dateien
character filename_ACCEL*40 ! gegebenenfalls Name des ACCEL-files
character filename_MUTRACK*40 ! gegebenenfalls Name des 'foilfiles'
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON geo_fileName
COMMON /filename/ filename
COMMON filename_ACCEL,filename_MUTRACK
c-------------------------------------------------------------------------------
c Vorgaben fuer das Summary (.LOG-file)
c-------------------------------------------------------------------------------
integer n_outWhere ! LogFile auf welche Ausgabekanaele geben?
logical LogFile ! Logfile erstellen?
logical smallLogFile ! minimalversion des Logfiles erstellen?
logical statsInSummary ! Statistiken in das Summary?
logical statInSummary(Stat_Anzahl) ! welche Statistiken in das Summary?
logical log_out_FE ! FolienElektronen-Statistik in das Summary?
logical log_out_pfosten(2)! getroffene TD-'Pfosten' in das Summary?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON n_outWhere
COMMON LogFile,smallLogFile
COMMON statsInSummary,statInSummary
COMMON log_out_FE,log_out_pfosten
c-------------------------------------------------------------------------------
c WELCHE FILES sollen erzeugt werden?
c-------------------------------------------------------------------------------
logical write_geo ! .GEO-file schreiben?
logical createPhysTab ! PAW-Gesamt-Tabelle (.PAW) erzeugen?
logical createNtp ! Ntuple (.NTP) erzeugen?
logical Fo_triggered ! nur Teilchen die die TD-Folie treffen in NTupel
logical xM2_triggered ! nur Teilchen die MCP2-Ebene erreichen ins NTupel
logical M2_triggered ! nur Teilchen die das MCP treffen ins NTupel
logical NTP_S1xM2 ! Flugzeit bis zur MCP2-EBENE ins NTupel?
logical NTP_times ! sonstige Flugzeiten ins NTupel?
logical NTP_FoM2Only ! nur TOF Folie-M2 ins NTupel? (ausser S1xM2)
logical NTP_charge ! Der Ladungszustand ins NTupel?
logical NTP_lifetime ! Die Lebensdauer ins NTupel?
logical NTP_start ! Die Startgroessen ...?
logical NTP_stop ! Die Stopgroessen ...?
logical NTP_40mm ! Die Groessen bei x=40mm ...?
logical NTP_Folie ! Everlust und Aufstreuungupel ...?
logical NTP_steps ! kleinste und groesste Schrittweiten ...?
logical NTP_Koord ! Die Trajektoriendaten ...?
logical createTabellen ! Tabellen-files erzeugen?
logical createTabelle(Stat_Anzahl) ! welche Tabellen-files erzeugen?
character TabExt(stat_Anzahl)*9 ! Extensions der Tabellenfiles
logical smearS1Fo /.false./
real sigmaS1Fo /1.6/
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON write_geo,createPhysTab,createNtp
COMMON Fo_triggered,xM2_triggered,M2_triggered
COMMON NTP_S1xM2,NTP_times,NTP_FoM2Only,NTP_charge,NTP_lifetime,NTP_start,NTP_stop
COMMON NTP_40mm,NTP_Folie,NTP_steps,NTP_Koord
COMMON createTabellen,createTabelle,statName,whatName,TabExt
COMMON smearS1Fo,sigmaS1Fo
c-------------------------------------------------------------------------------
c Fehlerkontrolle
c-------------------------------------------------------------------------------
real eps_x ! Fehlertoleranz bei Ortsberechnung
real eps_v ! Fehlertoleranz bei Geschw.Berechnung
logical log_relativ ! relative Fehlerbetrachtung?
integer maxStep ! maximale Anzahl an Integrationsschritten
! real deltaE in / 1 / (auch in initialize einbinden)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON eps_x,eps_v,log_relativ
COMMON maxStep
c-------------------------------------------------------------------------------
c haeufig benutzte Faktoren
c-------------------------------------------------------------------------------
real Energie_Faktor ! Faktor bei Berechn. der Energie aus der Geschw.
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON Energie_Faktor
c-------------------------------------------------------------------------------
c PHYSICA
c-------------------------------------------------------------------------------
integer par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY
integer parList(par_Anzahl),statList(stat_Anzahl),whatList(what_Anzahl)
integer lengthParName
logical statInPHYSICA(Stat_Anzahl) ! welche Statistiken in .PHYSICA file?
logical whatInPHYSICA(What_Anzahl) ! welche Statistiken in .PHYSICA file?
integer LwPerRec ! Recordlaenge in MU_nnnn.PHYSICA in Longwords
parameter (LwPerRec = 50)
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON par_Anzahl_used,statAnzahlPHY,whatAnzahlPHY
COMMON parList,statList,whatList
COMMON lengthParName
COMMON statInPHYSICA,whatInPHYSICA
c-------------------------------------------------------------------------------
c Programmablauf
c-------------------------------------------------------------------------------
real x0(3),v0(3),E0 ! Startort, -geschwindigkeit und -energie
real lifetime ! individuelle Myon-Lebensdauer [ns]
real theta0 ! 3D-Startwinkel gegen x_Achse
real phi0 ! azimuthaler Startwinkel (y-Achse:0, z-Achse:90)
real x(3),t,v(3) ! Ort, Zeit, Geschwindigkeit
c real spin(3) ! Teichelspin (nicht benutzt)
integer destiny ! die Codezahl fuer das Schicksal des Projektils
integer start_nr(2) ! Startnummer der Teilchen (1) und der FE (2)
integer GesamtZahl ! Gesamtzahl der Projektile
integer SchleifenZahl ! Anzahl durchzufuehrender Schleifen
integer SchleifenNr ! Nummer der aktuellen Schleife
integer Steps ! Nummer des Integrationssteps
real dtsmall ! kleinster Zeitschritt fuer Integrationen
integer n_dtSmall ! wie oft hat Teilchen dtSmall unterschritten
integer n_dtsmall_Max ! wie oft wurde dtsmall max. unterschritten
integer dtsmall_counter ! wieviele Teilchen haben dtsmall unterschritten
integer maxBelowDtSmall
integer LostInTD_counter! wieviele Teilchen wurden im TD abgeschrieben
integer Lost_counter ! wieviele Teilchen wurden sonst noch abgeschrieben
logical OneLoop ! genau eine Schleife
logical OneStartPerLoop ! Zufallsschleife macht genau einen Durchlauf
logical log_percent
logical Use_ACCEL ! ACCEL-Daten verwenden
logical Use_MUTRACK ! 'FoilFile'-Daten verwenden
logical fromScratch ! .NOT.(Use_ACCEL.OR.Use_MUTRACK)
logical previousSettings ! Parametervorgaben von ACCEL uebernehmen?
integer firstIndx(10),IndxIncr(10),parIndx(10)
integer eventNr ! korrespondierende Eventnummer im ACCEL-NTP
logical guard ! Potential am Guardring frei variierbar?
integer randomStarts_prevSim ! 'randomStarts' bei ACCEL und 'foilFile'
integer seed ! fuer Zufallsgenerator
logical reachedEndOfMap ! bei FolienMappe oder MCP2Mappe x=xmax erreicht
logical gridInFrontOfFoil
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
c Die benannten Common-Bloecke werden fuer die NTP-Ausgabe benoetigt!
c die separaten Commonblocks sind fuer die Routine HBNAME der CERN library
c wichtig wenn es darum geht, frueher erzeugte NTP einzulesen. Ansonsten kommt
c (zumindest auf der PSW264, auf der PSICLC u.U. nicht (-> Option 'align=all'
c beim FORTRAN Befehl auf der alpha)) z.B. die Fehlermeldung
c
c Variable LIFETIME
c ***** ERROR in HBNAME : Address not word aligned :
c Variable GEBIET
c ***** ERROR in HBNAME : Address not word aligned :
c Variable T
c ***** ERROR in HBNAME : Address not word aligned :
COMMON /gebiet/ gebiet,destiny ! Reihenfolge wichtig fuer NTupel!
COMMON /lifetime/ lifetime
COMMON /x0/ x0
COMMON /v0/ v0
COMMON /E0/ E0
COMMON /theta0/ theta0,phi0
COMMON /t/ t,x,v ! Reihenfolge wichtig fuer NTupel!
COMMON /ntp_steps/ steps ! in MUTRACK wird noch weiteres angefuegt!
COMMON /loop/ SchleifenNr
COMMON start_Nr
COMMON GesamtZahl,SchleifenZahl
COMMON dtsmall, n_dtsmall, n_dtsmall_Max, dtsmall_counter
COMMON maxBelowDtSmall
COMMON LostInTD_counter,Lost_counter
COMMON OneLoop, OneStartPerLoop
COMMON log_percent
COMMON Use_ACCEL,Use_MUTRACK,fromScratch
COMMON previousSettings,firstIndx,IndxIncr,parIndx,eventNr
COMMON guard
COMMON randomStarts_prevSim
COMMON /seed/ seed ! das Common /seed/ ist auch in den Routinen
! 'GAUSS_VERTEILUNG' und 'GAUSS_VERTEILUG_THETA'
! in MUTRACK.FOR definiert
COMMON reachedEndOfMap
COMMON /foilGrid/ gridInFrontOfFoil
c-------------------------------------------------------------------------------
c Statistik
c-------------------------------------------------------------------------------
integer statTD(2,18) ! Statistik der Returncodes des TDs
integer pfostenHit(75,2) ! Statistik der Pfostentreffen im TD (75 oder 45?)
integer statDestiny(smallest_code_Nr:Gebiete_Anzahl*highest_code_Nr)
! Statistik der Teilchenschicksale
real statMem(9,stat_Anzahl) ! Statistik der Ergebnisse der Bahnberechnung
logical statNeeded(stat_Anzahl) ! welche Statistiken muessen fuer die
! geforderten Informationen gefuehrt werden?
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
COMMON statTD,pfostenHit,statDestiny
COMMON statMem,statNeeded
c-------------------------------------------------------------------------------
c Ein- und Ausgabekanaele
c-------------------------------------------------------------------------------
INCLUDE 'mutrack$sourcedirectory:COM_LUNS.INC'
integer*4 NTP_write, NTP_read
parameter (NTP_write=5, NTP_read = NTP_write+1)
c-------------------------------------------------------------------------------
c Datenausgabe
c-------------------------------------------------------------------------------
INCLUDE 'mutrack$sourcedirectory:COM_OUTPUT.INC'

View File

@ -0,0 +1,23 @@
c===============================================================================
c COM_OUTPUT.INC
c===============================================================================
c Die Deklaration der Variablen und des Commonblocks fuer die DatenAusgabe
c im Programm 'MUTRACK' wird sowohl von den Ausgaberoutinen des Hauptprogramms
c als auch von den zum TriggerDetektor gehoerenden Routinen benoetigt und sind
c daher in diesem separaten include-file niedergelegt.
integer DEBUG_StartNr
integer DEBUG_Anzahl ! fuer wieviele Starts je Schleife sollen
! (so ueberhaupt) DEBUG-Informationen ausgegeben
! werden?
integer lun(2), indx
integer indx1, indx2
COMMON /OUTPUT/ lun, indx1,indx2, indx, DEBUG_StartNr, DEBUG_Anzahl
c 'indx' steht nur im COMMON-Block, damit die Meldungen 'declared but not used'
c unterbleiben!

View File

@ -0,0 +1,20 @@
c===============================================================================
c COM_TD_EXT.INC
c===============================================================================
c Dieser include-file declariert diejenigen Variablen, die den Routinen in
c der Fortran-Text-Datei SUB-TD-CALC und der Routine, welche das Sub. TD_CALC
c aufruft, gemeinsam sind und definiert den zugehoerigen COMMON-Block:
c - die am Trigger-Detektor anliegenden Spannungen:
real U_F ! die Spannung an der FOLIE (F)
real U_V ! die Spannung am vorderen Gitter (V)
real U_H ! die Spannung am hinteren Gitter (H)
real U_MCP3 ! die Spannung an der Vorderseite von MCP-3 (3)
c - der COMMOM-Block:
COMMON /TRIGGERSETTINGS/ U_F,U_V,U_H,U_MCP3

View File

@ -0,0 +1,25 @@
c===============================================================================
c COM_TD_INT.INC
c===============================================================================
c Dieser include-file declariert diejenigen Variablen, die den Routinen in
c der Fortran-Text-Datei SUB-TD-CALC gemeinsam zugaenglich sind, und definiert
c den zugehoerigen COMMON-Block:
c - die Teilchen-Parameter Ladung, Masse, Ort, Geschw., Startenergie
real q, m, t, x, y, z, v_x, v_y, v_z, E0
c - was ausgegeben werden soll:
logical DEBUG, GRAPHICS
c - die Return-Variable:
integer n_return
c - logicals, die anzeigen, ob das Teilchen schon einmal reflektiert wurde:
logical log_refl_Vh, log_refl_V3
c - der COMMON-Block:
COMMON /INTERN/ q, m, t, x, y, z, v_x, v_y, v_z, E0
COMMON /INTERN/ DEBUG,GRAPHICS, n_return,log_refl_VH,log_refl_V3

View File

@ -0,0 +1,24 @@
c===============================================================================
c COM_WINKEL.INC
c===============================================================================
c Da die Drehwinkel von Moderator (= Target), Spiegel und Triggerdetektor
c in mehreren Routinen des Programms 'MUTRACK' sowohl innerhalb als auch
c ausserhalb der Trigger-Komplexes benoetigt wird, steht dieser Commonblock in
c diesem separaten Include-file. (Auch in SUB_PICTURE verwendet)
real alfaTgt ! Tgt <-> Target
real Sin_alfaTgt, Cos_alfaTgt ! Target-Verdrehung
real alfaSp ! Sp <-> Spiegel
real Sin_alfaSp , Cos_alfaSp , Tan_AlfaSp ! Spiegel-Verdrehung
real alfaTD ! TD <-> TriggerDetektor
real Sin_alfaTD , Cos_alfaTD , Tan_alfaTD ! Trigger-Verdrehung
COMMON /ANGLES/ alfaTgt, Sin_alfaTgt, Cos_alfaTgt
COMMON /ANGLES/ alfaSp, Sin_alfaSp, Cos_alfaSp, Tan_AlfaSp
COMMON /ANGLES/ alfaTD, Sin_alfaTD, Cos_alfaTD, Tan_alfaTD

123
mutrack/src/GEO_TRIGGER.INC Normal file
View File

@ -0,0 +1,123 @@
c===============================================================================
c GEO_TRIGGER.INC
c===============================================================================
c*******************************************************************************
c* *
c* Diese Datei enthaelt die geometrischen Daten des NEMU-Triggerdetektors *
c* in seiner ersten Version. *
c* *
c* Die Definitionen der Groessen sind im Ordner 'MUTRACK' niedergelegt! *
c* Alle Angaben sind in [mm]. *
c* *
c* Stand: Run VI. Die Werte wurden einer Konstruktionszeichnung entnommen *
c* *
c* >> 2.12.1994 >> ahofer@psiclu.cern.ch *
c* *
c*******************************************************************************
c Laengen in x-Richtung:
real dx1,dx2,dx3,dx4,dx5,dx6,dx7,dx8,dx9,dx10,dx11
parameter (dx1 = 8, dx2 =37, dx3 =14, dx4 =42, !dx5 = 8,
+ dx6 =12, dx7 =12, dx8 =19, dx9 =23, dx10=10, dx11=14)
DATA dx5 / 8 /
COMMON /dx5/ dx5
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Laengen in y-Richtung:
real dy1,dy2,dy3,dy4,dy5,dy6,dy7,dy8,dy9,dy10,dy11
real dy12,dy13,dy14,dy15
parameter (dy1 =20, dy2 =20, dy3 =25, dy4 =25, dy5 =25,
+ dy6 =32, dy7 =30, dy8 =42, dy9 =40, dy10=11,
+ dy11=32, dy12=30, dy13=30, dy14=30, dy15=30)
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Laengen in z-Richtung:
real dz1, dz2
parameter (dz1 =30, dz2 =30)
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
real d_Grid_Folie ! Abstand zwischen
parameter (d_Grid_Folie = 18) ! Gitter und Folie
c Abgeleitete Laengen:
real d_Folie_Achse ! Abstand zwischen Folie
parameter (d_Folie_Achse = dx1+dx2+dx3/2) ! und Trigger-Achse
real d_Folie_Hinten2 ! Abstand zwischen Folie
parameter (d_Folie_Hinten2 = dx1+dx2+dx3+dx4) ! und 2. Gitter von H
real radiusQuad_Folie ! in MUTRACK.INPUT?
parameter (radiusQuad_Folie = 20*20 )
real radiusQuad_Folie_max ! <------ nicht benutzt!
parameter (radiusQuad_Folie_max = 26*26) ! maximaler Folienradius
real xCenter_MCP3, radius_MCP3, radiusQuad_MCP3
parameter (radius_MCP3 = ((dx2+dy8-dx11)-(dx9))/2. )
parameter (radiusQuad_MCP3 = radius_MCP3 * radius_MCP3)
parameter (xCenter_MCP3 = dx1+dx9+radius_MCP3) ! x-Pos. der Mitte von
! MCP3 im Triggersystem
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Gitterdrahtabstaende und -durchmesser:
c (Nachdem diese Groessen in Run 10 geaendert wurden muessen sie nun als
c Variable gehandhabt werden)
real dist_Wires_V1 /1.5/, dWires_V1 /.050/
real dist_Wires_V2 /1.5/, dWires_V2 /.050/
real dist_Wires_V3 /1.5/, dWires_V3 /.050/
real dist_Wires_H1 /1.5/, dWires_H1 /.050/
real dist_Wires_H2 /1.5/, dWires_H2 /.050/
real dist_Wires_G /1.5/, dWires_G /.050/
real WireRadiusQuad_V1, WireRadiusQuad_V2, WireRadiusQuad_V3
real WireRadiusQuad_H1, WireRadiusQuad_H2, WireRadiusQuad_G
COMMON /TD_GEO/
+ dist_Wires_V1,dist_Wires_V2,dist_Wires_V3,
+ dist_Wires_H1,dist_Wires_H2,dist_Wires_G,
+ dWires_V1,dWires_V2,dWires_V3,dWires_H1,dWires_H2,dWires_G,
+ WireRadiusQuad_V1,WireRadiusQuad_V2,WireRadiusQuad_V3,
+ WireRadiusQuad_H1,WireRadiusQuad_H2,WireRadiusQuad_G
c parameter (dist_Wires_V1 = 1.5 , dWires_V1 = .050)
c parameter (dist_Wires_V2 = 1.5 , dWires_V2 = .050)
c parameter (dist_Wires_V3 = 1.5 , dWires_V3 = .050)
c parameter (dist_Wires_H1 = 1.5 , dWires_H1 = .050)
c parameter (dist_Wires_H2 = 1.5 , dWires_H2 = .050)
c parameter (dist_Wires_G = 1.5 , dWires_G = .050)
c die Berechnung der Quadrate wird jetzt in SUBROUTINE READ_TRIGGER_GEO erledigt
c
c parameter (WireRadiusQuad_V1 = dwires_V1*dWires_V1/4.,
c + WireRadiusQuad_V2 = dwires_V2*dWires_V2/4.,
c + WireRadiusQuad_V3 = dwires_V3*dWires_V3/4.,
c + WireRadiusQuad_H1 = dwires_H1*dWires_H1/4.,
c + WireRadiusQuad_H2 = dwires_H2*dWires_H2/4.,
c + WireRadiusQuad_G = dwires_G *dWires_G /4.)
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
c Effizienz von MCP3:
real efficiencyM3
parameter (efficiencyM3 = .75)
c parameter (efficiencyM3 = .50)

464
mutrack/src/INITIALIZE.INC Normal file
View File

@ -0,0 +1,464 @@
c Diese Datei enthaelt Initialisierungen fuer das Programm TOF zur Berechnung
c von Flugzeiten zwischen MCP3 und MCP2 der NEMU-Apparatur.
c Die Deklaration der Variablen findet im Include-file 'COM_MUTRACK.INC'
c statt.
c die Spezifizierungen der Schleifen-Parameter (character*22):
par_text(UTgt ) = 'U(TARGET) [kV] : '
par_text(UGua ) = 'U(GUARD) [kV] : '
par_text(UG1 ) = 'U(GITTER) [kV] : '
par_text(UL1 ) = 'U(L1) [kV] : '
par_text(USp ) = 'U(SPIEGEL)[kV] : '
par_text(UL2 ) = 'U(L2) [kV] : '
par_text(UL3 ) = 'U(L3) [kV] : '
par_text(UFolie ) = 'U(FOLIE) [kV] : '
par_text(UVorne ) = 'U(VORNE) [kV] : '
par_text(UHinten) = 'U(HINTEN) [kV] : '
par_text(UMCP3 ) = 'U(MCP3) [kV] : '
par_text(UMCP2 ) = 'U(MCP2) [kV] : '
par_text(BTD ) = 'B(TD) [Gauss] : '
par_text(BHelm ) = 'B(Helmh.) [Gauss] : '
par_text(alfTgt ) = 'alpha_Tgt [degree] : '
par_text(alfSp ) = 'alpha_Sp [degree] : '
par_text(alfTD ) = 'alpha_TD [degree] : '
par_text(mass ) = 'Masse [keV/c**2]: '
par_text(charge ) = 'Ladung [e] : '
par_text(ener ) = 'Energie [keV] : '
par_text(yPos ) = 'y0 [mm] : '
par_text(zPos ) = 'z0 [mm] : '
par_text(thetAng) = 'theta0 [degree] : '
par_text(phiAng ) = 'phi0 [degree] : '
par_text(Thickn ) = 'Thickness [ug/cm^2] : '
par_text(Eloss ) = 'E-Verlust [keV] : '
par_text(deltaL1) = 'delta_L1 [mm] : '
par_text(deltaL2) = 'delta_L2 [mm] : '
c Groesste Laenge einer Parameterbezeichnung (ohne Einheitenangabe) in
c 'par_text':
lengthParName = 10
c die Gebiets-Bezeichnungen (character*40):
Gebiet_Text(upToGrid1) = 'in 1. Beschl.Stufe:'
Gebiet_Text(upToGrid2) = 'in 2. Beschl.Stufe:'
Gebiet_Text(upToHeShield) = 'bis He-Schild:'
Gebiet_Text(upToLNShield) = 'bis LN-Schild:'
Gebiet_Text(upToL1Map) = 'vor Linse-1-Mappe:'
Gebiet_Text(upToExL1) = 'in Linse-1-Mappe:'
Gebiet_Text(upToEnSp) = 'bis Spiegel:'
Gebiet_Text(upToExSp) = 'im Spiegel:'
Gebiet_Text(upToChKoord) = 'bis Koordinatenwechsel:'
Gebiet_Text(upToEnTD) = 'bis TriggerDetektor:'
Gebiet_Text(upToExTD) = 'im TriggerDetektor:'
Gebiet_Text(upToL2andFoMap) = 'vor Linse-2-Mappe:'
Gebiet_Text(upToExL2) = 'in Linse-2-Mappe:'
Gebiet_Text(upToL3Map) = 'vor Linse-3-Mappe:'
Gebiet_Text(upToExL3) = 'in Linse-3-Mappe:'
Gebiet_Text(upToM2Map) = 'zwischen Linse-3-Mappe und MCP2-Mappe:'
Gebiet_Text(upToMCP2) = 'vor MCP2:'
c die Bezeichnungen fuer die moeglichen Teilchenschicksale (character*26):
code_text(code_ok ) = 'MCP2 getroffen: '
code_text(code_durchSpiegel ) = 'Spiegel durchquert: '
code_text(code_Stuetzgitter ) = 'Folienstuetzgitter getr.: '
code_text(code_lostInTD ) = 'im TD abgebrochen: '
code_text(code_NotRegInM3 ) = 'von MCP3 nicht registriert: '
code_text(code_hitBlende ) = 'auf Blende des MCP2: '
code_text(code_hitMCP2inactive) = 'auf Rand des MCP2: '
code_text(code_frontOfMapAc ) = 'ACCEL: vor Mappe (FEHLER!): '
code_text(code_leftMapAc ) = 'ACCEL: seitlich aus Mappe: '
code_text(code_hit_TgtHolder ) = 'Targethalter getroffen: '
code_text(code_stopped_in_foil) = 'in Triggerfolie gestoppt: '
code_text(code_decay ) = 'zerfallen: '
code_text(code_vorbei ) = 'Element verfehlt: '
code_text(code_reflektiert ) = 'reflektiert: '
code_text(code_grid ) = 'auf Gitter getroffen: '
code_text(code_wand ) = 'aufgeschlagen: '
code_text(code_lost ) = 'verloren (steps>maxsteps): '
code_text(code_dtsmall ) = 'Zeitschritt kleiner dtSmall:'
c die Bezeichnungen der Statistiken (character*8):
statName(Nr_S1xM2) = 'S1xM2 '
statName(Nr_S1M2) = 'S1M2 '
statName(Nr_S1Fo) = 'S1Fo '
statName(Nr_FoM2) = 'FoM2 '
statName(Nr_S1M3) = 'S1M3 '
statName(Nr_M3M2) = 'M3M2 '
statName(Nr_t_FE) = 't(FE) '
statName(Nr_y_Fo) = 'y(FOLIE)'
statName(Nr_z_Fo) = 'z(FOLIE)'
statName(Nr_r_Fo) = 'r(FOLIE)'
c statName(Nr_y_xFo) = 'y(xFOLIE)'
c statName(Nr_z_xFo) = 'z(xFOLIE)'
c statName(Nr_r_xFo) = 'r(xFOLIE)'
statName(Nr_y_M2) = 'y(MCP2) '
statName(Nr_z_M2) = 'z(MCP2) '
statName(Nr_r_M2) = 'r(MCP2) '
statName(Nr_y_xM2) = 'y(xMCP2)'
statName(Nr_z_xM2) = 'z(xMCP2)'
statName(Nr_r_xM2) = 'r(xMCP2)'
c die Bezeichnungen der statistischen Groessen (character*8):
whatName(1) = 'mean '
whatName(2) = 'variance'
whatName(3) = 'minimum '
whatName(4) = 'maximum '
whatName(5) = 'percent '
c die Extensions der Tabellen-files (character*9):
TabExt(Nr_S1xM2) = '._S1xM2 '
TabExt(Nr_S1M2) = '._S1M2 '
TabExt(Nr_S1Fo) = '._S1Fo '
TabExt(Nr_FoM2) = '._FoM2 '
TabExt(Nr_S1M3) = '._S1M3 '
TabExt(Nr_M3M2) = '._M3M2 '
TabExt(Nr_t_FE) = '._T_FE '
TabExt(Nr_y_Fo) = '._Y_FO '
TabExt(Nr_z_Fo) = '._Z_FO '
TabExt(Nr_r_Fo) = '._R_FO '
TabExt(Nr_y_M2) = '._Y_M2 '
TabExt(Nr_z_M2) = '._Z_M2 '
TabExt(Nr_r_M2) = '._R_M2 '
TabExt(Nr_y_xM2) = '._Y_xM2 '
TabExt(Nr_z_xM2) = '._Z_xM2 '
TabExt(Nr_r_xM2) = '._R_xM2 '
c die Reihenfolge, in welcher die Schleifen der 'Schleifenparameter' par(i,k)
c im Hauptprogramm abgearbeitet werden:
c Aenderungen in der Reihenfolge brauchen in den Routinen fuer die graphische
c Darstellung mittels 'PHYSICA' nicht durch entsprechende Aenderungen in den
c jeweiligen files beruecksichtigt werden (PHYSICA bekommt die Reihenfolge ueber
c die .PHYSICA - files selbst mitgeteilt).
c Diese files sind nur anzugleichen, falls die Zuordnungen der verschiedenen
c physikalischen Groessen zu ihren jeweiligen Code-Nummern geaendert werden,
c bzw. wenn zusaetzliche Schleifengroessen aufgenommen werden
c (-> mutrack$PHYSICAdirectory: 'xxx.FOR'- und 'xxx.PCM'-Dateien).
c Desweiteren koennen ACCEL und 'foilFile' durchaus andere Reihenfolgen ver-
c wendet haben.
DATA reihenfolge /
+ DeltaL1,DeltaL2,Eloss,Thickn,
+ UMCP2, alfTgt,alfSp,alfTD,
+ UVorne,UHinten,UMCP3,
+ UFolie,UL2, USp,UL1,UL3,
+ BHelm,BTD,
+ mass,charge, UTgt,UGua,UG1,
+ ener,thetAng,phiAng,yPos,zPos /
c====== Initialisierungen fuer die benutzerdefinierbaren Parameter ============
c Das Startgebiet 'Gebiet0' wird indirekt im SUB 'READ_INPUTFILE' via die
c lokalen Variablen 'Startflaeche', bzw. 'x0_' und 'Kammerteil' initialisiert.
c - - - - - - - - - - zufallsverteilte Startparameter - - - - - - - - - - - - -
c Energie:
DATA random_E0 /.false./
DATA random_E0_equal /.false./
DATA lowerE0 / 0.000 /
DATA upperE0 / 0.010 /
DATA random_E0_gauss /.false./
DATA sigmaE0 / 0.010 /
c Position:
DATA random_pos /.false./
DATA sigmaPosition / 15. /
DATA random_y0z0_equal /.false./
DATA random_r0_equal /.false./
DATA random_y0z0_Gauss /.false./
DATA random_r0_Gauss /.false./
DATA StartBreite / -1. /
DATA StartHoehe / -1. /
DATA StartRadius / -1. /
c Winkel:
DATA random_angle /.false./
DATA random_lambert /.false./
DATA random_gauss /.false./
DATA StartLambertOrd / 1. /
DATA sigmaWinkel / 1. /
DATA ener_offset / .true. /
DATA pos_offset / .true. /
DATA angle_offset / .true. /
c - - - - - - - - - - Schleifen-Parameter - - - - - - - - - - - - - - - - - - -
! Das Schleifenparameterfeld 'par(i,k)' (1 <= k <= par_Anzahl)
! wird indirekt im SUB 'read_inputFile' ueber die dortigen lokalen
! Variablen initialisiert (siehe dort).
! Hier wird nur die 'Zufallsschleife' par(i,0) initialisiert.
DATA par(1,0) / 1. /
DATA par(2,0) / 1. /
DATA par(3,0) / 1. /
c - - - - - - - - - - Projektile- - - - - - - - - - - - - - - - - - - - - - - -
DATA art_Name / 'm+ ', 'm- ', ! character*4
+ 'Mu ', 'Mu- ',
+ 'e+ ', 'e- ',
+ 'H+ ', 'H ', 'H- ',
+ 'H2+ ', 'H2 ', 'H2- ',
+ 'alfa',
+ 'A11+', 'A12+', 'A21+', 'A31+', 'A32+',
+ 'N11+', 'N21+',
+ 'K11+', 'K12+',
+ 'H2O1', 'H2O2', 'H2O3', 'H2O4', 'H2O5',
+ 'Hyd1', 'Hyd2', 'Hyd3', 'Hyd4', 'Hyd5',
+ 'Hyd6', 'Hyd7', 'Hyd8', 'Hyd9'
+ /
c folgende Werte wurden aus bzw. mittels 'HANDBOOK OF CHEMESTRY AND PHYSICS,
c 74th edition' und 'PHYSICAL REVIEW D, 50, S.1173-1826 (August 1994)' bestimmt:
DATA art_Masse / 105658., 105658.,
+ 106169., 106680.,
+ 510.9991, 510.9991,
+ 938272.3, 938783.3, 939294.3,
+ 1877055.6, 1877566.6, 1878077.6,
+ 3727380.2,
+ 37.96238E6,37.22371E6,74.44896E6,111.673689E6,111.673178E6,
+ 13.043273 ,26.087057,
+ 78.16258E6,78.162070E6,
+ 16.77623E6,33.55297E6,50.32971E6,67.10644E6,83.88318E6,
+ 17.71501E6,34.49175E6,51.26849E6,68.04523E6,84.82197E6,
+ 101.59870E6,118.37544E6,135.15218E6,151.92892E6
+ /
DATA art_Ladung / +1., -1.,
+ 0., -1.,
+ +1., -1.,
+ +1., 0., -1.,
+ +1., 0., -1.,
+ +2.,
+ +1., +2., +1., +1., +2.,
+ +1., +1.,
+ +1., +2.,
+ +1., +1., +1., +1., +1.,
+ +1., +1., +1., +1., +1.,
+ +1., +1., +1., +1.
+ /
DATA neutral_fract / artenMax*0. /
DATA artList / ' ' /
DATA artList_defined /.false./
c - - - - - - - - - - Trigger-Detektor- - - - - - - - - - - - - - - - - - - - -
DATA TriggerInBeam / .false. /
DATA Thickness / 3.0 /
DATA log_aufStreu / .false. /
DATA log_aufstreu_fixed / .false. /
DATA log_Meyer_Gauss / .false. /
DATA log_Meyer_F_Function / .false. /
DATA sigmaAufstreu / 5. /
DATA log_E_Verlust / .false. /
DATA log_E_Verlust_defined / .false. /
DATA log_E_Verlust_ICRU / .false. /
DATA log_E_Straggling_sigma / .false. /
DATA log_E_Straggling_equal / .false. /
DATA log_E_Straggling_Lindhard / .false. /
DATA log_E_Straggling_Yang / .false. /
DATA mean_E_Verlust / 2.5 /
DATA calculate_each / .false. /
DATA sigmaE / 0.5 /
DATA lowerE / 0. /
DATA upperE / 0.1 /
DATA graphitData / .false. /
DATA log_neutralize / .false. /
DATA generate_FE / .false. /
DATA TransTDFoil / 100. /
c - - - - - - - - - - Programmsteuerung - - - - - - - - - - - - - - - - - - - -
DATA alfaTgtVertically/ .false. /
DATA scaleFactor / 1. /
DATA UseDecay / .false. /
DATA UseDecay_ / .false. /
DATA UseDecay_prevSim / .false. /
DATA DEBUG / .false. /
DATA DEBUG_FE / .false. /
DATA log_alpha0_KS / .false. /
DATA gotFileNr / .false. /
DATA TestRun / .false. /
DATA log_confine / .false. /
DATA TestOnWireHit / .false. /
DATA upToTDFoilOnly / .false. /
DATA createFoilFile / .false. /
DATA lense2 / .false. /
c - - - - - - - - - - Graphikausgabe- - - - - - - - - - - - - - - - - - - - - -
DATA GRAPHICS / .false. /
DATA GRAPHICS_Anzahl / 25 /
DATA plot_FE / .false. /
DATA vertical / .true. /
DATA n_postSkript / 1 /
DATA imonitor / 2 /
DATA color / 0 /
DATA schnitt_p / 2 /
DATA schnitt_x / -1. /
c - - - - - - - - - - FileName- - - - - - - - - - - - - - - - - - - - - - - - -
DATA filename / 'MU_' /
c - - - - - - - - - - Vorgaben fuer das Summary - - - - - - - - - - - - - - - -
DATA n_outWhere / 2 /
DATA LogFile / .false. /
DATA smallLogFile / .false. /
DATA statsInSummary / .false. /
! 'statInSummary' wird indirekt im SUB 'read_inputFile' ueber die
! lokalen Variablen 'SUM_*' initialisiert (alle auf .false.)
DATA log_out_FE / .false. /
DATA log_out_pfosten / .false. , .false./
c - - - - - - - - WELCHE FILES sollen erzeugt werden? (ausser .SUM)- - - - - -
DATA createTabellen / .false. /
! 'createTabelle' wird indirekt im SUB 'read_inputFile' ueber die
! lokalen Variablen 'TAB_*' initialisiert (alle auf .false.)
DATA createPhysTab / .false. /
DATA createNtp / .false. /
DATA Fo_triggered / .false. /
DATA xM2_triggered / .false. /
DATA M2_triggered / .false. /
DATA NTP_Koord / .false. /
DATA NTP_S1xM2 / .false. /
DATA NTP_times / .false. /
DATA NTP_FoM2Only / .false. /
DATA NTP_charge / .false. /
DATA NTP_start / .false. /
DATA NTP_stop / .false. /
DATA NTP_40mm / .false. /
DATA NTP_Folie / .false. /
DATA NTP_steps / .false. /
DATA NTP_Koord / .false. /
c - - - - - - - - - - Fehlerkontrolle - - - - - - - - - - - - - - - - - - - - -
DATA eps_x / 1.e-5 /
DATA eps_v / 1.e-5 /
DATA log_relativ / .false. /
DATA maxStep / 6000 /
DATA dtsmall / .001 /
DATA maxBelowDtSmall / 50 /
DATA idealMirror / .false. /
c - - - - - - - - - - Programmablauf- - - - - - - - - - - - - - - - - - - - - -
DATA accelVersionIndx / -1 /
DATA mutrackVersionIndx / -1 /
DATA n_dtsmall / 0 /
DATA n_dtsmall_Max / 0 /
DATA dtsmall_counter / 0 /
DATA LostInTD_counter / 0 /
DATA Lost_counter / 0 /
DATA Startflaeche / 0 /
DATA SchleifenNr / 0 /
c Ausgabekanaele (fuer die 'do indx = indx1, indx2 ....' Anweisungen):
DATA lun / lunLOG, lunScreen /
DATA OneLoop / .false. /
DATA OneStartPerLoop / .false. /
DATA log_percent / .false. /
DATA Use_ACCEL / .false. /
DATA Use_MUTRACK / .false. /
DATA fromScratch / .true. /
DATA previousSettings / .false. /
DATA guard / .true. /
DATA gridInFrontOfFoil / .false. /
c fuer Random-Generator: 'seed' soll gross und ungerade sein. ->
c nimm den Sinus von secnds, und mache daraus durch Multiplikation mit ent-
c sprechender 10er-Potenz eine 8stellige Integer-Zahl. Sollte seed dann
c gerade sein, mache es ungerade:
help1= abs(sin(secnds(0.))) ! abs(), da sonst log10(sec) zu Fehler fuehrt
seed = int(help1* 10.**(8-int(log10(help1)) ) )
if ((seed/2)*2.EQ.seed) seed=seed-1 ! z.B. seed=3 -> seed/2=1, wegen Integer

Some files were not shown because too many files have changed in this diff Show More