LMU/musrsim
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added to repository.

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

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

33
accel/com/ACCEL_GENERAL_INIT.COM Normal file
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"
$!==============================================================================

19
accel/com/ACCEL_PROGR_INIT.COM Normal file
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"
$!==============================================================================

6
accel/com/DEF_MAKEWRITELOGOUT.CLD Normal file
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

98
accel/com/MAKEWRITELOGOUT.FOR Normal file
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
View 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

38
accel/src/CALC_FIELD_1.INC Normal file
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

32
accel/src/CODENUMMERN.LIST Normal file
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
View 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
View File

File diff suppressed because it is too large Load Diff

1705
accel/src/SUB_OUTPUT.FOR Normal file
View 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===============================================================================